From e4b609edd312ae4bf6f2049c72a1741396f5b0b4 Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Sat, 30 Aug 2003 11:30:56 +0000
Subject: [PATCH] 	* src/ldb/, src/assembler/: Removed; dead code.

---
 assembler/assem.lisp       |  697 -------------
 assembler/assembler.lisp   | 1693 -------------------------------
 assembler/disassemble.lisp |  368 -------
 assembler/miscasm.lisp     |   44 -
 assembler/rompconst.lisp   | 1097 --------------------
 assembler/ropdefs.lisp     |  221 ----
 ldb/Makefile.boot          |    8 -
 ldb/Makefile.orig          |  153 ---
 ldb/alloc.c                |  122 ---
 ldb/alloc.h                |    3 -
 ldb/arch.h                 |    8 -
 ldb/backtrace.c            |  222 -----
 ldb/bitbash.c              |   72 --
 ldb/breakpoint.c           |  166 ---
 ldb/core.h                 |   33 -
 ldb/coreparse.c            |  143 ---
 ldb/dynbind.c              |   69 --
 ldb/egets.c                |  628 ------------
 ldb/fake-mach.c            |   53 -
 ldb/gc.c                   | 1938 ------------------------------------
 ldb/gc.h                   |   33 -
 ldb/globals.c              |   66 --
 ldb/globals.h              |   68 --
 ldb/interrupt.c            |  417 --------
 ldb/interrupt.h            |   38 -
 ldb/ldb.c                  |  160 ---
 ldb/ldb.h                  |   25 -
 ldb/lispregs.h             |   17 -
 ldb/mach-os.c              |  180 ----
 ldb/mach-os.h              |   13 -
 ldb/mips-arch.c            |  144 ---
 ldb/mips-assem.s           |  356 -------
 ldb/mips-lispregs.h        |   50 -
 ldb/monitor.c              |  494 ---------
 ldb/os-common.c            |   95 --
 ldb/os.h                   |   47 -
 ldb/pager.c                |  587 -----------
 ldb/pager.h                |   47 -
 ldb/pagerlog.c             |   50 -
 ldb/parse.c                |  360 -------
 ldb/parse.h                |    9 -
 ldb/print.c                |  585 -----------
 ldb/print.h                |    5 -
 ldb/purify.c               |  736 --------------
 ldb/regnames.c             |    5 -
 ldb/rt-arch.c              |  164 ---
 ldb/rt-assem.s             |  260 -----
 ldb/rt-lispregs.h          |   32 -
 ldb/save.c                 |  347 -------
 ldb/search.c               |   45 -
 ldb/signal.h               |   32 -
 ldb/socket.c               |  144 ---
 ldb/sparc-arch.c           |  201 ----
 ldb/sparc-assem.s          |  475 ---------
 ldb/sparc-lispregs.h       |   64 --
 ldb/sunos-os.c             |  701 -------------
 ldb/sunos-os.h             |   13 -
 ldb/test.c                 |  264 -----
 ldb/undefineds.src         |  163 ---
 ldb/validate.c             |   63 --
 ldb/validate.h             |   49 -
 ldb/vars.c                 |  185 ----
 ldb/vars.h                 |   13 -
 ldb/version.c              |    2 -
 64 files changed, 15542 deletions(-)
 delete mode 100644 assembler/assem.lisp
 delete mode 100644 assembler/assembler.lisp
 delete mode 100644 assembler/disassemble.lisp
 delete mode 100644 assembler/miscasm.lisp
 delete mode 100644 assembler/rompconst.lisp
 delete mode 100644 assembler/ropdefs.lisp
 delete mode 100644 ldb/Makefile.boot
 delete mode 100644 ldb/Makefile.orig
 delete mode 100644 ldb/alloc.c
 delete mode 100644 ldb/alloc.h
 delete mode 100644 ldb/arch.h
 delete mode 100644 ldb/backtrace.c
 delete mode 100644 ldb/bitbash.c
 delete mode 100644 ldb/breakpoint.c
 delete mode 100644 ldb/core.h
 delete mode 100644 ldb/coreparse.c
 delete mode 100644 ldb/dynbind.c
 delete mode 100644 ldb/egets.c
 delete mode 100644 ldb/fake-mach.c
 delete mode 100644 ldb/gc.c
 delete mode 100644 ldb/gc.h
 delete mode 100644 ldb/globals.c
 delete mode 100644 ldb/globals.h
 delete mode 100644 ldb/interrupt.c
 delete mode 100644 ldb/interrupt.h
 delete mode 100644 ldb/ldb.c
 delete mode 100644 ldb/ldb.h
 delete mode 100644 ldb/lispregs.h
 delete mode 100644 ldb/mach-os.c
 delete mode 100644 ldb/mach-os.h
 delete mode 100644 ldb/mips-arch.c
 delete mode 100644 ldb/mips-assem.s
 delete mode 100644 ldb/mips-lispregs.h
 delete mode 100644 ldb/monitor.c
 delete mode 100644 ldb/os-common.c
 delete mode 100644 ldb/os.h
 delete mode 100644 ldb/pager.c
 delete mode 100644 ldb/pager.h
 delete mode 100644 ldb/pagerlog.c
 delete mode 100644 ldb/parse.c
 delete mode 100644 ldb/parse.h
 delete mode 100644 ldb/print.c
 delete mode 100644 ldb/print.h
 delete mode 100644 ldb/purify.c
 delete mode 100644 ldb/regnames.c
 delete mode 100644 ldb/rt-arch.c
 delete mode 100644 ldb/rt-assem.s
 delete mode 100644 ldb/rt-lispregs.h
 delete mode 100644 ldb/save.c
 delete mode 100644 ldb/search.c
 delete mode 100644 ldb/signal.h
 delete mode 100644 ldb/socket.c
 delete mode 100644 ldb/sparc-arch.c
 delete mode 100644 ldb/sparc-assem.s
 delete mode 100644 ldb/sparc-lispregs.h
 delete mode 100644 ldb/sunos-os.c
 delete mode 100644 ldb/sunos-os.h
 delete mode 100644 ldb/test.c
 delete mode 100644 ldb/undefineds.src
 delete mode 100644 ldb/validate.c
 delete mode 100644 ldb/validate.h
 delete mode 100644 ldb/vars.c
 delete mode 100644 ldb/vars.h
 delete mode 100644 ldb/version.c

diff --git a/assembler/assem.lisp b/assembler/assem.lisp
deleted file mode 100644
index 0811ac163..000000000
--- a/assembler/assem.lisp
+++ /dev/null
@@ -1,697 +0,0 @@
-;;; -*- Log: clc.log; Package: Compiler -*-
-;;;
-;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
-;;; **********************************************************************
-;;;
-;;; Assembler for the Common Lisp Compiler.  This file deals with turning
-;;; LAP code into binary code and dumping the results in the right places.
-;;; There also ulilities for dealing with the various output files.
-;;; 
-
-;;; Written by many hands: Joe Ginder, Scott Fahlman, Dave Dill,
-;;; Walter van Roggen, and Skef Wholey.
-
-;;; Currently maintained by Scott Fahlman.
-
-(in-package 'compiler :use '(system))
-
-(import '(lisp::%fasl-code-format))
-
-;;; Version number.
-
-(defparameter assembler-version "2.0")
-(defparameter target-fasl-code-format 3)
-
-(proclaim '(special compiler-version target-machine target-system
-		    *compile-to-lisp* *lisp-package* *keyword-package*))
-
-
-
-(defvar function-name nil
-  "Holds a symbol that names the function currently being compiled,
-  or nil if between functions.")
-
-;;; Output streams:
-;;; If a stream is NIL, don't produce that kind of output.
-(defvar *clc-fasl-stream* nil)
-(defvar *clc-lap-stream* nil)
-(defvar *clc-err-stream* nil)
-
-;;; Stuff we keep track of for the error log:
-
-(defvar functions-with-errors nil
-  "A list of all functions that did not compile properly due to errors in
-  the code.")
-
-(defvar error-count 0
-  "The number of errors generated during this compilation.")
-
-(defvar warning-count 0
-  "The number of warnings generated during this compilation.")
-
-(defvar unknown-functions nil
-  "List of functions called but not yet seen and not built-in.  The user
-  is informed of any function still on this list at the end of a file
-  compilation.")
-
-(defvar unknown-free-vars nil
-  "A list of all variables referenced free in the compilation, but not
-  bound or declared special anywhere.  These are assumed to be special
-  variables, but are listed in a warning message at the end of the
-  compilation.")
-
-(defvar *verbose* t
-  "If nil, only true error messages and warnings go to the error stream.
-  If non-null, prints a message as each function is compiled.")
-
-(defvar *compile-to-lisp* nil
-  "If non-null, stuff compiled definitions into the compiler's own Lisp
-  environment.")
-
-(defvar *clc-input-stream* nil)
-(defvar *input-filename* nil "Truename of file being compiled.")
-(defvar *compiler-is-reading* nil
-  "This is true only if we are actually doing a read from *clc-input-stream*.
-  #, (in the reader) looks at this.")
-
-  
-;;; The Line-Length of the lap stream...
-(defvar *lap-line-length*)
-
-;;; The defined-from string for functions defined in the current source file:
-(defvar *current-defined-from*)
-
-
-;;;; Error Reporting:
-
-;;; CLC-MUMBLE is just a format print to the error stream.
-
-(defun clc-mumble (string &rest args)
-  (when *clc-err-stream*
-    (apply #'format *clc-err-stream* string args)))
-
-
-;;; A COMMENT is something the user might like to know, but that will
-;;; probably not affect the correctness of his code.
-
-(defun clc-comment (string &rest args)
-  (when *clc-err-stream*
-    (if (or (not function-name) (eq function-name 'lisp::top-level-form))
-	(format *clc-err-stream* "Comment between functions:~%  ")
-	(format *clc-err-stream* "Comment in ~S:~%  " function-name))
-    (apply #'format *clc-err-stream* string args)
-    (terpri *clc-err-stream*)))
-
-
-;;; A WARNING is something suspicious in the user's code that probably
-;;; signals some form of lossage, but that may be ignored if the user
-;;; knows what he is doing.
-
-(defun clc-warning (string &rest args)
-  (when *clc-err-stream*
-    (incf warning-count)
-    (if (or (not function-name) (eq function-name 'lisp::top-level-form))
-	(format *clc-err-stream* "Warning between functions:~%  ")
-	(format *clc-err-stream* "Warning in ~S:~%  " function-name))
-    (apply #'format *clc-err-stream* string args)
-    (terpri *clc-err-stream*)))
-
-
-;;; An ERROR is a problem in the user's code that will definitely cause some
-;;; lossage.  The compiler attempts to go on with the compilation so that
-;;; as many errors as possible can be caught per compilation.
-
-(defun clc-error (string &rest args)
-  (when *clc-err-stream*
-    (incf error-count)
-    (cond ((or (not function-name) (eq function-name 'lisp::top-level-form))
-	   (format *clc-err-stream* "Error between functions:~%  ")
-	   (pushnew function-name functions-with-errors))
-	  (t
-	   (format *clc-err-stream* "Error in ~S:~%  " function-name)))
-    (apply #'format *clc-err-stream* string args)
-    (terpri *clc-err-stream*)))
-
-
-;;; Keep the internal real and run times in these vars so that we can report
-;;; the elapsed time.
-(defvar *start-real-time*)
-(defvar *start-run-time*)
-
-;;; Start-Assembly  --  Internal
-;;;
-;;;    This function is called before assembling each batch of stuff.  It
-;;; writes out the fasl file header and does other random stuff.  It is
-;;; assumed that all the streams are initialized at this point.
-;;;
-(defun start-assembly ()
-  (let* ((host (machine-instance))
-	 (now (get-universal-time))
-	 (now-string (universal-time-to-string now))
-	 (in-string (if *input-filename* (namestring *input-filename*)))
-	 (then (if *input-filename*
-		   (file-write-date *input-filename*)))
-	 (then-string (if then (universal-time-to-string then)))
-	 (where (cond ((not *clc-input-stream*)
-		       (format nil "Lisp on ~A, machine ~A" now-string host))
-		      (in-string
-		       (format nil "~A ~A" in-string now-string))
-		      ((not then)
-		       (format nil "~S on ~A, machine ~A" *clc-input-stream*
-			       now-string host))
-		      (t
-		       (format nil "~A ~A" in-string then-string)))))
-    
-    ;; Set the defined-from string:
-    (setq *current-defined-from* (format nil "~A ~D" where (or then now)))
-
-    (when *input-filename*
-      (setq *start-real-time* (get-internal-real-time))
-      (setq *start-run-time* (get-internal-run-time))
-      (clc-mumble "Error output from ~A.~@
-		  Compiled on ~A by CLC version ~A.~2%"
-		  where now-string compiler-version))
-
-    (when *clc-lap-stream*
-      (setq *lap-line-length* (or (lisp::line-length *clc-lap-stream*) 80))
-      (format *clc-lap-stream*
-	      "~:[Unreadble~;Readable~] LAP output from ~A.~@
-	      Compiled on ~A by CLC version ~A.~%"
-	      *print-readable-lap* where now-string compiler-version))
-  
-    (when *clc-fasl-stream*
-      (format *clc-fasl-stream* "FASL FILE output from ~A~@
-	      Compiled ~A on ~A~@
-	      Compiler ~A, Assembler ~A, Lisp ~A~@
-	      Targeted for ~A/~A, FASL code format ~D~%"
-	      where now-string host compiler-version assembler-version
-	      (lisp-implementation-version) target-machine target-system
-	      c::target-fasl-code-format)
-      (start-fasl-file))))
-
-;;; Also the ten-dozenth place this is defined...
-(defun universal-time-to-string (ut)
-  (multiple-value-bind (sec min hour day month year)
-		       (decode-universal-time ut)
-    (format nil "~D-~A-~2,'0D ~D:~2,'0D:~2,'0D"
-	    day (svref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
-			  "Sep" "Oct" "Nov" "Dec")
-		       (1- month))
-	    (rem year 100)
-	    hour min sec)))
-
-(defun elapsed-time-to-string (it)
-  (let ((tsec (truncate it internal-time-units-per-second)))
-    (multiple-value-bind (tmin sec)
-			 (truncate tsec 60)
-      (multiple-value-bind (thr min)
-			   (truncate tmin 60)
-	(format nil "~D:~2,'0D:~2,'0D" thr min sec)))))
-
-
-;;; Finish-Assembly  --  Internal
-;;;
-;;;
-(defun finish-assembly ()
-  (when *clc-fasl-stream* (terminate-fasl-file))
-  
-  ;; All done.  Let the post-mortems begin.
-  (when *input-filename*
-    (clc-mumble "~%Finished compilation of file ~S.~%"
-		(namestring *input-filename*))
-    (clc-mumble "~S Errors, ~S Warnings.~%" error-count warning-count)
-    (clc-mumble "Elapsed time ~A, run time ~A.~2%"
-		(elapsed-time-to-string (- (get-internal-real-time)
-					   *start-real-time*))
-		(elapsed-time-to-string (- (get-internal-run-time)
-					   *start-run-time*))))
-    
-  (when functions-with-errors
-    (clc-mumble "Errors were detected in the following functions:~% ~S~%"
-		(nreverse functions-with-errors)))
-  (when unknown-functions
-    (clc-mumble
-     "These symbols were called as functions but not declared or defined:~% ~S~%"
-     (nreverse unknown-functions)))
-  (do* ((p NIL)
-	(l unknown-free-vars (cdr l))
-	(a (car l) (car l)))
-       ((null l))
-    (if (get a 'globally-special-in-compiler)
-	(cond (p (rplacd p (cdr l))
-		 (setq l p))
-	      (T (setq unknown-free-vars (cdr l))
-		 (setq p NIL)))
-	(setq p l)))
-  (when unknown-free-vars
-    (clc-mumble
-     "The following variables, assumed to be special, are referenced~@
-     but never declared:~% ~S~%"
-     (nreverse unknown-free-vars))))
-
-;;;; Fasl dumping stuff:
-
-;;; Next slot to be filled in the fasload table.  Reset at the start of
-;;; each new FASL file.
-(defvar fop-table-counter 0)
-
-;;; For speed, we keep the table index for each symbol in a property
-;;; under that symbol, rather than in an A-list.  All the symbols with
-;;; FOP-TABLE-INDEX properties are kept on this list, so that we can
-;;; clean up when a new FASL file is started.
-(defvar fop-table-symbol-list nil)
-
-;;; FOP-TABLE-PACKAGE-LIST is an a-list mapping packages to their fop-table
-;;; indices.  Each entry is (package . index).
-(defvar fop-table-package-list nil)
-
-;;; When we dump lists and strings, we look for them in this hashtable.
-;;; If we find what we are looking for, we just push the thing from the
-;;; table.  If it isn't there, we dump the object and then enter it.
-(defvar *table-table* (make-hash-table :test #'equal))
-
-;;; If true, then we must dump stuff so that it neither adds to nor refers
-;;; the table.  This is used by the forms which need to be available
-;;; at cold load time.
-(defvar *hands-off-table* nil)
-
-;;; Dump a single byte to the *CLC-FASL-STREAM* file.  We buffer these until
-;;; we collect 512 of them, and then write-string them to the FASL stream.
-(defvar *dump-byte-buffer* (make-array 512 :element-type '(mod 256)))
-(defvar *dump-byte-index*)
-
-
-(defun dump-dump-byte-buffer ()
-  (write-string *dump-byte-buffer* *clc-fasl-stream*
-		:start 0 :end *dump-byte-index*)
-  (setq *dump-byte-index* 0))
-
-(defmacro dump-byte (b)
-  `(progn
-    (if (= *dump-byte-index* 512)
-	(dump-dump-byte-buffer))
-    (setf (aref *dump-byte-buffer* *dump-byte-index*) (logand ,b #x+FF))
-    (incf *dump-byte-index*)))
-
-
-;;; Put out the code for one FASL-format operator.
-
-(defun dump-fop (fs)
-  (let ((val (get fs 'lisp::fop-code)))
-    (if (null val)
-	(error "Compiler bug: ~S not a legal fasload operator." fs)
-	(dump-byte val))))
-
-
-(defmacro dump-fop* (n byte-fop word-fop)
-  `(cond ((< ,n 256)
-	  (dump-fop ',byte-fop)
-	  (dump-byte ,n))
-	 (t
-	  (dump-fop ',word-fop)
-	  (quick-dump-number ,n 4))))
-
-;;; Dump out number NUM as BYTES bytes.
-
-(defun quick-dump-number (num bytes)
-  (do ((n num (ash n -8))
-       (i bytes (1- i)))
-      ((= i 0))
-    (dump-byte (logand n #o377))))
-
-;;; Start-Fasl-File  --  Internal
-;;;
-;;;    Set up fasdumper state and finish off the header.  The "FASL FILE"
-;;; header should already be written.  Called by Start-Assembly.
-;;;
-(defun start-fasl-file ()
-  ;; We now have a virgin FOP-TABLE, so clean up any old stuff.
-  (setq fop-table-counter 0)
-  ;; Just in case this didn't get cleaned up after an earlier compile.
-  (cond (fop-table-symbol-list
-	 (do ((sl fop-table-symbol-list (cdr sl)))
-	     ((null sl) (setq fop-table-symbol-list nil))
-	   (remprop (car sl) 'lisp::fop-table-index))))
-  ;; Clear the package alist.
-  (setq fop-table-package-list nil)
-  ;; And the table hashtable.
-  (clrhash *table-table*)
-  ;; Reset the dump-byte buffer
-  (setq *dump-byte-index* 0)
-  ;; Print header stuff.
-  (dump-byte 255)
-  ;; Perq code format.
-  (dump-fop 'lisp::fop-code-format)
-  (dump-byte c::target-fasl-code-format))
-
-;;; Terminate-Fasl-File  --  Internal
-;;;
-;;;    Finish off the current fasl group and clean up.  Called from 
-;;; Finish-Assembly.
-;;;
-(defun terminate-fasl-file ()
-  (dump-fop 'lisp::fop-verify-empty-stack)
-  (dump-fop 'lisp::fop-verify-table-size)
-  (quick-dump-number fop-table-counter 4)
-  (dump-fop 'lisp::fop-end-group)
-  (dump-dump-byte-buffer)
-  (do ((sl fop-table-symbol-list (cdr sl)))
-      ((null sl) (setq fop-table-symbol-list nil))
-    (remprop (car sl) 'lisp::fop-table-index)))
-  
-;;; Fasl-Dump-Cold-Load-Form  --  Internal
-;;;
-;;;    Similar to fasl-dump-form, except that the form is to be evaluated
-;;; at cold load time when in cold load.  This is used to dump package
-;;; frobbing forms.
-;;;
-(defun fasl-dump-cold-load-form (form)
-  (dump-fop 'lisp::fop-normal-load)
-  (let ((*hands-off-table* t))
-    (dump-object form))
-  (dump-fop 'lisp::fop-eval-for-effect)
-  (dump-fop 'lisp::fop-maybe-cold-load))
-
-
-;;; Dump-Object  -- Internal
-;;;
-;;;    Dump an object of any type.  This function dispatches to the correct
-;;; type-specific dumping function.  Table entry and lookup for non-immediate
-;;; objects other than lists and symbols is done here.
-;;;
-(defun dump-object (x)
-  (cond
-   ((listp x)
-    (cond ((null x)
-	   (dump-fop 'lisp::fop-empty-list))
-	  ((eq (car x) '%eval-at-load-time)
-	   (load-time-eval x))
-	  (t
-	   (dump-list x))))
-   ((symbolp x)
-    (if (eq x t) 
-	(dump-fop 'lisp::fop-truth)
-	(dump-symbol x)))
-   ((fixnump x) (dump-integer x))
-   ((characterp x) (dump-character x))
-   ((typep x 'short-float) (dump-short-float x))
-   (t
-    ;;
-    ;; Look for it in the table; if it is there, push it, otherwise
-    ;; dump it.
-    (let ((index (gethash x *table-table*)))
-      (cond
-       ((and index (not *hands-off-table*))
-	(dump-fop* index lisp::fop-byte-push lisp::fop-push))
-       (t
-	(typecase x
-	  (vector
-	   (cond ((stringp x) (dump-string x))
-		 ((subtypep (array-element-type x) '(unsigned-byte 16))
-		  (dump-i-vector x))
-		 (t
-		  (dump-vector x))))
-	  (array (dump-array x))
-	  (number
-	   (etypecase x
-	     (ratio (dump-ratio x))
-	     (complex (dump-complex x))
-;	     (single-float (dump-single-float x))
-	     (long-float (dump-long-float x))
-	     (integer (dump-integer x))))
-	  (compiled-function (dump-function x))
-	  (t
-	   (clc-error "This object cannot be dumped into a fasl file:~%  ~S" x)
-	   (dump-object nil)))
-	;;
-	;; If wasn't in the table, put it there...
-	(unless *hands-off-table*
-	  (dump-fop 'lisp::fop-pop)
-	  (dump-fop* fop-table-counter lisp::fop-byte-push lisp::fop-push)
-	  (setf (gethash x *table-table*) fop-table-counter)
-	  (incf fop-table-counter))))))))
-
-;;;; Number Dumping:
-
-;;; Dump a ratio
-
-(defun dump-ratio (x)
-  (dump-object (numerator x))
-  (dump-object (denominator x))
-  (dump-fop 'lisp::fop-ratio))
-
-;;; Or a complex...
-
-(defun dump-complex (x)
-  (dump-object (realpart x))
-  (dump-object (imagpart x))
-  (dump-fop 'lisp::fop-complex))
-
-;;; Dump an integer.
-
-(defun dump-integer (n)
-  (let* ((bytes (compute-bytes n)))
-    (cond ((= bytes 1)
-	   (dump-fop 'lisp::fop-byte-integer)
-	   (dump-byte n))
-	  ((< bytes 5)
-	   (dump-fop 'lisp::fop-word-integer)
-	   (quick-dump-number n 4))
-	  ((< bytes 256)
-	   (dump-fop 'lisp::fop-small-integer)
-	   (dump-byte bytes)
-	   (quick-dump-number n bytes))
-	  (t (dump-fop 'lisp::fop-integer)
-	     (quick-dump-number bytes 4)
-	     (quick-dump-number n bytes)))))
-
-;;; Compute how many bytes it will take to represent signed integer N.
-
-(defun compute-bytes (n)
-  (truncate (+ (integer-length n) 8) 8))
-
-;;;
-;;; These two are almost exactly alike, and could easily be the same function.
-
-(defun dump-short-float (x)
-  (multiple-value-bind (f exponent sign) (decode-float x)
-    (let ((mantissa (truncate (scale-float (* f sign) (float-precision f)))))
-      (dump-fop 'lisp::fop-float)
-      (dump-byte (1+ (integer-length exponent)))
-      (quick-dump-number exponent (compute-bytes exponent))
-      (dump-byte (1+ (integer-length mantissa)))
-      (quick-dump-number mantissa (compute-bytes mantissa)))))
-
-#|
-(defun dump-single-float (x)
-  (multiple-value-bind (f exponent sign) (decode-float x)
-    (let ((mantissa (truncate (scale-float (* f sign) (float-precision f)))))
-      (dump-fop 'lisp::fop-float)
-      (dump-byte (1+ (integer-length exponent)))
-      (dump-byte exponent)
-      (dump-byte (1+ (integer-length mantissa)))
-      (quick-dump-number mantissa (compute-bytes mantissa)))))
-|#
-;;; For long-floats we're careful that the dumped mantissa actually
-;;; has 63 significant bits, so the fasloader can recognize it as such.
-
-(defun dump-long-float (x)
-  (multiple-value-bind (f exponent sign) (decode-float x)
-    (let ((mantissa (truncate (scale-float (* f sign) (float-precision f)))))
-      (dump-fop 'lisp::fop-float)
-      (dump-byte (1+ (integer-length exponent)))
-      (quick-dump-number exponent (compute-bytes exponent))
-      (dump-byte (1+ (integer-length mantissa)))
-      (quick-dump-number mantissa (compute-bytes mantissa)))))
-
-;;;; Symbol Dumping:
-
-(defun dump-symbol (s)
-  (let ((number (get s 'lisp::fop-table-index)))
-    (if (and number (not *hands-off-table*))
-	;; Symbol is already in the table.  Just dump the index.
-	(dump-fop* number lisp::fop-byte-push lisp::fop-push)
-	;; Got to dump the symbol and put it into the table.
-	(let* ((pname (symbol-name s))
-	       (pname-length (length pname))
-	       (pkg (symbol-package s)))
-	  (cond ((null pkg)
-		 ;; Symbol is uninterned.
-		 (dump-fop* pname-length lisp::fop-uninterned-small-symbol-save
-			    lisp::fop-uninterned-symbol-save))
-		((eq pkg *package*)
-		 ;; Symbol is in current default package.  Just dump it.
-		 (dump-fop* pname-length lisp::fop-small-symbol-save
-			    lisp::fop-symbol-save))
-		((eq pkg *lisp-package*)
-		 (dump-fop* pname-length lisp::fop-lisp-small-symbol-save
-			    lisp::fop-lisp-symbol-save))
-		((eq pkg *keyword-package*)
-		 ;; Symbol is in current default package.  Just dump it.
-		 (dump-fop* pname-length lisp::fop-keyword-small-symbol-save
-			    lisp::fop-keyword-symbol-save))
-		(t
-		 ;; We have to dump this symbol with a package specifier.
-		 (let ((entry (assq pkg fop-table-package-list)))
-		   ;; Put the package into the table unless it's already there.
-		   (unless entry
-		     (unless *hands-off-table*
-		       (dump-fop 'lisp::fop-normal-load))
-		     (dump-string (package-name pkg))
-		     (dump-fop 'lisp::fop-package)
-		     (dump-fop 'lisp::fop-pop)
-		     (unless *hands-off-table*
-		       (dump-fop 'lisp::fop-maybe-cold-load))
-		     (setq entry (cons pkg fop-table-counter))
-		     (push entry fop-table-package-list)
-		     (incf fop-table-counter))
-		   (setq entry (cdr entry))
-		   (cond
-		    ((< pname-length 256)
-		     (dump-fop* entry
-				lisp::fop-small-symbol-in-byte-package-save
-				lisp::fop-small-symbol-in-package-save)
-		     (dump-byte pname-length))
-		    (t
-		     (dump-fop* entry
-				lisp::fop-symbol-in-byte-package-save
-				lisp::fop-symbol-in-package-save)
-		     (quick-dump-number pname-length 4))))))
-	  ;; Finish dumping the symbol and put it in table.
-	  (do ((index 0 (1+ index)))
-	      ((= index pname-length))
-	    (dump-byte (char-code (schar pname index))))
-	  (unless *hands-off-table*
-	    (setf (get s 'lisp::fop-table-index) fop-table-counter))
-	  (push s fop-table-symbol-list)
-	  (setq fop-table-counter (1+ fop-table-counter))))))
-
-;;; Dumper for lists.
-
-(defun dump-list (list)
-  (if (null list)
-      (dump-fop 'lisp::fop-empty-list)
-      (let ((index (gethash list *table-table*)))
-	(cond ((and index (not *hands-off-table*))
-	       (dump-fop* index lisp::fop-byte-push lisp::fop-push))
-	      (t
-	       (do ((l list (cdr l))
-		    (n 0 (1+ n)))
-		   ((atom l)
-		    (cond ((null l)
-			   (terminate-undotted-list n))
-			  (t (dump-object l)
-			     (terminate-dotted-list n))))
-		 (dump-object (car l)))
-	       (unless *hands-off-table*
-		 (dump-fop 'lisp::fop-pop)
-		 (dump-fop* fop-table-counter lisp::fop-byte-push
-			    lisp::fop-push)
-		 (setf (gethash list *table-table*) fop-table-counter)
-		 (incf fop-table-counter)))))))
-
-(defun terminate-dotted-list (n)
-  (case n
-    (1 (dump-fop 'lisp::fop-list*-1))
-    (2 (dump-fop 'lisp::fop-list*-2))
-    (3 (dump-fop 'lisp::fop-list*-3))
-    (4 (dump-fop 'lisp::fop-list*-4))
-    (5 (dump-fop 'lisp::fop-list*-5))
-    (6 (dump-fop 'lisp::fop-list*-6))
-    (7 (dump-fop 'lisp::fop-list*-7))
-    (8 (dump-fop 'lisp::fop-list*-8))
-    (T (do ((nn n (- nn 255)))
-	   ((< nn 256)
-	    (dump-fop 'lisp::fop-list*)
-	    (dump-byte nn))
-	 (dump-fop 'lisp::fop-list*)
-	 (dump-byte 255)))))
-
-;;; If N > 255, must build list with one list operator, then list* operators.
-
-(defun terminate-undotted-list (n)
-    (case n
-      (1 (dump-fop 'lisp::fop-list-1))
-      (2 (dump-fop 'lisp::fop-list-2))
-      (3 (dump-fop 'lisp::fop-list-3))
-      (4 (dump-fop 'lisp::fop-list-4))
-      (5 (dump-fop 'lisp::fop-list-5))
-      (6 (dump-fop 'lisp::fop-list-6))
-      (7 (dump-fop 'lisp::fop-list-7))
-      (8 (dump-fop 'lisp::fop-list-8))
-      (T (cond ((< n 256)
-		(dump-fop 'lisp::fop-list)
-		(dump-byte n))
-	       (t (dump-fop 'lisp::fop-list)
-		  (dump-byte 255)
-		  (do ((nn (- n 255) (- nn 255)))
-		      ((< nn 256)
-		       (dump-fop 'lisp::fop-list*)
-		       (dump-byte nn))
-		    (dump-fop 'lisp::fop-list*)
-		    (dump-byte 255)))))))
-
-;;;; Array dumping:
-
-;;; Named G-vectors get their subtype field set at load time.
-
-(defun dump-vector (obj)
-  (cond ((and (simple-vector-p obj)
-	      (= (%primitive get-vector-subtype obj)
-		 %g-vector-structure-subtype))
-	 (normal-dump-vector obj)
-	 (dump-fop 'lisp::fop-structure))
-	(t
-	 (normal-dump-vector obj))))
-
-(defun normal-dump-vector (v)
-  (do ((index 0 (1+ index))
-       (length (length v)))
-      ((= index length)
-       (dump-fop* length lisp::fop-small-vector lisp::fop-vector))
-    (dump-object (aref v index))))
-
-;;; Dump a string.
-
-(defun dump-string (s)
-  (let ((length (length s)))
-    (dump-fop* length lisp::fop-small-string lisp::fop-string)
-    (dotimes (i length)
-      (dump-byte (char-code (char s i))))))
-
-;;; Dump-Array  --  Internal
-;;;
-;;;    Dump a multi-dimensional array.  Someday when we figure out what
-;;; a displaced array looks like, we can fix this.
-;;;
-(defun dump-array (array)
-  (unless (zerop (%primitive header-ref array %array-displacement-slot))
-    (clc-error "Attempt to dump an array with a displacement, you lose big.")
-    (dump-object nil)
-    (return-from dump-array nil))
-
-  (let ((rank (array-rank array)))
-    (dotimes (i rank)
-      (dump-integer (array-dimension array i)))
-    (dump-object (%primitive header-ref array %array-data-slot))
-    (dump-fop 'lisp::fop-array)
-    (quick-dump-number rank 4)))
-
-
-;;; Dump a character.
-
-(defun dump-character (ch)
-  (cond
-   ((string-char-p ch)
-    (dump-fop 'lisp::fop-short-character)
-    (dump-byte (char-code ch)))
-   (t
-    (dump-fop 'lisp::fop-character)
-    (dump-byte (char-code ch))
-    (dump-byte (char-bits ch))
-    (dump-byte (char-font ch)))))
-
diff --git a/assembler/assembler.lisp b/assembler/assembler.lisp
deleted file mode 100644
index ebe8ad70c..000000000
--- a/assembler/assembler.lisp
+++ /dev/null
@@ -1,1693 +0,0 @@
-;;; -*- Mode: Lisp; Package: Compiler; Log: clc.log -*-
-;;;
-;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
-;;; **********************************************************************
-;;;
-;;; A user-level assembler for the ROMP.
-;;; Written by Skef Wholey.
-;;;
-;;; This program processes a file of lispy assembly code and produces a Lisp
-;;; FASL file.  It will be used primarily for coding the assembler support
-;;; routines, but later might be used by applications programmers to speed up
-;;; inner loops.
-;;;
-;;; The file to be assembled consists of Lisp forms.  Most forms are simply
-;;; evaluated -- macro definitions, constant declarations, and things like that
-;;; are made this way.  Three forms are treated specially:
-;;;   Define-Miscop, which defines a miscop,
-;;;   Define-Assembler-Routine, which defines a random piece of assembly code,
-;;;   Defun-In-Assembly-Code, which defines a Lisp-callable function.
-;;;
-(in-package "COMPILER")
-
-(export 'assemble-file)
-
-(import '(lisp::define-fop lisp::fop-assembler-routine
-			   lisp::fop-fixup-miscop-routine
-			   lisp::fop-fixup-user-miscop-routine
-			   lisp::fop-fixup-assembler-routine
-			   lisp::fop-fun)
-	(find-package 'compiler))
-
-;;; %%% Unixfy external definitions, references
-;;; %%% Possibly help enforce 8 character uniqueness lossage
-;;; %%% Data blocks
-;;; %%% Tied down things
-
-
-(defvar *undefined-labels* ()
-  "List of all undefined labels in the current file.")
-
-(defvar *defined-labels* ()
-  "List of all defined labels in the current file.")
-
-(defparameter romp-assembler-version "1.0")
-
-;;; The ROMP instruction set database for the user-level assembler.
-
-;;; All the stuff we need to know about an instruction is held in a structure
-;;; hanging off of its %Instruction-Info property.
-
-(defstruct (romp-info (:print-function print-romp-info)
-		      (:constructor make-romp-info (name format opcode)))
-  name				; symbolic name
-  format			; ROMP format
-  opcode)			; numeric opcode
-
-(defun print-romp-info (structure stream depth)
-  (declare (ignore depth))
-  (format stream "#<The ~S instruction>" (romp-info-name structure)))
-
-(defmacro def-romp-instr (name format opcode)
-  `(setf (get ',name '%instruction-info)
-	 (make-romp-info ',name ',format ,opcode)))
-
-
-;;; The half dozen "instruction formats" described in the ROMP architecture
-;;; guide aren't really sufficient for our purposes -- we've added a couple.
-;;; The formats are:
-;;;	JI  4 bit opcode, 4 bit N, 8 bits jump offset
-;;;     X   4 bit opcode, 3 register fields
-;;;     DS  4 bit opcode, 4 bit N, 2 registers
-;;;	R   8 bit opcode, 2 registers
-;;;	R1  8 bit opcode, 4 bit N, 1 register
-;;;	R2  8 bit opcode, 1 register, 4 bit N
-;;;     BI  8 bit opcode, 1 register, 20 bits jump offset
-;;;	BA  8 bit opcode, 24 bits absolute jump address
-;;;	D   8 bit opcode, 2 registers, 16 bit N
-;;;	SR  12 bit opcode, 1 register
-;;;	SN  12 bit opcode, 4 bit N
-
-
-;;; Storage Access instructions:
-
-(def-romp-instr lcs  ds #x04)
-(def-romp-instr lc   d  #xCE)
-(def-romp-instr lhas ds #x05)
-(def-romp-instr lha  d  #xCA)
-(def-romp-instr lhs  r  #xEB)
-(def-romp-instr lh   d  #xDA)
-(def-romp-instr ls   ds #x07)
-(def-romp-instr l    d  #xCD)
-(def-romp-instr lm   d  #xC9)
-(def-romp-instr tsh  d  #xCF)
-(def-romp-instr stcs ds #x01)
-(def-romp-instr stc  d  #xDE)
-(def-romp-instr sths ds #x02)
-(def-romp-instr sth  d  #xDC)
-(def-romp-instr sts  ds #x03)
-(def-romp-instr st   d  #xDD)
-(def-romp-instr stm  d  #xD9)
-
-;;; Address Computation instructions:
-
-(def-romp-instr cal  d  #xC8)
-(def-romp-instr cal16 d #xC2)
-(def-romp-instr cau  d  #xD8)
-(def-romp-instr cas  x  #x06)
-(def-romp-instr ca16 r  #xF3)
-(def-romp-instr inc  r2 #x91)
-(def-romp-instr dec  r2 #x93)
-(def-romp-instr lis  r2 #xA4)
- 
-;;; Branching instructions:
-
-(def-romp-instr bala ba #x8A)
-(def-romp-instr balax ba #x8B)
-(def-romp-instr bali bi #x8C)
-(def-romp-instr balix bi #x8D)
-(def-romp-instr balr r  #xEC)
-(def-romp-instr balrx r #xED)
-(def-romp-instr jb   ji #x01)
-(def-romp-instr bb   bi #x8E)
-(def-romp-instr bbx  bi #x8F)
-(def-romp-instr bbr  r1 #xEE)
-(def-romp-instr bbrx r1 #xEF)
-(def-romp-instr jnb  ji #x00)
-(def-romp-instr bnb  bi #x88)
-(def-romp-instr bnbx bi #x89)
-(def-romp-instr bnbr r  #xE8)
-(def-romp-instr bnbrx r  #xe9)
-
-;;; Trap instructions:
-
-(def-romp-instr ti   d  #xCC)
-(def-romp-instr tgte r  #xBD)
-(def-romp-instr tlt  r  #xBE)
-
-;;; Move and Insert instructions.
-
-(def-romp-instr mc03 r  #xF9)
-(def-romp-instr mc13 r  #xFA)
-(def-romp-instr mc23 r  #xFB)
-(def-romp-instr mc33 r  #xFC)
-(def-romp-instr mc30 r  #xFD)
-(def-romp-instr mc31 r  #xFE)
-(def-romp-instr mc32 r  #xFF)
-(def-romp-instr mftb r  #xBC)
-(def-romp-instr mftbil r2 #x9D)
-(def-romp-instr mftbiu r2 #x9C)
-(def-romp-instr mttb r  #xBF)
-(def-romp-instr mttbil r2 #x9F)
-(def-romp-instr mttbiu r2 #x9E)
-
-;;; Arithmetic instructions.
-
-(def-romp-instr a    r  #xE1)
-(def-romp-instr ae   r  #xF1)
-(def-romp-instr aei  d  #xD1)
-(def-romp-instr ai   d  #xC1)
-(def-romp-instr ais  r2 #x90)
-(def-romp-instr abs  r  #xE0)
-(def-romp-instr onec r  #xF4)
-(def-romp-instr twoc r  #xE4)
-(def-romp-instr c    r  #xB4)
-(def-romp-instr cis  r2 #x94)
-(def-romp-instr ci   d  #xD4)
-(def-romp-instr cl   r  #xB3)
-(def-romp-instr cli  d  #xD3)
-(def-romp-instr exts r  #xB1)
-(def-romp-instr s    r  #xE2)
-(def-romp-instr sf   r  #xB2)
-(def-romp-instr se   r  #xF2)
-(def-romp-instr sfi  d  #xD2)
-(def-romp-instr sis  r2 #x92)
-(def-romp-instr d    r  #xB6)
-(def-romp-instr m    r  #xE6)
-
-;;; Logical instructions.
-
-(def-romp-instr clrbl r2 #x99)
-(def-romp-instr clrbu r2 #x98)
-(def-romp-instr setbl r2 #x9B)
-(def-romp-instr setbu r2 #x9A)
-(def-romp-instr n     r  #xE5)
-(def-romp-instr nilz  d  #xC5)
-(def-romp-instr nilo  d  #xC6)
-(def-romp-instr niuz  d  #xD5)
-(def-romp-instr niuo  d  #xD6)
-(def-romp-instr o     r  #xE3)
-(def-romp-instr oil   d  #xC4)
-(def-romp-instr oiu   d  #xC3)
-(def-romp-instr x     r  #xE7)
-(def-romp-instr xil   d  #xC7)
-(def-romp-instr xiu   d  #xD7)
-(def-romp-instr clz   r  #xF5)
-
-;;; Shifting instructions.
-
-(def-romp-instr sar   r  #xB0)
-(def-romp-instr sari  r2 #xA0)
-(def-romp-instr sari16 r2 #xA1)
-(def-romp-instr sr    r  #xB8)
-(def-romp-instr sri   r2 #xA8)
-(def-romp-instr sri16 r2 #xA9)
-(def-romp-instr srp   r  #xB9)
-(def-romp-instr srpi  r2 #xAC)
-(def-romp-instr srpi16 r2 #xAD)
-(def-romp-instr sl    r  #xBA)
-(def-romp-instr sli   r2 #xAA)
-(def-romp-instr sli16 r2 #xAB)
-(def-romp-instr slp   r  #xBB)
-(def-romp-instr slpi  r2 #xAE)
-(def-romp-instr slpi16 r2 #xAF)
-
-;;; Special Purpose Register Manipulation instructions.
-
-(def-romp-instr mtmq  sr #xB5A)
-(def-romp-instr mfmq  sr #x96A)
-(def-romp-instr mtcsr sr #xB5F)
-(def-romp-instr mfcsr sr #x96F)
-(def-romp-instr clrcb sn #x95F)
-(def-romp-instr setcb sn #x97F)
-
-;;; Execution Control instructions.
-
-(def-romp-instr lps   d  #xD0)
-(def-romp-instr svc   d  #xC0)
-
-(defvar *produce-unixy-cruft* nil
-  "If T, the LAP file will have stuff that should be legal food for a unixy
-  assembler.")
-
-
-;;; PRINT-FILE-HEADER prints assorted information at the start of an
-;;; ascii output file.
-
-(defun print-file-header (stream output-type input-namestring)
-  (format stream
-	  "~%;;; ~A output for file ~A."
-	  output-type input-namestring)
-  (format stream
-	  "~%;;; Assembled by assembler version ~A.~%"
-	  romp-assembler-version))
-
-(defun assemble-file (input-pathname
-		      &key (output-file t) (error-file t) (listing-file nil)
-		           ((:unixy-lap-file *produce-unixy-cruft*) nil))
-  "Assembles the file named by the Input-Pathname."
-  (declare (optimize (speed 3) (safety 0)))
-  (let* ((*clc-input-stream*
-	  (open (merge-pathnames input-pathname ".romp") :direction :input))
-	 (*clc-fasl-stream*
-	  (if output-file
-	      (open (if (eq output-file t)
-			(make-pathname :defaults input-pathname :type "fasl")
-			output-file)
-		    :if-exists :rename-and-delete
-		    :direction :output
-		    :element-type '(unsigned-byte 8))))
-	 (error-file-stream
-	  (if error-file
-	      (open (if (eq error-file t)
-			(make-pathname :defaults input-pathname :type "err")
-			error-file)
-		    :if-exists :rename-and-delete
-		    :direction :output)))
-	 (*clc-err-stream*
-	  (if error-file
-	      (make-broadcast-stream error-file-stream *standard-output*)
-	      *standard-output*))
-	 (*clc-lap-stream*
-	  (if listing-file
-	      (open (if (eq listing-file t)
-			(make-pathname :defaults input-pathname
-				       :type (if *produce-unixy-cruft*
-						 "s"
-						 "list"))
-			listing-file)
-		    :if-exists :rename-and-delete
-		    :direction :output)))
-	 (error-count 0)
-	 (warning-count 0)
-	 (assembly-won nil)
-	 (input-namestring (namestring input-pathname))
-	 (*defined-labels* ())
-	 (*undefined-labels* ())
-	 (*package* (find-package "COMPILER")))
-    (unwind-protect
-      (progn
-	;; Initialize the files.
-	(when output-file
-	  (format *clc-fasl-stream*
-		  "FASL FILE output from ~A~%" input-namestring)
-	  (start-fasl-file)
-	  (fasl-dump-cold-load-form '(in-package "COMPILER")))
-	(if error-file
-	    (print-file-header error-file-stream "Error" input-namestring))
-	(if (and listing-file (not *produce-unixy-cruft*))
-	    (print-file-header *clc-lap-stream* "Listing" input-namestring))
-	;; All set up.  Let the festivities begin.	    
-	(clc-mumble "~%Starting assembly of file ~S.~%" input-namestring)
-	(assembler-loop)
-	;; All done.  Let the post-mortems begin.
-	(clc-mumble "~2%Finished assembly of file ~S." input-namestring)
-	(clc-mumble "~%~S Errors, ~S Warnings." error-count warning-count)
-	(dolist (label *defined-labels*)
-	  (setq *undefined-labels*
-		(delete label *undefined-labels* :test #'eq)))
-	(if (> (length *undefined-labels*) 0)
-	    (clc-mumble "~%~S Undefined labels in file ~S: ~{~%	~S~}."
-			(length *undefined-labels*) input-namestring
-			*undefined-labels*))
-	(terpri)
-	(setq assembly-won t))
-      ;; Close files.  Unwind-Protect makes sure that these get closed even
-      ;; if compilation is aborted.  If the assembly did not win, abort the fasl
-      ;; file instead of writing out a whole lot of useless stuff.
-      (close *clc-input-stream*)
-      (when (streamp *clc-fasl-stream*)
-	(terminate-fasl-file)
-	(close *clc-fasl-stream* :abort (not assembly-won)))
-      (when error-file-stream (close error-file-stream))
-      (when (streamp *clc-lap-stream*) (close *clc-lap-stream*)))))
-
-(defvar *unique-thing* '(*unique-thing*))
-
-(defun assembler-loop ()
-  (do ((form (read *clc-input-stream* nil *unique-thing*)
-	     (read *clc-input-stream* nil *unique-thing*)))
-      ((eq form *unique-thing*))
-    (process-assembler-form form)))
-
-(defun process-assembler-form (form)
-  (declare (optimize (speed 3) (safety 0)))
-  (cond ((atom form))
-	((eq (car form) 'define-miscop)
-	 (process-define-miscop form))
-	((eq (car form) 'define-user-miscop)
-	 (process-define-user-miscop form))
-	((eq (car form) 'define-assembler-routine)
-	 (process-define-assembler-routine form))
-	((eq (car form) 'defun-in-assembly-code)
-	 (process-defun-in-assembly-code form))
-	((macro-function (car form))
-	 (process-assembler-form (macroexpand form)))
-	((or (functionp (car form)) (special-form-p (car form)))
-	 (eval form))
-	(t
-	 (eval form))))
-
-;;; There are three kinds of labels:
-;;;  Local labels, which are used within a miscop or routine.
-;;;  External labels, which are used between routines.
-;;;  Absolute labels, which might not be used at all.
-;;;
-;;; Labels appear as symbols in the code, and information about a label is
-;;; stored on that symbol's property list.  The kind of label, either LOCAL,
-;;; EXTERNAL, or ABSOLUTE, is store on the %LABEL-KIND property.  The location
-;;; of the label, is stored on the %LABEL-LOCATION property.  For local labels,
-;;; the location is the offset in halfwords from the beginning of the routine.
-;;; The locations of external labels is left unresolved until load time.  The
-;;; location of absolute labels the byte address of the code they address.
-;;;
-;;; Labels may be referenced in one of four ways:
-;;;  JI, which means the reference is from a JI relative branch instruction.
-;;;  BI, which means the reference is from a BI relative branch instruction.
-;;;  BA, which means the reference is from a BA absolute branch instruction.
-;;;  L, which means the reference is from a pair of CA instructions.
-;;;
-;;; When each routine is assembled and dumped, the locations of any external
-;;; labels defined in it are also dumped.  The locations of any external labels
-;;; it defines are dumped as well.  When all files making up the system are
-;;; loaded, the routines are "linked" by resolving the external references.
-
-
-(defvar *local-labels* ()
-  "List of labels local to this routine.")
-
-(defvar *external-labels* ()
-  "List of external labels defined by this routine.  Each definition is of the
-  form (Label . Location).")
-
-(defvar *external-references* ()
-  "List of external references made by this routine.  Each reference is of the
-  form (Type Label Location).")
-
-;;; Define-XXX-Label defines a label at the given location.
-
-(defun define-local-label (label location)
-  (declare (optimize (speed 3) (safety 0)))
-  (when (get label '%label-kind)
-    (clc-error "~S is already a defined label." label))
-  (push label *local-labels*)
-  (push label *defined-labels*)
-  (setf (get label '%label-kind) 'local)
-  (setf (get label '%label-location) location))
-
-(defun define-external-label (label location)
-  (declare (optimize (speed 3) (safety 0)))
-  (when (get label '%label-kind)
-    (clc-error "~S is already a defined label." label))
-  (push (cons label location) *external-labels*)
-  (push label *defined-labels*)
-  (setf (get label '%label-kind) 'external)
-  (setf (get label '%label-location) location))
-
-
-;;; Reference-Label references a label in the given way.  If a location can
-;;; sensibly be returned, it is.  Otherwise, 0 is returned and the reference
-;;; is added to the list of references to be resolved at load time.  The
-;;; Location parameter is the halfword offset in the current routine at
-;;; which the reference is made.
-
-(defun reference-label (label how location)
-  (declare (optimize (speed 3) (safety 0)))
-  (when (and (not (memq label *defined-labels*))
-	     (not (memq label *undefined-labels*)))
-    (push label *undefined-labels*))
-  (case (get label '%label-kind)
-    ((local external)			; treated the same at this point
-     (case how
-       ((bi ji)
-	(get label '%label-location))
-       ((ba l)
-	(push `(,how ,label ,location)
-	      *external-references*)
-	0)))
-    (absolute
-     (case how
-       ((bi ji)
-	(push `(,how ,label ,location)
-	      *external-references*)
-	0)
-       ((ba l)
-	(get label '%label-location))))
-    (T
-     (push `(,how ,label ,location) *external-references*)
-     0)))
-
-
-;;; Short-Jump-P is used by the jump optimizer to determine if a branch can be
-;;; turned into a Jump.  The Location of the branching instruction and the
-;;; label that is the destination of the jump are given.  Note that if the thing
-;;; is 128 words away, we'll be able to short jump to it after the halfword is
-;;; optimizied out of the branching instruction.
-
-(defun short-jump-p (location label)
-  (declare (fixnum location))
-  (case (get label '%label-kind)
-    ((local external)
-     (<= -128 (the fixnum (- (the fixnum (get label '%label-location))
-			     location)) 128))
-    (t
-     nil)))
-
-
-;;; Clean-Up-Labels nukes the properties of labels defined in the
-;;; current routine.
-
-(defun clean-up-labels ()
-  (declare (optimize (speed 3) (safety 0)))
-  (dolist (label *local-labels*)
-    (remprop label '%label-kind)
-    (remprop label '%label-location))
-  (dolist (label *external-labels*)
-    (remprop (car label) '%label-kind)
-    (remprop (car label) '%label-location)))
-
-;;; Process-XXX does a little special stuff and calls Assemble-Top-Level-List
-;;; to spit out code.
-
-(defun process-define-miscop (form)
-  (let ((function-name (cadr form))
-	(*local-labels* '())
-	(*external-labels* '())
-	(*external-references* '())
-	(body (cddr form)))
-    (define-external-label function-name 0)
-    (unwind-protect
-      (assemble-top-level-list function-name body)
-      (clean-up-labels))
-    (dump-fop 'lisp::fop-fixup-miscop-routine)
-    (clc-mumble "~%~S assembled." function-name)))
-
-(defun process-define-user-miscop (form)
-  (let ((function-name (cadr form))
-	(*local-labels* '())
-	(*external-labels* '())
-	(*external-references* '())
-	(body (cddr form)))
-    (define-external-label function-name 0)
-    (unwind-protect
-      (assemble-top-level-list function-name body)
-      (clean-up-labels))
-    (dump-fop 'lisp::fop-fixup-user-miscop-routine)
-    (clc-mumble "~%~S assembled." function-name)))
-
-(defun process-define-assembler-routine (form)
-  (let ((function-name (cadr form))
-	(*local-labels* '())
-	(*external-labels* '())
-	(*external-references* '())
-	(body (cddr form)))
-    (define-external-label function-name 0)
-    (unwind-protect
-      (assemble-top-level-list function-name body)
-      (clean-up-labels))
-    (dump-fop 'lisp::fop-fixup-assembler-routine)
-    (clc-mumble "~%~S assembled." function-name)))
-
-(defun process-defun-in-assembly-code (form)
-  (declare (ignore form))
-  (clc-error "Defun-In-Assembly-Code is not yet implemented."))
-
-;;; Pass 1.  We just fly down the list, expanding macros and finding addresses
-;;; of the labels.  The macroexpanded code is put into *pass1-list*.  Each
-;;; element of that list is either a cons of the instruction's byte offset from
-;;; the start of the routine and the instruction or a label.
-
-(defvar *pass1-list* '())
-
-;;; Assemble-Top-Level-List performs both passes, writing out the length in
-;;; bytes of the function before anything else.  The Process-mumbles count on
-;;; the length in bytes to be written out that way.
-
-(defun assemble-top-level-list (function-name list)
-  (let ((*pass1-list* '()))
-    (do ((list list (cdr list))
-	 (location 0))
-	((null list)
-	 (setq *pass1-list* (nreverse *pass1-list*))
-	 (setq location (optimize-jumps location))
-	 (dump-fop 'lisp::fop-assembler-routine)
-	 (quick-dump-number (ash location 1) 4)
-	 (pass2-top-level-list)
-	 (let ((*hands-off-table* t))
-	   (dump-fop 'lisp::fop-normal-load)
-	   (dump-object function-name)
-	   (dump-object *external-labels*)
-	   (dump-object *external-references*)
-	   (dump-fop 'lisp::fop-maybe-cold-load)))
-      (setq location (assemble-one-instruction (car list) location)))))
-
-;;; Symbols in the instruction list are labels -- keywords are external labels.
-;;; Lists that don't begin with an instruction mnemonic are macroexpanded and
-;;; expected to return a list of instructions.
-
-(defun assemble-one-instruction (inst location)
-  (declare (optimize (speed 3) (safety 0)))
-  (cond ((atom inst)
-	 (if (keywordp inst)
-	     (define-external-label inst location)
-	     (define-local-label inst location))
-	 (push inst *pass1-list*))
-	(t
-	 (let ((info (get (car inst) '%instruction-info)))
-	   (cond (info
-		  (push (cons location inst) *pass1-list*)
-		  (case (romp-info-format info)
-		    ((ji x ds r r1 r2 sr sn)
-		     (setq location (+ location 1)))
-		    ((bi ba d)
-		     (setq location (+ location 2)))))
-		 ((macro-function (car inst))
-		  (dolist (inst (macroexpand inst))
-		    (setq location (assemble-one-instruction inst location))))
-		 (t
-		  (clc-error "~S is a bad instruction list." inst))))))
-  location)
-
-;;; Jump optimizer.  We turn BI branches into JI branches if we can.  Currently
-;;; we punt on the possibility that the halfword saved by optimizing a branch
-;;; might make possible optimization of branches already processed, since such
-;;; computation chews up a lot of time for relatively little gain.  We return
-;;; the new number of halfwords in the *Pass1-List*.
-
-(defun optimize-jumps (length)
-  (declare (optimize (speed 3) (safety 0)))
-  (do* ((list *pass1-list* (cdr list))
-	(stuff (car list) (car list))
-	(instp (consp stuff) (consp stuff))
-	(location (if instp (car stuff)) (if instp (car stuff)))
-	(inst (if instp (cdr stuff)) (if instp (cdr stuff))))
-       ((null list) length)
-    (when (and instp
-	       (or (eq (car inst) 'bb) (eq (car inst) 'bnb))
-	       (<= 8 (eval (cadr inst)) 15)
-	       (short-jump-p location (caddr inst)))
-      (setf (car inst) (cdr (assoc (car inst) '((bb . jb) (bnb . jnb)))))
-      (setf (cadr inst) (- (cadr inst) 8))
-      (setq length (1- length))
-      (dolist (stiff (cdr list))
-	(if (consp stiff)
-	    (setf (car stiff) (1- (car stiff)))))
-      (dolist (label *local-labels*)
-	(let ((loc (get label '%label-location)))
-	  (when (> loc location)
-	    (setf (get label '%label-location) (1- loc)))))
-      (dolist (label *external-labels*)
-	(let ((loc (cdr label)))
-	  (when (> loc location)
-	    (setf (cdr label) (1- loc))
-	    (setf (get (car label) '%label-location) (1- loc))))))))
-
-;;; Pass 2.  We fly down the list created in pass 1, and interpret the
-;;; instructions according to their format.  We spit the binary code out to the
-;;; *Clc-Fasl-Stream*, and listing information out to *Clc-Lap-Stream* using
-;;; Dump-Instruction.
-
-(defun pass2-top-level-list ()
-  (declare (optimize (speed 3) (safety 0)))
-  (when *clc-lap-stream*
-    (if *produce-unixy-cruft*
-	(format *clc-lap-stream* "~2%~(~A~):" (unixfy function-name))
-	(format *clc-lap-stream* "~2%                    ~S~%" function-name)))
-  (dolist (stuff *pass1-list*)
-    (if (atom stuff)
-	(dump-instruction stuff)
-	(let* ((location (car stuff))
-	       (inst (cdr stuff))
-	       (name (car inst))
-	       (args (cdr inst))
-	       (info (get name '%instruction-info))
-	       (opcode (romp-info-opcode info)))
-	  (case (romp-info-format info)
-	    (ji
-	     (let* ((n (car args))
-		    (n-value (eval n))
-		    (ji (cadr args))
-		    (ji-value (reference-label ji 'ji location)))
-	       (cond ((not (and n ji))
-		      (clc-error "Bad JI format instruction: ~S." inst))
-		     ((not (<= 0 n-value 7))
-		      (clc-error "N field out of range in ~S." inst))
-		     (t
-		      (let ((distance (- ji-value location)))
-			(unless (<= -128 distance 127)
-			  (clc-error "Out of range JI branch in ~S." inst))
-			(dump-instruction
-			 inst (logior (ash opcode 3) n-value)
-			      (logand distance 255)))))))
-	    (x
-	     (let* ((ra (car args))
-		    (ra-value (eval-register ra))
-		    (rb (cadr args))
-		    (rb-value (eval-register rb))
-		    (rc (caddr args))
-		    (rc-value (eval-register rc)))
-	       (cond ((not (and ra-value rb-value rc-value))
-		      (clc-error "Too few or illegal registers specified in ~S."
-				 inst))
-		     (t
-		      (dump-instruction
-		       inst (logior (ash opcode 4) ra-value)
-		            (logior (ash rb-value 4) rc-value))))))
-	    (ds
-	     (let* ((rb (car args))
-		    (rb-value (eval-register rb))
-		    (rc (cadr args))
-		    (rc-value (eval-register rc))
-		    (i (caddr args))
-		    (i-value (eval i)))
-	       (cond ((not (and i rb rc))
-		      (clc-error "Bad DS format instruction: ~S." inst))
-		     ((not (<= 0 i-value 15))
-		      (clc-error "I field out of range in ~S." inst))
-		     (t
-		      (dump-instruction
-		       inst (logior (ash opcode 4) i-value)
-		            (logior (ash rb-value 4) rc-value))))))
-	    (r
-	     (let* ((rb (car args))
-		    (rb-value (eval-register rb))
-		    (rc (cadr args))
-		    (rc-value (eval-register rc)))
-	       (cond ((not (and rb-value rc-value))
-		      (clc-error "Bad R format instruction: ~S" inst))
-		     (t
-		      (dump-instruction
-		       inst opcode (logior (ash rb-value 4) rc-value))))))
-	    (r1
-	     (let* ((rb (car args))
-		    (rb-value (eval rb))
-		    (rc (cadr args))
-		    (rc-value (eval-register rc)))
-	       (cond ((not (and rb-value rc-value))
-		      (clc-error "Bad R format instruction: ~S" inst))
-		     (t
-		      (dump-instruction
-		       inst opcode (logior (ash rb-value 4) rc-value))))))
-	    (r2
-	     (let* ((rb (car args))
-		    (rb-value (eval-register rb))
-		    (rc (cadr args))
-		    (rc-value (eval rc)))
-	       (cond ((not (and rb-value rc-value))
-		      (clc-error "Bad R format instruction: ~S" inst))
-		     (t
-		      (dump-instruction
-		       inst opcode (logior (ash rb-value 4) rc-value))))))
-	    (sr
-	     (let* ((rb (car args))
-		    (rb-value (eval-register rb)))
-	       (cond ((not rb-value)
-		      (clc-error "Bad S format instruction: ~S" inst))
-		     (t
-		      (dump-instruction
-		       inst (ash opcode -4)
-		            (logior (logand (ash opcode 4) 255) rb-value))))))
-	    (sn
-	     (let* ((rb (car args))
-		    (rb-value (eval rb)))
-	       (cond ((not rb-value)
-		      (clc-error "Bad S format instruction: ~S" inst))
-		     (t
-		      (dump-instruction
-		       inst (ash opcode -4)
-		            (logior (logand (ash opcode 4) 255) rb-value))))))
-	    (bi
-	     (let* ((rb (car args))
-		    (rb-value (eval-register rb))
-		    (bi (cadr args))
-		    (bi-value (reference-label bi 'bi location)))
-	       (cond ((not (and rb-value bi))
-		      (clc-error "Bad BI format instruction: ~S." inst))
-		     (t
-		      (let ((distance (- bi-value location)))
-			(unless (<= -524288 distance 524287)
-			  (clc-error "Out of range JI branch in ~S." inst))
-			(dump-instruction
-			 inst opcode
-			      (logior (ash rb-value 4)
-				      (logand (ash distance -16) 15))
-		              (logand (ash distance -8) 255)
-		              (logand distance 255)))))))
-	    (ba
-	     (let* ((ba (car args))
-		    (ba-value (cond ((fixnump ba) ba)
-				    ((and (listp ba)
-					  (eq (car ba) 'symbol-value))
-				     (symbol-value (cadr ba)))
-				    (T (reference-label ba 'ba location)))))
-	       (cond ((not ba)
-		      (clc-error "Bad BA format instruction: ~S." inst))
-		     (t
-		      (dump-instruction inst opcode
-					(logand (ash ba-value -16) 255)
-					(logand (ash ba-value -8) 255)
-					(logand ba-value 255))))))
-	    (d
-             (let* ((rb (car args))
-		    (rb-value (eval-register rb))
-		    (rc (cadr args))
-		    (rc-value (eval-register rc))
-		    (i (caddr args))
-		    (i-value (eval i)))
-	       (cond ((not (and i rb rc))
-		      (clc-error "Bad D format instruction: ~S." inst))
-		     ;; Sometimes I is sign extended, sometimes not.  Assume the
-		     ;;  guy knows what he's doing.
-		     ((not (<= -32768 i-value 65535))
-		      (clc-error "I field out of range in ~S." inst))
-		     (t
-		      (dump-instruction
-		       inst opcode
-		            (logior (ash rb-value 4) rc-value)
-		            (logand (ash i-value -8) 255)
-		            (logand i-value 255))))))))))
-  (when *clc-lap-stream*
-    (terpri *clc-lap-stream*)))
-
-
-;;; Dump-Instruction dumps out some bytes to the fasl file and a nice line to
-;;; the listing file.
-
-(defun dump-instruction (inst &rest bytes)
-  (declare (optimize (speed 3) (safety 0)))
-  (when *clc-lap-stream*
-    (if *produce-unixy-cruft*
-	(output-unixy-instruction inst)
-	(if (atom inst)
-	    (format *clc-lap-stream* "~%                    ~S" inst)
-	    (if (cddr bytes)
-		(format *clc-lap-stream*
-			"~%~2,'0X ~2,'0X ~2,'0X ~2,'0X         ~S"
-			(car bytes) (cadr bytes) (caddr bytes)
-			(cadddr bytes) inst)
-		(format *clc-lap-stream*
-			"~%~2,'0X ~2,'0X               ~S"
-			(car bytes) (cadr bytes) inst)))))
-  (dolist (byte bytes)
-    (dump-byte byte)))
-
-;;; Compatability for silly Unixy assembler.
-
-(defun output-unixy-instruction (inst)
-  (declare (optimize (speed 3) (safety 0)))
-  (if (atom inst)
-      (format *clc-lap-stream* "~%~(~A~):" (unixfy inst))
-      (let* ((name (car inst))
-	     (args (cdr inst))
-	     (info (get name '%instruction-info)))
-	(case (romp-info-format info)
-	  (ji
-	   (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-		   (case name (jb 'bb) (jnb 'bnb))
-		   (+ (eval (car args)) 8)
-		   (unixfy (cadr args))))
-	  (x
-	   (format *clc-lap-stream* "~%~(	~A	~A,~A,~A~)"
-		   name (unixfy (car args)) (unixfy (cadr args))
-		   (unixfy (caddr args))))
-	  (ds
-	   (format *clc-lap-stream* "~%~(	~A	~A,~A(~A)~)"
-		   (get-unixy-long-name name)
-		   (unixfy (car args)) (eval (caddr args))
-		   (unixfy (cadr args))))
-	  (r
-	   (if (eq name 'lhs)
-	       (format *clc-lap-stream* "~%~(	~A	~A,0(~A)~)"
-		       'lh (unixfy (car args)) (unixfy (cadr args)))
-	       (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-		       name (unixfy (car args)) (unixfy (cadr args)))))
-	  (r1
-	   (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-		   name (eval (car args)) (unixfy (cadr args))))
-	  (r2
-	   (if (eq name 'cis) (setq name 'ci))
-	   (cond ((memq name '(sari16 sri16 srpi16 sli16 slpi16))
-		  (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-			  (case name
-			    (sari16 'sari)
-			    (sri16 'sri)
-			    (srpi16 'srpi)
-			    (sli16 'sli)
-			    (slpi16 'slpi))
-			  (unixfy (car args)) (+ 16 (eval (cadr args)))))
-		 ((memq name '(mftbil mttbil))
-		  (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-			  (case name
-			    (mftbil 'mftbi)
-			    (mttbil 'mttbi))
-			  (unixfy (car args)) (- 32 (eval (cadr args)))))
-		 ((memq name '(mftbiu mttbiu))
-		  (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-			  (case name
-			    (mftbiu 'mftbi)
-			    (mttbiu 'mttbi))
-			  (unixfy (car args)) (- 16 (eval (cadr args)))))
-		 (T (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-			    name (unixfy (car args)) (eval (cadr args))))))
-	  (bi
-	   (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-		   name (unixfy (car args)) (unixfy (cadr args))))
-	  (ba
-	   (format *clc-lap-stream* "~%~(	~A	~A~)"
-		   name (unixfy (car args))))
-	  (d
-	   (if (memq name '(lc lha lh l lm tsh stc sth st stm cal cal16 cau))
-	       (format *clc-lap-stream* "~%~(	~A	~A,~A(~A)~)"
-		       name (unixfy (car args)) (eval (caddr args))
-		       (unixfy (cadr args)))
-	       (if (memq name '(ci cli))
-		   (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-			   name (unixfy (cadr args)) (eval (caddr args)))
-		   (format *clc-lap-stream* "~%~(	~A	~A,~A,~A~)"
-			   name (unixfy (car args)) (unixfy (cadr args))
-			   (eval (caddr args))))))
-	  (sr
-	   (cond ((memq name '(mtmq mfmq))
-		  (format *clc-lap-stream* "~%~(	~A	~A,~A~)"
-			  (if (eq name 'mtmq) 'mts 'mfs)
-			  10 (unixfy (car args))))
-		 (T (format *clc-lap-stream* "~%~(	~A	~A~)"
-			    name (unixfy (car args))))))
-	  (sn
-	   (format *clc-lap-stream* "~%~(	~A	~A~)"
-		   name (eval (car args))))))))
-
-(defun unixfy (thing)
-  (if (symbolp thing)
-      (substitute #\_ #\-
-		  (the string (copy-seq (the string (symbol-name thing)))))
-      thing))
-
-(defun get-unixy-long-name (name)
-  (case name
-    (ls 'l)
-    (sts 'st)
-    (lhas 'lha)
-    (sths 'sth)
-    (lcs 'lc)
-    (stcs 'stc)))
-
-;;; Nice branching instructions.
-
-(defconstant condition-code-alist
-  '((pz . 8) (lt . 9) (eq . 10) (gt . 11) (c0 . 12) (ov . 14) (tb . 15)
-	     (<0 . 9) (=0 . 10) (>0 . 11)))
-
-(defconstant not-condition-code-alist
-  '((po . 8) (ge . 9)  (ne . 10)  (le . 11) (nc0 . 12) (nov . 14) (ntb . 15)
-	     (>=0 . 9) (<>0 . 10) (<=0 . 11)))
-
-(defmacro defbranch (name on on-not)
-  `(defmacro ,name (destination &optional (condition 'po))
-     (let ((cc (cdr (assq condition condition-code-alist))))
-       (if cc
-	   `((,',on ,cc ,destination))
-	   (if (setq cc (cdr (assq condition not-condition-code-alist)))
-	       `((,',on-not ,cc ,destination))
-	       (error "Unknown condition code: ~S."))))))
-
-(defbranch branch   bb   bnb)		; branch
-(defbranch branchx  bbx  bnbx)		; branch with execute
-(defbranch rbranch  bbr  bnbr)		; register branch
-(defbranch rbranchx bbrx bnbrx)  	; register branch with execute
-
-(defmacro b (destination) `((branch ,destination)))
-(defmacro beq (destination) `((branch ,destination =0)))
-(defmacro bne (destination) `((branch ,destination <>0)))
-(defmacro blt (destination) `((branch ,destination <0)))
-(defmacro bgt (destination) `((branch ,destination >0)))
-(defmacro bge (destination) `((branch ,destination >=0)))
-(defmacro ble (destination) `((branch ,destination <=0)))
-(defmacro bx (destination) `((branchx ,destination)))
-(defmacro beqx (destination) `((branchx ,destination =0)))
-(defmacro bnex (destination) `((branchx ,destination <>0)))
-(defmacro bltx (destination) `((branchx ,destination <0)))
-(defmacro bgtx (destination) `((branchx ,destination >0)))
-(defmacro bgex (destination) `((branchx ,destination >=0)))
-(defmacro blex (destination) `((branchx ,destination <=0)))
-(defmacro br (destination) `((rbranch ,destination)))
-(defmacro breq (destination) `((rbranch ,destination =0)))
-(defmacro brne (destination) `((rbranch ,destination <>0)))
-(defmacro brlt (destination) `((rbranch ,destination <0)))
-(defmacro brgt (destination) `((rbranch ,destination >0)))
-(defmacro brge (destination) `((rbranch ,destination >=0)))
-(defmacro brle (destination) `((rbranch ,destination <=0)))
-(defmacro brx (destination) `((rbranchx ,destination)))
-(defmacro breqx (destination) `((rbranchx ,destination =0)))
-(defmacro brnex (destination) `((rbranchx ,destination <>0)))
-(defmacro brltx (destination) `((rbranchx ,destination <0)))
-(defmacro brgtx (destination) `((rbranchx ,destination >0)))
-(defmacro brgex (destination) `((rbranchx ,destination >=0)))
-(defmacro brlex (destination) `((rbranchx ,destination <=0)))
-
-(defmacro bov (destination) `((branch ,destination ov)))
-(defmacro bnov (destination) `((branch ,destination nov)))
-(defmacro brov (destination) `((rbranch ,destination ov)))
-(defmacro brnov (destination) `((rbranch ,destination nov)))
-(defmacro bovx (destination) `((branchx ,destination ov)))
-(defmacro bnovx (destination) `((branchx ,destination nov)))
-(defmacro brovx (destination) `((rbranchx ,destination ov)))
-(defmacro brnovx (destination) `((rbranchx ,destination nov)))
-
-(defmacro btb (destination) `((branch ,destination tb)))
-(defmacro bntb (destination) `((branch ,destination ntb)))
-(defmacro brtb (destination) `((rbranch ,destination tb)))
-(defmacro brntb (destination) `((rbranch ,destination ntb)))
-(defmacro btbx (destination) `((branchx ,destination tb)))
-(defmacro bntbx (destination) `((branchx ,destination ntb)))
-(defmacro brtbx (destination) `((rbranchx ,destination tb)))
-(defmacro brntbx (destination) `((rbranchx ,destination ntb)))
-
-(defmacro bc0 (destination) `((branch ,destination c0)))
-(defmacro bnc0 (destination) `((branch ,destination nc0)))
-(defmacro brc0 (destination) `((rbranch ,destination c0)))
-(defmacro brnc0 (destination) `((rbranch ,destination nc0)))
-(defmacro bc0x (destination) `((branchx ,destination c0)))
-(defmacro bnc0x (destination) `((branchx ,destination nc0)))
-(defmacro brc0x (destination) `((rbranchx ,destination c0)))
-(defmacro brnc0x (destination) `((rbranchx ,destination nc0)))
-
-;;; Lr loads register1 with the contents of register2.  Nicer looking than
-;;; cas r1,r2,0.
-
-(defmacro lr (register1 register2)
-  `((cas ,register1 ,register2 0)))
-
-;;; Loadi loads the specified Constant into the given Register.
-
-(defmacro loadi (register constant)
-  (let ((value (eval constant)))
-    (cond ((<= 0 value 15)
-	   `((lis ,register ,value)))
-	  ((<= -32768 value 32767)
-	   `((cal ,register 0 ,value)))
-	  ((= (logand value 65535) 0)
-	   `((cau ,register 0 (logand (ash ,value -16) #xFFFF))))
-	  (t
-	   `((cau ,register 0 (logand (ash ,value -16) #xFFFF))
-	     (oil ,register ,register (logand ,value 65535)))))))
-
-(defmacro cmpi (register constant)
-  (let ((value (eval constant)))
-    (cond ((<= 0 value 15)
-	   `((cis ,register ,value)))
-	  ((<= -32768 value 32767)
-	   `((ci 0 ,register ,value)))
-	  (T (clc-error "~A is to big for a compare immediate instruction."
-			value)))))
-
-(defmacro defmemref (name ds d shift)
-  `(defmacro ,name (register index-register &optional (offset 0))
-     (let ((value (eval offset)))
-       (cond ((and (eql (logand value (1- (ash 1 (abs ,shift)))) 0)
-		   (<= 0 (ash value ,shift) ,(if (eq name 'loadh) 0 15)))
-	      `((,',ds ,register ,index-register ,(ash value ,shift))))
-	     (t
-	      `((,',d ,register ,index-register ,value)))))))
-
-(defmemref loadc lcs lc 0)		; loads a character or byte
-(defmemref loadha lhas lha -1)		; loads a halfword, sign-extending
-(defmemref loadh lhs lh -1)		; loads a halfword, no sign extend.
-(defmemref loadw ls l -2)		; loads a fullword
-
-(defmemref storec stcs stc 0)		; stores a character or byte
-(defmemref storeha sths sth -1)		; stores a halfword
-(defmemref storew sts st -2)		; stores a fullword
-
-;;; (Mulitply Reg1 Reg2) multiplies the contents of Reg1 by Reg2 leaving the high order
-;;; result in Reg1 and the low order result in Reg2.  This macro could try and play
-;;; games, but to reduce the number of multiply steps, but it turns out that the extra
-;;; logic becomes pretty hariy, and you end up gaining a small amount.
-
-(defmacro multiply (Reg1 Reg2)
-  `((mtmq ,Reg1)
-    (s	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (m	,Reg1 ,Reg2)
-    (mfmq ,Reg2)))
-
-;;; More useful macros.
-
-(defmacro noop ()
-  `((cas NL0 NL0 NL0)))
-
-(defmacro pushm (reg)
-  `((inc cs 4)
-    (sts ,reg cs 0)))
-
-(defmacro popm (reg)
-  `((ls ,reg cs 0)
-    (dec cs 4)))
-
-(defmacro verify-type (reg type error &optional ignore-nil)
-  (let ((label (gensym "Label")))
-    (if (or (eq type 'type-+-fixnum) (eq type 'type-negative-fixnum))
-	`(,@(if (memq reg '(A0 A1))
-		`((srpi16 ,reg ,type-shift-16)
-		  (cmpi ,(if (eq reg 'A0) 'NL0 'NL1) ,type)
-		  (,(if (eq type 'type-+-fixnum) 'bgt 'blt) ,error))
-		`((lr NL0 ,reg)
-		  (sri16 NL0 ,type-shift-16)
-		  (cmpi NL0 ,type)
-		  (,(if (eq type 'type-+-fixnum) 'bgt 'blt) ,error))))
-	`(,@(if (and (eq type 'type-symbol) (null ignore-nil))
-		`((xiu NL0 ,reg nil-16)
-		  (beq ,label)))
-	  ,@(if (memq reg '(A0 A1))
-		`((srpi16 ,reg ,type-shift-16)
-		  (cmpi ,(if (eq reg 'A0) 'NL0 'NL1) ,type)
-		  (bne ,error))
-		`((niuz NL0 ,reg type-mask-16)
-		  (xiu NL0 NL0 (get-type-mask-16 ,type))
-		  (bne ,error)))
-	  ,@(if (and (eq type 'type-symbol) (null ignore-nil))
-		(list label))))))
-
-(defmacro verify-not-type (reg type error)
-  (if (or (eq type 'type-+-fixnum) (eq type 'type-negative-fixnum))
-      `(,@(if (memq reg '(A0 A1))
-	      `((srpi16 ,reg ,type-shift-16)
-		(cmpi ,(if (eq reg 'A0) 'NL0 'NL1) ,type)
-		(,(if (eq type 'type-+-fixnum) 'bgt 'blt) ,error))
-	      `((lr NL0 ,reg)
-		(sri16 NL0 ,type-shift-16)
-		(cmpi NL0 ,type)
-		(,(if (eq type 'type-+-fixnum) 'bgt 'blt) ,error))))
-      `(,@(if (memq reg '(A0 A1))
-	      `((srpi16 ,reg ,type-shift-16)
-		(cmpi ,(if (eq reg 'A0) 'NL0 'NL1) ,type)
-		(beq ,error))
-	      `((niuz NL0 ,reg type-mask-16)
-		(xiu NL0 NL0 (get-type-mask-16 ,type))
-		(beq ,error))))))
-
-(defmacro test-nil (reg label)
-  `((xiu NL0 ,reg nil-16)
-    (beq ,label)))
-
-(defmacro test-not-nil (reg label)
-  `((xiu NL0 ,reg nil-16)
-    (bne ,label)))
-
-(defmacro test-t (reg label)
-  `((xiu NL0 ,reg t-16)
-    (beq ,label)))
-
-(defmacro test-not-t (reg label)
-  `((xiu ro ,reg t-16)
-    (bne ,label)))
-
-(defmacro test-trap (reg label)
-  `((xiu NL0 ,reg trap-16)
-    (beq ,label)))
-
-(defmacro test-not-trap (reg label)
-  `((xiu NL0 ,reg trap-16)
-    (bne ,label)))
-
-(defmacro get-type (reg type-reg)
-  (cond ((and (eq reg 'A0) (eq type-reg 'NL0))
-	 `((srpi16 A0 type-shift-16)))
-	((and (eq reg 'A1) (eq type-reg 'NL1))
-	 `((srpi16 A1 type-shift-16)))
-	((and (eq reg 'A2) (eq type-reg 'A3))
-	 `((srpi16 A2 type-shift-16)))
-	(T `(,@(unless (eq reg type-reg)
-		 `((cas ,type-reg ,reg 0)))
-	     (sri16 ,type-reg type-shift-16)))))
-
-(defmacro type-equal (reg type label)
-  `((cmpi ,reg ,type)
-    ,(cond ((eq type 'type-+-fixnum)
-	    `(ble ,label))
-	   ((eq type 'type-negative-fixnum)
-	    `(bge ,label))
-	   (T `(beq ,label)))))
-
-(defmacro type-not-equal (reg type label)
-  `((cmpi ,reg ,type)
-    ,(cond ((eq type 'type-+-fixnum)
-	    `(bgt ,label))
-	   ((eq type 'type-negative-fixnum)
-	    `(blt ,label))
-	   (T `(bne ,label)))))
-
-(defmacro error0 (error-code)
-  `((bx error0)
-    (loadi a0 ,error-code)))
-
-(defmacro error1 (error-code reg)
-  `(,@(unless (eq reg 'a1)
-	`((cas a1 ,reg 0)))
-    (bx error1)
-    (loadi a0 ,error-code)))
-
-(defmacro error2 (error-code reg1 reg2)
-  `(,@(unless (eq reg2 'a2)
-	`((cas a2 ,reg2 0)))
-    ,@(unless (eq reg1 'a1)
-	`((cas a1 ,reg1 0)))
-    (bx error2)
-    (loadi a0 ,error-code)))
-
-;;; Floating Point support on the IBM RT PC.  The floating point support
-;;; provided assumes that there is hardware support for floating point.
-;;; This means the machine must have an FPA card, have an APC (which
-;;; has an MC68881 chip on board), or an AFPA card.
-
-;;; The macros defined below assume that there are only 7 floating point
-;;; registers available to Lisp miscops.  On the FPA's all register numbers
-;;; are shifted left one before being used, since the Mc68881 only has
-;;; 8 registers.  On the FPA the register 14 and 15 are not useable which
-;;; leaves 7 registers for Lisp.
-
-(float-register FR0 0)
-(float-register FR1 1)
-(float-register FR2 2)
-(float-register FR3 3)
-(float-register FR4 4)
-(float-register FR5 5)
-(float-register FR6 6)
-(float-register FR7 7)
-
-;;; Floatop generates code that checks (at runtime) the type of
-;;; floating point hardware available.  Shift-code is inserted between
-;;; the load of the hardware-type and the comparison.  Floatop then
-;;; branches to either the mc68881-code or the fpa-code.  The code for
-;;; each type of hardware should normally return to Lisp code.  However,
-;;; if the code should fall through, then the optional argument fall-through
-;;; should be passed a non-NIL value.
-
-(defmacro floatop (mc68881-code fpa-code &optional shift-code fall-through)
-  (let ((tag (gensym "LABEL"))
-	(tag2 (when fall-through (gensym "LABEL"))))
-    `((cau A3 0 romp-data-base)
-      (loadw A3 A3 floating-point-hardware-available)
-      ,@shift-code
-      (cmpi A3 float-mc68881)
-      (bne ,tag)
-      ,@mc68881-code
-      ,@(when fall-through `((b ,tag2)))
-      ,tag
-      ,@fpa-code
-      ,@(when fall-through `(,tag2)))))
-
-;;; Macros to support Floating point operations on the IBM RT PC.
-;;; The following code supports the FPA and AFPA.
-
-(defconstant read-float-register #x0BC)
-(defconstant read-status-register #x037)
-(defconstant write-float-register #x094)
-(defconstant write-status-register #x10F)
-(defconstant convert-float-long-to-float-short #x016)
-(defconstant convert-float-short-to-float-long #x01B)
-(defconstant negate-float-short #x055)
-(defconstant negate-float-long #x054)
-(defconstant absolute-float-short #x075)
-(defconstant absolute-float-long #x074)
-(defconstant copy-float-short #x045)
-(defconstant copy-float-long #x044)
-(defconstant compare-float-short #x049)
-(defconstant compare-float-long #x048)
-(defconstant divide-float-short #x061)
-(defconstant divide-float-long #x060)
-(defconstant multiply-float-short #x071)
-(defconstant multiply-float-long #x070)
-(defconstant subtract-float-short #x051)
-(defconstant subtract-float-long #x050)
-(defconstant add-float-short #x041)
-(defconstant add-float-long #x040)
-(defconstant round-float-long-to-word #x023)
-(defconstant truncate-float-long-to-word #x02B)
-(defconstant floor-float-long-to-word #x03B)
-(defconstant round-float-short-to-integer #x027)
-(defconstant truncate-float-short-to-integer #x02F)
-(defconstant floor-float-short-to-integer #x03F)
-(defconstant convert-float-short-immediate-to-float-long #x21B)
-(Defconstant convert-word-immediate-to-float-long #x203)
-(defconstant convert-word-immediate-to-float-short #x207)
-(defconstant compare-float-immediate-short #x249)
-(defconstant divide-float-immediate-short #x261)
-(defconstant divide-float-short-immediate #x161)
-(defconstant multiply-float-immediate-short #x271)
-(defconstant multiply-float-short-immediate #x171)
-(defconstant subtract-float-immediate-short #x251)
-(defconstant subtract-float-short-immediate #x151)
-(defconstant add-float-immediate-short #x241)
-(defconstant add-float-short-immediate #x141)
-(defconstant convert-float-long-immediate-to-float-short #x216)
-(defconstant compare-float-immediate-long #x248)
-(defconstant divide-float-immediate-long #x260)
-(defconstant divide-float-long-immediate #x160)
-(defconstant multiply-float-immediate-long #x270)
-(defconstant multiply-float-long-immediate #x170)
-(defconstant subtract-float-immediate-long #x250)
-(defconstant subtract-float-long-immediate #x150)
-(defconstant add-float-immediate-long #x240)
-(defconstant add-float-long-immediate #x140)
-(defconstant afpa-atanl #x0D4)
-(defconstant afpa-cosl #x0C2)
-(defconstant afpa-expl #x0D8)
-(defconstant afpa-log10l #x0DE)
-(defconstant afpa-logl #x0DC)
-(defconstant afpa-sinl #x0C0)
-(defconstant afpa-sqrs #x065)
-(defconstant afpa-sqrl #x064)
-(defconstant afpa-tanl #x0C4)
-
-(register float-status-register 14)
-
-;;; Check-For-Float-Errors checks to make sure a floating point operation
-;;; did not overflow or cause some other form of error.  The  argument
-;;; Error-Routine is the label to branch to if an error occurred.  There
-;;; is one routine for short, single, and long floating pointer errors
-;;; respectively.  The argument Reg is a general register to use in
-;;; the calculations.
-
-(defmacro fpa-check-for-float-error (underflow overflow reg &optional divide)
-  `((rdstr ,reg ,reg)			; get float status into register.
-    (nilz ,reg ,reg #x7)		; Clear useless bits.
-    (cmpi ,reg 1)			; Underflow ?
-    (beq ,underflow)			; Yes, go generate error.
-    (cmpi ,reg 2)			; Overflow ?
-    (beq ,overflow)			; Yes, go generate error.
-    ,@(if divide `((cmpi ,reg 3)	; Check for divide by 0.
-		   (beq ,divide)))))
-
-(defmacro invoke-fpa-float (opcode op1 op2 base
-			       &optional (data-reg 'NL0) (data-op 'storew))
-  (let* ((opcode (cond ((integerp opcode) opcode)
-		       ((symbolp opcode) (symbol-value opcode))
-		       (T (error "Illegal value: ~A." opcode))))
-	 (high-op (logior #xFF00 (logand (ash opcode -6) #xF)))
-	 (low-op (logior (ash (logand opcode #x3F) 10)
-			 (ash (eval-register op1) 6)
-			 (ash (eval-register op2) 2))))
-    (declare (fixnum high-op low-op))
-    (if (/= (logand low-op #x8000) 0)
-	(setq high-op (1+ high-op)))
-    `((cau ,base 0 ,high-op)
-      (,data-op ,data-reg ,base ,low-op))))
-
-(defmacro rdfr (gpr fpr &optional (base 'NL1))
-  `((invoke-fpa-float ,read-float-register ,fpr 0 ,base ,gpr loadw)))
-
-(defmacro rdstr (gpr &optional (base 'NL1))
-  `((invoke-fpa-float ,read-status-register float-status-register
-		  float-status-register ,base ,gpr loadw)))
-
-(defmacro wtfr (gpr fpr &optional (base 'NL1))
-  `((invoke-fpa-float ,write-float-register 0 ,fpr ,base ,gpr)))
-
-(defmacro wtstr (gpr &optional (base 'NL1))
-  `((invoke-fpa-float ,write-status-register float-status-register
-		  float-status-register ,base ,gpr)))
-
-(defmacro cisl (gr sfr lfr &optional (base 'NL1))
-  `((invoke-fpa-float ,convert-float-short-immediate-to-float-long
-		  ,sfr ,lfr ,base ,gr)))
-
-(defmacro csl (sfr lfr &optional (base 'NL1))
-  `((invoke-fpa-float ,convert-float-short-to-float-long ,sfr ,lfr ,base)))
-
-(defmacro cls  (lfr sfr &optional (base 'NL1))
-  `((invoke-fpa-float ,convert-float-long-to-float-short ,lfr ,sfr ,base)))
-
-(defmacro cils (gr lfr sfr &optional (base 'NL1))
-  `((invoke-fpa-float ,convert-float-long-immediate-to-float-short
-		  ,lfr ,sfr ,base ,gr)))
-
-(defmacro fixnum-to-short (ir sr &optional (base 'NL1))
-  `((invoke-fpa-float ,convert-word-immediate-to-float-short R0 ,sr ,base ,ir)))
-
-(defmacro fixnum-to-long (ir lr &optional (base 'NL1))
-  `((invoke-fpa-float ,convert-word-immediate-to-float-long R0 ,lr ,base ,ir)))
-
-(defmacro coms (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,compare-float-short ,fr1 ,fr2 ,base)))
-
-(defmacro comis (gr fpr1 fpr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,compare-float-immediate-short ,fpr1 ,fpr2 ,base ,gr)))
-
-(defmacro coml (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,compare-float-long ,fr1 ,fr2 ,base)))
-
-(defmacro comil (gr fpr1 fpr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,compare-float-immediate-long ,fpr1 ,fpr2 ,base ,gr)))
-
-(defmacro cops (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,copy-float-short ,fr1 ,fr2 ,base)))
-
-(defmacro copl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,copy-float-long ,fr1 ,fr2 ,base)))
-
-(defmacro abss (fpr1 fpr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,absolute-float-short ,fpr1 ,fpr2 ,base)))
-
-(defmacro absl (fpr1 fpr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,absolute-float-long ,fpr1 ,fpr2 ,base)))
-
-(defmacro negs (fpr1 fpr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,negate-float-short ,fpr1 ,fpr2 ,base)))
-
-(defmacro negl (fpr1 fpr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,negate-float-long ,fpr1 ,fpr2 ,base)))
-
-(defmacro adds (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,add-float-short ,fr1 ,fr2 ,base)))
-
-(defmacro addis (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,add-float-immediate-short ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro addsi (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,add-float-short-immediate ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro addl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,add-float-long ,fr1 ,fr2 ,base)))
-
-(defmacro addil (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,add-float-immediate-long ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro addli (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,add-float-long-immediate ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro subs (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,subtract-float-short ,fr1 ,fr2 ,base)))
-
-(defmacro subis (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,subtract-float-immediate-short ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro subsi (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,subtract-float-short-immediate ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro subl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,subtract-float-long ,fr1 ,fr2 ,base)))
-
-(defmacro subil (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,subtract-float-immediate-long ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro subli (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,subtract-float-long-immediate ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro muls (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,multiply-float-short ,fr1 ,fr2 ,base)))
-
-(defmacro mulis (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,multiply-float-immediate-short ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro mulsi (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,multiply-float-short-immediate ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro mull (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,multiply-float-long ,fr1 ,fr2 ,base)))
-
-(defmacro mulil (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,multiply-float-immediate-long ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro mulli (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,multiply-float-long-immediate ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro divs (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,divide-float-short ,fr1 ,fr2 ,base)))
-
-(defmacro divis (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,divide-float-immediate-short ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro divsi (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,divide-float-short-immediate ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro divl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,divide-float-long ,fr1 ,fr2 ,base)))
-
-(defmacro divil (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,divide-float-immediate-long ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro divli (gr fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,divide-float-long-immediate ,fr1 ,fr2 ,base ,gr)))
-
-(defmacro atanl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,afpa-atanl ,fr1 ,fr2 ,base)))
-
-(defmacro cosl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,afpa-cosl ,fr1 ,fr2 ,base)))
-
-(defmacro cosl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,afpa-cosl ,fr1 ,fr2 ,base)))
-
-(defmacro expl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,afpa-expl ,fr1 ,fr2 ,base)))
-
-(defmacro logl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,afpa-logl ,fr1 ,fr2 ,base)))
-
-(defmacro sinl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,afpa-sinl ,fr1 ,fr2 ,base)))
-
-(defmacro sqrs (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,afpa-sqrs ,fr1 ,fr2 ,base)))
-
-(defmacro sqrl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,afpa-sqrl ,fr1 ,fr2 ,base)))
-
-(defmacro tanl (fr1 fr2 &optional (base 'NL1))
-  `((invoke-fpa-float ,afpa-tanl ,fr1 ,fr2 ,base)))
-
-;;; The following code is to support the MC6881 floating point chip on
-;;; the APC card.
-
-;;; MC68881 opcodes.
-
-(defconstant fop881-move #x00)
-(defconstant fop881-int #x01)
-(defconstant fop881-sinh #x02)
-(defconstant fop881-intrz #x03)
-(defconstant fop881-sqrt #x04)
-(defconstant fop881-lognp1 #x06)
-(defconstant fop881-etoxm1 #x08)
-(defconstant fop881-tanh #x09)
-(defconstant fop881-atan #x0A)
-(defconstant fop881-asin #x0C)
-(defconstant fop881-atanh #x0D)
-(defconstant fop881-sin #x0E)
-(defconstant fop881-tan #x0F)
-(defconstant fop881-etox #x10)
-(defconstant fop881-twotox #x11)
-(defconstant fop881-tentox #x12)
-(defconstant fop881-logn #x14)
-(defconstant fop881-log10 #x15)
-(defconstant fop881-log2 #x16)
-(defconstant fop881-abs #x18)
-(defconstant fop881-cosh #x19)
-(defconstant fop881-neg #x1A)
-(defconstant fop881-acos #x1C)
-(defconstant fop881-cos #x1D)
-(defconstant fop881-getexp #x1E)
-(defconstant fop881-getman #x1F)
-(defconstant fop881-div #x20)
-(defconstant fop881-mod #x21)
-(defconstant fop881-add #x22)
-(defconstant fop881-mul #x23)
-(defconstant fop881-sgldiv #x24)
-(defconstant fop881-rem #x25)
-(defconstant fop881-scale #x26)
-(defconstant fop881-sglmul #x27)
-(defconstant fop881-sub #x28)
-(defconstant fop881-sincos #x30)
-(defconstant fop881-cmp #x38)
-(defconstant fop881-tst #x3A)
-
-;;; Instruction classes.
-(defconstant f881-freg-to-freg 0)
-(defconstant f881-mem-to-freg 2)
-(defconstant f881-freg-to-mem 3)
-(defconstant f881-mem-to-scr 4)
-(defconstant f881-scr-to-mem 5)
-
-;;; When going to or from memory, have to specify type of the operand.
-(defconstant f881-mem-integer 0)	;; 32 bit integer.
-(defconstant f881-mem-single 1)		;; 32 bit float.
-(defconstant f881-mem-double 5)		;; 64 bit float.
-(defconstant f881-transfer-control-field-table
-  '#(0 #x3c0000 0 #x3c0000 0 #x3c0000 0 #x3c0000))
-
-;;; Control registers on the MC688881
-
-(defconstant f881-fpsr 2)
-(defconstant f881-fpcr 4)
-(defconstant f881-fpiar 1)
-
-
-(defmacro mc68881-check-for-error (under over opr baser &optional divide)
-  `((f881op ,f881-scr-to-mem ,f881-fpsr 0 ,fop881-move 1 ,opr ,baser)
-    (setcb 8)
-    (loadw NL0 ,baser 0)
-    (nilz ,opr NL0 #x800)
-    (bne ,under)
-    (nilz ,opr NL0 #x1000)
-    (bne ,over)
-    ,@(when divide
-	`((nilz ,opr NL0 #x400)
-	  (bne ,divide)))))
-
-(defmacro f881op (class src dst operation length &optional (opr 'A2) (dtr 'NL1))
-  (let* ((ecl (eval class))
-	 (opcode (logior #xFC000000
-			 (svref f881-transfer-control-field-table ecl)
-			 (ash ecl 15)
-			 (let ((r (eval-register src)))
-			   (unless r
-			     (setq r (eval src)))
-			   (ash r 12))
-			 (let ((r (eval-register dst)))
-			   (unless r
-			     (setq r (eval dst)))
-			   (ash r 9))
-			 (ash (eval operation) 2)
-			 length))
-	 (low (logand opcode #xFFFF))
-	 (high (+ (logand (ash opcode -16) #xFFFF)
-		  (if (eql (logand low #x8000) 0) 0 1))))
-    `((cau ,opr 0 ,high)
-      (storew ,dtr ,opr ,low))))
-
-;;; Assumes NL0 contains the (now) single floating point number.
-;;; Returns result in A0 as well as returning to caller.
-
-(defmacro short-monadic-f881op (op &optional (opr 'A2) (base 'NL1))
-  `((loadi ,base mc68881-float-temporary)
-    (storew NL0 ,base 0)
-    (f881op ,f881-mem-to-freg ,f881-mem-single FR0 ,(symbol-value op)
-	    1 ,opr ,base)
-    (f881op ,f881-freg-to-mem ,f881-mem-single FR0 ,fop881-move 1 ,opr ,base)
-    (setcb 8)
-    (loadw NL0 ,base 0)
-    (sri NL0 short-float-shift-16)
-    (brx PC)
-    (oiu A0 NL0 short-float-4bit-mask-16)))
-
-;;; Assumes A0 contains a pointer to a long floating point number.
-;;; Allocates storage to hold the result of the computation.
-
-(defmacro long-monadic-f881op (op &optional (opr 'A2) (base 'NL1))
-  `((cal ,base A0 long-float-high-data)
-    (f881op ,f881-mem-to-freg ,f881-mem-double FR0 ,(symbol-value op)
-	    2 ,opr ,base)
-    (allocate A0 type-long-float long-float-size ,base NL0)
-    (cal ,base A0 long-float-high-data)
-    (f881op ,f881-freg-to-mem ,f881-mem-double FR0 ,fop881-move 2 ,opr ,base)
-    (setcb 8)
-    (br PC)))
-
-;;; Assumes NL0 and NL1 contain the first and second number respectively.
-
-(defmacro short-dyadic-f881op (op type1 type2
-				  &optional (opr 'A2) (base 'A3) divide)
-  (let ((t1 (case type1
-	      (integer f881-mem-integer)
-	      (short-float f881-mem-single)
-	      (T type1)))
-	(t2 (case type2
-	      (integer f881-mem-integer)
-	      (short-float f881-mem-single)
-	      (T type2)))
-	(fr (if (float-register-p type1) type1 'FR6)))
-    `((loadi ,base ,mc68881-float-temporary)
-      (loadi ,opr 0)
-      (storew ,opr ,base 0)
-      (f881op ,f881-mem-to-scr ,f881-fpsr 0 ,fop881-move 1 ,opr ,base)
-      ,@(when (null (float-register-p type1))
-	  `((storew NL0 ,base 0)
-	    (f881op ,f881-mem-to-freg ,t1 ,fr ,fop881-move 1 ,opr ,base)))
-      ,@(if (null (float-register-p type2))
-	    `((storew NL1 ,base 4)
-	      (inc ,base 4)
-	      (f881op ,f881-mem-to-freg ,t2 ,fr ,(symbol-value op)
-		      1 ,opr ,base))
-	    `((f881op ,f881-freg-to-freg ,t2 ,fr ,(symbol-value op)
-			     0 ,opr ,base)))
-      (f881op ,f881-freg-to-mem ,f881-mem-single ,fr ,fop881-move 1 ,opr ,base)
-      (setcb 8)
-      (inc ,base 4)
-      (mc68881-check-for-error short-float-underflow short-float-overflow
-			       ,opr ,base ,divide)
-      (loadw NL0 ,base -4)
-      (sri NL0 short-float-shift-16)
-      (brx PC)
-      (oiu A0 NL0 short-float-4bit-mask-16))))
-
-;;; Assumes A0 contains the first number, and A1 the second.  Type1 and
-;;; type2 specify the type of the first and second number respectively.
-;;; Allocates storage to hold the result of the computation.
-
-(defmacro long-dyadic-f881op (op type1 type2
-				 &optional (opr 'A2) (base 'NL1) divide)
-  (let ((l1 (if (eq type1 'long-float) 2 1))
-	(l2 (if (eq type2 'long-float) 2 1))
-	(t1 (case type1
-	      (integer f881-mem-integer)
-	      (short-float f881-mem-single)
-	      (long-float f881-mem-double)
-	      (T type1)))
-	(t2 (case type2
-	      (integer f881-mem-integer)
-	      (short-float f881-mem-single)
-	      (long-float f881-mem-double)
-	      (T type2)))
-	(fr (if (float-register-p type1) type1 'FR6)))
-    `(,@(when (null (float-register-p type1))
-	  `(,@(case type1
-		(integer `((loadi ,base ,mc68881-float-temporary)
-			   (storew A0 ,base 0)))
-		(short-float `((loadi ,base ,mc68881-float-temporary)
-			       (slpi A0 short-float-shift-16)
-			       (storew NL0 ,base 0)))
-		(long-float `((cal ,base A0 long-float-high-data))))
-	      (f881op ,f881-mem-to-freg ,t1 ,fr ,fop881-move ,l1 ,opr ,base)))
-	,@(case type2
-	    (integer `((loadi ,base mc68881-float-temporary)
-		       (storew A1 ,base 4)
-		       (inc ,base 4)))
-	    (short-float `((loadi ,base mc68881-float-temporary)
-			   (lr NL0 A1)
-			   (sli NL0 short-float-shift-16)
-			   (storew NL0 ,base 4)
-			   (inc ,base 4)))
-	    (long-float `((cal ,base A1 long-float-high-data))))
-	,@(if (null (float-register-p type2))
-	      `((f881op ,f881-mem-to-freg ,t2 ,fr ,(symbol-value op)
-			,l2 ,opr ,base))
-	      `((f881op ,f881-freg-to-freg ,t2 ,fr ,(symbol-value op)
-			       0 ,opr ,base)))
-	(loadi ,base mc68881-float-temporary)
-	(mc68881-check-for-error long-float-underflow long-float-overflow
-				 ,opr ,base ,divide)
-	(allocate A0 type-long-float long-float-size ,base NL0)
-	(cal ,base A0 long-float-high-data)
-	(f881op ,f881-freg-to-mem ,f881-mem-double ,fr ,fop881-move
-		2 ,opr ,base)
-	(setcb 8)
-	(br PC))))
diff --git a/assembler/disassemble.lisp b/assembler/disassemble.lisp
deleted file mode 100644
index 720c5a4db..000000000
--- a/assembler/disassemble.lisp
+++ /dev/null
@@ -1,368 +0,0 @@
-;;; -*- Mode: Lisp; Package: Compiler -*-
-
-;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
-;;; **********************************************************************
-;;;
-;;; The  DISASSEMBLE function as described in the Common Lisp manual.
-;;; 
-;;; Written by Don Mathis
-;;;
-;;;
-;;; Modified 11/83 by Robert Rose to put an asterisk before lines
-;;;  that are branched to.
-;;;
-;;; Heavily Modified 1/84 to use new instruction set.
-;;;
-;;; Modified by David B. McDonald to disassemble the Romp instruction
-;;; set.
-;;;
-;;; Hacked by Rob MacLachlan for the interim RT function format.  Hopefully
-;;; this file will die after the port.
-;;;
-;;; **********************************************************************
-;;;
-(in-package 'compiler :use '("LISP" "SYSTEM"))
-(export 'lisp::disassemble (find-package 'lisp))
-
-(proclaim '(special romp-4bit-opcode-symbol romp-8bit-opcode-symbol))
-
-;;;;   The Main function, DISASSEMBLE
-
-(defun disassemble (function &optional (*standard-output* *standard-output*))
-  "The argument should be either a function object, a lambda expression, or
-   a symbol with a function definition. If the relevant function is not a
-   compiled function, it is first compiled. In any case, the compiled code
-   is then 'reverse assembled' and printed out in a symbolic format."
-  (etypecase function
-    (function
-     (ecase (%primitive get-vector-subtype function)
-       ((#.%function-entry-subtype #.%function-closure-entry-subtype)
-	(prin-prelim-info function)
-	(Output-macro-instructions function (branch-list function)))
-       (#.%function-closure-subtype
-	(disassemble (%primitive header-ref function %function-name-slot)))))
-    (symbol
-     (disassemble (symbol-function function)))))
-
-
-
-;;;   PRIN-PRELIM-INFO takes a function object and extracts from it and
-;;; prints out the following information:
-;;;   - The argument list of the function.
-;;;   - The number of Locals allocated by the function.
-;;;   - Whether the function does or does not evaluate its arguments.
-
-(defun prin-prelim-info (function)
-  (format t "~%Disassembly of ~S.~%"
-	  (%primitive header-ref function %function-name-slot))
-  (format t "~%Its arg list is: ~A.~%"
-	  (%primitive header-ref function %function-entry-arglist-slot)))
-
-
-;;;   OUTPUT-MACRO-INSTRUCTIONS takes a function object and prints out the
-;;; corresponding macro. (Not executable macro, just macro that looks good!)
- 
-(defun Output-Macro-Instructions (function branches)
-  (declare (optimize (speed 3) (safety 0)))
-  (let* ((byte-vector
-	  (%primitive header-ref function %function-code-slot))
-	 (offset
-	  (- (%primitive header-ref function %function-offset-slot)
-	     i-vector-header-size))
-	 (vector-length (length byte-vector)))
-    (declare (fixnum vector-length))
-    (do ((i 0))
-	((= i vector-length))
-      (declare (fixnum i))
-      (when (= i offset)
-	(format t "~&*** Enter here:~%"))
-      (let* ((opcode (aref byte-vector i))
-	     (symbol (find-symbol-name opcode))
-	     (inst-type (get symbol 'romp-instruction-type)))
-	(case inst-type
-	  (ji (print-ji-instruction opcode byte-vector i branches)
-	      (setq i (the fixnum (+ i 2))))
-	  (x (print-x-instruction opcode byte-vector i branches)
-	     (setq i (the fixnum (+ i 2))))
-	  (ds (print-ds-instruction opcode byte-vector i branches function)
-	      (setq i (the fixnum (+ i 2))))
-	  (r (print-r-instruction opcode byte-vector i branches)
-	     (setq i (the fixnum (+ i 2))))
-	  (bi (print-bi-instruction opcode byte-vector i branches)
-	      (setq i (the fixnum (+ i 4))))
-	  (ba (print-ba-instruction opcode byte-vector i branches)
-	      (setq i (the fixnum  (+ i 4))))
-	  (d (setq i (the fixnum
-			  (+ i (the fixnum
-				    (print-d-instruction opcode byte-vector i
-							 branches function ))))))
-	  (T (error "Illegal instruction type: ~A for instruction ~A.~%"
-		    inst-type symbol)))))))
-
-
-(defun find-symbol-name (opcode)
-  (declare (fixnum opcode))
-  (let ((symbol (svref romp-4bit-opcode-symbol (logand (the fixnum (ash opcode -4)) #xFF))))
-    (if symbol
-	symbol
-	(svref romp-8bit-opcode-symbol opcode))))
-		  
-
-;;;   BRANCH-LIST is very much like output-macro-instructions,
-;;;   but instead of actually creating all the instructions it just
-;;;   creates the branch instruction labels.  A list of these labels
-;;;   is returned.
-
-
-(defun branch-list (function)
-  (let* ((byte-vector
-	  (%primitive header-ref function %function-code-slot))
-	 (vector-length (length byte-vector))
-	 (branches nil))
-    (declare (fixnum vector-length))
-    (do ((i 0))
-	((>= i vector-length))
-      (declare (fixnum i))
-      (let* ((opcode (aref byte-vector i))
-	     (symbol (find-symbol-name opcode))
-             (inst-type (get symbol 'romp-instruction-type)))
-	(case inst-type
-	  (ji (push (the fixnum (+ i (the fixnum (sign-extend-ji byte-vector i)))) branches)
-	      (setq i (the fixnum (+ i 2))))
-	  ((x ds r) (setq i (the fixnum (+ i 2))))
-	  (bi (push (the fixnum (+ i (the fixnum (sign-extend-bi byte-vector i)))) branches)
-	      (setq i (the fixnum (+ i 4))))
-	  ((ba d) (setq i (the fixnum (+ i 4))))
-	  (T (error "Unknown instruction type: ~A, for instruction ~A.~%"
-		    inst-type symbol)))))
-    branches))
-
-(defun print-ji-instruction (opcode byte-vector index branches)
-  (declare (fixnum opcode index))
-  (format t "~6D~A  (~A ~A ~A)~%"
-	  index (if (memq index branches) "*" " ")
-	  (if (= (logand opcode #x8) 0) "JNB" "JB")
-	  (romp-condition-code (+ 8 (logand opcode #x7)))
-	  `(**address** ,(the fixnum (+ index (the fixnum (sign-extend-ji byte-vector index)))))))
-
-(defun print-x-instruction (opcode byte-vector index branches)
-  (declare (fixnum opcode index))
-  (let* ((rega (get-register-name (logand opcode #xF)))
-	 (operand (aref byte-vector (the fixnum (1+ index))))
-	 (regb (get-register-name (logand (the fixnum (ash operand -4)) #xF)))
-	 (regc (get-register-name (logand operand #xF)))
-	 (star (if (memq index branches) "*" " ")))
-    (declare (fixnum operand))
-    (if (eq regc 'NL0)
-	(cond ((and (eq rega 'NL0) (eq regb 'NL0))
-	       (format t "~6D~A  (LR NL0 NL0)		; Padding for previous execute instruction.~%"
-		       index star))
-	      (T (format t "~6D~A  (LR ~A ~A)~%"
-			 index (if (memq index branches) "*" " ")
-			 rega regb)))
-	(format t "~6D~A  (CAS ~A ~A ~A)~%"
-		index (if (memq index branches) "*" " ")
-		rega regb regc))))
-
-(defun print-ds-instruction (opcode byte-vector index branches function)
-  (declare (fixnum opcode index))
-  (let* ((symbol (find-symbol-name opcode))
-	 (operand (aref byte-vector (the fixnum (1+ index))))
-	 (rega (get-register-name (logand (the fixnum (ash operand -4)) #xF)))
-	 (regb (get-register-name (logand operand #xF)))
-	 (offset (ash (logand opcode #xF) 2)))
-    (declare (fixnum offset operand))
-    (cond ((and (memq symbol '(ls sts))
-		(memq regb '(ENV CONT)))
-	   (print-special-access symbol rega regb offset function
-				 index branches))
-	  (T (format t "~6D~A  (~A ~A ~A ~A)~%"
-		     index (if (memq index branches) "*" " ")
-		     (symbol-name symbol)
-		     (get-register-name (logand (the fixnum (ash operand -4)) #xF))
-		     (get-register-name (logand operand #xF))
-		     (case symbol
-		       ((ls sts) (ash (logand opcode #xF) 2))
-		       ((lhs lhas sths) (ash (logand opcode #xF) 1))
-		       (T (logand opcode #xF))))))))
-
-(defun print-r-instruction (opcode byte-vector index branches)
-  (declare (fixnum index opcode))
-  (let* ((symbol (find-symbol-name opcode))
-	 (operand (aref byte-vector (the fixnum (1+ index))))
-	 (rega (logand (the fixnum (ash operand -4)) #xF))
-	 (regb (logand operand #xF)))
-    (declare (fixnum operand))
-    (cond ((memq symbol '(inc dec lis mftbil mftbiu mttbil mttbiu
-			      ais cis sis clrbl clrbu setbl setbu
-			      sari sari16 sri sri16 srpi srpi16
-			      sli sli16 slpi slpi16))
-	   (format t "~6D~A  (~A ~A ~A)~%"
-		   index (if (memq index branches) "*" " ")
-		   (symbol-name symbol)
-		   (get-register-name rega)
-		   regb))
-	  ((memq symbol '(bbr bbrx bnbr bnbrx))
-	   (format t "~6D~A  (~A ~A ~A)~%"
-		   index (if (memq index branches) "*" " ")
-		   (symbol-name symbol)
-		   (romp-condition-code rega)
-		   (get-register-name regb)))
-	  ((memq symbol '(mts mfs))
-	   (format t "~6D~A  (~A ~A ~A)~%"
-		   index (if (memq index branches) "*" " ")
-		   (symbol-name symbol)
-		   rega regb))
-	  ((memq symbol '(clrsb setsb))
-	   (format t "~6D~A  (~A ~A ~A)~%"
-		   index (if (memq index branches) "*" " ")
-		   (symbol-name symbol)
-		   rega regb))
-	  (T (format t "~6D~A  (~A ~A ~A)~%"
-		     index (if (memq index branches) "*" " ")
-		     (symbol-name symbol)
-		     (get-register-name rega)
-		     (get-register-name regb))))))
-
-(defun print-bi-instruction (opcode byte-vector index branches)
-  (declare (fixnum index opcode))
-  (let* ((symbol (find-symbol-name opcode))
-	 (cc (romp-condition-code
-	      (logand (ash (the fixnum (aref byte-vector (the fixnum (1+ index)))) -4) #xF)))
-	 (label (the fixnum (+ index (the fixnum (sign-extend-bi byte-vector index))))))
-    (format t "~6D~A  (~A ~A ~A)~%"
-	    index (if (memq index branches) "*" " ")
-	    (symbol-name symbol) cc `(**address** ,label))))
-
-(defun print-ba-instruction (opcode byte-vector index branches)
-  (declare (fixnum index opcode))
-  (let* ((symbol (find-symbol-name opcode))
-	 (operand (the fixnum (logior (ash (the fixnum (aref byte-vector (the fixnum (1+ index)))) 16)
-				      (ash (the fixnum (aref byte-vector (the fixnum (+ index 2)))) 8)
-				      (the fixnum (aref byte-vector (the fixnum (+ index 3)))))))
-	 (miscop (find-miscop-name operand)))
-    (format t "~6D~A  (~A ~A)		; Call miscop ~A.~%"
-	    index (if (memq index branches) "*" " ")
-	    (symbol-name symbol)
-	    miscop
-	    miscop))
-  4)
-
-(defun print-d-instruction (opcode byte-vector index branches function)
-  (declare (fixnum index opcode))
-  (let* ((symbol (find-symbol-name opcode))
-	 (operand (aref byte-vector (the fixnum (1+ index))))
-	 (rega (get-register-name (logand (the fixnum (ash operand -4)) #xF)))
-	 (regb (get-register-name (logand operand #xF)))
-	 (offset (sign-extend-d byte-vector index)))
-    (declare (fixnum offset operand))
-    (cond ((eq symbol 'ci)
-	   (format t"~6D~A  (~A ~A ~A)~%"
-		   index (if (memq index branches) "*" " ")
-		   (symbol-name symbol)
-		   rega offset)
-	   4)
-	  ((and (memq symbol '(l st))
-		(memq regb '(ENV CONT)))
-	   (print-special-access symbol rega regb offset function
-				 index branches)
-	   4)
-	  (T (format t "~6D~A  (~A ~A ~A ~A)~A~%"
-		     index (if (memq index branches) "*" " ")
-		     (symbol-name symbol)
-		     rega regb offset
-		     (if (eq (setq offset (logand offset #xFFFF)) nil-16)
-			 "		; NIL."
-			 (if (eq offset t-16)
-			     "		; T."
-			     "")))
-	     4))))
-
-
-(defun print-special-access (symbol rega regb offset function index branches)
-  (declare (fixnum index offset))
-  (let ((star (if (memq index branches) "*" " "))
-	(*print-level* 3)
-	(*print-length* 10))
-    (cond
-     ((not (eq regb 'ENV))
-      (format t "~6D~A  (~A ~A ~A ~A)		; Stack slot ~D.~%"
-	      index star (symbol-name symbol)
-	      rega regb offset
-	      (ash offset -2)))
-     ((= offset (ash %function-code-slot 2))
-      (format t "~6D~A  (~A ~A ~A ~A)		; Function code.~%"
-	      index star (symbol-name symbol)
-	      rega regb offset))
-     ((= offset (ash %function-offset-slot 2))
-      (format t "~6D~A  (~A ~A ~A ~A)		; Function offset.~%"
-	      index star (symbol-name symbol)
-	      rega regb offset))
-     (t
-      (format t "~6D~A  (~A ~A ~A ~A)		; Constant: ~S.~%"
-	      index star (symbol-name symbol)
-	      rega regb offset
-	      (%primitive header-ref
-			  (%primitive header-ref function
-				      %function-entry-constants-slot)
-			  (ash (the fixnum
-				    (- offset g-vector-header-size)) -2)))))))
-
-
-(defun sign-extend-ji (byte-vector index)
-  (declare (fixnum index))
-  (let ((byte (aref byte-vector (the fixnum (1+ index)))))
-    (declare (fixnum byte))
-    (ash (if (= (logand byte #x80) 0)
-	     byte
-	     (the fixnum (- (the fixnum (1+ (logand (lognot byte) #x7F))))))
-	 1)))
-
-(defun sign-extend-bi (byte-vector index)
-  (declare (fixnum index))
-  (let ((int (logior (the fixnum (ash (logand (the fixnum (aref byte-vector (the fixnum (1+ index)))) #xF) 16))
-		     (the fixnum (ash (aref byte-vector (the fixnum (+ index 2))) 8))
-		     (the fixnum (aref byte-vector (the fixnum (+ index 3)))))))
-    (declare (fixnum int))
-    (ash (if (= (logand int #x80000) 0)
-	     int
-	     (the fixnum (- (the fixnum (1+ (logand (lognot int) #x7FFFF))))))
-	 1)))
-
-(defun sign-extend-d (byte-vector index)
-  (declare (fixnum index))
-  (let ((hword (logior (the fixnum (ash (aref byte-vector (the fixnum (+ index 2))) 8))
-		       (the fixnum (aref byte-vector (the fixnum (+ index 3)))))))
-    (declare (fixnum hword))
-    (if (= (logand hword #x8000) 0)
-	hword
-	(the fixnum (- (the fixnum (1+ (logand (lognot hword) #xFFFF))))))))
-
-(defun romp-condition-code (cc)
-  (if (<= 8 cc 16)
-      (svref '#(pz lt eq gt cz reserved ov tb) (- cc 8))
-      '??))
-
-(defun get-register-name (reg)
-  (svref '#(NL0 A0 NL1 A1 A3 A2 SP L0 L1 L2 L3 L4 BS CONT ENV PC) reg))
-
-(defvar miscop-cache NIL)
-
-(defun find-miscop-name (index)
-  (if (null miscop-cache) (initialize-miscop-cache))
-  (gethash index miscop-cache))
-
-(defun initialize-miscop-cache ()
-  (setq miscop-cache (make-hash-table :size 500))
-  (do-symbols (x (find-package "CLC"))
-    (let ((v (get x 'lisp::%loaded-address)))
-      (when v
-	(setf (gethash v miscop-cache) x))))
-
-  (dolist (x lisp::*user-defined-miscops*)
-    (setf (gethash (get x 'lisp::%loaded-address) miscop-cache) x)))
diff --git a/assembler/miscasm.lisp b/assembler/miscasm.lisp
deleted file mode 100644
index 346e211f4..000000000
--- a/assembler/miscasm.lisp
+++ /dev/null
@@ -1,44 +0,0 @@
-;;; -*- Mode: Lisp; Package: Compiler -*-
-
-;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
-;;; **********************************************************************
-
-(in-package 'compiler)
-
-(export '(asm asm-files) (find-package 'compiler))
-
-(defun asm (f)
-  (assemble-file (concatenate 'simple-string "miscops:" f ".romp")))
-
-(defun asm-files ()
-  (asm "abs")
-  (asm "allocation")
-  (asm "arith")
-  (asm "array")
-  (asm "byte")
-  (asm "call")
-  (asm "nlx")
-  (asm "compare")
-  (asm "divide")
-  (asm "gc")
-  (asm "gcd")
-  (asm "irrat")
-  (asm "list")
-  (asm "logic")
-  (asm "minus")
-  (asm "misc")
-  (asm "multiply")
-  (asm "negate")
-  (asm "plus")
-  (asm "print")
-  (asm "predicate")
-  (asm "save")
-  (asm "stack")
-  (asm "symbol")
-  (asm "system")
-  (asm "truncate"))
diff --git a/assembler/rompconst.lisp b/assembler/rompconst.lisp
deleted file mode 100644
index b653257d2..000000000
--- a/assembler/rompconst.lisp
+++ /dev/null
@@ -1,1097 +0,0 @@
-;;; -*- Mode: Lisp; Package: Compiler; Log: clc.log -*-
-;;;
-;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
-;;; **********************************************************************
-;;;
-;;; Constants for the Romp.
-;;; Written by: David B. McDonald and Skef Wholey.
-;;;
-
-(in-package "COMPILER")
-
-
-;;; Utilities for hacking header objects.
-
-(defmacro load-slot (value object index)
-  `(loadw ,value ,object (ash (+ ,index g-vector-header-size-in-words) 2)))
-
-(defmacro store-slot (value object index)
-  `(storew ,value ,object (ash (+ ,index g-vector-header-size-in-words) 2)))
-
-
-;;; Pointer manipulation macros.
-
-(defmacro get-type-mask-16 (type)
-  `(ash ,type type-shift-16))
-
-(defmacro get-address-16 (type space)
-  `(logior (ash ,type type-shift-16)
-	   (ash ,space space-shift-16)))
-
-
-(defmacro romp-immed-fixnum-p (object)
-  `(let ((thing ,object))
-     (and (fixnump thing)
-	  (>= (the fixnum thing) (the fixnum romp-min-immed-number))
-	  (<= (the fixnum thing) (the fixnum romp-max-immed-number)))))
-
-(defmacro romp-short-fixnum-p (object)
-  `(let ((thing ,object))
-     (and (fixnump thing)
-	(>= (the fixnum thing) (the fixnum romp-min-short-immed-number))
-	(<= (the fixnum thing) (the fixnum romp-max-short-immed-number)))))
-
-(defmacro romp-fixnum-p (object)
-  `(let ((thing ,object))
-     (and (fixnump thing)
-	(>= (the fixnum thing) (the fixnum romp-min-fixnum))
-	(<= (the fixnum thing) (the fixnum romp-max-fixnum)))))
-
-
-;;; Registers are given a separate namespace from the constants.  Registers are
-;;; defined using the Register macro.  Constants can be defined using the Lisp
-;;; Defconstant.  Numbers may be used in place of registers.
-
-(defmacro register (name value)
-  `(setf (get ',name '%assembler-register) ,value))
-
-(defun registerp (name)
-  (and (symbolp name) (get name '%assembler-register)))
-
-(defmacro float-register (name value)
-  `(setf (get ',name '%assembler-float-register) ,value))
-
-(defun float-register-p (name)
-  (and (symbolp name) (get name '%assembler-float-register)))
-
-(defun eval-register (form)
-  (cond ((numberp form) form)
-	((symbolp form) (or (get form '%assembler-register)
-			    (get form '%assembler-float-register)))
-	(t (clc-error "~S can't be used as a register." form))))
-
-(defun translate-romp-type (register type label not-flag)
-  (case type
-    (+fixnum `((cmpi ,register type-+-fixnum)
-	       (,(get-branch-to-use label not-flag '+fixnum) ,label)))
-    (-fixnum `((cmpi ,register type-negative-fixnum)
-	       (,(get-branch-to-use label not-flag '-fixnum) ,label)))
-    (fixnum `((cmpi ,register type-+-fixnum)
-	      (,(get-branch-to-use label not-flag '+fixnum) ,label)
-	      (cmpi ,register type-negative-fixnum)
-	      (,(get-branch-to-use label not-flag '-fixnum) ,label)))
-    (bignum `((cmpi ,register type-bignum)
-	      (,(get-branch-to-use label not-flag) ,label)))
-    (ratio `((cmpi ,register type-ratio)
-	     (,(get-branch-to-use label not-flag) ,label)))
-    (+short-float `((cmpi ,register type-short-float-low)
-		    (,(get-branch-to-use label not-flag) ,label)))
-    (-short-float `((cmpi ,register type-short-float-high)
-		    (,(get-branch-to-use label not-flag) ,label)))
-    (short-float
-     (let ((tag (gensym "L")))
-       `((cmpi ,register type-short-float-low)
-	 (blt ,(if not-flag label tag))
-	 (cmpi ,register type-short-float-high)
-	 (,(if not-flag 'bgt 'ble) ,label)
-	 ,tag)))
-#|
-    (single-float `((cmpi ,register type-single-float)
-		    (,(get-branch-to-use label not-flag) ,label)))
-|#
-    (long-float `((cmpi ,register type-long-float)
-		  (,(get-branch-to-use label not-flag) ,label)))
-    (complex `((cmpi ,register type-complex)
-	       (,(get-branch-to-use label not-flag) ,label)))
-    (string `((cmpi ,register type-string)
-	      (,(get-branch-to-use label not-flag) ,label)))
-    (bit-vector `((cmpi ,register type-bit-vector)
-		  (,(get-branch-to-use label not-flag) ,label)))
-    (i-vector `((cmpi ,register type-i-vector)
-		      (,(get-branch-to-use label not-flag) ,label)))
-    (g-vector `((cmpi ,register type-g-vector)
-		      (,(get-branch-to-use label not-flag) ,label)))
-    (array `((cmpi ,register type-array)
-	     (,(get-branch-to-use label not-flag) ,label)))
-    (function `((cmpi ,register type-function)
-		(,(get-branch-to-use label not-flag) ,label)))
-    (symbol `((cmpi ,register type-symbol)
-	      (,(get-branch-to-use label not-flag) ,label)))
-    (list `((cmpi ,register type-list)
-	    (,(get-branch-to-use label not-flag) ,label)))
-    (control-stack-pointer `((cmpi ,register type-control-stack-pointer)
-			     (,(get-branch-to-use label not-flag) ,label)))
-    (binding-stack-pointer `((cmpi ,register type-binding-stack-pointer)
-			     (,(get-branch-to-use label not-flag) ,label)))
-    (gc-forward `((cmpi ,register type-gc-forward)
-		  (,(get-branch-to-use label not-flag) ,label)))
-    (string-char `((cmpi ,register type-string-char)
-		   (,(get-branch-to-use label not-flag) ,label)))
-    (trap `((cmpi ,register type-trap)
-	    (,(get-branch-to-use label not-flag) ,label)))
-    ((T))
-    (T (clc-error "Unknow type ~A to type-dispatch macro." type))))
-
-(defun get-branch-to-use (label not-flag &optional fixnum)
-  (cond ((eq label 'PC)
-	 (if (eq fixnum '+fixnum)
-	     (if not-flag 'brgt 'brle)
-	     (if (eq fixnum '-fixnum)
-		 (if not-flag 'brlt 'brge)
-		 (if not-flag 'brne 'breq))))
-	(T (if (eq fixnum '+fixnum)
-	       (if not-flag 'bgt 'ble)
-	       (if (eq fixnum '-fixnum)
-		   (if not-flag 'blt 'bge)
-		   (if not-flag 'bne 'beq))))))
-
-(defmacro type-dispatch (register &rest forms)
-    (do* ((form-list forms (cdr form-list))
-	  (form (car form-list) (car form-list))
-	  (label (gensym "L") (gensym))
-	  (type-code NIL)
-	  (clause-code NIL))
-	 ((null form-list)
-	  (append type-code clause-code))
-      (let ((types (cond ((listp (car form)) (car form))
-			 (t (list (car form)))))
-	    (label (if (and (cadr form) (atom (cadr form)))
-		       (cadr form) label))
-	    (not-flag (let ((next-form (cadr form-list)))
-			(cond ((and next-form
-				    (eq (car next-form) 'T)
-				    (cadr next-form)
-				    (atom (cadr next-form))
-				    (not (and (cadr form) (atom (cadr form)))))
-			       (setq form-list nil)
-			       (cadr next-form))))))
-	(if not-flag (setq label not-flag))
-	(dolist (x types)
-	  (setq type-code
-		(append type-code
-			(translate-romp-type register x label not-flag))))
-	(cond ((and (memq T types) (not (null (cdr form))) (atom (cadr form)))
-	       (setq type-code (append type-code `((b ,(cadr form))))))
-	      ((memq T types)
-	       (setq type-code
-		     (append type-code (cdr form)))
-	       (setq form-list nil))
-	      ((and (cdr form) (atom (cadr form))))
-	      ((null not-flag)
-	       (setq clause-code
-		     (append clause-code (list label) (cdr form))))
-	      (T (setq type-code (append type-code (cdr form))))))))
-
-(defmacro access-i-vector (vector index access-code)
-  (case access-code
-    ((0 1 2)
-     `((lr	NL1 ,index)
-       (sri	NL1 ,(case access-code (0 3) (1 2) (2 1)))
-       (cas	NL1 NL1 ,vector)
-       (loadc	NL0 NL1 i-vector-header-size)
-       (nilz	NL1 ,index ,(case access-code (0 #x7) (1 #x3) (2 #x1)))
-       (xil	NL1 NL1 ,(case access-code (0 #x7) (1 #x3) (2 #x1)))
-       ,@(case access-code (0 nil) (1 `((sli NL1 1))) (2 `((sli NL1 2))))
-       (sr	NL0 NL1)
-       (brx	PC)
-       (nilz	A0 NL0 ,(case access-code (0 #x1) (1 #x3) (2 #xF)))))
-    (3
-     `((cas	NL1 ,vector ,index)
-       (brx	PC)
-       (loadc	A0 NL1 i-vector-header-size)))
-    (4
-     `((sli	,index 1)
-       (cas	NL1 ,vector ,index)
-       (brx	PC)
-       (loadh	A0 NL1 i-vector-header-size)))
-    (5 (let* ((tag1 (gensym))
-	      (tag2 (gensym)))
-	 `((sli ,index 2)		; Get index to word.
-	   (cas NL1 ,vector ,index)
-	   (loadw NL0 NL1 i-vector-header-size) ; Pickup 32 bit quantity
-	   (srpi16 NL0 fixnum?-shift-16) ; Shift bits to a more useful place.
-	   (bne ,tag1)			; Not a fixnum, go create a bignum
-	   (brx PC)		 	; Return it as a fixnum.
-	   (cas A0 NL0 0)		; Put into return register.
-,tag1
-	   (xiu NL1 NL0 #x8000)		; 1 or 2 word bignum?
-
-	   (bnex ,tag2)
-	   (loadi A1 (+ bignum-header-size 8)) ; Assume two word.
-	   (noop)			; For execute.
-
-	   (loadi A1 (+ bignum-header-size 4)) ; A one word bignum.
-,tag2
-	   (allocate A0 type-bignum A1 A2 A3) ; Allocate a bignum.
-	   (storew NL0 A0 bignum-header-size) ; Store result in bignum.
-	   (sri A1 2)
-	   (brx PC)			; Return to caller.
-	   (storew A1 A0 0))))		; Store word count in bignum header.
-    (T (clc-error "Illegal access code (~A) in access-i-vector."
-		  access-code))))
-
-(defmacro store-i-vector (vector index access-code value)
-  (case access-code
-    ((0 1 2)
-     `((cas	NL1 ,index 0)
-       (sri	NL1 ,(case access-code (0 3) (1 2) (2 1)))
-       (cas	NL1 NL1 ,vector)
-       (loadc	NL0 NL1 i-vector-header-size)
-       (nilz	,index ,index ,(case access-code (0 #x7) (1 #x3) (2 #x1)))
-       (xil	,index ,index ,(case access-code (0 #x7) (1 #x3) (2 #x1)))
-       ,@(case access-code (0 nil) (1 `((sli ,index 1))) (2 `((sli ,index 2))))
-       (nilz	,value ,value ,(case access-code (0 #x1) (1 #x3) (2 #xF)))
-       (lr	A0 ,value)
-       (sl	,value ,index)
-       (lis	A3 ,(case access-code (0 #x1) (1 #x3) (2 #xF)))
-       (sl	A3 ,index)
-       (onec	A3 A3)
-       (n	NL0 A3)
-       (o	NL0 ,value)
-       (brx	PC)
-       (storec	NL0 NL1 i-vector-header-size)))
-    (3
-     `((cas	NL1 ,vector ,index)
-       (lr	A0 ,value)
-       (brx	PC)
-       (storec	,value NL1 i-vector-header-size)))
-    (4
-     `((sli	,index 1)
-       (cas	NL1 ,vector ,index)
-       (lr	A0 ,value)
-       (brx	PC)
-       (storeha ,value NL1 i-vector-header-size)))
-    (5 (let ((tag1 (gensym)))
-	 `((sli ,index 2)		; Get index to word.
-	   (cas NL1 ,index ,vector)
-	   (get-type ,value NL0)		; Get type of object.
-	   (cmpi NL0 type-bignum)	; Bignum?
-	   (beq ,tag1)	; Yes, go process it.
-	   (storew ,value NL1 i-vector-header-size) ; Assume fixnum and store it.
-	   (brx PC)			; Return to caller.
-	   (lr A0 ,value)		; Put into return register.
-,tag1
-	   (loadw NL0 ,value bignum-header-size) ; Pull out low order 32 bits.
-	   (storew NL0 NL1 i-vector-header-size) ; Store it into vector.
-	   (brx PC)
-	   (lr A0 ,value))))
-    (T (clc-error "Illegal access code (~A) in access-i-vector."
-		  access-code))))
-
-;;; The bit-bash-loop macro is used to generate code for the various operations
-;;; in the bit-bash misc-op.  It accepts a list of instructions, that should
-;;; only modify NL0 and NL1 leaving the result in NL0.
-
-(defmacro bit-bash-loop (operation-code)
-  (let ((loop-label (gensym "LABEL-"))
-	(done-label (gensym "LABEL-")))
-    `((lr	A3 NL0)
-      ,loop-label
-      (dec	A3 4)
-      (cmpi	A3 i-vector-header-size)
-      (blt	,done-label)
-      (cas	NL1 A0 A3)
-      (loadw	NL0 NL1 0)
-      (cas	NL1 A1 A3)
-      (loadw	NL1 NL1 0)
-      ,@operation-code
-      (cas	NL1 A2 A3)
-      (bx	,loop-label)
-      (storew	NL0 NL1 0)
-      ,done-label
-      (brx	PC)
-      (lr	A0 A2))))
-
-;;; Macro to call a conversion routine inside an arithmetic miscop.
-
-(defmacro call-conversion-routine (conversion-routine register)
-  `((inc CS 12)			; Make room on for A0, A1, PC.
-    (storew PC CS 0)		; Store PC
-    (storew A0 CS -4)		; Store A0.
-    ,@(unless (eq register 'A0) `((cas A0 ,register 0)))
-    
-    (mo-callx ,conversion-routine) ; Convert A0 to whatever.
-    (storew A1 CS -8)		; while saving A1.
-
-    (cas A2 A0 0)		; Get returned 
-    (loadw PC CS 0)		; Restore PC
-    (loadw A1 CS -8)		; Get A1 back.
-    (loadw A0 CS -4)		; Restore A0.
-    (dec CS 12)))		; Restore Stack pointer.
-
-(defmacro save-registers (&rest registers)
-  (let ((amount (ash (length registers) 2)))
-    (do* ((i 0 (1+ i))
-	  (reg-list registers (cdr reg-list))
-	  (register (car reg-list) (car reg-list))
-	  (inst-list NIL))
-	 ((null reg-list)
-	  `(,(if (< amount 16) `(inc CS ,amount) `(cal CS CS ,amount))
-	    ,@(nreverse inst-list)))
-      (push `(storew ,register CS ,(- (ash (1+ i) 2) amount)) inst-list))))
-
-(defmacro restore-registers (&rest registers)
-  (let ((amount (ash (length registers) 2)))
-    (do* ((i 0 (1+ i))
-	  (reg-list registers (cdr reg-list))
-	  (register (car reg-list) (car reg-list))
-	  (inst-list NIL))
-	 ((null reg-list)
-	  `(,@(nreverse inst-list)
-	    ,(if (< amount 16) `(dec CS ,amount) `(cal CS CS ,(- amount)))))
-      (push `(loadw ,register CS ,(- (ash (1+ i) 2) amount)) inst-list))))
-
-(defmacro save-registers-PC (&rest registers)
-  (let ((amount (+ (ash (length registers) 2) 8)))
-    (do* ((i 0 (1+ i))
-	  (reg-list registers (cdr reg-list))
-	  (register (car reg-list) (car reg-list))
-	  (inst-list NIL))
-	 ((null reg-list)
-	  `(,(if (< amount 16) `(inc CS ,amount) `(cal CS CS ,amount))
-	    ,@(nreverse inst-list)
-	    (stm AF CS -4)))
-      (push `(storew ,register CS ,(- (ash (1+ i) 2) amount)) inst-list))))
-
-(defmacro restore-registers-PC (&rest registers)
-  (let ((amount (+ (ash (length registers) 2) 8)))
-    (do* ((i 0 (1+ i))
-	  (reg-list registers (cdr reg-list))
-	  (register (car reg-list) (car reg-list))
-	  (inst-list NIL))
-	 ((null reg-list)
-	  `(,@(nreverse inst-list)
-	    (lm AF CS -4)
-	    (storew BS CS 0)			; Clobber return PC.
-	    ,(if (< amount 16) `(dec CS ,amount) `(cal CS CS ,(- amount)))))
-      (if register
-	  (push `(loadw ,register CS ,(- (ash (1+ i) 2) amount)) inst-list)))))
-
-(defmacro save-registers-internal-PC (&rest registers)
-  (let ((amount (+ (ash (length registers) 2) 4)))
-    (do* ((i 0 (1+ i))
-	  (reg-list registers (cdr reg-list))
-	  (register (car reg-list) (car reg-list))
-	  (inst-list NIL))
-	 ((null reg-list)
-	  `(,(if (< amount 16) `(inc CS ,amount) `(cal CS CS ,amount))
-	    ,@(nreverse inst-list)
-	    (storew PC CS 0)))
-      (push `(storew ,register CS ,(- (ash (1+ i) 2) amount)) inst-list))))
-
-(defmacro restore-registers-internal-PC (&rest registers)
-  (let ((amount (+ (ash (length registers) 2) 4)))
-    (do* ((i 0 (1+ i))
-	  (reg-list registers (cdr reg-list))
-	  (register (car reg-list) (car reg-list))
-	  (inst-list NIL))
-	 ((null reg-list)
-	  `(,@(nreverse inst-list)
-	    (loadw PC CS 0)
-	    ,(if (< amount 16) `(dec CS ,amount) `(cal CS CS ,(- amount)))))
-      (if register
-	  (push `(loadw ,register CS ,(- (ash (1+ i) 2) amount)) inst-list)))))
-
-;;; Macros to call misc-ops and internal assembler routines
-
-(defmacro mo-call (routine)
-  `((bali PC ,routine)))
-
-(defmacro mo-callx (routine)
-  `((balix PC ,routine)))
-
-(defmacro load-global-addr (register offset)
-  `((cau ,register 0 romp-data-base)
-    (oil ,register ,register ,offset)))
-
-(defmacro load-global (register offset &optional (base NIL base-defined))
-  (if (not base-defined) (setq base register))
-  `((cau ,base 0 romp-data-base)
-    (loadw ,register ,base ,offset)))
-
-(defmacro load-multiple-global (register offset
-					 &optional (base NIL base-defined))
-  (if (not base-defined) (setq base register))
-  `((cau ,base 0 romp-data-base)
-    (lm ,register ,base ,offset)))
-
-(defmacro store-global (register offset &optional (base 'NL1))
-  `((cau ,base 0 romp-data-base)
-    (storew ,register ,base ,offset)))
-
-(defmacro store-multiple-global (register offset &optional (base 'NL1))
-  `((cau ,base 0 romp-data-base)
-    (stm ,register ,base ,offset)))
-
-(defmacro load-symbol-addr (register offset)
-  `((cau ,register 0 (get-address-16 type-symbol static-space))
-    (oil ,register ,register ,offset)))
-
-(defmacro load-symbol-offset (register symbol-offset offset)
-  `((cau ,register 0 (get-address-16 type-symbol static-space))
-    (loadw ,register ,register (+ ,symbol-offset ,offset))))
-
-(defmacro store-symbol-offset (register symbol-offset offset &optional (base 'NL1))
-  `((cau ,base 0 (get-address-16 type-symbol static-space))
-    (storew ,register ,base (+ ,symbol-offset ,offset))))
-
-;;; Escape-Routine  --  Interface
-;;;
-;;;    Call the function that is the definition of the symbol at the specifed
-;;; offset, passing Nargs arguments.  The arguments should already be set up in
-;;; A0..A3.  The function must take no more than 4 arguments and return no more
-;;; than 3 values.  We make an "escape frame" and save the entire register set
-;;; in it.  If the called function returns, we restore the saved registers
-;;; *except* for A<N> and NL<N>.  This is so that we return the values returned
-;;; by the escape routine, rather than restoring whatever garbage was in the
-;;; argument registers before the call.  We only saved the arg registers for
-;;; the benefit of the debugger.
-;;;
-(defmacro escape-routine (symbol-offset nargs)
-  (unless (<= 0 nargs 4)
-    (error "Losing NARGS: ~D." nargs))
-  ;; Allocate frame+1 to preserve the assembly-level stack top.
-  `((cal SP SP (* 4 (1+ %escape-frame-size)))
-    ;; Clear type bits in unboxed registers so that GC doesn't gag.  If these
-    ;; hold user fixnum or string-char variables, then this won't destroy the
-    ;; info.
-    (niuo NL0 NL0 clc::type-not-mask-16)
-    (niuo NL1 NL1 clc::type-not-mask-16)
-    ;; Save all registers...
-    (stm NL0 CS (* 4 (- (- %escape-frame-size
-			   %escape-frame-general-register-start-slot))))
-    ;; Save current FP as OLD-FP.
-    (storew FP SP (* 4 (+ (- %escape-frame-size) c::old-fp-save-offset)))
-    ;; Compute escape frame start from SP.
-    (cal FP SP (* 4 (- %escape-frame-size)))
-    ;; Store escape frame start in to register save area as old SP, since we
-    ;; trashed SP before saving registers.
-    (storew FP FP (* 4 (+ %escape-frame-general-register-start-slot
-			      c::sp-offset)))
-    ;; Zero ENV save area to indicate an escape frame.
-    (loadi NL1 0)
-    (storew NL1 FP (* 4 c::env-save-offset))
-    ;; Save miscop return PC as PC escape frame is returning to.
-    (storew PC FP (* 4 c::return-pc-save-offset))
-
-    ;; Get definition
-    (load-symbol-offset ENV ,symbol-offset symbol-definition)
-    ;; Get entry offset (in bytes, including header size).
-    (loadw PC ENV (+ g-vector-header-size (* 4 %function-offset-slot)))
-    ;; Get code vector.
-    (loadw NL1 ENV (+ g-vector-header-size (* 4 %function-code-slot)))
-    ;; Compute entry PC.
-    (cas PC PC NL1)
-    (lr OLD-FP FP) ; OLD-FP gets escape frame.
-    (lr FP SP) ; So escape frame doesn't get overwritten.
-    ;;
-    ;; If 4 args, set up arg frame.
-    ,@(when (= nargs 4)
-	'((cal SP SP (* 4 4))
-	  (storew A3 SP -4)))
-    ;; 
-    ;; Call, giving this miscop as return PC for escape frame.
-    (balrx PC PC)
-    (lis NARGS ,nargs) ; Load argument count
-    (noop)
-    (cal 0 0 0) ; 32bit noop for single-value return.
-    ;; Now restore all registers except for A<N> and NL<N>.
-    ;; FP should be restored to the escape frame by returning function.
-    (lm SP FP (* 4 (+ %escape-frame-general-register-start-slot
-			c::sp-offset)))
-    ;; Return to caller.
-    (br PC)))
-
-
-;;; The Allocate macro allocates a chunk of storage, frobing the free pointers
-;;; of the correct space and possibly invoking the garbage collector.  A newly
-;;; allocated object of the given Type and Length is left in the specified
-;;; Register.  The Length may be a constant or a register.
-
-;;; We take advantage of the fact that a GC will never happen during execution
-;;; of a miscop.  Things get significantly hairier if that is not true.
-
-(defmacro allocate (reg type length temp1 temp2)
-  `((load-symbol-offset ,temp1 current-allocation-space-offset symbol-value)
-    (oil ,temp1 ,temp1 (ash ,type 5))		; or in type
-    (cau ,temp1 ,temp1 alloc-table-address-16)	; add alloc-type address
-    (loadw ,reg ,temp1)				; fetch free pointer
-    ,@(if (registerp length)			; update free pointer
-	  `((cas ,temp2 ,length ,reg))
-	  `((cal ,temp2 ,reg ,length)))
-    (storew ,temp2 ,temp1)))			; write free pointer back to memory
-
-(defmacro static-allocate (reg type length temp1 temp2)
-  `((cau ,temp1 0 alloc-table-address-16)
-    (oil ,temp1 ,temp1 (+ (ash ,type 5) 16))
-    (loadw ,reg ,temp1)
-    ,@(if (registerp length)
-	  `((cas ,temp2 ,reg ,length))
-	  `((cal ,temp2 ,reg ,length)))
-    (storew ,temp2 ,temp1)))
-
-;;; Check-pc-for-interrupt checks to see if a miscops got interrupted
-;;; before it entered an interruptable state.
-
-(defmacro check-pc-for-interrupt ()
-  (let ((l (gensym)))
-    `((srpi16 PC type-shift-16)
-      (bne ,l)
-      (load-global PC interrupt-pc)
-      (cau L0 0 interrupted-16)
-      ,l)))
-
-(defmacro service-interrupt ()
-  `((xiu L0 L0 interrupted-16)
-    (brnex PC)
-    (cau L0 0 nil-16)
-    (store-global PC interrupt-pc NL1)
-    (load-global PC interrupt-routine)))
-
-;;; Various ranges for fixnums on the Romp.
-
-(eval-when (compile load eval)
-  (defconstant romp-code-base #x0020)
-  (defconstant romp-data-base #x0010)
-)
-
-(defconstant romp-min-immed-number (1- (- #x7fff)))
-(defconstant romp-max-immed-number #x7fff)
-
-(defconstant romp-min-short-immed-number 0)
-(defconstant romp-max-short-immed-number 15)
-
-(defconstant romp-max-fixnum #x7FFFFFF)
-(defconstant romp-min-fixnum (1- (- romp-max-fixnum)))
-
-(defconstant Page-Size 8192)
-(defconstant Page-Mask-16 #x1FFF)
-(defconstant Page-Not-Mask-16 #xE000)
-(defconstant Page-Shift-16 13)
-
-;;; Type codes:
-
-(eval-when (compile load eval)
-  (defconstant type-+-fixnum 0)
-  (defconstant type-gc-forward 1)
-  (defconstant type-trap 4)
-  (defconstant type-bignum 5)
-  (defconstant type-ratio 6)
-  (defconstant type-complex 7)
-  (defconstant type-+-short-float 8)
-  (defconstant type---short-float 9)
-  (defconstant type-double-float 10)
-  (defconstant type-long-float 10)
-  (defconstant type-string 11)
-  (defconstant type-bit-vector 12)
-  (defconstant type-i-vector 13)
-  (defconstant type-code-vector 14)
-  (defconstant type-g-vector 15)
-  (defconstant type-array 16)
-  (defconstant type-function 17)
-  (defconstant type-symbol 18)
-  (defconstant type-list 19)
-  (defconstant type-control-stack-pointer 20)
-  (defconstant type-binding-stack-pointer 21)
-  (defconstant type-assembler-code 0)
-
-
-  (defconstant type-short-float 8)
-  (defconstant type-short-float-low 8)
-  (defconstant type-short-float-high 9)
-
-  (defconstant type-string-char 26)
-  (defconstant type-bitsy-char 27)
-  (defconstant type-interruptable 28)
-
-  (defconstant type-negative-fixnum 31)
-
-  (defconstant first-pointer-type 4)
-  (defconstant last-pointer-type 19)
-  (defconstant first-lisp-pointer-type 4)
-  (defconstant last-lisp-pointer-type 21)
-)
-
-;;; Header sizes and offsets to access words in Lisp objects.
-
-(defconstant bignum-header-size 4)
-(defconstant bignum-header-size-in-words 1)
-(defconstant bignum-header-words 0)
-
-(defconstant ratio-numerator 0)
-(defconstant ratio-denominator 4)
-
-(defconstant float-header-size 4)
-(defconstant float-header-size-in-words 1)
-(defconstant long-float-size 12)
-#|
-(defconstant single-float-size 8)
-(defconstant single-float-data 4)
-|#
-(defconstant long-float-high-data 4)
-(defconstant long-float-low-data 8)
-(defconstant short-float-shift-16 4)
-(defconstant short-float-4bit-type #x4)
-(defconstant short-float-4bit-mask-16 #x4000)
-(defconstant float-compare-shift-16 9)
-(defconstant mc68881-compare-shift-16 10)
-(defconstant float-compare-mask-16 #x3)
-(defconstant mc68881-compare-mask-16 #x3)
-(defconstant float-compare-equal 1)
-
-(defconstant short-float-zero-16 #x4000)
-(defconstant single-float-one #x3F80)
-(defconstant long-float-one #x3FF0)
-(defconstant short-float-one
-  (logior (ash short-float-4bit-type (- 16 short-float-shift-16))
-	  (ash single-float-one (- short-float-shift-16))))
-(defconstant single-float-minus-one #xBF80)
-(defconstant long-float-minus-one #xBFF0)
-(defconstant short-float-minus-one
-  (logior (ash short-float-4bit-type (- 16 short-float-shift-16))
-	  (ash single-float-minus-one (- short-float-shift-16))))
-
-(defconstant complex-realpart 0)
-(defconstant complex-imagpart 4)
-(defconstant complex-size 8)
-
-(defconstant vector-subtype-byte 0)
-
-(defconstant string-header-size 8)
-(defconstant string-header-words 0)
-(defconstant string-header-entries 4)
-
-(defconstant bit-vector-header-size 8)
-(defconstant bit-vector-header-words 0)
-(defconstant bit-vector-header-entries 4)
-
-(defconstant i-vector-header-size 8)
-(defconstant i-vector-header-size-in-words 2)
-(defconstant i-vector-header-words 0)
-(defconstant i-vector-header-entries 4)
-(defconstant i-vector-access-byte 4)
-
-(defconstant iv-access-code-1 0)
-(defconstant iv-access-code-2 1)
-(defconstant iv-access-code-4 2)
-(defconstant iv-access-code-8 3)
-(defconstant iv-access-code-16 4)
-(defconstant iv-access-code-32 5)
-
-(defconstant g-vector-header-size 4)
-(defconstant g-vector-header-size-in-words 1)
-(defconstant g-vector-header-words 0)
-
-(defconstant array-header-size 20)
-(defconstant array-header-size-in-words 5)
-(defconstant array-header-words 0)
-(defconstant array-data-vector 4)
-(defconstant array-nelements 8)
-(defconstant array-fill-pointer 12)
-(defconstant array-displacement 16)
-
-(defconstant function-header-size 24)
-(defconstant function-header-size-in-words 6)
-(defconstant function-header-words 0)
-(defconstant function-nconstants 4)
-(defconstant function-code 8)
-(defconstant function-arginfo 12)
-(defconstant min-arg-count-mask-16 #xFF)
-(defconstant max-arg-count-mask-16 #xFF00)
-(defconstant max-arg-shift-16 8)
-(defconstant function-symbol 16)
-(defconstant function-arguments 20)
-
-(defconstant symbol-size 20)
-(defconstant symbol-value 0)
-(defconstant symbol-definition 4)
-(defconstant symbol-property-list 8)
-(defconstant symbol-print-name 12)
-(defconstant symbol-package 16)
-
-(defconstant cons-size 8)
-(defconstant list-size 8)
-(defconstant list-car 0)
-(defconstant list-cdr 4)
-
-(defconstant frame-size 36)
-(defconstant frame-size-in-words 9)
-(defconstant frame-saved-l0 0)
-(defconstant frame-saved-l1 4)
-(defconstant frame-saved-l2 8)
-(defconstant frame-saved-l3 12)
-(defconstant frame-saved-l4 16)
-(defconstant frame-binding-stack 20)
-(defconstant frame-active-frame 24)
-(defconstant frame-active-function 28)
-(defconstant frame-pc 32)
-
-(defconstant catch-frame-size 24)
-(defconstant catch-frame-size-in-words 6)
-(defconstant catch-binding-stack 0)
-(defconstant catch-active-frame 4)
-(defconstant catch-active-function 8)
-(defconstant catch-pc 12)
-(defconstant catch-tag-caught 16)
-(defconstant catch-prev-catch 20)
-
-(defconstant binding-symbol 4)
-(defconstant binding-value 0)
-
-;;; Structure for the link table.
-
-(defconstant lt-vector-size 5)
-(defconstant lt-access-code 5)
-(defconstant lt-nargs-ac 4)
-
-(defconstant lt-link-table-size 8192)
-(defconstant lt-log-table-size 13)
-(defconstant link-table-end-in-bytes
-  (+ i-vector-header-size (ash lt-link-table-size 3)))
-(defconstant lt-table-count 4)
-(defconstant lt-symbol-table 8)
-(defconstant lt-nargs-table 12)
-(defconstant lt-link-table 16)
-(defconstant lt-next-table 20)
-
-;;; Masks and shifts for various operations on the ROMP.
-
-(eval-when (compile load eval)
-  (defconstant type-mask-16 #xF800)
-  (defconstant type-not-mask-16 #x7FF)
-  (defconstant type-shift-16 11)
-
-  (defconstant space-mask-16 #x0600)
-  (defconstant space-shift-16 9)
-  (defconstant dynamic-space-mask-16 #x0200)
-)
-
-(defconstant space-mask-result-16 #x3)
-
-(defconstant dynamic-0-space 0)
-(defconstant dynamic-1-space 1)
-(defconstant static-space 2)
-(defconstant read-only-space 3)
-
-(defconstant nil-16 (get-address-16 type-list static-space))
-(defconstant t-16 (get-address-16 type-symbol static-space))
-(defconstant trap-16 (ash type-trap type-shift-16))
-
-(defconstant interruptable-16 (get-type-mask-16 type-interruptable))
-(defconstant interrupted-16 (+ (get-type-mask-16 type-interruptable) 1))
-
-(defconstant g-vector-words-mask-16 #x00FF)
-(defconstant right-shifted-subtype-mask-16 #x0007)
-(defconstant subtype-shift-16 8)
-(defconstant subtype-mask-16 #x0700)
-(defconstant g-vector-must-rehash #x0400)
-(defconstant i-vector-entries-mask-16 #x0FFF)
-(defconstant i-vector-words-mask-16 #x00FF)
-(defconstant access-code-shift-byte-16 4)
-(defconstant access-code-shift-word-16 12)
-
-(defconstant access-code-1-mask-16 #x0000)
-(defconstant access-code-2-mask-16 #x1000)
-(defconstant access-code-4-mask-16 #x2000)
-(defconstant access-code-8-mask-16 #x3000)
-(defconstant access-code-16-mask-16 #x4000)
-(defconstant access-code-32-mask-16 #x5000)
-
-(defconstant fixnum-mask-16 #xF800)
-(defconstant fixnum-not-mask-16 #x07FF)
-(defconstant fixnum-bits 28)
-(defconstant fixnum-sign-bit-16 4)
-(defconstant fixnum-shift-16 4)
-(defconstant fixnum?-shift-16 11)
-(defconstant most-negative-fixnum-16 #xF800)
-(defconstant smallest-+-bignum-16 #x0800)
-(defconstant smallest-positive-bignum-address-16
-  (get-address-16 type-bignum static-space))
-(defconstant least-negative-bignum-offset 8)
-
-;;; Define values for the boole operations.
-
-(defconstant boole-clr 0)
-(defconstant boole-set 1)
-(defconstant boole-1 2)
-(defconstant boole-2 3)
-(defconstant boole-c1 4)
-(defconstant boole-c2 5)
-(defconstant boole-and 6)
-(defconstant boole-ior 7)
-(defconstant boole-xor 8)
-(defconstant boole-eqv 9)
-(defconstant boole-nand 10)
-(defconstant boole-nor 11)
-(defconstant boole-andc1 12)
-(defconstant boole-andc2 13)
-(defconstant boole-orc1 14)
-(defconstant boole-orc2 15)
-
-;;; Register definitions.
-
-(register r0 0)
-(register r1 1)
-(register r2 2)
-(register r3 3)
-(register r4 4)
-(register r5 5)
-(register r6 6)
-(register r7 7)
-(register r8 8)
-(register r9 9)
-(register r10 10)
-(register r11 11)
-(register r12 12)
-(register r13 13)
-(register r14 14)
-(register r15 15)
-
-(register NArgs 0)		; Number of arguments to a function.
-(register nl0 0)		; Unboxed scratch
-(register a0 1)			; First argument and return value
-(register nl1 2)		; Unboxed scratch
-(register a1 3)			; Second argument
-(register t0 4)			; Boxed scratch
-(register a3 4)			; Fourth arg to some misc-ops.
-(register a2 5)			; Third argument
-(register cs 6)			; Control Stack Pointer (old name)
-(register sp 6)			; Stack pointer
-(register l0 7)			; Boxed Temporary
-(register l1 8)			; Boxed Temporary
-(register l2 9)			; Boxed Temporary
-(register name 9)		; Name of function we are trying to call
-(register l3 10)		; Boxed Temporary
-(register old-fp 10)		; Fp to return to
-(register old-cont 10)		; Fp to return to (old name)
-(register l4 11)		; Boxed Temporary
-(register args 11)		; Pointer to stack arguments
-(register bs 12)		; Binding Stack Pointer
-(register fp 13)		; Frame Pointer 
-(register cont 13)		; Current Fp (old name)
-(register af 14)		; Active Function Pointer (old name)
-(register env 14)		; Current constant pool, called function.
-(register pc 15)		; PC, Return PC for misc-ops, and
-(register st 15)		; Super Temporary (old name)
-(register t1 15)		; Boxed scratch
-
-;;; Floating point hardware types.
-
-(defconstant float-none 0)
-(defconstant float-fpa 2)
-(defconstant float-afpa 4)
-(defconstant float-mc68881 1)
-
-;;; Error codes.
-
-(defconstant error-not-list 1)
-(defconstant error-not-symbol 2)
-(defconstant error-object-not-number 3)
-(defconstant error-object-not-integer 4)
-(defconstant error-object-not-ratio 5)
-(defconstant error-object-not-complex 6)
-(defconstant error-object-not-vector 7)
-(defconstant error-object-not-simple-vector 8)
-(defconstant error-illegal-function 9)
-(defconstant error-object-not-header 10)
-(defconstant error-object-not-i-vector 11)
-(defconstant error-object-not-simple-bit-vector 12)
-(defconstant error-object-not-simple-string 13)
-(defconstant error-object-not-character 14)
-(defconstant error-not-control-stack-pointer 15)
-(defconstant error-not-binding-stack-pointer 16)
-(defconstant error-object-not-array 17)
-(defconstant error-object-not-non-negative-fixnum 18)
-(defconstant error-object-not-sap-pointer 19)
-(defconstant error-object-not-system-pointer 20)
-(defconstant error-object-not-float 21)
-(defconstant error-object-not-rational 22)
-(defconstant error-object-not-non-complex-number 23)
-
-(defconstant error-symbol-unbound 25)
-(defconstant error-symbol-undefined 26)
-(defconstant error-modify-nil 27)
-(defconstant error-modify-t 28)
-
-(defconstant error-bad-access-code 30)
-(defconstant error-bad-vector-length 31)
-(defconstant error-index-out-of-range 32)
-(defconstant error-illegal-index 33)
-(defconstant error-illegal-shrink-value 34)
-(defconstant error-not-a-shrink 35)
-(defconstant error-illegal-data-vector 36)
-(defconstant error-too-few-indices 37)
-(defconstant error-too-many-indices 38)
-
-(defconstant error-illegal-byte-specifier 40)
-(defconstant error-illegal-position-in-byte-spec 41)
-(defconstant error-illegal-size-in-byte-spec 42)
-(defconstant error-illegal-shift-count 43)
-(defconstant error-illegal-boole-operation 44)
-
-(defconstant error-wrong-number-args 50)
-
-(defconstant error-not-<= 55)
-
-(defconstant error-divide-by-zero 60)
-(defconstant error-unseen-throw-tag 61)
-(defconstant error-short-float-underflow 62)
-(defconstant error-short-float-overflow 63)
-#|
-(defconstant error-single-float-underflow 64)
-(defconstant error-single-float-overflow 65)
-|#
-(defconstant error-long-float-underflow 66)
-(defconstant error-long-float-overflow 67)
-(defconstant error-monadic-short-underflow 68)
-(defconstant error-monadic-short-overflow 69)
-(defconstant error-monadic-long-underflow 70)
-(defconstant error-monadic-long-overflow 71)
-
-(defconstant error-log-of-zero 72)
-
-(defconstant error-object-not-string-char 73)
-(defconstant error-object-not-short-float 74)
-(defconstant error-object-not-long-float 75)
-(defconstant error-object-not-fixnum 76)
-(defconstant error-object-not-cons 77)
-
-(defconstant error-invalid-exit 78)
-
-(defconstant error-odd-keyword-arguments 79)
-(defconstant error-unknown-keyword-argument 80)
-(defconstant error-object-not-type 81)
-(defconstant error-object-not-function-or-symbol 82)
-(defconstant error-not-= 83)
-
-
-;;; Addresses of memory blocks used by the assembler routines.
-
-(defconstant alloc-table-address-16 romp-data-base)
-(defconstant alloc-table-address (ash alloc-table-address-16 16))
-(defconstant mc68881-float-temporary (+ (ash romp-data-base 16) #x10000))
-(defconstant get-real-time (+ (ash romp-data-base 16) #x20000))
-(defconstant get-run-time (+ (ash romp-data-base 16) #x20008))
-(defconstant alloc-table-size 2048)
-
-(defconstant prime-table-offset	(+ alloc-table-size 0))
-(defconstant mo-nargs-nil-routine-addr (+ alloc-table-size 64))
-(defconstant mo-nargs-t-routine-addr (+ alloc-table-size 68))
-(defconstant check-nargs-t-addr (+ alloc-table-size 72))
-(defconstant current-catch-block (+ alloc-table-size 76))
-(defconstant space-address (+ alloc-table-size 80))
-(defconstant newspace-address (+ alloc-table-size 84))
-(defconstant gc-save-NL0 (+ alloc-table-size 88))
-(defconstant gc-save-NL1 (+ alloc-table-size 92))
-(defconstant gc-save-CS (+ alloc-table-size 96))
-(defconstant gc-save-BS (+ alloc-table-size 100))
-(defconstant mo-no-entry-routine-addr (+ alloc-table-size 104))
-(defconstant save-c-stack-pointer (+ alloc-table-size 108))
-(defconstant current-unwind-protect-block (+ alloc-table-size 112))
-(defconstant interrupt-signal (+ alloc-table-size 116))
-(defconstant interrupt-code (+ alloc-table-size 120))
-(defconstant interrupt-scp (+ alloc-table-size 124))
-(defconstant interrupt-pc (+ alloc-table-size 128))
-(defconstant interrupt-routine (+ alloc-table-size 132))
-(defconstant interrupt-reset-pc (+ alloc-table-size 136))
-(defconstant interrupt-old-r5 (+ alloc-table-size 140))
-(defconstant in-call-foreign (+ alloc-table-size 144))
-(defconstant in-cf-save-regs-ptr (+ alloc-table-size 148))
-(defconstant software-interrupt-offset (+ alloc-table-size 152))
-(defconstant floating-point-hardware-available (+ alloc-table-size 156))
-(defconstant bignum-cache-timestamp (+ alloc-table-size 160))
-(defconstant bignum-cache-hits (+ alloc-table-size 164))
-(defconstant bignum-cache-table (+ alloc-table-size 168))
-(defconstant bignum-cache-bignums (+ alloc-table-size 172))
-(defconstant get-time-buffer (+ alloc-table-size 300))
-
-;;; Define offsets from the begining of static symbol space for all the symbols
-;;; that the assembler code needs to know about.
-
-(defconstant %sp-t-offset 0)
-(defconstant %sp-internal-apply-offset 20)
-(defconstant %sp-internal-error-offset 40)
-(defconstant %sp-software-interrupt-handler-offset 60)
-(defconstant %sp-internal-throw-tag-offset 80)
-(defconstant %sp-initial-function-offset 100)
-(defconstant %link-table-header-offset 120)
-(defconstant current-allocation-space-offset 140)
-(defconstant %sp-bignum/fixnum 160)
-(defconstant %sp-bignum/bignum 180)
-(defconstant %sp-fixnum/bignum 200)
-(defconstant %sp-abs-ratio 220)
-(defconstant %sp-abs-complex 240)
-(defconstant %sp-negate-ratio 260)
-(defconstant %sp-negate-complex 280)
-(defconstant %sp-integer+ratio 300)
-(defconstant %sp-ratio+ratio 320)
-(defconstant %sp-complex+number 340)
-(defconstant %sp-number+complex 360)
-(defconstant %sp-complex+complex 380)
-(defconstant %sp-1+ratio 400)
-(defconstant %sp-1+complex 420)
-(defconstant %sp-integer-ratio 440)
-(defconstant %sp-ratio-integer 460)
-(defconstant %sp-ratio-ratio 480)
-(defconstant %sp-complex-number 500)
-(defconstant %sp-number-complex 520)
-(defconstant %sp-complex-complex 540)
-(defconstant %sp-1-ratio 560)
-(defconstant %sp-1-complex 580)
-(defconstant %sp-integer*ratio 600)
-(defconstant %sp-ratio*ratio 620)
-(defconstant %sp-number*complex 640)
-(defconstant %sp-complex*number 660)
-(defconstant %sp-complex*complex 680)
-(defconstant %sp-integer/ratio 700)
-(defconstant %sp-ratio/integer 720)
-(defconstant %sp-ratio/ratio 740)
-(defconstant %sp-number/complex 760)
-(defconstant %sp-complex/number 780)
-(defconstant %sp-complex/complex 800)
-(defconstant %sp-integer-truncate-ratio 820)
-(defconstant %sp-ratio-truncate-integer 840)
-(defconstant %sp-ratio-truncate-ratio 860)
-(defconstant %sp-number-truncate-complex 880)
-(defconstant %sp-complex-truncate-number 900)
-(defconstant %sp-complex-truncate-complex 920)
-(defconstant maybe-gc 940)
-(defconstant lisp-environment-list 960)
-(defconstant call-lisp-from-c 980)
-(defconstant lisp-command-line-list 1000)
-(defconstant *nameserverport*-offset 1020)
-(defconstant *ignore-floating-point-underflow*-offset 1040)
-(defconstant lisp::%sp-sin-rational 1060)
-(defconstant lisp::%sp-sin-short 1080)
-(defconstant lisp::%sp-sin-long 1100)
-(defconstant lisp::%sp-sin-complex 1120)
-(defconstant lisp::%sp-cos-rational 1140)
-(defconstant lisp::%sp-cos-short 1160)
-(defconstant lisp::%sp-cos-long 1180)
-(defconstant lisp::%sp-cos-complex 1200)
-(defconstant lisp::%sp-tan-rational 1220)
-(defconstant lisp::%sp-tan-short 1240)
-(defconstant lisp::%sp-tan-long 1260)
-(defconstant lisp::%sp-tan-complex 1280)
-(defconstant lisp::%sp-atan-rational 1300)
-(defconstant lisp::%sp-atan-short 1320)
-(defconstant lisp::%sp-atan-long 1340)
-(defconstant lisp::%sp-atan-complex 1360)
-(defconstant lisp::%sp-exp-rational 1380)
-(defconstant lisp::%sp-exp-short 1400)
-(defconstant lisp::%sp-exp-long 1420)
-(defconstant lisp::%sp-exp-complex 1440)
-(defconstant lisp::%sp-log-rational 1460)
-(defconstant lisp::%sp-log-short 1480)
-(defconstant lisp::%sp-log-long 1500)
-(defconstant lisp::%sp-log-complex 1520)
-(defconstant lisp::%sp-sqrt-rational 1540)
-(defconstant lisp::%sp-sqrt-short 1560)
-(defconstant lisp::%sp-sqrt-long 1580)
-(defconstant lisp::%sp-sqrt-complex 1600)
-(defconstant *eval-stack-top*-offset 1620)
diff --git a/assembler/ropdefs.lisp b/assembler/ropdefs.lisp
deleted file mode 100644
index 37bf970f1..000000000
--- a/assembler/ropdefs.lisp
+++ /dev/null
@@ -1,221 +0,0 @@
-;;; -*- Mode: Lisp; Package: Compiler -*-
-
-;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
-;;; **********************************************************************
-
-;;; This file defines the instruction set for the Common Lisp Romp Assembler
-;;; used by the compiler.
-
-;;; Written by David B. McDonald.
-
-(in-package 'Compiler)
-
-(defvar romp-4bit-opcode-symbol (make-array 16))
-(defvar romp-8bit-opcode-symbol (make-array 256))
-
-;;; Define-Romp-Instruction defines a Romp instruction to the assembler.
-;;; It accepts three arguments:
-;;;	romp-instruction is a symbol whose pname is the name of a Romp instruction
-;;;	romp-inst-type specifies the underlying type of the Romp instruction.
-;;;		it must have one of the following values: JI, X, DS, R, BI, BA,
-;;;		or D.
-;;;	romp-code specifies the numeric op code for the instruction.
-
-
-(defmacro Define-Romp-Instruction (romp-instruction romp-inst-type romp-code)
-  `(progn (setf (get ',romp-instruction 'romp-instruction-type)
-		',romp-inst-type)
-	  (setf (get ',romp-instruction 'romp-operation-code)
-		,romp-code)
-	  ,(case romp-inst-type
-	     (ji
-	      `(setf (svref romp-4bit-opcode-symbol 0) ',romp-instruction))
-	     ((x ds)
-	      `(setf (svref romp-4bit-opcode-symbol ,romp-code) ',romp-instruction))
-	     ((r bi ba d)
-	      `(setf (svref romp-8bit-opcode-symbol ,romp-code) ',romp-instruction))
-	     (T
-	      (error "Illegal instruction type: ~A, for instruction ~A (~A).~%"
-		     romp-inst-type romp-instruction romp-code)))))
-
-;;; Define-Romp-Branch defines a Romp branch instruction to the assembler.  It
-;;; accepts three arguments:
-;;;     romp-branch is a symbol whose pname is the name of a branch instruction.
-;;;     romp-instruction is the underlying romp-instruction that should be used
-;;;             used to implement the branch instruction.
-;;;     condition-code specifies the bit of the condition code that should be
-;;;             be tested to implement the branch.
-
-(defmacro Define-Romp-Branch (romp-branch romp-instruction condition-code)
-  `(progn (setf (get ',romp-branch 'romp-branch-instruction)
-		',romp-instruction)
-	  (setf (get ',romp-branch 'romp-condition-code)
-		,condition-code)))
-
-;;; Define-Condition-Code associates the integer code for a particular condition
-;;; code bit with a symbol.  It accepts a symbol and a value.
-
-(defmacro Define-Condition-Code (condition-code value)
-  `(setf (get ',condition-code 'condition-code) ,value))
-
-;;; Storage Access Instructions.
-
-(define-romp-instruction lcs ds #x4)
-(define-romp-instruction lc d #xCE)
-(define-romp-instruction lhas ds #x5)
-(define-romp-instruction lha d #xCA)
-(define-romp-instruction lhs r #xEB)
-(define-romp-instruction lh d #xDA)
-(define-romp-instruction ls ds #x7)
-(define-romp-instruction l d #xCD)
-(define-romp-instruction lm d #xC9)
-(define-romp-instruction tsh d #xCF)
-(define-romp-instruction stcs ds #x1)
-(define-romp-instruction stc d #xDE)
-(define-romp-instruction sths ds #x2)
-(define-romp-instruction sth d #xDC)
-(define-romp-instruction sts ds #x3)
-(define-romp-instruction st d #xDD)
-(define-romp-instruction stm d #xD9)
-
-;;; Address Computation Instructions.
-
-(define-romp-instruction cal d #xC8)
-(define-romp-instruction cal16 d #xC2)
-(define-romp-instruction cau d #xD8)
-(define-romp-instruction cas x #x6)
-(define-romp-instruction ca16 r #xF3)
-(define-romp-instruction inc r #x91)
-(define-romp-instruction dec r #x93)
-(define-romp-instruction lis r #xA4)
-
-;;; Basic Romp Branch Instructions.
-
-(define-romp-instruction bala ba #x8A)
-(define-romp-instruction balax ba #x8B)
-(define-romp-instruction bali bi #x8C)
-(define-romp-instruction balix bi #x8D)
-(define-romp-instruction balr r #xEC)
-(define-romp-instruction balrx r #xED)
-(define-romp-instruction jb ji #x1)
-(define-romp-instruction bb bi #x8E)
-(define-romp-instruction bbx bi #x8F)
-(define-romp-instruction bbr r #xEE)
-(define-romp-instruction bbrx r #xEF)
-(define-romp-instruction jnb ji #x0)
-(define-romp-instruction bnb bi #x88)
-(define-romp-instruction bnbx bi #x89)
-(define-romp-instruction bnbr r #xE8)
-(define-romp-instruction bnbrx r #xE9)
-
-;;; Romp Trap Instrunctions.
-
-(define-romp-instruction ti d #xCC)
-(define-romp-instruction tgte r #xBD)
-(define-romp-instruction tlt r #xBE)
-
-;;; Romp Move and Insert Instructions.
-
-(define-romp-instruction mc03 r #xF9)
-(define-romp-instruction mc13 r #xFA)
-(define-romp-instruction mc23 r #xFB)
-(define-romp-instruction mc33 r #xFC)
-(define-romp-instruction mc30 r #xFD)
-(define-romp-instruction mc31 r #xFE)
-(define-romp-instruction mc32 r #xFF)
-(define-romp-instruction mftb r #xBC)
-(define-romp-instruction mftbil r #x9D)
-(define-romp-instruction mftbiu r #x9C)
-(define-romp-instruction mttb r #xBF)
-(define-romp-instruction mttbil r #x9F)
-(define-romp-instruction mttbiu r #x9E)
-
-;;; Romp Arithmetic Instructions.
-
-(define-romp-instruction a r #xE1)
-(define-romp-instruction ae r #xF1)
-(define-romp-instruction aei d #xD1)
-(define-romp-instruction ai d #xC1)
-(define-romp-instruction ais r #x90)
-(define-romp-instruction abs r #xE0)
-(define-romp-instruction onec r #xF4)
-(define-romp-instruction twoc r #xE4)
-(define-romp-instruction c r #xB4)
-(define-romp-instruction cis r #x94)
-(define-romp-instruction ci d #xD4)
-(define-romp-instruction cl r #xB3)
-(define-romp-instruction cli d #xD3)
-(define-romp-instruction exts r #xB1)
-(define-romp-instruction s r #xE2)
-(define-romp-instruction sf r #xB2)
-(define-romp-instruction se r #xF2)
-(define-romp-instruction sfi d #xD2)
-(define-romp-instruction sis r #x92)
-(define-romp-instruction d r #xB6)
-(define-romp-instruction m r #xE6)
-
-;;; Romp Logical Operations
-
-(define-romp-instruction clrbl r #x99)
-(define-romp-instruction clrbu r #x98)
-(define-romp-instruction setbl r #x9B)
-(define-romp-instruction setbu r #x9A)
-(define-romp-instruction n r #xE5)
-(define-romp-instruction nilz d #xC5)
-(define-romp-instruction nilo d #xC6)
-(define-romp-instruction niuz d #xD5)
-(define-romp-instruction niuo d #xD6)
-(define-romp-instruction o r #xE3)
-(define-romp-instruction oil d #xC4)
-(define-romp-instruction oiu d #xC3)
-(define-romp-instruction x r #xE7)
-(define-romp-instruction xil d #xC7)
-(define-romp-instruction xiu d #xD7)
-(define-romp-instruction clz r #xF5)
-
-;;; Romp Shift Instructions
-
-(define-romp-instruction sar r #xB0)
-(define-romp-instruction sari r #xA0)
-(define-romp-instruction sari16 r #xA1)
-(define-romp-instruction sr r #xB8)
-(define-romp-instruction sri r #xA8)
-(define-romp-instruction sri16 r #xA9)
-(define-romp-instruction srp r #xB9)
-(define-romp-instruction srpi r #xAC)
-(define-romp-instruction srpi16 r #xAD)
-(define-romp-instruction sl r #xBA)
-(define-romp-instruction sli r #xAA)
-(define-romp-instruction sli16 r #xAB)
-(define-romp-instruction slp r #xBB)
-(define-romp-instruction slpi r #xAE)
-(define-romp-instruction slpi16 r #xAF)
-
-;;; Romp System Control Instructions.
-
-(define-romp-instruction mts r #xB5)
-(define-romp-instruction mfs r #x96)
-(define-romp-instruction clrsb r #x95)
-(define-romp-instruction setsb r #x97)
-(define-romp-instruction lps d #xD0)
-(define-romp-instruction wait r #xF0)
-(define-romp-instruction svc d #xC0)
-
-;;; Romp Input/Output Instructions.
-
-(define-romp-instruction ior d #xCB)
-(define-romp-instruction iow d #xDB)
-
-;;; Define bit setting for examining condition codes.
-
-(define-condition-code pz 8)
-(define-condition-code lt 9)
-(define-condition-code eq 10)
-(define-condition-code gt 11)
-(define-condition-code cz 12)
-(define-condition-code ov 14)
-(define-condition-code tb 15)
diff --git a/ldb/Makefile.boot b/ldb/Makefile.boot
deleted file mode 100644
index 0dd96b77d..000000000
--- a/ldb/Makefile.boot
+++ /dev/null
@@ -1,8 +0,0 @@
-# Makefile for generating the real Makefile.
-# $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/Makefile.boot,v 1.3 1991/11/08 00:22:04 wlott Exp $
-#
-
-Makefile: Makefile.orig
-	/usr/cs/lib/cpp < Makefile.orig > Makefile.NEW
-	mv Makefile.NEW Makefile
-	make depend
diff --git a/ldb/Makefile.orig b/ldb/Makefile.orig
deleted file mode 100644
index 55b30e5b0..000000000
--- a/ldb/Makefile.orig
+++ /dev/null
@@ -1,153 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/Makefile.orig,v 1.29 1992/03/06 12:39:06 wlott Exp $ */
-INCLS = -I. -I/usr/misc/.X11/include
-
-SRCS = ldb.c egets.c coreparse.c alloc.c monitor.c print.c \
-	os.c os-common.c arch.c vars.c assem.s parse.c interrupt.c test.c \
-	search.c validate.c gc.c globals.c dynbind.c breakpoint.c \
-	regnames.c backtrace.c bitbash.c save.c purify.c socket.c
-
-OBJS = ldb.o egets.o coreparse.o alloc.o monitor.o print.o \
-	os.o os-common.o arch.o vars.o assem.o parse.o interrupt.o test.o \
-	search.o validate.o gc.o globals.o dynbind.o breakpoint.o \
-	regnames.o backtrace.o bitbash.o save.o purify.o socket.o
-
-#ifdef mips
-CFLAGS = -O ${INCLS}
-UNDEFSYMPATTERN=&
-ASSEMFILE='mips-assem.s'
-ARCH_SRC="mips-arch.c"
-#endif
-
-#ifdef ibmrt
-CFLAGS = -g ${INCLS}
-UNDEFSYMPATTERN=_&
-ASSEMFILE='rt-assem.s'
-ARCH_SRC="rt-arch.c"
-#endif
-
-#ifdef sparc
-CFLAGS = -O ${INCLS}
-UNDEFSYMPATTERN=_&
-ASSEMFILE='sparc-assem.s'
-ARCH_SRC="sparc-arch.c"
-#endif
-
-#ifdef MACH
-OS_SRC=mach-os.c
-OS_LINK_FLAGS=
-OS_SRCS=
-OS_OBJS=
-OS_LIBS=-lmach
-CPP=/usr/cs/lib/cpp
-#else
-#ifdef sun
-OS_SRC=sunos-os.c
-OS_LINK_FLAGS=-Bstatic
-OS_SRCS=fake-mach.c
-OS_OBJS=fake-mach.o
-OS_LIBS=
-#endif
-CPP=/lib/cpp
-#endif
-
-
-all: ldb.map
-
-ldb.map: ldb
-	echo -n 'Map file for ldb version ' > ldb.map
-	cat version >> ldb.map
-	nm -gp ldb >> ldb.map
-
-
-ldb: ${OBJS} ${OS_OBJS} version undefineds
-	echo -n '1 + ' | cat - version | bc > ,version
-	mv ,version version
-	cc ${CFLAGS} -DVERSION=`cat version` -c version.c
-	cc ${OS_LINK_FLAGS} `cat undefineds` -o ,ldb \
-		${OBJS} ${OS_OBJS} version.o \
-		${OS_LIBS} -lm -lc
-	mv -f ,ldb ldb
-
-version:
-	echo 0 > version
-
-undefineds: undefineds.src
-	${CPP} undefineds.src | \
-	sed -e '/^#/d' -e '/^[ 	]*$$/d' -e 's/.*/-u ${UNDEFSYMPATTERN}/' | \
-	sort -u > ,undefineds
-	mv ,undefineds undefineds
-
-assem.s:
-	rm -f assem.s
-	ln -s ${ASSEMFILE} assem.s
-
-os.c:
-	rm -f os.c
-	ln -s ${OS_SRC} os.c
-
-arch.c:
-	rm -f arch.c
-	ln -s ${ARCH_SRC} arch.c
-
-#ifdef mips
-
-/* MIPS specific stuff. */
-
-/* If we get an interrupt while in lisp code, the global pointer */
-/* is trash.  Therefore, we can't use the GP relative addressing */
-/* mode in the interrupt handlers. */
-
-arch.o: arch.c
-	cc ${CFLAGS} -G 0 -c arch.c
-interrupt.o: interrupt.c
-	cc ${CFLAGS} -G 0 -c interrupt.c
-
-assem.o: assem.s lisp.h lispregs.h globals.h
-	as -G 0 -o $@ assem.s
-
-#endif
-
-#ifdef ibmrt
-
-assem.o: assem.s
-	${CPP} assem.s | as -o assem.o
-
-#endif
-
-
-#ifdef sparc
-
-/* We need this shit because as runs the wrong preprocessor. */
-#ifdef MACH
-ASSEMDEFS=-DMACH
-#else
-ASSEMDEFS=-UMACH
-#endif
-
-assem.o: assem.s lisp.h lispregs.h globals.h
-	as -P ${ASSEMDEFS} -o $@ assem.s
-
-#endif
-
-
-socket.o: socket.c
-	cc ${CFLAGS} -DUNIXCONN -c socket.c
-
-lisp.h:
-	@echo "You must run genesis to create lisp.h!"
-	@false
-
-clean:
-	rm -f lisp.h os.c arch.c assem.s undefineds *.o ldb ldb.map
-
-depend: depends
-
-depends: os.c arch.c assem.s
-	rm -f Makefile.BAK
-	ln Makefile Makefile.BAK
-	sed -n '1,/^\/\*@/p' Makefile > Makefile.NEW
-	cc -M ${INCLS} ${SRCS} ${OS_SRCS} | egrep -v ' /usr/' >> Makefile.NEW
-	mv Makefile.NEW Makefile
-	rm Makefile.BAK
-
-/*@ Do not edit anything after this line. */
diff --git a/ldb/alloc.c b/ldb/alloc.c
deleted file mode 100644
index 32eab5774..000000000
--- a/ldb/alloc.c
+++ /dev/null
@@ -1,122 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/alloc.c,v 1.7 1991/10/22 18:36:50 wlott Exp $ */
-#include "lisp.h"
-#include "ldb.h"
-#include "alloc.h"
-#include "globals.h"
-
-#ifdef ibmrt
-#define GET_FREE_POINTER() ((lispobj *)SymbolValue(ALLOCATION_POINTER))
-#define SET_FREE_POINTER(new_value) \
-    (SetSymbolValue(ALLOCATION_POINTER,(lispobj)(new_value)))
-#define GET_GC_TRIGGER() ((lispobj *)SymbolValue(INTERNAL_GC_TRIGGER))
-#define SET_GC_TRIGGER(new_value) \
-    (SetSymbolValue(INTERNAL_GC_TRIGGER,(lispobj)(new_value)))
-#else
-#define GET_FREE_POINTER() current_dynamic_space_free_pointer
-#define SET_FREE_POINTER(new_value) \
-    (current_dynamic_space_free_pointer = (new_value))
-#define GET_GC_TRIGGER() current_auto_gc_trigger
-#define SET_GC_TRIGGER(new_value) \
-    clear_auto_gc_trigger(); set_auto_gc_trigger(new_value);
-#endif
-
-
-
-/****************************************************************
-Allocation Routines.
-****************************************************************/
-
-static lispobj *alloc(bytes)
-int bytes;
-{
-    lispobj *result;
-
-    /* Round to dual word boundry. */
-    bytes = (bytes + lowtag_Mask) & ~lowtag_Mask;
-
-    result = GET_FREE_POINTER();
-    SET_FREE_POINTER(result + (bytes / sizeof(lispobj)));
-
-    if (GET_GC_TRIGGER() && GET_FREE_POINTER() > GET_GC_TRIGGER()) {
-	SET_GC_TRIGGER((char *)GET_FREE_POINTER()
-		       - (char *)current_dynamic_space);
-    }
-
-    return result;
-}
-
-lispobj *alloc_unboxed(type, words)
-int type, words;
-{
-    lispobj *result;
-
-    result = alloc((1 + words) * sizeof(lispobj));
-
-    *result = (lispobj) (words << type_Bits) | type;
-
-    return result;
-}
-
-lispobj alloc_vector(type, length, size)
-int type, length, size;
-{
-    struct vector *result;
-
-    result = (struct vector *)alloc((2 + (length*size + 31) / 32) * sizeof(lispobj));
-
-    result->header = type;
-    result->length = fixnum(length);
-
-    return ((lispobj)result)|type_OtherPointer;
-}
-
-lispobj alloc_cons(car, cdr)
-lispobj car, cdr;
-{
-    struct cons *ptr = (struct cons *)alloc(sizeof(struct cons));
-
-    ptr->car = car;
-    ptr->cdr = cdr;
-
-    return (lispobj)ptr | type_ListPointer;
-}
-
-lispobj alloc_number(n)
-long n;
-{
-    struct bignum *ptr;
-
-    if (-0x20000000 < n && n < 0x20000000)
-        return fixnum(n);
-    else {
-        ptr = (struct bignum *)alloc_unboxed(type_Bignum, 1);
-
-        ptr->digits[0] = n;
-
-	return (lispobj) ptr | type_OtherPointer;
-    }
-}
-
-lispobj alloc_string(str)
-char *str;
-{
-    int len = strlen(str);
-    lispobj result = alloc_vector(type_SimpleString, len+1, 8);
-    struct vector *vec = (struct vector *)PTR(result);
-
-    vec->length = fixnum(len);
-    strcpy(vec->data, str);
-
-    return result;
-}
-
-lispobj alloc_sap(ptr)
-char *ptr;
-{
-    struct sap *sap = (struct sap *)alloc_unboxed(type_Sap, 1);
-
-    sap->pointer = ptr;
-
-    return (lispobj) sap | type_OtherPointer;
-}
-
diff --git a/ldb/alloc.h b/ldb/alloc.h
deleted file mode 100644
index 4ca5f1446..000000000
--- a/ldb/alloc.h
+++ /dev/null
@@ -1,3 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/alloc.h,v 1.1 1990/02/24 19:37:11 wlott Exp $ */
-
-lispobj alloc_cons(), alloc_string(), alloc_number();
diff --git a/ldb/arch.h b/ldb/arch.h
deleted file mode 100644
index cc363b0f4..000000000
--- a/ldb/arch.h
+++ /dev/null
@@ -1,8 +0,0 @@
-#ifndef __ARCH_H__
-#define __ARCH_H__
-
-extern char *arch_init();
-extern void arch_skip_instruction();
-extern os_vm_address_t arch_get_bad_addr();
-
-#endif /* __ARCH_H__ */
diff --git a/ldb/backtrace.c b/ldb/backtrace.c
deleted file mode 100644
index 1f0b3a1fa..000000000
--- a/ldb/backtrace.c
+++ /dev/null
@@ -1,222 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/backtrace.c,v 1.7 1990/10/22 12:38:28 wlott Exp $
- *
- * Simple backtrace facility.  More or less from Rob's lisp version.
- */
-
-#include <stdio.h>
-#include <signal.h>
-#include "ldb.h"
-#include "lisp.h"
-#include "globals.h"
-#include "interrupt.h"
-#include "lispregs.h"
-
-/* Sigh ... I know what the call frame looks like and it had
-   better not change. */
-
-struct call_frame {
-	struct call_frame *old_cont;
-	lispobj saved_lra;
-        lispobj code;
-	lispobj other_state[5];
-};
-
-struct call_info {
-    struct call_frame *frame;
-    int interrupted;
-    struct code *code;
-    lispobj lra;
-    int pc; /* Note: this is the trace file offset, not the actual pc. */
-};
-
-#define HEADER_LENGTH(header) ((header)>>8)
-
-static struct code *
-code_pointer(object)
-lispobj object;
-{
-    lispobj *headerp, header;
-    int type, len;
-
-    headerp = (lispobj *) PTR(object);
-    header = *headerp;
-    type = TypeOf(header);
-
-    switch (type) {
-        case type_CodeHeader:
-            break;
-        case type_ReturnPcHeader:
-        case type_FunctionHeader:
-        case type_ClosureFunctionHeader:
-            len = HEADER_LENGTH(header);
-            if (len == 0)
-                headerp = NULL;
-            else
-                headerp -= len;
-            break;
-        default:
-            headerp = NULL;
-    }
-
-    return (struct code *) headerp;
-}
-
-static
-cs_valid_pointer_p(pointer)
-struct call_frame *pointer;
-{
-	return (((char *) control_stack <= (char *) pointer) &&
-		((char *) pointer < (char *) current_control_stack_pointer));
-}
-
-static void
-info_from_lisp_state(info)
-struct call_info *info;
-{
-    info->frame = (struct call_frame *)current_control_frame_pointer;
-    info->interrupted = 0;
-    info->code = NULL;
-    info->lra = 0;
-    info->pc = 0;
-
-    previous_info(info);
-}
-
-static void
-info_from_sigcontext(info, csp)
-struct call_info *info;
-struct sigcontext *csp;
-{
-    unsigned long pc;
-
-    info->interrupted = 1;
-    if (LowtagOf(csp->sc_regs[CODE]) == type_FunctionPointer) {
-        /* We tried to call a function, but crapped out before $CODE could be fixed up.  Probably an undefined function. */
-        info->frame = (struct call_frame *)csp->sc_regs[OCFP];
-        info->lra = (lispobj)csp->sc_regs[LRA];
-        info->code = code_pointer(info->lra);
-        pc = (unsigned long)PTR(info->lra);
-    }
-    else {
-        info->frame = (struct call_frame *)csp->sc_regs[CFP];
-        info->code = code_pointer(csp->sc_regs[CODE]);
-        info->lra = NIL;
-        pc = csp->sc_pc;
-    }
-    if (info->code != NULL)
-        info->pc = pc - (unsigned long) info->code -
-            (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
-    else
-        info->pc = 0;
-}
-
-static int
-previous_info(info)
-struct call_info *info;
-{
-    struct call_frame *this_frame;
-    int free;
-    struct sigcontext *csp;
-
-    if (!cs_valid_pointer_p(info->frame)) {
-        printf("Bogus callee value (0x%08x).\n", (unsigned long)info->frame);
-        return 0;
-    }
-
-    this_frame = info->frame;
-    info->lra = this_frame->saved_lra;
-    info->frame = this_frame->old_cont;
-    info->interrupted = 0;
-
-    if (info->frame == NULL || info->frame == this_frame)
-        return 0;
-
-    if (info->lra == NIL) {
-        /* We were interrupted.  Find the correct sigcontext. */
-        free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
-        while (free-- > 0) {
-            csp = lisp_interrupt_contexts[free];
-            if ((struct call_frame *)(csp->sc_regs[CFP]) == info->frame) {
-                info_from_sigcontext(info, csp);
-                break;
-            }
-        }
-    }
-    else {
-        info->code = code_pointer(info->lra);
-        if (info->code != NULL)
-            info->pc = (unsigned long)PTR(info->lra) -
-                (unsigned long)info->code -
-                (HEADER_LENGTH(info->code->header) * sizeof(lispobj));
-        else
-            info->pc = 0;
-    }
-
-    return 1;
-}
-
-void
-backtrace(nframes)
-int nframes;
-{
-    struct call_info info;
-	
-    info_from_lisp_state(&info);
-
-    do {
-        printf("<Frame 0x%08x%s, ", (unsigned long) info.frame,
-                info.interrupted ? " [interrupted]" : "");
-        
-        if (info.code != (struct code *) 0) {
-            lispobj function;
-
-            printf("CODE: 0x%08x, ", (unsigned long) info.code | type_OtherPointer);
-
-            function = info.code->entry_points;
-            while (function != NIL) {
-                struct function_header *header;
-                lispobj name;
-
-                header = (struct function_header *) PTR(function);
-                name = header->name;
-
-                if (LowtagOf(name) == type_OtherPointer) {
-                    lispobj *object;
-
-                    object = (lispobj *) PTR(name);
-
-                    if (TypeOf(*object) == type_SymbolHeader) {
-                        struct symbol *symbol;
-
-                        symbol = (struct symbol *) object;
-                        object = (lispobj *) PTR(symbol->name);
-                    }
-                    if (TypeOf(*object) == type_SimpleString) {
-                        struct vector *string;
-
-                        string = (struct vector *) object;
-                        printf("%s, ", (char *) string->data);
-                    } else
-                        printf("(Not simple string???), ");
-                } else
-                    printf("(Not other pointer???), ");
-
-
-                function = header->next;
-            }
-        }
-        else
-            printf("CODE: ???, ");
-
-        if (info.lra != NIL)
-            printf("LRA: 0x%08x, ", (unsigned long)info.lra);
-        else
-            printf("<no LRA>, ");
-
-        if (info.pc)
-            printf("PC: 0x%x>\n", info.pc);
-        else
-            printf("PC: ???>\n");
-
-    } while (--nframes > 0 && previous_info(&info));
-}
diff --git a/ldb/bitbash.c b/ldb/bitbash.c
deleted file mode 100644
index 0e7314344..000000000
--- a/ldb/bitbash.c
+++ /dev/null
@@ -1,72 +0,0 @@
-
-unsigned long bit_bash_low_masks[] = {
-    0x00000000,
-    0x00000001,
-    0x00000003,
-    0x00000007,
-    0x0000000f,
-    0x0000001f,
-    0x0000003f,
-    0x0000007f,
-    0x000000ff,
-    0x000001ff,
-    0x000003ff,
-    0x000007ff,
-    0x00000fff,
-    0x00001fff,
-    0x00003fff,
-    0x00007fff,
-    0x0000ffff,
-    0x0001ffff,
-    0x0003ffff,
-    0x0007ffff,
-    0x000fffff,
-    0x001fffff,
-    0x003fffff,
-    0x007fffff,
-    0x00ffffff,
-    0x01ffffff,
-    0x03ffffff,
-    0x07ffffff,
-    0x0fffffff,
-    0x1fffffff,
-    0x3fffffff,
-    0x7fffffff,
-    0xffffffff
-};
-
-unsigned long bit_bash_high_masks[] = {
-    0x00000000,
-    0x80000000,
-    0xc0000000,
-    0xe0000000,
-    0xf0000000,
-    0xf8000000,
-    0xfc000000,
-    0xfe000000,
-    0xff000000,
-    0xff800000,
-    0xffc00000,
-    0xffe00000,
-    0xfff00000,
-    0xfff80000,
-    0xfffc0000,
-    0xfffe0000,
-    0xffff0000,
-    0xffff8000,
-    0xffffc000,
-    0xffffe000,
-    0xfffff000,
-    0xfffff800,
-    0xfffffc00,
-    0xfffffe00,
-    0xffffff00,
-    0xffffff80,
-    0xffffffc0,
-    0xffffffe0,
-    0xfffffff0,
-    0xfffffff8,
-    0xfffffffc,
-    0xfffffffe,
-    0xffffffff,
-};
diff --git a/ldb/breakpoint.c b/ldb/breakpoint.c
deleted file mode 100644
index 6e8b68411..000000000
--- a/ldb/breakpoint.c
+++ /dev/null
@@ -1,166 +0,0 @@
-#include <stdio.h>
-#include <signal.h>
-
-#include "ldb.h"
-#include "lisp.h"
-#include "os.h"
-#include "lispregs.h"
-#include "globals.h"
-
-#ifdef ibmrt
-typedef unsigned short inst;
-#else
-typedef unsigned long inst;
-#endif
-
-#define REAL_LRA_SLOT 0
-#define KNOWN_RETURN_P_SLOT 1
-#define BOGUS_LRA_CONSTANTS 2
-
-static inst swap_insts(code_obj, pc_offset, new_inst)
-     lispobj code_obj;
-     int pc_offset;
-     inst new_inst;
-{
-    struct code *code;
-    inst *addr, old_inst;
-
-    code = (struct code *)PTR(code_obj);
-    addr = (inst *)((char *)code + HeaderValue(code->header)*sizeof(lispobj)
-		    + pc_offset);
-    old_inst = *addr;
-    *addr = new_inst;
-    os_flush_icache((os_vm_address_t)addr, sizeof(inst));
-    return old_inst;
-}
-
-inst breakpoint_install(code_obj, pc_offset)
-     lispobj code_obj;
-     int pc_offset;
-{
-    return swap_insts(code_obj, pc_offset,
-#ifdef mips
-		      (trap_Breakpoint << 16) | 0xd
-#endif
-#ifdef sparc
-		      trap_Breakpoint
-#endif
-#ifdef ibmrt
-		      0 /* hack */
-#endif
-	);
-}
-
-void breakpoint_remove(code_obj, pc_offset, orig_inst)
-     lispobj code_obj;
-     int pc_offset;
-     inst orig_inst;
-{
-    swap_insts(code_obj, pc_offset, orig_inst);
-}
-
-static lispobj find_code(scp)
-struct sigcontext *scp;
-{
-    lispobj code = scp->sc_regs[CODE];
-    lispobj header = *(lispobj *)PTR(code);
-
-    switch (TypeOf(header)) {
-      case type_CodeHeader:
-	return code;
-      case type_ReturnPcHeader:
-	return code - HeaderValue(header)*4;
-      case type_FunctionHeader:
-      case type_ClosureFunctionHeader:
-	return code - type_FunctionPointer - HeaderValue(header)*4
-	        + type_OtherPointer;
-      default:
-	crap_out("Strange thing in $CODE at breakpoint.");
-    }
-}
-
-static int calc_offset(code, pc)
-     struct code *code;
-     unsigned long pc;
-{
-    unsigned long code_start;
-    int offset;
-
-    code_start = (unsigned long)code
-	+ HeaderValue(code->header)*sizeof(lispobj);
-    if (pc < code_start)
-	return 0;
-    offset = pc - code_start;
-    if (offset >= code->code_size)
-	return 0;
-    return offset;
-}
-
-int breakpoint_after_offset(scp)
-     struct sigcontext *scp;
-{
-    struct code *code = (struct code *)PTR(find_code(scp));
-
-#ifdef sparc
-    return calc_offset(code, scp->sc_npc);
-#endif
-
-#ifdef mips
-    inst cur_inst = *(inst *)scp->sc_pc;
-    int opcode = cur_inst >> 26;
-    struct sigcontext tmp;
-
-    if (opcode == 1 || ((opcode & 0x3c) == 0x4) || ((cur_inst & 0xf00e0000) == 0x80000000)) {
-	tmp = *scp;
-	emulate_branch(&tmp, cur_inst);
-	return calc_offset(code, tmp.sc_pc);
-    }
-    else
-	return calc_offset(code, scp->sc_pc + 4);
-#endif
-}
-
-static void internal_handle_breakpoint(scp, code)
-struct sigcontext *scp;
-lispobj code;
-{
-    struct code *codeptr = (struct code *)PTR(code);
-    lispobj *args;
-
-    args = current_control_stack_pointer;
-    current_control_stack_pointer += 3;
-    args[0] = fixnum(calc_offset(codeptr, scp->sc_pc));
-    args[1] = code;
-    args[2] = alloc_sap(scp);
-    funcall_sym(HANDLE_BREAKPOINT, args, 3);
-    scp->sc_mask = sigblock(0);
-}
-
-handle_breakpoint(signal, subcode, scp)
-int signal, subcode;
-struct sigcontext *scp;
-{
-    internal_handle_breakpoint(scp, find_code(scp));
-}
-
-handle_function_end_breakpoint(signal, subcode, scp)
-int signal, subcode;
-struct sigcontext *scp;
-{
-    extern char function_end_breakpoint_guts[], function_end_breakpoint_trap[];
-
-    lispobj code = scp->sc_pc - (unsigned long)function_end_breakpoint_trap
-	+ (unsigned long)function_end_breakpoint_guts -
-	((sizeof(struct code)+((BOGUS_LRA_CONSTANTS-1)*sizeof(lispobj))+7)&~7)
-	+ type_OtherPointer;
-    struct code *codeptr = (struct code *)PTR(code);
-    lispobj lra;
-
-    internal_handle_breakpoint(scp, code);
-
-    lra = codeptr->constants[REAL_LRA_SLOT];
-    if (codeptr->constants[KNOWN_RETURN_P_SLOT] == NIL)
-	scp->sc_regs[CODE] = lra;
-    scp->sc_pc = lra - type_OtherPointer+sizeof(lispobj);
-}
-
diff --git a/ldb/core.h b/ldb/core.h
deleted file mode 100644
index 65b013388..000000000
--- a/ldb/core.h
+++ /dev/null
@@ -1,33 +0,0 @@
-#define CORE_PAGESIZE OS_VM_DEFAULT_PAGESIZE
-#define CORE_MAGIC (('C' << 24) | ('O' << 16) | ('R' << 8) | 'E')
-#define CORE_END 3840
-#define CORE_NDIRECTORY 3861
-#define CORE_VALIDATE 3845
-#define CORE_VERSION 3860
-#define CORE_MACHINE_STATE 3862
-
-#define DYNAMIC_SPACE_ID (1)
-#define STATIC_SPACE_ID (2)
-#define READ_ONLY_SPACE_ID (3)
-
-struct ndir_entry {
-	long identifier;
-	long nwords;
-	long data_page;
-	long address;
-	long page_count;
-};
-
-struct machine_state {
-    lispobj *csp;
-    lispobj *fp;
-#ifndef ibmrt
-    lispobj *bsp;
-#endif
-    char *number_stack_start;
-
-    long sigcontext_page;
-    long control_stack_page;
-    long binding_stack_page;
-    long number_stack_page;
-};
diff --git a/ldb/coreparse.c b/ldb/coreparse.c
deleted file mode 100644
index faafb50dc..000000000
--- a/ldb/coreparse.c
+++ /dev/null
@@ -1,143 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/coreparse.c,v 1.8 1991/05/24 17:33:10 wlott Exp $ */
-#include <stdio.h>
-#include <sys/types.h>
-#include <sys/file.h>
-
-#include "ldb.h"
-#include "os.h"
-#include "lisp.h"
-#include "globals.h"
-#include "core.h"
-
-extern int version;
-
-static void process_directory(fd, ptr, count)
-int fd, count;
-long *ptr;
-{
-	long id, offset, len;
-	lispobj *free_pointer;
-	os_vm_address_t addr;
-	struct ndir_entry *entry;
-
-	entry = (struct ndir_entry *) ptr;
-
-	while (count-- > 0) {
-		id = entry->identifier;
-		offset = CORE_PAGESIZE * (1 + entry->data_page);
-		addr = (os_vm_address_t) (CORE_PAGESIZE * entry->address);
-		free_pointer = (lispobj *) addr + entry->nwords;
-		len = CORE_PAGESIZE * entry->page_count;
-
-		if (len != 0) {
-		    os_vm_address_t real_addr;
-#ifdef PRINTNOISE
-		    printf("Mapping %d bytes at 0x%x.\n", len, addr);
-#endif
-		    real_addr=os_map(fd, offset, addr, len);
-		    if(real_addr!=addr)
-			fprintf(stderr,
-		  "process_directory: file mapped in wrong place! (0x%08x != 0x%08x)\n",
-				real_addr,
-				addr);
-		}
-
-#if 0
-		printf("Space ID = %d, free pointer = 0x%08x.\n", id, free_pointer);
-#endif
-
-		switch (id) {
-		case DYNAMIC_SPACE_ID:
-                    if (addr != (os_vm_address_t)dynamic_0_space && addr != (os_vm_address_t)dynamic_1_space)
-                        printf("Strange ... dynamic space lossage.\n");
-                    current_dynamic_space = (lispobj *)addr;
-#ifdef ibmrt
-		    SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer);
-#else
-                    current_dynamic_space_free_pointer = free_pointer;
-#endif
-                    break;
-		case STATIC_SPACE_ID:
-			static_space = (lispobj *) addr;
-			break;
-		case READ_ONLY_SPACE_ID:
-			/* Don't care about read only space */
-			break;
-		default:
-			printf("Strange space ID: %d; ignored.\n", id);
-			break;
-		}
-		entry++;
-	}
-}
-
-boolean load_core_file(file)
-char *file;
-{
-    int fd = open(file, O_RDONLY), count;
-    long header[CORE_PAGESIZE / sizeof(long)], val, len, *ptr;
-    boolean restore_state = FALSE;
-
-    if (fd < 0) {
-	    fprintf(stderr, "Could not open file \"%s\".\n", file);
-	    perror("open");
-	    exit(1);
-    }
-
-    count = read(fd, header, CORE_PAGESIZE);
-    if (count < 0) {
-        perror("read");
-        exit(1);
-    }
-    if (count < CORE_PAGESIZE) {
-        fprintf(stderr, "Premature EOF.\n");
-        exit(1);
-    }   
-
-    ptr = header;
-    val = *ptr++;
-
-    if (val != CORE_MAGIC) {
-        fprintf(stderr, "Invalid magic number: 0x%x should have been 0x%x.\n",
-		val, CORE_MAGIC); 
-        exit(1);
-    }
-
-    while (val != CORE_END) {
-        val = *ptr++;
-        len = *ptr++;
-
-        switch (val) {
-            case CORE_END:
-                break;
-
-            case CORE_VERSION:
-                if (*ptr != version) {
-                    fprintf(stderr, "WARNING: ldb version (%d) different from core version (%d).\nYou may lose big.\n", version, *ptr);
-                }
-                break;
-
-            case CORE_VALIDATE:
-		fprintf(stderr, "Validation no longer supported; ignored.\n");
-                break;
-
-            case CORE_NDIRECTORY:
-                process_directory(fd, ptr,
-				  (len-2) / (sizeof(struct ndir_entry) / sizeof(long)));
-                break;
-
-            case CORE_MACHINE_STATE:
-                restore_state = TRUE;
-                load(fd, (struct machine_state *)ptr);
-                break;
-
-            default:
-                printf("Unknown core file entry: %d; skipping.\n", val);
-                break;
-        }
-
-        ptr += len - 2;
-    }
-
-    return restore_state;
-}
diff --git a/ldb/dynbind.c b/ldb/dynbind.c
deleted file mode 100644
index 40984eec3..000000000
--- a/ldb/dynbind.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/dynbind.c,v 1.3 1991/02/16 00:59:56 wlott Exp $
- * 
- * Support for dynamic binding from C.
- */
-
-#include "ldb.h"
-#include "lisp.h"
-#include "globals.h"
-
-#ifdef ibmrt
-#define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER))
-#define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value))
-#else
-#define GetBSP() ((struct binding *)current_binding_stack_pointer)
-#define SetBSP(value) (current_binding_stack_pointer=(lispobj *)(value))
-#endif
-
-bind_variable(symbol, value)
-lispobj symbol, value;
-{
-	lispobj old_value;
-	struct binding *binding;
-
-	old_value = SymbolValue(symbol);
-	binding = GetBSP();
-	SetBSP(binding+1);
-
-	binding->value = old_value;
-	binding->symbol = symbol;
-	SetSymbolValue(symbol, value);
-}
-
-unbind()
-{
-	struct binding *binding;
-	lispobj symbol;
-	
-	binding = GetBSP() - 1;
-		
-	symbol = binding->symbol;
-
-	SetSymbolValue(symbol, binding->value);
-
-	binding->symbol = 0;
-
-	SetBSP(binding);
-}
-
-unbind_to_here(bsp)
-lispobj *bsp;
-{
-    struct binding *target = (struct binding *)bsp;
-    struct binding *binding = GetBSP();
-    lispobj symbol;
-
-    while (target < binding) {
-	binding--;
-
-	symbol = binding->symbol;
-
-	if (symbol) {
-	    SetSymbolValue(symbol, binding->value);
-	    binding->symbol = 0;
-	}
-
-    }
-    SetBSP(binding);
-}
diff --git a/ldb/egets.c b/ldb/egets.c
deleted file mode 100644
index 18a08affc..000000000
--- a/ldb/egets.c
+++ /dev/null
@@ -1,628 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/egets.c,v 1.1 1990/02/24 19:37:15 wlott Exp $ */
-/********************************************************************
-*                                                                   *
-*                                                                   *
-*     Copyright (C) 1987, Carnegie Mellon University                *
-*                                                                   *
-*                                                                   *
-********************************************************************/
-
-/* egets.c --	replacement for C library's gets(3s)
- *		allows emacs style command editing if stdin is a tty
- *						Derek Beatty
- * HISTORY
- *	20 Nov 87 Beatty: added code for more-mode.
- *		More-mode is handled by this file so gets can reset
- *		its line count.
- */
-#include <stdio.h>
-#include <ctype.h>
-#include <sgtty.h>
-#include <signal.h>
-#include <strings.h>
-#include <setjmp.h>
-
-int getpid();		/* this should have been declared somewhere */
-
-/*LINTLIBRARY*/
-
-#define TRUE (1)
-#define FALSE (0)
-
-typedef unsigned char uchar;
-
-#define HISTBUF		(2000)
-#define LINEBUF		(132)
-
-#define CONTROL(x)	((x)&0x1F)
-#define META(x)		((x)|0x80)
-#define BELL		CONTROL('g')
-#define ESC		(0x1B)
-#define RUBOUT		(0x7F)
-#define ISCONTROL(x)	((x)<0x20 || (x)>0x7E)		/* includes meta */
-#define NOTPREFIX(c)	((c)!=ESC)
-
-/** Global Variables for user settings */
-int ScrollPauseSwitch;
-int ScreenLengthLimit;
-int EditSwitch = TRUE;
-
-/** Shared by MORE and GETS **/
-static int CurrentLine = 1;
-static int Initialized = FALSE;/* true iff initialize has been called */
-
-/** VARIABLES FOR GETS **/
-static struct sgttyb OttyFlags, NttyFlags;
-static struct ltchars OltChars, NltChars;
-  
-#ifdef SIGTSTP
-static int (*TstpHandler)();
-#endif SIGTSTP
-  
-static int Active = TRUE;	/* true iff egets is working */
-static uchar History[HISTBUF];	/* history buffer */
-static uchar
-	*FirstHistory,		/* ptr to earliest line in history buffer */
-	*YankedHistory;		/* ptr to history last yanked */
-static uchar KillBuf[LINEBUF+1];	/* kill buffer */
-static uchar Line[LINEBUF+1];	/* line being entered, plus null */
-static uchar
-	*Cursor,		/* ptr to character cursor is on */
-	*Bol,			/* ptr to first char of line */
-	*Eol;			/* ptr to null that terminates line */
-
-static uchar tLine[LINEBUF+1];	/* line displayed on terminal */
-static uchar *tCursor, *tBol, *tEol;
-
-static uchar Meta = 0;	/* meta bit; 0x80 if meta key was last */
-static int Bleep = FALSE;   /* TRUE iff bell needed at next screen update */
-
-static jmp_buf out_of_here;
-
-static void saveTtyModes(), restoreTtyModes(), initialize(), showLine(),
-	killToEol(), yankNext(), yankPrev(),	yankKillBuf(), 
-	transpose(), openSpace(), closeSpace();
-
-/* saveTtyModes -- save tty state and put tty into cbreak mode */
-static void 
-saveTtyModes()
-{
-    (void) ioctl(fileno(stdin), TIOCGETP, (char*) &OttyFlags);
-    NttyFlags = OttyFlags;
-    NttyFlags.sg_flags |= CBREAK;
-    NttyFlags.sg_flags &= ~XTABS;
-    NttyFlags.sg_flags &= ~ECHO;
-    (void) ioctl(fileno(stdin), TIOCSETN, (char*) &NttyFlags);
-    (void) ioctl(fileno(stdin), TIOCGLTC, (char*) &OltChars);
-    NltChars = OltChars;
-    NltChars.t_dsuspc = NltChars.t_suspc;
-    (void) ioctl(fileno(stdin), TIOCSLTC, (char*) &NltChars);
-}
-
-/* restoreTtyModes -- restore tty state */
-static void 
-restoreTtyModes()
-{
-    (void) ioctl(fileno(stdin), TIOCSLTC, (char*) &OltChars);
-    (void) ioctl(fileno(stdin), TIOCSETN, (char*) &OttyFlags);
-}
-
-/* isaCRT -- return nonzero iff fd is a tty with CRT bits set */
-static int 
-isaCRT( fd)
-int fd;
-{
-    int             ltbits;
-
-    (void) ioctl(fd, TIOCLGET, (char*) &ltbits);
-    return (ltbits & (LCRTERA | LCRTKIL));
-}
-
-/* tstp -- handler for SIGTSTP: restore tty and suspend */
-#ifdef SIGTSTP
-int 
-tstp()
-{
-    if (TstpHandler == SIG_IGN)
-	return;
-    restoreTtyModes();
-    if (TstpHandler == SIG_DFL)
-	(void) kill(getpid(), SIGSTOP);
-    else
-	(*TstpHandler) ();
-    saveTtyModes();
-    tBol = tEol = tCursor = tLine;
-    tLine[0] = '\0';
-    showLine();
-}
-#endif
-
-/* initialize -- init data structures used by gets and more. called once. */
-static void 
-initialize()
-{
-    int             i;
-
-    /* initialization for gets */
-    Initialized = TRUE;
-    YankedHistory = FirstHistory = History;
-    for (i = 0; i < HISTBUF; i++)
-	History[i] = '\0';
-    KillBuf[0] = '\0';
-
-    /* initialization for more */
-    ScrollPauseSwitch= isaCRT(fileno(stdin)) && isatty(fileno(stdout));
-
-    ScreenLengthLimit= -1;
-#ifdef TIOCGWINSZ /* 4.3bsd window size */
-    {
-	struct winsize wss;
-	ioctl(fileno(stdin), TIOCGWINSZ, (char*) &wss);
-	ScreenLengthLimit= wss.ws_row-1;
-    }
-#endif
-#ifdef TIOCGSIZE /* sun window size */
-    {
-	struct ttysize tss;
-	ioctl(fileno(stdin), TIOCGSIZE, (char*) &tss);
-	ScreenLengthLimit= tss.ts_lines-1;
-    }
-#endif
-    if (ScreenLengthLimit==-1)
-	ScreenLengthLimit = 24;
-}
-
-
-/* killToEol -- delete characters on and following cursor into kill buffer */
-static void 
-killToEol()
-{
-    int             n = strlen( (char*) Cursor);
-
-    (void) strcpy((char*) KillBuf, (char*) Cursor);
-    closeSpace(n);
-}
-
-/* transpose -- transpose two characters preceding cursor */
-static void 
-transpose()
-{
-    if (Cursor <= Bol + 1)
-	Bleep = TRUE;
-    else {
-	uchar           c = *(Cursor - 1);
-	*(Cursor - 1) = *(Cursor - 2);
-	*(Cursor - 2) = c;
-    }
-}
-
-/* numInWord -- return number of chars through word before or after cursor */
-static int
-numInWord( before)
-  int before;		/* true iff want count in word before cursor */
-{
-    uchar          *tempCursor = Cursor;
-    int             n;
-
-    if (before) {
-	if (tempCursor > Bol)
-	    tempCursor--;
-	else
-	    Bleep = TRUE;
-	while (tempCursor > Bol && !isalnum(*tempCursor))
-	    tempCursor--;
-	while (tempCursor > Bol && isalnum(*tempCursor))
-	    tempCursor--;
-	n = Cursor - tempCursor;
-	if (n != 0 && !isalnum(*tempCursor))
-	    n--;
-	return (n);
-    } else {
-	if (tempCursor >= Eol)
-	    Bleep = TRUE;
-	while (tempCursor < Eol && !isalnum(*tempCursor))
-	    tempCursor++;
-	while (tempCursor < Eol && isalnum(*tempCursor))
-	    tempCursor++;
-	return (tempCursor - Cursor);
-    }
-}
-
-/* yankHistory -- yank line at YankedHistory into Line */
-static void 
-yankHistory()
-{
-    uchar          *tempHistory;
-
-    YankedHistory++;
-    if (YankedHistory >= History + HISTBUF)
-	YankedHistory = History;
-    tempHistory = YankedHistory;
-    Bol = Cursor = Line;
-    while (*tempHistory) {
-	*Cursor++ = *tempHistory++;
-	if (tempHistory >= History + HISTBUF)
-	    tempHistory = History;
-    }
-    *Cursor = '\0';
-    Eol = Cursor;
-}
-
-/* yankNext -- yank the next line from the history buffer */
-static void 
-yankNext()
-{
-    while (*YankedHistory) {
-	YankedHistory++;
-	if (YankedHistory >= History + HISTBUF)
-	    YankedHistory = History;
-    }
-    yankHistory();
-}
-
-/* yankPrev -- yank the previous line from the history buffer */
-static void 
-yankPrev()
-{
-    YankedHistory--;
-    if (YankedHistory < History)
-	YankedHistory = History + HISTBUF - 1;
-    YankedHistory--;
-    if (YankedHistory < History)
-	YankedHistory = History + HISTBUF - 1;
-    while (*YankedHistory) {
-	YankedHistory--;
-	if (YankedHistory < History)
-	    YankedHistory = History + HISTBUF - 1;
-    }
-    yankHistory();
-}
-
-/* addHistory -- add the current line to the history buffer */
-static void 
-addHistory()
-{
-    uchar          *tempCursor = Bol;
-
-    while (*tempCursor) {
-	*FirstHistory++ = *tempCursor++;
-	if (FirstHistory >= History + HISTBUF)
-	    FirstHistory = History;
-    }
-    *FirstHistory++ = '\0';
-    if (FirstHistory >= History + HISTBUF)
-	FirstHistory = History;
-    YankedHistory = FirstHistory;
-}
-
-/* yankKillBuf -- insert kill buffer in current line.  Bleep if trouble */
-static void 
-yankKillBuf()
-{
-    uchar          *sourceCursor = KillBuf;
-    uchar          *destCursor = Cursor;
-    int             n = strlen((char*) KillBuf);
-
-    if (Eol + n > Line + LINEBUF)
-	Bleep = TRUE;
-    else {
-	openSpace(n);
-	while (*sourceCursor)
-	    *destCursor++ = *sourceCursor++;
-	Cursor += n;
-    }
-}
-
-/* redraw -- force showLine to redraw current line on screen */
-static void 
-redraw()
-{
-    tCursor = tBol = tEol = tLine;
-    tLine[0] = '\0';
-    printf("\n");
-    (void) fflush(stdout);
-}
-
-/* showLine -- update screen and tLine to reflect Line */
-static void 
-showLine()
-{
-    uchar          *Dif, *tDif;
-
-
-    /* find first place the lines differ */
-    Dif = Bol;
-    tDif = tBol;
-    while (*Dif && *tDif && *Dif == *tDif) {
-	Dif++;
-	tDif++;
-    }
-    if (*Dif || *tDif) {
-	/* lines differ: move tCursor to the point of difference */
-	while (tCursor > tDif) {
-	    printf("\b");
-	    tCursor--;
-	}
-	while (tCursor < tDif)
-	    printf("%c", *tCursor++);
-	/* write remainder of Line */
-	while (*Dif)
-	    printf("%c", *tCursor++ = *Dif++);
-	/* add blanks to bring tLine up to length of Line */
-	while (tCursor < tEol) {
-	    printf(" ");
-	    *tCursor++ = '\0';
-	}
-	/* adjust tEol */
-	tEol = tBol + (Eol - Bol);
-    }
-    /* move tCursor to proper place */
-    while (tCursor - tBol > Cursor - Bol) {
-	printf("\b");
-	tCursor--;
-    }
-    while (tCursor - tBol < Cursor - Bol)
-	printf("%c", *tCursor++);
-    /* cleanup */
-    if (Bleep) {
-	printf("%c", BELL);
-	Bleep = FALSE;
-    }
-    (void) fflush(stdout);
-}
-
-/* openSpace -- open space for n characters at cursor.  Beep if trouble. */
-static void 
-openSpace( n)
-  int n;
-{
-    uchar          *sourceCursor, *destCursor;
-
-    if (n == 0)
-	return;
-    destCursor = Eol + n;
-    if (destCursor > Line + LINEBUF + 1)
-	Bleep = TRUE;
-    else {
-	sourceCursor = Eol;
-	Eol = destCursor;
-	while (sourceCursor >= Cursor)
-	    *destCursor-- = *sourceCursor--;
-    }
-}
-
-/* closeSpace -- close space for n characters at cursor.  Bleep if trouble. */
-static void 
-closeSpace( n)
-  int n;
-{
-    uchar          *sourceCursor, *destCursor;
-
-    if (n == 0)
-	return;
-    if (n > Eol - Cursor) {
-	Bleep = TRUE;
-	n = Eol - Cursor;
-    }
-    sourceCursor = Cursor + n;
-    destCursor = Cursor;
-    while (sourceCursor <= Eol)
-	*destCursor++ = *sourceCursor++;
-    Eol = destCursor - 1;
-}
-
-/* ogets -- get a line without command line editing */
-static char *
-ogets(s, n)
-char *s;
-int n;				/* total length of string */
-{
-	int c, i;
-	char *t;
-
-	t = s; i = n;
-
-	if (n <= 0)
-		return NULL;
-
-	while ((--i > 0) && ((c = getchar()) != '\n') && (c != EOF))
-		*t++ = c;
-	if ((n != 1) && (c == EOF) && (s == t))
-		return NULL;
-	*t = '\0';
-
-	return(s);
-}
-
-static sigint_handler()
-{
-    longjmp(out_of_here, 1);
-}
-
-
-/* egets -- get a line from stdin with command line editing */
-char * 
-egets()
-{
-    uchar           c= '\0';
-    int            done, returnEOF;
-    long int        buffered= 0L;
-    int             n;
-    int             arg = 0;
-    int            gettingArg = FALSE, gettingDigitArg = FALSE;
-    int            stillGettingArg = FALSE;
-    struct sigvec sv, old_int_sv;
-
-    if (!EditSwitch
-	|| !Active
-	|| (!Initialized && (!isatty(fileno(stdin)) ))
-	|| !isaCRT(fileno(stdin))) {
-	Active = FALSE;
-	return (ogets(Line, LINEBUF + 1));
-    }
-    if (!Initialized)
-	initialize();
-    fflush(stdout);
-    CurrentLine=1;		/* Reset line count for more-mode. */
-    Line[0] = '\0';
-    tLine[0] = '\0';
-    Cursor = Bol = Eol = Line;
-    tCursor = tBol = tEol = tLine;
-#ifdef SIGTSTP
-    TstpHandler = signal(SIGTSTP, tstp);
-#endif
-    saveTtyModes();
-    if (setjmp(out_of_here))
-        returnEOF = TRUE;
-    else {
-        sv.sv_handler = sigint_handler;
-        sv.sv_mask = 0;
-        sv.sv_flags = 0;
-        sigvec(SIGINT, &sv, &old_int_sv);
-
-        returnEOF = done = FALSE;
-        while (!done) {
-            /* lint complains that c may be used before set */
-            if (!gettingArg && arg > 0 && NOTPREFIX(c))
-                arg--;
-            else {
-                if (read(fileno(stdin), (char*) &c, 1) == 0)
-                    c = CONTROL('m');
-                else {
-                    c |= Meta;
-                    Meta = 0;
-                }
-            }
-            if (ISCONTROL(c)) {
-                switch (c) {
-                    case CONTROL('a'):
-                        Cursor = Bol;
-                        break;
-                    case CONTROL('b'):
-                        if (Cursor > Bol)
-                            Cursor--;
-                        else
-                            Bleep = TRUE;
-                        break;
-                    case CONTROL('d'):
-                        if (Cursor < Eol)
-                            closeSpace(1);
-                        else
-                            Bleep = TRUE;
-                        break;
-                    case CONTROL('e'):
-                        Cursor = Eol;
-                        break;
-                    case CONTROL('f'):
-                        if (Cursor < Eol)
-                            Cursor++;
-                        else
-                            Bleep = TRUE;
-                        break;
-                    case CONTROL('h'):
-                    case RUBOUT:
-                        if (Cursor > Bol) {
-                            Cursor--;
-                            closeSpace(1);
-                        } else
-                            Bleep = TRUE;
-                        break;
-                    case CONTROL('j'):
-                        done = TRUE;
-                        break;
-                    case CONTROL('k'):
-                        killToEol();
-                        break;
-                    case CONTROL('m'):
-                        done = TRUE;
-                        break;
-                    case CONTROL('n'):
-                        yankNext();
-                        break;
-                    case CONTROL('p'):
-                        yankPrev();
-                        break;
-                    case CONTROL('r'):
-                        redraw();
-                        break;
-                    case CONTROL('t'):
-                        transpose();
-                        break;
-                    case CONTROL('u'):
-                        if (gettingArg)
-                            arg *= 4;
-                        else
-                            arg = 4;
-                        stillGettingArg = TRUE;
-                        gettingDigitArg = FALSE;
-                        break;
-                    case CONTROL('y'):
-                        yankKillBuf();
-                        break;
-                    case ESC:
-                        Meta = 0x80;
-                        break;
-                    case META('f'):
-                        Cursor += numInWord(0);
-                        break;
-                    case META('b'):
-                        Cursor -= numInWord(1);
-                        break;
-                    case META('d'):
-                        closeSpace(numInWord(0));
-                        break;
-                    case CONTROL('w'):
-                    case META('h'):
-                        n = numInWord(1);
-                        Cursor -= n;
-                        closeSpace(n);
-                        break;
-                    case META(CONTROL('d')):
-                        if (Bol == Eol)
-                            done = returnEOF = TRUE;
-                        else
-                            Bleep = TRUE;
-                        break;
-                    default:
-                        Bleep = TRUE;
-                        break;
-                }
-            } else if (!gettingArg || !isdigit(c)) {
-                if (Eol + 1 > Line + LINEBUF)
-                    Bleep = TRUE;
-                else {
-                    openSpace(1);
-                    *Cursor++ = c;
-                }
-            } else {
-                /* getting argument digits */
-                if (gettingDigitArg)
-                    arg = 10 * arg + c - '0';
-                else
-                    arg = c - '0';
-                stillGettingArg = TRUE;
-                gettingDigitArg = TRUE;
-            }
-            if (gettingArg && !stillGettingArg)
-                arg--;
-            gettingArg = stillGettingArg;
-            stillGettingArg = FALSE;
-            if (Bleep)
-                arg = 0;
-            (void) ioctl(fileno(stdin), FIONREAD, (char*) &buffered);
-            if ((buffered == 0L && arg == 0) || done)
-                showLine();
-        }
-        addHistory();
-    }
-
-    if (!returnEOF) printf("\n");
-    (void) fflush(stdout);
-
-    restoreTtyModes();
-#ifdef SIGTSTP
-    (void) signal(SIGTSTP, TstpHandler);
-#endif
-    sigvec(SIGINT, &old_int_sv, NULL);
-    return (returnEOF ? NULL : (char *) Line);
-}
diff --git a/ldb/fake-mach.c b/ldb/fake-mach.c
deleted file mode 100644
index 422e3e0f7..000000000
--- a/ldb/fake-mach.c
+++ /dev/null
@@ -1,53 +0,0 @@
-#include "ldb.h"
-#include "os.h"
-
-#define KERN_SUCCESS		0
-#define KERN_INVALID_ADDRESS	1
-#define KERN_PROTECTION_FAILURE	2
-#define KERN_NO_SPACE		3
-#define KERN_INVALID_ARGUMENT	4
-#define KERN_FAILURE		5
-
-int task_self()
-{
-    return 0;
-}
-
-int thread_reply()
-{
-    return 0;
-}
-
-int task_notify()
-{
-    return 0;
-}
-
-int vm_allocate(task,addr_p,len,free)
-int task;
-os_vm_address_t *addr_p;
-os_vm_size_t len;
-int free;
-{
-    *addr_p=os_validate(free ? NULL : *addr_p,len);
-    return (*addr_p)==NULL ? KERN_FAILURE : KERN_SUCCESS;
-}
-
-int vm_deallocate(task,addr,len)
-int task;
-os_vm_address_t addr;
-os_vm_size_t len;
-{
-    os_invalidate(addr,len);
-    return KERN_SUCCESS;
-}
-
-int vm_copy()
-{
-    return KERN_FAILURE;
-}
-
-int vm_statistics()
-{
-    return KERN_FAILURE;
-}
diff --git a/ldb/gc.c b/ldb/gc.c
deleted file mode 100644
index 536770710..000000000
--- a/ldb/gc.c
+++ /dev/null
@@ -1,1938 +0,0 @@
-/*
- * Stop and Copy GC based on Cheney's algorithm.
- *
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/gc.c,v 1.34 1992/04/15 00:45:48 wlott Exp $
- * 
- * Written by Christopher Hoover.
- */
-
-#include <stdio.h>
-#include <sys/time.h>
-#include <sys/resource.h>
-#include <signal.h>
-#include "lisp.h"
-#include "ldb.h"
-#include "os.h"
-#include "gc.h"
-#include "globals.h"
-#include "interrupt.h"
-#include "validate.h"
-#include "lispregs.h"
-
-lispobj *from_space;
-lispobj *from_space_free_pointer;
-
-lispobj *new_space;
-lispobj *new_space_free_pointer;
-
-static int (*scavtab[256])();
-static lispobj (*transother[256])();
-static int (*sizetab[256])();
-
-static struct weak_pointer *weak_pointers;
-
-
-/* Predicates */
-
-#if defined(DEBUG_SPACE_PREDICATES)
-
-from_space_p(object)
-lispobj object;
-{
-	lispobj *ptr;
-
-	gc_assert(Pointerp(object));
-
-	ptr = (lispobj *) PTR(object);
-
-	return ((from_space <= ptr) &&
-		(ptr < from_space_free_pointer));
-}	    
-
-new_space_p(object)
-lispobj object;
-{
-	lispobj *ptr;
-
-	gc_assert(Pointerp(object));
-
-	ptr = (lispobj *) PTR(object);
-		
-	return ((new_space <= ptr) &&
-		(ptr < new_space_free_pointer));
-}	    
-
-#else
-
-#define from_space_p(ptr) \
-	((from_space <= ((lispobj *) ptr)) && \
-	 (((lispobj *) ptr) < from_space_free_pointer))
-
-#define new_space_p(ptr) \
-	((new_space <= ((lispobj *) ptr)) && \
-	 (((lispobj *) ptr) < new_space_free_pointer))
-
-#endif
-
-
-/* GC Lossage */
-
-void
-gc_lose()
-{
-	exit(1);
-}
-
-
-/* Copying Objects */
-
-static lispobj
-copy_object(object, nwords)
-lispobj object;
-int nwords;
-{
-	int tag;
-	lispobj *new;
-	lispobj *source, *dest;
-
-	gc_assert(Pointerp(object));
-	gc_assert(from_space_p(object));
-	gc_assert((nwords & 0x01) == 0);
-
-	/* get tag of object */
-	tag = LowtagOf(object);
-
-	/* allocate space */
-	new = new_space_free_pointer;
-	new_space_free_pointer += nwords;
-
-	dest = new;
-	source = (lispobj *) PTR(object);
-
-	/* copy the object */
-	while (nwords > 0) {
-            dest[0] = source[0];
-            dest[1] = source[1];
-            dest += 2;
-            source += 2;
-            nwords -= 2;
-	}
-
-	/* return lisp pointer of new object */
-	return ((lispobj) new) | tag;
-}
-
-
-/* Collect Garbage */
-
-static double tv_diff(x, y)
-struct timeval *x, *y;
-{
-    return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
-	    ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
-}
-
-#define BYTES_ZERO_BEFORE_END (1<<12)
-
-static void zero_stack()
-{
-    unsigned long *ptr = (unsigned long *)current_control_stack_pointer;
-
-  search:
-    do {
-	if (*ptr)
-	    goto fill;
-	ptr++;
-    } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
-    return;
-
-  fill:
-    do {
-	*ptr++ = 0;
-    } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
-    goto search;
-}
-
-collect_garbage()
-{
-#ifdef PRINTNOISE
-	struct timeval start_tv, stop_tv;
-	struct rusage start_rusage, stop_rusage;
-	double real_time, system_time, user_time;
-	double percent_retained, gc_rate;
-	unsigned long size_discarded;
-	unsigned long size_retained;
-#endif
-	lispobj *current_static_space_free_pointer;
-	unsigned long static_space_size;
-	unsigned long control_stack_size, binding_stack_size;
-	int oldmask;
-	
-#ifdef PRINTNOISE
-	printf("[Collecting garbage ... \n");
-
-	getrusage(RUSAGE_SELF, &start_rusage);
-	gettimeofday(&start_tv, (struct timezone *) 0);
-#endif
-
-	oldmask = sigblock(BLOCKABLE);
-
-	current_static_space_free_pointer =
-		(lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER);
-
-
-	/* Set up from space and new space pointers. */
-
-	from_space = current_dynamic_space;
-#ifndef ibmrt
-	from_space_free_pointer = current_dynamic_space_free_pointer;
-#else
-	from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER);
-#endif
-
-	if (current_dynamic_space == dynamic_0_space)
-		new_space = dynamic_1_space;
-	else if (current_dynamic_space == dynamic_1_space)
-		new_space = dynamic_0_space;
-	else {
-		fprintf(stderr, "GC lossage.  Current dynamic space is bogus!\n");
-		gc_lose();
-	}
-
-	new_space_free_pointer = new_space;
-
-
-	/* Initialize the weak pointer list. */
-	weak_pointers = (struct weak_pointer *) NULL;
-
-
-	/* Scavenge all of the roots. */
-#ifdef PRINTNOISE
-	printf("Scavenging interrupt contexts ...\n");
-#endif
-	scavenge_interrupt_contexts();
-
-#ifdef PRINTNOISE
-	printf("Scavenging interrupt handlers (%d bytes) ...\n",
-	       sizeof(interrupt_handlers));
-#endif
-	scavenge((lispobj *) interrupt_handlers,
-		 sizeof(interrupt_handlers) / sizeof(lispobj));
-
-	control_stack_size = current_control_stack_pointer - control_stack;
-#ifdef PRINTNOISE
-	printf("Scavenging the control stack (%d bytes) ...\n",
-	       control_stack_size * sizeof(lispobj));
-#endif
-	scavenge(control_stack, control_stack_size);
-
-#ifndef ibmrt
-	binding_stack_size = current_binding_stack_pointer - binding_stack;
-#else
-	binding_stack_size =
-	    (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack;
-#endif
-#ifdef PRINTNOISE
-	printf("Scavenging the binding stack (%d bytes) ...\n",
-	       binding_stack_size * sizeof(lispobj));
-#endif
-	scavenge(binding_stack, binding_stack_size);
-
-	static_space_size = current_static_space_free_pointer - static_space;
-#ifdef PRINTNOISE
-	printf("Scavenging static space (%d bytes) ...\n",
-	       static_space_size * sizeof(lispobj));
-#endif
-	scavenge(static_space, static_space_size);
-
-
-	/* Scavenge newspace. */
-#ifdef PRINTNOISE
-	printf("Scavenging new space (%d bytes) ...\n",
-	       (new_space_free_pointer - new_space) * sizeof(lispobj));
-#endif
-	scavenge_newspace();
-
-
-#if defined(DEBUG_PRINT_GARBAGE)
-	print_garbage(from_space, from_space_free_pointer);
-#endif
-
-	/* Scan the weak pointers. */
-#ifdef PRINTNOISE
-	printf("Scanning weak pointers ...\n");
-#endif
-	scan_weak_pointers();
-
-
-	/* Flip spaces. */
-#ifdef PRINTNOISE
-	printf("Flipping spaces ...\n");
-#endif
-
-	os_zero((os_vm_address_t) current_dynamic_space,
-		(os_vm_size_t) DYNAMIC_SPACE_SIZE);
-
-	current_dynamic_space = new_space;
-#ifndef ibmrt
-	current_dynamic_space_free_pointer = new_space_free_pointer;
-#else
-	SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer);
-#endif
-
-#ifdef PRINTNOISE
-	size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
-	size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
-#endif
-
-	/* Zero stack. */
-#ifdef PRINTNOISE
-	printf("Zeroing empty part of control stack ...\n");
-#endif
-	zero_stack();
-
-	(void) sigsetmask(oldmask);
-
-
-#ifdef PRINTNOISE
-	gettimeofday(&stop_tv, (struct timezone *) 0);
-	getrusage(RUSAGE_SELF, &stop_rusage);
-
-	printf("done.]\n");
-	
-	percent_retained = (((float) size_retained) /
-			     ((float) size_discarded)) * 100.0;
-
-	printf("Total of %d bytes out of %d bytes retained (%3.2f%%).\n",
-	       size_retained, size_discarded, percent_retained);
-
-	real_time = tv_diff(&stop_tv, &start_tv);
-	user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
-	system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
-
-#if 0
-	printf("Statistics:\n");
-	printf("%10.2f sec of real time\n", real_time);
-	printf("%10.2f sec of user time,\n", user_time);
-	printf("%10.2f sec of system time.\n", system_time);
-#else
-        printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
-               real_time, user_time, system_time);
-#endif        
-
-	gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
-
-	printf("%10.2f M bytes/sec collected.\n", gc_rate);
-#endif
-}
-
-
-/* Scavenging */
-
-static
-scavenge(start, nwords)
-lispobj *start;
-long nwords;
-{
-	while (nwords > 0) {
-		lispobj object;
-		int type, words_scavenged;
-
-		object = *start;
-		type = TypeOf(object);
-
-#if defined(DEBUG_SCAVENGE_VERBOSE)
-		printf("Scavenging object at 0x%08x, object = 0x%08x, type = %d\n",
-		       (unsigned long) start, (unsigned long) object, type);
-#endif
-
-#if 0
-		words_scavenged = (scavtab[type])(start, object);
-#else
-                if (Pointerp(object)) {
-                    /* It be a pointer. */
-                    if (from_space_p(object)) {
-                        /* It currently points to old space.  Check for a */
-                        /* forwarding pointer. */
-                        lispobj first_word;
-
-                        first_word = *((lispobj *)PTR(object));
-                        if (Pointerp(first_word) && new_space_p(first_word)) {
-                            /* Yep, there be a forwarding pointer. */
-                            *start = first_word;
-                            words_scavenged = 1;
-                        }
-                        else {
-                            /* Scavenge that pointer. */
-                            words_scavenged = (scavtab[type])(start, object);
-                        }
-                    }
-                    else {
-                        /* It points somewhere other than oldspace.  Leave */
-                        /* it alone. */
-                        words_scavenged = 1;
-                    }
-                }
-                else if ((object & 3) == 0) {
-                    /* It's a fixnum.  Real easy. */
-                    words_scavenged = 1;
-                }
-                else {
-                    /* It's some random header object. */
-                    words_scavenged = (scavtab[type])(start, object);
-                }
-#endif
-
-		start += words_scavenged;
-		nwords -= words_scavenged;
-	}
-	gc_assert(nwords == 0);
-}
-
-static
-scavenge_newspace()
-{
-    lispobj *here, *next;
-
-    here = new_space;
-    while (here < new_space_free_pointer) {
-	next = new_space_free_pointer;
-	scavenge(here, next - here);
-	here = next;
-    }
-}
-
-
-/* Scavenging Interrupt Contexts */
-
-scavenge_interrupt_contexts()
-{
-	int i, index;
-	struct sigcontext *context;
-
-	index = FIXNUM_TO_INT(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
-#if defined(DEBUG_PRINT_CONTEXT_INDEX)
-	printf("Number of active contexts: %d\n", index);
-#endif
-
-	for (i = 0; i < index; i++) {
-		context = lisp_interrupt_contexts[i];
-		scavenge_interrupt_context(context); 
-	}
-}
-
-#ifdef mips
-static int boxed_registers[] = {
-	A0, A1, A2, A3, A4, A5, CNAME, LEXENV,
-	NFP, OCFP, LRA, L0, L1, L2, CODE
-};
-#endif
-#ifdef sparc
-static int boxed_registers[] = {
-	A0, A1, A2, A3, A4, A5, OCFP, LRA,
-	CNAME, LEXENV, L0, L1, L2, CODE
-};
-#endif
-
-#ifdef ibmrt
-static int boxed_registers[] = {
-    CODE, CNAME, LEXENV, LRA, A0, A1, A2
-};
-#endif
-
-scavenge_interrupt_context(context)
-struct sigcontext *context;
-{
-	int i;
-	unsigned long lip;
-	unsigned long lip_offset;
-	int lip_register_pair;
-	unsigned long pc_code_offset;
-#ifdef sparc
-	unsigned long npc_code_offset;
-#endif
-
-	/* Find the LIP's register pair and calculate it's offset */
-	/* before we scavenge the context. */
-	lip = context->sc_regs[LIP];
-	lip_offset = 0x7FFFFFFF;
-	lip_register_pair = -1;
-	for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
-		unsigned long reg;
-		long offset;
-		int index;
-
-		index = boxed_registers[i];
-		reg = context->sc_regs[index];
-		if (PTR(reg) <= lip) {
-			offset = lip - reg;
-			if (offset < lip_offset) {
-				lip_offset = offset;
-				lip_register_pair = index;
-			}
-		}
-	}
-
-#if defined(DEBUG_LIP)
-	printf("LIP = %08x, Pair is R%d = %08x, Offset = %08x\n",
-	       context->sc_regs[LIP],
-	       lip_register_pair,
-	       context->sc_regs[lip_register_pair],
-	       lip_offset);
-#endif
-
-	/* Compute the PC's offset from the start of the CODE */
-	/* register. */
-	pc_code_offset = context->sc_pc - context->sc_regs[CODE];
-#ifdef sparc
-	npc_code_offset = context->sc_npc - context->sc_regs[CODE];
-#endif
-
-#if defined(DEBUG_PC)
-	printf("PC = %08x, CODE = %08x, Offset = %08x\n",
-	       context->sc_pc, context->sc_regs[CODE], pc_code_offset);
-#ifdef sparc
-	printf("nPC = %08x, CODE = %08x, Offset = %08x\n",
-	       context->sc_npc, context->sc_regs[CODE], npc_code_offset);
-#endif
-#endif
-	       
-	/* Scanvenge all boxed registers in the context. */
-	for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
-		int index;
-#if defined(DEBUG_SCAVENGE_REGISTERS)
-		unsigned long reg;
-#endif
-
-		index = boxed_registers[i];
-#if defined(DEBUG_SCAVENGE_REGISTERS)
-		reg = context->sc_regs[index];
-#endif
-		scavenge((lispobj *) &(context->sc_regs[index]), 1);
-#if defined(DEBUG_SCAVENGE_REGISTERS)
-		printf("Scavenged R%d: was 0x%08x now 0x%08x\n",
-		       index, reg, context->sc_regs[index]);
-#endif
-	}
-
-	/* Fix the LIP */
-	context->sc_regs[LIP] =
-		context->sc_regs[lip_register_pair] + lip_offset;
-	
-#if defined(DEBUG_LIP)
-	printf("LIP = %08x, Pair is R%d = %08x, Offset = %08x\n",
-	       context->sc_regs[LIP],
-	       lip_register_pair,
-	       context->sc_regs[lip_register_pair],
-	       lip_offset);
-#endif
-
-	/* Fix the PC if it was in from space */
-	if (from_space_p(context->sc_pc))
-		context->sc_pc = context->sc_regs[CODE] + pc_code_offset;
-#ifdef sparc
-	if (from_space_p(context->sc_npc))
-		context->sc_npc = context->sc_regs[CODE] + npc_code_offset;
-#endif
-
-#if defined(DEBUG_PC)
-	printf("PC = %08x, CODE = %08x, Offset = %08x\n",
-	       context->sc_pc, context->sc_regs[CODE], pc_code_offset);
-#ifdef sparc
-	printf("PC = %08x, CODE = %08x, Offset = %08x\n",
-	       context->sc_npc, context->sc_regs[CODE], npc_code_offset);
-#endif
-#endif
-	       
-}
-
-
-/* Debugging Code */
-
-print_garbage(from_space, from_space_free_pointer)
-lispobj *from_space, *from_space_free_pointer;
-{
-	lispobj *start;
-	int total_words_not_copied;
-
-	printf("Scanning from space ...\n");
-
-	total_words_not_copied = 0;
-	start = from_space;
-	while (start < from_space_free_pointer) {
-		lispobj object;
-		int forwardp, type, nwords;
-		lispobj header;
-
-		object = *start;
-		forwardp = Pointerp(object) && new_space_p(object);
-
-		if (forwardp) {
-			int tag;
-			lispobj *pointer;
-
-			tag = LowtagOf(object);
-
-			switch (tag) {
-			case type_ListPointer:
-				nwords = 2;
-				break;
-			case type_StructurePointer:
-				printf("Don't know about structures yet!\n");
-				nwords = 1;
-				break;
-			case type_FunctionPointer:
-				nwords = 1;
-				break;
-			case type_OtherPointer:
-				pointer = (lispobj *) PTR(object);
-				header = *pointer;
-				type = TypeOf(header);
-				nwords = (sizetab[type])(pointer);
-			}
-		} else {
-			type = TypeOf(object);
-			nwords = (sizetab[type])(start);
-			total_words_not_copied += nwords;
-			printf("%4d words not copied at 0x%08x; ",
-			       nwords, (unsigned long) start);
-			printf("Header word is 0x%08x\n", (unsigned long) object);
-		}
-		start += nwords;
-	}
-	printf("%d total words not copied.\n", total_words_not_copied);
-}
-
-
-/* Code and Code-Related Objects */
-
-static lispobj trans_function_header();
-static lispobj trans_boxed();
-
-static
-scav_function_pointer(where, object)
-lispobj *where, object;
-{
-	gc_assert(Pointerp(object));
-
-	if (from_space_p(object)) {
-		lispobj first, *first_pointer;
-
-		/* object is a pointer into from space.  check to see */
-		/* if it has been forwarded */
-		first_pointer = (lispobj *) PTR(object);
-		first = *first_pointer;
-		
-		if (!(Pointerp(first) && new_space_p(first))) {
-			int type;
-			lispobj copy;
-
-			/* must transport object -- object may point */
-			/* to either a function header, a closure */
-			/* function header, or to a closure header. */
-			
-			type = TypeOf(first);
-			switch (type) {
-			  case type_FunctionHeader:
-			  case type_ClosureFunctionHeader:
-			    copy = trans_function_header(object);
-			    break;
-			  default:
-			    copy = trans_boxed(object);
-			    break;
-			}
-
-			first = *first_pointer = copy;
-		}
-
-		gc_assert(Pointerp(first));
-		gc_assert(!from_space_p(first));
-
-		*where = first;
-	}
-	return 1;
-}
-
-static struct code *
-trans_code(code)
-struct code *code;
-{
-	struct code *new_code;
-	lispobj first, l_code, l_new_code;
-	int nheader_words, ncode_words, nwords;
-	unsigned long displacement;
-	lispobj fheaderl, *prev_pointer;
-
-#if defined(DEBUG_CODE_GC)
-	printf("\nTransporting code object located at 0x%08x.\n",
-	       (unsigned long) code);
-#endif
-
-	/* if object has already been transported, just return pointer */
-	first = code->header;
-	if (Pointerp(first) && new_space_p(first))
-		return (struct code *) PTR(first);
-	
-	gc_assert(TypeOf(first) == type_CodeHeader);
-
-	/* prepare to transport the code vector */
-	l_code = (lispobj) code | type_OtherPointer;
-
-	ncode_words = FIXNUM_TO_INT(code->code_size);
-	nheader_words = HeaderValue(code->header);
-	nwords = ncode_words + nheader_words;
-	nwords = CEILING(nwords, 2);
-
-	l_new_code = copy_object(l_code, nwords);
-	new_code = (struct code *) PTR(l_new_code);
-
-	displacement = l_new_code - l_code;
-
-#if defined(DEBUG_CODE_GC)
-	printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
-	       (unsigned long) code, (unsigned long) new_code);
-	printf("Code object is %d words long.\n", nwords);
-#endif
-
-	/* set forwarding pointer */
-	code->header = l_new_code;
-	
-	/* set forwarding pointers for all the function headers in the */
-	/* code object.  also fix all self pointers */
-
-	fheaderl = code->entry_points;
-	prev_pointer = &new_code->entry_points;
-
-	while (fheaderl != NIL) {
-		struct function_header *fheaderp, *nfheaderp;
-		lispobj nfheaderl;
-		
-		fheaderp = (struct function_header *) PTR(fheaderl);
-		gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
-
-		/* calcuate the new function pointer and the new */
-		/* function header */
-		nfheaderl = fheaderl + displacement;
-		nfheaderp = (struct function_header *) PTR(nfheaderl);
-
-		/* set forwarding pointer */
-		fheaderp->header = nfheaderl;
-		
-		/* fix self pointer */
-		nfheaderp->self = nfheaderl;
-
-		*prev_pointer = nfheaderl;
-
-		fheaderl = fheaderp->next;
-		prev_pointer = &nfheaderp->next;
-	}
-
-	return new_code;
-}
-
-static
-scav_code_header(where, object)
-lispobj *where, object;
-{
-	struct code *code;
-	int nheader_words, ncode_words, nwords;
-	lispobj fheaderl;
-	struct function_header *fheaderp;
-
-	code = (struct code *) where;
-	ncode_words = FIXNUM_TO_INT(code->code_size);
-	nheader_words = HeaderValue(object);
-	nwords = ncode_words + nheader_words;
-	nwords = CEILING(nwords, 2);
-
-#if defined(DEBUG_CODE_GC)
-	printf("\nScavening code object at 0x%08x.\n",
-	       (unsigned long) where);
-	printf("Code object is %d words long.\n", nwords);
-	printf("Scavenging boxed section of code data block (%d words).\n",
-	       nheader_words - 1);
-#endif
-
-	/* Scavenge the boxed section of the code data block */
-	scavenge(where + 1, nheader_words - 1);
-
-	/* Scavenge the boxed section of each function object in the */
-	/* code data block */
-	fheaderl = code->entry_points;
-	while (fheaderl != NIL) {
-		fheaderp = (struct function_header *) PTR(fheaderl);
-		gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
-		
-#if defined(DEBUG_CODE_GC)
-		printf("Scavenging boxed section of entry point located at 0x%08x.\n",
-		       (unsigned long) PTR(fheaderl));
-#endif
-		scavenge(&fheaderp->name, 1);
-		scavenge(&fheaderp->arglist, 1);
-		scavenge(&fheaderp->type, 1);
-		
-		fheaderl = fheaderp->next;
-	}
-	
-	return nwords;
-}
-
-static lispobj
-trans_code_header(object)
-lispobj object;
-{
-	struct code *ncode;
-
-	ncode = trans_code((struct code *) PTR(object));
-	return (lispobj) ncode | type_OtherPointer;
-}
-
-static
-size_code_header(where)
-lispobj *where;
-{
-	struct code *code;
-	int nheader_words, ncode_words, nwords;
-
-	code = (struct code *) where;
-	
-	ncode_words = FIXNUM_TO_INT(code->code_size);
-	nheader_words = HeaderValue(code->header);
-	nwords = ncode_words + nheader_words;
-	nwords = CEILING(nwords, 2);
-
-	return nwords;
-}
-
-
-static
-scav_return_pc_header(where, object)
-lispobj *where, object;
-{
-	fprintf(stderr, "GC lossage.  Should not be scavenging a ");
-	fprintf(stderr, "Return PC Header.\n");
-	fprintf(stderr, "where = 0x%08x, object = 0x%08x",
-		(unsigned long) where, (unsigned long) object);
-	gc_lose();
-}
-
-static lispobj
-trans_return_pc_header(object)
-lispobj object;
-{
-	struct function_header *return_pc;
-	unsigned long offset;
-	struct code *code, *ncode;
-	
-	return_pc = (struct function_header *) PTR(object);
-	offset = HeaderValue(return_pc->header) * 4;
-
-	/* Transport the whole code object */
-	code = (struct code *) ((unsigned long) return_pc - offset);
-	ncode = trans_code(code);
-
-	return ((lispobj) ncode + offset) | type_OtherPointer;
-}
-
-
-static
-scav_function_header(where, object)
-lispobj *where, object;
-{
-	fprintf(stderr, "GC lossage.  Should not be scavenging a ");
-	fprintf(stderr, "Function Header.\n");
-	fprintf(stderr, "where = 0x%08x, object = 0x%08x",
-		(unsigned long) where, (unsigned long) object);
-	gc_lose();
-}
-
-static lispobj
-trans_function_header(object)
-lispobj object;
-{
-	struct function_header *fheader;
-	unsigned long offset;
-	struct code *code, *ncode;
-	
-	fheader = (struct function_header *) PTR(object);
-	offset = HeaderValue(fheader->header) * 4;
-
-	/* Transport the whole code object */
-	code = (struct code *) ((unsigned long) fheader - offset);
-	ncode = trans_code(code);
-
-	return ((lispobj) ncode + offset) | type_FunctionPointer;
-}
-
-
-
-/* Structures */
-
-static
-scav_structure_pointer(where, object)
-lispobj *where, object;
-{
-    if (from_space_p(object)) {
-	lispobj first, *first_pointer;
-
-	/* object is a pointer into from space.  check to see */
-	/* if it has been forwarded */
-	first_pointer = (lispobj *) PTR(object);
-	first = *first_pointer;
-		
-	if (!(Pointerp(first) && new_space_p(first)))
-	    first = *first_pointer = trans_boxed(object);
-	*where = first;
-    }
-    return 1;
-}
-
-
-/* Lists and Conses */
-
-static lispobj trans_list();
-
-static
-scav_list_pointer(where, object)
-lispobj *where, object;
-{
-	gc_assert(Pointerp(object));
-
-	if (from_space_p(object)) {
-		lispobj first, *first_pointer;
-
-		/* object is a pointer into from space.  check to see */
-		/* if it has been forwarded */
-		first_pointer = (lispobj *) PTR(object);
-		first = *first_pointer;
-		
-		if (!(Pointerp(first) && new_space_p(first)))
-			first = *first_pointer = trans_list(object);
-
-		gc_assert(Pointerp(first));
-		gc_assert(!from_space_p(first));
-	
-		*where = first;
-	}
-	return 1;
-}
-
-static lispobj
-trans_list(object)
-lispobj object;
-{
-	lispobj new_list_pointer;
-	struct cons *cons, *new_cons;
-	
-	cons = (struct cons *) PTR(object);
-
-	/* ### Don't use copy_object here. */
-	new_list_pointer = copy_object(object, 2);
-	new_cons = (struct cons *) PTR(new_list_pointer);
-
-	/* Set forwarding pointer. */
-	cons->car = new_list_pointer;
-	
-	/* Try to linearize the list in the cdr direction to help reduce */
-	/* paging. */
-
-	while (1) {
-		lispobj cdr, new_cdr, first;
-		struct cons *cdr_cons, *new_cdr_cons;
-
-		cdr = cons->cdr;
-
-                if (LowtagOf(cdr) != type_ListPointer ||
-                    !from_space_p(cdr) ||
-                    (Pointerp(first = *(lispobj *)PTR(cdr)) &&
-                     new_space_p(first)))
-                	break;
-
-		cdr_cons = (struct cons *) PTR(cdr);
-
-		/* ### Don't use copy_object here */
-		new_cdr = copy_object(cdr, 2);
-		new_cdr_cons = (struct cons *) PTR(new_cdr);
-
-		/* Set forwarding pointer */
-		cdr_cons->car = new_cdr;
-
-		/* Update the cdr of the last cons copied into new */
-		/* space to keep the newspace scavenge from having to */
-		/* do it. */
-		new_cons->cdr = new_cdr;
-		
-		cons = cdr_cons;
-		new_cons = new_cdr_cons;
-	}
-
-	return new_list_pointer;
-}
-
-
-/* Scavenging and Transporting Other Pointers */
-
-static
-scav_other_pointer(where, object)
-lispobj *where, object;
-{
-	gc_assert(Pointerp(object));
-
-	if (from_space_p(object)) {
-		lispobj first, *first_pointer;
-
-		/* object is a pointer into from space.  check to see */
-		/* if it has been forwarded */
-		first_pointer = (lispobj *) PTR(object);
-		first = *first_pointer;
-		
-		if (!(Pointerp(first) && new_space_p(first)))
-			first = *first_pointer = 
-				(transother[TypeOf(first)])(object);
-
-		gc_assert(Pointerp(first));
-		gc_assert(!from_space_p(first));
-
-		*where = first;
-	}
-	return 1;
-}
-
-
-/* Immediate, Boxed, and Unboxed Objects */
-
-static
-size_pointer(where)
-lispobj *where;
-{
-	return 1;
-}
-
-
-static
-scav_immediate(where, object)
-lispobj *where, object;
-{
-	return 1;
-}
-
-static lispobj
-trans_immediate(object)
-lispobj object;
-{
-	fprintf(stderr, "GC lossage.  Trying to transport an immediate!?\n");
-	gc_lose();
-	return NIL;
-}
-
-static
-size_immediate(where)
-lispobj *where;
-{
-	return 1;
-}
-
-
-static
-scav_boxed(where, object)
-lispobj *where, object;
-{
-	return 1;
-}
-
-static lispobj
-trans_boxed(object)
-lispobj object;
-{
-	lispobj header;
-	unsigned long length;
-
-	gc_assert(Pointerp(object));
-
-	header = *((lispobj *) PTR(object));
-	length = HeaderValue(header) + 1;
-	length = CEILING(length, 2);
-
-	return copy_object(object, length);
-}
-
-static
-size_boxed(where)
-lispobj *where;
-{
-	lispobj header;
-	unsigned long length;
-
-	header = *where;
-	length = HeaderValue(header) + 1;
-	length = CEILING(length, 2);
-
-	return length;
-}
-
-/* Note: on the sparc we don't have to do anything special for fdefns, */
-/* cause the raw-addr has a function lowtag. */
-#ifndef sparc
-static
-scav_fdefn(where, object)
-lispobj *where, object;
-{
-    struct fdefn *fdefn;
-#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
-
-    fdefn = (struct fdefn *)where;
-    
-    if ((char *)(fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr) {
-        scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
-        fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET);
-        return sizeof(struct fdefn) / sizeof(lispobj);
-    }
-    else
-        return 1;
-}
-#endif
-
-static
-scav_unboxed(where, object)
-lispobj *where, object;
-{
-	unsigned long length;
-
-	length = HeaderValue(object) + 1;
-	length = CEILING(length, 2);
-
-	return length;
-}
-
-static lispobj
-trans_unboxed(object)
-lispobj object;
-{
-	lispobj header;
-	unsigned long length;
-
-
-	gc_assert(Pointerp(object));
-
-	header = *((lispobj *) PTR(object));
-	length = HeaderValue(header) + 1;
-	length = CEILING(length, 2);
-
-	return copy_object(object, length);
-}
-
-static
-size_unboxed(where)
-lispobj *where;
-{
-	lispobj header;
-	unsigned long length;
-
-	header = *where;
-	length = HeaderValue(header) + 1;
-	length = CEILING(length, 2);
-
-	return length;
-}
-
-
-/* Vector-Like Objects */
-
-#define NWORDS(x,y) (CEILING((x),(y)) / (y))
-
-static
-scav_string(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	/* NOTE: Strings contain one more byte of data than the length */
-	/* slot indicates. */
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length) + 1;
-	nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
-	return nwords;
-}
-
-static lispobj
-trans_string(object)
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	/* NOTE: Strings contain one more byte of data than the length */
-	/* slot indicates. */
-
-	vector = (struct vector *) PTR(object);
-	length = FIXNUM_TO_INT(vector->length) + 1;
-	nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_string(where)
-lispobj *where;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	/* NOTE: Strings contain one more byte of data than the length */
-	/* slot indicates. */
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length) + 1;
-	nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
-	return nwords;
-}
-
-static
-scav_vector(where, object)
-lispobj *where, object;
-{
-    if (HeaderValue(object) == subtype_VectorValidHashing)
-        *where = (subtype_VectorMustRehash<<type_Bits) | type_SimpleVector;
-
-    return 1;
-}
-
-
-static lispobj
-trans_vector(object)
-lispobj object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	vector = (struct vector *) PTR(object);
-
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_vector(where)
-lispobj *where;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length + 2, 2);
-
-	return nwords;
-}
-
-
-static
-scav_vector_bit(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 32) + 2, 2);
-
-	return nwords;
-}
-
-static lispobj
-trans_vector_bit(object)
-lispobj object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	vector = (struct vector *) PTR(object);
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 32) + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_vector_bit(where)
-lispobj *where;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 32) + 2, 2);
-
-	return nwords;
-}
-
-
-static
-scav_vector_unsigned_byte_2(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 16) + 2, 2);
-
-	return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_2(object)
-lispobj object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	vector = (struct vector *) PTR(object);
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 16) + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_vector_unsigned_byte_2(where)
-lispobj *where;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 16) + 2, 2);
-
-	return nwords;
-}
-
-
-static
-scav_vector_unsigned_byte_4(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 8) + 2, 2);
-
-	return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_4(object)
-lispobj object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	vector = (struct vector *) PTR(object);
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 8) + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_vector_unsigned_byte_4(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 8) + 2, 2);
-
-	return nwords;
-}
-
-
-static
-scav_vector_unsigned_byte_8(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
-	return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_8(object)
-lispobj object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	vector = (struct vector *) PTR(object);
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_vector_unsigned_byte_8(where)
-lispobj *where;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 4) + 2, 2);
-
-	return nwords;
-}
-
-
-static
-scav_vector_unsigned_byte_16(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 2) + 2, 2);
-
-	return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_16(object)
-lispobj object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	vector = (struct vector *) PTR(object);
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 2) + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_vector_unsigned_byte_16(where)
-lispobj *where;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(NWORDS(length, 2) + 2, 2);
-
-	return nwords;
-}
-
-
-static
-scav_vector_unsigned_byte_32(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length + 2, 2);
-
-	return nwords;
-}
-
-static lispobj
-trans_vector_unsigned_byte_32(object)
-lispobj object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	vector = (struct vector *) PTR(object);
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_vector_unsigned_byte_32(where)
-lispobj *where;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length + 2, 2);
-
-	return nwords;
-}
-
-
-static
-scav_vector_single_float(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length + 2, 2);
-
-	return nwords;
-}
-
-static lispobj
-trans_vector_single_float(object)
-lispobj object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	vector = (struct vector *) PTR(object);
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_vector_single_float(where)
-lispobj *where;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length + 2, 2);
-
-	return nwords;
-}
-
-
-static
-scav_vector_double_float(where, object)
-lispobj *where, object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length * 2 + 2, 2);
-
-	return nwords;
-}
-
-static lispobj
-trans_vector_double_float(object)
-lispobj object;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	gc_assert(Pointerp(object));
-
-	vector = (struct vector *) PTR(object);
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length * 2 + 2, 2);
-
-	return copy_object(object, nwords);
-}
-
-static
-size_vector_double_float(where)
-lispobj *where;
-{
-	struct vector *vector;
-	int length, nwords;
-
-	vector = (struct vector *) where;
-	length = FIXNUM_TO_INT(vector->length);
-	nwords = CEILING(length * 2 + 2, 2);
-
-	return nwords;
-}
-
-
-/* Weak Pointers */
-
-#define WEAK_POINTER_NWORDS \
-	CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
-
-static
-scav_weak_pointer(where, object)
-lispobj *where, object;
-{
-	/* Do not let GC scavenge the value slot of the weak pointer */
-	/* (that is why it is a weak pointer).  Note:  we could use */
-	/* the scav_unboxed method here. */
-
-	return WEAK_POINTER_NWORDS;
-}
-
-static lispobj
-trans_weak_pointer(object)
-lispobj object;
-{
-	lispobj copy;
-	struct weak_pointer *wp;
-
-	gc_assert(Pointerp(object));
-
-#if defined(DEBUG_WEAK)
-	printf("Transporting weak pointer from 0x%08x\n", object);
-#endif
-
-	/* Need to remember where all the weak pointers are that have */
-	/* been transported so they can be fixed up in a post-GC pass. */
-
-	copy = copy_object(object, WEAK_POINTER_NWORDS);
-	wp = (struct weak_pointer *) PTR(copy);
-	
-
-	/* Push the weak pointer onto the list of weak pointers. */
-	wp->next = weak_pointers;
-	weak_pointers = wp;
-
-	return copy;
-}
-
-static
-size_weak_pointer(where)
-lispobj *where;
-{
-	return WEAK_POINTER_NWORDS;
-}
-
-scan_weak_pointers()
-{
-	struct weak_pointer *wp;
-
-	for (wp = weak_pointers; wp != (struct weak_pointer *) NULL;
-	     wp = wp->next) {
-		lispobj value;
-		lispobj first, *first_pointer;
-
-		value = wp->value;
-
-#if defined(DEBUG_WEAK)
-		printf("Weak pointer at 0x%08x\n", (unsigned long) wp);
-		printf("Value: 0x%08x\n", (unsigned long) value);
-#endif		
-
-		if (!(Pointerp(value) && from_space_p(value)))
-			continue;
-
-		/* Now, we need to check if the object has been */
-		/* forwarded.  If it has been, the weak pointer is */
-		/* still good and needs to be updated.  Otherwise, the */
-		/* weak pointer needs to be nil'ed out. */
-
-		first_pointer = (lispobj *) PTR(value);
-		first = *first_pointer;
-		
-#if defined(DEBUG_WEAK)
-		printf("First: 0x%08x\n", (unsigned long) first);
-#endif		
-
-		if (Pointerp(first) && new_space_p(first))
-			wp->value = first;
-		else {
-			wp->value = NIL;
-			wp->broken = T;
-		}
-	}
-}
-
-
-
-/* Initialization */
-
-static
-scav_lose(object)
-lispobj object;
-{
-	fprintf(stderr, "GC lossage.  No scavenge function for object 0x%08x\n",
-		(unsigned long) object);
-	gc_lose();
-	return 0;
-}
-
-static lispobj
-trans_lose(object)
-lispobj object;
-{
-	fprintf(stderr, "GC lossage.  No transport function for object 0x%08x\n",
-		(unsigned long) object);
-	gc_lose();
-	return NIL;
-}
-
-static
-size_lose(where)
-lispobj *where;
-{
-	fprintf(stderr, "Size lossage.  No size function for object at 0x%08x\n",
-		(unsigned long) where);
-	fprintf(stderr, "First word of object: 0x%08x\n",
-		(unsigned long) *where);
-	return 1;
-}
-
-gc_init()
-{
-	int i;
-
-	/* Scavenge Table */
-	for (i = 0; i < 256; i++)
-		scavtab[i] = scav_lose;
-
-	for (i = 0; i < 32; i++) {
-		scavtab[type_EvenFixnum|(i<<3)] = scav_immediate;
-		scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer;
-		/* OtherImmediate0 */
-		scavtab[type_ListPointer|(i<<3)] = scav_list_pointer;
-		scavtab[type_OddFixnum|(i<<3)] = scav_immediate;
-		scavtab[type_StructurePointer|(i<<3)] = scav_structure_pointer;
-		/* OtherImmediate1 */
-		scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer;
-	}
-
-	scavtab[type_Bignum] = scav_unboxed;
-	scavtab[type_Ratio] = scav_boxed;
-	scavtab[type_SingleFloat] = scav_unboxed;
-	scavtab[type_DoubleFloat] = scav_unboxed;
-	scavtab[type_Complex] = scav_boxed;
-	scavtab[type_SimpleArray] = scav_boxed;
-	scavtab[type_SimpleString] = scav_string;
-	scavtab[type_SimpleBitVector] = scav_vector_bit;
-	scavtab[type_SimpleVector] = scav_vector;
-	scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2;
-	scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4;
-	scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8;
-	scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16;
-	scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32;
-	scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float;
-	scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float;
-	scavtab[type_ComplexString] = scav_boxed;
-	scavtab[type_ComplexBitVector] = scav_boxed;
-	scavtab[type_ComplexVector] = scav_boxed;
-	scavtab[type_ComplexArray] = scav_boxed;
-	scavtab[type_CodeHeader] = scav_code_header;
-	scavtab[type_FunctionHeader] = scav_function_header;
-	scavtab[type_ClosureFunctionHeader] = scav_function_header;
-	scavtab[type_ReturnPcHeader] = scav_return_pc_header;
-	scavtab[type_ClosureHeader] = scav_boxed;
-	scavtab[type_FuncallableInstanceHeader] = scav_boxed;
-	scavtab[type_ByteCodeFunction] = scav_boxed;
-	scavtab[type_ByteCodeClosure] = scav_boxed;
-	scavtab[type_ValueCellHeader] = scav_boxed;
-        scavtab[type_SymbolHeader] = scav_boxed;
-	scavtab[type_BaseChar] = scav_immediate;
-	scavtab[type_Sap] = scav_unboxed;
-	scavtab[type_UnboundMarker] = scav_immediate;
-	scavtab[type_WeakPointer] = scav_weak_pointer;
-        scavtab[type_StructureHeader] = scav_boxed;
-#ifndef sparc
-        scavtab[type_Fdefn] = scav_fdefn;
-#else
-        scavtab[type_Fdefn] = scav_boxed;
-#endif
-
-	/* Transport Other Table */
-	for (i = 0; i < 256; i++)
-		transother[i] = trans_lose;
-
-	transother[type_Bignum] = trans_unboxed;
-	transother[type_Ratio] = trans_boxed;
-	transother[type_SingleFloat] = trans_unboxed;
-	transother[type_DoubleFloat] = trans_unboxed;
-	transother[type_Complex] = trans_boxed;
-	transother[type_SimpleArray] = trans_boxed;
-	transother[type_SimpleString] = trans_string;
-	transother[type_SimpleBitVector] = trans_vector_bit;
-	transother[type_SimpleVector] = trans_vector;
-	transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2;
-	transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4;
-	transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8;
-	transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16;
-	transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32;
-	transother[type_SimpleArraySingleFloat] = trans_vector_single_float;
-	transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float;
-	transother[type_ComplexString] = trans_boxed;
-	transother[type_ComplexBitVector] = trans_boxed;
-	transother[type_ComplexVector] = trans_boxed;
-	transother[type_ComplexArray] = trans_boxed;
-	transother[type_CodeHeader] = trans_code_header;
-	transother[type_FunctionHeader] = trans_function_header;
-	transother[type_ClosureFunctionHeader] = trans_function_header;
-	transother[type_ReturnPcHeader] = trans_return_pc_header;
-	transother[type_ClosureHeader] = trans_boxed;
-	transother[type_FuncallableInstanceHeader] = trans_boxed;
-	transother[type_ByteCodeFunction] = trans_boxed;
-	transother[type_ByteCodeClosure] = trans_boxed;
-	transother[type_ValueCellHeader] = trans_boxed;
-	transother[type_SymbolHeader] = trans_boxed;
-	transother[type_BaseChar] = trans_immediate;
-	transother[type_Sap] = trans_unboxed;
-	transother[type_UnboundMarker] = trans_immediate;
-	transother[type_WeakPointer] = trans_weak_pointer;
-        transother[type_StructureHeader] = trans_vector;
-	transother[type_Fdefn] = trans_boxed;
-
-	/* Size table */
-
-	for (i = 0; i < 256; i++)
-		sizetab[i] = size_lose;
-
-	for (i = 0; i < 32; i++) {
-		sizetab[type_EvenFixnum|(i<<3)] = size_immediate;
-		sizetab[type_FunctionPointer|(i<<3)] = size_pointer;
-		/* OtherImmediate0 */
-		sizetab[type_ListPointer|(i<<3)] = size_pointer;
-		sizetab[type_OddFixnum|(i<<3)] = size_immediate;
-		sizetab[type_StructurePointer|(i<<3)] = size_pointer;
-		/* OtherImmediate1 */
-		sizetab[type_OtherPointer|(i<<3)] = size_pointer;
-	}
-
-	sizetab[type_Bignum] = size_unboxed;
-	sizetab[type_Ratio] = size_boxed;
-	sizetab[type_SingleFloat] = size_unboxed;
-	sizetab[type_DoubleFloat] = size_unboxed;
-	sizetab[type_Complex] = size_boxed;
-	sizetab[type_SimpleArray] = size_boxed;
-	sizetab[type_SimpleString] = size_string;
-	sizetab[type_SimpleBitVector] = size_vector_bit;
-	sizetab[type_SimpleVector] = size_vector;
-	sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2;
-	sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4;
-	sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8;
-	sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16;
-	sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32;
-	sizetab[type_SimpleArraySingleFloat] = size_vector_single_float;
-	sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float;
-	sizetab[type_ComplexString] = size_boxed;
-	sizetab[type_ComplexBitVector] = size_boxed;
-	sizetab[type_ComplexVector] = size_boxed;
-	sizetab[type_ComplexArray] = size_boxed;
-	sizetab[type_CodeHeader] = size_code_header;
-#if 0
-	/* Shouldn't see these so just lose if it happens */
-	sizetab[type_FunctionHeader] = size_function_header;
-	sizetab[type_ClosureFunctionHeader] = size_function_header;
-	sizetab[type_ReturnPcHeader] = size_return_pc_header;
-#endif
-	sizetab[type_ClosureHeader] = size_boxed;
-	sizetab[type_FuncallableInstanceHeader] = size_boxed;
-	sizetab[type_ValueCellHeader] = size_boxed;
-	sizetab[type_SymbolHeader] = size_boxed;
-	sizetab[type_BaseChar] = size_immediate;
-	sizetab[type_Sap] = size_unboxed;
-	sizetab[type_UnboundMarker] = size_immediate;
-	sizetab[type_WeakPointer] = size_weak_pointer;
-        sizetab[type_StructureHeader] = size_vector;
-	sizetab[type_Fdefn] = size_boxed;
-}
-
-
-
-/* Noise to manipulate the gc trigger stuff. */
-
-#ifndef ibmrt
-
-void set_auto_gc_trigger(dynamic_usage)
-     unsigned long dynamic_usage;
-{
-    os_vm_address_t addr=(os_vm_address_t)current_dynamic_space + dynamic_usage;
-    os_vm_size_t length=
-	DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
-
-    if(addr < (os_vm_address_t)current_dynamic_space_free_pointer) {
-	fprintf(stderr,
-	   "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %d)\n",
-		dynamic_usage,
-		(os_vm_address_t)current_dynamic_space_free_pointer
-		- (os_vm_address_t)current_dynamic_space);
-	return;
-    }
-    else if (length < 0) {
-	fprintf(stderr,
-		"set_auto_gc_trigger: tried to set gc trigger too high! (%d)\n",
-		dynamic_usage);
-	return;
-    }
-
-    addr=os_round_up_to_page(addr);
-    length=os_trunc_size_to_page(length);
-
-#ifndef MACH
-    os_invalidate(addr,length);
-#else
-    os_protect(addr, length, 0);
-#endif
-
-    current_auto_gc_trigger = (lispobj *)addr;
-}
-
-void clear_auto_gc_trigger()
-{
-    if(current_auto_gc_trigger!=NULL){
-#ifndef MACH /* don't want to force whole space into swapping mode... */
-	os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger;
-	os_vm_size_t length=
-	    DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
-
-	os_validate(addr,length);
-#else
-	os_protect((os_vm_address_t)current_dynamic_space,
-		   DYNAMIC_SPACE_SIZE,
-		   OS_VM_PROT_ALL);
-#endif
-
-	current_auto_gc_trigger = NULL;
-    }
-}
-
-#endif
diff --git a/ldb/gc.h b/ldb/gc.h
deleted file mode 100644
index 4f4ece061..000000000
--- a/ldb/gc.h
+++ /dev/null
@@ -1,33 +0,0 @@
-/*
- * Header file for GC
- *
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/gc.h,v 1.4 1990/11/12 02:36:28 wlott Exp $
- */
-
-#if !defined(_INCLUDED_GC_H_)
-#define _INCLUDED_GC_H_
-
-#include "lisp.h"
-
-extern void gc_lose();
-
-#define gc_abort() do { \
-	fprintf(stderr, "GC invariant lost!  File \"%s\", line %d\n", \
-	__FILE__, __LINE__); \
-	gc_lose(); \
-} while (0)
-
-#if 0
-#define gc_assert(ex) do { \
-	if (!(ex)) gc_abort(); \
-} while (0)
-#else
-#define gc_assert(ex)
-#endif
-
-
-#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
-#define FIXNUM_TO_INT(x) ((x)>>2)
-#define INT_TO_FIXNUM(x) ((x)<<2)
-
-#endif
diff --git a/ldb/globals.c b/ldb/globals.c
deleted file mode 100644
index 237fcd6df..000000000
--- a/ldb/globals.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.c,v 1.9 1991/10/22 19:20:34 wlott Exp $ */
-
-/* Variables everybody needs to look at or frob on. */
-
-#include <stdio.h>
-
-#include "lisp.h"
-#include "ldb.h"
-#include "globals.h"
-
-char *number_stack_start;
-
-int foreign_function_call_active;
-
-#ifdef mips
-unsigned long saved_global_pointer;
-unsigned long current_flags_register;
-#endif
-
-lispobj *current_control_stack_pointer;
-lispobj *current_control_frame_pointer;
-#ifndef ibmrt
-lispobj *current_binding_stack_pointer;
-#endif
-
-lispobj *read_only_space;
-lispobj *static_space;
-lispobj *dynamic_0_space;
-lispobj *dynamic_1_space;
-lispobj *control_stack;
-lispobj *binding_stack;
-
-lispobj *current_dynamic_space;
-#ifndef ibmrt
-lispobj *current_dynamic_space_free_pointer;
-lispobj *current_auto_gc_trigger;
-#endif
-
-globals_init()
-{
-	/* Space, stack, and free pointer vars are initialized by
-	   validate() and coreparse(). */
-
-#ifdef mips
-	/* Get the current value of GP. */
-	saved_global_pointer = current_global_pointer();
-
-        /* Set the Atomic flag */
-	current_flags_register = 1<<flag_Atomic;
-#endif
-#ifndef ibmrt
-
-        /* No GC trigger yet */
-        current_auto_gc_trigger = NULL;
-#endif
-
-	/* Set foreign function call active. */
-	foreign_function_call_active = 1;
-
-	/* Initialize the current lisp state. */
-	current_control_stack_pointer = control_stack;
-	current_control_frame_pointer = (lispobj *)0;
-#ifndef ibmrt
-	current_binding_stack_pointer = binding_stack;
-#endif
-}
diff --git a/ldb/globals.h b/ldb/globals.h
deleted file mode 100644
index fc11198a5..000000000
--- a/ldb/globals.h
+++ /dev/null
@@ -1,68 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/globals.h,v 1.8 1991/10/22 18:38:04 wlott Exp $ */
-
-#if !defined(_INCLUDE_GLOBALS_H_)
-#define _INCLUDED_GLOBALS_H_
-
-#include "lisp.h"
-
-#ifndef LANGUAGE_ASSEMBLY
-
-extern char *number_stack_start;
-
-extern int foreign_function_call_active;
-
-#ifdef mips
-extern unsigned long saved_global_pointer;
-extern unsigned long current_flags_register;
-#endif
-
-extern lispobj *current_control_stack_pointer;
-extern lispobj *current_control_frame_pointer;
-#ifndef ibmrt
-extern lispobj *current_binding_stack_pointer;
-#endif
-
-extern lispobj *read_only_space;
-extern lispobj *static_space;
-extern lispobj *dynamic_0_space;
-extern lispobj *dynamic_1_space;
-extern lispobj *control_stack;
-extern lispobj *binding_stack;
-
-extern lispobj *current_dynamic_space;
-#ifndef ibmrt
-extern lispobj *current_dynamic_space_free_pointer;
-extern lispobj *current_auto_gc_trigger;
-#endif
-
-#else  LANGUAGE_ASSEMBLY
-
-/* These are needed by ./assem.s */
-
-#ifdef mips
-#define EXTERN(name,bytes) .extern name bytes
-#endif
-#ifdef sparc
-#define EXTERN(name,bytes) .global _/**/name
-#endif
-#ifdef ibmrt
-#define EXTERN(name,bytes) .globl _/**/name
-#endif
-
-
-EXTERN(foreign_function_call_active, 4)
-
-EXTERN(current_control_stack_pointer, 4)
-EXTERN(current_control_frame_pointer, 4)
-#ifndef ibmrt
-EXTERN(current_binding_stack_pointer, 4)
-EXTERN(current_dynamic_space_free_pointer, 4)
-#endif
-
-#ifdef mips
-EXTERN(current_flags_register, 4)
-#endif
-
-#endif LANGUAGE_ASSEMBLY
-
-#endif _INCLUDED_GLOBALS_H_
diff --git a/ldb/interrupt.c b/ldb/interrupt.c
deleted file mode 100644
index e99352873..000000000
--- a/ldb/interrupt.c
+++ /dev/null
@@ -1,417 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/interrupt.c,v 1.34 1992/03/22 20:25:51 wlott Exp $ */
-
-/* Interrupt handing magic. */
-
-#include <stdio.h>
-
-#include <signal.h>
-#ifdef mips
-#include <mips/cpu.h>
-#endif
-
-#include "ldb.h"
-
-#include "os.h"
-#include "arch.h"
-#include "lisp.h"
-#include "globals.h"
-#include "lispregs.h"
-#include "interrupt.h"
-#include "validate.h"
-
-#define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2)
-
-boolean internal_errors_enabled = 0;
-
-struct sigcontext *lisp_interrupt_contexts[MAX_INTERRUPTS];
-
-union interrupt_handler interrupt_handlers[NSIG];
-SIGHDLRTYPE (*interrupt_low_level_handlers[NSIG])() = {0};
-
-static int pending_signal = 0, pending_code = 0, pending_mask = 0;
-static boolean maybe_gc_pending = FALSE;
-
-
-/****************************************************************\
-* Utility routines used by various signal handlers.              *
-\****************************************************************/
-
-void fake_foreign_function_call(context)
-     struct sigcontext *context;
-{
-    int context_index;
-    lispobj oldcont;
-    
-    /* Get current LISP state from context */
-#ifndef ibmrt
-    current_dynamic_space_free_pointer = (lispobj *) context->sc_regs[ALLOC];
-    current_binding_stack_pointer = (lispobj *) context->sc_regs[BSP];
-#endif
-#ifdef mips
-    current_flags_register = context->sc_regs[FLAGS]|(1<<flag_Atomic);
-#endif
-    
-    /* Build a fake stack frame */
-    current_control_frame_pointer = (lispobj *) context->sc_regs[CSP];
-    if ((lispobj *)context->sc_regs[CFP]==current_control_frame_pointer) {
-        /* There is a small window during call where the callee's frame */
-        /* isn't built yet. */
-        if (LowtagOf(context->sc_regs[CODE]) == type_FunctionPointer) {
-            /* We have called, but not built the new frame, so
-               build it for them. */
-            current_control_frame_pointer[0] = context->sc_regs[OCFP];
-            current_control_frame_pointer[1] = context->sc_regs[LRA];
-            current_control_frame_pointer += 8;
-            /* Build our frame on top of it. */
-            oldcont = (lispobj)context->sc_regs[CFP];
-        }
-        else {
-            /* We haven't yet called, build our frame as if the
-               partial frame wasn't there. */
-            oldcont = (lispobj)context->sc_regs[OCFP];
-        }
-    }
-    /* ### We can't tell if we are still in the caller if it had to
-       allocate the stack frame due to stack arguments. */
-    /* ### Can anything strange happen during return? */
-    else
-        /* Normal case. */
-        oldcont = (lispobj)context->sc_regs[CFP];
-    
-    current_control_stack_pointer = current_control_frame_pointer + 8;
-
-    current_control_frame_pointer[0] = oldcont;
-    current_control_frame_pointer[1] = NIL;
-    current_control_frame_pointer[2] = (lispobj)context->sc_regs[CODE];
-    
-#ifdef mips
-    /* Restore the GP */
-    set_global_pointer(saved_global_pointer);
-#endif
-    
-    /* Do dynamic binding of the active interrupt context index
-       and save the context in the context array. */
-    context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
-    
-    if (context_index >= MAX_INTERRUPTS) {
-        fprintf("Maximum number (%d) of interrupts exceeded.  Exiting.\n",
-                MAX_INTERRUPTS);
-        exit(1);
-    }
-    
-    bind_variable(FREE_INTERRUPT_CONTEXT_INDEX, fixnum(context_index + 1));
-    
-    lisp_interrupt_contexts[context_index] = context;
-    
-    /* No longer in Lisp now. */
-    foreign_function_call_active = 1;
-}
-
-void undo_fake_foreign_function_call(context)
-     struct sigcontext *context;
-{
-    /* Block all blockable signals */
-    sigblock(BLOCKABLE);
-    
-    /* Going back into lisp. */
-    foreign_function_call_active = 0;
-    
-    /* Undo dynamic binding. */
-    /* ### Do I really need to unbind_to_here()? */
-    unbind();
-    
-#ifndef ibmrt
-    /* Put the dynamic space free pointer back into the context. */
-    context->sc_regs[ALLOC] =
-        (unsigned long) current_dynamic_space_free_pointer;
-#endif
-}
-
-#define call_maybe_gc() \
-    funcall_sym(MAYBE_GC, current_control_stack_pointer, 0)
-
-void interrupt_internal_error(signal, code, context, continuable)
-     struct sigcontext *context;
-     boolean continuable;
-{
-    lispobj *args;
-
-    if (internal_errors_enabled) {
-	sigsetmask(context->sc_mask);
-	fake_foreign_function_call(context);
-	args = current_control_stack_pointer;
-	current_control_stack_pointer += 2;
-	args[0] = alloc_sap(context);
-	if (continuable)
-	    args[1] = T;
-	else
-	    args[1] = NIL;
-	funcall_sym(INTERNAL_ERROR, args, 2);
-	undo_fake_foreign_function_call(context);
-	if (continuable)
-	    arch_skip_instruction(context);
-    }
-    else
-	interrupt_handle_now(signal, code, context);
-}
-
-void interrupt_handle_pending(context)
-     struct sigcontext *context;
-{
-    if (foreign_function_call_active)
-	crap_out("Oh no, got a PendingInterrupt while foreign function call was active.\n");
-
-#ifdef mips
-    context->sc_regs[FLAGS] &= ~(1<<flag_Interrupted);
-#else
-#ifdef sparc
-    /* Bit 0 is the pseudo-atomic-interrupted flag, and bit 2 is the
-	pseudo-atomic-atomic flag.  Normally, p-a-a is cleared before
-	we get control, but sometimes (assembly/sparc/bit-bash.lisp)
-	it is not.  So we clear them both here. */
-    context->sc_regs[ALLOC] &= ~5;
-#else
-    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, 0);
-#endif
-#endif
-    SetSymbolValue(INTERRUPT_PENDING, NIL);
-    if (maybe_gc_pending) {
-	maybe_gc_pending = FALSE;
-	fake_foreign_function_call(context);
-	call_maybe_gc();
-	undo_fake_foreign_function_call(context);
-    }
-    if (pending_signal) {
-	int signal, code;
-
-	signal = pending_signal;
-	code = pending_code;
-	pending_signal = 0;
-	pending_code = 0;
-	interrupt_handle_now(signal, code, context);
-    }
-    context->sc_mask = pending_mask;
-    pending_mask = 0;
-    arch_skip_instruction(context);
-}
-
-
-/****************************************************************\
-* interrupt_handle_now, maybe_now_maybe_later                    *
-*    the two main signal handlers.                               *
-\****************************************************************/
-
-SIGHDLRTYPE interrupt_handle_now(signal, code, context)
-int signal, code;
-struct sigcontext *context;
-{
-    int were_in_lisp;
-    union interrupt_handler handler;
-    lispobj *args;
-    lispobj function;
-    
-    handler = interrupt_handlers[signal];
-
-    if(handler.c==SIG_IGN)
-	return;
-
-    were_in_lisp = !foreign_function_call_active;
-    if (were_in_lisp)
-        fake_foreign_function_call(context);
-    
-    /* Allow signals again. */
-    sigsetmask(context->sc_mask);
-
-    if(handler.c==SIG_DFL){
-	/* This can happen if someone tries to ignore or default on of the */
-	/* signals we need for runtime support. */
-	fprintf(stderr,"interrupt_handle_now: No handler for signal %d?\n",signal);
-	printf("[exit debugger to continue]\n");
-	ldb_monitor();
-    }
-    else if (LowtagOf(handler.lisp) == type_EvenFixnum ||
-        LowtagOf(handler.lisp) == type_OddFixnum)
-        (*handler.c)(signal, code, context);
-    else {
-        args = current_control_stack_pointer;
-        current_control_stack_pointer += 3;
-        args[0] = fixnum(signal);
-        args[1] = fixnum(code);
-        args[2] = alloc_sap(context);
-	function = handler.lisp;
-        call_into_lisp(function, function, args, 3);
-    }
-    
-    if (were_in_lisp)
-        undo_fake_foreign_function_call(context);
-}
-
-static SIGHDLRTYPE maybe_now_maybe_later(signal, code, context)
-int signal, code;
-struct sigcontext *context;
-{
-    if (SymbolValue(INTERRUPTS_ENABLED) == NIL) {
-        pending_signal = signal;
-        pending_code = code;
-        pending_mask = context->sc_mask;
-        context->sc_mask |= BLOCKABLE;
-        SetSymbolValue(INTERRUPT_PENDING, T);
-    } else if ((!foreign_function_call_active)
-#ifdef mips
-               && (context->sc_regs[FLAGS] & (1<<flag_Atomic))
-#else
-#ifdef sparc
-	       && (context->sc_regs[ALLOC] & 4)
-#else
-	       && (SymbolValue(PSEUDO_ATOMIC_ATOMIC))
-#endif
-#endif
-               ) {
-        pending_signal = signal;
-        pending_code = code;
-        pending_mask = context->sc_mask;
-        context->sc_mask |= BLOCKABLE;
-#ifdef mips
-        context->sc_regs[FLAGS] |= (1<<flag_Interrupted);
-#else
-#ifdef sparc
-	context->sc_regs[ALLOC] |= 1;
-#else
-	SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, T);
-#endif
-#endif
-    } else
-        interrupt_handle_now(signal, code, context);
-}
-
-/****************************************************************\
-* Stuff to detect and handle hitting the gc trigger.             *
-\****************************************************************/
-
-#ifndef ibmrt
-static boolean gc_trigger_hit(context)
-     struct sigcontext *context;
-{
-
-    if (current_auto_gc_trigger == NULL)
-	return FALSE;
-    else{
-	lispobj *badaddr=(lispobj *)arch_get_bad_addr(context);
-
-	return (badaddr >= current_auto_gc_trigger &&
-		badaddr < current_dynamic_space + DYNAMIC_SPACE_SIZE);
-    }
-}
-#endif
-
-
-boolean interrupt_maybe_gc(context)
-struct sigcontext *context;
-{
-    if (!foreign_function_call_active
-#ifndef ibmrt
-		  && gc_trigger_hit(context)
-#endif
-	) {
-#ifdef mips
-	set_global_pointer(saved_global_pointer);
-#endif
-#ifndef ibmrt
-	clear_auto_gc_trigger();
-#endif
-
-	if (
-#ifdef mips
-	    context->sc_regs[FLAGS] & (1<<flag_Atomic)
-#else
-#ifdef sparc
-	    context->sc_regs[ALLOC] & 4
-#else
-	    SymbolValue(PSEUDO_ATOMIC_ATOMIC)
-#endif sparc
-#endif mips
-	    ) {
-	    maybe_gc_pending = TRUE;
-	    if (pending_signal == 0) {
-		pending_mask = context->sc_mask;
-		context->sc_mask |= BLOCKABLE;
-	    }
-#ifdef mips
-	    context->sc_regs[FLAGS] |= (1<<flag_Interrupted);
-#else
-#ifdef sparc
-	    context->sc_regs[ALLOC] |= 1;
-#else
-	    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, T);
-#endif
-#endif
-	}
-	else {
-	    fake_foreign_function_call(context);
-	    call_maybe_gc();
-	    undo_fake_foreign_function_call(context);
-	}
-
-	return TRUE;
-    }else
-	return FALSE;
-}
-
-/****************************************************************\
-* Noise to install handlers.                                     *
-\****************************************************************/
-
-void interrupt_install_low_level_handler(signal,handler)
-int signal;
-SIGHDLRTYPE (*handler)();
-{
-    struct sigvec sv;
-
-    sv.sv_handler=handler;
-    sv.sv_mask=BLOCKABLE;
-    sv.sv_flags=0;
-
-    sigvec(signal,&sv,NULL);
-
-    interrupt_low_level_handlers[signal]=(handler==SIG_DFL ? 0 : handler);
-}
-
-unsigned long install_handler(signal, handler)
-int signal;
-SIGHDLRTYPE (*handler)();
-{
-    struct sigvec sv;
-    int oldmask;
-    union interrupt_handler oldhandler;
-
-    oldmask = sigblock(sigmask(signal));
-
-    if(interrupt_low_level_handlers[signal]==0){
-	if(handler==SIG_DFL || handler==SIG_IGN)
-	    sv.sv_handler=handler;
-	else if (sigmask(signal)&BLOCKABLE)
-	    sv.sv_handler = maybe_now_maybe_later;
-	else
-	    sv.sv_handler = interrupt_handle_now;
-
-	sv.sv_mask = BLOCKABLE;
-	sv.sv_flags = 0;
-
-	sigvec(signal, &sv, NULL);
-    }
-
-    oldhandler = interrupt_handlers[signal];
-    interrupt_handlers[signal].c = handler;
-
-    sigsetmask(oldmask);
-
-    return (unsigned long)oldhandler.lisp;
-}
-
-interrupt_init()
-{
-    int i;
-
-    for (i = 0; i < NSIG; i++)
-        interrupt_handlers[i].c = SIG_DFL;
-}
diff --git a/ldb/interrupt.h b/ldb/interrupt.h
deleted file mode 100644
index 2e62292de..000000000
--- a/ldb/interrupt.h
+++ /dev/null
@@ -1,38 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/interrupt.h,v 1.3 1991/09/27 10:32:30 wlott Exp $ */
-
-#if !defined(_INCLUDE_INTERRUPT_H_)
-#define _INCLUDE_INTERRUPT_H_
-
-#include <signal.h>
-
-#define MAX_INTERRUPTS (4096)
-
-extern struct sigcontext *lisp_interrupt_contexts[MAX_INTERRUPTS];
-
-#ifdef SUNOS
-#define SIGHDLRTYPE void
-#else
-#define SIGHDLRTYPE int
-#endif
-
-union interrupt_handler {
-	lispobj lisp;
-	SIGHDLRTYPE (*c)();
-};
-
-extern SIGHDLRTYPE interrupt_handle_now();
-extern void interrupt_handle_pending();
-extern void interrupt_internal_error();
-
-extern union interrupt_handler interrupt_handlers[NSIG];
-
-#define BLOCKABLE (sigmask(SIGHUP) | sigmask(SIGINT) | \
-		   sigmask(SIGQUIT) | sigmask(SIGPIPE) | \
-		   sigmask(SIGALRM) | sigmask(SIGURG) | \
-		   sigmask(SIGTSTP) | sigmask(SIGCHLD) | \
-		   sigmask(SIGIO) | sigmask(SIGXCPU) | \
-		   sigmask(SIGXFSZ) | sigmask(SIGVTALRM) | \
-		   sigmask(SIGPROF) | sigmask(SIGWINCH) | \
-		   sigmask(SIGUSR1) | sigmask(SIGUSR2))
-
-#endif
diff --git a/ldb/ldb.c b/ldb/ldb.c
deleted file mode 100644
index db70934e8..000000000
--- a/ldb/ldb.c
+++ /dev/null
@@ -1,160 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/ldb.c,v 1.20 1992/05/25 14:36:43 wlott Exp $ */
-/* Lisp kernel core debugger */
-
-#include <stdio.h>
-#include <sys/types.h>
-#include <sys/file.h>
-#include <sys/param.h>
-#include <sys/stat.h>
-
-#include "ldb.h"
-#include "lisp.h"
-#include "alloc.h"
-#include "vars.h"
-#include "globals.h"
-#include "os.h"
-#include "arch.h"
-
-lispobj lisp_nil_reg = NIL;
-char *lisp_csp_reg, *lisp_bsp_reg;
-
-static lispobj alloc_str_list(list)
-char *list[];
-{
-    lispobj result, newcons;
-    struct cons *ptr;
-
-    if (*list == NULL)
-        result = NIL;
-    else {
-        result = newcons = alloc_cons(alloc_string(*list++), NIL);
-
-        while (*list != NULL) {
-            ptr = (struct cons *)PTR(newcons);
-            newcons = alloc_cons(alloc_string(*list++), NIL);
-            ptr->cdr = newcons;
-        }
-    }
-
-    return result;
-}
-
-
-main(argc, argv, envp)
-int argc;
-char *argv[];
-char *envp[];
-{
-    char *arg, **argptr;
-    char *core = NULL, *default_core;
-    boolean restore_state, monitor;
-
-    number_stack_start = (char *)&monitor;
-
-    define_var("nil", NIL, TRUE);
-    define_var("t", T, TRUE);
-    monitor = FALSE;
-
-    argptr = argv;
-    while ((arg = *++argptr) != NULL) {
-        if (strcmp(arg, "-core") == 0) {
-            if (core != NULL) {
-                fprintf(stderr, "can only specify one core file.\n");
-                exit(1);
-            }
-            core = *++argptr;
-            if (core == NULL) {
-                fprintf(stderr, "-core must be followed by the name of the core file to use.\n");
-                exit(1);
-            }
-        }
-	else if (strcmp(arg, "-monitor") == 0) {
-	    monitor = TRUE;
-	}
-    }
-
-    default_core = arch_init();
-    if (default_core == NULL)
-	default_core = "lisp.core";
-
-    /* Note: the /usr/misc/.cmucl/lib/ default path is also wired into */
-    /* the lisp code in .../code/save.lisp. */
-
-    if (core == NULL) {
-	static char buf[MAXPATHLEN];
-	extern char *getenv();
-	char *lib = getenv("CMUCLLIB");
-
-	if (lib != NULL) {
-	    char *dst;
-	    struct stat statbuf;
-
-	    do {
-		dst = buf;
-		while (*lib != '\0' && *lib != ':')
-		    *dst++ = *lib++;
-		if (dst != buf && dst[-1] != '/')
-		    *dst++ = '/';
-		strcpy(dst, default_core);
-		if (stat(buf, &statbuf) == 0) {
-		    core = buf;
-		    break;
-		}
-	    } while (*lib++ == ':');
-	}
-	if (core == NULL) {
-	    strcpy(buf, "/usr/misc/.cmucl/lib/");
-	    strcat(buf, default_core);
-	    core = buf;
-	}
-    }
-
-    os_init();
-
-#if defined(EXT_PAGER)
-    pager_init();
-#endif
-
-    gc_init();
-    
-    validate();
-
-    globals_init();
-
-    restore_state = load_core_file(core);
-
-#ifdef ibmrt
-    if (!restore_state) {
-	SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack);
-	SetSymbolValue(INTERNAL_GC_TRIGGER, fixnum(-1));
-    }
-#endif
-
-    interrupt_init();
-
-    arch_install_interrupt_handlers();
-    os_install_interrupt_handlers();
-
-    /* Convert the argv and envp to something Lisp can grok. */
-    SetSymbolValue(LISP_COMMAND_LINE_LIST, alloc_str_list(argv));
-    SetSymbolValue(LISP_ENVIRONMENT_LIST, alloc_str_list(envp));
-
-#if !defined(mips) && !defined(sparc)
-    /* Turn on pseudo atomic for when we call into lisp. */
-    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, fixnum(1));
-    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, fixnum(0));
-#endif
-
-    /* Snag a few of the signal */
-    test_init();
-
-    if (!monitor) {
-	if (restore_state)
-            restore();
-	else
-	    funcall_sym(INITIAL_FUNCTION, current_control_stack_pointer, 0);
-	printf("%INITIAL-FUNCTION returned?");
-    }
-    while (1)
-	ldb_monitor();
-}
diff --git a/ldb/ldb.h b/ldb/ldb.h
deleted file mode 100644
index 7ee4ac054..000000000
--- a/ldb/ldb.h
+++ /dev/null
@@ -1,25 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/ldb.h,v 1.4 1992/04/12 14:55:34 wlott Exp $ */
-#ifndef _LDB_H_
-#define _LDB_H_
-
-#ifndef NULL
-#define NULL 0
-#endif
-
-#define boolean int
-#define TRUE 1
-#define FALSE 0
-
-#define SymbolValue(sym) \
-    (((struct symbol *)((sym)-type_OtherPointer))->value)
-#define SetSymbolValue(sym,val) \
-    (((struct symbol *)((sym)-type_OtherPointer))->value = (val))
-
-#define funcall(fdefn,argptr,nargs) \
-    call_into_lisp((fdefn),(fdefn)->function,argptr,nargs)
-#define funcall_sym(sym,argptr,nargs) \
-    funcall((struct fdefn *)(SymbolValue(sym)-type_OtherPointer),argptr,nargs)
-
-#define crap_out(msg) do { write(2, msg, sizeof(msg)); exit(-1); } while (0)
-
-#endif _LDB_H_
diff --git a/ldb/lispregs.h b/ldb/lispregs.h
deleted file mode 100644
index 9cd97b565..000000000
--- a/ldb/lispregs.h
+++ /dev/null
@@ -1,17 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/lispregs.h,v 1.8 1991/05/24 17:55:24 wlott Exp $ */
-
-#ifdef mips
-#include "mips-lispregs.h"
-#endif
-
-#ifdef sparc
-#include "sparc-lispregs.h"
-#endif
-
-#ifdef ibmrt
-#include "rt-lispregs.h"
-#endif
-
-#ifndef LANGUAGE_ASSEMBLY
-extern char *lisp_register_names[];
-#endif
diff --git a/ldb/mach-os.c b/ldb/mach-os.c
deleted file mode 100644
index 3817ff0be..000000000
--- a/ldb/mach-os.c
+++ /dev/null
@@ -1,180 +0,0 @@
-/*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/mach-os.c,v 1.5 1992/04/08 03:25:15 wlott Exp $
- *
- * OS-dependent routines.  This file (along with os.h) exports an
- * OS-independent interface to the operating system VM facilities.
- * Suprisingly, this interface looks a lot like the Mach interface
- * (but simpler in some places).  For some operating systems, a subset
- * of these functions will have to be emulated.
- *
- * This is the Mach version.
- *
- */
-
-#include <stdio.h>
-#include <mach.h>
-#include "./signal.h"
-#include "ldb.h"
-#include "os.h"
-
-#define MAX_SEGS 32
-
-static struct segment {
-    vm_address_t start;
-    vm_size_t length;
-} addr_map[MAX_SEGS];
-static int segments = -1;
-
-vm_size_t os_vm_page_size;
-
-void os_init()
-{
-	os_vm_page_size = vm_page_size;
-}
-
-os_vm_address_t os_validate(addr, len)
-vm_address_t addr;
-vm_size_t len;
-{
-    kern_return_t res;
-
-#if defined(EXT_PAGER)
-    res = pager_vm_allocate(task_self(), &addr, len, addr==NULL);
-#else
-    res = vm_allocate(task_self(), &addr, len, addr==NULL);
-#endif
-
-    if (res != KERN_SUCCESS)
-	return 0;
-
-    segments = -1;
-
-    vm_protect(task_self(), addr, len, TRUE,
-	       VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE);
-
-    return addr;
-}
-
-void os_invalidate(addr, len)
-vm_address_t addr;
-vm_size_t len;
-{
-    kern_return_t res;
-
-#if defined(EXT_PAGER)
-    res = pager_vm_deallocate(task_self(), addr, len);
-#else
-    res = vm_deallocate(task_self(), addr, len);
-#endif
-
-    if (res != KERN_SUCCESS)
-        mach_error("Could not vm_allocate memory: ", res);
-
-    segments = -1;
-}
-
-vm_address_t os_map(fd, offset, addr, len)
-int fd, offset;
-vm_address_t addr;
-vm_size_t len;
-{
-    kern_return_t res;
-
-#if defined(EXT_PAGER)
-    res = pager_map_fd(fd, offset, &addr, 0, len);
-#else
-    res = map_fd(fd, offset, &addr, 0, len);
-#endif
-
-    if (res != KERN_SUCCESS)
-        mach_error("Could not map_fd memory: ", res);
-
-    segments = -1;
-
-    vm_protect(task_self(), addr, len, TRUE,
-	       VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE);
-
-    return addr;
-}
-
-void os_flush_icache(address, length)
-vm_address_t address;
-vm_size_t length;
-{
-#ifdef mips
-	vm_machine_attribute_val_t flush;
-	kern_return_t kr;
-
-	flush = MATTR_VAL_ICACHE_FLUSH;
-
-	kr = vm_machine_attribute(task_self(), address, length,
-				  MATTR_CACHE, &flush);
-	if (kr != KERN_SUCCESS)
-		mach_error("Could not flush the instruction cache", kr);
-#endif
-}
-
-void os_protect(address, length, protection)
-vm_address_t address;
-vm_size_t length;
-vm_prot_t protection;
-{
-	vm_protect(task_self(), address, length, FALSE, protection);
-}
-
-
-boolean valid_addr(test)
-vm_address_t test;
-{
-    vm_address_t addr;
-    vm_size_t size;
-    long bullshit;
-    int curseg;
-
-    if (segments == -1) {
-        addr = 0;
-        curseg = 0;
-
-        while (1) {
-            if (vm_region(task_self(), &addr, &size, &bullshit, &bullshit, &bullshit, &bullshit, &bullshit, &bullshit) != KERN_SUCCESS)
-                break;
-
-            if (curseg > 0 && addr_map[curseg-1].start + addr_map[curseg-1].length == addr)
-                addr_map[curseg-1].length += size;
-            else {
-                addr_map[curseg].start = addr;
-                addr_map[curseg].length = size;
-                curseg++;
-            }
-
-            addr += size;
-        }
-
-        segments = curseg;
-    }
-    
-    for (curseg = 0; curseg < segments; curseg++)
-        if (addr_map[curseg].start <= test && test < addr_map[curseg].start + addr_map[curseg].length)
-            return TRUE;
-    return FALSE;
-}
-
-#ifndef ibmrt
-static void sigbus_handler(signal, code, context)
-int signal, code;
-struct sigcontext *context;
-{
-    if(!interrupt_maybe_gc(context))
-	interrupt_handle_now(signal, code, context);
-}
-#endif
-
-void os_install_interrupt_handlers()
-{
-#ifndef ibmrt
-    interrupt_install_low_level_handler(SIGBUS,sigbus_handler);
-#endif
-#ifdef mips
-    interrupt_install_low_level_handler(SIGSEGV,sigbus_handler);
-#endif
-}
diff --git a/ldb/mach-os.h b/ldb/mach-os.h
deleted file mode 100644
index d54ffbd05..000000000
--- a/ldb/mach-os.h
+++ /dev/null
@@ -1,13 +0,0 @@
-#include <mach.h>
-#include "ldb.h"
-
-typedef vm_address_t os_vm_address_t;
-typedef vm_size_t os_vm_size_t;
-typedef vm_offset_t os_vm_offset_t;
-typedef vm_prot_t os_vm_prot_t;
-
-#define OS_VM_PROT_READ VM_PROT_READ
-#define OS_VM_PROT_WRITE VM_PROT_WRITE
-#define OS_VM_PROT_EXECUTE VM_PROT_EXECUTE
-
-#define OS_VM_DEFAULT_PAGESIZE	4096
diff --git a/ldb/mips-arch.c b/ldb/mips-arch.c
deleted file mode 100644
index 8e0761dee..000000000
--- a/ldb/mips-arch.c
+++ /dev/null
@@ -1,144 +0,0 @@
-#include <mips/cpu.h>
-
-#include "ldb.h"
-#include "lisp.h"
-#include "globals.h"
-#include "validate.h"
-#include "os.h"
-#include "arch.h"
-#include "lispregs.h"
-#include "signal.h"
-
-char *arch_init()
-{
-    return NULL;
-}
-
-os_vm_address_t arch_get_bad_addr(context)
-struct sigcontext *context;
-{
-    /* Finding the bad address on the mips is easy. */
-    return (os_vm_address_t)context->sc_badvaddr;
-}
-
-void arch_skip_instruction(context)
-struct sigcontext *context;
-{
-    /* Skip the offending instruction */
-    if (context->sc_cause & CAUSE_BD)
-        emulate_branch(context, *(unsigned long *)context->sc_pc);
-    else
-        context->sc_pc += 4;
-}
-
-static void sigtrap_handler(signal, code, context)
-     int signal, code;
-     struct sigcontext *context;
-{
-    switch (code) {
-      case trap_PendingInterrupt:
-	interrupt_handle_pending(context);
-	break;
-
-      case trap_Halt:
-	crap_out("%primitive halt called; the party is over.\n");
-
-      case trap_Error:
-      case trap_Cerror:
-	interrupt_internal_error(signal, code, context, code==trap_Cerror);
-	break;
-
-      case trap_Breakpoint:
-	sigsetmask(context->sc_mask);
-	fake_foreign_function_call(context);
-	handle_breakpoint(signal, code, context);
-	undo_fake_foreign_function_call(context);
-	break;
-
-      case trap_FunctionEndBreakpoint:
-	sigsetmask(context->sc_mask);
-	fake_foreign_function_call(context);
-	handle_function_end_breakpoint(signal, code, context);
-	undo_fake_foreign_function_call(context);
-	break;
-
-      default:
-	interrupt_handle_now(signal, code, context);
-	break;
-    }
-}
-
-#define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2)
-
-static void sigfpe_handler(signal, code, context)
-int signal, code;
-struct sigcontext *context;
-{
-    unsigned long bad_inst;
-    unsigned int op, rs, rt, rd, funct, dest;
-    int immed;
-    long result;
-
-    if (context->sc_cause & CAUSE_BD)
-        bad_inst = *(unsigned long *)(context->sc_pc + 4);
-    else
-        bad_inst = *(unsigned long *)(context->sc_pc);
-
-    op = (bad_inst >> 26) & 0x3f;
-    rs = (bad_inst >> 21) & 0x1f;
-    rt = (bad_inst >> 16) & 0x1f;
-    rd = (bad_inst >> 11) & 0x1f;
-    funct = bad_inst & 0x3f;
-    immed = (((int)(bad_inst & 0xffff)) << 16) >> 16;
-
-    switch (op) {
-        case 0x0: /* SPECIAL */
-            switch (funct) {
-                case 0x20: /* ADD */
-                    result = FIXNUM_VALUE(context->sc_regs[rs]) + FIXNUM_VALUE(context->sc_regs[rt]);
-                    dest = rd;
-                    break;
-
-                case 0x22: /* SUB */
-                    result = FIXNUM_VALUE(context->sc_regs[rs]) - FIXNUM_VALUE(context->sc_regs[rt]);
-                    dest = rd;
-                    break;
-
-                default:
-                    dest = 32;
-                    break;
-            }
-            break;
-
-        case 0x8: /* ADDI */
-            result = FIXNUM_VALUE(context->sc_regs[rs]) + (immed>>2);
-            dest = rt;
-            break;
-
-        default:
-            dest = 32;
-            break;
-    }
-
-    if (dest < 32) {
-        set_global_pointer(saved_global_pointer);
-        current_dynamic_space_free_pointer =
-            (lispobj *) context->sc_regs[ALLOC];
-
-        context->sc_regs[dest] = alloc_number(result);
-
-	context->sc_regs[ALLOC] =
-	    (unsigned long) current_dynamic_space_free_pointer;
-
-        arch_skip_instruction(context);
-
-    }
-    else
-        interrupt_handle_now(signal, code, context);
-}
-
-void arch_install_interrupt_handlers()
-{
-    interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler);
-    interrupt_install_low_level_handler(SIGFPE,sigfpe_handler);
-}
diff --git a/ldb/mips-assem.s b/ldb/mips-assem.s
deleted file mode 100644
index 510a2326c..000000000
--- a/ldb/mips-assem.s
+++ /dev/null
@@ -1,356 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/mips-assem.s,v 1.14 1992/03/08 18:44:06 wlott Exp $ */
-#include <machine/regdef.h>
-
-#include "lisp.h"
-#include "lispregs.h"
-#include "globals.h"
-
-/*
- * Function to save the global pointer.
- */
-	.text
-	.globl	current_global_pointer
-	.ent	current_global_pointer
-current_global_pointer:
-	move	v0, gp
-	j	ra
-	.end	current_global_pointer
-
-/*
- * And a function to restore the global pointer.
- */
-	.text
-	.globl	set_global_pointer
-	.ent	set_global_pointer
-set_global_pointer:
-	move	gp, a0
-	j	ra
-	.end	set_global_pointer
-
-#if !defined(s8)
-#define s8 $30
-#endif
-
-/*
- * Function to transfer control into lisp.
- */
-	.text
-	.globl	call_into_lisp
-	.ent	call_into_lisp
-call_into_lisp:
-#define framesize 12*4
-	subu	sp, framesize
-	.frame	sp, framesize, ra
-	/* Save all the C regs. */
-	.mask	0xd0ff0000, 0
-	sw	ra, framesize(sp)
-	sw	s8, framesize-4(sp)
-	sw	gp, framesize-8(sp)
-	sw	s7, framesize-12(sp)
-	sw	s6, framesize-16(sp)
-	sw	s5, framesize-20(sp)
-	sw	s4, framesize-24(sp)
-	sw	s3, framesize-28(sp)
-	sw	s2, framesize-32(sp)
-	sw	s1, framesize-36(sp)
-	sw	s0, framesize-40(sp)
-
-	/* Clear descriptor regs */
-	move	t0, zero
-	move	t1, zero
-	move	t2, zero
-	move	t3, zero
-	move	t4, zero
-	move	t5, zero
-	move	t6, zero
-	move	t7, zero
-	move	s0, zero
-	move	s1, zero
-	move	s2, zero
-	move	s3, zero
-	move	gp, zero
-	move	ra, zero
-
-	.set	noreorder
-
-	/* The saved FLAGS has the pseudo-atomic bit set. */
-	li	NULLREG, NIL
-	lw	FLAGS, current_flags_register
-
-	/* No longer in foreign call. */
-	sw	zero, foreign_function_call_active
-
-        .set    reorder
-
-	/* Load the rest of the LISP state. */
-	lw	ALLOC, current_dynamic_space_free_pointer
-	lw	BSP, current_binding_stack_pointer
-	lw	CSP, current_control_stack_pointer
-	lw	OCFP, current_control_frame_pointer
-
-        .set    noreorder
-
-	/* Check for interrupt */
-	and	FLAGS, (0xffff^(1<<flag_Atomic))
-	and	v0, FLAGS, (1<<flag_Interrupted)
-	beq	v0, zero, 1f
-	nop
-
-	/* We were interrupted. Hit the trap. */
-	break	trap_PendingInterrupt
-1:
-
-	.set	reorder
-
-	/* Pass in args */
-	move	CNAME, $4
-	move	LEXENV, $5
-	move	CFP, $6
-	sll	NARGS, $7, 2
-	lw	A0, 0(CFP)
-	lw	A1, 4(CFP)
-	lw	A2, 8(CFP)
-	lw	A3, 12(CFP)
-	lw	A4, 16(CFP)
-	lw	A5, 20(CFP)
-
-	/* Calculate LRA */
-	la	LRA, lra + type_OtherPointer
-
-	/* Indirect closure */
-	lw	CODE, 4-1(LEXENV)
-
-	/* Jump into lisp land. */
-	addu	LIP, CODE, 6*4 - type_FunctionPointer
-	j	LIP
-
-	.set	noreorder
-
-	.align	3
-lra:
-	.word	type_ReturnPcHeader
-
-	/* Multiple value return spot, clear stack */
-	move	CSP, OCFP
-	nop
-
-	/* Pass one return value back to C land. */
-	move	v0, A0
-
-	/* Set pseudo-atomic flag. */
-	or	FLAGS, (1<<flag_Atomic)
-
-	/* Save LISP registers. */
-	sw	ALLOC, current_dynamic_space_free_pointer
-	sw	BSP, current_binding_stack_pointer
-	sw	CSP, current_control_stack_pointer
-	sw	CFP, current_control_frame_pointer
-	sw	FLAGS, current_flags_register
-
-	/* Back in foreign function call */
-	li	t0, 1
-	sw	t0, foreign_function_call_active
-
-	/* Check for interrupt */
-	and	FLAGS, (0xffff^(1<<flag_Atomic))
-	and	v1, FLAGS, (1<<flag_Interrupted)
-	beq	v1, zero, 1f
-	nop
-
-	/* We were interrupted. Hit the trap. */
-	break	trap_PendingInterrupt
-1:
-
-	.set	reorder
-
-	/* Restore C regs */
-	lw	ra, framesize(sp)
-	lw	s8, framesize-4(sp)
-	lw	gp, framesize-8(sp)
-	lw	s7, framesize-12(sp)
-	lw	s6, framesize-16(sp)
-	lw	s5, framesize-20(sp)
-	lw	s4, framesize-24(sp)
-	lw	s3, framesize-28(sp)
-	lw	s2, framesize-32(sp)
-	lw	s1, framesize-36(sp)
-	lw	s0, framesize-40(sp)
-
-	/* Restore C stack. */
-	addu	sp, framesize
-
-	/* Back we go. */
-	j	ra
-
-	.end	call_into_lisp
-
-/*
- * Transfering control from Lisp into C
- */
-	.text
-	.globl	call_into_c
-	.ent	call_into_c
-call_into_c:
-	/* Set up a stack frame. */
-	move	OCFP, CFP
-	move	CFP, CSP
-	addu	CSP, CFP, 32
-	sw	OCFP, 0(CFP)
-	sw	LRA, 4(CFP)
-	sw	CODE, 8(CFP)
-
-	/* Note: the C stack is already set up. */
-
-	/* Set the pseudo-atomic flag. */
-	.set	noreorder
-	or	FLAGS, (1<<flag_Atomic)
-
-	/* Save lisp state. */
-	sw	ALLOC, current_dynamic_space_free_pointer
-	sw	BSP, current_binding_stack_pointer
-	sw	CSP, current_control_stack_pointer
-	sw	CFP, current_control_frame_pointer
-	sw	FLAGS, current_flags_register
-
-	/* Mark us as in C land. */
-	li	t0, 1
-	sw	t0, foreign_function_call_active
-
-	/* Restore GP */
-	lw	gp, saved_global_pointer
-
-	/* Were we interrupted? */
-	and	FLAGS, (0xffff^(1<<flag_Atomic))
-	and	t0, FLAGS, (1<<flag_Interrupted)
-	beq	t0, zero, 1f
-	nop
-
-	/* We were interrupted. Hit the trap. */
-	break	trap_PendingInterrupt
-1:
-
-	.set	reorder
-
-	/* Into C land we go. */
-	jal	v0
-
-	/* Clear unsaved descriptor regs */
-	move	t0, zero
-	move	t1, zero
-	move	t2, zero
-	move	t3, zero
-	move	t4, zero
-	move	t5, zero
-	move	t6, zero
-	move	t7, zero
-	move	gp, zero
-	move	ra, zero
-
-	.set	noreorder
-
-	/* Restore FLAGS (which set the pseudo-atomic flag) */
-	lw	FLAGS, current_flags_register
-
-	/* Mark us at in Lisp land. */
-	sw	zero, foreign_function_call_active
-
-	/* Restore other lisp state. */
-	lw	ALLOC, current_dynamic_space_free_pointer
-	lw	BSP, current_binding_stack_pointer
-
-	/* Check for interrupt */
-	and	FLAGS, (0xffff^(1<<flag_Atomic))
-	and	a0, FLAGS, (1<<flag_Interrupted)
-	beq	a0, zero, 1f
-	nop
-
-	/* We were interrupted. Hit the trap. */
-	break	trap_PendingInterrupt
-1:
-
-	.set	reorder
-
-	/* Restore LRA & CODE (they may have been GC'ed) */
-	lw	CODE, 8(CFP)
-	lw	LRA, 4(CFP)
-
-	/* Reset the lisp stack. */
-	/* Note: OCFP and CFP are in saved regs. */
-	move	CSP, CFP
-	move	CFP, OCFP
-
-	/* Return to LISP. */
-	addu	LIP, LRA, 4-type_OtherPointer
-	j	LIP
-
-	.end	call_into_c
-
-	.text
-	.globl	start_of_tramps
-start_of_tramps:
-
-/*
- * The undefined-function trampoline.
- */
-        .text
-        .globl  undefined_tramp
-        .ent    undefined_tramp
-undefined_tramp:
-        break   10
-        .byte    4
-        .byte    23
-        .byte    254
-        .byte    208
-        .byte    1
-        .align 2
-        .end    undefined_tramp
-
-/*
- * The closure trampoline.
- */
-        .text
-        .globl  closure_tramp
-        .ent    closure_tramp
-closure_tramp:
-        lw      LEXENV, FDEFN_FUNCTION_OFFSET(CNAME)
-        lw      L0, CLOSURE_FUNCTION_OFFSET(LEXENV)
-        add     LIP, L0, FUNCTION_HEADER_CODE_OFFSET
-        j       LIP
-        .end    closure_tramp
-
-	.text
-	.globl	end_of_tramps
-end_of_tramps:
-
-
-/*
- * Function-end breakpoint magic.
- */
-
-	.text
-	.align	2
-	.set	noreorder
-	.globl	function_end_breakpoint_guts
-function_end_breakpoint_guts:
-	.word	type_ReturnPcHeader
-	beq	zero, zero, 1f
-	nop
-	move	OCFP, CSP
-	addu	CSP, 4
-	li	NARGS, 4
-	move	A1, NULLREG
-	move	A2, NULLREG
-	move	A3, NULLREG
-	move	A4, NULLREG
-	move	A5, NULLREG
-1:
-
-	.globl	function_end_breakpoint_trap
-function_end_breakpoint_trap:
-	break	trap_FunctionEndBreakpoint
-	beq	zero, zero, 1b
-	nop
-
-	.globl	function_end_breakpoint_end
-function_end_breakpoint_end:
-	.set	reorder
diff --git a/ldb/mips-lispregs.h b/ldb/mips-lispregs.h
deleted file mode 100644
index 613ce2a0f..000000000
--- a/ldb/mips-lispregs.h
+++ /dev/null
@@ -1,50 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/mips-lispregs.h,v 1.1 1991/05/24 18:46:15 wlott Exp $ */
-
-#ifdef LANGUAGE_ASSEMBLY
-#define REG(num) $num
-#else
-#define REG(num) num
-#endif
-
-#define NREGS	(32)
-
-#define ZERO    REG(0)
-#define NL3     REG(1)
-#define NL4     REG(2)
-#define FLAGS   REG(3)
-#define NL0     REG(4)
-#define NL1     REG(5)
-#define NL2     REG(6)
-#define NARGS   REG(7)
-#define A0      REG(8)
-#define A1      REG(9)
-#define A2      REG(10)
-#define A3      REG(11)
-#define A4      REG(12)
-#define A5      REG(13)
-#define CNAME   REG(14)
-#define LEXENV  REG(15)
-#define NFP     REG(16)
-#define OCFP    REG(17)
-#define LRA     REG(18)
-#define L0      REG(19)
-#define NULLREG REG(20)
-#define BSP     REG(21)
-#define CFP     REG(22)
-#define CSP     REG(23)
-#define L1      REG(24)
-#define ALLOC   REG(25)
-#define L2      REG(28)
-#define NSP     REG(29)
-#define CODE    REG(30)
-#define LIP     REG(31)
-
-#define REGNAMES \
-	"ZERO",		"NL3",		"NL4",		"FLAGS", \
-	"NL0",		"NL1",		"NL2",		"NARGS", \
-	"A0",		"A1",		"A2",		"A3", \
-	"A4",		"A5",		"CNAME",       	"LEXENV", \
-	"NFP",		"OCFP",		"LRA",		"L0", \
-	"NULL",		"BSP",		"CFP",		"CSP", \
-	"L1",		"ALLOC",	"K0",		"K1", \
-	"L2",		"NSP",		"CODE",		"LIP"
diff --git a/ldb/monitor.c b/ldb/monitor.c
deleted file mode 100644
index c107b2f54..000000000
--- a/ldb/monitor.c
+++ /dev/null
@@ -1,494 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/monitor.c,v 1.17 1992/03/08 18:42:41 wlott Exp $ */
-
-#include <stdio.h>
-#include <setjmp.h>
-#include <sys/time.h>
-#include <sys/resource.h>
-#include <signal.h>
-#include "ldb.h"
-#include "lisp.h"
-#include "globals.h"
-#include "vars.h"
-#include "parse.h"
-#include "interrupt.h"
-#include "lispregs.h"
-
-static void call_cmd(), dump_cmd(), print_cmd(), quit(), help();
-static void flush_cmd(), search_cmd(), regs_cmd(), exit_cmd();
-static void timed_call_cmd(), gc_cmd(), print_context_cmd();
-static void backtrace_cmd(), purify_cmd(), catchers_cmd(), save_cmd();
-static void grab_sigs_cmd(), restore_cmd();
-
-static struct cmd {
-    char *cmd, *help;
-    void (*fn)();
-} Cmds[] = {
-    {"help", "Display this info", help},
-    {"?", NULL, help},
-    {"backtrace", "backtrace up to N frames", backtrace_cmd},
-    {"call", "call FUNCTION with ARG1, ARG2, ...", call_cmd},
-    {"catchers", "Print a list of all the active catchers.", catchers_cmd},
-    {"context", "print interrupt context number I.", print_context_cmd},
-    {"dump", "dump memory starting at ADDRESS for COUNT words.", dump_cmd},
-    {"d", NULL, dump_cmd},
-    {"exit", "Exit this instance of the monitor.", exit_cmd},
-    {"flush", "flush all temp variables.", flush_cmd},
-    {"gc", "collect garbage (caveat collector).", gc_cmd},
-    {"grab-signals", "Set the signal handlers to call LDB.", grab_sigs_cmd},
-    {"purify", "purify (caveat purifier).", purify_cmd},
-    {"print", "print object at ADDRESS.", print_cmd},
-    {"p", NULL, print_cmd},
-    {"quit", "quit.", quit},
-    {"regs", "display current lisp regs.", regs_cmd},
-    {"restore", "restore the saved lisp image.", restore_cmd},
-    {"save", "save the current lisp image.", save_cmd},
-    {"search", "search for TYPE starting at ADDRESS for a max of COUNT words.", search_cmd},
-    {"s", NULL, search_cmd},
-    {"time", "call FUNCTION with ARG1, ARG2, ... and time it.", timed_call_cmd},
-    {NULL, NULL, NULL}
-};
-
-
-static jmp_buf curbuf;
-
-
-static int visable(c)
-unsigned char c;
-{
-    if (c < ' ' || c > '~')
-        return ' ';
-    else
-        return c;
-}
-
-static void dump_cmd(ptr)
-char **ptr;
-{
-    static char *lastaddr = 0;
-    static int lastcount = 20;
-
-    char *addr = lastaddr;
-    int count = lastcount, displacement;
-
-    if (more_p(ptr)) {
-        addr = parse_addr(ptr);
-
-        if (more_p(ptr))
-            count = parse_number(ptr);
-    }
-
-    if (count == 0) {
-        printf("COUNT must be non-zero.\n");
-        return;
-    }
-        
-    lastcount = count;
-
-    if (count > 0)
-        displacement = 4;
-    else {
-        displacement = -4;
-        count = -count;
-    }
-
-    while (count-- > 0) {
-        printf("0x%08x: ", addr);
-        if (valid_addr(addr)) {
-            unsigned long *lptr = (unsigned long *)addr;
-            unsigned short *sptr = (unsigned short *)addr;
-            unsigned char *cptr = (unsigned char *)addr;
-
-            printf("0x%08x   0x%04x 0x%04x   0x%02x 0x%02x 0x%02x 0x%02x    %c%c%c%c\n", lptr[0], sptr[0], sptr[1], cptr[0], cptr[1], cptr[2], cptr[3], visable(cptr[0]), visable(cptr[1]), visable(cptr[2]), visable(cptr[3]));
-        }
-        else
-            printf("invalid address\n");
-
-        addr += displacement;
-    }
-
-    lastaddr = addr;
-}
-
-static void print_cmd(ptr)
-char **ptr;
-{
-    lispobj obj = parse_lispobj(ptr);
-    
-    print(obj);
-}
-
-static void regs_cmd(ptr)
-char **ptr;
-{
-    printf("CSP\t=\t0x%08x\n", current_control_stack_pointer);
-    printf("FP\t=\t0x%08x\n", current_control_frame_pointer);
-#ifndef ibmrt
-    printf("BSP\t=\t0x%08x\n", current_binding_stack_pointer);
-#endif
-
-    printf("DYNAMIC\t=\t0x%08x\n", current_dynamic_space);
-#ifdef ibmrt
-    printf("ALLOC\t=\t0x08x\n", SymbolValue(ALLOCATION_POINTER));
-    printf("TRIGGER\t=\t0x08x\n", SymbolValue(INTERNAL_GC_TRIGGER));
-#else
-    printf("ALLOC\t=\t0x%08x\n", current_dynamic_space_free_pointer);
-    printf("TRIGGER\t=\t0x%08x\n", current_auto_gc_trigger);
-#endif
-    printf("STATIC\t=\t0x%08x\n", SymbolValue(STATIC_SPACE_FREE_POINTER));
-    printf("RDONLY\t=\t0x%08x\n", SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
-
-#ifdef MIPS
-    printf("FLAGS\t=\t0x%08x\n", current_flags_register);
-#endif
-}
-
-static void search_cmd(ptr)
-char **ptr;
-{
-    static int lastval = 0, lastcount = 0;
-    static lispobj *start = 0, *end = 0;
-    int val, count;
-    lispobj *addr, obj;
-
-    if (more_p(ptr)) {
-        val = parse_number(ptr);
-        if (val < 0 || val > 0xff) {
-            printf("Can only search for single bytes.\n");
-            return;
-        }
-        if (more_p(ptr)) {
-            addr = (lispobj *)PTR((long)parse_addr(ptr));
-            if (more_p(ptr)) {
-                count = parse_number(ptr);
-            }
-            else {
-                /* Speced value and address, but no count. Only one. */
-                count = -1;
-            }
-        }
-        else {
-            /* Speced a value, but no address, so search same range. */
-            addr = start;
-            count = lastcount;
-        }
-    }
-    else {
-        /* Speced nothing, search again for val. */
-        val = lastval;
-        addr = end;
-        count = lastcount;
-    }
-
-    lastval = val;
-    start = end = addr;
-    lastcount = count;
-
-    printf("searching for 0x%x at 0x%x\n", val, end);
-
-    while (search_for_type(val, &end, &count)) {
-        printf("found 0x%x at 0x%x:\n", val, end);
-        obj = *end;
-        addr = end;
-        end += 2;
-        if (TypeOf(obj) == type_FunctionHeader)
-            print((long)addr | type_FunctionPointer);
-        else if (LowtagOf(obj) == type_OtherImmediate0 || LowtagOf(obj) == type_OtherImmediate1)
-            print((long)addr | type_OtherPointer);
-        else
-            print(addr);
-        if (count == -1)
-            return;
-    }
-}
-
-static void call_cmd(ptr)
-char **ptr;
-{
-    extern lispobj call_into_lisp();
-
-    lispobj function = parse_lispobj(ptr);
-    lispobj result, *args;
-    int numargs;
-
-    if (LowtagOf(function) != type_FunctionPointer) {
-        printf("0x%x is not a function pointer.\n", function);
-        return;
-    }
-
-    numargs = 0;
-    args = current_control_stack_pointer;
-    while (more_p(ptr)) {
-        current_control_stack_pointer++;
-        current_control_stack_pointer[-1] = parse_lispobj(ptr);
-        numargs++;
-    }
-
-    result = call_into_lisp(function, function, args, numargs);
-
-    print(result);
-}
-
-static double tv_diff(x, y)
-struct timeval *x, *y;
-{
-    return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
-	    ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
-}
-
-static void timed_call_cmd(ptr)
-char **ptr;
-{
-    extern lispobj call_into_lisp();
-
-    lispobj args[16];
-
-    lispobj function = parse_lispobj(ptr);
-    lispobj result, *argptr;
-    int numargs;
-    struct timeval start_tv, stop_tv;
-    struct rusage start_rusage, stop_rusage;
-    double real_time, system_time, user_time;
-
-    if (LowtagOf(function) != type_FunctionPointer) {
-        printf("0x%x is not a function pointer.\n", function);
-        return;
-    }
-
-    numargs = 0;
-    argptr = args;
-    while (more_p(ptr)) {
-        *argptr++ = parse_lispobj(ptr);
-        numargs++;
-    }
-    while (argptr < args + 6)
-        *argptr++ = NIL;
-
-    getrusage(RUSAGE_SELF, &start_rusage);
-    gettimeofday(&start_tv, (struct timezone *) 0);
-    result = call_into_lisp(function, function, args, numargs);
-    gettimeofday(&stop_tv, (struct timezone *) 0);
-    getrusage(RUSAGE_SELF, &stop_rusage);
-
-    print(result);
-
-    real_time = tv_diff(&stop_tv, &start_tv) * 1000.0;
-    user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime) *
-	    1000.0;
-    system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime) *
-	    1000.0;
-
-    printf("Call took:\n");
-    printf("%20.8f msec of real time\n", real_time);
-    printf("%20.8f msec of user time,\n", user_time);
-    printf("%20.8f msec of system time.\n", system_time);
-}
-
-static void flush_cmd()
-{
-    flush_vars();
-}
-
-static void quit()
-{
-    char buf[10];
-
-    printf("Really quit? [y] ");
-    fflush(stdout);
-    fgets(buf, sizeof(buf), stdin);
-    if (buf[0] == 'y' || buf[0] == 'Y' || buf[0] == '\n')
-        exit(0);
-}
-
-static void help()
-{
-    struct cmd *cmd;
-
-    for (cmd = Cmds; cmd->cmd != NULL; cmd++)
-        if (cmd->help != NULL)
-            printf("%s\t%s\n", cmd->cmd, cmd->help);
-}
-
-static int done;
-
-static void exit_cmd()
-{
-    done = TRUE;
-}
-
-static void gc_cmd()
-{
-	collect_garbage();
-}
-
-static void purify_cmd()
-{
-	purify(NIL);
-}
-
-static void print_context(context)
-struct sigcontext *context;
-{
-	int i;
-
-	for (i = 0; i < NREGS; i++) {
-		printf("%s:\t", lisp_register_names[i]);
-		brief_print((lispobj) context->sc_regs[i]);
-	}
-	printf("PC:\t\t  0x%08x\n", context->sc_pc);
-}
-
-static void print_context_cmd(ptr)
-char **ptr;
-{
-	int free;
-
-	free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
-	
-        if (more_p(ptr)) {
-		int index;
-
-		index = parse_number(ptr);
-
-		if ((index >= 0) && (index < free)) {
-			printf("There are %d interrupt contexts.\n", free);
-			printf("Printing context %d\n", index);
-			print_context(lisp_interrupt_contexts[index]);
-		} else {
-			printf("There aren't that many/few contexts.\n");
-			printf("There are %d interrupt contexts.\n", free);
-		}
-	} else {
-		if (free == 0)
-			printf("There are no interrupt contexts!\n");
-		else {
-			printf("There are %d interrupt contexts.\n", free);
-			printf("Printing context %d\n", free - 1);
-			print_context(lisp_interrupt_contexts[free - 1]);
-		}
-	}
-}
-
-static void backtrace_cmd(ptr)
-char **ptr;
-{
-	void backtrace();
-	int n;
-
-        if (more_p(ptr))
-		n = parse_number(ptr);
-	else
-		n = 100;
-	
-	printf("Backtrace:\n");
-	backtrace(n);
-}
-
-static void catchers_cmd()
-{
-    struct catch_block *catch;
-
-    catch = (struct catch_block *)SymbolValue(CURRENT_CATCH_BLOCK);
-
-    if (catch == NULL)
-        printf("There are no active catchers!\n");
-    else {
-        while (catch != NULL) {
-            printf("0x%08x:\n\tuwp: 0x%08x\n\tfp: 0x%08x\n\tcode: 0x%08x\n\tentry: 0x%08x\n\ttag: ", catch, catch->current_uwp, catch->current_cont, catch->current_code, catch->entry_pc);
-            brief_print((lispobj)catch->tag);
-            catch = catch->previous_catch;
-        }
-    }
-}
-
-static void save_cmd(ptr)
-char **ptr;
-{
-    if (more_p(ptr))
-        save(*ptr);
-    else
-        save("lisp.core");
-}
-
-static void restore_cmd(ptr)
-     char **ptr;
-{
-    restore();
-}
-
-static void grab_sigs_cmd()
-{
-    printf("Grabbing signals.\n");
-    test_init();
-}
-
-static void sub_monitor()
-{
-    extern char *egets();
-    struct cmd *cmd, *found;
-    char *line, *ptr, *token;
-    int ambig;
-
-    while (!done) {
-        printf("ldb> ");
-        fflush(stdout);
-        line = egets();
-        if (line == NULL) {
-	    if (isatty(0)) {
-		putchar('\n');
-	        continue;
-	    }
-	    else {
-		fprintf(stderr, "\nEOF on something other than a tty.\n");
-		exit(0);
-	    }
-	}
-        ptr = line;
-        if ((token = parse_token(&ptr)) == NULL)
-            continue;
-        ambig = 0;
-        found = NULL;
-        for (cmd = Cmds; cmd->cmd != NULL; cmd++) {
-            if (strcmp(token, cmd->cmd) == 0) {
-                found = cmd;
-                ambig = 0;
-                break;
-            }
-            else if (strncmp(token, cmd->cmd, strlen(token)) == 0) {
-                if (found)
-                    ambig = 1;
-                else
-                    found = cmd;
-            }
-        }
-        if (ambig)
-            printf("``%s'' is ambiguous.\n", token);
-        else if (found == NULL)
-            printf("unknown command: ``%s''\n", token);
-        else {
-            reset_printer();
-            (*found->fn)(&ptr);
-        }
-    }
-}
-
-void ldb_monitor()
-{
-    jmp_buf oldbuf;
-
-    bcopy(curbuf, oldbuf, sizeof(oldbuf));
-
-    printf("LDB monitor\n");
-
-    setjmp(curbuf);
-
-    sub_monitor();
-
-    done = FALSE;
-
-    bcopy(oldbuf, curbuf, sizeof(curbuf));
-}
-
-void throw_to_monitor()
-{
-    longjmp(curbuf, 1);
-}
diff --git a/ldb/os-common.c b/ldb/os-common.c
deleted file mode 100644
index f3c27532b..000000000
--- a/ldb/os-common.c
+++ /dev/null
@@ -1,95 +0,0 @@
-#include <stdio.h>
-
-#include "ldb.h"
-#include "os.h"
-
-void os_zero(addr, length)
-os_vm_address_t addr;
-os_vm_size_t length;
-{
-    os_vm_address_t block_start;
-    os_vm_size_t block_size;
-
-#ifdef DEBUG
-    fprintf(stderr,";;; os_zero: addr: 0x%08x, len: 0x%08x\n",addr,length);
-#endif
-
-    block_start=os_round_up_to_page(addr);
-
-    length-=block_start-addr;
-    block_size=os_trunc_size_to_page(length);
-
-    if(block_start>addr)
-	bzero((char *)addr,block_start-addr);
-    if(block_size<length)
-	bzero((char *)block_start+block_size,length-block_size);
-    
-    if (block_size != 0) {
-	/* Now deallocate and allocate the block so that it */
-	/* faults in  zero-filled. */
-
-	os_invalidate(block_start,block_size);
-	addr=os_validate(block_start,block_size);
-
-	if(addr==NULL || addr!=block_start)
-	    fprintf(stderr,"os_zero: block moved, 0x%08x ==> 0x%08x!\n",block_start,addr);
-    }
-}
-
-os_vm_address_t os_allocate(len)
-os_vm_size_t len;
-{
-    return os_validate((os_vm_address_t)NULL,len);
-}
-
-os_vm_address_t os_allocate_at(addr,len)
-os_vm_address_t addr;
-os_vm_size_t len;
-{
-    return os_validate(addr, len);
-}
-
-void os_deallocate(addr,len)
-os_vm_address_t addr;
-os_vm_size_t len;
-{
-    os_invalidate(addr,len);
-}
-
-os_vm_address_t os_reallocate(addr,old_len,len)
-os_vm_address_t addr;
-os_vm_size_t old_len, len;
-{
-    addr=os_trunc_to_page(addr);
-    len=os_round_up_size_to_page(len);
-    old_len=os_round_up_size_to_page(old_len);
-
-    if(addr==NULL)
-	return os_allocate(len);
-    else{
-	long len_diff=len-old_len;
-
-	if(len_diff<0)
-	    os_invalidate(addr+len,-len_diff);
-	else if(len_diff!=0){
-	    os_vm_address_t new=os_validate(addr+old_len,len_diff);
-
-	    if(new==NULL || new!=addr+old_len){
-		if(new!=NULL)
-		    /* allocated alright, but in the wrong place */
-		    os_invalidate(new,len_diff);
-
-		new=os_allocate(len);
-		
-		if(new!=NULL){
-		    bcopy(addr,new,old_len);
-		    os_invalidate(addr,old_len);
-		}
-		
-		addr=new;
-	    }
-	}
-	
-	return addr;
-    }
-}
diff --git a/ldb/os.h b/ldb/os.h
deleted file mode 100644
index f8e13413d..000000000
--- a/ldb/os.h
+++ /dev/null
@@ -1,47 +0,0 @@
-/*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/os.h,v 1.2 1991/05/24 17:57:40 wlott Exp $
- *
- * Common interface for os-dependent functions.
- *
- */
-
-#if !defined(_OS_H_INCLUDED_)
-
-#define _OS_H_INCLUDED_
-
-#ifdef MACH
-#include "mach-os.h"
-#else
-#ifdef sun
-#include "sunos-os.h"
-#endif
-#endif
-
-#define OS_VM_PROT_ALL (OS_VM_PROT_READ|OS_VM_PROT_WRITE|OS_VM_PROT_EXECUTE)
-
-extern os_vm_size_t os_vm_page_size;
-
-extern void os_install_interrupt_handlers();
-
-extern os_vm_address_t os_allocate(), os_reallocate();
-void os_deallocate();
-
-extern os_vm_address_t os_validate();
-extern void os_invalidate();
-extern void os_zero();
-extern os_vm_address_t os_map();
-extern void os_flush_icache();
-extern void os_protect();
-extern boolean valid_addr();
-
-#define os_trunc_to_page(addr) \
-    (os_vm_address_t)((long)addr&~(os_vm_page_size-1))
-#define os_round_up_to_page(addr) \
-    os_trunc_to_page(addr+(os_vm_page_size-1))
-
-#define os_trunc_size_to_page(size) \
-    (os_vm_size_t)((long)size&~(os_vm_page_size-1))
-#define os_round_up_size_to_page(size) \
-    os_trunc_size_to_page(size+(os_vm_page_size-1))
-
-#endif
diff --git a/ldb/pager.c b/ldb/pager.c
deleted file mode 100644
index 8baa95e7b..000000000
--- a/ldb/pager.c
+++ /dev/null
@@ -1,587 +0,0 @@
-/*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/pager.c,v 1.2 1991/02/19 12:27:41 ch Exp $
- * 
- * Mach Memory Manager for GC Support
- *
- * Written by Christopher Hoover
- */
-
-#include <stdio.h>
-#include <mach.h>
-#include <mach/message.h>
-#include <mach/mig_errors.h>
-#include <cthreads.h>
-#include "pager.h"
-
-static port_t pager_port;
-static port_set_name_t pager_port_set;
-
-
-/* Marking */
-
-#define PAGE_SIZE (4096)	/* ### Ack!  I want a constant here. */
-#define PAGE_SIZE_L2 (12)	/* log_{2} PAGE_SIZE  */
-
-#define OFFSET_TO_PAGE(offset) ((offset)>>PAGE_SIZE_L2)
-
-#define BITS_PER_BYTE (8)
-#define PAGES_PER_INDEX (sizeof(unsigned long) * BITS_PER_BYTE)
-
-#define PAGE_INDEX(page) ((page) / PAGES_PER_INDEX)
-#define PAGE_BIT(page) ((page) % PAGES_PER_INDEX)
-
-#define MARK(marked_pages,offset)					\
-	{ 								\
-		int page; 						\
-									\
-		page = OFFSET_TO_PAGE(offset); 				\
-	  	marked_pages[PAGE_INDEX(page)] |= (1<<PAGE_BIT(page));	\
-	}
-
-
-/* Pager Object Registry */
-
-static pager_object_t *pager_objects = NULL_PAGER_OBJECT;
-static mutex_t pager_objects_mutex;
-
-static pager_object_t *
-allocate_pager_object()
-{
-	pager_object_t *object;
-
-	object = (pager_object_t *) malloc(sizeof(pager_object_t));
-	
-	if (object == NULL_PAGER_OBJECT)
-		return NULL_PAGER_OBJECT;
-
-	mutex_lock(pager_objects_mutex);
-
-        object->next = pager_objects;
-	object->prev = NULL_PAGER_OBJECT;
-	
-	if (pager_objects != NULL_PAGER_OBJECT)
-		pager_objects->prev = object;
-
-	pager_objects = object;
-
-	mutex_unlock(pager_objects_mutex);
-
-	return object;
-}
-
-static void
-deallocate_pager_object(object)
-pager_object_t *object;
-{
-	mutex_lock(pager_objects_mutex);
-
-	if (object->prev == NULL_PAGER_OBJECT) {
-		/* Deleting item at head of list */
-		pager_objects = object->next;
-		if (pager_objects != NULL_PAGER_OBJECT)
-			pager_objects->prev = NULL_PAGER_OBJECT;
-	} else {
-		pager_object_t *prev;
-		pager_object_t *next;
-
-		prev = object->prev;
-		next = object->next;
-
-		prev->next = next;
-		if (next != NULL_PAGER_OBJECT)
-			next->prev = prev;
-	}
-
-	mutex_unlock(pager_objects_mutex);
-
-	(void) free((char *) object);
-}
-
-static pager_object_t *
-find_pager_object(memory_object)
-memory_object_t memory_object;
-{
-	pager_object_t *p;
-
-	mutex_lock(pager_objects_mutex);
-
-	for (p = pager_objects; p != NULL_PAGER_OBJECT; p = p->next)
-		if (p->object == memory_object)
-			break;
-
-	mutex_unlock(pager_objects_mutex);
-
-	return p;
-}
-
-
-/* Memory Object Allocation */
-
-static kern_return_t
-pager_allocate_memory_object(memory_object, address, size)
-memory_object_t *memory_object;
-vm_address_t address;
-vm_size_t size;
-{
-	kern_return_t kr;
-	pager_object_t *p;
-	port_t port;
-	memory_object_t object;
-
-	pagerlog("pager_allocate_memory_object(memory_object, size = 0x%08x)\n",
-	       size);
-
-	if (size != round_page(size)) {
-		kr = KERN_INVALID_ARGUMENT;
-		goto e0;
-	}
-
-
-	p = allocate_pager_object();
-	if (p == NULL_PAGER_OBJECT) {
-		kr = KERN_RESOURCE_SHORTAGE;
-		goto e0;
-	}
-
-	kr = port_allocate(task_self(), &port);
-	if (kr != KERN_SUCCESS)
-		goto e1;
-
-	object = (memory_object_t) port;
-
-	kr = port_set_add(task_self(), pager_port_set, port);
-	if (kr != KERN_SUCCESS)
-		goto e2;
-
-	p->object = object;
-	p->control = (memory_object_control_t) PORT_NULL;
-	p->name = (memory_object_name_t) PORT_NULL;
-	p->size = size;
-	p->backing_store = address;
-
-	*memory_object = object;
-
-	pagerlog("Allocated memory object %d.  Backing store: addr = 0x%08x, length = 0x%08x\n",
-	       port, address, size);
-
-	return KERN_SUCCESS;
-
- e2:
-	(void) port_deallocate(port);
- e1:
-	deallocate_pager_object(p);
- e0:
-	return kr;
-}
-
-static kern_return_t
-pager_deallocate_memory_object(memory_object)
-memory_object_t memory_object;
-{
-	pager_object_t *object;
-	kern_return_t kr0, kr1, kr2, kr3;
-
-	pagerlog("pager_deallocate_memory_object(memory_object = %d)\n",
-	       memory_object);
-
-	/* Find the pager object associated with this memory object. */
-	object = find_pager_object(memory_object);
-	if (object == NULL_PAGER_OBJECT)
-		return KERN_INVALID_ARGUMENT;
-	
-	/* Roll through these ignoring errors until later. */
-	kr0 = port_deallocate(task_self(), (port_t) object->object);
-	kr1 = port_deallocate(task_self(), (port_t) object->control);
-	kr2 = port_deallocate(task_self(), (port_t) object->name);
-	kr3 = vm_deallocate(task_self(), object->backing_store,
-			    object->size);
-
-	deallocate_pager_object(object);
-	
-	if (kr0 != KERN_SUCCESS)
-		return kr0;
-	else if (kr1 != KERN_SUCCESS)
-		return kr1;
-	else if (kr2 != KERN_SUCCESS)
-		return kr2;
-	else if (kr3 != KERN_SUCCESS)
-		return kr3;
-	else
-		return KERN_SUCCESS;
-
-}	
-
-
-/* Calls from the kernel */
-
-kern_return_t
-memory_object_init(memory_object, memory_control, memory_object_name,
-		   memory_object_page_size)
-memory_object_t memory_object;
-memory_object_control_t memory_control;
-memory_object_name_t memory_object_name;
-vm_size_t memory_object_page_size;
-{
-	kern_return_t;
-	pager_object_t *object;
-
-	pagerlog("memory_object_init(memory_object = %d, memory_control = %d, memory_object_name = %d, memory_object_pager_size = 0x%0x)\n",
-	       memory_object, memory_control, memory_object_name,
-	       memory_object_page_size);
-
-	/* Find the pager object associated with this memory object. */
-	object = find_pager_object(memory_object);
-	if (object == NULL_PAGER_OBJECT) {
-		pagerlog("No pager object for memory object in memory_object_init!\n");
-		return KERN_FAILURE;
-	}
-
-	if (memory_object_page_size != PAGE_SIZE) {
-		pagerlog("Hep me!  Page size, %d bytes, is not %d bytes!",
-			 memory_object_page_size, PAGE_SIZE);
-		return KERN_FAILURE;
-	}
-
-	/* Record the interesting information. */
-	object->control = memory_control;
-	object->name = memory_object_name;
-	object->page_size = memory_object_page_size;
-		
-
-	/* Handshake with kernel. */
-
-	/* ### May want to turn caching on ... probably won't be */
-	/* useful though. */
-	SYSCALL_OR_LOSE(memory_object_set_attributes(memory_control,
-						     TRUE, FALSE,
-						     MEMORY_OBJECT_COPY_DELAY));
-
-	return KERN_SUCCESS;
-}
-
-kern_return_t
-memory_object_terminate(memory_object, memory_control, memory_object_name)
-memory_object_t memory_object;
-memory_object_control_t memory_control;
-memory_object_name_t memory_object_name;
-{
-	pager_object_t *object;
-
-	pagerlog("memory_object_terminate(memory_object = %d, memory_control = %d, memory_object_name = %d)\n",
-	       memory_object, memory_control, memory_object_name);
-
-	/* Find the pager object associated with this memory object. */
-	object = find_pager_object(memory_object);
-	if (object == NULL_PAGER_OBJECT) {
-		pagerlog("No pager object for memory object in memory_object_terminate!\n");
-		return KERN_FAILURE;
-	}
-
-	SYSCALL_OR_LOSE(pager_deallocate_memory_object(memory_object));
-
-	return KERN_SUCCESS;
-}
-
-kern_return_t
-memory_object_data_request(memory_object, memory_control, offset, length,
-			   desired_access)
-memory_object_t memory_object;
-memory_object_control_t memory_control;
-vm_offset_t offset;
-vm_size_t length;
-vm_prot_t desired_access;
-{
-	pager_object_t *object;
-
-#if defined(LOG_REQUESTS)
-	pagerlog("memory_object_data_request(memory_object = %d, memory_control = %d, offset = 0x%08x, length = 0x%08x, desired access = 0x%0x)\n",
-	       memory_object, memory_control, offset, length, desired_access);
-#endif
-
-	/* Find the pager object associated with this memory object. */
-	object = find_pager_object(memory_object);
-	if (object == NULL_PAGER_OBJECT) {
-		pagerlog("No pager object for memory object in memory_object_data_request!\n");
-		return KERN_FAILURE;
-	}
-
-	if ((offset + length) <= object->size) {
-		/* ### The lock value is something we want to play with. */
-		SYSCALL_OR_LOSE(memory_object_data_provided(memory_control,
-							    offset,
-							    (object->backing_store +
-							     offset),
-							    length, VM_PROT_NONE));
-	} else {
-		/* Out of bounds. */
-		pagerlog("Out of bounds memory request in memory_object_data_request\n");
-		SYSCALL_OR_LOSE(memory_object_data_error(memory_control,
-							 offset, length,
-							 KERN_INVALID_ADDRESS));
-	}
-	return KERN_SUCCESS;
-}
-
-kern_return_t
-memory_object_data_write(memory_object, memory_control, offset, data, dataCnt)
-memory_object_t memory_object;
-memory_object_control_t memory_control;
-vm_offset_t offset;
-pointer_t data;
-unsigned int dataCnt;
-{
-	pager_object_t *object;
-
-#if defined(LOG_REQUESTS)
-	pagerlog("memory_object_data_write(memory_object = %d, memory_control = %d, offset = 0x%08x, data = 0x%08x, dataCnt = 0x%08x)\n",
-	       memory_object, memory_control, offset, data, dataCnt);
-#endif
-
-	/* Mark the page as dirty.
-	MARK(object->marked_pages, offset);
-
-	/* Find the pager object associated with this memory object. */
-	object = find_pager_object(memory_object);
-	if (object == NULL_PAGER_OBJECT) {
-		pagerlog("No pager object for memory object in memory_object_data_write!\n");
-		return KERN_FAILURE;
-	}
-
-	bcopy((char *) data, (char *) (object->backing_store + offset), dataCnt);
-
-	SYSCALL_OR_LOSE(vm_deallocate(task_self(), data, dataCnt));
-
-	return KERN_SUCCESS;
-}
-
-kern_return_t
-memory_object_copy(old_memory_object, old_memory_control, offset, length,
-		   new_memory_object)
-memory_object_t old_memory_object;
-memory_object_control_t old_memory_control;
-vm_offset_t offset;
-vm_size_t length;
-memory_object_t new_memory_object;
-{
-	pagerlog("memory_object_copy(old_memory_object = %d, old_memory_control = %d, offset = 0x%08x, length = 0x%08x, new_memory_object = %d)\n",
-	       old_memory_object, old_memory_control, offset, length,
-	       new_memory_object);
-
-	pagerlog("Received memory_object_copy() RPC???\n");
-
-	return KERN_SUCCESS;
-}
-
-kern_return_t
-memory_object_data_unlock(memory_object, memory_control, offset, length,
-			  desired_access)
-memory_object_t memory_object;
-memory_object_control_t memory_control;
-vm_offset_t offset;
-vm_size_t length;
-vm_prot_t desired_access;
-{
-	pagerlog("memory_object_data_unlock(memory_object = %d, memory_control = %d, offset = 0x%08x, length = 0x%08x, desired access = 0x%0x)\n",
-	       memory_object, memory_control, offset, length, desired_access);
-
-	return KERN_SUCCESS;
-}
-
-kern_return_t memory_object_lock_completed(memory_object, memory_control,
-					   offset, length)
-memory_object_t memory_object;
-memory_object_control_t memory_control;
-vm_offset_t offset;
-vm_size_t length;
-{
-	pagerlog("memory_object_lock_completed(memory_object = %d, memory_control = %d, offset = 0x%08x, length = 0x%08x)\n",
-	       memory_object, memory_control, offset, length);
-
-	return KERN_SUCCESS;
-}
-
-
-/* Server Loop */
-
-typedef struct {
-	msg_header_t head;
-	msg_type_t return_code_type;
-	kern_return_t return_code;
-} reply_t;
-
-static
-pager_serve_requests()
-{
-	struct {
-		msg_header_t header;
-		char data[MSG_SIZE_MAX - sizeof(msg_header_t)];
-	} in_msg, out_msg;
-
-	while (1) {
-		kern_return_t kr;
-		boolean_t won;
-		
-		in_msg.header.msg_local_port = pager_port_set;
-		in_msg.header.msg_size = sizeof(in_msg);
-		
-		kr = msg_receive(&in_msg.header, MSG_OPTION_NONE, 0);
-		if (kr != RCV_SUCCESS) {
-			pagerlog("msg_receive() lost.  kr = %d.\n", kr);
-			continue;
-		}
-
-#if DEBUG_MESSAGE
-		pagerlog("Message received on port %d\n",
-		       in_msg.header.msg_local_port);
-#endif
-
-		won = memory_object_server(&in_msg.header, &out_msg.header);
-		if (!won) {
-			pagerlog("memory_objectserver() lost.\n");
-			continue;
-		}
-		if ((((reply_t *) &out_msg)->return_code != MIG_NO_REPLY) &&
-		    ((out_msg.header.msg_remote_port != PORT_NULL))) {
-			kr = msg_send(&out_msg.header, MSG_OPTION_NONE, 0);
-			pagerlog("msg_send() lost.  kr = %d.\n", kr);
-		}
-	}
-}
-
-
-/* Mach Routine Emulation */
-
-kern_return_t
-pager_vm_allocate(task, address, size, anywhere)
-task_t task;
-vm_address_t *address;
-vm_size_t size;
-boolean_t anywhere;
-{
-	kern_return_t kr;
-	memory_object_t object;
-	vm_address_t backing_store;
-
-	pagerlog("pager_vm_allocate(*address = 0x%08x, size = 0x%08x, anywhere = %d)\n",
-	       *address, size, anywhere);
-
-	if (task != task_self())
-		return KERN_INVALID_ARGUMENT;
-
-	/* Emulate vm_allocate() ... */
-
-	if (size == 0) {
-		*address = 0;
-		return KERN_SUCCESS;
-	}
-
-	*address = trunc_page(*address);
-	size = round_page(size);
-
-	kr = vm_allocate(task_self(), &backing_store, size, TRUE);
-	if (kr != KERN_SUCCESS)
-		goto e0;
-
-	/* Now get a memory_object */
-	kr = pager_allocate_memory_object(&object, backing_store, size);
-	if (kr != KERN_SUCCESS)
-		goto e0;
-
-	kr = vm_map(task_self(), address, size, 0, anywhere,
-		    object, 0, FALSE, VM_PROT_ALL, VM_PROT_ALL,
-		    VM_INHERIT_COPY);
-	if (kr != KERN_SUCCESS)
-		goto e1;
-
-	return KERN_SUCCESS;
-
- e1:
-	(void) pager_deallocate_memory_object(object);
- e0:
-	return kr;
-}
-
-kern_return_t
-pager_vm_deallocate(task, address, size)
-task_t task;
-vm_address_t address;
-vm_size_t size;
-{
-	pagerlog("pager_vm_deallocate(address = 0x%08x, size = 0x%08x)\n",
-	       address, size);
-
-	if (task != task_self())
-		return KERN_INVALID_ARGUMENT;
-
-	return vm_deallocate(task_self(), address, size);
-}
-
-kern_return_t
-pager_map_fd(fd, offset, address, anywhere, size)
-int fd;
-vm_offset_t offset;
-vm_address_t *address;
-boolean_t anywhere;
-vm_size_t size;
-{
-	kern_return_t kr;
-	memory_object_t object;
-	vm_address_t backing_store;
-
-	pagerlog("pager_map_fd(fd = %d, offset = 0x%08x, *address = 0x%08x, anywhere = %d, size = 0x%08x)\n",
-	       fd, offset, *address, anywhere, size);
-
-	kr = map_fd(fd, offset, &backing_store, TRUE, size);
-	if (kr != KERN_SUCCESS)
-		goto e0;
-
-	/* Now get a memory_object */
-	kr = pager_allocate_memory_object(&object, backing_store, size);
-	if (kr != KERN_SUCCESS)
-		goto e0;
-
-	(void) vm_deallocate(task_self(), *address, size);
-	kr = vm_map(task_self(), address, size, 0, anywhere,
-		    object, 0, FALSE, VM_PROT_ALL, VM_PROT_ALL,
-		    VM_INHERIT_COPY);
-	if (kr != KERN_SUCCESS)
-		goto e1;
-
-	return KERN_SUCCESS;
-
- e1:
-	(void) pager_deallocate_memory_object(object);
- e0:
-	return kr;
-}
-
-
-/* Initialization */
-
-static
-pager_thread(arg)
-any_t arg;
-{
-	pagerlog("pager_thread() started.\n");
-	
-	pager_serve_requests();
-}
-
-pager_init()
-{
-	pager_objects_mutex = mutex_alloc();
-
-	pagerlog(";;; Lisp pager log started.\n;;;\n");
-
-	SYSCALL_OR_LOSE(port_allocate(task_self(), &pager_port));
-	pagerlog(";;; pager_port = %d\n", pager_port);
-
-	SYSCALL_OR_LOSE(port_set_allocate(task_self(), &pager_port_set));
-	pagerlog(";;; pager_port_set = %d\n", pager_port_set);
-
-	pagerlog(";;;\n");
-
-	SYSCALL_OR_LOSE(port_set_add(task_self(), pager_port_set, pager_port));
-
-	cthread_detach(cthread_fork(pager_thread, (any_t) 0));
-}
diff --git a/ldb/pager.h b/ldb/pager.h
deleted file mode 100644
index c7d883558..000000000
--- a/ldb/pager.h
+++ /dev/null
@@ -1,47 +0,0 @@
-/*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/pager.h,v 1.2 1991/02/19 12:27:47 ch Exp $
- * 
- * pager.h
- */
-
-#if !defined(_PAGER_H_INCLUDED_)
-#define _PAGER_H_INCLUDED_
-
-typedef struct pager_object {
-	memory_object_t object;
-	memory_object_control_t control;
-	memory_object_name_t name;
-	vm_size_t size;
-	vm_address_t backing_store;
-	vm_size_t page_size;
-	unsigned long *marked_pages;
-	struct pager_object *prev;
-	struct pager_object *next;
-} pager_object_t;
-
-#define NULL_PAGER_OBJECT ((pager_object_t *) 0)
-
-#define SYSCALL_OR_LOSE(syscall) {                         	\
-	kern_return_t kr;                                  	\
-                                                           	\
-	if ((kr = (syscall)) != KERN_SUCCESS) {            	\
-		fprintf(stderr, "ERROR:\n");			\
-		fprintf(stderr, "In file \"%s\", line %d:",	\
-			__FILE__, __LINE__);               	\
-		mach_error("", kr);                        	\
-		exit(1);                                   	\
-	}                                                  	\
-}						   
-						   
-#define SYSCALL_OR_WARN(syscall) {                         	\
-	kern_return_t kr;                                  	\
-                                                           	\
-	if ((kr = (syscall)) != KERN_SUCCESS) {            	\
-		fprintf(stderr, "WARNING:\n");			\
-		fprintf(stderr, "In file \"%s\", line %d:",	\
-			__FILE__, __LINE__);               	\
-		mach_error("", kr);                        	\
-	}                                                  	\
-}						   
-						   
-#endif
diff --git a/ldb/pagerlog.c b/ldb/pagerlog.c
deleted file mode 100644
index 08fa2c022..000000000
--- a/ldb/pagerlog.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/pagerlog.c,v 1.2 1991/02/19 12:27:50 ch Exp $
- * 
- * pager log facility
- *
- */
-
-#include <stdio.h>
-#include <varargs.h>
-
-#define PAGERLOG_ENVVAR "PAGERLOG"
-#define PAGERLOG_DEFAULT "./pager.log"
-
-extern char *getenv();
-
-static initialized = 0;
-static FILE *logfile;
-
-static void
-initialize_pagerlog()
-{
-	char *log;
-
-	log = getenv(PAGERLOG_ENVVAR);
-	if (log == NULL)
-		log = PAGERLOG_DEFAULT;
-
-	logfile = fopen(log, "w+");
-	if (logfile == (FILE *) NULL) {
-		fprintf(stderr, "pagerlog: cannot open \"%s\"\n", log);
-		exit(1);
-	}
-	setlinebuf(logfile);
-	initialized = 1;	
-}
-
-/*VARARGS1*/
-pagerlog(fmt, va_alist)
-char *fmt;
-va_dcl
-{
-	va_list pvar;
-	
-	if (!initialized)
-		initialize_pagerlog();
-
-	va_start(pvar);
-	vfprintf(logfile, fmt, pvar);
-	va_end(pvar);
-}
diff --git a/ldb/parse.c b/ldb/parse.c
deleted file mode 100644
index 6d04ccf13..000000000
--- a/ldb/parse.c
+++ /dev/null
@@ -1,360 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/parse.c,v 1.7 1991/05/24 18:34:59 wlott Exp $ */
-#include <stdio.h>
-#include <ctype.h>
-#include <signal.h>
-#include <strings.h>
-
-#include "ldb.h"
-#include "lisp.h"
-#include "globals.h"
-#include "vars.h"
-#include "parse.h"
-#include "interrupt.h"
-#include "lispregs.h"
-
-static int strcasecmp(s1,s2)
-char *s1,*s2;
-{
-    int c1, c2;
-
-    do{
-	c1=(*s1++);
-	if(isupper(c1))
-	    c1=tolower(c1);
-
-	c2=(*s2++);
-	if(isupper(c2))
-	    c2=tolower(c2);
-    }while(c1==c2 && c1!=0);
-
-    return c1-c2;
-}
-
-static void skip_ws(ptr)
-char **ptr;
-{
-    while (**ptr <= ' ' && **ptr != '\0')
-        (*ptr)++;
-}
-
-static boolean string_to_long(token, value)
-char *token;
-long *value;
-{
-    int base, digit;
-    long num;
-    char *ptr;
-
-    if (token == 0)
-        return FALSE;
-
-    if (token[0] == '0')
-        if (token[1] == 'x') {
-            base = 16;
-            token += 2;
-        }
-        else {
-            base = 8;
-            token++;
-        }
-    else if (token[0] == '#') {
-        switch (token[1]) {
-            case 'x':
-            case 'X':
-                base = 16;
-                token += 2;
-                break;            
-            case 'o':
-            case 'O':
-                base = 8;
-                token += 2;
-                break;
-            default:
-                return FALSE;
-        }
-    }
-    else
-        base = 10;
-
-    num = 0;
-    ptr = token;
-    while (*ptr != '\0') {
-        if (*ptr >= 'a' && *ptr <= 'f')
-            digit = *ptr + 10 - 'a';
-        else if (*ptr >= 'A' && *ptr <= 'F')
-            digit = *ptr + 10 - 'A';
-        else if (*ptr >= '0' && *ptr <= '9')
-            digit = *ptr - '0';
-        else
-            return FALSE;
-        if (digit < 0 || digit >= base)
-            return FALSE;
-
-        ptr++;
-        num = num * base + digit;
-    }
-
-    *value = num;
-    return TRUE;
-}
-
-static boolean lookup_variable(name, result)
-char *name;
-lispobj *result;
-{
-    struct var *var = lookup_by_name(name);
-
-    if (var == NULL)
-        return FALSE;
-    else {
-        *result = var_value(var);
-        return TRUE;
-    }
-}
-
-
-boolean more_p(ptr)
-char **ptr;
-{
-    skip_ws(ptr);
-
-    if (**ptr == '\0')
-        return FALSE;
-    else
-        return TRUE;
-}
-
-char *parse_token(ptr)
-char **ptr;
-{
-    char *token;
-
-    skip_ws(ptr);
-    
-    if (**ptr == '\0')
-        return NULL;
-
-    token = *ptr;
-
-    while (**ptr > ' ')
-        (*ptr)++;
-
-    if (**ptr != '\0') {
-        **ptr = '\0';
-        (*ptr)++;
-    }
-
-    return token;
-}
-
-#if 0
-static boolean number_p(token)
-char *token;
-{
-    char *okay;
-
-    if (token == NULL)
-        return FALSE;
-
-    okay = "abcdefABCDEF987654321d0";
-
-    if (token[0] == '0')
-        if (token[1] == 'x' || token[1] == 'X')
-            token += 2;
-        else {
-            token++;
-            okay += 14;
-        }
-    else if (token[0] == '#') {
-        switch (token[1]) {
-            case 'x':
-            case 'X':
-                break;
-            case 'o':
-            case 'O':
-                okay += 14;
-                break;
-            default:
-                return FALSE;
-        }
-    }
-    else
-        okay += 12;
-
-    while (*token != '\0')
-        if (index(okay, *token++) == NULL)
-            return FALSE;
-    return TRUE;
-}
-#endif
-
-long parse_number(ptr)
-char **ptr;
-{
-    char *token = parse_token(ptr);
-    long result;
-
-    if (token == NULL) {
-        printf("Expected a number.\n");
-        throw_to_monitor();
-    }
-    else if (string_to_long(token, &result))
-        return result;
-    else {
-        printf("Invalid number: ``%s''\n", token);
-        throw_to_monitor();
-    }
-}
-
-char *parse_addr(ptr)
-char **ptr;
-{
-    char *token = parse_token(ptr);
-    long result;
-
-    if (token == NULL) {
-        printf("Expected an address.\n");
-        throw_to_monitor();
-    }
-    else if (token[0] == '$') {
-        if (!lookup_variable(token+1, (lispobj *)&result)) {
-            printf("Unknown variable: ``%s''\n", token);
-            throw_to_monitor();
-        }
-        result &= ~7;
-    }
-    else {
-        if (!string_to_long(token, &result)) {
-            printf("Invalid number: ``%s''\n", token);
-            throw_to_monitor();
-        }
-        result &= ~3;
-    }
-
-    if (!valid_addr(result)) {
-        printf("Invalid address: 0x%x\n", result);
-        throw_to_monitor();
-    }
-
-    return (char *)result;
-}
-
-static boolean lookup_symbol(name, result)
-char *name;
-lispobj *result;
-{
-    int count;
-
-    /* Search static space */
-    *result = (lispobj) static_space;
-    count = ((lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) -
-	     static_space);
-    if (search_for_symbol(name, result, &count)) {
-        *result |= type_OtherPointer;
-        return TRUE;
-    }
-
-    /* Search dynamic space */
-    *result = (lispobj) current_dynamic_space;
-#ifndef ibmrt
-    count = current_dynamic_space_free_pointer - current_dynamic_space;
-#else
-    count = (lispobj *)SymbolValue(ALLOCATION_POINTER) - current_dynamic_space;
-#endif
-    if (search_for_symbol(name, result, &count)) {
-        *result |= type_OtherPointer;
-        return TRUE;
-    }
-
-    return FALSE;
-}
-
-static int
-parse_regnum(s)
-char *s;
-{
-	if ((s[1] == 'R') || (s[1] == 'r')) {
-		int regnum;
-
-		if (s[2] == '\0')
-			return -1;
-
-		/* skip the $R part and call atoi on the number */
-		regnum = atoi(s + 2);
-		if ((regnum >= 0) && (regnum < NREGS))
-			return regnum;
-		else
-			return -1;
-	} else {
-		int i;
-
-		for (i = 0; i < NREGS ; i++)
-			if (strcasecmp(s + 1, lisp_register_names[i]) == 0)
-				return i;
-		
-		return -1;
-	}
-}
-
-lispobj parse_lispobj(ptr)
-char **ptr;
-{
-    char *token = parse_token(ptr);
-    long pointer;
-    lispobj result;
-
-    if (token == NULL) {
-        printf("Expected an object.\n");
-        throw_to_monitor();
-    } else if (token[0] == '$') {
-	if (isalpha(token[1])) {
-		int free;
-		int regnum;
-		struct sigcontext *context;
-
-		free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
-
-		if (free == 0) {
-			printf("Variable ``%s'' is not valid -- there is no current interrupt context.\n", token);
-			throw_to_monitor();
-		}
-
-		context = lisp_interrupt_contexts[free - 1];
-
-		regnum = parse_regnum(token);
-		if (regnum < 0) {
-			printf("Bogus register: ``%s''\n", token);
-			throw_to_monitor();
-		}
-
-		result = context->sc_regs[regnum];
-	} else if (!lookup_variable(token+1, &result)) {
-            printf("Unknown variable: ``%s''\n", token);
-            throw_to_monitor();
-        }
-    } else if (token[0] == '@') {
-        if (string_to_long(token+1, &pointer)) {
-            pointer &= ~3;
-            if (valid_addr(pointer))
-                result = *(lispobj *)pointer;
-            else {
-                printf("Invalid address: ``%s''\n", token+1);
-                throw_to_monitor();
-            }
-        }
-        else {
-            printf("Invalid address: ``%s''\n", token+1);
-            throw_to_monitor();
-        }
-    }
-    else if (string_to_long(token, (long *)&result))
-        ;
-    else if (lookup_symbol(token, &result))
-        ;
-    else {
-        printf("Invalid lisp object: ``%s''\n", token);
-        throw_to_monitor();
-    }
-
-    return result;
-}
diff --git a/ldb/parse.h b/ldb/parse.h
deleted file mode 100644
index ebd096bd1..000000000
--- a/ldb/parse.h
+++ /dev/null
@@ -1,9 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/parse.h,v 1.1 1990/02/24 19:37:27 wlott Exp $ */
-
-/* All parse routines take a char ** as their only argument */
-
-boolean more_p();
-char *parse_token();
-lispobj parse_lispobj();
-char *parse_addr();
-long parse_number();
diff --git a/ldb/print.c b/ldb/print.c
deleted file mode 100644
index 080586e13..000000000
--- a/ldb/print.c
+++ /dev/null
@@ -1,585 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/print.c,v 1.17 1992/03/08 18:39:57 wlott Exp $ */
-#include <stdio.h>
-
-#include "ldb.h"
-#include "print.h"
-#include "lisp.h"
-#include "vars.h"
-
-static int max_lines = 20, cur_lines = 0;
-static int max_depth = 5, brief_depth = 2, cur_depth = 0;
-static int max_length = 5;
-static boolean dont_decend = FALSE, skip_newline = FALSE;
-static cur_clock = 0;
-
-static void print_obj();
-
-#define NEWLINE if (continue_p(TRUE)) newline(NULL); else return;
-
-char *lowtag_Names[] = {
-    "even fixnum",
-    "function pointer",
-    "other immediate [0]",
-    "list pointer",
-    "odd fixnum",
-    "structure pointer",
-    "other immediate [1]",
-    "other pointer"
-};
-
-char *subtype_Names[] = {
-    "unused 0",
-    "unused 1",
-    "bignum",
-    "ratio",
-    "single float",
-    "double float",
-    "complex",
-    "simple-array",
-    "simple-string",
-    "simple-bit-vector",
-    "simple-vector",
-    "(simple-array (unsigned-byte 2) (*))",
-    "(simple-array (unsigned-byte 4) (*))",
-    "(simple-array (unsigned-byte 8) (*))",
-    "(simple-array (unsigned-byte 16) (*))",
-    "(simple-array (unsigned-byte 32) (*))",
-    "(simple-array single-float (*))",
-    "(simple-array double-float (*))",
-    "complex-string",
-    "complex-bit-vector",
-    "(array * (*))",
-    "array",
-    "code header",
-    "function header",
-    "closure header",
-    "funcallable-instance header",
-    "unused function header 1",
-    "unused function header 2",
-    "unused function header 3",
-    "closure function header",
-    "return PC header",
-    "value cell header",
-    "symbol header",
-    "character",
-    "SAP",
-    "unbound marker",
-    "weak pointer",
-    "structure header",
-    "fdefn"
-};
-
-static void indent(in)
-int in;
-{
-    static char *spaces = "                                                                ";
-
-    while (in > 64) {
-        fputs(spaces, stdout);
-        in -= 64;
-    }
-    if (in != 0)
-        fputs(spaces + 64 - in, stdout);
-}
-
-static boolean continue_p(newline)
-boolean newline;
-{
-    char buffer[256];
-
-    if (cur_depth >= max_depth || dont_decend)
-        return FALSE;
-
-    if (newline) {
-        if (skip_newline)
-            skip_newline = FALSE;
-        else
-            putchar('\n');
-
-        if (cur_lines >= max_lines) {
-            printf("More? [y] ");
-            fflush(stdout);
-
-            gets(buffer);
-
-            if (buffer[0] == 'n' || buffer[0] == 'N')
-                throw_to_monitor();
-            else
-                cur_lines = 0;
-        }
-    }
-
-    return TRUE;
-}
-
-static void newline(label)
-char *label;
-{
-    cur_lines++;
-    if (label != NULL)
-        fputs(label, stdout);
-    putchar('\t');
-    indent(cur_depth * 2);
-}
-
-
-static void brief_fixnum(obj)
-lispobj obj;
-{
-    printf("%d", ((long)obj)>>2);
-}
-
-static void print_fixnum(obj)
-lispobj obj;
-{
-    printf(": %d", ((long)obj)>>2);
-}
-
-static void brief_otherimm(obj)
-lispobj obj;
-{
-    int type, c, idx;
-    char buffer[10];
-
-    type = TypeOf(obj);
-    switch (type) {
-        case type_BaseChar:
-            c = (obj>>8)&0xff;
-            switch (c) {
-                case '\0':
-                    printf("#\\Null");
-                    break;
-                case '\n':
-                    printf("#\\Newline");
-                    break;
-                case '\b':
-                    printf("#\\Backspace");
-                    break;
-                case '\177':
-                    printf("#\\Delete");
-                    break;
-                default:
-                    strcpy(buffer, "#\\");
-                    if (c >= 128) {
-                        strcat(buffer, "m-");
-                        c -= 128;
-                    }
-                    if (c < 32) {
-                        strcat(buffer, "c-");
-                        c += '@';
-                    }
-                    printf("%s%c", buffer, c);
-                    break;
-            }
-            break;
-
-        case type_UnboundMarker:
-            printf("<unbound marker>");
-            break;
-
-        default:
-	    idx = type >> 2;
-	    if (idx < (sizeof(subtype_Names) / sizeof(char *)))
-		    printf("%s", subtype_Names[idx]);
-	    else
-		    printf("unknown type (0x%0x)", type);
-            break;
-    }
-}
-
-static void print_otherimm(obj)
-lispobj obj;
-{
-    int type, c, idx;
-
-    type = TypeOf(obj);
-    idx = type >> 2;
-
-    if (idx < (sizeof(subtype_Names) / sizeof(char *)))
-	    printf(", %s", subtype_Names[idx]);
-    else
-	    printf(", unknown type (0x%0x)", type);
-
-    switch (TypeOf(obj)) {
-        case type_BaseChar:
-            printf(": ");
-            brief_otherimm(obj);
-            break;
-
-        case type_Sap:
-        case type_UnboundMarker:
-            break;
-
-        default:
-            printf(": data=%d", (obj>>8)&0xffffff);
-            break;
-    }
-}
-
-static void brief_list(obj)
-lispobj obj;
-{
-    int space = FALSE;
-    int length = 0;
-
-    if (!valid_addr(obj))
-	    printf("(invalid address)");
-    else if (obj == NIL)
-        printf("NIL");
-    else {
-        putchar('(');
-        while (LowtagOf(obj) == type_ListPointer) {
-            struct cons *cons = (struct cons *)PTR(obj);
-
-            if (space)
-                putchar(' ');
-            if (++length >= max_length) {
-                printf("...");
-                obj = NIL;
-                break;
-            }
-            print_obj(NULL, cons->car);
-            obj = cons->cdr;
-            space = TRUE;
-            if (obj == NIL)
-                break;
-        }
-        if (obj != NIL) {
-            printf(" . ");
-            print_obj(NULL, obj);
-        }
-        putchar(')');
-    }
-}
-
-static void print_list(obj)
-lispobj obj;
-{
-    if (!valid_addr(obj))
-	    printf("(invalid address)");
-    else if (obj == NIL)
-        printf(" (NIL)");
-    else {
-        struct cons *cons = (struct cons *)PTR(obj);
-
-        print_obj("car: ", cons->car);
-        print_obj("cdr: ", cons->cdr);
-    }
-}
-
-static void brief_struct(obj)
-lispobj obj;
-{
-    printf("#<ptr to ");
-    print_obj(NULL, ((struct structure *)PTR(obj))->slots[0]);
-    printf(" structure>");
-}
-
-static void print_struct(obj)
-lispobj obj;
-{
-    struct structure *structure = (struct structure *)PTR(obj);
-    int i;
-    char buffer[16];
-
-    print_obj("type: ", structure->slots[0]);
-    for (i = 1; i < HeaderValue(structure->header); i++) {
-	sprintf(buffer, "slot %d: ", i);
-	print_obj(buffer, structure->slots[i]);
-    }
-}
-
-static void brief_otherptr(obj)
-lispobj obj;
-{
-    lispobj *ptr, header;
-    int type;
-    struct symbol *symbol;
-    struct vector *vector;
-    char *charptr;
-
-    ptr = (lispobj *) PTR(obj);
-
-    if (!valid_addr(obj)) {
-	    printf("(invalid address)");
-	    return;
-    }
-
-    header = *ptr;
-    type = TypeOf(header);
-    switch (type) {
-        case type_SymbolHeader:
-            symbol = (struct symbol *)ptr;
-            vector = (struct vector *)PTR(symbol->name);
-            for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
-                if (*charptr == '"')
-                    putchar('\\');
-                putchar(*charptr);
-            }
-            break;
-
-        case type_SimpleString:
-            vector = (struct vector *)ptr;
-            putchar('"');
-            for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
-                if (*charptr == '"')
-                    putchar('\\');
-                putchar(*charptr);
-            }
-            putchar('"');
-            break;
-            
-        default:
-            printf("#<ptr to ");
-            brief_otherimm(header);
-            putchar('>');
-    }
-}
-
-static void print_slots(slots, count, ptr)
-char **slots;
-int count;
-long *ptr;
-{
-    while (count-- > 0)
-        if (*slots)
-            print_obj(*slots++, *ptr++);
-        else
-            print_obj("???: ", *ptr++);
-}
-
-static char *symbol_slots[] = {"value: ", "unused: ",
-    "plist: ", "name: ", "package: ", NULL};
-static char *ratio_slots[] = {"numer: ", "denom: ", NULL};
-static char *complex_slots[] = {"real: ", "imag: ", NULL};
-static char *code_slots[] = {"words: ", "entry: ", "debug: ", NULL};
-static char *fn_slots[] = {"self: ", "next: ", "name: ", "arglist: ", "type: ", NULL};
-static char *closure_slots[] = {"fn: ", NULL};
-static char *weak_pointer_slots[] = {"value: ", NULL};
-static char *fdefn_slots[] = {"name: ", "function: ", "raw_addr: ", NULL};
-
-static void print_otherptr(obj)
-lispobj obj;
-{
-    if (!valid_addr(obj))
-	    printf("(invalid address)");
-    else {
-        unsigned long *ptr; 
-        unsigned long header;
-        unsigned long length;
-        int count, type, index;
-        boolean raw;
-        char *cptr, buffer[16];
-
-	ptr = (unsigned long *) PTR(obj);
-	if (ptr == (unsigned long *) NULL) {
-		printf(" (NULL Pointer)");
-		return;
-	}
-
-	header = *ptr++;
-	length = (*ptr) >> 2;
-	count = header>>8;
-	type = TypeOf(header);
-
-        print_obj("header: ", header);
-        if (LowtagOf(header) != type_OtherImmediate0 && LowtagOf(header) != type_OtherImmediate1) {
-            NEWLINE;
-            printf("(invalid header object)");
-            return;
-        }
-
-        switch (type) {
-            case type_Bignum:
-                ptr += count;
-                NEWLINE;
-                printf("0x");
-                while (count-- > 0)
-                    printf("%08x", *--ptr);
-                break;
-
-            case type_Ratio:
-                print_slots(ratio_slots, count, ptr);
-                break;
-
-            case type_Complex:
-                print_slots(complex_slots, count, ptr);
-                break;
-
-            case type_SymbolHeader:
-                print_slots(symbol_slots, count, ptr);
-                break;
-
-            case type_SingleFloat:
-                NEWLINE;
-                printf("%f", ((struct single_float *)PTR(obj))->value);
-                break;
-
-            case type_DoubleFloat:
-                NEWLINE;
-                printf("%lf", ((struct double_float *)PTR(obj))->value);
-                break;
-
-            case type_SimpleString:
-                NEWLINE;
-                cptr = (char *)(ptr+1);
-                putchar('\"');
-                while (length-- > 0)
-                    putchar(*cptr++);
-                putchar('\"');
-                break;
-
-            case type_SimpleVector:
-            case type_StructureHeader:
-                NEWLINE;
-                printf("length = %d", length);
-                ptr++;
-                index = 0;
-                while (length-- > 0) {
-                    sprintf(buffer, "%d: ", index++);
-                    print_obj(buffer, *ptr++);
-                }
-                break;
-
-            case type_SimpleArray:
-            case type_SimpleBitVector:
-            case type_SimpleArrayUnsignedByte2:
-            case type_SimpleArrayUnsignedByte4:
-            case type_SimpleArrayUnsignedByte8:
-            case type_SimpleArrayUnsignedByte16:
-            case type_SimpleArrayUnsignedByte32:
-            case type_SimpleArraySingleFloat:
-            case type_SimpleArrayDoubleFloat:
-            case type_ComplexString:
-            case type_ComplexBitVector:
-            case type_ComplexVector:
-            case type_ComplexArray:
-                break;
-
-            case type_CodeHeader:
-                print_slots(code_slots, count-1, ptr);
-                break;
-
-            case type_FunctionHeader:
-            case type_ClosureFunctionHeader:
-                print_slots(fn_slots, 5, ptr);
-                break;
-
-            case type_ReturnPcHeader:
-                print_obj("code: ", obj - (count * 4));
-                break;
-
-            case type_ClosureHeader:
-                print_slots(closure_slots, count, ptr);
-                break;
-
-            case type_Sap:
-                NEWLINE;
-                printf("0x%08x", *ptr);
-                break;
-
-            case type_WeakPointer:
-		print_slots(weak_pointer_slots, 1, ptr);
-                break;
-
-            case type_BaseChar:
-            case type_UnboundMarker:
-                NEWLINE;
-                printf("pointer to an immediate?");
-                break;
-
-	      case type_Fdefn:
-		print_slots(fdefn_slots, count, ptr);
-		break;
-		
-            default:
-                NEWLINE;
-                printf("Unknown header object?");
-                break;
-        }
-    }
-}
-
-static void print_obj(prefix, obj)
-char *prefix;
-lispobj obj;
-{
-    static void (*verbose_fns[])() = {print_fixnum, print_otherptr, print_otherimm, print_list, print_fixnum, print_struct, print_otherimm, print_otherptr};
-    static void (*brief_fns[])() = {brief_fixnum, brief_otherptr, brief_otherimm, brief_list, brief_fixnum, brief_struct, brief_otherimm, brief_otherptr};
-    int type = LowtagOf(obj);
-    struct var *var = lookup_by_obj(obj);
-    char buffer[256];
-    boolean verbose = cur_depth < brief_depth;
-
-    
-    if (!continue_p(verbose))
-        return;
-
-    if (var != NULL && var_clock(var) == cur_clock)
-        dont_decend = TRUE;
-
-    if (var == NULL && (obj & type_FunctionPointer & type_ListPointer & type_StructurePointer & type_OtherPointer) != 0)
-        var = define_var(NULL, obj, FALSE);
-
-    if (var != NULL)
-        var_setclock(var, cur_clock);
-
-    cur_depth++;
-    if (verbose) {
-        if (var != NULL) {
-            sprintf(buffer, "$%s=", var_name(var));
-            newline(buffer);
-        }
-        else
-            newline(NULL);
-        printf("%s0x%08x: ", prefix, obj);
-        if (cur_depth < brief_depth) {
-            fputs(lowtag_Names[type], stdout);
-            (*verbose_fns[type])(obj);
-        }
-        else
-            (*brief_fns[type])(obj);
-    }
-    else {
-        if (dont_decend)
-            printf("$%s", var_name(var));
-        else {
-            if (var != NULL)
-                printf("$%s=", var_name(var));
-            (*brief_fns[type])(obj);
-        }
-    }
-    cur_depth--;
-    dont_decend = FALSE;
-}
-
-void reset_printer()
-{
-    cur_clock++;
-    cur_lines = 0;
-    dont_decend = FALSE;
-}
-
-void print(obj)
-lispobj obj;
-{
-    skip_newline = TRUE;
-    cur_depth = 0;
-    max_depth = 5;
-    max_lines = 20;
-
-    print_obj("", obj);
-
-    putchar('\n');
-}
-
-void brief_print(obj)
-lispobj obj;
-{
-    skip_newline = TRUE;
-    max_depth = 1;
-    max_lines = 5000;
-
-    print_obj("", obj);
-    putchar('\n');
-}
diff --git a/ldb/print.h b/ldb/print.h
deleted file mode 100644
index c66202e00..000000000
--- a/ldb/print.h
+++ /dev/null
@@ -1,5 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/print.h,v 1.1 1990/02/24 19:37:30 wlott Exp $ */
-
-extern char *lowtag_Names[], *subtype_Names[];
-
-extern void print();
diff --git a/ldb/purify.c b/ldb/purify.c
deleted file mode 100644
index 9c2581ed5..000000000
--- a/ldb/purify.c
+++ /dev/null
@@ -1,736 +0,0 @@
-/* Purify. */
-
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/purify.c,v 1.18 1992/04/15 00:40:00 wlott Exp $ */
-
-#include <stdio.h>
-
-#include "lisp.h"
-#include "ldb.h"
-#include "os.h"
-#include "globals.h"
-#include "validate.h"
-#include "interrupt.h"
-#include "gc.h"
-
-/* These hold the original end of the read_only and static spaces so we can */
-/* tell what are forwarding pointers. */
-
-static lispobj *read_only_end, *static_end;
-
-static lispobj *read_only_free, *static_free;
-static lispobj *pscav();
-
-#define LATERBLOCKSIZE 1020
-#define LATERMAXCOUNT 10
-
-static struct later {
-    struct later *next;
-    union {
-        lispobj *ptr;
-        int count;
-    } u[LATERBLOCKSIZE];
-} *later_blocks = NULL;
-static int later_count = 0;
-
-
-#define NWORDS(x,y) (CEILING((x),(y)) / (y))
-
-#ifdef sparc
-#define RAW_ADDR_OFFSET 0
-#else
-#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
-#endif
-
-static boolean forwarding_pointer_p(obj)
-     lispobj obj;
-{
-    lispobj *ptr;
-
-    ptr = (lispobj *)obj;
-
-    return ((static_end <= ptr && ptr <= static_free) ||
-            (read_only_end <= ptr && ptr <= read_only_free));
-}
-
-static boolean dynamic_pointer_p(ptr)
-     lispobj ptr;
-{
-    return ptr >= (lispobj)dynamic_0_space;
-}
-
-static void pscav_later(where, count)
-     lispobj *where;
-     int count;
-{
-    struct later *new;
-
-    if (count > LATERMAXCOUNT) {
-        while (count > LATERMAXCOUNT) {
-            pscav_later(where, LATERMAXCOUNT);
-            count -= LATERMAXCOUNT;
-            where += LATERMAXCOUNT;
-        }
-    }
-    else {
-        if (later_blocks == NULL || later_count == LATERBLOCKSIZE ||
-            (later_count == LATERBLOCKSIZE-1 && count > 1)) {
-            new  = (struct later *)malloc(sizeof(struct later));
-            new->next = later_blocks;
-            if (later_blocks && later_count < LATERBLOCKSIZE)
-                later_blocks->u[later_count].ptr = NULL;
-            later_blocks = new;
-            later_count = 0;
-        }
-
-        if (count != 1)
-            later_blocks->u[later_count++].count = count;
-        later_blocks->u[later_count++].ptr = where;
-    }
-}
-
-static lispobj ptrans_boxed(thing, header, constant)
-     lispobj thing, header;
-     boolean constant;
-{
-    int nwords;
-    lispobj result, *new, *old;
-
-    nwords = 1 + HeaderValue(header);
-
-    /* Allocate it */
-    old = (lispobj *)PTR(thing);
-    if (constant) {
-        new = read_only_free;
-        read_only_free += CEILING(nwords, 2);
-    }
-    else {
-        new = static_free;
-        static_free += CEILING(nwords, 2);
-    }
-
-    /* Copy it. */
-    bcopy(old, new, nwords * sizeof(lispobj));
-
-    /* Deposit forwarding pointer. */
-    result = (lispobj)new | LowtagOf(thing);
-    *old = result;
-        
-    /* Scavenge it. */
-    pscav(new, nwords, constant);
-
-    return result;
-}
-
-static lispobj ptrans_fdefn(thing, header)
-{
-    int nwords;
-    lispobj result, *new, *old, oldfn;
-    struct fdefn *fdefn;
-
-    nwords = 1 + HeaderValue(header);
-
-    /* Allocate it */
-    old = (lispobj *)PTR(thing);
-    new = static_free;
-    static_free += CEILING(nwords, 2);
-
-    /* Copy it. */
-    bcopy(old, new, nwords * sizeof(lispobj));
-
-    /* Deposit forwarding pointer. */
-    result = (lispobj)new | LowtagOf(thing);
-    *old = result;
-
-    /* Scavenge the function. */
-    fdefn = (struct fdefn *)new;
-    oldfn = fdefn->function;
-    pscav(&fdefn->function, 1, FALSE);
-    if ((char *)oldfn + RAW_ADDR_OFFSET == fdefn->raw_addr)
-        fdefn->raw_addr = (char *)fdefn->function + RAW_ADDR_OFFSET;
-
-    return result;
-}
-
-static lispobj ptrans_unboxed(thing, header)
-{
-    int nwords;
-    lispobj result, *new, *old;
-
-    nwords = 1 + HeaderValue(header);
-
-    /* Allocate it */
-    old = (lispobj *)PTR(thing);
-    new = read_only_free;
-    read_only_free += CEILING(nwords, 2);
-
-    /* Copy it. */
-    bcopy(old, new, nwords * sizeof(lispobj));
-
-    /* Deposit forwarding pointer. */
-    result = (lispobj)new | LowtagOf(thing);
-    *old = result;
-
-    return result;
-}
-
-static lispobj ptrans_vector(thing, bits, extra, boxed, constant)
-     lispobj thing;
-     int bits, extra;
-     boolean boxed, constant;
-{
-    struct vector *vector;
-    int nwords;
-    lispobj result, *new;
-
-    vector = (struct vector *)PTR(thing);
-    nwords = 2 + (CEILING((FIXNUM_TO_INT(vector->length)+extra)*bits,32)>>5);
-
-    if (boxed && !constant) {
-        new = static_free;
-        static_free += CEILING(nwords, 2);
-    }
-    else {
-        new = read_only_free;
-        read_only_free += CEILING(nwords, 2);
-    }
-
-    bcopy(vector, new, nwords * sizeof(lispobj));
-
-    result = (lispobj)new | LowtagOf(thing);
-    vector->header = result;
-
-    if (boxed)
-        pscav(new, nwords, constant);
-
-    return result;
-}
-
-
-static lispobj ptrans_code(thing)
-     lispobj thing;
-{
-    struct code *code, *new;
-    int nwords;
-    lispobj func, result;
-
-    code = (struct code *)PTR(thing);
-    nwords = HeaderValue(code->header) + FIXNUM_TO_INT(code->code_size);
-
-    new = (struct code *)read_only_free;
-    read_only_free += CEILING(nwords, 2);
-
-    bcopy(code, new, nwords * sizeof(lispobj));
-    
-    result = (lispobj)new | type_OtherPointer;
-
-    /* Stick in a forwarding pointer for the code object. */
-    *(lispobj *)code = result;
-
-    /* Put in forwarding pointers for all the functions. */
-    for (func = code->entry_points;
-         func != NIL;
-         func = ((struct function_header *)PTR(func))->next) {
-
-        gc_assert(LowtagOf(func) == type_FunctionPointer);
-
-        *(lispobj *)PTR(func) = result + (func - thing);
-    }
-
-    /* Arrange to scavenge the debug info later. */
-    pscav_later(&new->debug_info, 1);
-
-    /* Scavenge the constants. */
-    pscav(new->constants, HeaderValue(new->header)-5, TRUE);
-
-    /* Scavenge all the functions. */
-    pscav(&new->entry_points, 1, TRUE);
-    for (func = new->entry_points;
-         func != NIL;
-         func = ((struct function_header *)PTR(func))->next) {
-        gc_assert(LowtagOf(func) == type_FunctionPointer);
-        gc_assert(!dynamic_pointer_p(func));
-        pscav(&((struct function_header *)PTR(func))->self, 2, TRUE);
-        pscav_later(&((struct function_header *)PTR(func))->name, 3);
-    }
-
-    return result;
-}
-
-static lispobj ptrans_func(thing, header, constant)
-     lispobj thing, header;
-     boolean constant;
-{
-    int nwords;
-    lispobj code, *new, *old, result;
-    struct function_header *function;
-
-    /* THING can either be a function header, a closure function header, */
-    /* a closure, or a funcallable-instance.  If it's a closure or a */
-    /* funcallable-instance, we do the same as ptrans_boxed. */
-    /* Otherwise we have to do something strange, 'cause it is buried inside */
-    /* a code object. */
-
-    if (TypeOf(header) == type_FunctionHeader ||
-        TypeOf(header) == type_ClosureFunctionHeader) {
-
-	/* We can only end up here if the code object has not been */
-        /* scavenged, because if it had been scavenged, forwarding pointers */
-        /* would have been left behind for all the entry points. */
-
-        function = (struct function_header *)PTR(thing);
-        code = PTR(thing) - (HeaderValue(function->header) * sizeof(lispobj)) |
-            type_OtherPointer;
-
-        /* This will cause the function's header to be replaced with a */
-        /* forwarding pointer. */
-        ptrans_code(code);
-
-        /* So we can just return that. */
-        return function->header;
-    }
-    else {
-	/* It's some kind of closure-like thing. */
-        nwords = 1 + HeaderValue(header);
-        old = (lispobj *)PTR(thing);
-
-	/* Allocate the new one. */
-	if (TypeOf(header) == type_FuncallableInstanceHeader) {
-	    /* FINs *must* not go in read_only space. */
-	    new = static_free;
-	    static_free += CEILING(nwords, 2);
-	}
-	else {
-	    /* Closures can always go in read-only space, 'caues */
-	    /* they never change. */
-	    new = read_only_free;
-	    read_only_free += CEILING(nwords, 2);
-	}
-
-        /* Copy it. */
-        bcopy(old, new, nwords * sizeof(lispobj));
-
-        /* Deposit forwarding pointer. */
-        result = (lispobj)new | LowtagOf(thing);
-        *old = result;
-
-        /* Scavenge it. */
-        pscav(new, nwords, constant);
-
-        return result;
-    }
-}
-
-static lispobj ptrans_returnpc(thing, header)
-     lispobj thing, header;
-{
-    lispobj code, new;
-
-    /* Find the corresponding code object. */
-    code = thing - HeaderValue(header)*sizeof(lispobj);
-
-    /* Make sure it's been transported. */
-    new = *(lispobj *)PTR(code);
-    if (!forwarding_pointer_p(new))
-        new = ptrans_code(code);
-
-    /* Maintain the offset: */
-    return new + (thing - code);
-}
-
-#define WORDS_PER_CONS CEILING(sizeof(struct cons) / sizeof(lispobj), 2)
-
-static lispobj ptrans_list(thing, constant)
-     lispobj thing;
-     boolean constant;
-{
-    struct cons *old, *new, *orig;
-    int length;
-
-    if (constant)
-        orig = (struct cons *)read_only_free;
-    else
-        orig = (struct cons *)static_free;
-    length = 0;
-
-    do {
-        /* Allocate a new cons cell. */
-        old = (struct cons *)PTR(thing);
-        if (constant) {
-            new = (struct cons *)read_only_free;
-            read_only_free += WORDS_PER_CONS;
-        }
-        else {
-            new = (struct cons *)static_free;
-            static_free += WORDS_PER_CONS;
-        }
-
-        /* Copy the cons cell and keep a pointer to the cdr. */
-        new->car = old->car;
-        thing = new->cdr = old->cdr;
-
-        /* Set up the forwarding pointer. */
-        *(lispobj *)old = ((lispobj)new) | type_ListPointer;
-
-        /* And count this cell. */
-        length++;
-    } while (LowtagOf(thing) == type_ListPointer &&
-             dynamic_pointer_p(thing) &&
-             !(forwarding_pointer_p(*(lispobj *)PTR(thing))));
-
-    /* Scavenge the list we just copied. */
-    pscav(orig, length * WORDS_PER_CONS, constant);
-
-    return ((lispobj)orig) | type_ListPointer;
-}
-
-static lispobj ptrans_otherptr(thing, header, constant)
-     lispobj thing, header;
-     boolean constant;
-{
-    switch (TypeOf(header)) {
-      case type_Bignum:
-      case type_SingleFloat:
-      case type_DoubleFloat:
-      case type_Sap:
-        return ptrans_unboxed(thing, header);
-
-      case type_Ratio:
-      case type_Complex:
-      case type_SimpleArray:
-      case type_ComplexString:
-      case type_ComplexVector:
-      case type_ComplexArray:
-        return ptrans_boxed(thing, header, constant);
-
-      case type_ValueCellHeader:
-      case type_WeakPointer:
-        return ptrans_boxed(thing, header, FALSE);
-
-      case type_SymbolHeader:
-        return ptrans_boxed(thing, header, FALSE);
-
-      case type_SimpleString:
-        return ptrans_vector(thing, 8, 1, FALSE, constant);
-
-      case type_SimpleBitVector:
-        return ptrans_vector(thing, 1, 0, FALSE, constant);
-
-      case type_SimpleVector:
-        return ptrans_vector(thing, 32, 0, TRUE, constant);
-
-      case type_SimpleArrayUnsignedByte2:
-        return ptrans_vector(thing, 2, 0, FALSE, constant);
-
-      case type_SimpleArrayUnsignedByte4:
-        return ptrans_vector(thing, 4, 0, FALSE, constant);
-
-      case type_SimpleArrayUnsignedByte8:
-        return ptrans_vector(thing, 8, 0, FALSE, constant);
-
-      case type_SimpleArrayUnsignedByte16:
-        return ptrans_vector(thing, 16, 0, FALSE, constant);
-
-      case type_SimpleArrayUnsignedByte32:
-        return ptrans_vector(thing, 32, 0, FALSE, constant);
-
-      case type_SimpleArraySingleFloat:
-        return ptrans_vector(thing, 32, 0, FALSE, constant);
-
-      case type_SimpleArrayDoubleFloat:
-        return ptrans_vector(thing, 64, 0, FALSE, constant);
-
-      case type_CodeHeader:
-        return ptrans_code(thing);
-
-      case type_ReturnPcHeader:
-        return ptrans_returnpc(thing, header);
-
-      case type_Fdefn:
-	return ptrans_fdefn(thing, header);
-
-      default:
-        /* Should only come across other pointers to the above stuff. */
-        gc_abort();
-    }
-}
-
-static int pscav_fdefn(fdefn)
-     struct fdefn *fdefn;
-{
-    boolean fix_func;
-
-    fix_func = ((char *)(fdefn->function+RAW_ADDR_OFFSET) == fdefn->raw_addr);
-    pscav(&fdefn->name, 1, TRUE);
-    pscav(&fdefn->function, 1, FALSE);
-    if (fix_func)
-        fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET);
-    return sizeof(struct fdefn) / sizeof(lispobj);
-}
-
-static lispobj *pscav(addr, nwords, constant)
-     lispobj *addr;
-     int nwords;
-     boolean constant;
-{
-    lispobj thing, *thingp, header;
-    int count;
-    struct vector *vector;
-
-    while (nwords > 0) {
-        thing = *addr;
-        if (Pointerp(thing)) {
-            /* It's a pointer.  Is it something we might have to move? */
-            if (dynamic_pointer_p(thing)) {
-                /* Maybe.  Have we already moved it? */
-                thingp = (lispobj *)PTR(thing);
-                header = *thingp;
-                if (Pointerp(header) && forwarding_pointer_p(header))
-                    /* Yep, so just copy the forwarding pointer. */
-                    thing = header;
-                else {
-                    /* Nope, copy the object. */
-                    switch (LowtagOf(thing)) {
-                      case type_FunctionPointer:
-                        thing = ptrans_func(thing, header, constant);
-                        break;
-                    
-                      case type_ListPointer:
-                        thing = ptrans_list(thing, constant);
-                        break;
-                    
-                      case type_StructurePointer:
-                        thing = ptrans_boxed(thing, header, constant);
-                        break;
-                    
-                      case type_OtherPointer:
-                        thing = ptrans_otherptr(thing, header, constant);
-                        break;
-
-                      default:
-                        /* It was a pointer, but not one of them? */
-                        gc_abort();
-                    }
-                }
-                *addr = thing;
-            }
-            count = 1;
-        }
-        else if (thing & 3) {
-            /* It's an other immediate.  Maybe the header for an unboxed */
-            /* object. */
-            switch (TypeOf(thing)) {
-              case type_Bignum:
-              case type_SingleFloat:
-              case type_DoubleFloat:
-              case type_Sap:
-                /* It's an unboxed simple object. */
-                count = HeaderValue(thing)+1;
-                break;
-
-              case type_SimpleVector:
-                if (HeaderValue(thing) == subtype_VectorValidHashing)
-                    *addr = (subtype_VectorMustRehash<<type_Bits) |
-                        type_SimpleVector;
-                count = 1;
-                break;
-
-              case type_SimpleString:
-                vector = (struct vector *)addr;
-                count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length)+1,4)+2,2);
-                break;
-
-              case type_SimpleBitVector:
-                vector = (struct vector *)addr;
-                count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),32)+2,2);
-                break;
-
-              case type_SimpleArrayUnsignedByte2:
-                vector = (struct vector *)addr;
-                count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),16)+2,2);
-                break;
-
-              case type_SimpleArrayUnsignedByte4:
-                vector = (struct vector *)addr;
-                count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),8)+2,2);
-                break;
-
-              case type_SimpleArrayUnsignedByte8:
-                vector = (struct vector *)addr;
-                count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),4)+2,2);
-                break;
-
-              case type_SimpleArrayUnsignedByte16:
-                vector = (struct vector *)addr;
-                count = CEILING(NWORDS(FIXNUM_TO_INT(vector->length),2)+2,2);
-                break;
-
-              case type_SimpleArrayUnsignedByte32:
-                vector = (struct vector *)addr;
-                count = CEILING(FIXNUM_TO_INT(vector->length)+2,2);
-                break;
-
-              case type_SimpleArraySingleFloat:
-                vector = (struct vector *)addr;
-                count = CEILING(FIXNUM_TO_INT(vector->length)+2,2);
-                break;
-
-              case type_SimpleArrayDoubleFloat:
-                vector = (struct vector *)addr;
-                count = FIXNUM_TO_INT(vector->length)*2+2;
-                break;
-
-              case type_CodeHeader:
-                gc_abort(); /* No code headers in static space */
-                break;
-
-              case type_FunctionHeader:
-              case type_ClosureFunctionHeader:
-              case type_ReturnPcHeader:
-                /* We should never hit any of these, 'cause they occure */
-                /* buried in the middle of code objects. */
-                gc_abort();
-
-              case type_WeakPointer:
-                /* Weak pointers get preserved during purify, 'cause I don't */
-                /* feel like figuring out how to break them. */
-                pscav(addr+1, 2, constant);
-                count = 4;
-                break;
-
-	      case type_Fdefn:
-		/* We have to handle fdefn objects specially, so we can fix */
-		/* up the raw function address. */
-		count = pscav_fdefn((struct fdefn *)addr);
-		break;
-
-              default:
-                count = 1;
-                break;
-            }
-        }
-        else {
-            /* It's a fixnum. */
-            count = 1;
-        }
-            
-        addr += count;
-        nwords -= count;
-    }
-
-    return addr;
-}
-
-
-int purify(static_roots, read_only_roots)
-lispobj static_roots, read_only_roots;
-{
-    lispobj *clean;
-    int count, i;
-    struct later *laters, *next;
-
-#ifdef PRINTNOISE
-    printf("[Doing purification:");
-    fflush(stdout);
-#endif
-
-    if (FIXNUM_TO_INT(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)) != 0) {
-        printf(" Ack! Can't purify interrupt contexts. ");
-        fflush(stdout);
-        return;
-    }
-
-    read_only_end = read_only_free =
-        (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
-    static_end = static_free =
-        (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER);
-
-#ifdef PRINTNOISE
-    printf(" roots");
-    fflush(stdout);
-#endif
-    pscav(&static_roots, 1, FALSE);
-    pscav(&read_only_roots, 1, TRUE);
-
-#ifdef PRINTNOISE
-    printf(" handlers");
-    fflush(stdout);
-#endif
-    pscav((lispobj *) interrupt_handlers,
-          sizeof(interrupt_handlers) / sizeof(lispobj),
-          FALSE);
-
-#ifdef PRINTNOISE
-    printf(" stack");
-    fflush(stdout);
-#endif
-    pscav(control_stack, current_control_stack_pointer - control_stack, FALSE);
-
-#ifdef PRINTNOISE
-    printf(" bindings");
-    fflush(stdout);
-#endif
-#ifndef ibmrt
-    pscav(binding_stack, current_binding_stack_pointer - binding_stack, FALSE);
-#else
-    pscav(binding_stack, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack, FALSE);
-#endif
-
-#ifdef PRINTNOISE
-    printf(" static");
-    fflush(stdout);
-#endif
-    clean = static_space;
-    do {
-        while (clean != static_free)
-            clean = pscav(clean, static_free - clean, FALSE);
-        laters = later_blocks;
-        count = later_count;
-        later_blocks = NULL;
-        later_count = 0;
-        while (laters != NULL) {
-            for (i = 0; i < count; i++) {
-                if (laters->u[i].count == 0)
-                    ;
-                else if (laters->u[i].count <= LATERMAXCOUNT) {
-                    pscav(laters->u[i+1].ptr, laters->u[i].count, TRUE);
-                    i++;
-                }
-                else
-                    pscav(laters->u[i].ptr, 1, TRUE);
-            }
-            next = laters->next;
-            free(laters);
-            laters = next;
-            count = LATERBLOCKSIZE;
-        }
-    } while (clean != static_free || later_blocks != NULL);
-
-
-#ifdef PRINTNOISE
-    printf(" cleanup");
-    fflush(stdout);
-#endif
-    os_zero((os_vm_address_t) current_dynamic_space,
-            (os_vm_size_t) DYNAMIC_SPACE_SIZE);
-
-    /* Zero stack. */
-    os_zero((os_vm_address_t) current_control_stack_pointer,
-            (os_vm_size_t) (CONTROL_STACK_SIZE -
-                            ((current_control_stack_pointer - control_stack) *
-                             sizeof(lispobj))));
-
-#ifndef ibmrt
-    current_dynamic_space_free_pointer = current_dynamic_space;
-#else
-    SetSymbolValue(ALLOCATION_POINTER, (lispobj)current_dynamic_space);
-#endif
-    SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free);
-    SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free);
-
-#ifdef PRINTNOISE
-    printf(" Done.]\n");
-    fflush(stdout);
-#endif
-
-    return 0;
-}
diff --git a/ldb/regnames.c b/ldb/regnames.c
deleted file mode 100644
index 70c576772..000000000
--- a/ldb/regnames.c
+++ /dev/null
@@ -1,5 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/regnames.c,v 1.5 1991/05/24 18:38:02 wlott Exp $ */
-
-#include "lispregs.h"
-
-char *lisp_register_names[] = { REGNAMES, 0 };
diff --git a/ldb/rt-arch.c b/ldb/rt-arch.c
deleted file mode 100644
index 5ce30b300..000000000
--- a/ldb/rt-arch.c
+++ /dev/null
@@ -1,164 +0,0 @@
-#include <stdio.h>
-#include <mach.h>
-#include <sys/file.h>
-#include <sys/types.h>
-#include <sys/mman.h>
-
-#include "ldb.h"
-#include "lisp.h"
-#include "globals.h"
-#include "validate.h"
-#include "os.h"
-#include "arch.h"
-#include "lispregs.h"
-#include "signal.h"
-
-#define FL_NONE 0
-#define FL_FPA 2
-#define FL_AFPA 4
-#define FL_MC68881 1
-
-#define READ_MC68881_FPCR 0xfc3ec001
-#define WRITE_MC68881_FPCR 0xfc024001
-#define MC68881_ZIC 0xfc1c0003
-#define MC68881_PREC_MASK 0xff3f
-#define MC68881_DOUBLE_PREC 0x0080
-
-/* This is only used during arch_init to find out what kind of FP we have. */
-static sigsys_handler(signal, code, scp)
-int signal, code;
-struct sigcontext *scp;
-{
-    return (-1);
-}
-
-char *arch_init()
-{
-    int hw, i, rc;
-    int fs[5];
-    struct sigvec sv, osv;
-
-    /* Set up the state of the floating point hardware.  On the APC, there is
-       the onboard MC68881 which must be dealt with properly.  The signal
-       handling is necessary to be compatible with facilities version
-       of Mach.  */
-
-    sv.sv_handler = sigsys_handler;
-    sv.sv_mask = sigmask(SIGSYS);
-    sv.sv_onstack = FALSE;
-    rc = sigvec(SIGSYS, &sv, &osv);
-    i = 20;
-    rc = syscall(167, fs, &i);
-    if (rc == 0) {
-	i = fs[0];
-	hw = i & 7;
-	if (i & 1) {
-	    *(int *)READ_MC68881_FPCR = (int) &i;
-	    *(int *)MC68881_ZIC = 0;
-	    i = ((i & MC68881_PREC_MASK) | MC68881_DOUBLE_PREC);
-	    *(int *)WRITE_MC68881_FPCR = (int) &i;
-	    if (i & 2)
-		hw = hw & (~2);
-	}
-    }
-    else
-	hw = FL_FPA;
-
-    sigvec(SIGSYS, &osv, &sv);
-
-    switch (hw) {
-      case FL_FPA:
-	fprintf(stderr, "CMUCL only supports the AFPA and the MC68881 floating point options.\n");
-	exit(1);
-      case FL_AFPA:
-	return "eapc.core";
-      case FL_MC68881:
-	return NULL;
-      default:
-	fprintf(stderr, "CMUCL only supports the AFPA and the MC68881 floating point options.\nUse a different machine.\n");
-	exit(1);
-    }
-}
-
-os_vm_address_t arch_get_bad_addr(context)
-struct sigcontext *context;
-{
-    return 0;
-}
-
-void arch_skip_instruction(context)
-struct sigcontext *context;
-{
-    unsigned long pc = context->sc_iar;
-    unsigned long prev_inst = ((unsigned long *)pc)[-1];
-
-    if ((prev_inst >> 24) == 0x89) {
-	short offset = prev_inst & 0xffff;
-	context->sc_pc = pc - 4 + offset;
-    }
-    else
-	context->sc_pc = pc + 4;
-}
-
-static sigtrap_handler(signal, code, context)
-     int signal, code;
-     struct sigcontext *context;
-{
-    switch (*((char *)context->sc_iar)) {
-      case 0xCC:
-	/* trap-immediate instruction. */
-	switch (*((unsigned short *)context->sc_iar+1)) {
-	  case trap_PendingInterrupt:
-	    interrupt_handle_pending(context);
-	    break;
-
-	  case trap_Halt:
-	    crap_out("%primitive halt called; the party is over.\n");
-
-	  case trap_Error:
-	  case trap_Cerror:
-	    interrupt_internal_error(signal, code, context, code==trap_Cerror);
-	    break;
-
-	  case trap_Breakpoint:
-	    sigsetmask(context->sc_mask);
-	    fake_foreign_function_call(context);
-	    handle_breakpoint(signal, code, context);
-	    undo_fake_foreign_function_call(context);
-	    break;
-
-	  case trap_FunctionEndBreakpoint:
-	    sigsetmask(context->sc_mask);
-	    fake_foreign_function_call(context);
-	    handle_function_end_breakpoint(signal, code, context);
-	    undo_fake_foreign_function_call(context);
-	    break;
-
-	  default:
-	    interrupt_handle_now(signal, code, context);
-	    break;
-	}
-	break;
-
-      case 0xBE:
-	/* Trap Less Than instruction. */
-	if (SymbolValue(ALLOCATION_POINTER)>SymbolValue(INTERNAL_GC_TRIGGER)) {
-	    SetSymbolValue(INTERNAL_GC_TRIGGER, fixnum(-1));
-	    interrupt_maybe_gc(context);
-	    context->sc_iar += 2;
-	}
-	else
-	    interrupt_handle_now(signal, code, context);
-	break;
-
-      default:
-	interrupt_handle_now(signal, code, context);
-	break;
-    }
-}
-
-
-void arch_install_interrupt_handlers()
-{
-    interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler);
-}
diff --git a/ldb/rt-assem.s b/ldb/rt-assem.s
deleted file mode 100644
index 3e09f03f2..000000000
--- a/ldb/rt-assem.s
+++ /dev/null
@@ -1,260 +0,0 @@
-	.globl	.oVncs
-	.set	.oVncs,0
-
-#define LANGUAGE_ASSEMBLY
-#include "lispregs.h"
-#include "lisp.h"
-#include "globals.h"
-
-	.text
-	.data	1
-	.globl	_call_into_lisp
-_call_into_lisp:
-	.long	_.call_into_lisp
-	.text
-	.align	1
-	.globl	_.call_into_lisp
-_.call_into_lisp:
-/* Save the callee-saves registers. */
-	stm   	r6,-64(r1)
-/* Put the pointer to our data area where we can use it. */
-	mr    	r14,r0
-/* Move the callers stack pointer into our frame pointer. */
-	mr    	r13,r1
-/* And allocate our frame on the stack. */
-	cal   	r1,-64(r1)
-
-/* Set up the lisp state. */
-	mr	CNAME, r2
-	mr	LEXENV, r3
-	mr	CFP, r4
-	mr	NARGS, r5
-	sli	NARGS, 2
-	get	NULLREG, $NIL
-
-/* No longer in foreign function call. */
-/* Note: the atomic flag should still be set. */
-	lis	A0, 0
-	store	A0, _foreign_function_call_active, NL0
-
-/* Load the rest of lisp state. */
-	load	CSP, _current_control_stack_pointer
-	load	OCFP, _current_control_frame_pointer
-
-/* No longer atomic. */
-	store	A0, PSEUDO_ATOMIC_ATOMIC+SYMBOL_VALUE_OFFSET, NL0
-
-/* Were we interrupted? */
-	load	NL0, PSEUDO_ATOMIC_INTERRUPTED+SYMBOL_VALUE_OFFSET
-	ci	NL0, 0
-	je	1f
-
-	ti	7, r0, trap_PendingInterrupt
-1:
-
-/* Load the args. */
-	l	A0, 0(CFP)
-	l	A1, 4(CFP)
-	l	A2, 8(CFP)
-
-/* Calculate LRA. */
-	get	LRA, $lra+type_OtherPointer
-
-/* Indirect closure */
-	l	CODE, CLOSURE_FUNCTION_OFFSET(LEXENV)
-
-	cal	LIP, FUNCTION_HEADER_CODE_OFFSET(CODE)
-	br	LIP
-
-	.align	3
-lra:
-	.long	type_ReturnPcHeader
-
-/* Blow off any extra values. */
-	cal	CSP, 0(OCFP)	/* We must use a 32-bit instruction here */
-
-/* Save the return value. */
-	mr	r2, A0
-
-/* Turn on pseudo-atomic */
-	store	CFP, PSEUDO_ATOMIC_ATOMIC+SYMBOL_VALUE_OFFSET, r3
-
-/* Store lisp state */
-	store	CSP, _current_control_stack_pointer, r3
-	store	CFP, _current_control_frame_pointer, r3
-
-/* No longer in lisp. */
-	store	CFP, _foreign_function_call_active, r3
-
-/* Were we interrupted? */
-	load	r3, PSEUDO_ATOMIC_INTERRUPTED+SYMBOL_VALUE_OFFSET
-	ci	r3, 0
-	je	1f
-
-/* Yep. */
-	ti	7, r0, trap_PendingInterrupt
-
-1:
-/* Restore callee-saves registers. */
-	lm	r6,0(r1)
-/* Return to C */
-	brx	r15
-/* And reset the stack. */
-	ai	r1,64
-
-/* Noise to keep debuggers happy. */
-	.long	0xDF07DF68
-	.short	0x0110
-
-
-/* Call_into_C
-
-On entry:
- NL0 - addr of fn to call
- NSP[0]...NSP[n-1] - args
- LRA, CODE - must be preserved (and GCed if necessary)
-
-*/
-
-	.text
-	.globl	call_into_c
-call_into_c:
-	/* Build a stack frame. */
-	mr	OCFP, CFP
-	mr	CFP, CSP
-	cal	CSP, 32(CSP)
-	st	OCFP, 0(CFP)
-	st	LRA, 4(CFP)
-	st	CODE, 8(CFP)
-	
-	/* Get the text addr we are supposed to jump to */
-	l	r15, 0(NL0)
-	mr	r0, NL0
-
-	/* Set pseudo-atomic. */
-	store	CFP, PSEUDO_ATOMIC_ATOMIC+SYMBOL_VALUE_OFFSET, r3
-
-	/* Save lisp state. */
-	store	CSP, _current_control_stack_pointer, r2
-	store	CFP, _current_control_frame_pointer, r2
-
-	/* Now in foreign function call land */
-	store	CFP, _foreign_function_call_active, r2
-
-	/* Were we interrupted? */
-	load	r3, PSEUDO_ATOMIC_INTERRUPTED+SYMBOL_VALUE_OFFSET
-	ci	r3, 0
-	je	1f
-
-/* Yep. */
-	ti	7, r0, trap_PendingInterrupt
-
-1:
-	/* Get the first 4 args, and adjust the stack pointer.  We need to */
-	/* adjust the stack pointer because r1 is supposed to point at the */
-	/* 5th argument, not the 1st.  This is easier than trying to fix */
-	/* pack to be able to deal with TNs with a negative offset. */
-	l	r2, 0(r1)
-	l	r3, 4(r1)
-	l	r4, 8(r1)
-	l	r5, 12(r1)
-	cal	r1, 16(r1)
-
-	/* And hit it. */
-	balr	r15, r15
-
-	/* Save the second return value (assuming there is one) */
-	mr	NARGS, OCFP
-
-	/* Clear desriptor regs.  We have to do this before we clear the
-	foreign-function-call-active flag even if we are just going to
-	load the saved value back into the reg to make sure we don't keep
-	ahold of any pointers that have been moved by GC. */
-	lis	CODE, 0
-	lis	CNAME, 0
-	lis	LEXENV, 0
-	lis	LRA, 0
-	lis	A0, 0
-	lis	A1, 0
-	lis	A2, 0
-
-/* No longer in foreign function call. */
-/* Note: the atomic flag should still be set. */
-	lis	A0, 0
-	store	A0, _foreign_function_call_active, OCFP
-
-/* Load the rest of lisp state. */
-	load	CSP, _current_control_stack_pointer
-	load	CFP, _current_control_frame_pointer
-
-/* No longer atomic. */
-	store	A0, PSEUDO_ATOMIC_ATOMIC+SYMBOL_VALUE_OFFSET, OCFP
-
-/* Were we interrupted? */
-	load	OCFP, PSEUDO_ATOMIC_INTERRUPTED+SYMBOL_VALUE_OFFSET
-	ci	OCFP, 0
-	je	1f
-
-	ti	7, r0, trap_PendingInterrupt
-1:
-
-	/* Restore OCFP, LRA & CODE (they may have been GC'ed) */
-	l	OCFP, 0(CFP)
-	l	LRA, 4(CFP)
-	l	CODE, 8(CFP)
-
-	/* Reset the stack. */
-	mr	CSP, CFP
-	mr	CFP, OCFP
-	cal	r1, -16(r1)
-
-	/* Restore the second return value */
-	mr	OCFP, NARGS
-
-	/* And return */
-	cal	LIP, (4-type_OtherPointer)(LRA)
-	br	LIP
-
-
-
-	.text
-	.globl	undefined_tramp
-undefined_tramp:
-	ti	7, r0, trap_Error
-	.byte	4
-	.byte	23
-	.byte	254
-	.byte	43
-	.byte	1
-	.align	2
-
-	.globl	closure_tramp
-closure_tramp:
-        l	LEXENV, SYMBOL_FUNCTION_OFFSET(CNAME)
-        l	CNAME, CLOSURE_FUNCTION_OFFSET(LEXENV)
-        cal	LIP, FUNCTION_HEADER_CODE_OFFSET(CNAME)
-        br	LIP
-
-/*
- * Function-end breakpoint magic.
- */
-	.text
-	.align	2
-	.globl	_function_end_breakpoint_guts
-_function_end_breakpoint_guts:
-	.long	type_ReturnPcHeader
-	b	1f
-	mr	OCFP, CSP
-	inc	CSP, 4
-	lis	NARGS, 4
-	mr	A1, NULLREG
-	mr	A2, NULLREG
-1:
-
-	.globl	_function_end_breakpoint_trap
-_function_end_breakpoint_trap:
-	ti	7, r0, trap_FunctionEndBreakpoint
-	b	1b
-
-	.globl	_function_end_breakpoint_end
-_function_end_breakpoint_end:
diff --git a/ldb/rt-lispregs.h b/ldb/rt-lispregs.h
deleted file mode 100644
index c3254700b..000000000
--- a/ldb/rt-lispregs.h
+++ /dev/null
@@ -1,32 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/rt-lispregs.h,v 1.1 1991/05/24 18:46:09 wlott Exp $ */
-
-#ifdef LANGUAGE_ASSEMBLY
-#define REG(num) r/**/num
-#else
-#define REG(num) num
-#endif
-
-#define NREGS	(16)
-
-#define NARGS	REG(0)
-#define NSP	REG(1)
-#define NL0	REG(2)
-#define OCFP	REG(3)
-#define NFP	REG(4)
-#define CSP	REG(5)
-#define CFP	REG(6)
-#define CODE	REG(7)
-#define NULLREG	REG(8)
-#define CNAME	REG(9)
-#define LEXENV	REG(10)
-#define LRA	REG(11)
-#define A0	REG(12)
-#define A1	REG(13)
-#define A2	REG(14)
-#define LIP	REG(15)
-
-#define REGNAMES \
-	"NARGS",	"NSP",		"NL0",		"OCFP", \
-	"NFP",		"CSP",		"CFP",		"CODE", \
-	"NULL",		"CNAME",	"LEXENV",	"LRA", \
-	"A0",		"A1",		"A2",		"LIP"
diff --git a/ldb/save.c b/ldb/save.c
deleted file mode 100644
index d20f9d11e..000000000
--- a/ldb/save.c
+++ /dev/null
@@ -1,347 +0,0 @@
-#include <stdio.h>
-#include <signal.h>
-#include <sys/file.h>
-
-#include "ldb.h"
-#include "os.h"
-#include "lisp.h"
-#include "core.h"
-#include "globals.h"
-#include "lispregs.h"
-#include "interrupt.h"
-
-#define STACK_SIZE (8*1024)
-
-extern int version;
-
-static FILE *save_file;
-
-/* State that is restored when save returns, and therefore must be setup by either save or restore. */
-
-static boolean return_value;
-static int oldmask;
-static struct sigvec oldsv;
-static struct sigstack oldss;
-
-
-
-static long write_bytes(addr, bytes)
-char *addr;
-long bytes;
-{
-    long count, here, data;
-
-    fflush(save_file);
-    here = ftell(save_file);
-    fseek(save_file, 0, 2);
-    data = (ftell(save_file)+CORE_PAGESIZE-1)&~(CORE_PAGESIZE-1);
-    fseek(save_file, data, 0);
-
-    while (bytes > 0) {
-        count = fwrite(addr, 1, bytes, save_file);
-        if (count > 0) {
-            bytes -= count;
-            addr += count;
-        }
-        else {
-            perror("Error writing to save file");
-            bytes = 0;
-        }
-    }
-    fflush(save_file);
-    fseek(save_file, here, 0);
-    return data/CORE_PAGESIZE - 1;
-}
-
-static void output_space(id, addr, end)
-int id;
-lispobj *addr, *end;
-{
-    int words, bytes, data;
-    static char *names[] = {NULL, "Dynamic", "Static", "Read-Only"};
-
-    putw(id, save_file);
-    words = end - addr;
-    putw(words, save_file);
-
-    bytes = words * sizeof(lispobj);
-
-    printf("Writing %d bytes from the %s space at 0x%08x.\n",
-           bytes, names[id], addr);
-
-    data = write_bytes((char *)addr, bytes);
-
-    putw(data, save_file);
-    putw((os_vm_address_t)((long)addr / CORE_PAGESIZE), save_file);
-    putw((bytes + CORE_PAGESIZE - 1) / CORE_PAGESIZE, save_file);
-}
-
-static long write_stack(name, start, end)
-char *name, *start, *end;
-{
-    long len;
-
-    start = (char *)os_trunc_to_page((os_vm_address_t)start);
-    end = (char *)os_round_up_to_page((os_vm_address_t)end);
-
-    len = end-start;
-
-    printf("Writing %d bytes from the %s stack at 0x%08x.\n", len, name, start);
-
-    return write_bytes(start, len);
-}
-
-static void output_machine_state(context)
-struct sigcontext *context;
-{
-    struct machine_state ms;
-
-    putw(CORE_MACHINE_STATE, save_file);
-    putw(2 + sizeof(ms)/sizeof(long), save_file);
-
-    ms.csp = current_control_stack_pointer;
-    ms.fp = current_control_frame_pointer;
-#ifndef ibmrt
-    ms.bsp = current_binding_stack_pointer;
-#endif
-    ms.number_stack_start = number_stack_start;
-    ms.sigcontext_page = write_bytes((char *)context, sizeof(struct sigcontext));
-    ms.control_stack_page = write_stack("Control",
-       (char *)control_stack,
-       (char *)current_control_stack_pointer);
-#ifndef ibmrt
-    ms.binding_stack_page = write_stack("Binding",
-       (char *)binding_stack,
-       (char *)current_binding_stack_pointer);
-#else
-    ms.binding_stack_page = write_stack("Binding",
-       (char *)binding_stack,
-       (char *)SymbolValue(BINDING_STACK_POINTER));
-#endif
-    ms.number_stack_page = write_stack("Number",
-       (char *)(context->sc_regs[NSP]),
-       number_stack_start);
-
-    fwrite(&ms, sizeof(ms), 1, save_file);
-}
-
-static SIGHDLRTYPE save_handler(signal, code, context)
-int signal, code;
-struct sigcontext *context;
-{
-    if (context->sc_onstack) {
-        printf("Cannot save while executing on a signal stack!\n");
-        return;
-    }
-
-    putw(CORE_MAGIC, save_file);
-
-    putw(CORE_VERSION, save_file);
-    putw(3, save_file);
-    putw(version, save_file);
-
-    putw(CORE_NDIRECTORY, save_file);
-    putw((5*3)+2, save_file);
-
-    output_space(READ_ONLY_SPACE_ID, read_only_space, (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
-    output_space(STATIC_SPACE_ID, static_space, (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER));
-#ifndef ibmrt
-    output_space(DYNAMIC_SPACE_ID, current_dynamic_space, current_dynamic_space_free_pointer);
-#else
-    output_space(DYNAMIC_SPACE_ID, current_dynamic_space, (lispobj *)SymbolValue(ALLOCATION_POINTER));
-#endif
-
-
-    output_machine_state(context);
-
-    putw(CORE_END, save_file);
-    fclose(save_file);
-
-    printf("done.]\n");
-}
-
-extern lispobj save(filename)
-char *filename;
-{
-    int oldmask;
-    struct sigvec oldsv, newsv;
-    struct sigstack oldss, newss;
-    static char signal_stack[STACK_SIZE];
-
-    /* Set the return value. */
-    return_value = TRUE;
-
-    /* Open the file: */
-    unlink(filename);
-    save_file = fopen(filename, "w");
-    if (save_file == NULL) {
-        perror(filename);
-        return;
-    }
-    printf("[Saving current lisp image into %s:\n", filename);
-
-    oldmask = sigblock(sigmask(SIGTERM));
-
-    /* Install the save handler */
-    newsv.sv_handler = save_handler;
-    newsv.sv_mask = 0;
-    newsv.sv_flags = SV_ONSTACK;
-    sigvec(SIGTERM, &newsv, &oldsv);
-    
-    /* Set up the signal stack. */
-    newss.ss_sp = (char *)(((unsigned)signal_stack + STACK_SIZE) & ~7);
-    newss.ss_onstack = 0;
-    sigstack(&newss, &oldss);
-
-    /* Deliver the signal and wait for it to be delivered. */
-    kill(getpid(), SIGTERM);
-
-    sigpause(oldmask);
-
-    /* Restore the state of the world. */
-    sigvec(SIGTERM, &oldsv, NULL);
-    sigstack(&oldss, NULL);
-    sigsetmask(oldmask);
-
-    return return_value;
-}
-
-
-/* State that must be preserved between load and restore. */
-
-static struct sigcontext context;
-static os_vm_address_t number_stack;
-
-
-static os_vm_address_t map_stack(fd, start, end, data_page, name)
-int fd;
-os_vm_address_t start, end;
-long data_page;
-char *name;
-{
-    os_vm_size_t len;
-
-    start = os_trunc_to_page(start);
-    len = os_round_up_to_page(end) - start;
-
-    if (len != 0) {
-        if (start == NULL) {
-            start = os_validate(start, len);
-	    if(start==NULL)
-                fprintf(stderr, "Could not allocate stageing area for the %s stack.\n", name);
-        }
-
-#ifdef PRINTNOISE
-        printf("Mapping %d bytes onto the %s stack at 0x%08x.\n", len, name, start);
-#endif
-        start=os_map(fd, (1+data_page)*CORE_PAGESIZE, start, len);
-    }
-
-    return start;
-}
-
-extern void load(fd, ms)
-int fd;
-struct machine_state *ms;
-{
-    current_control_stack_pointer = ms->csp;
-    current_control_frame_pointer = ms->fp;
-#ifndef ibmrt
-    current_binding_stack_pointer = ms->bsp;
-#endif
-
-    if (ms->number_stack_start > number_stack_start) {
-        fprintf(stderr, "Can't allocate number stack --- probably this is a Sparc 10.\n");
-        fprintf(stderr, "If not, your environment is real big...\n");
-        exit(1);
-    }
-    else
-        number_stack_start = ms->number_stack_start;
-
-    lseek(fd, CORE_PAGESIZE * (1+ms->sigcontext_page), L_SET);
-    read(fd, &context, sizeof(context));
-
-    map_stack(fd,
-              (os_vm_address_t)control_stack,
-              (os_vm_address_t)current_control_stack_pointer,
-              ms->control_stack_page,
-              "Control");
-
-    map_stack(fd,
-              (os_vm_address_t)binding_stack,
-#ifndef ibmrt
-              (os_vm_address_t)current_binding_stack_pointer,
-#else
-	      (os_vm_address_t)SymbolValue(BINDING_STACK_POINTER),
-#endif
-              ms->binding_stack_page,
-              "Binding");
-
-    number_stack = map_stack(fd,
-                             (os_vm_address_t)NULL,
-                             os_round_up_to_page((os_vm_address_t)number_stack_start) - (os_vm_address_t)context.sc_regs[NSP],
-                             ms->number_stack_page,
-                             "Number");
-}
-
-static SIGHDLRTYPE restore_handler(signal, code, old_context)
-int signal, code;
-struct sigcontext *old_context;
-{
-    os_vm_size_t len;
-    os_vm_address_t nsp;
-
-    /* We have to move the number stack into place. */
-    nsp = os_trunc_to_page((os_vm_address_t)context.sc_regs[NSP]);
-    len = (os_vm_address_t)number_stack_start - nsp;
-#ifdef PRINTNOISE
-    printf("Moving the number stack from 0x%08x to 0x%08x.\n", number_stack, nsp);
-#endif
-    bcopy(number_stack, nsp, len);
-
-    os_invalidate(number_stack, os_round_up_to_page(len));
-
-#ifndef ibmrt
-    sigreturn(&context);
-
-    /* We should not get here. */
-#else
-    bcopy(&context, old_context, sizeof(context));
-#endif
-}
-
-
-extern void restore()
-{
-    struct sigvec newsv;
-    struct sigstack newss;
-    static char signal_stack[STACK_SIZE];
-
-    /* Set the return value. */
-    return_value = 0;
-
-    /* Block the signal. */
-    oldmask = sigblock(sigmask(SIGTERM));
-
-    /* Install the handler */
-    newsv.sv_handler = restore_handler;
-    newsv.sv_mask = 0;
-    newsv.sv_flags = SV_ONSTACK;
-    sigvec(SIGTERM, &newsv, &oldsv);
-    
-    /* Set up the signal stack. */
-    newss.ss_sp = (char *)(((unsigned)signal_stack + STACK_SIZE) & ~7);
-    newss.ss_onstack = 0;
-    sigstack(&newss, &oldss);
-
-    /* Deliver the signal and wait for it to be delivered. */
-    kill(getpid(), SIGTERM);
-    sigpause(oldmask);
-
-    /* We should never get here. */
-    sigvec(SIGTERM, &oldsv, NULL);
-    sigstack(&oldss, NULL);
-    sigsetmask(oldmask);
-
-    fprintf(stderr, "Hm, tried to restore, but nothing happened.\n");
-}
diff --git a/ldb/search.c b/ldb/search.c
deleted file mode 100644
index 97431bee3..000000000
--- a/ldb/search.c
+++ /dev/null
@@ -1,45 +0,0 @@
-
-#include "lisp.h"
-#include "ldb.h"
-
-boolean search_for_type(type, start, count)
-int type;
-lispobj **start;
-int *count;
-{
-    lispobj obj, *addr;
-
-    while ((*count == -1 || (*count > 0)) && valid_addr(*start)) {
-        obj = **start;
-        addr = *start;
-        if (*count != -1)
-            *count -= 2;
-
-        if (TypeOf(obj) == type)
-            return TRUE;
-
-        (*start) += 2;
-    }
-    return FALSE;
-}
-
-
-boolean search_for_symbol(name, start, count)
-char *name;
-lispobj **start;
-int *count;
-{
-    struct symbol *symbol;
-    struct vector *symbol_name;
-
-    while (search_for_type(type_SymbolHeader, start, count)) {
-        symbol = (struct symbol *)PTR((lispobj)*start);
-	if (LowtagOf(symbol->name) == type_OtherPointer) {
-            symbol_name = (struct vector *)PTR(symbol->name);
-            if (valid_addr(symbol_name) && TypeOf(symbol_name->header) == type_SimpleString && strcmp((char *)symbol_name->data, name) == 0)
-                return TRUE;
-	}
-        (*start) += 2;
-    }
-    return FALSE;
-}
diff --git a/ldb/signal.h b/ldb/signal.h
deleted file mode 100644
index a9c77a488..000000000
--- a/ldb/signal.h
+++ /dev/null
@@ -1,32 +0,0 @@
-#ifndef _SIGNAL_H_
-#define _SIGNAL_H_
-
-#include </usr/include/signal.h>
-
-#ifdef sparc
-
-/* We need to fake the existance of a reasonable sigcontext */
-struct lisp_sigcontext {
-    /* This part is identical to the real sigcontext. */
-    int     sc_onstack;		/* sigstack state to restore */
-    int     sc_mask;		/* signal mask to restore */
-    int     sc_sp;                  /* sp to restore */
-    int     sc_pc;                  /* pc to retore */
-    int     sc_npc;                 /* next pc to restore */
-    int     sc_psr;                 /* psr to restore */
-    int     sc_g1;                  /* register that must be restored */
-    int     sc_o0;
-
-    /* And this is the part we have added. */
-    unsigned long sc_regs[32];
-    unsigned long sc_fpregs[32];
-    long sc_y;
-    unsigned long sc_fsr;
-};
-
-#define sigcontext lisp_sigcontext
-
-#endif sparc
-
-
-#endif _SIGNAL_H_
diff --git a/ldb/socket.c b/ldb/socket.c
deleted file mode 100644
index f8c843ebc..000000000
--- a/ldb/socket.c
+++ /dev/null
@@ -1,144 +0,0 @@
-/* Copyright    Massachusetts Institute of Technology    1988	*/
-/*
- * THIS IS AN OS DEPENDENT FILE! It should work on 4.2BSD derived
- * systems.  VMS and System V should plan to have their own version.
- *
- * This code was cribbed from lib/X/XConnDis.c.
- * Compile using   
- *                    % cc -c socket.c -DUNIXCONN
- */
-
-#include <stdio.h>
-#include <X11/Xos.h>
-#include <X11/Xproto.h>
-#include <errno.h>
-#include <netinet/in.h>
-#include <sys/ioctl.h>
-#include <netdb.h> 
-#include <sys/socket.h>
-#ifndef hpux
-#include <netinet/tcp.h>
-#endif
-
-extern int errno;		/* Certain (broken) OS's don't have this */
-				/* decl in errno.h */
-
-#ifdef UNIXCONN
-#include <sys/un.h>
-#ifndef X_UNIX_PATH
-#ifdef hpux
-#define X_UNIX_PATH "/usr/spool/sockets/X11/"
-#define OLD_UNIX_PATH "/tmp/.X11-unix/X"
-#else /* hpux */
-#define X_UNIX_PATH "/tmp/.X11-unix/X"
-#endif /* hpux */
-#endif /* X_UNIX_PATH */
-#endif /* UNIXCONN */
-void bcopy();
-
-/* 
- * Attempts to connect to server, given host and display. Returns file 
- * descriptor (network socket) or 0 if connection fails.
- */
-
-int connect_to_server (host, display)
-     char *host;
-     int display;
-{
-  struct sockaddr_in inaddr;	/* INET socket address. */
-  struct sockaddr *addr;		/* address to connect to */
-  struct hostent *host_ptr;
-  int addrlen;			/* length of address */
-#ifdef UNIXCONN
-  struct sockaddr_un unaddr;	/* UNIX socket address. */
-#endif
-  extern char *getenv();
-  extern struct hostent *gethostbyname();
-  int fd;				/* Network socket */
-  {
-#ifdef UNIXCONN
-    if ((host[0] == '\0') || (strcmp("unix", host) == 0)) {
-	/* Connect locally using Unix domain. */
-	unaddr.sun_family = AF_UNIX;
-	(void) strcpy(unaddr.sun_path, X_UNIX_PATH);
-	sprintf(&unaddr.sun_path[strlen(unaddr.sun_path)], "%d", display);
-	addr = (struct sockaddr *) &unaddr;
-	addrlen = strlen(unaddr.sun_path) + 2;
-	/*
-	 * Open the network connection.
-	 */
-	if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0) {
-#ifdef hpux /* this is disgusting */  /* cribbed from X11R4 xlib source */
-  	    if (errno == ENOENT) {  /* No such file or directory */
-	      sprintf(unaddr.sun_path, "%s%d", OLD_UNIX_PATH, display);
-              addrlen = strlen(unaddr.sun_path) + 2;
-              if ((fd = socket ((int) addr->sa_family, SOCK_STREAM, 0)) < 0)
-                return(-1);     /* errno set by most recent system call. */
-	    } else 
-#endif /* hpux */
-	    return(-1);	    /* errno set by system call. */
-        }
-    } else 
-#endif /* UNIXCONN */
-    {
-      /* Get the statistics on the specified host. */
-      if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) 
-	{
-	  if ((host_ptr = gethostbyname(host)) == NULL) 
-	    {
-	      /* No such host! */
-	      errno = EINVAL;
-	      return(-1);
-	    }
-	  /* Check the address type for an internet host. */
-	  if (host_ptr->h_addrtype != AF_INET) 
-	    {
-	      /* Not an Internet host! */
-	      errno = EPROTOTYPE;
-	      return(-1);
-	    }
-	  /* Set up the socket data. */
-	  inaddr.sin_family = host_ptr->h_addrtype;
-	  bcopy((char *)host_ptr->h_addr, 
-		(char *)&inaddr.sin_addr, 
-		sizeof(inaddr.sin_addr));
-	} 
-      else 
-	{
-	  inaddr.sin_family = AF_INET;
-	}
-      addr = (struct sockaddr *) &inaddr;
-      addrlen = sizeof (struct sockaddr_in);
-      inaddr.sin_port = display + X_TCP_PORT;
-      inaddr.sin_port = htons(inaddr.sin_port);
-      /*
-       * Open the network connection.
-       */
-      if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0){
-	return(-1);	    /* errno set by system call. */}
-      /* make sure to turn off TCP coalescence */
-#ifdef TCP_NODELAY
-      {
-	int mi = 1;
-	setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int));
-      }
-#endif
-    }
-
-    /*
-     * Changed 9/89 to retry connection if system call was interrupted.  This
-     * is necessary for multiprocessing implementations that use timers,
-     * since the timer results in a SIGALRM.	-- jdi
-     */
-    while (connect(fd, addr, addrlen) == -1) {
-	if (errno != EINTR) {
-  	    (void) close (fd);
-  	    return(-1); 	    /* errno set by system call. */
-	}
-      }
-  }
-  /*
-   * Return the id if the connection succeeded.
-   */
-  return(fd);
-}
diff --git a/ldb/sparc-arch.c b/ldb/sparc-arch.c
deleted file mode 100644
index db76c7326..000000000
--- a/ldb/sparc-arch.c
+++ /dev/null
@@ -1,201 +0,0 @@
-#include <machine/trap.h>
-
-#include "ldb.h"
-#include "lisp.h"
-#include "globals.h"
-#include "validate.h"
-#include "os.h"
-#include "arch.h"
-#include "lispregs.h"
-#include "signal.h"
-
-char *arch_init()
-{
-    return NULL;
-}
-
-os_vm_address_t arch_get_bad_addr(context)
-struct sigcontext *context;
-{
-    unsigned long badinst;
-    int rs1;
-
-    /* On the sparc, we have to decode the instruction. */
-
-    /* Make sure it's not the pc thats bogus, and that it was lisp code */
-    /* that caused the fault. */
-    if ((context->sc_pc & 3) != 0 ||
-	((context->sc_pc < READ_ONLY_SPACE_START ||
-	  context->sc_pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) &&
-	 ((lispobj *)context->sc_pc < current_dynamic_space &&
-	  (lispobj *)context->sc_pc >=
-	      current_dynamic_space + DYNAMIC_SPACE_SIZE)))
-	return NULL;
-
-    badinst = *(unsigned long *)context->sc_pc;
-
-    if ((badinst >> 30) != 3)
-	/* All load/store instructions have op = 11 (binary) */
-	return NULL;
-
-    rs1 = (badinst>>14)&0x1f;
-
-    if (badinst & (1<<13)) {
-	/* r[rs1] + simm(13) */
-	int simm13 = badinst & 0x1fff;
-
-	if (simm13 & (1<<12))
-	    simm13 |= -1<<13;
-
-	return (os_vm_address_t)(context->sc_regs[rs1] + simm13);
-    }
-    else {
-	/* r[rs1] + r[rs2] */
-	int rs2 = badinst & 0x1f;
-
-	return (os_vm_address_t)(context->sc_regs[rs1] + context->sc_regs[rs2]);
-    }
-
-}
-
-void arch_skip_instruction(context)
-struct sigcontext *context;
-{
-    /* Skip the offending instruction */
-    context->sc_pc = context->sc_npc;
-    context->sc_npc += 4;
-}
-
-static void sigill_handler(signal, code, context)
-int signal, code;
-struct sigcontext *context;
-{
-    int badinst;
-
-    if (code == T_UNIMP_INSTR) {
-	int trap;
-
-	trap = *(unsigned long *)(context->sc_pc) & 0x3fffff;
-
-	switch (trap) {
-	  case trap_PendingInterrupt:
-	    interrupt_handle_pending(context);
-	    break;
-
-	  case trap_Halt:
-	    crap_out("%primitive halt called; the party is over.\n");
-
-	  case trap_Error:
-	  case trap_Cerror:
-	    interrupt_internal_error(signal, code, context, trap == trap_Cerror);
-	    break;
-
-	  case trap_Breakpoint:
-	    sigsetmask(context->sc_mask);
-	    fake_foreign_function_call(context);
-	    handle_breakpoint(signal, code, context);
-	    undo_fake_foreign_function_call(context);
-	    break;
-
-	  case trap_FunctionEndBreakpoint:
-	    sigsetmask(context->sc_mask);
-	    fake_foreign_function_call(context);
-	    handle_function_end_breakpoint(signal, code, context);
-	    undo_fake_foreign_function_call(context);
-	    context->sc_npc = context->sc_pc + 4;
-	    break;
-
-	  default:
-	    interrupt_handle_now(signal, code, context);
-	    break;
-	}
-    }
-    else if (code >= T_SOFTWARE_TRAP + 16 & code < T_SOFTWARE_TRAP + 32)
-	interrupt_internal_error(signal, code, context, FALSE);
-    else
-	interrupt_handle_now(signal, code, context);
-}
-
-static void sigemt_handler(signal, code, context)
-     int signal, code;
-     struct sigcontext *context;
-{
-    unsigned long badinst;
-    boolean subtract, immed;
-    int rd, rs1, op1, rs2, op2, result;
-
-    badinst = *(unsigned long *)context->sc_pc;
-    if ((badinst >> 30) != 2 || ((badinst >> 20) & 0x1f) != 0x11) {
-	/* It wasn't a tagged add.  Pass the signal into lisp. */
-	interrupt_handle_now(signal, code, context);
-	return;
-    }
-	
-    /* Extract the parts of the inst. */
-    subtract = badinst & (1<<19);
-    rs1 = (badinst>>14) & 0x1f;
-    op1 = context->sc_regs[rs1];
-
-    /* If the first arg is $ALLOC then it is really a signal-pending note */
-    /* for the pseudo-atomic noise. */
-    if (rs1 == ALLOC) {
-	/* Perform the op anyway. */
-	op2 = badinst & 0x1fff;
-	if (op2 & (1<<12))
-	    op2 |= -1<<13;
-	if (subtract)
-	    result = op1 - op2;
-	else
-	    result = op1 + op2;
-	context->sc_regs[ALLOC] = result;
-	interrupt_handle_pending(context);
-	return;
-    }
-
-    if ((op1 & 3) != 0) {
-	/* The first arg wan't a fixnum. */
-	interrupt_internal_error(signal, code, context, FALSE);
-	return;
-    }
-
-    if (immed = badinst & (1<<13)) {
-	op2 = badinst & 0x1fff;
-	if (op2 & (1<<12))
-	    op2 |= -1<<13;
-    }
-    else {
-	rs2 = badinst & 0x1f;
-	op2 = context->sc_regs[rs2];
-    }
-
-    if ((op2 & 3) != 0) {
-	/* The second arg wan't a fixnum. */
-	interrupt_internal_error(signal, code, context, FALSE);
-	return;
-    }
-
-    rd = (badinst>>25) & 0x1f;
-    if (rd != 0) {
-	/* Don't bother computing the result unless we are going to use it. */
-	if (subtract)
-	    result = (op1>>2) - (op2>>2);
-	else
-	    result = (op1>>2) + (op2>>2);
-
-        current_dynamic_space_free_pointer =
-            (lispobj *) context->sc_regs[ALLOC];
-
-	context->sc_regs[rd] = alloc_number(result);
-
-	context->sc_regs[ALLOC] =
-	    (unsigned long) current_dynamic_space_free_pointer;
-    }
-
-    arch_skip_instruction(context);
-}
-
-void arch_install_interrupt_handlers()
-{
-    interrupt_install_low_level_handler(SIGILL,sigill_handler);
-    interrupt_install_low_level_handler(SIGEMT,sigemt_handler);
-}
diff --git a/ldb/sparc-assem.s b/ldb/sparc-assem.s
deleted file mode 100644
index a52b54180..000000000
--- a/ldb/sparc-assem.s
+++ /dev/null
@@ -1,475 +0,0 @@
-
-#include <machine/asm_linkage.h>
-#include <machine/psl.h>
-#include <machine/trap.h>
-
-#define LANGUAGE_ASSEMBLY
-#include "lispregs.h"
-#include "lisp.h"
-#include "globals.h"
-
-#define load(sym, reg) \
-        sethi   %hi(NAME(sym)), reg;    ld      [reg+%lo(NAME(sym))], reg
-#define store(reg, sym) \
-        sethi %hi(NAME(sym)), L0; st reg, [L0+%lo(NAME(sym))]
-
-
-#define FRAMESIZE (SA(WINDOWSIZE+4))
-
-        .seg    "text"
-        .global NAME(call_into_lisp)
-NAME(call_into_lisp):
-        save    %sp, -FRAMESIZE, %sp
-
-	/* Flush all of C's register windows to the stack. */
-	ta	ST_FLUSH_WINDOWS
-
-        /* Save the return address. */
-        st      %i7, [%fp-4]
-
-        /* Clear the descriptor regs. */
-        mov     ZERO, A0
-        mov     ZERO, A1
-        mov     ZERO, A2
-        mov     ZERO, A3
-        mov     ZERO, A4
-        mov     ZERO, A5
-        mov     ZERO, OCFP
-        mov     ZERO, LRA
-        mov     ZERO, L2
-        mov     ZERO, CODE
-
-        /* Establish NIL */
-        set     NIL, NULLREG
-
-	/* Set the pseudo-atomic flag. */
-	set	4, ALLOC
-
-	/* Turn off foreign function call. */
-        sethi   %hi(NAME(foreign_function_call_active)), NL0
-        st      ZERO, [NL0+%lo(NAME(foreign_function_call_active))]
-
-        /* Load the rest of lisp state. */
-        load(current_dynamic_space_free_pointer, NL0)
-	add	NL0, ALLOC, ALLOC
-        load(current_binding_stack_pointer, BSP)
-        load(current_control_stack_pointer, CSP)
-        load(current_control_frame_pointer, OCFP)
-
-        /* No longer atomic, and check for interrupt. */
-	tsubcctv	ALLOC, 4, ALLOC
-
-        /* Pass in the args. */
-        /* Note: CNAME and LEXENV already hold the correct values. */
-        mov     %i2, CFP
-        sll     %i3, 2, NARGS
-        ld      [CFP+0], A0
-        ld      [CFP+4], A1
-        ld      [CFP+8], A2
-        ld      [CFP+12], A3
-        ld      [CFP+16], A4
-        ld      [CFP+20], A5
-
-        /* Calculate LRA */
-        set     lra + type_OtherPointer, LRA
-
-        /* Indirect closure */
-        ld      [LEXENV+CLOSURE_FUNCTION_OFFSET], CODE
-
-        jmp     CODE+FUNCTION_HEADER_CODE_OFFSET
-        nop
-
-        .align  8
-lra:
-        .word   type_ReturnPcHeader
-
-        /* Blow off any extra values. */
-        mov     OCFP, CSP
-        nop
-
-        /* Return the one value. */
-        mov     A0, %i0
-
-        /* Turn on pseudo_atomic */
-	add	ALLOC, 4, ALLOC
-
-        /* Store LISP state */
-	andn	ALLOC, 7, NL1
-        store(NL1,current_dynamic_space_free_pointer)
-        store(BSP,current_binding_stack_pointer)
-        store(CSP,current_control_stack_pointer)
-        store(CFP,current_control_frame_pointer)
-
-        /* No longer in Lisp. */
-        store(NL1,foreign_function_call_active)
-
-        /* Were we interrupted? */
-	tsubcctv	ALLOC, 4, ALLOC
-
-        /* Back to C we go. */
-	ld	[%sp+FRAMESIZE-4], %i7
-        ret
-        restore	%sp, FRAMESIZE, %sp
-
-
-
-        .global _call_into_c
-_call_into_c:
-        /* Build a lisp stack frame */
-        mov     CFP, OCFP
-        mov     CSP, CFP
-        add     CSP, 32, CSP
-        st      OCFP, [CFP]
-        st      CODE, [CFP+8]
-
-        /* Turn on pseudo-atomic. */
-	add	ALLOC, 4, ALLOC
-
-	/* Convert the return address to an offset and save it on the stack. */
-	sub	LIP, CODE, L0
-	add	L0, type_OtherPointer, L0
-	st	L0, [CFP+4]
-
-        /* Store LISP state */
-	andn	ALLOC, 7, L1
-        store(L1,current_dynamic_space_free_pointer)
-        store(BSP,current_binding_stack_pointer)
-        store(CSP,current_control_stack_pointer)
-        store(CFP,current_control_frame_pointer)
-
-        /* No longer in Lisp. */
-        store(CSP,foreign_function_call_active)
-
-        /* Were we interrupted? */
-	tsubcctv	ALLOC, 4, ALLOC
-
-        /* Into C we go. */
-        call    CFUNC
-        nop
-
-        /* Re-establish NIL */
-        set     NIL, NULLREG
-
-	/* Atomic. */
-	set	4, ALLOC
-
-        /* No longer in foreign function call. */
-        sethi   %hi(NAME(foreign_function_call_active)), NL1
-        st      ZERO, [NL1+%lo(NAME(foreign_function_call_active))]
-
-        /* Load the rest of lisp state. */
-        load(current_dynamic_space_free_pointer, NL1)
-	add	NL1, ALLOC, ALLOC
-        load(current_binding_stack_pointer, BSP)
-        load(current_control_stack_pointer, CSP)
-        load(current_control_frame_pointer, CFP)
-
-	/* Get the return address back. */
-	ld	[CFP+4], LIP
-	ld	[CFP+8], CODE
-	add	LIP, CODE, LIP
-	sub	LIP, type_OtherPointer, LIP
-
-        /* No longer atomic. */
-	tsubcctv	ALLOC, 4, ALLOC	
-
-        /* Reset the lisp stack. */
-        /* Note: OCFP is in one of the locals, it gets preserved across C. */
-        mov     CFP, CSP
-        mov     OCFP, CFP
-
-        /* And back into lisp. */
-        ret
-        nop
-
-
-
-
-        .global _undefined_tramp
-        .align  8
-        .byte   0
-_undefined_tramp:
-        .byte   0, 0, type_FunctionHeader
-        .word   _undefined_tramp
-        .word   NIL
-        .word   NIL
-        .word   NIL
-        .word   NIL
-
-	b	1f
-        unimp   trap_Cerror
-	.byte	4, 23, 254, 12, 3
-	.align	4
-1:
-	ld	[CNAME+FDEFN_RAW_ADDR_OFFSET], CODE
-	jmp	CODE+FUNCTION_HEADER_CODE_OFFSET
-	nop
-
-	.global	_closure_tramp
-	.align	8
-	.byte	0
-_closure_tramp:
-	.byte	0, 0, type_FunctionHeader
-	.word	_closure_tramp
-	.word	NIL
-        .word   NIL
-	.word	NIL
-	.word	NIL
-
-	ld	[CNAME+FDEFN_FUNCTION_OFFSET], LEXENV
-	ld	[LEXENV+CLOSURE_FUNCTION_OFFSET], CODE
-	jmp	CODE+FUNCTION_HEADER_CODE_OFFSET
-	nop
-
-
-
-/*
- * Function-end breakpoint magic.
- */
-
-	.text
-	.align	8
-	.global	_function_end_breakpoint_guts
-_function_end_breakpoint_guts:
-	.word	type_ReturnPcHeader
-	b	1f
-	nop
-	mov	CSP, OCFP
-	add	4, CSP, CSP
-	mov	4, NARGS
-	mov	NULLREG, A1
-	mov	NULLREG, A2
-	mov	NULLREG, A3
-	mov	NULLREG, A4
-	mov	NULLREG, A5
-1:
-
-	.global	_function_end_breakpoint_trap
-_function_end_breakpoint_trap:
-	unimp	trap_FunctionEndBreakpoint
-	b	1b
-	nop
-
-	.global	_function_end_breakpoint_end
-_function_end_breakpoint_end:
-
-
-
-
-/****************************************************************\
-
-We need our own version of sigtramp.
-
-\****************************************************************/
-
-	.global	__sigtramp, __sigfunc
-__sigtramp:
-	!
-	! On entry sp points to:
-	! 	0 - 63: window save area
-	!	64: signal number
-	!	68: signal code
-	!	72: pointer to sigcontext
-	!	76: addr parameter
-	!
-	! A sigcontext looks like:
-	!	00: on signal stack flag
-	!	04: old signal mask
-	!	08: old sp
-	!	12: old pc
-	!	16: old npc
-	!	20: old psr
-	!	24: old g1
-	!	28: old o0
-	!
-        ! Out sigcontext has the following added:
-        !       32: regs[32]
-        !       160: fpregs[32]
-        !       288: y
-        !       292: fsr
-        !
-        ! After we allocate space for the new sigcontext, the stack looks like:
-        !       < window save area, etc >
-        !       SCOFF: start of generic sigcontext.
-        !       IREGSOFF: start of lisp sigcontext.
-        !       SIGNUM: signal number
-        !       CODE: signal code
-        !       OSCP: pointer to orig sigcontext
-        !       ADDR: addr parameter (which isn't supplied by the kernel)
-
-#define SCOFF SA(MINFRAME)
-#define IREGSOFF SCOFF+32
-#define FPREGSOFF IREGSOFF+(32*4)
-#define YOFF FPREGSOFF+(32*4)
-#define FSROFF YOFF+4
-#define SCSIZE SA(32+(32*4)+(32*4)+4+4)
-#define SIGNUMOFF SCOFF+SCSIZE
-#define CODEOFF SCOFF+SCSIZE+4
-#define ADDROFF SCOFF+SCSIZE+12
-
-#ifdef MACH
-#define OSCOFF ADDROFF
-#else
-#define OSCOFF SCOFF+SCSIZE+16
-#endif
-
-        ! Allocate space for our sigcontext.
-        sub     %sp, SCSIZE+SA(MINFRAME)-64, %sp
-
-        ! Save integer registers.
-        ! Note: the globals and outs are good, but the locals and ins have
-        ! been trashed.  But luckly, they have been saved on the stack.
-        ! So we need to extract the saved stack pointer from the sigcontext
-        ! to determine where they are.
-        std     %g0, [%sp+IREGSOFF]
-        std     %g2, [%sp+IREGSOFF+8]
-        std     %g4, [%sp+IREGSOFF+16]
-        std     %g6, [%sp+IREGSOFF+24]
-        std     %o0, [%sp+IREGSOFF+32]
-        ld      [%sp + OSCOFF+8], %o0
-        std     %o2, [%sp+IREGSOFF+40]
-        std     %o4, [%sp+IREGSOFF+48]
-        st      %o0, [%sp+IREGSOFF+56]
-        st      %o7, [%sp+IREGSOFF+60]
-
-        ldd     [%o0], %l0
-        ldd     [%o0+8], %l2
-        ldd     [%o0+16], %l4
-        ldd     [%o0+24], %l6
-        ldd     [%o0+32], %i0
-        ldd     [%o0+40], %i2
-        ldd     [%o0+48], %i4
-        ldd     [%o0+56], %i6
-        std     %l0, [%sp+IREGSOFF+64]
-        std     %l2, [%sp+IREGSOFF+72]
-        std     %l4, [%sp+IREGSOFF+80]
-        std     %l6, [%sp+IREGSOFF+88]
-        std     %i0, [%sp+IREGSOFF+96]
-        std     %i2, [%sp+IREGSOFF+104]
-        std     %i4, [%sp+IREGSOFF+112]
-        std     %i6, [%sp+IREGSOFF+120]
-
-        ! Copy the original sigcontext down to our sigcontext.
-        ld      [%sp + OSCOFF], %l0
-        ld      [%sp + OSCOFF+4], %l1
-        ld      [%sp + OSCOFF+8], %l2
-        ld      [%sp + OSCOFF+12], %l3
-        ld      [%sp + OSCOFF+16], %l4
-        ld      [%sp + OSCOFF+20], %l5
-        ld      [%sp + OSCOFF+24], %l6
-        ld      [%sp + OSCOFF+28], %l7
-        std     %l0, [%sp+SCOFF]
-        std     %l2, [%sp+SCOFF+8]
-        std     %l4, [%sp+SCOFF+16]
-        std     %l6, [%sp+SCOFF+24]
-
-        ! Check to see if we need to save the fp regs.
-	set	PSR_EF, %l0
-	mov	%y, %l2			! save y
-	btst	%l0, %l5		! is FPU enabled?
-	bz	1f			! if not skip FPU save
-	st	%l2, [%sp + YOFF]
-
-	std	%f0, [%sp + FPREGSOFF+(0*4)]	! save all fpu registers.
-	std	%f2, [%sp + FPREGSOFF+(2*4)]
-	std	%f4, [%sp + FPREGSOFF+(4*4)]
-	std	%f6, [%sp + FPREGSOFF+(6*4)]
-	std	%f8, [%sp + FPREGSOFF+(8*4)]
-	std	%f10, [%sp + FPREGSOFF+(10*4)]
-	std	%f12, [%sp + FPREGSOFF+(12*4)]
-	std	%f14, [%sp + FPREGSOFF+(14*4)]
-	std	%f16, [%sp + FPREGSOFF+(16*4)]
-	std	%f18, [%sp + FPREGSOFF+(18*4)]
-	std	%f20, [%sp + FPREGSOFF+(20*4)]
-	std	%f22, [%sp + FPREGSOFF+(22*4)]
-	std	%f24, [%sp + FPREGSOFF+(24*4)]
-	std	%f26, [%sp + FPREGSOFF+(26*4)]
-	std	%f28, [%sp + FPREGSOFF+(28*4)]
-	std	%f30, [%sp + FPREGSOFF+(30*4)]
-	st	%fsr, [%sp + FSROFF] ! save old fsr
-1:
-
-	ld	[%sp + SIGNUMOFF], %o0	! get signal number
-	set	__sigfunc, %g1		! get array of function ptrs
-	sll	%o0, 2, %g2		! scale signal number for index
-	ld	[%g1 + %g2], %g1	! get func
-	ld	[%sp + CODEOFF], %o1	! get code
-        add     %sp, SCOFF, %o2         ! compute scp
-	call	%g1			! (*_sigfunc[sig])(sig,code,scp,addr)
-	ld	[%sp + ADDROFF], %o3	! get addr
-
-        ! Recompute scp, and call into _sigreturn
-        add     %sp, SCOFF, %o0
-
-
-        .global _sigreturn
-_sigreturn:
-        ! Move values we can't restore directory into real sigcontext.
-        ld      [%o0+32+(4*1)], %l0     ! g1
-        ld      [%o0+32+(4*8)], %l1     ! o0
-        ld      [%o0+32+(4*14)], %l2    ! sp
-        st      %l0, [%o0+24]
-        st      %l1, [%o0+28]
-        st      %l2, [%o0+8]
-
-	ld	[%o0 + 20], %l2		! get psr
-	set	PSR_EF, %l0
-	ld	[%o0 + 288], %l1        ! restore y
-	btst	%l0, %l2		! is FPU enabled?
-	bz	2f			! if not skip FPU restore
-	mov	%l1, %y
-
-	ldd	[%o0 + 160+(0*4)], %f0	! restore all fpu registers.
-	ldd	[%o0 + 160+(2*4)], %f2
-	ldd	[%o0 + 160+(4*4)], %f4
-	ldd	[%o0 + 160+(6*4)], %f6
-	ldd	[%o0 + 160+(8*4)], %f8
-	ldd	[%o0 + 160+(10*4)], %f10
-	ldd	[%o0 + 160+(12*4)], %f12
-	ldd	[%o0 + 160+(14*4)], %f14
-	ldd	[%o0 + 160+(16*4)], %f16
-	ldd	[%o0 + 160+(18*4)], %f18
-	ldd	[%o0 + 160+(20*4)], %f20
-	ldd	[%o0 + 160+(22*4)], %f22
-	ldd	[%o0 + 160+(24*4)], %f24
-	ldd	[%o0 + 160+(26*4)], %f26
-	ldd	[%o0 + 160+(28*4)], %f28
-	ldd	[%o0 + 160+(30*4)], %f30
-	ld	[%o0 + 160+(33*4)], %fsr	! restore old fsr
-2:
-
-	! The locals and in are restored from the stack, so we have to put
-	! them there.
-	ld	[%o0 + 8], %o1
-        ldd     [%o0 + 32+(16*4)], %l0
-        ldd     [%o0 + 32+(18*4)], %l2
-        ldd     [%o0 + 32+(20*4)], %l4
-        ldd     [%o0 + 32+(22*4)], %l6
-        ldd     [%o0 + 32+(24*4)], %i0
-        ldd     [%o0 + 32+(26*4)], %i2
-        ldd     [%o0 + 32+(28*4)], %i4
-        ldd     [%o0 + 32+(30*4)], %i6
-	std	%l0, [%o1 + (0*4)]
-	std	%l2, [%o1 + (2*4)]
-	std	%l4, [%o1 + (4*4)]
-	std	%l6, [%o1 + (6*4)]
-	std	%i0, [%o1 + (8*4)]
-	std	%i2, [%o1 + (10*4)]
-	std	%i4, [%o1 + (12*4)]
-	std	%i6, [%o1 + (14*4)]
-
-        ! Restore the globals and outs.  Don't restore %g1, %o0, or %sp
-	! 'cause they get restored from the sigcontext.
-        ldd     [%o0 + 32+(2*4)], %g2
-        ldd     [%o0 + 32+(4*4)], %g4
-        ldd     [%o0 + 32+(6*4)], %g6
-        ld      [%o0 + 32+(9*4)], %o1
-        ldd     [%o0 + 32+(10*4)], %o2
-        ldd     [%o0 + 32+(12*4)], %o4
-        ld      [%o0 + 32+(15*4)], %o7
-
-	set	139, %g1		! sigcleanup system call
-	t	0
-	unimp	0			! just in case it returns
-	/*NOTREACHED*/
-
diff --git a/ldb/sparc-lispregs.h b/ldb/sparc-lispregs.h
deleted file mode 100644
index dc9bad423..000000000
--- a/ldb/sparc-lispregs.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/sparc-lispregs.h,v 1.1 1991/05/24 18:45:57 wlott Exp $ */
-
-#ifdef LANGUAGE_ASSEMBLY
-
-#define GREG(num) %g/**/num
-#define OREG(num) %o/**/num
-#define LREG(num) %l/**/num
-#define IREG(num) %i/**/num
-
-#else
-
-#define GREG(num) (num)
-#define OREG(num) ((num)+8)
-#define LREG(num) ((num)+16)
-#define IREG(num) ((num)+24)
-
-#endif
-
-#define NREGS	(32)
-
-#define ZERO	GREG(0)
-#define ALLOC	GREG(1)
-#define NULLREG	GREG(2)
-#define CSP	GREG(3)
-#define CFP	GREG(4)
-#define BSP	GREG(5)
-#define NFP	GREG(6)
-#define CFUNC	GREG(7)
-
-#define NL0	OREG(0)
-#define NL1	OREG(1)
-#define NL2	OREG(2)
-#define NL3	OREG(3)
-#define NL4	OREG(4)
-#define NL5	OREG(5)
-#define NSP	OREG(6)
-#define NARGS	OREG(7)
-
-#define A0	LREG(0)
-#define A1	LREG(1)
-#define A2	LREG(2)
-#define A3	LREG(3)
-#define A4	LREG(4)
-#define A5	LREG(5)
-#define OCFP	LREG(6)
-#define LRA	LREG(7)
-
-#define CNAME	IREG(0)
-#define LEXENV	IREG(1)
-#define L0	IREG(2)
-#define L1	IREG(3)
-#define L2	IREG(4)
-#define CODE	IREG(5)
-#define LIP	IREG(7)
-
-#define REGNAMES \
-	"ZERO",		"ALLOC",	"NULL",		"CSP", \
-	"CFP",		"BSP",		"NFP",		"CFUNC", \
-        "NL0",		"NL1",		"NL2",		"NL3", \
-        "NL4",		"NL5",		"NSP",		"NARGS", \
-        "A0",		"A1",		"A2",		"A3", \
-        "A4",		"A5",		"OCFP",		"LRA", \
-        "CNAME",	"LEXENV",	"L0",		"L1", \
-        "L2",		"CODE",		"???",		"LIP"
diff --git a/ldb/sunos-os.c b/ldb/sunos-os.c
deleted file mode 100644
index bd070d545..000000000
--- a/ldb/sunos-os.c
+++ /dev/null
@@ -1,701 +0,0 @@
-/*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/sunos-os.c,v 1.3 1992/03/06 12:34:22 wlott Exp $
- *
- * OS-dependent routines.  This file (along with os.h) exports an
- * OS-independent interface to the operating system VM facilities.
- * Suprisingly, this interface looks a lot like the Mach interface
- * (but simpler in some places).  For some operating systems, a subset
- * of these functions will have to be emulated.
- *
- * This is the SunOS version.
- * March 1991, Miles Bader <miles@cogsci.ed.ack.uk> & ted <ted@edu.NMSU>
- *
- */
-
-/* #define DEBUG */
-
-#include <stdio.h>
-
-#include <signal.h>
-#include <sys/file.h>
-
-#include "ldb.h"
-#include "os.h"
-
-/* block size must be larger than the system page size */
-#define SPARSE_BLOCK_SIZE (1<<15)
-#define SPARSE_SIZE_MASK (SPARSE_BLOCK_SIZE-1)
-
-#define PROT_DEFAULT OS_VM_PROT_ALL
-
-#define OFFSET_NONE ((os_vm_offset_t)(~0))
-
-#define EMPTYFILE "/tmp/empty"
-#define ZEROFILE "/dev/zero"
-
-#define MAX_SEGS 64
-
-extern char *getenv();
-
-/* ---------------------------------------------------------------- */
-
-#define ADJ_OFFSET(off,adj) (((off)==OFFSET_NONE) ? OFFSET_NONE : ((off)+(adj)))
-
-long os_vm_page_size=(-1);
-
-static struct segment {
-    os_vm_address_t start;	/* note: start & length are expected to be on page */
-    os_vm_size_t length;        /*       boundaries */
-    long file_offset;
-    short mapped_fd;
-    short protection;
-} addr_map[MAX_SEGS];
-
-static int n_segments=0;
-
-static int zero_fd=(-1), empty_fd=(-1);
-
-static os_vm_address_t last_fault=0;
-static os_vm_size_t real_page_size_difference=0;
-
-void os_init()
-{
-    char *empty_file=getenv("CMUCL_EMPTYFILE");
-
-    if(empty_file==NULL)
-	empty_file=EMPTYFILE;
-
-    empty_fd=open(empty_file,O_RDONLY|O_CREAT);
-    unlink(empty_file);
-
-    zero_fd=open(ZEROFILE,O_RDONLY);
-
-    os_vm_page_size=getpagesize();
-
-    if(os_vm_page_size>OS_VM_DEFAULT_PAGESIZE){
-	fprintf(stderr,"os_init: Pagesize too large (%d > %d)\n",
-		os_vm_page_size,OS_VM_DEFAULT_PAGESIZE);
-	exit(1);
-    }else{
-	/*
-	 * we do this because there are apparently dependencies on
-	 * the pagesize being OS_VM_DEFAULT_PAGESIZE somewhere...
-	 * but since the OS doesn't know we're using this restriction,
-	 * we have to grovel around a bit to enforce it, thus anything
-	 * that uses real_page_size_difference.
-	 */
-	real_page_size_difference=OS_VM_DEFAULT_PAGESIZE-os_vm_page_size;
-	os_vm_page_size=OS_VM_DEFAULT_PAGESIZE;
-    }
-}
-
-/* ---------------------------------------------------------------- */
-
-void seg_force_resident(seg,addr,len)
-struct segment *seg;
-os_vm_address_t addr;
-os_vm_size_t len;
-{
-    int prot=seg->protection;
-
-    if(prot!=0){
-	os_vm_address_t end=addr+len, touch=addr;
-		
-	while(touch<end){
-	    int contents=(*(char *)touch);
-	    if(prot&OS_VM_PROT_WRITE)
-		(*(char *)touch)=contents;
-	    touch=(os_vm_address_t)(((long)touch+SPARSE_BLOCK_SIZE)&~SPARSE_SIZE_MASK);
-	}
-    }
-}
-
-static struct segment *seg_create_nomerge(addr,len,protection,mapped_fd,file_offset)
-os_vm_address_t addr;
-os_vm_size_t len;
-int protection;
-int mapped_fd;
-{
-    int n;
-    struct segment *seg;
-
-    if(len==0)
-	return NULL;
-
-    if(n_segments==MAX_SEGS){
-	fprintf(stderr,"seg_create_nomerge: Out of segments\n");
-	return NULL;
-    }
-
-    for(n=n_segments, seg=addr_map; n>0; n--, seg++)
-	if(addr<seg->start){
-	    seg=(&addr_map[n_segments]);
-	    while(n-->0){
-		seg[0]=seg[-1];
-		seg--;
-	    }
-	    break;
-	}
-
-    n_segments++;
-
-    seg->start=addr;
-    seg->length=len;
-    seg->protection=protection;
-    seg->mapped_fd=mapped_fd;
-    seg->file_offset=file_offset;
-
-    return seg;
-}
-
-/* returns the first segment containing addr */
-static struct segment *seg_find(addr)
-os_vm_address_t addr;
-{
-    int n;
-    struct segment *seg;
-
-    for(n=n_segments, seg=addr_map; n>0; n--, seg++)
-	if(seg->start<=addr && seg->start+seg->length>addr)
-	    return seg;
-
-    return NULL;
-}
-
-/* returns TRUE if the range from addr to addr+len intersects with any segment */
-static boolean collides_with_seg_p(addr,len)
-os_vm_address_t addr;
-os_vm_size_t len;
-{
-    int n;
-    struct segment *seg;
-    os_vm_address_t end=addr+len;
-
-    for(n=n_segments, seg=addr_map; n>0; n--, seg++)
-	if(seg->start>=end)
-	    return FALSE;
-	else if(seg->start+seg->length>addr)
-	    return TRUE;
-
-    return FALSE;
-}
-
-#define seg_last_p(seg) (((seg)-addr_map)>=n_segments-1)
-
-static void seg_destroy(seg)
-struct segment *seg;
-{
-    if(seg!=NULL){
-	int n;
-
-	for(n=seg-addr_map+1; n<n_segments; n++){
-	    seg[0]=seg[1];
-	    seg++;
-	}
-
-	n_segments--;
-    }
-}
-
-static void seg_try_merge_next(seg)
-struct segment *seg;
-{
-    struct segment *nseg=seg+1;
-
-    if(!seg_last_p(seg)
-       && seg->start+seg->length==nseg->start
-       && seg->protection==nseg->protection
-       && seg->mapped_fd==nseg->mapped_fd
-       && ADJ_OFFSET(seg->file_offset,seg->length)==nseg->file_offset)
-    {
-	/* can merge with the next segment */
-#ifdef DEBUG
-	fprintf(stderr,
-		";;; seg_try_merge: Merged 0x%08x[0x%08x] with 0x%08x[0x%08x]\n",
-		seg->start,seg->length,nseg->start,nseg->length);
-#endif
-
-	if(((long)nseg->start&SPARSE_SIZE_MASK)!=0){
-	    /*
-	     * if not on a block boundary, we have to ensure both parts
-	     * of a common block are in a known state
-	     */
-	    seg_force_resident(seg,nseg->start-1,1);
-	    seg_force_resident(nseg,nseg->start,1);
-	}
-
-	seg->length+=nseg->length;
-	seg_destroy(nseg);
-    }
-}
-
-
-/*
- * Try to merge seg with adjacent segments.
- */
-static void seg_try_merge_adjacent(seg)
-struct segment *seg;
-{
-    if(!seg_last_p(seg))
-	seg_try_merge_next(seg);
-    if(seg>addr_map)
-	seg_try_merge_next(seg-1);
-}
-
-static struct segment *seg_create(addr,len,protection,mapped_fd,file_offset)
-os_vm_address_t addr;
-os_vm_size_t len;
-int protection;
-int mapped_fd;
-{
-    struct segment *seg=seg_create_nomerge(addr,len,protection,mapped_fd,file_offset);
-    if(seg!=NULL)
-	seg_try_merge_adjacent(seg);
-    return seg;
-}
-
-/* 
- * Change the attributes of the given range of an existing segment, and return
- * a segment corresponding to the new bit.
- */
-static struct segment *seg_change_range(seg,addr,len,protection,mapped_fd,file_offset)
-struct segment *seg;
-os_vm_address_t addr;
-os_vm_size_t len;
-int protection;
-int mapped_fd;
-{
-    os_vm_address_t end=addr+len;
-
-    if(len==0)
-	return NULL;
-
-    if(protection!=seg->protection
-       || mapped_fd!=seg->mapped_fd
-       || file_offset!=ADJ_OFFSET(seg->file_offset,addr-seg->start))
-    {
-	os_vm_size_t old_len=seg->length, seg_offset=(addr-seg->start);
-	
-	if(old_len<len+seg_offset){
-	    struct segment *next=seg+1;
-	    
-#ifdef DEBUG
-	    fprintf(stderr,
-		    ";;; seg_change_range: region 0x%08x[0x%08x] overflows 0x%08x[0x%08x]\n",
-		    addr,len,
-		    seg->start,old_len);
-#endif
-	    
-	    while(!seg_last_p(seg) && next->start+next->length<=end){
-#ifdef DEBUG
-		fprintf(stderr,
-			";;; seg_change_range: merging extra segment 0x%08x[0x%08x]\n",
-			next->start,
-			next->length);
-#endif
-		seg_destroy(next);
-	    }
-	    
-	    if(!seg_last_p(seg) && next->start<end){
-		next->length-=end-next->start;
-		next->start=end;
-		old_len=next->start-seg->start;
-	    }else
-		old_len=len+seg_offset;
-	    
-#ifdef DEBUG
-	    fprintf(stderr,
-		    ";;; seg_change_range: extended first seg to 0x%08x[0x%08x]\n",
-		    seg->start,
-		    old_len);
-#endif
-	}
-
-	if(seg_offset+len<old_len){
-	    /* add second part of old segment */
-	    seg_create_nomerge(end,
-			       old_len-(seg_offset+len),
-			       seg->protection,
-			       seg->mapped_fd,
-			       ADJ_OFFSET(seg->file_offset,seg_offset+len));
-
-#ifdef DEBUG
-	    fprintf(stderr,
-		    ";;; seg_change_range: Split off end of 0x%08x[0x%08x]: 0x%08x[0x%08x]\n",
-		    seg->start,old_len,
-		    end,old_len-(seg_offset+len));
-#endif
-	}
-
-	if(seg_offset==0){
-	    seg->length=len;
-	    seg->protection=protection;
-	    seg->mapped_fd=mapped_fd;
-	    seg->file_offset=file_offset;
-	}else{
-	    /* adjust first part of remaining old segment */
-	    seg->length=seg_offset;
-
-#ifdef DEBUG
-	    fprintf(stderr,
-		    ";;; seg_change_range: Split off beginning of 0x%08x[0x%08x]: 0x%08x[0x%08x]\n",
-		    seg->start,old_len,
-		    seg->start,seg_offset);
-#endif
-
-	    /* add new middle segment for new protected region */
-	    seg=seg_create_nomerge(addr,len,protection,mapped_fd,file_offset);
-	}
-
-	seg_try_merge_adjacent(seg);
-
-	last_fault=0;
-    }
-
-    return seg;
-}
-
-/* ---------------------------------------------------------------- */
-
-static os_vm_address_t mapin(addr,len,protection,map_fd,offset,is_readable)
-os_vm_address_t addr;
-os_vm_size_t len;
-int protection;
-int map_fd;
-long offset;
-int is_readable;
-{
-    os_vm_address_t real;
-    boolean sparse=(len>=SPARSE_BLOCK_SIZE);
-
-    if(offset!=OFFSET_NONE
-       && (offset<os_vm_page_size || (offset&(os_vm_page_size-1))!=0))
-    {
-	fprintf(stderr,
-		"mapin: file offset (%d) not multiple of pagesize (%d)\n",
-		offset,
-		os_vm_page_size);
-    }
-
-    if(addr==NULL)
-	len+=real_page_size_difference;	/* futz around to get an aligned region */
-
-    last_fault=0;
-    real=(os_vm_address_t)
-	mmap((caddr_t)addr,
-	     (long)len,
-	     sparse ? (is_readable ? PROT_READ|PROT_EXEC : 0) : protection,
-	     (addr==NULL? 0 : MAP_FIXED)|MAP_PRIVATE,
-	     (is_readable || !sparse) ? map_fd : empty_fd,
-	     (off_t)(offset==OFFSET_NONE ? 0 : offset));
-
-    if((long)real==-1){
-	perror("mapin: mmap");
-	return NULL;
-    }
-
-    if(addr==NULL){
-	/*
-	 * now play around with what the os gave us to make it align by
-	 * our standards (which is why we overallocated)
-	 */
-	os_vm_size_t overflow;
-
-	addr=os_round_up_to_page(real);
-	if(addr!=real)
-	    munmap(real,addr-real);
-	
-	overflow=real_page_size_difference-(addr-real);
-	if(overflow!=0)
-	    munmap(addr+len-real_page_size_difference,overflow);
-
-	real=addr;
-    }
-
-
-    return real;
-}
-
-static os_vm_address_t map_and_remember(addr,len,protection,map_fd,offset,is_readable)
-os_vm_address_t addr;
-os_vm_size_t len;
-int protection;
-int map_fd;
-long offset;
-int is_readable;
-{
-    os_vm_address_t real=mapin(addr,len,protection,map_fd,offset,is_readable);
-
-    if(real!=NULL){
-	struct segment *seg=seg_find(real);
-
-	if(seg!=NULL)
-	    seg=seg_change_range(seg,real,len,protection,map_fd,offset);
-	else
-	    seg=seg_create(real,len,protection,map_fd,offset);
-
-	if(seg==NULL){
-	    munmap(real,len);
-	    return NULL;
-	}
-    }
-
-#ifdef DEBUG
-    fprintf(stderr,";;; map_and_remember: 0x%08x[0x%08x] offset: %d, mapped to: %d\n",
-	    real,len,offset,map_fd);
-#endif
-
-    return real;
-}
-
-/* ---------------------------------------------------------------- */
-
-os_vm_address_t os_validate(addr, len)
-os_vm_address_t addr;
-os_vm_size_t len;
-{
-    addr=os_trunc_to_page(addr);
-    len=os_round_up_size_to_page(len);
-
-#ifdef DEBUG
-    fprintf(stderr, ";;; os_validate: 0x%08x[0x%08x]\n",addr,len);
-#endif
-
-    if(addr!=NULL && collides_with_seg_p(addr,len))
-	return NULL;
-
-    return map_and_remember(addr,len,PROT_DEFAULT,zero_fd,OFFSET_NONE,FALSE);
-}
-
-void os_invalidate(addr, len)
-os_vm_address_t addr;
-os_vm_size_t len;
-{
-    struct segment *seg=seg_find(addr);
-
-    addr=os_trunc_to_page(addr);
-    len=os_round_up_size_to_page(len);
-
-#ifdef DEBUG
-    fprintf(stderr, ";;; os_invalidate: 0x%08x[0x%08x]\n",addr,len);
-#endif
-
-    if(seg==NULL)
-	fprintf(stderr, "os_invalidate: Unknown segment: 0x%08x[0x%08x]\n",addr,len);
-    else{
-	seg=seg_change_range(seg,addr,len,0,0,OFFSET_NONE);
-	if(seg!=NULL)
-	    seg_destroy(seg);
-
-	last_fault=0;
-	if(munmap(addr,len)!=0)
-	    perror("os_invalidate: munmap");
-    }
-}
-
-os_vm_address_t os_map(fd, offset, addr, len)
-int fd;
-os_vm_offset_t offset;
-os_vm_address_t addr;
-long len;
-{
-    addr=os_trunc_to_page(addr);
-    len=os_round_up_size_to_page(len);
-
-#ifdef DEBUG
-    fprintf(stderr, ";;; os_map: 0x%08x[0x%08x]\n",addr,len);
-#endif
-
-    return map_and_remember(addr,len,PROT_DEFAULT,fd,offset,TRUE);
-}
-
-void os_flush_icache(address, length)
-os_vm_address_t address;
-os_vm_size_t length;
-{
-#if defined(MACH) && defined(mips)
-	vm_machine_attribute_val_t flush;
-	kern_return_t kr;
-
-	flush = MATTR_VAL_ICACHE_FLUSH;
-
-	kr = vm_machine_attribute(task_self(), address, length,
-				  MATTR_CACHE, &flush);
-	if (kr != KERN_SUCCESS)
-		mach_error("Could not flush the instruction cache", kr);
-#endif
-}
-
-void os_protect(addr, len, prot)
-os_vm_address_t addr;
-os_vm_size_t len;
-int prot;
-{
-    struct segment *seg=seg_find(addr);
-
-    addr=os_trunc_to_page(addr);
-    len=os_round_up_size_to_page(len);
-
-#ifdef DEBUG
-    fprintf(stderr,";;; os_protect: 0x%08x[0x%08x]\n",addr,len);
-#endif
-
-    if(seg!=NULL){
-	int old_prot=seg->protection;
-
-	if(prot!=old_prot){
-	    /*
-	     * oooooh, sick: we have to make sure all the pages being protected have
-	     * faulted in, so they're in a known state...
-	     */
-	    seg_force_resident(seg,addr,len);
-
-	    seg_change_range(seg,addr,len,prot,seg->mapped_fd,seg->file_offset);
-
-	    if(mprotect((caddr_t)addr,(long)len,prot)!=0)
-		perror("os_unprotect: mprotect");
-	}
-    }else
-	fprintf(stderr,"os_protect: Unknown segment: 0x%08x[0x%08x]\n",addr,len);
-}
-
-boolean valid_addr(test)
-os_vm_address_t test;
-{
-    return seg_find(test)!=NULL;
-}
-
-/* ---------------------------------------------------------------- */
-
-static boolean maybe_gc(context)
-struct sigcontext *context;
-{
-    /*
-     * It's necessary to enable recursive SEGVs, since the handle is
-     * used for multiple things (e.g., both gc-trigger & faulting in pages).
-     * We check against recursive gc's though...
-     */
-
-    boolean did_gc;
-    static already_trying=0;
-
-    if(already_trying)
-	return FALSE;
-
-    sigsetmask(context->sc_mask);
-
-    already_trying=TRUE;
-    did_gc=interrupt_maybe_gc(context);
-    already_trying=FALSE;
-
-    return did_gc;
-}
-
-/*
- * The primary point of catching segmentation violations is to allow 
- * read only memory to be re-mapped with more permissions when a write
- * is attempted.  this greatly decreases the residency of the program
- * in swap space since read only areas don't take up room
- *
- * Running into the gc trigger page will also end up here...
- */
-void segv_handler(sig, code, context, addr)
-int sig, code;
-struct sigcontext *context;
-caddr_t addr;
-{
-    if (code == SEGV_PROT) {	/* allow writes to this chunk */
-	struct segment *seg=seg_find(addr);
-
-	if(last_fault==addr){
-	    if(seg!=NULL && maybe_gc(context))
-		/* we just garbage collected */
-		return;
-	    else{
-		/* a *real* protection fault */
-		fprintf(stderr,
-			"segv_handler: Real protection violation: 0x%08x\n",
-			addr);
-		interrupt_handle_now(sig,code,context);
-	    }
-	}else
-	    last_fault=addr;
-
-	if(seg!=NULL){
-	    int err;
-	    /* round down to a page */
-	    os_vm_address_t block=(os_vm_address_t)((long)addr&~SPARSE_SIZE_MASK);
-	    os_vm_size_t length=SPARSE_BLOCK_SIZE;
-
-	    if(block < seg->start){
-		length-=(seg->start - block);
-		block=seg->start;
-	    }
-	    if(block+length > seg->start+seg->length)
-		length=seg->start+seg->length-block;
-
-#if 0
-	    /* unmap it.  probably redundant. */
-	    if(munmap(block,length) == -1)
-		perror("segv_handler: munmap");
-#endif
-
-	    /* and remap it with more permissions */
-	    err=(int)
-		mmap(block,
-		     length,
-		     seg->protection,
-		     MAP_PRIVATE|MAP_FIXED,
-		     seg->mapped_fd,
-		     seg->file_offset==OFFSET_NONE
-		       ? 0
-		       : seg->file_offset+(block-seg->start));
-
-	    if (err == -1) {
-		perror("segv_handler: mmap");
-		interrupt_handle_now(sig,code,context);
-	    }
-	}
-	else{
-	    fprintf(stderr, "segv_handler: 0x%08x not in any segment\n",addr);
-	    interrupt_handle_now(sig,code,context);
-	}
-    }
-    /*
-     * note that we check for a gc-trigger hit even if it's not a PROT error
-     */
-    else if(!maybe_gc(context)){
-	static int nomap_count=0;
-
-	if(code==SEGV_NOMAP){
-	    if(nomap_count==0){
-		fprintf(stderr,
-			"segv_handler: No mapping fault: 0x%08x\n",addr);
-		nomap_count++;
-	    }else{
-		/*
-		 * There should be higher-level protection against stack
-		 * overflow somewhere, but at least this prevents infinite
-		 * puking of error messages...
-		 */
-		fprintf(stderr,
-			"segv_handler: Recursive no mapping fault (stack overflow?)\n");
-		exit(-1);
-	    }
-	}else if(SEGV_CODE(code)==SEGV_OBJERR){
-	    extern int errno;
-	    errno=SEGV_ERRNO(code);
-	    perror("segv_handler: Object error");
-	}
-
-	interrupt_handle_now(sig,code,context);
-
-	if(code==SEGV_NOMAP)
-	    nomap_count--;
-    }
-}
-
-void os_install_interrupt_handlers()
-{
-    interrupt_install_low_level_handler(SIGSEGV,segv_handler);
-}
diff --git a/ldb/sunos-os.h b/ldb/sunos-os.h
deleted file mode 100644
index 85992579b..000000000
--- a/ldb/sunos-os.h
+++ /dev/null
@@ -1,13 +0,0 @@
-#include <sys/types.h>
-#include <sys/mman.h>
-
-typedef caddr_t os_vm_address_t;
-typedef long os_vm_size_t;
-typedef off_t os_vm_offset_t;
-typedef int os_vm_prot_t;
-
-#define OS_VM_PROT_READ PROT_READ
-#define OS_VM_PROT_WRITE PROT_WRITE
-#define OS_VM_PROT_EXECUTE PROT_EXEC
-
-#define OS_VM_DEFAULT_PAGESIZE	8192
diff --git a/ldb/test.c b/ldb/test.c
deleted file mode 100644
index 791003ea5..000000000
--- a/ldb/test.c
+++ /dev/null
@@ -1,264 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/test.c,v 1.11 1991/02/16 01:01:36 wlott Exp $ */
-/* Extra random routines for testing stuff. */
-
-#include <signal.h>
-#ifdef mips
-#include <mips/cpu.h>
-#endif
-
-#include "lisp.h"
-#include "ldb.h"
-
-static char *signames[] = {
-    "<Unused>", "SIGHUP", "SIGINT", "SIGQUIT", "SIGILL", "SIGTRAP",
-    "SIGIOT", "SIGEMT", "SIGFPE", "SIGKILL", "SIGBUS", "SIGSEGV",
-    "SIGSYS", "SIGPIPE", "SIGALRM", "SIGTERM", "SIGURG", "SIGSTOP",
-    "SIGTSTP", "SIGCONT", "SIGCHLD", "SIGTTIN", "SIGTTOU", "SIGIO",
-    "SIGXCPU", "SIGXFSZ", "SIGVTALRM", "SIGPROF", "SIGWINCH",
-    "SIGUSR1", "SIGUSR2"
-};
-
-static char *errors[] = ERRORS;
-
-#ifdef mips
-#define any_reg_sc 16
-#define descriptor_reg_sc 17
-#define base_char_reg_sc 18
-#define sap_reg_sc 19
-#define signed_reg_sc 20
-#define unsigned_reg_sc 21
-#define non_descr_reg_sc 22
-#define interior_reg_sc 23
-#define single_float_reg_sc 24
-#define double_float_reg_sc 25
-#endif
-
-#ifdef sparc
-#define any_reg_sc 11
-#define descriptor_reg_sc 12
-#define base_char_reg_sc 13
-#define sap_reg_sc 14
-#define signed_reg_sc 15
-#define unsigned_reg_sc 16
-#define non_descr_reg_sc 17
-#define interior_reg_sc 18
-#define single_float_reg_sc 19
-#define double_float_reg_sc 20
-#endif
-
-#ifdef ibmrt
-#define any_reg_sc 10
-#define descriptor_reg_sc 11
-#define base_char_reg_sc 12
-#define sap_reg_sc 13
-#define signed_reg_sc 14
-#define unsigned_reg_sc 15
-#define non_descr_reg_sc 16
-#define word_pointer_reg_sc 17
-#define interior_reg_sc 18
-#define single_68881_reg_sc 19
-#define double_68881_reg_sc 20
-#define single_fpa_reg_sc 21
-#define double_fpa_reg_sc 22
-#define single_afpa_reg_sc 23
-#define double_afpa_reg_sc 24
-#endif
-
-signal_handler(signal, code, context)
-int signal, code;
-struct sigcontext *context;
-{
-    int mask;
-    unsigned long *ptr, bad_inst;
-    unsigned char *cptr;
-    int len, scoffset, sc, offset, ch;
-
-    printf("Hit with %s, code = %d, context = 0x%x\n", signames[signal], code, context);
-
-#ifdef mips
-    if (context->sc_cause & CAUSE_BD)
-        ptr = (unsigned long *)(context->sc_pc + 4);
-    else
-        ptr = (unsigned long *)(context->sc_pc);
-#else
-    ptr = (unsigned long *)(context->sc_pc);
-#endif
-
-    bad_inst = *ptr;
-
-#ifdef mips
-    if ((bad_inst >> 26) == 0 && (bad_inst & 0x3f) == 0xd) {
-        /* It was a break. */
-        switch ((bad_inst >> 16) & 0x3ff) {
-#if 0
-        }
-    }
-#endif
-#endif
-#ifdef sparc
-    if ((bad_inst & 0xc1c00000) == 0) {
-        switch (bad_inst & 0x3fffff) {
-#if 0
-        }
-    }
-#endif
-#endif
-#ifdef ibmrt
-    if ((bad_inst & 0xffff0000) == 0xcc700000) {
-	switch (bad_inst & 0xffff) {
-#if 0
-	}
-    }
-#endif
-#endif
-#if !defined(mips) && !defined(sparc) && !defined(ibmrt)
-    if (0) {
-	switch (0) {
-#endif
-            case trap_Halt:
-                printf("%primitive halt called; the party is over.\n");
-                break;
-
-            case trap_PendingInterrupt:
-                printf("Pending interrupt trap? This should not happen.\n");
-                break;
-
-            case trap_Error:
-            case trap_Cerror:
-                cptr = (unsigned char *)(ptr+1);
-                if (*cptr == 0xff)
-                    cptr++;
-
-                len = *cptr++;
-                printf("Error: %s\n", errors[*cptr++]);
-                len--;
-                while (len > 0) {
-                    scoffset = *cptr++;
-                    len--;
-                    if (scoffset == 253) {
-                        scoffset = *cptr++;
-                        len--;
-                    }
-                    else if (scoffset == 254) {
-                        scoffset = cptr[0] + cptr[1]*256;
-                        cptr += 2;
-                        len -= 2;
-                    }
-                    else if (scoffset == 255) {
-                        scoffset = cptr[0] + (cptr[1]<<8) +
-                            (cptr[2]<<16) + (cptr[3]<<24);
-                            cptr += 4;
-                        len -= 4;
-                    }
-                    sc = scoffset & 0x1f;
-                    offset = scoffset >> 5;
-
-                    printf("    SC: %d, Offset: %d", sc, offset);
-                    switch (sc) {
-                      case any_reg_sc:
-                      case descriptor_reg_sc:
-                        putchar('\t');
-                        brief_print(context->sc_regs[offset]);
-                        break;
-                      case base_char_reg_sc:
-                        ch = context->sc_regs[offset];
-                        switch (ch) {
-                          case '\n': printf("\t'\\n'\n"); break;
-                          case '\b': printf("\t'\\b'\n"); break;
-                          case '\t': printf("\t'\\t'\n"); break;
-                          case '\r': printf("\t'\\r'\n"); break;
-                          default:
-                            if (ch < 32 || ch > 127)
-                                printf("\\%03o", ch);
-                            else
-                                printf("\t'%c'\n", ch);
-                            break;
-                        }
-                        break;
-                      case sap_reg_sc:
-#ifdef ibmrt
-		      case word_pointer_reg_sc:
-#endif
-                        printf("\t0x%08x\n", context->sc_regs[offset]);
-                        break;
-                      case signed_reg_sc:
-                        printf("\t%ld\n", context->sc_regs[offset]);
-                        break;
-                      case unsigned_reg_sc:
-                        printf("\t%lu\n", context->sc_regs[offset]);
-                        break;
-                      case non_descr_reg_sc:
-                      case interior_reg_sc:
-                        printf("\t???\n");
-                        break;
-#ifndef ibmrt
-                      case single_float_reg_sc:
-                        printf("\t%g\n",
-                               *(float *)&context->sc_fpregs[offset]);
-                        break;
-                      case double_float_reg_sc:
-                        printf("\t%g\n",
-                               *(double *)&context->sc_fpregs[offset]);
-                        break;
-#endif
-                      default:
-                        printf("\t???\n");
-                        break;
-                    }
-                }
-                if (code == trap_Cerror) {
-                    printf("Hit a break.  Use ``exit'' to continue.\n");
-#ifdef mips
-                    if (context->sc_cause & CAUSE_BD)
-                        emulate_branch(context, *(unsigned long *)context->sc_pc);
-                    else
-                        context->sc_pc += 4;
-#endif
-#ifdef sparc
-                    context->sc_pc = context->sc_npc;
-                    context->sc_npc = context->sc_npc + 4;
-#endif
-                }
-                break;
-
-            default:
-                printf("Unknown trap type.\n");
-                break;
-        }
-    }
-
-    mask = sigsetmask(0);
-
-    ldb_monitor();
-
-    sigsetmask(mask);
-}
-
-
-
-test_init()
-{
-    install_handler(SIGINT, signal_handler);
-#if defined(mips)||defined(ibmrt)
-    install_handler(SIGTRAP, signal_handler);
-#endif
-#ifdef sparc
-    install_handler(SIGILL, signal_handler);
-#endif
-}
-
-
-#ifdef mips
-cacheflush()
-{
-    /* This is supposed to be defined, but is not. */
-}
-#endif
-
-lispobj debug_print(string)
-lispobj string;
-{
-    printf("%s\n", ((struct vector *)PTR(string))->data);
-
-    return NIL;
-}
diff --git a/ldb/undefineds.src b/ldb/undefineds.src
deleted file mode 100644
index 72a3abea4..000000000
--- a/ldb/undefineds.src
+++ /dev/null
@@ -1,163 +0,0 @@
-/* Routines that must be linked into the core for lisp to work. */
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/undefineds.src,v 1.4 1991/09/13 20:43:00 wlott Exp $ */
-
-#ifdef sun
-#ifndef MACH
-#define SUNOS
-#endif
-#endif
-
-/* Pick up all the syscalls. */
-accept
-access
-acct
-adjtime
-bind
-brk
-chdir
-chmod
-chown
-chroot
-close
-connect
-creat
-dup
-dup2
-execve
-exit
-fchmod
-fchown
-fcntl
-flock
-fork
-fstat
-fsync
-ftruncate
-getdtablesize
-getegid
-geteuid
-getgid
-getgroups
-gethostid
-gethostname
-getitimer
-getpagesize
-getpeername
-getpgrp
-getpid
-getppid
-getpriority
-getrlimit
-getrusage
-getsockname
-getsockopt
-gettimeofday
-getuid
-ioctl
-kill
-killpg
-link
-listen
-lseek
-lstat
-mkdir
-mknod
-mount
-open
-pipe
-profil
-ptrace
-#ifndef SUNOS
-quota
-#endif
-read
-readlink
-readv
-reboot
-recv
-recvfrom
-recvmsg
-rename
-rmdir
-sbrk
-select
-send
-sendmsg
-sendto
-setgroups
-#ifndef SUNOS
-sethostid
-#endif
-sethostname
-setitimer
-setpgrp
-setpriority
-#ifndef SUNOS
-setquota
-#endif
-setregid
-setreuid
-setrlimit
-setsockopt
-settimeofday
-shutdown
-sigblock
-sigpause
-#ifndef ibmrt
-sigreturn
-#endif
-sigsetmask
-sigstack
-sigvec
-socket
-socketpair
-stat
-swapon
-symlink
-sync
-syscall
-truncate
-umask
-#ifndef SUNOS
-umount
-#endif
-unlink
-utimes
-vfork
-vhangup
-wait
-wait3
-write
-writev
-
-/* Math routines. */
-cos
-sin
-tan
-acos
-asin
-atan
-atan2
-sinh
-cosh
-tanh
-asinh
-acosh
-atanh
-exp
-expm1
-log
-log10
-log1p
-pow
-cbrt
-sqrt
-hypot
-
-/* Network support. */
-gethostbyname
-gethostbyaddr
-
-/* Other random things. */
-getwd
-ttyname
diff --git a/ldb/validate.c b/ldb/validate.c
deleted file mode 100644
index 15988c427..000000000
--- a/ldb/validate.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/validate.c,v 1.6 1991/09/13 20:42:24 wlott Exp $
- *
- * Memory Validation
- */
-
-#include <stdio.h>
-#include "ldb.h"
-#include "lisp.h"
-#include "os.h"
-#include "globals.h"
-#include "validate.h"
-
-static void ensure_space(start,size)
-lispobj *start;
-unsigned long size;
-{
-    if(os_validate((os_vm_address_t)start,(os_vm_size_t)size)==NULL){
-	fprintf(stderr,
-		"ensure_space: Failed to validate %ld bytes at 0x%08x\n",
-		size,
-		start);
-	exit(1);
-    }
-}
-
-validate()
-{
-#ifdef PRINTNOISE
-	printf("Validating memory ...");
-	fflush(stdout);
-#endif
-
-	/* Read-Only Space */
-	read_only_space = (lispobj *) READ_ONLY_SPACE_START;
-	ensure_space(read_only_space, READ_ONLY_SPACE_SIZE);
-
-	/* Static Space */
-	static_space = (lispobj *) STATIC_SPACE_START;
-	ensure_space(static_space, STATIC_SPACE_SIZE);
-
-	/* Dynamic-0 Space */
-	dynamic_0_space = (lispobj *) DYNAMIC_0_SPACE_START;
-	ensure_space(dynamic_0_space, DYNAMIC_SPACE_SIZE);
-
-	current_dynamic_space = dynamic_0_space;
-
-	/* Dynamic-1 Space */
-	dynamic_1_space = (lispobj *) DYNAMIC_1_SPACE_START;
-	ensure_space(dynamic_1_space, DYNAMIC_SPACE_SIZE);
-
-	/* Control Stack */
-	control_stack = (lispobj *) CONTROL_STACK_START;
-	ensure_space(control_stack, CONTROL_STACK_SIZE);
-
-	/* Binding Stack */
-	binding_stack = (lispobj *) BINDING_STACK_START;
-	ensure_space(binding_stack, BINDING_STACK_SIZE);
-
-#ifdef PRINTNOISE
-	printf(" done.\n");
-#endif
-}
diff --git a/ldb/validate.h b/ldb/validate.h
deleted file mode 100644
index 03a6a500a..000000000
--- a/ldb/validate.h
+++ /dev/null
@@ -1,49 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/validate.h,v 1.9 1992/12/17 13:03:13 wlott Exp $ */
-
-#if !defined(_INCLUDE_VALIDATE_H_)
-#define _INCLUDE_VALIDATE_H_
-
-#ifdef sparc
-
-#define READ_ONLY_SPACE_START   (0x00200000)
-#define READ_ONLY_SPACE_SIZE    (0x0bdfe000)
-
-#define STATIC_SPACE_START	(0x0c000000)
-#define STATIC_SPACE_SIZE	(0x03ffe000)
-
-#define DYNAMIC_0_SPACE_START	(0x10000000)
-#define DYNAMIC_1_SPACE_START	(0x18000000)
-#define DYNAMIC_SPACE_SIZE	(0x07ffe000)
-
-#define CONTROL_STACK_START	(0x00100000)
-#define CONTROL_STACK_SIZE	(0x0007e000)
-
-#define BINDING_STACK_START	(0x00180000)
-#define BINDING_STACK_SIZE	(0x0007e000)
-
-#else sparc
-
-#ifdef ibmrt
-#define READ_ONLY_SPACE_START	(0x00100000)
-#define READ_ONLY_SPACE_SIZE    (0x04F00000)
-#else
-#define READ_ONLY_SPACE_START   (0x01000000)
-#define READ_ONLY_SPACE_SIZE    (0x04000000)
-#endif
-
-#define STATIC_SPACE_START	(0x05000000)
-#define STATIC_SPACE_SIZE	(0x02000000)
-
-#define DYNAMIC_0_SPACE_START	(0x07000000)
-#define DYNAMIC_1_SPACE_START	(0x0b000000)
-#define DYNAMIC_SPACE_SIZE	(0x04000000)
-
-#define CONTROL_STACK_START	(0x50000000)
-#define CONTROL_STACK_SIZE	(0x00100000)
-
-#define BINDING_STACK_START	(0x60000000)
-#define BINDING_STACK_SIZE	(0x00100000)
-
-#endif sparc
-
-#endif
diff --git a/ldb/vars.c b/ldb/vars.c
deleted file mode 100644
index b17a7a6e1..000000000
--- a/ldb/vars.c
+++ /dev/null
@@ -1,185 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/vars.c,v 1.2 1992/03/24 04:25:09 wlott Exp $ */
-#include <stdio.h>
-
-#include "ldb.h"
-#include "lisp.h"
-#include "vars.h"
-
-#define NAME_BUCKETS 31
-#define OBJ_BUCKETS 31
-
-static struct var *NameHash[NAME_BUCKETS], *ObjHash[OBJ_BUCKETS];
-static int tempcntr = 1;
-
-struct var {
-    lispobj obj, (*update_fn)();
-    char *name;
-    long clock;
-    boolean map_back, permanent;
-
-    struct var *nnext; /* Next in name list */
-    struct var *onext; /* Next in object list */
-};
-
-static int hash_name(name)
-unsigned char *name;
-{
-    unsigned long value = 0;
-
-    while (*name != '\0') {
-        value = (value << 1) ^ *name++;
-        value = (value & (1-(1<<24))) ^ (value >> 24);
-    }
-
-    return value % NAME_BUCKETS;
-}
-
-static int hash_obj(obj)
-lispobj obj;
-{
-    return (long)obj % OBJ_BUCKETS;
-}
-
-
-void flush_vars()
-{
-    int index;
-    struct var *var, *next, *perm = NULL;
-
-    /* Note: all vars in the object hash table also appear in the name hash table, so if we free everything in the name hash table, we free everything in the object hash table. */
-
-    for (index = 0; index < NAME_BUCKETS; index++)
-        for (var = NameHash[index]; var != NULL; var = next) {
-            next = var->nnext;
-            if (var->permanent) {
-                var->nnext = perm;
-                perm = var;
-            }
-            else {
-                free(var->name);
-                free(var);
-            }
-        }
-    bzero(NameHash, sizeof(NameHash));
-    bzero(ObjHash, sizeof(ObjHash));
-    tempcntr = 1;
-
-    for (var = perm; var != NULL; var = next) {
-        next = var->nnext;
-        index = hash_name(var->name);
-        var->nnext = NameHash[index];
-        NameHash[index] = var;
-        if (var->map_back) {
-            index = hash_obj(var->obj);
-            var->onext = ObjHash[index];
-            ObjHash[index] = var;
-        }
-    }
-}
-
-struct var *lookup_by_name(name)
-char *name;
-{
-    struct var *var;
-
-    for (var = NameHash[hash_name(name)]; var != NULL; var = var->nnext)
-        if (strcmp(var->name, name) == 0)
-            return var;
-    return NULL;
-}
-
-struct var *lookup_by_obj(obj)
-lispobj obj;
-{
-    struct var *var;
-
-    for (var = ObjHash[hash_obj(obj)]; var != NULL; var = var->onext)
-        if (var->obj == obj)
-            return var;
-    return NULL;
-}
-
-static struct var *make_var(name, perm)
-char *name;
-boolean perm;
-{
-    struct var *var = (struct var *)malloc(sizeof(struct var));
-    char buffer[256];
-    int index;
-
-    if (name == NULL) {
-        sprintf(buffer, "%d", tempcntr++);
-        name = buffer;
-    }
-    var->name = (char *)malloc(strlen(name)+1);
-    strcpy(var->name, name);
-    var->clock = 0;
-    var->permanent = perm;
-    var->map_back = FALSE;
-    
-    index = hash_name(name);
-    var->nnext = NameHash[index];
-    NameHash[index] = var;
-
-    return var;
-}    
-
-struct var *define_var(name, obj, perm)
-char *name;
-lispobj obj;
-boolean perm;
-{
-    struct var *var = make_var(name, perm);
-    int index;
-
-    var->obj = obj;
-    var->update_fn = NULL;
-
-    if (lookup_by_obj(obj) == NULL) {
-        var->map_back = TRUE;
-        index = hash_obj(obj);
-        var->onext = ObjHash[index];
-        ObjHash[index] = var;
-    }
-
-    return var;
-}
-
-struct var *define_dynamic_var(name, updatefn, perm)
-char *name;
-lispobj (*updatefn)();
-boolean perm;
-{
-    struct var *var = make_var(name, perm);
-
-    var->update_fn = updatefn;
-
-    return var;
-}
-
-char *var_name(var)
-struct var *var;
-{
-    return var->name;
-}
-
-lispobj var_value(var)
-struct var *var;
-{
-    if (var->update_fn != NULL)
-        var->obj = (*var->update_fn)(var);
-    return var->obj;
-}
-
-long var_clock(var)
-struct var *var;
-{
-    return var->clock;
-}
-
-void var_setclock(var, val)
-struct var *var;
-long val;
-{
-    var->clock = val;
-}
diff --git a/ldb/vars.h b/ldb/vars.h
deleted file mode 100644
index c83eb90a1..000000000
--- a/ldb/vars.h
+++ /dev/null
@@ -1,13 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/vars.h,v 1.1 1990/02/24 19:37:33 wlott Exp $ */
-
-
-extern void flush_vars();
-extern struct var *lookup_by_name(/* name */);
-extern struct var *lookup_by_obj(/* obj */);
-extern struct var *define_var(/* name, obj, perm */);
-extern struct var *define_dynamic_var(/* name, update_fn, perm */);
-
-extern char *var_name();
-extern lispobj var_value();
-extern long var_clock();
-extern void var_setclock();
diff --git a/ldb/version.c b/ldb/version.c
deleted file mode 100644
index 6ecb66060..000000000
--- a/ldb/version.c
+++ /dev/null
@@ -1,2 +0,0 @@
-/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/ldb/Attic/version.c,v 1.1 1990/02/24 19:37:34 wlott Exp $ */
-int version = VERSION;
-- 
GitLab