From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 17 Mar 1987 18:55:18 +0000 (+0000)
Subject: Change runtime system so that a lambda's name is not considered a
X-Git-Tag: 20090517-FFI~13672
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2a5f5533bdd05e574fe18932cd0a78a314e6f663;p=mit-scheme.git

Change runtime system so that a lambda's name is not considered a
bound variable.  Eliminate all references to `#!false' and `#!true'.
Eliminate `canonicalize-filename-string', since pathname parsing is
now system-dependent.  Install new quasiquote expander which does
vectors.  Teach `eqv?' to handle null length vectors.  Eliminate
`make-package' special form.
---

diff --git a/v7/src/runtime/advice.scm b/v7/src/runtime/advice.scm
index cde21047a..b700cbc83 100644
--- a/v7/src/runtime/advice.scm
+++ b/v7/src/runtime/advice.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/advice.scm,v 13.41 1987/01/23 00:07:35 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/advice.scm,v 13.42 1987/03/17 18:48:26 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -40,19 +40,28 @@
 ;;;; Advice package
 
 (declare (usual-integrations))
-
+
 (define advice-package
-  (make-package advice-package
-		((the-args)
-		 (the-procedure)
-		 (the-result)
-
-		 (entry-advice-population (make-population))
-		 (exit-advice-population (make-population))
-		 )
-(define (*args*) the-args)
-(define (*proc*) the-procedure)
-(define (*result*) the-result)
+  (make-environment
+
+(define the-args)
+(define the-procedure)
+(define the-result)
+
+(define (*args*)
+  the-args)
+
+(define (*proc*)
+  the-procedure)
+
+(define (*result*)
+  the-result)
+
+(define entry-advice-population
+  (make-population))
+
+(define exit-advice-population
+  (make-population))
 
 ;;;; Advice Wrappers
 
@@ -457,5 +466,4 @@
 
 (define *args*   (access *args* advice-package))
 (define *proc*   (access *proc* advice-package))
-(define *result* (access *result* advice-package))
 (define *result* (access *result* advice-package))
\ No newline at end of file
diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm
index 994400635..b7703a711 100644
--- a/v7/src/runtime/debug.scm
+++ b/v7/src/runtime/debug.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 13.41 1987/01/23 00:11:14 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/debug.scm,v 13.42 1987/03/17 18:49:00 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -540,8 +540,6 @@
 	       lambda-tag:shallow-fluid-let
 	       lambda-tag:deep-fluid-let
 	       lambda-tag:common-lisp-fluid-let
-	       lambda-tag:make-environment
-	       lambda-tag:make-package)))
+	       lambda-tag:make-environment)))
     (named-lambda (special-name? symbol)
-      (memq symbol the-special-names))))
       (memq symbol the-special-names))))
\ No newline at end of file
diff --git a/v7/src/runtime/equals.scm b/v7/src/runtime/equals.scm
index 872c8ee32..8ed005d02 100644
--- a/v7/src/runtime/equals.scm
+++ b/v7/src/runtime/equals.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/equals.scm,v 13.41 1987/01/23 00:11:42 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/equals.scm,v 13.42 1987/03/17 18:49:17 cph Rel $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -54,9 +54,12 @@
   (if (eq? x y)
       true
       (and (primitive-type? (primitive-type x) y)
-	   (or (type? big-fixnum y)
-	       (type? big-flonum y))
-	   (= x y))))
+	   (or (and (or (type? big-fixnum y)
+			(type? big-flonum y))
+		    (= x y))
+	       (and (type? vector y)
+		    (zero? (vector-length x))
+		    (zero? (vector-length y)))))))
 
 (define (equal? x y)
   (if (eq? x y)
diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index 65c86e988..38cd8c633 100644
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 13.43 1987/02/15 15:42:08 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 13.44 1987/03/17 18:49:27 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -66,7 +66,7 @@
 
 (define *error-code*)
 (define *error-hook*)
-(define *error-decision-hook* #F)
+(define *error-decision-hook* false)
 
 (define error-message
   "")
@@ -82,7 +82,7 @@
    (lambda ()
      (fluid-let ((error-message message)
 		 (error-irritant irritant))
-       (*error-hook* environment message irritant #!FALSE)))))
+       (*error-hook* environment message irritant false)))))
 
 (define ((error-handler-wrapper handler) error-code interrupt-enables)
   (with-interrupts-reduced INTERRUPT-MASK-GC-OK
@@ -102,8 +102,8 @@
 	      (error-irritant irritant))
     (let ((environment (continuation-environment (rep-continuation))))
       (if (continuation-undefined-environment? environment)
-	  (*error-hook* (rep-environment) message irritant #!TRUE)
-	  (*error-hook* environment message irritant #!FALSE)))))
+	  (*error-hook* (rep-environment) message irritant true)
+	  (*error-hook* environment message irritant false)))))
 
 (define (standard-error-hook environment message irritant
 			     substitute-environment?)
@@ -328,7 +328,7 @@ using the current read-eval-print environment."))
   combination-second-operand)
 
 (define-unbound-variable-error
-  (list (make-primitive-procedure 'ADD-FLUID-BINDING! #!true))
+  (list (make-primitive-procedure 'ADD-FLUID-BINDING! true))
   (lambda (obj)
     (let ((object (combination-second-operand obj)))
       (cond ((variable? object) (variable-name object))
@@ -361,8 +361,8 @@ using the current read-eval-print environment."))
 (define-assignment-to-procedure-error
   (list (make-primitive-procedure 'LEXICAL-ASSIGNMENT)
 	(make-primitive-procedure 'LOCAL-ASSIGNMENT)
-	(make-primitive-procedure 'ADD-FLUID-BINDING! #!true)
-	(make-primitive-procedure 'MAKE-FLUID-BINDING! #!true))
+	(make-primitive-procedure 'ADD-FLUID-BINDING! true)
+	(make-primitive-procedure 'MAKE-FLUID-BINDING! true))
   combination-second-operand)
 
 ;;;; Application Errors
diff --git a/v7/src/runtime/events.scm b/v7/src/runtime/events.scm
index 755652b0f..e373644e5 100644
--- a/v7/src/runtime/events.scm
+++ b/v7/src/runtime/events.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/events.scm,v 13.41 1987/01/23 00:12:11 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/events.scm,v 13.42 1987/03/17 18:49:40 cph Rel $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -52,22 +52,21 @@
 	  (define receivers '())
 	  (define queue-head '())
 	  (define queue-tail '())
-	  (define event-in-progress? #!FALSE)
-
+	  (define event-in-progress? false)
 	  (lambda arguments
 	    (if (null? queue-head)
 		(begin (set! queue-head (list arguments))
 		       (set! queue-tail queue-head))
 		(begin (set-cdr! queue-tail (list arguments))
 		       (set! queue-tail (cdr queue-tail))))
-	    (if (not (set! event-in-progress? #!TRUE))
+	    (if (not (set! event-in-progress? true))
 		(begin (let ((arguments (car queue-head)))
 			 (set! queue-head (cdr queue-head))
 			 (let loop ((receivers receivers))
 			      (if (not (null? receivers))
 				  (begin (apply (car receivers) arguments)
 					 (loop (cdr receivers))))))
-		       (set! event-in-progress? #!FALSE))))))
+		       (set! event-in-progress? false))))))
 
   (set! event-distributor?
 	(named-lambda (event-distributor? object)
@@ -85,8 +84,7 @@
       (without-interrupts
        (lambda ()
 	 (set! (access receivers e)
-	       (operation event-receiver
-			  (access receivers e)))))))
+	       (operation event-receiver (access receivers e)))))))
 
   (set! add-event-receiver!
 	(make-receiver-modifier 'ADD-EVENT-RECEIVER!
@@ -94,8 +92,6 @@
 	    (append! receivers (list receiver)))))
 
   (set! remove-event-receiver!
-	(make-receiver-modifier 'REMOVE-EVENT-RECEIVER!
-	  delq!))
+	(make-receiver-modifier 'REMOVE-EVENT-RECEIVER! delq!))
 
-)
 )
\ No newline at end of file
diff --git a/v7/src/runtime/format.scm b/v7/src/runtime/format.scm
index e1fb1057f..42536804f 100644
--- a/v7/src/runtime/format.scm
+++ b/v7/src/runtime/format.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/format.scm,v 13.41 1987/01/23 00:12:19 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/format.scm,v 13.42 1987/03/17 18:49:48 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -138,11 +138,9 @@
 
 (define (parse-digit string supplied-arguments parsed-arguments modifiers
 		     receiver)
-  (let accumulate ((acc (char->digit (string-ref string 0) 10))
-		   (i 1))
+  (let accumulate ((acc (char->digit (string-ref string 0) 10)) (i 1))
     (if (char-numeric? (string-ref string i))
-	(accumulate (+ (* acc 10)
-		       (char->digit (string-ref string i) 10))
+	(accumulate (+ (* acc 10) (char->digit (string-ref string i) 10))
 		    (1+ i))
 	(parse-dispatch (string-tail string i)
 			supplied-arguments
@@ -152,11 +150,8 @@
 
 (define (parse-ignore string supplied-arguments parsed-arguments modifiers
 		      receiver)
-  (parse-dispatch (string-tail string 1)
-		  supplied-arguments
-		  parsed-arguments
-		  modifiers
-		  receiver))
+  (parse-dispatch (string-tail string 1) supplied-arguments parsed-arguments
+		  modifiers receiver))
 
 (define (parse-arity string supplied-arguments parsed-arguments modifiers
 		     receiver)
@@ -232,7 +227,7 @@
       (error "Too few arguments" 'FORMAT string))
   (if (unassigned? n-columns)
       (*unparse-string (car arguments))
-      (unparse-string-into-fixed-size (car arguments) #!FALSE
+      (unparse-string-into-fixed-size (car arguments) false
 				      n-columns modifiers))
   (receiver string (cdr arguments)))
 
@@ -279,8 +274,7 @@
 	  ((memq 'COLON modifiers)
 	   (*unparse-string (substring string 0 (- n-columns 4)))
 	   (*unparse-string " ..."))
-	  (else
-	   (*unparse-string (substring string 0 n-columns))))))
+	  (else (*unparse-string (substring string 0 n-columns))))))
 
 ;;;; Dispatcher Setup
 
@@ -318,7 +312,7 @@
 (add-dispatcher! #\V parse-argument)
 (add-dispatcher! #\@ (parse-modifier 'AT))
 (add-dispatcher! #\: (parse-modifier 'COLON))
-
+
 ;;;
 ;;; (format format-string arg arg ...)
 ;;; (format port format-string arg arg ...)
@@ -354,5 +348,4 @@
 (add-dispatcher! #\C (format-wrapper format-code))
 
 ;;; end LET.
-)
 )
\ No newline at end of file
diff --git a/v7/src/runtime/gcstat.scm b/v7/src/runtime/gcstat.scm
index 520c84775..3428185cf 100644
--- a/v7/src/runtime/gcstat.scm
+++ b/v7/src/runtime/gcstat.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gcstat.scm,v 13.41 1987/01/23 00:13:34 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/gcstat.scm,v 13.42 1987/03/17 18:50:11 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -46,7 +46,7 @@
 (define gc-history-mode)
 
 (define gc-statistics-package
-  (make-package gc-statistics-package ()
+  (make-environment
 
 ;;;; Statistics Hooks
 
@@ -57,7 +57,7 @@
   (with-interrupts-reduced INTERRUPT-MASK-NONE
     (lambda (Old-Interrupt-Mask)
      (measure-interval
-      #!FALSE		;i.e. do not count the interval in RUNTIME.
+      false			;i.e. do not count the interval in RUNTIME.
       (lambda (start-time)
 	(let ((old-state (gc-start-hook)))
 	  (let ((new-space-remaining (primitive-datum (apply old-flip more))))
@@ -81,7 +81,7 @@
 (define (statistics-reset!)
   (set! meter 1)
   (set! total-gc-time 0)
-  (set! last-gc-start #!FALSE)
+  (set! last-gc-start false)
   (set! last-gc-end (system-clock))
   (reset-recorder! '()))
 
@@ -105,7 +105,7 @@
 (define history)
 
 (define (reset-recorder! old)
-  (set! last-statistic #!FALSE)
+  (set! last-statistic false)
   (reset-history! old))
 
 (define (record-statistic! statistic)
@@ -269,5 +269,4 @@
 	     (write-string "%) free: ") (write heap-left)))
 	 (vector->list statistic)))
 
-)
 )
\ No newline at end of file
diff --git a/v7/src/runtime/histry.scm b/v7/src/runtime/histry.scm
index acb25be16..9d7be55ab 100644
--- a/v7/src/runtime/histry.scm
+++ b/v7/src/runtime/histry.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/histry.scm,v 13.42 1987/02/15 15:43:36 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/histry.scm,v 13.43 1987/03/17 18:50:22 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -46,31 +46,30 @@
 (define with-new-history)
 
 (define history-package
-  (make-package history-package
-		((set-current-history!
-		  (make-primitive-procedure 'SET-CURRENT-HISTORY!))
-		 (return-address-pop-from-compiled-code
-		  (make-return-address
-		   (microcode-return 'POP-FROM-COMPILED-CODE)))
-
-		 ;; VERTEBRA abstraction.
-		 (make-vertebra (make-primitive-procedure 'HUNK3-CONS))
-		 (vertebra-rib system-hunk3-cxr0)
-		 (deeper-vertebra system-hunk3-cxr1)
-		 (shallower-vertebra system-hunk3-cxr2)
-		 (set-vertebra-rib! system-hunk3-set-cxr0!)
-		 (set-deeper-vertebra! system-hunk3-set-cxr1!)
-		 (set-shallower-vertebra! system-hunk3-set-cxr2!)
-
-		 ;; REDUCTION abstraction.
-		 (make-reduction (make-primitive-procedure 'HUNK3-CONS))
-		 (reduction-expression system-hunk3-cxr0)
-		 (reduction-environment system-hunk3-cxr1)
-		 (next-reduction system-hunk3-cxr2)
-		 (set-reduction-expression! system-hunk3-set-cxr0!)
-		 (set-reduction-environment! system-hunk3-set-cxr1!)
-		 (set-next-reduction! system-hunk3-set-cxr2!)
-		 )
+  (let ((set-current-history!
+	 (make-primitive-procedure 'SET-CURRENT-HISTORY!))
+	(return-address-pop-from-compiled-code
+	 (make-return-address
+	  (microcode-return 'POP-FROM-COMPILED-CODE)))
+
+	;; VERTEBRA abstraction.
+	(make-vertebra (make-primitive-procedure 'HUNK3-CONS))
+	(vertebra-rib system-hunk3-cxr0)
+	(deeper-vertebra system-hunk3-cxr1)
+	(shallower-vertebra system-hunk3-cxr2)
+	(set-vertebra-rib! system-hunk3-set-cxr0!)
+	(set-deeper-vertebra! system-hunk3-set-cxr1!)
+	(set-shallower-vertebra! system-hunk3-set-cxr2!)
+
+	;; REDUCTION abstraction.
+	(make-reduction (make-primitive-procedure 'HUNK3-CONS))
+	(reduction-expression system-hunk3-cxr0)
+	(reduction-environment system-hunk3-cxr1)
+	(next-reduction system-hunk3-cxr2)
+	(set-reduction-expression! system-hunk3-set-cxr0!)
+	(set-reduction-environment! system-hunk3-set-cxr1!)
+	(set-next-reduction! system-hunk3-set-cxr2!)
+	)
 
 (declare (integrate-primitive-procedures
 	  (make-vertebra hunk3-cons)
@@ -118,15 +117,13 @@
 
 (define (create-history depth width)
   (define (new-vertebra)
-    (let ((head (make-reduction #!FALSE #!FALSE '())))
+    (let ((head (make-reduction false false '())))
       (set-next-reduction!
        head
        (let reduction-loop ((n (-1+ width)))
 	 (if (zero? n)
 	     head
-	     (make-reduction #!FALSE
-			     #!FALSE
-			     (reduction-loop (-1+ n))))))
+	     (make-reduction false false (reduction-loop (-1+ n))))))
       (make-vertebra head '() '())))
 
   (cond ((or (not (integer? depth))
@@ -152,23 +149,24 @@
 ;;; SET-CURRENT-HISTORY! is run.
 
 (set! with-new-history
-      (named-lambda (with-new-history thunk)
-	(set-current-history!
-	 (let ((history (push-history! (create-history max-subproblems
-						       max-reductions))))
-	   (if (zero? max-subproblems)
-
-	       ;; In this case, we want the history to appear empty,
-	       ;; so when it pops up, there is nothing in it.
-	       history
-
-	       ;; Otherwise, record a dummy reduction, which will appear
-	       ;; in the history.
-	       (begin
-		(record-evaluation-in-history! history
-					       (scode-quote #!FALSE)
-					       system-global-environment)
-		(push-history! history)))))
+  (named-lambda (with-new-history thunk)
+    (set-current-history!
+     (let ((history
+	    (push-history! (create-history max-subproblems
+					   max-reductions))))
+       (if (zero? max-subproblems)
+
+	   ;; In this case, we want the history to appear empty,
+	   ;; so when it pops up, there is nothing in it.
+	   history
+
+	   ;; Otherwise, record a dummy reduction, which will appear
+	   ;; in the history.
+	   (begin
+	    (record-evaluation-in-history! history
+					   (scode-quote #F)
+					   system-global-environment)
+	    (push-history! history)))))
 	(thunk)))
 
 ;;;; Primitive History Operations
@@ -202,8 +200,7 @@
   (let loop ((current history))
     (cons current
 	  (if (marked-vertebra? current)
-	      (cons (delay
-		     (unfold-and-reverse-rib (vertebra-rib current)))
+	      (cons (delay (unfold-and-reverse-rib (vertebra-rib current)))
 		    (delay
 		     (let ((next (shallower-vertebra current)))
 		       (if (eq? next history)
@@ -218,8 +215,7 @@
 	    (reduction-environment reduction))))
 
 (define (unfold-and-reverse-rib rib)
-  (let loop ((current (next-reduction rib))
-	     (output 'WRAP-AROUND))
+  (let loop ((current (next-reduction rib)) (output 'WRAP-AROUND))
     (let ((step
 	   (if (dummy-compiler-reduction? current)
 	       '()
@@ -230,8 +226,7 @@
 			 output)))))
       (if (eq? current rib)
 	  step
-	  (loop (next-reduction current)
-		step)))))
+	  (loop (next-reduction current) step)))))
 
 (define the-empty-history
   (cons (vector-ref (get-fixed-objects-vector)
diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm
index 9e8211cba..91994809e 100644
--- a/v7/src/runtime/input.scm
+++ b/v7/src/runtime/input.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 13.42 1987/03/12 02:20:33 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 13.43 1987/03/17 18:50:41 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -129,7 +129,7 @@
   'DONE)
 
 (define character-buffer
-  #!FALSE)
+  false)
 
 (define (:peek-char)
   (or character-buffer
@@ -137,11 +137,11 @@
 	     character-buffer)))
 
 (define (:discard-char)
-  (set! character-buffer #!FALSE))
+  (set! character-buffer false))
 
 (define (:read-char)
   (if character-buffer
-      (set! character-buffer #!FALSE)
+      (set! character-buffer false)
       (tty-read-char)))
 
 (define (:read-string delimiters)
@@ -166,12 +166,11 @@
 
 (define (:read-char-immediate)
   (if character-buffer
-      (set! character-buffer #!FALSE)
+      (set! character-buffer false)
       (tty-read-char-immediate)))
 
 (define (:char-ready? delay)
-  (or character-buffer
-      (tty-read-char-ready? delay)))
+  (or character-buffer (tty-read-char-ready? delay)))
 
 (define (:read-start!)
   (read-start-hook))
@@ -231,7 +230,7 @@
 (define (:length)
   (file-length file-channel))
 
-(define buffer #!FALSE)
+(define buffer false)
 (define start-index 0)
 (define end-index -1)
 
@@ -246,7 +245,7 @@
 
 (define (:close)
   (set! end-index 0)
-  (set! buffer #!FALSE)
+  (set! buffer false)
   ((access close-physical-channel primitive-io) file-channel))
 
 (define (:peek-char)
@@ -444,12 +443,12 @@
 
 (define load)
 (define load-noisily)
-(define load-noisily? #!FALSE)
+(define load-noisily? false)
 (define read-file)
 (let ()
 
 (define default-pathname
-  (make-pathname #!FALSE #!FALSE #!FALSE #!FALSE 'NEWEST))
+  (make-pathname false false false false 'NEWEST))
 
 ;;; This crufty piece of code, once it decides which file to load,
 ;;; does `file-exists?' on that file at least three times!!
@@ -491,7 +490,7 @@
   (if (pair? filename)
       (for-each kernel filename)
       (kernel filename)))
-
+
 (set! load
 (named-lambda (load filename #!optional environment)
   (if (unassigned? environment) (set! environment (rep-environment)))
@@ -500,7 +499,7 @@
 (set! load-noisily
 (named-lambda (load-noisily filename #!optional environment)
   (if (unassigned? environment) (set! environment (rep-environment)))
-  (fluid-let ((load-noisily? #!TRUE))
+  (fluid-let ((load-noisily? true))
     (basic-load filename environment))))
 
 (set! read-file
@@ -544,5 +543,4 @@
     (named-lambda (transcript-off)
       (if (not (photo-close))
 	  (error "Transcript file already closed: TRANSCRIPT-OFF"))
-      *the-non-printing-object*)))
       *the-non-printing-object*)))
\ No newline at end of file
diff --git a/v7/src/runtime/intrpt.scm b/v7/src/runtime/intrpt.scm
index 456533936..c5e0b863f 100644
--- a/v7/src/runtime/intrpt.scm
+++ b/v7/src/runtime/intrpt.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/intrpt.scm,v 13.42 1987/02/15 15:43:59 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/intrpt.scm,v 13.43 1987/03/17 18:50:56 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -46,23 +46,22 @@
 
 (define timer-interrupt
   (let ((setup-timer-interrupt
-	 (make-primitive-procedure 'setup-timer-interrupt #T)))
+	 (make-primitive-procedure 'SETUP-TIMER-INTERRUPT true)))
     (named-lambda (timer-interrupt)
       (setup-timer-interrupt '() '())
       (error "Unhandled Timer interrupt received"))))
 
 (define interrupt-system
-  (make-package interrupt-system
-		((get-next-interrupt-character
-		  (make-primitive-procedure 'GET-NEXT-INTERRUPT-CHARACTER))
-		 (check-and-clean-up-input-channel
-		  (make-primitive-procedure 'CHECK-AND-CLEAN-UP-INPUT-CHANNEL))
-		 (index:interrupt-vector
-		  (fixed-objects-vector-slot 'SYSTEM-INTERRUPT-VECTOR))
-		 (index:termination-vector
-		  (fixed-objects-vector-slot
-		   'MICROCODE-TERMINATIONS-PROCEDURES))
-		 (^Q-Hook '()))
+  (let ((get-next-interrupt-character
+	 (make-primitive-procedure 'GET-NEXT-INTERRUPT-CHARACTER))
+	(check-and-clean-up-input-channel
+	 (make-primitive-procedure 'CHECK-AND-CLEAN-UP-INPUT-CHANNEL))
+	(index:interrupt-vector
+	 (fixed-objects-vector-slot 'SYSTEM-INTERRUPT-VECTOR))
+	(index:termination-vector
+	 (fixed-objects-vector-slot
+	  'MICROCODE-TERMINATIONS-PROCEDURES))
+	(^Q-Hook '()))
 
 ;;;; Soft interrupts
 
@@ -171,22 +170,22 @@
 ; (install-keyboard-interrupt! #\S ^S-interrupt-handler)
 ; (install-keyboard-interrupt! #\Q ^Q-interrupt-handler)
 
-(define STACK-OVERFLOW-SLOT	0)
-(define GC-SLOT			2)
-(define CHARACTER-SLOT		4)
-(define TIMER-SLOT		6)
-
+(define stack-overflow-slot	0)
+(define gc-slot			2)
+(define character-slot		4)
+(define timer-slot		6)
+
 (define (install)
-  (with-interrupts-reduced INTERRUPT-MASK-GC-OK
+  (with-interrupts-reduced interrupt-mask-gc-ok
    (lambda (old-mask)
      (let ((old-system-interrupt-vector
 	    (vector-ref (get-fixed-objects-vector) index:interrupt-vector))
 	   (old-termination-vector
 	    (vector-ref (get-fixed-objects-vector) index:termination-vector)))
        (let ((previous-gc-interrupt
-	      (vector-ref old-system-interrupt-vector GC-SLOT))
+	      (vector-ref old-system-interrupt-vector gc-slot))
 	     (previous-stack-interrupt
-	      (vector-ref old-system-interrupt-vector STACK-OVERFLOW-SLOT))
+	      (vector-ref old-system-interrupt-vector stack-overflow-slot))
 	     (system-interrupt-vector
 	      (vector-cons (vector-length old-system-interrupt-vector)
 			   default-interrupt-handler))
@@ -197,14 +196,14 @@
 		      (vector-grow old-termination-vector
 				   number-of-microcode-terminations)
 		      old-termination-vector)
-		  (vector-cons number-of-microcode-terminations #F))))
+		  (vector-cons number-of-microcode-terminations false))))
 
-	 (vector-set! system-interrupt-vector GC-SLOT previous-gc-interrupt)
-	 (vector-set! system-interrupt-vector STACK-OVERFLOW-SLOT
+	 (vector-set! system-interrupt-vector gc-slot previous-gc-interrupt)
+	 (vector-set! system-interrupt-vector stack-overflow-slot
 		      previous-stack-interrupt)
-	 (vector-set! system-interrupt-vector CHARACTER-SLOT
+	 (vector-set! system-interrupt-vector character-slot
 		      external-interrupt-handler)
-	 (vector-set! system-interrupt-vector TIMER-SLOT
+	 (vector-set! system-interrupt-vector timer-slot
 		      timer-interrupt-handler)
 
 	 ;; slots 4-15 unused.
@@ -245,12 +244,12 @@
   (dynamic-wind
    (lambda ()
      (set! old-handler
-	   (vector-set! interrupt-vector CHARACTER-SLOT old-handler)))
+	   (vector-set! interrupt-vector character-slot old-handler)))
    code
    (lambda ()
-     (vector-set! interrupt-vector CHARACTER-SLOT
+     (vector-set! interrupt-vector character-slot
 		  (set! old-handler
-			(vector-ref interrupt-vector CHARACTER-SLOT)))))))
+			(vector-ref interrupt-vector character-slot)))))))
 
 ;;; end INTERRUPT-SYSTEM package.
 (the-environment)))
\ No newline at end of file
diff --git a/v7/src/runtime/lambda.scm b/v7/src/runtime/lambda.scm
index 4f159b54e..2751b2970 100644
--- a/v7/src/runtime/lambda.scm
+++ b/v7/src/runtime/lambda.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/lambda.scm,v 13.41 1987/01/23 00:15:18 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/lambda.scm,v 13.42 1987/03/17 18:51:08 cph Rel $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -49,18 +49,17 @@
 (define lambda-bound)
 
 (define lambda-package
-  (make-package lambda-package
-		((slambda-type (microcode-type 'LAMBDA))
-		 (slexpr-type (microcode-type 'LEXPR))
-		 (xlambda-type (microcode-type 'EXTENDED-LAMBDA))
-		 (internal-lambda-tag (make-named-tag "INTERNAL-LAMBDA"))
-		 (internal-lexpr-tag (make-named-tag "INTERNAL-LEXPR"))
-		 (lambda-optional-tag (make-interned-symbol "#!OPTIONAL"))
-		 (lambda-rest-tag (make-interned-symbol "#!REST")))
+  (let ((slambda-type (microcode-type 'LAMBDA))
+	(slexpr-type (microcode-type 'LEXPR))
+	(xlambda-type (microcode-type 'EXTENDED-LAMBDA))
+	(internal-lambda-tag (make-named-tag "INTERNAL-LAMBDA"))
+	(internal-lexpr-tag (make-named-tag "INTERNAL-LEXPR"))
+	(lambda-optional-tag (make-interned-symbol "#!OPTIONAL"))
+	(lambda-rest-tag (make-interned-symbol "#!REST")))
 
 (define internal-lambda-tags
   (list internal-lambda-tag internal-lexpr-tag))
-
+
 ;;;; Hairy Advice Wrappers
 
 ;;; The body of a LAMBDA object can be modified by transformation.
@@ -178,15 +177,14 @@
 (define (clambda-bound clambda)
   (slambda-components clambda
     (lambda (name required body)
-      (cons name
-	    (if (combination? body)
-		(let ((operator (combination-operator body)))
-		  (if (is-internal-lambda? operator)
-		      (slambda-components operator
-			(lambda (tag auxiliary body)
-			  (append required auxiliary)))
-		      required))
-		required)))))
+      (if (combination? body)
+	  (let ((operator (combination-operator body)))
+	    (if (is-internal-lambda? operator)
+		(slambda-components operator
+		  (lambda (tag auxiliary body)
+		    (append required auxiliary)))
+		required))
+	  required))))
 
 (define (clambda-has-internal-lambda? clambda)
   (let ((body (slambda-body clambda)))
@@ -194,7 +192,7 @@
 	 (let ((operator (combination-operator body)))
 	   (and (is-internal-lambda? operator)
 		operator)))))
-
+
 (define clambda-wrap-body!)
 (define clambda-wrapper-components)
 (define clambda-unwrap-body!)
@@ -255,11 +253,11 @@
     (lambda (name required body)
       (slambda-components (combination-operator body)
 	(lambda (tag auxiliary body)
-	  (cons name (append required auxiliary)))))))
+	  (append required auxiliary))))))
 
 (define (clexpr-has-internal-lambda? clexpr)
   (combination-operator (slexpr-body clexpr)))
-
+
 (define clexpr-wrap-body!)
 (define clexpr-wrapper-components)
 (define clexpr-unwrap-body!)
@@ -316,11 +314,12 @@
 		      (xlambda-unwrapped-body xlambda))))))))
 
 (define (xlambda-bound xlambda)
-  (vector->list (&triple-second xlambda)))
+  (let ((names (&triple-second xlambda)))
+    (subvector->list names 1 (vector-length names))))
 
 (define (xlambda-has-internal-lambda? xlambda)
-  #!FALSE)
-
+  false)
+
 (define xlambda-wrap-body!)
 (define xlambda-wrapper-components)
 (define xlambda-unwrap-body!)
@@ -336,6 +335,8 @@
     (set! xlambda-unwrapped-body unwrapped-body)
     (set! set-xlambda-unwrapped-body! set-unwrapped-body!)))
 
+;;;; Generic Lambda
+
 (set! lambda?
 (named-lambda (lambda? object)
   (or (primitive-type? slambda-type object)
@@ -378,14 +379,14 @@
 		      (block-declaration-text (car actions))
 		      (make-sequence (cdr actions)))
 	    (receiver name required optional rest auxiliary '() body)))))))
-
+
 (define ((dispatch-0 op-name clambda-op clexpr-op xlambda-op) lambda)
   ((cond ((primitive-type? slambda-type lambda) clambda-op)
 	 ((primitive-type? slexpr-type lambda) clexpr-op)
 	 ((primitive-type? xlambda-type lambda) xlambda-op)
 	 (else (error "Not a lambda" op-name lambda)))
    lambda))
-
+
 (define ((dispatch-1 op-name clambda-op clexpr-op xlambda-op) lambda arg)
   ((cond ((primitive-type? slambda-type lambda) clambda-op)
 	 ((primitive-type? slexpr-type lambda) clexpr-op)
@@ -465,7 +466,9 @@
 (define slexpr-body slambda-body)
 
 ;;; end LAMBDA-PACKAGE.
-))
+(the-environment)))
+
+;;;; Alternative Component Views
 
 (define (make-lambda* name required optional rest body)
   (scan-defines body
@@ -481,12 +484,24 @@
 (define (lambda-components** lambda receiver)
   (lambda-components* lambda
     (lambda (name required optional rest body)
-      (let ((rest-list (if (null? rest) '() (list rest))))
-	(receiver (list required optional rest-list)
-		  `(,name ,@required ,@optional ,@rest-list)
-		  body)))))
+      (receiver (vector name required optional rest)
+		(append required optional (if (null? rest) '() (list rest)))
+		body))))
+
+(define (lambda-pattern/name pattern)
+  (vector-ref pattern 0))
+
+(define (lambda-pattern/required pattern)
+  (vector-ref pattern 1))
+
+(define (lambda-pattern/optional pattern)
+  (vector-ref pattern 2))
+
+(define (lambda-pattern/rest pattern)
+  (vector-ref pattern 3))
 
 (define (make-lambda** pattern bound body)
+
   (define (split pattern bound receiver)
     (cond ((null? pattern)
 	   (receiver '() bound))
@@ -495,13 +510,13 @@
 	     (lambda (copy tail)
 	       (receiver (cons (car bound) copy)
 			 tail))))))
-  (split (first pattern) (cdr bound)
+
+  (split (lambda-pattern/required pattern) bound
     (lambda (required tail)
-      (split (second pattern) tail
+      (split (lambda-pattern/optional pattern) tail
 	(lambda (optional rest)
-	  (make-lambda* (car bound)
+	  (make-lambda* (lambda-pattern/name pattern)
 			required
 			optional
 			(if (null? rest) rest (car rest))
-			body))))))
 			body))))))
\ No newline at end of file
diff --git a/v7/src/runtime/parse.scm b/v7/src/runtime/parse.scm
index 852a62c88..fda41feae 100644
--- a/v7/src/runtime/parse.scm
+++ b/v7/src/runtime/parse.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/parse.scm,v 13.41 1987/01/23 00:17:04 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/parse.scm,v 13.42 1987/03/17 18:51:44 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -357,18 +357,15 @@
 (define-char #\`
   (lambda ()
     (discard-char)
-    (list (access quasiquote-keyword syntaxer-package)
-	  (parse-object))))
+    (list 'QUASIQUOTE (parse-object))))
 
 (define-char #\,
   (lambda ()
     (discard-char)
     (if (char=? #\@ (peek-char))
 	(begin (discard-char)
-	       (list (access unquote-splicing-keyword syntaxer-package)
-		     (parse-object)))
-	(list (access unquote-keyword syntaxer-package)
-	      (parse-object)))))
+	       (list 'UNQUOTE-SPLICING (parse-object)))
+	(list 'UNQUOTE (parse-object)))))
 
 (define-char #\"
   (let ((delimiters (char-set #\" #\\)))
diff --git a/v7/src/runtime/pp.scm b/v7/src/runtime/pp.scm
index 8e0e65d2c..187586c26 100644
--- a/v7/src/runtime/pp.scm
+++ b/v7/src/runtime/pp.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/pp.scm,v 13.41 1987/01/23 00:17:46 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/pp.scm,v 13.42 1987/03/17 18:52:08 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -210,7 +210,7 @@
 	 (print-guaranteed-column nodes optimistic)
 	 (begin (tab-to pessimistic)
 		(print-column nodes pessimistic depth))))))
-
+
 ;;; Print a procedure definition.  The bound variable pattern goes on
 ;;; the same line as the keyword, while everything else gets indented
 ;;; pessimistically.  We may later want to modify this to make higher
@@ -222,7 +222,7 @@
      (print-node (car nodes) optimistic 0)
      (tab-to pessimistic)
      (print-column (cdr nodes) pessimistic depth))))
-
+
 ;;; Print a binding form.  There is a great deal of complication here,
 ;;; some of which is to gracefully handle the case of a badly-formed
 ;;; binder.  But most important is the code that handles the name when
@@ -264,7 +264,7 @@
 	   (else					;Ordinary LET.
 	    (print-node (car nodes) optimistic 0)
 	    (print-body (cdr nodes)))))))
-
+
 (define dispatch-list
   `((COND . ,forced-indentation)
     (IF . ,forced-indentation)
@@ -275,7 +275,7 @@
     (DEFINE . ,print-procedure)
     (LAMBDA . ,print-procedure)
     (NAMED-LAMBDA . ,print-procedure)))
-
+
 ;;;; Alignment
 
 (declare (integrate fits-within?))
@@ -375,15 +375,13 @@
 (define (make-prefix-node prefix subnode)
   (cond ((or (list-node? subnode)
 	     (symbol? subnode))
-	 (vector (+ (string-length prefix)
-		    (node-size subnode))
+	 (vector (+ (string-length prefix) (node-size subnode))
 		 prefix
 		 subnode))
 	((prefix-node? subnode)
 	 (make-prefix-node (string-append prefix (node-prefix subnode))
 			   (node-subnode subnode)))
-	(else
-	 (string-append prefix subnode))))
+	(else (string-append prefix subnode))))
 
 (define prefix-node? vector?)
 (define prefix-node-size vector-first)
@@ -432,28 +430,28 @@
       (define (kernel as-code?)
 	(if (scode-constant? scode)
 	    ((access pp scheme-pretty-printer) scode as-code?)
-	    ((access pp scheme-pretty-printer) (prepare scode) #!TRUE)))
+	    ((access pp scheme-pretty-printer) (prepare scode) true)))
 
       (cond ((null? optionals)
-	     (kernel #!FALSE))
+	     (kernel false))
 	    ((null? (cdr optionals))
 	     (cond ((eq? (car optionals) 'AS-CODE)
-		    (kernel #!TRUE))
+		    (kernel true))
 		   ((output-port? (car optionals))
 		    (with-output-to-port (car optionals)
-		      (lambda () (kernel #!FALSE))))
+		      (lambda () (kernel false))))
 		   (else
 		    (bad-arg (car optionals)))))
 	    ((null? (cddr optionals))
 	     (cond ((eq? (car optionals) 'AS-CODE)
 		    (if (output-port? (cadr optionals))
 			(with-output-to-port (cadr optionals)
-			  (lambda () (kernel #!TRUE)))
+			  (lambda () (kernel true)))
 			(bad-arg (cadr optionals))))
 		   ((output-port? (car optionals))
 		    (if (eq? (cadr optionals) 'AS-CODE)
 			(with-output-to-port (car optionals)
-			  (lambda () (kernel #!TRUE)))
+			  (lambda () (kernel true)))
 			(bad-arg (cadr optionals))))
 		   (else
 		    (bad-arg (car optionals)))))
@@ -464,5 +462,4 @@
 (define (pa procedure)
   (if (not (compound-procedure? procedure))
       (error "Must be a compound procedure" procedure))
-  (pp (unsyntax-lambda-list (procedure-lambda procedure))))
   (pp (unsyntax-lambda-list (procedure-lambda procedure))))
\ No newline at end of file
diff --git a/v7/src/runtime/scode.scm b/v7/src/runtime/scode.scm
index 7d16071fc..37624c0b6 100644
--- a/v7/src/runtime/scode.scm
+++ b/v7/src/runtime/scode.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scode.scm,v 13.41 1987/01/23 00:19:03 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scode.scm,v 13.42 1987/03/17 18:52:47 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -44,9 +44,9 @@
 ;;;; Constants
 
 (define scode-constant?
-  (let ((type-vector (make-vector number-of-microcode-types #!FALSE)))
+  (let ((type-vector (make-vector number-of-microcode-types false)))
     (for-each (lambda (name)
-		(vector-set! type-vector (microcode-type name) #!TRUE))
+		(vector-set! type-vector (microcode-type name) true))
 	      '(NULL TRUE UNASSIGNED
 		     FIXNUM BIGNUM FLONUM
 		     CHARACTER STRING UNINTERNED-SYMBOL INTERNED-SYMBOL
@@ -170,7 +170,7 @@
 (define set-definition-name! system-pair-set-car!)
 (define definition-value &pair-cdr)
 (define set-definition-value! &pair-set-cdr!)
-
+
 ;;;; ASSIGNMENT
 
 (define assignment?)
@@ -331,7 +331,7 @@
 
 (define in-package-environment &pair-car)
 (define in-package-expression &pair-cdr)
-
+
 ;;;; DELAY
 
 (define delay?)
@@ -348,6 +348,4 @@
 (define delay-expression &singleton-element)
 
 (define (delay-components delay receiver)
-  (receiver (delay-expression delay)))
-
   (receiver (delay-expression delay)))
\ No newline at end of file
diff --git a/v7/src/runtime/scomb.scm b/v7/src/runtime/scomb.scm
index eea5f0869..55ab9a2a0 100644
--- a/v7/src/runtime/scomb.scm
+++ b/v7/src/runtime/scomb.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scomb.scm,v 13.41 1987/01/23 00:19:15 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/scomb.scm,v 13.42 1987/03/17 18:52:59 cph Rel $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -153,7 +153,7 @@
       (combination-components predicate
 	(lambda (operator operands)
 	  (if (eq? operator not)
-	      (make-conditional (first operands) alternative #!TRUE)
+	      (make-conditional (first operands) alternative true)
 	      (&typed-pair-cons type predicate alternative))))
       (&typed-pair-cons type predicate alternative))))
 
@@ -365,6 +365,4 @@
   (receiver (unassigned?-name unassigned?)))
 
 (define unbound?-name unassigned?-name)
-(define unbound?-components unassigned?-components)
-
 (define unbound?-components unassigned?-components)
\ No newline at end of file
diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm
index a14eb2370..03009167b 100644
--- a/v7/src/runtime/syntax.scm
+++ b/v7/src/runtime/syntax.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 13.42 1987/02/27 21:59:36 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 13.43 1987/03/17 18:53:27 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -62,9 +62,6 @@
 (define lambda-tag:make-environment
   (make-named-tag "MAKE-ENVIRONMENT-PROCEDURE"))
 
-(define lambda-tag:make-package
-  (make-named-tag "MAKE-PACKAGE-PROCEDURE"))
-
 (define syntax)
 (define syntax*)
 (define macro-spreader)
@@ -212,71 +209,88 @@
 
 ;;;; Quasiquote
 
-(define quasiquote-keyword 'QUASIQUOTE)
-(define unquote-keyword 'UNQUOTE)
-(define unquote-splicing-keyword 'UNQUOTE-SPLICING)
-
 (define expand-quasiquote)
 (let ()
 
-(define (expand expression)
-  (if (pair? expression)
-      (cond ((eq? (car expression) unquote-keyword)
-	     (cadr expression))
-	    ((eq? (car expression) quasiquote-keyword)
-	     (expand (expand (cadr expression))))
-	    ((eq? (car expression) unquote-splicing-keyword)
-	     (error "EXPAND-QUASIQUOTE: Misplaced ,@" expression))
-	    ((and (pair? (car expression))
-		  (eq? (caar expression) unquote-splicing-keyword))
-	     (expand-spread (cadr (car expression))
-			    (expand (cdr expression))))
-	    (else
-	     (expand-pair (expand (car expression))
-			  (expand (cdr expression)))))
-      (list 'QUOTE expression)))
-
-(define (expand-pair a d)
-  (cond ((pair? d)
-	 (cond ((eq? (car d) 'QUOTE)
-		(cond ((and (pair? a) (eq? (car a) 'QUOTE))
-		       (list 'QUOTE (cons (cadr a) (cadr d))))
-		      ((list? (cadr d))
-		       (cons* 'LIST
-			      a
-			      (map (lambda (element)
-				     (list 'QUOTE element))
-				   (cadr d))))
-		      (else
-		       (list 'CONS a d))))
-	       ((eq? (car d) 'CONS)
-		(cons* 'CONS* a (cdr d)))
-	       ((memq (car d) '(LIST CONS*))
-		(cons* (car d) a (cdr d)))
-	       (else
-		(list 'CONS a d))))
-	(else
-	 (list 'CONS a d))))
+(define (descend-quasiquote x level return)
+  (cond ((pair? x) (descend-quasiquote-pair x level return))
+	((vector? x) (descend-quasiquote-vector x level return))
+	(else (return 'QUOTE x))))
+
+(define (descend-quasiquote-pair x level return)
+  (define (descend-quasiquote-pair* level)
+    (descend-quasiquote (car x) level
+      (lambda (car-mode car-arg)
+	(descend-quasiquote (cdr x) level
+	  (lambda (cdr-mode cdr-arg)
+	    (cond ((and (eq? car-mode 'QUOTE)
+			(eq? cdr-mode 'QUOTE))
+		   (return 'QUOTE x))
+		  ((eq? car-mode 'UNQUOTE-SPLICING)
+		   (if (and (eq? cdr-mode 'QUOTE)
+			    (null? cdr-arg))
+		       (return 'UNQUOTE car-arg)
+		       (return (system 'APPEND)
+			       (list car-arg
+				     (finalize-quasiquote cdr-mode cdr-arg)))))
+		  ((and (eq? cdr-mode 'QUOTE)
+			(null? cdr-arg))
+		   (return 'LIST
+			   (list (finalize-quasiquote car-mode car-arg))))
+		  ((and (eq? cdr-mode 'QUOTE)
+			(list? cdr-arg))
+		   (return 'LIST
+			   (cons (finalize-quasiquote car-mode car-arg)
+				 (map (lambda (el)
+					(finalize-quasiquote 'QUOTE el))
+				      cdr-arg))))
+		  ((memq cdr-mode '(LIST CONS))
+		   (return cdr-mode
+			   (cons (finalize-quasiquote car-mode car-arg)
+				 cdr-arg)))
+		  (else
+		   (return
+		    'CONS
+		    (list (finalize-quasiquote car-mode car-arg)
+			  (finalize-quasiquote cdr-mode cdr-arg))))))))))
+  (case (car x)
+    ((QUASIQUOTE) (descend-quasiquote-pair* (1+ level)))
+    ((UNQUOTE UNQUOTE-SPLICING)
+     (if (zero? level)
+	 (return (car x) (cadr x))
+	 (descend-quasiquote-pair* (- level 1))))
+    (else (descend-quasiquote-pair* level))))
 
-(define (expand-spread a d)
-  (cond ((pair? d)
-	 (cond ((eq? (car d) 'QUOTE)
-		(cond ((and (pair? a) (eq? (car a) 'QUOTE))
-		       (list 'QUOTE (append (cadr a) (cadr d))))
-		      ((null? (cadr d))
-		       a)
-		      (else
-		       (list 'APPEND a d))))
-	       ((eq? (car d) 'APPEND)
-		(cons* (car d) a (cdr d)))
-	       (else
-		(list 'APPEND a d))))
+(define (descend-quasiquote-vector x level return)
+  (descend-quasiquote (vector->list x) level
+    (lambda (mode arg)
+      (case mode
+	((QUOTE)
+	 (return 'QUOTE x))
+	((LIST)
+	 (return (system 'VECTOR) arg))
 	(else
-	 (list 'APPEND a d))))
+	 (return (system 'LIST->VECTOR)
+		 (list (finalize-quasiquote mode arg))))))))
+
+(define (finalize-quasiquote mode arg)
+  (case mode
+    ((QUOTE) `',arg)
+    ((UNQUOTE) arg)
+    ((UNQUOTE-SPLICING) (error ",@ in illegal context" arg))
+    ((LIST) `(,(system 'LIST) ,@arg))
+    ((CONS)
+     (if (= (length arg) 2)
+	 `(,(system 'CONS) ,@arg)
+	 `(,(system 'CONS*) ,@arg)))
+    (else `(,mode ,@arg))))
+
+(define (system name)
+  `(ACCESS ,name #F))
 
 (set! expand-quasiquote
-(named-lambda (expand-quasiquote expression)
-  (syntax-expression (expand expression))))
+  (named-lambda (expand-quasiquote expression)
+    (syntax-expression (descend-quasiquote expression 0 finalize-quasiquote))))
 
 )
 
@@ -436,32 +450,17 @@
      (if (symbol? name-or-pattern)
 	 (syntax-bindings pattern-or-first
 	   (lambda (names values)
-	     (make-combination (make-named-lambda name-or-pattern names
-						  (syntax-sequence rest))
-			       values)))
+	     (make-letrec (list name-or-pattern)
+			  (list (make-named-lambda name-or-pattern names
+						   (syntax-sequence rest)))
+			  (make-combination (make-variable name-or-pattern)
+					    values))))
 	 (syntax-bindings name-or-pattern
 	   (lambda (names values)
 	     (make-closed-block
 	      lambda-tag:let names values
 	      (syntax-sequence (cons pattern-or-first rest)))))))))
 
-(define syntax-MAKE-PACKAGE-form
-  (spread-arguments
-   (lambda (name bindings . body)
-     (if (symbol? name)
-	 (syntax-bindings bindings
-	   (lambda (names values)
-	     (make-closed-block
-	      lambda-tag:make-package
-	      (cons name names)
-	      (cons unassigned-object values)
-	      (make-sequence* (make-assignment name the-environment-object)
-			      (if (null? body)
-				  the-environment-object
-				  (make-sequence* (syntax-sequence body)
-						  the-environment-object))))))
-	 (syntax-error "Bad package name" name)))))
-
 (define syntax-MAKE-ENVIRONMENT-form
   (spread-arguments
    (lambda body
@@ -768,6 +767,11 @@
 (define (make-closed-block tag names values body)
   (make-combination (internal-make-lambda tag names '() '() body)
 		    values))
+
+(define (make-letrec names values body)
+  (make-closed-block lambda-tag:let '() '()
+		     (make-sequence (append! (map make-definition names values)
+					     (list body)))))
 
 ;;;; Lambda List Parser
 
@@ -991,7 +995,6 @@
 	       (LOCAL-DECLARE    . ,syntax-LOCAL-DECLARE-form)
 	       (MACRO            . ,syntax-MACRO-form)
 	       (MAKE-ENVIRONMENT . ,syntax-MAKE-ENVIRONMENT-form)
-	       (MAKE-PACKAGE     . ,syntax-MAKE-PACKAGE-form)
 	       (NAMED-LAMBDA     . ,syntax-NAMED-LAMBDA-form)
 	       (OR               . ,syntax-DISJUNCTION-form)
 	       ;; The funniness here prevents QUASIQUOTE from being
@@ -1008,9 +1011,4 @@
 	       ))))
 
 ;;; end SYNTAXER-PACKAGE
-)
-
-;;; Edwin Variables:
-;;; Scheme Environment: syntaxer-package
-;;; End:
 )
\ No newline at end of file
diff --git a/v7/src/runtime/system.scm b/v7/src/runtime/system.scm
index d86387236..a13d04e8a 100644
--- a/v7/src/runtime/system.scm
+++ b/v7/src/runtime/system.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/system.scm,v 13.42 1987/03/12 02:19:48 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/system.scm,v 13.43 1987/03/17 18:53:48 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -197,10 +197,10 @@
 	      (lambda (eval-list pure-list constant-list)
 		(if (not (null? pure-list))
 		    (begin (newline) (write-string "Purify")
-			   (purify (list->vector pure-list) #!TRUE)))
+			   (purify (list->vector pure-list) true)))
 		(if (not (null? constant-list))
 		    (begin (newline) (write-string "Constantify")
-			   (purify (list->vector constant-list) #!FALSE)))
+			   (purify (list->vector constant-list) false)))
 		(append! eval-list (loop tail))))))))
   (let ((files (format-files-list (access :files-lists system) compiled?)))
     (set! (access :files system)
@@ -264,12 +264,10 @@
   (let ((char (char-upcase (read-char))))
     (cond ((char=? #\Y char)
 	   (write-string "Yes")
-	   #!TRUE)
+	   true)
 	  ((char=? #\N char)
 	   (write-string "No")
-	   #!FALSE)
+	   false)
 	  (else (beep) (query prompt)))))
 
-)
-
 )
\ No newline at end of file
diff --git a/v7/src/runtime/unsyn.scm b/v7/src/runtime/unsyn.scm
index 66b523a35..4c83c01a6 100644
--- a/v7/src/runtime/unsyn.scm
+++ b/v7/src/runtime/unsyn.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unsyn.scm,v 13.41 1987/01/23 00:21:55 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unsyn.scm,v 13.42 1987/03/17 18:54:23 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -124,7 +124,7 @@
 
 (define unexpand-definition
   (definition-unexpander 'DEFINE 'DEFINE))
-
+
 (define (unsyntax-COMMENT-object comment)
   (comment-components comment
     (lambda (text expression)
@@ -186,14 +186,12 @@
     ,@(unsyntax-cond-alternative alternative)))
 
 (define (unsyntax-cond-alternative alternative)
-  (cond ((false? alternative)
-	 '())
+  (cond ((false? alternative) '())
 	((disjunction? alternative)
 	 (disjunction-components alternative unsyntax-cond-disjunction))
 	((conditional? alternative)
 	 (conditional-components alternative unsyntax-cond-conditional))
-	(else
-	 `((ELSE ,@(unsyntax-sequence alternative))))))
+	(else `((ELSE ,@(unsyntax-sequence alternative))))))
 
 (define (unexpand-conjunction predicate consequent)
   (if (conditional? consequent)
@@ -205,8 +203,7 @@
 		  `(,(unsyntax-conditional predicate
 					   consequent
 					   alternative))))))
-      `(,(unsyntax-object predicate)
-	,(unsyntax-object consequent))))
+      `(,(unsyntax-object predicate) ,(unsyntax-object consequent))))
 
 (define (unsyntax-DISJUNCTION-object object)
   `(OR ,@(disjunction-components object unexpand-disjunction)))
@@ -290,13 +287,13 @@
 			   ((eq? name lambda-tag:deep-fluid-let)
 			    (unsyntax-deep-fluid-let required operands body))
 			   ((eq? name lambda-tag:shallow-fluid-let)
-			    (unsyntax-shallow-fluid-let required operands body))
+			    (unsyntax-shallow-fluid-let required operands
+							body))
 			   ((eq? name lambda-tag:common-lisp-fluid-let)
-			    (unsyntax-common-lisp-fluid-let required operands body))
+			    (unsyntax-common-lisp-fluid-let required operands
+							    body))
 			   ((eq? name lambda-tag:make-environment)
 			    (unsyntax-make-environment required operands body))
-			   ((eq? name lambda-tag:make-package)
-			    (unsyntax-make-package required operands body))
 			   (else
 			    `(LET ,name
 			       ,(unsyntax-let-bindings required operands)
@@ -306,7 +303,7 @@
 	    (else
 	     (cons (unsyntax-object operator)
 		   (unsyntax-objects operands)))))))
-
+
 (define (unsyntax-error-like-form operands name)
   (cons* name
 	 (unsyntax-object (first operands))
@@ -325,9 +322,8 @@
 					(null? environment)))))
 			  (unsyntax-objects operands)
 			  `(,(unsyntax-object operand))))))
-		 (else
-		  `(,(unsyntax-object operand)))))))
-
+		 (else `(,(unsyntax-object operand)))))))
+
 (define (unsyntax-shallow-FLUID-LET names values body)
   (combination-components body
     (lambda (operator operands)
@@ -344,16 +340,13 @@
 (define (every-other list)
   (if (null? list)
       '()
-      (cons (car list)
-	    (every-other (cddr list)))))
+      (cons (car list) (every-other (cddr list)))))
 
 (define (extract-transfer-var assignment)
   (assignment-components assignment
     (lambda (name value)
       (cond ((assignment? value)
-	     (assignment-components value
-	       (lambda (name value)
-		 name)))
+	     (assignment-components value (lambda (name value) name)))
 	    ((combination? value)
 	     (combination-components value
 	       (lambda (operator operands)
@@ -379,7 +372,8 @@
 	      (name (second operands))
 	      (val (third operands)))
 	  (cond ((symbol? name)
-		 `((ACCESS ,name ,(unsyntax-object env)) ,(unsyntax-object val)))
+		 `((ACCESS ,name ,(unsyntax-object env))
+		   ,(unsyntax-object val)))
 		((quotation? name)
 		 (let ((var (quotation-expression name)))
 		   (if (variable? var)
@@ -404,21 +398,15 @@
 
 (define unsyntax-deep-FLUID-LET
   (unsyntax-deep-or-common-FLUID-LET
-   'FLUID-LET (make-primitive-procedure 'add-fluid-binding! #!true)))
+   'FLUID-LET (make-primitive-procedure 'add-fluid-binding! true)))
 
 (define unsyntax-common-lisp-FLUID-LET
   (unsyntax-deep-or-common-FLUID-LET
-   'FLUID-BIND (make-primitive-procedure 'make-fluid-binding! #!true)))
-
+   'FLUID-BIND (make-primitive-procedure 'make-fluid-binding! true)))
+
 (define (unsyntax-MAKE-ENVIRONMENT names values body)
   `(MAKE-ENVIRONMENT ,@(except-last-pair (unsyntax-sequence body))))
 
-(define (unsyntax-MAKE-PACKAGE names values body)
-  `(MAKE-PACKAGE ,(car names)
-		 ,(unsyntax-let-bindings (cdr names)
-					 (cdr values))
-     ,@(except-last-pair (cdr (unsyntax-sequence body)))))
-
 (define (unsyntax-let-bindings names values)
   (map unsyntax-let-binding names values))
 
@@ -494,5 +482,4 @@
     (,lambda-type ,unsyntax-LAMBDA-object))))
 
 ;;; end UNSYNTAXER-PACKAGE
-))
 ))
\ No newline at end of file
diff --git a/v7/src/runtime/unxpth.scm b/v7/src/runtime/unxpth.scm
index f8320d36d..baaf66601 100644
--- a/v7/src/runtime/unxpth.scm
+++ b/v7/src/runtime/unxpth.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxpth.scm,v 1.1 1987/03/12 02:16:51 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxpth.scm,v 1.2 1987/03/17 18:54:38 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -61,9 +61,8 @@
 (let ()
 
 (set! string->pathname
-(named-lambda (string->pathname string)
-  (parse-pathname (canonicalize-filename-string string)
-		  make-pathname)))
+  (named-lambda (string->pathname string)
+    (parse-pathname string make-pathname)))
 
 (define (parse-pathname string receiver)
   (let ((components (divide-into-components (string-trim string))))
@@ -109,12 +108,12 @@
 	(else (list string)))))
 
 (set! home-directory-pathname
-      (lambda ()
-	(make-pathname #F
-		       (divide-into-components (get-environment-variable "HOME"))
-		       #F
-		       #F
-		       #F)))	
+  (lambda ()
+    (make-pathname #F
+		   (divide-into-components (get-environment-variable "HOME"))
+		   #F
+		   #F
+		   #F)))	
 
 (define get-environment-variable
   (let ((primitive (make-primitive-procedure 'GET-ENVIRONMENT-VARIABLE)))
@@ -195,11 +194,11 @@
 (let ()
 
 (set! pathname-unparse
-(named-lambda (pathname-unparse device directory name type version)
-  (unparse-device
-   device
-   (unparse-directory directory
-		      (pathname-unparse-name name type version)))))
+  (named-lambda (pathname-unparse device directory name type version)
+    (unparse-device
+     device
+     (unparse-directory directory
+			(pathname-unparse-name name type version)))))
 
 (define (unparse-device device rest)
   (let ((device-string (unparse-component device)))
@@ -222,18 +221,19 @@
 	 (error "Unrecognizable directory" directory))))
 
 (set! pathname-unparse-name
-(named-lambda (pathname-unparse-name name type version)
-  (let ((name-string (unparse-component name))
-	(type-string (unparse-component type))
-	(version-string (unparse-version version)))
-    (cond ((not name-string) "")
-	  ((not type-string) name-string)
-	  ((eq? type-string 'UNSPECIFIC) (string-append name-string "."))
-	  ((not version-string) (string-append name-string "." type-string))
-	  ((eq? version-string 'UNSPECIFIC)
-	   (string-append name-string "." type-string "."))
-	  (else
-	   (string-append name-string "." type-string "." version-string))))))
+  (named-lambda (pathname-unparse-name name type version)
+    (let ((name-string (unparse-component name))
+	  (type-string (unparse-component type))
+	  (version-string (unparse-version version)))
+      (cond ((not name-string) "")
+	    ((not type-string) name-string)
+	    ((eq? type-string 'UNSPECIFIC) (string-append name-string "."))
+	    ((not version-string) (string-append name-string "." type-string))
+	    ((eq? version-string 'UNSPECIFIC)
+	     (string-append name-string "." type-string "."))
+	    (else
+	     (string-append name-string "." type-string "."
+			    version-string))))))
 
 (define (unparse-version version)
   (if (eq? version 'NEWEST)
@@ -297,23 +297,18 @@
 		 string))))))
 
 (set! working-directory-pathname
-(named-lambda (working-directory-pathname)
-  pathname))
+  (named-lambda (working-directory-pathname)
+    pathname))
 
 (set! set-working-directory-pathname!
-(named-lambda (set-working-directory-pathname! name)
-  (set! pathname
-	(pathname-as-directory
-	 (pathname->absolute-pathname (->pathname name))))
-  pathname))
+  (named-lambda (set-working-directory-pathname! name)
+    (set! pathname
+	  (pathname-as-directory
+	   (pathname->absolute-pathname (->pathname name))))
+    pathname))
 
 ;;; end WORKING-DIRECTORY-PACKAGE
 ))
 
 (define init-file-pathname
-  (make-pathname #F
-		 #F
-		 ".scheme"
-		 "init"
-		 #F))
   (make-pathname #F #F ".scheme" "init" #F))
\ No newline at end of file
diff --git a/v7/src/runtime/vector.scm b/v7/src/runtime/vector.scm
index 18b3400d5..e69bffd72 100644
--- a/v7/src/runtime/vector.scm
+++ b/v7/src/runtime/vector.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/vector.scm,v 13.41 1987/01/23 00:22:17 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/vector.scm,v 13.42 1987/03/17 18:55:01 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -60,7 +60,7 @@
   (define-type-predicate vector? vector))
 
 (define (make-vector size #!optional fill)
-  (if (unassigned? fill) (set! fill #!FALSE))
+  (if (unassigned? fill) (set! fill false))
   (vector-cons size fill))
 
 (define (vector . elements)
@@ -162,5 +162,4 @@
 (define (vector-fifth vector) (vector-ref vector 4))
 (define (vector-sixth vector) (vector-ref vector 5))
 (define (vector-seventh vector) (vector-ref vector 6))
-(define (vector-eighth vector) (vector-ref vector 7))
 (define (vector-eighth vector) (vector-ref vector 7))
\ No newline at end of file
diff --git a/v7/src/runtime/where.scm b/v7/src/runtime/where.scm
index d52192d48..6a260a672 100644
--- a/v7/src/runtime/where.scm
+++ b/v7/src/runtime/where.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/where.scm,v 13.41 1987/01/23 00:22:23 jinx Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/where.scm,v 13.42 1987/03/17 18:55:18 cph Rel $
 ;;;
 ;;;	Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -20,9 +20,9 @@
 ;;;	future releases; and (b) to inform MIT of noteworthy uses of
 ;;;	this software.
 ;;;
-;;;	3.  All materials developed as a consequence of the use of
-;;;	this software shall duly acknowledge such use, in accordance
-;;;	with the usual standards of acknowledging credit in academic
+;;;	3. All materials developed as a consequence of the use of this
+;;;	software shall duly acknowledge such use, in accordance with
+;;;	the usual standards of acknowledging credit in academic
 ;;;	research.
 ;;;
 ;;;	4. MIT has made no warrantee or representation that the
@@ -30,7 +30,7 @@
 ;;;	under no obligation to provide any services, by way of
 ;;;	maintenance, update, or otherwise.
 ;;;
-;;;	5.  In conjunction with products arising from the use of this
+;;;	5. In conjunction with products arising from the use of this
 ;;;	material, there shall be no use of the name of the
 ;;;	Massachusetts Institute of Technology nor of any adaptation
 ;;;	thereof in any advertising, promotional, or sales literature
@@ -44,11 +44,10 @@
 (declare (usual-integrations))
 
 (define env-package
-  (make-package env-package
-		((env)
-		 (current-frame)
-		 (current-frame-depth)
-		 (env-commands (make-command-set 'WHERE-COMMANDS)))
+  (let ((env)
+	(current-frame)
+	(current-frame-depth)
+	(env-commands (make-command-set 'WHERE-COMMANDS)))
 
 (define (define-where-command letter function help-text)
   (define-letter-command env-commands letter function help-text))
@@ -113,8 +112,7 @@
 			(write-string "Depth (relative to starting frame): ")
 			(write depth)))
 	     (newline)
-	     (let ((bindings (del-assq (environment-name frame)
-				       (environment-bindings frame))))
+	     (let ((bindings (environment-bindings frame)))
 	       (if (null? bindings)
 		   (write-string "Has no bindings")
 		   (begin (write-string "Has bindings:")
@@ -131,7 +129,6 @@
 	   (,lambda-tag:shallow-fluid-let . FLUID-LET)
 	   (,lambda-tag:deep-fluid-let . FLUID-LET)
 	   (,lambda-tag:common-lisp-fluid-let . FLUID-BIND)
-	   (,lambda-tag:make-package . MAKE-PACKAGE)
 	   (,lambda-tag:make-environment . MAKE-ENVIRONMENT))))
     (lambda (frame)
       (let ((name (environment-name frame)))
@@ -142,7 +139,7 @@
 		     (write-string " special form"))
 	      (begin (write-string "the procedure ")
 		     (write name))))))))
-
+
 (define (print-binding binding)
   (define line-width 79)
   (define name-width 40)
@@ -247,7 +244,7 @@
   "Name of procedure which created current environment")
 
 ;;; end ENV-PACKAGE.
-))
+(the-environment)))
 
 (define print-user-friendly-name
   (access print-user-friendly-name env-package))
@@ -258,5 +255,4 @@
 ;;;; Exports
 
 (define where
-  (access where env-package debugger-package))
   (access where env-package debugger-package))
\ No newline at end of file