diff --git a/scsh/static.scm b/scsh/static.scm
deleted file mode 100755
index af55574..0000000
--- a/scsh/static.scm
+++ /dev/null
@@ -1,678 +0,0 @@
-#!/usr/local/bin/scsh \
--lm /usr/local/lib/scsh/vm/ps-interface.scm -lm /usr/local/lib/scsh/vm/interfaces.scm -lm /usr/local/lib/scsh/vm/package-defs.scm -lm /usr/local/lib/scsh/vm/s48-package-defs.scm -m heap -l /usr/local/lib/scsh/scsh/static-heap.scm -dm -m scsh-static-heap -e scsh-static-linker -s 
-!#
-;;; Package for Static heaps for the Scheme Shell
-;;; Copyright (c) 1995 by Brian D. Carlstrom.
-
-;;; based on Scheme48 implementation.
-;;; Copyright (c) 1993, 1994 by Richard Kelsey and Jonathan Rees.
-
-(define-structure heap-extra (export newspace-begin
-			      heap-pointer
-			      header-a-units
-			      d-vector? 
-			      stob-type)
-  (open scheme heap)
-  (begin
-    (define (newspace-begin) *newspace-begin*)
-    (define (heap-pointer) *hp*)))
-
-(define-structure scsh-static-heap (export scsh-static-linker)
-  (open scheme heap memory data stob struct
-	heap-extra
-	vm-architecture
-	formats
-	enumerated
-	signals
-	tables
-	defrec-package
-	scsh)
-  (begin
-
-    (define (scsh-static-linker argl)
-      (if (not (= (length argl) 3))
-	  (error "usage: ~a input-image-file output-archive-file" (car argl))
-	  (let ((tempdir (or (getenv "TMPDIR")
-			     "/usr/tmp"))
-		(cc-command (or (getenv "CC")
-				"gcc -g -O"))
-		(ar-command (or (getenv "AR")
-				"ar cq"))
-		(infile (cadr argl))
-		(outfile (caddr argl)))
-	    (scsh-do-it infile tempdir outfile cc-command ar-command)
-	    (exit 0))))
-
-    ;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
-    (define-record heap
-      (length    0)
-      (objects '())
-      )
-    ;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
-    (define (scsh-do-it infile tempdir outfile cc-command ar-command)
-      (let* ((temp-dir (format #f "~a/scsh~s" tempdir (pid)))
-	     (prefix (string-append temp-dir "/static"))
-	     (start (read-heap-image infile)))
-	(receive (pure impure reloc externs)
-	    (create-heaps-and-tables)
-	  (if (file-exists? temp-dir)
-	      (if (file-directory? temp-dir)
-		  (with-cwd temp-dir
-			    (map delete-file (directory-files temp-dir #t)))
-		  (delete-file temp-dir)))
-	  (create-directory temp-dir #o755 #t)
-	  (with-cwd temp-dir
-		    (write-c-header-file pure impure externs infile outfile prefix)
-		    (write-c-image pure impure reloc externs prefix)
-		    (write-main-c-file start reloc prefix)
-		    (compile-c-files cc-command prefix))
-	  (archive-files ar-command outfile prefix)
-	  )))
-
-
-    (define debug #f)
-
-    (define (vm-string->string x)
-      (cond ((vm-string? x)
-	     (let ((len (vm-string-length x)))
-	       (let loop ((i 0) 
-			  (l '()))
-		 (cond ((= i len) 
-			(list->string (reverse l)))
-		       (else
-			(loop (+ i 1) (cons (vm-string-ref x i) l)))))))
-	    (else
-	     (message x " is not a vm-string"))))
-
-    (define (read-heap-image infile)
-      (let ((bytes (file-info:size (file-info infile))))
-	(init (inexact->exact (floor (* 1.1 bytes))) infile)))
-					; XXX need little extra space for find-all-xs
-
-    (define (create-heaps-and-tables)
-      (let* ((n       (nchunks))
-	     (  pure  (make-vector n))
-	     (impure  (make-vector n))
-	     (reloc   (make-vector n))
-	     (externs (make-table   )))
-	;; initialize to blanks
-	(let loop ((i 0))
-	  (cond ((not (= i n))
-		 (vector-set!   pure i (make-heap ))
-		 (vector-set! impure i (make-heap ))
-		 (vector-set!  reloc i (make-table))
-		 (loop (+ i 1)))))
-	(scsh-for-each-stored-object
-	 (lambda (chunk)
-	   (format #t "Reading chunk number ~s" chunk))
-	 (lambda (chunk x len)
-	   (if debug
-	       (write x))
-	   (let* ((mutable (mutable? x))
-		  (heap (vector-ref (if mutable impure pure) chunk)))
-	     (table-set! (vector-ref reloc chunk) x (heap:length heap))
-	     (set-heap:objects heap (cons x (heap:objects heap)))
-	     (set-heap:length  heap (+ len  (heap:length  heap)))
-	     (cond (debug
-		    (display (if mutable "   mutable " " immutable "))
-		    (cond ((d-vector? x)  (display " d-vector"))
-			  ((vm-string? x) (display "vm-string"))
-			  (else           (display " b-vector")))
-		    (let ((m (heap:length (vector-ref impure chunk)))
-			  (i (heap:length (vector-ref   pure chunk))))
-		      (message " m" m "+i" i "=" (+ m i))))))
-	   (if (= (header-type (stob-header x)) (enum stob external))
-	       (table-set! externs 
-			   (external-value x) 
-			   (vm-string->string (external-name x))))
-	   )
-	 (lambda (chunk) 
-	   (newline)))
-	(let loop ((i 0))
-	  (cond ((not (= i n))
-		 (let ((p (vector-ref   pure i))
-		       (i (vector-ref impure i)))
-		   (set-heap:objects p (reverse (heap:objects p)))
-		   (set-heap:objects i (reverse (heap:objects i))))
-		 (loop (+ i 1)))))
-	(values pure impure reloc externs)))
-
-    (define (write-c-header-file pure impure externs infile outfile prefix)
-      (message "Writing header file")
-      (call-with-output-file (string-append prefix ".h")
-	(lambda (port)
-	  (format port "/* Static Heap File Automatically Generated~%")
-	  (format port " * by   scsh/static.scm~%")
-	  (format port " * from ~a~%" infile)
-	  (format port " * to   ~a~%" outfile)
-	  (format port " */~%")
-	  (let ((n (nchunks)))
-	    (do ((i 0 (+ i 1)))
-		((= i n))
-	      (format port "extern const long p~s[~s];~%" i 
-		      (quotient (heap:length (vector-ref   pure i)) 4)))
-	    (do ((i 0 (+ i 1)))
-		((= i n))
-	      (format port "extern long i~s[~s];~%" i
-		      (quotient (heap:length (vector-ref impure i)) 4))))
-	  (table-walk
-	   (lambda (address name)
-	     (format port "const extern ~a();~%" name))
-	   externs)
-	  )))
-
-    (define (d-vector-for-each proc d-vector)
-      (do ((i 0 (+ i 1)))
-	  ((>= i (d-vector-length d-vector)))
-	(proc (d-vector-ref d-vector i))))
-
-    (define (write-c-image pure impure reloc externs prefix)
-      (message "Writing   pure c files")
-      (scsh-write-c-image   pure "p" "const " reloc externs prefix)
-      (message "Writing impure c files")
-      (scsh-write-c-image impure "i" ""       reloc externs prefix))
-
-    (define (scsh-write-c-image heap name const reloc externs prefix)
-      (let ((n (nchunks)))
-	(let chunk-loop ((c 0))
-	  (cond ((not (= c n))
-		 (format #t "Writing ~a-~a~s.c~%" prefix name c)
-		 (call-with-output-file 
-		     (format #f "~a-~a~s.c" prefix name c)
-		   (lambda (port)	     
-		     (format port "#include \"~a.h\"~%" prefix)
-		     (format port "~a long ~a~s[]={~%" const name c)
-		     (let ((heap (vector-ref heap c)))
-		       (let heap-loop ((l (heap:objects heap)))
-			 (cond ((not (null? l))
-				(scsh-emit-initializer (car l) reloc externs port)
-				(heap-loop (cdr l))))))
-		     (display "};" port)
-		     (newline port)))
-		 (chunk-loop (+ 1 c)))))))
-
-    (define (write-main-c-file start reloc prefix)
-      (let ((n (nchunks)))
-	(call-with-output-file (string-append prefix ".c")
-	  (lambda (port)
-	    (format port "#include \"~a.h\"~%" prefix)
-	    (format port "const long p_count = ~s;~%" n)
-	    (format port "const long i_count = ~s;~%" n)
-	    
-	    (format port "const long * const p_areas[~s] = {" n)
-	    (do ((i 0 (+ i 1)))
-		((= i n))
-	      (format port "(const long *) &p~s, " i))
-	    (format port "};~%")
-
-	    (format port "long * const i_areas[~s] = {" n)
-	    (do ((i 0 (+ i 1)))
-		((= i n))
-	      (format port "(long *) &i~s, " i))
-	    (format port "};~%")
-
-	    (format port "const long p_sizes[~s] = {" n)
-	    (do ((i 0 (+ i 1)))
-		((= i n))
-	      (format port "sizeof(p~s), " i))
-	    (format port "};~%")
-
-	    (format port "const long i_sizes[~s] = {" n)
-	    (do ((i 0 (+ i 1)))
-		((= i n))
-	      (format port "sizeof(i~s), " i))
-	    (format port "};~%")
-
-	    (display "const long entry = " port)
-	    (scsh-emit-descriptor start reloc port)
-	    (write-char #\; port)
-	    (newline port)))))
-
-    (define (compile-c-files cc-command prefix)
-      (let ((n (nchunks))
-	    (cc (line->list cc-command)))
-	(message "Compiling main C file")
-	(run (,@(append cc (list (format #f "~a.c" prefix)))))
-	(do ((i 0 (+ i 1)))
-	    ((= i n))
-	  (message "Compiling C file for   pure chunk " i)
-	  (run (,@(append cc 
-			  (list (format #f "~a-p~s.c" prefix i)))))
-	  (message "Compiling C file for impure chunk " i)
-	  (run (,@(append cc 
-			  (list (format #f "~a-i~s.c" prefix i))))))))
-
-    (define (archive-files ar-command outfile prefix)
-      (let ((n (nchunks))
-	    (ar (line->list ar-command)))
-	(message "Archiving object files")
-	(run (,@(append 
-		 ar
-		 (cons 
-		  outfile
-		  (let loop ((i 0)
-			     (l '()))
-		    (cond ((not (= i n))
-			   (loop (+ i 1)
-				 (cons 
-				  (format #f "~a-i~s.o" prefix i)
-				  (cons
-				   (format #f "~a-p~s.o" prefix i)
-				   l))))
-			  (else 
-			   (reverse 		
-			    (cons 
-			     (string-append prefix ".o")
-			     l)))))))))))
-
-    (define (scsh-emit-initializer x reloc externs port)
-      (write-hex port (stob-header x))
-      (cond ((d-vector? x)
-	     (scsh-emit-d-vector-initializer x reloc port))
-	    ((vm-string? x)
-	     (scsh-emit-vm-string-initializer x port))
-	    (else
-	     (scsh-emit-b-vector-initializer x reloc externs port)))
-      (if *comments?*
-	  (begin (display " /* " port)
-		 (writex x port)
-		 (display " */" port)))
-      (newline port))
-
-
-    (define (scsh-emit-d-vector-initializer x reloc port)
-      (let ((len (d-vector-length x)))
-	(do ((i 0 (+ i 1)))
-	    ((= i len))
-	  (scsh-emit-descriptor (d-vector-ref x i) reloc port)
-	  (write-char #\, port))))
-
-    (define (scsh-emit-vm-string-initializer x port)
-      (let* ((len (vm-string-length x))	; end is jawilson style hack
-	     (end (- (cells->bytes (bytes->cells (+ len 1))) 4)))
-	(do ((i 0 (+ i 4)))
-	    ((= i end) 
-	     (case (- len end)
-	       ((0)
-		(write-hex port 0))
-	       ((1)
-		(write-hex
-		 port
-		 (net-to-host-32 (arithmetic-shift 
-				  (char->ascii (vm-string-ref x i)) 24))))
-	       ((2)
-		(write-hex 
-		 port
-		 (net-to-host-32 
-		  (bitwise-ior
-		   (arithmetic-shift
-		    (char->ascii (vm-string-ref x i))       24)
-		   (arithmetic-shift
-		    (char->ascii (vm-string-ref x (+ i 1))) 16)))))
-	       ((3)
-		(write-hex
-		 port
-		 (net-to-host-32
-		  (bitwise-ior
-		   (bitwise-ior
-		    (arithmetic-shift 
-		     (char->ascii (vm-string-ref x i))       24)
-		    (arithmetic-shift 
-		     (char->ascii (vm-string-ref x (+ i 1))) 16))
-		   (arithmetic-shift  
-		    (char->ascii (vm-string-ref x (+ i 2)))  8)))))))
-	  (write-hex port
-		     (net-to-host-32 (bitwise-ior
-				      (bitwise-ior
-				       (arithmetic-shift 
-					(char->ascii (vm-string-ref x i))       24)
-				       (arithmetic-shift 
-					(char->ascii (vm-string-ref x (+ i 1))) 16))
-				      (bitwise-ior
-				       (arithmetic-shift 
-					(char->ascii (vm-string-ref x (+ i 2)))  8)
-				       (char->ascii  (vm-string-ref x (+ i 3))))))
-		     ))))
-
-    (define (scsh-emit-b-vector-initializer x reloc externs port)
-      (cond ((and (code-vector? x)
-		  (table-ref externs x)) =>
-		  (lambda (name)
-		    (format port "(long) *~a," name)))
-	    (else 
-	     (let* ((len (b-vector-length x)) ;end is jawilson style hack
-		    (end (- (cells->bytes (bytes->cells (+ len 1))) 4)))
-	       (do ((i 0 (+ i 4)))
-		   ((= i end)
-		    (case (- len end)
-		      ((1)
-		       (write-hex
-			port
-			(net-to-host-32 (arithmetic-shift (b-vector-ref x i) 24))))
-		      ((2)
-		       (write-hex 
-			port
-			(net-to-host-32
-			 (bitwise-ior
-			  (arithmetic-shift (b-vector-ref x i)       24)
-			  (arithmetic-shift (b-vector-ref x (+ i 1)) 16)))))
-		      ((3)
-		       (write-hex
-			port
-			(net-to-host-32
-			 (bitwise-ior
-			  (bitwise-ior
-			   (arithmetic-shift (b-vector-ref x i)       24)
-			   (arithmetic-shift (b-vector-ref x (+ i 1)) 16))
-			  (arithmetic-shift  (b-vector-ref x (+ i 2))  8)))
-			))))
-		 (write-hex 
-		  port
-		  (net-to-host-32 (bitwise-ior
-				   (bitwise-ior
-				    (arithmetic-shift (b-vector-ref x i)       24)
-				    (arithmetic-shift (b-vector-ref x (+ i 1)) 16))
-				   (bitwise-ior
-				    (arithmetic-shift (b-vector-ref x (+ i 2))  8)
-				    (b-vector-ref x (+ i 3))))))))
-	     )))
-
-    (define (scsh-emit-descriptor x reloc port)
-      (if (stob? x)
-	  (let ((n (chunk-number x)))
-	    (display "(long)(&" port)
-	    (if (immutable? x)
-		(display "p" port)
-		(display "i" port))
-	    (display n port)
-	    (display "[" port)
-	    (display (quotient (table-ref (vector-ref reloc n) x) 4) port)
-	    (display "])+7" port))
-	  (format port 
-		  (if (negative? x) "-0x~a" "0x~a")
-		  (number->string (abs x) 16))))
-
-    (define (scsh-for-each-stored-object chunk-start proc chunk-end)
-      (let ((limit (heap-pointer)))
-	(let chunk-loop ((addr (newspace-begin))
-			 (i 0)
-			 (chunk (+ (newspace-begin) *chunk-size*)))
-	  (if (addr< addr limit)
-	      (begin (chunk-start i)
-		     (let loop ((addr addr))
-		       (if (and (addr< addr limit)
-				(addr< addr chunk))
-			   (let* ((d   (fetch addr))
-				  (len (addr1+ (header-a-units d))))
-			     (if (not (header? d))
-				 (warn "heap is in an inconsistent state" d))
-			     (proc i (address->stob-descriptor (addr1+ addr)) len)
-			     (loop (addr+ addr len)))
-			   (begin (chunk-end i)
-				  (chunk-loop addr
-					      (+ i 1)
-					      (+ chunk *chunk-size*))))))))))
-
-    (define (write-hex port x) 
-      (format port 
-	      (if (negative? x) "-0x~a," "0x~a,")
-	      (number->string (abs x) 16)))
-
-    ;; takes a string and break it into a list at whitespace
-    ;; rewrite using scsh stuff?
-    (define (line->list line)
-      (let ((len (string-length line)))
-	(let loop ((start 0)
-		   (end 0)
-		   (l '()))
-	  (cond ((>= end len)
-		 (if (= start end)
-		     l
-		     (append l (list (substring line start end)))))
-		((and (= start end)
-		      (or (char=? (string-ref line start) (ascii->char 32))
-			  (char=? (string-ref line start) (ascii->char 9))))
-		 (loop (+ 1 start) 
-		       (+ 1 end) 
-		       l))
-		((or (char=? (string-ref line end) (ascii->char 32))
-		     (char=? (string-ref line end) (ascii->char 9)))
-		 (loop (+ 1 end) 
-		       (+ 1 end) 
-		       (append l (list (substring line start end)))))
-		((< end len)
-		 (loop start 
-		       (+ 1 end)
-		       l))
-		(else (error "unexpected case in line->list"))))))
-
-;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
-;;; Debugging
-;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
-
-    (define (bin n)
-      (number->string n 2))
-
-    (define (oct n)
-      (number->string n 8))
-
-    (define (dec n)
-      (number->string n 10))
-
-    (define (hex n)
-      (number->string n 16))
-
-;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
-
-    ; For example:
-    ;   (do-it 100000 "~/s48/debug/little.image" "little-heap.c")
-    ;
-    ; The first argument to do-it should be somewhat larger than the size,
-    ; in bytes, of the image file to be converted (which you can obtain with
-    ; "ls -l").
-    ;
-    ; If the image contains 0-length stored objects, then the .c file will
-    ; have to be compiled by gcc, since 0-length arrays aren't allowed in
-    ; ANSI C.  This wouldn't be difficult to work around.
-    
-    (define *comments?* #f)
-    
-    ; 800,000 bytes => 200,000 words => at least 100,000 objects
-    ;   50 chunks => 16,000 bytes per chunk => 2,000 objects per chunk
-    (define *chunk-size* 10000)
-
-    (define (do-it bytes infile outfile)
-      (let ((start (init bytes infile)))
-	(call-with-output-file outfile
-	  (lambda (port)
-	    (format port "#define D(x) (long)(&x)+7~%")
-	    (format port "#define H unsigned long~%")
-	    (emit-area-declarations "p" immutable? "const " port)
-	    (emit-area-declarations "i" mutable? "" port)
-	    (emit-area-initializers "p" immutable? "const " port)
-	    (emit-area-initializers "i" mutable? "" port)
-	    (display "const long entry = " port)
-	    (emit-descriptor start port)
-	    (write-char #\; port)
-	    (newline port)))))
-
-    (define (init bytes infile)
-      (create-memory (quotient bytes 2) quiescent) ;Output of ls -l
-      (initialize-heap (memory-begin) (memory-size))
-      (let ((start (read-image infile 0)))
-	(message (nchunks)
-		 " chunks")
-	start))
-
-    (define (nchunks) (+ (chunk-number (heap-pointer)) 1))
-
-					; emit struct declarations for areas
-
-    (define (emit-area-declarations name in-area? const port)
-      (for-each-stored-object
-       (lambda (chunk)
-	 (message name chunk " declaration")
-	 (display "struct " port) (display name port) (display chunk port)
-	 (display " {" port) (newline port))
-       (lambda (x)
-	 (if (in-area? x)
-	     (emit-declaration x port)))
-       (lambda (chunk)
-	 (display "};" port)
-	 (newline port)
-	 (display const port)
-	 (display "extern struct " port) (display name port) (display chunk port)
-	 (write-char #\space port) (display name port) (display chunk port)
-	 (write-char #\; port) (newline port)
-	 chunk)))
-
-    (define (emit-declaration x port)
-      (display "  H x" port)
-      (writex x port)
-      (cond ((d-vector? x)
-	     (display "; long d" port)
-	     (writex x port)
-	     (write-char #\[ port)
-	     (write (d-vector-length x) port))
-	    ((vm-string? x)
-	     (display "; char d" port)
-	     (writex x port)
-	     (write-char #\[ port)
-	     ;; Ensure alignment (thanks Ian)
-	     (write (cells->bytes (bytes->cells (b-vector-length x)))
-		    port))
-	    (else
-	     (display "; unsigned char d" port)
-	     (writex x port)
-	     (write-char #\[ port)
-	     ;; Ensure alignment
-	     (write (cells->bytes (bytes->cells (b-vector-length x)))
-		    port)))
-      (display "];" port)
-      (if *comments?*
-	  (begin (display " /* " port)
-		 (display (enumerand->name (stob-type x) stob) port)
-		 (display " */" port)))
-      (newline port))
-
-					; Emit initializers for areas
-
-    (define (emit-area-initializers name in-area? const port)
-      (for-each-stored-object
-       (lambda (chunk)
-	 (message name chunk " initializer")
-
-	 (display const port)
-	 (display "struct " port) (display name port) (write chunk port)
-	 (write-char #\space port) (display name port) (write chunk port)
-	 (display " =" port) (newline port)
-
-	 (write-char #\{ port) (newline port))
-       (lambda (x)
-	 (if (in-area? x)
-	     (emit-initializer x port)))
-       (lambda (chunk)
-	 (display "};" port) (newline port)))
-
-      (let ((n (nchunks)))
-	(format port "const long ~a_count = ~s;~%" name n)
-	(format port "~a long * const ~a_areas[~s] = {" const name n)
-	(do ((i 0 (+ i 1)))
-	    ((= i n))
-	  (format port "(~a long *)&~a~s, " const name i))
-	(format port "};~%const long ~a_sizes[~s] = {" name n)
-	(do ((i 0 (+ i 1)))
-	    ((= i n))
-	  (format port "sizeof(~a~s), " name i))
-	(format port "};~%")))
-
-
-    (define (message . stuff)
-      (for-each display stuff) (newline))
-
-    (define (emit-initializer x port)
-      (display "  " port)
-      (write (stob-header x) port)
-      (write-char #\, port)
-      (cond ((d-vector? x)
-	     (emit-d-vector-initializer x port))
-	    ((vm-string? x)
-	     (write-char #\" port)
-	     (let ((len (vm-string-length x)))
-	       (do ((i 0 (+ i 1)))
-		   ((= i len) (write-char #\" port))
-		 (let ((c (vm-string-ref x i)))
-		   (cond ((or (char=? c #\") (char=? c #\\))
-			  (write-char #\\ port))
-			 ((char=? c #\newline)
-			  (display "\\n\\" port)))
-		   (write-char c port)))))
-	    (else
-	     (write-char #\{ port)
-	     (let ((len (b-vector-length x)))
-	       (do ((i 0 (+ i 1)))
-		   ((= i len) (write-char #\} port))
-		 (write (b-vector-ref x i) port)
-		 (write-char #\, port)))))
-      (write-char #\, port)
-      (if *comments?*
-	  (begin (display " /* " port)
-		 (writex x port)
-		 (display " */" port)))
-      (newline port))
-
-    (define (emit-d-vector-initializer x port)
-      (write-char #\{ port)
-      (let ((len (d-vector-length x)))
-	(do ((i 0 (+ i 1)))
-	    ((= i len) (write-char #\} port))
-	  (emit-descriptor (d-vector-ref x i) port)
-	  (write-char #\, port))))
-
-    (define (emit-descriptor x port)
-      (if (stob? x)
-	  (begin (if (immutable? x)
-		     (display "D(p" port)
-		     (display "D(i" port))
-		 (display (chunk-number x) port)
-		 (display ".x" port)
-		 (writex x port)
-		 (write-char #\) port))
-	  (write x port)))
-
-
-					; Foo
-
-    (define (writex x port)
-      (write (quotient (- (- x (memory-begin)) 7) 4) port))
-
-    (define (chunk-number x)
-      (quotient (- (- x (memory-begin)) 7) *chunk-size*))
-
-
-					; Image traversal utility
-
-    (define (for-each-stored-object chunk-start proc chunk-end)
-      (let ((limit (heap-pointer)))
-	(let chunk-loop ((addr (newspace-begin))
-			 (i 0)
-			 (chunk (+ (newspace-begin) *chunk-size*)))
-	  (if (addr< addr limit)
-	      (begin (chunk-start i)
-		     (let loop ((addr addr))
-		       (if (and (addr< addr limit)
-				(addr< addr chunk))
-			   (let ((d (fetch addr)))
-			     (if (not (header? d))
-				 (warn "heap is in an inconsistent state" d))
-			     (proc (address->stob-descriptor (addr1+ addr)))
-			     (loop (addr1+ (addr+ addr (header-a-units d)))))
-			   (begin (chunk-end i)
-				  (chunk-loop addr
-					      (+ i 1)
-					      (+ chunk *chunk-size*))))))))))
-
-    (define (mutable? x) (not (immutable? x)))
-
-    ;; End begin
-    ))