Provide a new, faster version of apply.

diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index 873448da25d612ad40fcd2329cb015a50dd40b82..5455648c5bc9f87071900d031b58edf3eb3f6c74 100644 (file)
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.31 1992/04/06 05:49:26 cph Exp $
+$Id: error.scm,v 14.32 1992/11/03 22:41:24 jinx Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -544,9 +544,9 @@ MIT in each case. |#
        (lambda (continuation)
         (let ((condition
                (apply make-condition
-                      continuation
-                      'BOUND-RESTARTS
-                      field-values)))
+                      (cons* continuation
+                             'BOUND-RESTARTS
+                             field-values))))
           (signal-condition condition)
           (default-handler condition)))))))
 \f
@@ -574,9 +574,9 @@ MIT in each case. |#
             (lambda (continuation)
               (let ((condition
                      (apply make-condition
-                            continuation
-                            'BOUND-RESTARTS
-                            field-values)))
+                            (cons* continuation
+                                   'BOUND-RESTARTS
+                                   field-values))))
                 (bind-restart 'USE-VALUE
                     (if (string? use-value-message)
                         use-value-message
@@ -662,7 +662,10 @@ MIT in each case. |#
 \f
 (define (initialize-package!)
   (set! hook/invoke-condition-handler default/invoke-condition-handler)
-  (set! hook/invoke-restart apply)
+  ;; No eta conversion for bootstrapping and efficiency reasons.
+  (set! hook/invoke-restart
+       (lambda (effector arguments)
+         (apply effector arguments)))
   (set! condition-type:serious-condition
        (make-condition-type 'SERIOUS-CONDITION false '() false))
   (set! condition-type:warning

diff --git a/v7/src/runtime/global.scm b/v7/src/runtime/global.scm
index 814a7fb4e01c59ab7b6584f65ebf38e2b894056d..d0a47eb1cb4423523895d61aefb87fb30bcdd247 100644 (file)
--- a/v7/src/runtime/global.scm
+++ b/v7/src/runtime/global.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: global.scm,v 14.42 1992/09/14 23:11:54 cph Exp $
+$Id: global.scm,v 14.43 1992/11/03 22:41:00 jinx Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -86,16 +86,9 @@ MIT in each case. |#
 (define (false-procedure . args) args false)
 (define (true-procedure . args) args true)
 
-(define (apply f . args)
-  ((ucode-primitive apply)
-   f
-   (if (null? args)
-       '()
-       (let loop ((first-element (car args)) (rest-elements (cdr args)))
-        (if (null? rest-elements)
-            first-element
-            (cons first-element
-                  (loop (car rest-elements) (cdr rest-elements))))))))
+;; This definition is replaced when the 
+;; later in the boot sequence.
+(define apply (ucode-primitive apply 2))
 
 (define (eval expression environment)
   (extended-scode-eval (syntax expression system-global-syntax-table)

diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm
index e9d380f97dee8d776155228f348527c571280f28..949e94518739d65374b026446edba7a80223cfd1 100644 (file)
--- a/v7/src/runtime/make.scm
+++ b/v7/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.37 1992/10/17 22:23:18 jinx Exp $
+$Id: make.scm,v 14.38 1992/11/03 22:41:13 jinx Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -33,10 +33,16 @@ promotional, or sales literature without prior written consent from
 MIT in each case. |#
 
 ;;;; Make Runtime System
+;;; package: ()
 
 (declare (usual-integrations))
 \f
 ((ucode-primitive set-interrupt-enables!) 0)
+
+;; This definition is replaced when the 
+;; later in the boot sequence.
+(define apply (ucode-primitive apply 2))
+
 (define system-global-environment (the-environment))
 
 (let ((environment-for-package (let () (the-environment))))
@@ -318,6 +324,7 @@ MIT in each case. |#
    ((RUNTIME MICROCODE-TABLES) READ-MICROCODE-TABLES! #t)
    (RUNTIME STATE-SPACE)
    (RUNTIME MICROCODE-TABLES)
+   (RUNTIME APPLY)
    (RUNTIME PRIMITIVE-IO)
    (RUNTIME SAVE/RESTORE)
    (RUNTIME SYSTEM-CLOCK)

diff --git a/v7/src/runtime/parse.scm b/v7/src/runtime/parse.scm
index 73cadffb10d6b5da315b37450d3c471bd0a4a8e4..cae42a8ec0e81ebb27dd1f8ae4b448861d4fb39a 100644 (file)
--- a/v7/src/runtime/parse.scm
+++ b/v7/src/runtime/parse.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/parse.scm,v 14.18 1992/07/21 04:24:43 cph Exp $
+$Id: parse.scm,v 14.19 1992/11/03 22:41:30 jinx Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -94,7 +94,8 @@ MIT in each case. |#
                            parse-object/special-undefined
                            collect-list/special-undefined)))
     (for-each (lambda (entry)
-               (apply parser-table/set-entry! table entry))
+               (apply parser-table/set-entry!
+                      (cons table entry)))
              `(("#" ,parse-object/special ,collect-list/special)
                (,char-set/symbol-leaders ,parse-object/symbol)
                (("#b" "#B") ,parse-object/numeric-prefix)

diff --git a/v7/src/runtime/syntax.scm b/v7/src/runtime/syntax.scm
index e57ff8e4cc4e95fd48c85fb4e0d4e225740790a9..003ed565efcc77c64bfda584f52e1f03fd3e942f 100644 (file)
--- a/v7/src/runtime/syntax.scm
+++ b/v7/src/runtime/syntax.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/Attic/syntax.scm,v 14.17 1992/02/08 15:08:39 cph Exp $
+$Id: syntax.scm,v 14.18 1992/11/03 22:41:38 jinx Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -179,13 +179,14 @@ MIT in each case. |#
 
 (define (syntax-error message . irritants)
   (apply error
-        (string-append "SYNTAX: "
-                       (if *current-keyword*
-                           (string-append (symbol->string *current-keyword*)
-                                          ": "
-                                          message)
-                           message))
-        irritants))
+        (cons
+         (string-append "SYNTAX: "
+                        (if *current-keyword*
+                            (string-append (symbol->string *current-keyword*)
+                                           ": "
+                                           message)
+                            message))
+         irritants)))
 
 (define (syntax-expressions expressions)
   (if (null? expressions)
@@ -446,7 +447,7 @@ MIT in each case. |#
 (define (syntax/define-macro pattern . body)
   (let ((keyword (car pattern)))
     (syntax-table-define *syntax-table* keyword
-      (syntax-eval (apply syntax/named-lambda pattern body)))
+      (syntax-eval (apply syntax/named-lambda (cons pattern body))))
     keyword))
 
 (define-integrable (syntax-eval scode)

diff --git a/v7/src/runtime/uerror.scm b/v7/src/runtime/uerror.scm
index 02f7f4cb0fe4a380f2c1b50c86be64025654dbd6..700b605d74f41c3b40342bb07d6c3b991a022327 100644 (file)
--- a/v7/src/runtime/uerror.scm
+++ b/v7/src/runtime/uerror.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uerror.scm,v 14.33 1992/10/21 00:17:23 jinx Exp $
+$Id: uerror.scm,v 14.34 1992/11/03 22:41:45 jinx Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -86,9 +86,9 @@ MIT in each case. |#
   (let ((make-condition (condition-constructor type field-names)))
     (lambda (continuation . field-values)
       (error (apply make-condition
-                   continuation
-                   'BOUND-RESTARTS
-                   field-values)))))
+                   (cons* continuation
+                          'BOUND-RESTARTS
+                          field-values))))))
 \f
 ;;;; Restart Bindings
 
@@ -424,7 +424,7 @@ MIT in each case. |#
               (fixed-objects-vector-slot 'ERROR-PROCEDURE)
               (lambda (datum arguments environment)
                 environment
-                (apply error datum arguments)))
+                (apply error (cons* datum arguments))))
   (vector-set! fixed-objects
               (fixed-objects-vector-slot 'COMPILER-ERROR-PROCEDURE)
               error)

diff --git a/v7/src/runtime/unsyn.scm b/v7/src/runtime/unsyn.scm
index c15a9925ee9c45081c00ea22b4153fb9fe8ad969..36395956a17886c8f19c678ab0cc4eb9f56094ba 100644 (file)
--- a/v7/src/runtime/unsyn.scm
+++ b/v7/src/runtime/unsyn.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unsyn.scm,v 14.12 1992/02/08 15:08:42 cph Exp $
+$Id: unsyn.scm,v 14.13 1992/11/03 22:41:50 jinx Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -102,8 +102,8 @@ MIT in each case. |#
 
 (define (unsyntax-error keyword message . irritants)
   (apply error
-        (string-append "UNSYNTAX: " (symbol->string keyword) ": " message)
-        irritants))
+        (cons (string-append "UNSYNTAX: " (symbol->string keyword) ": " message)
+              irritants)))
 \f
 ;;;; Unsyntax Quanta
 

diff --git a/v8/src/runtime/global.scm b/v8/src/runtime/global.scm
index 814a7fb4e01c59ab7b6584f65ebf38e2b894056d..d0a47eb1cb4423523895d61aefb87fb30bcdd247 100644 (file)
--- a/v8/src/runtime/global.scm
+++ b/v8/src/runtime/global.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: global.scm,v 14.42 1992/09/14 23:11:54 cph Exp $
+$Id: global.scm,v 14.43 1992/11/03 22:41:00 jinx Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -86,16 +86,9 @@ MIT in each case. |#
 (define (false-procedure . args) args false)
 (define (true-procedure . args) args true)
 
-(define (apply f . args)
-  ((ucode-primitive apply)
-   f
-   (if (null? args)
-       '()
-       (let loop ((first-element (car args)) (rest-elements (cdr args)))
-        (if (null? rest-elements)
-            first-element
-            (cons first-element
-                  (loop (car rest-elements) (cdr rest-elements))))))))
+;; This definition is replaced when the 
+;; later in the boot sequence.
+(define apply (ucode-primitive apply 2))
 
 (define (eval expression environment)
   (extended-scode-eval (syntax expression system-global-syntax-table)

diff --git a/v8/src/runtime/make.scm b/v8/src/runtime/make.scm
index e9d380f97dee8d776155228f348527c571280f28..949e94518739d65374b026446edba7a80223cfd1 100644 (file)
--- a/v8/src/runtime/make.scm
+++ b/v8/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.37 1992/10/17 22:23:18 jinx Exp $
+$Id: make.scm,v 14.38 1992/11/03 22:41:13 jinx Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -33,10 +33,16 @@ promotional, or sales literature without prior written consent from
 MIT in each case. |#
 
 ;;;; Make Runtime System
+;;; package: ()
 
 (declare (usual-integrations))
 \f
 ((ucode-primitive set-interrupt-enables!) 0)
+
+;; This definition is replaced when the 
+;; later in the boot sequence.
+(define apply (ucode-primitive apply 2))
+
 (define system-global-environment (the-environment))
 
 (let ((environment-for-package (let () (the-environment))))
@@ -318,6 +324,7 @@ MIT in each case. |#
    ((RUNTIME MICROCODE-TABLES) READ-MICROCODE-TABLES! #t)
    (RUNTIME STATE-SPACE)
    (RUNTIME MICROCODE-TABLES)
+   (RUNTIME APPLY)
    (RUNTIME PRIMITIVE-IO)
    (RUNTIME SAVE/RESTORE)
    (RUNTIME SYSTEM-CLOCK)