Update to match 68020 compiler version 4.84.

Add assembly-language hooks for generic arithmetic.

diff --git a/v7/src/compiler/machines/spectrum/rules3.scm b/v7/src/compiler/machines/spectrum/rules3.scm
index c168dc7bf1ff677112ef152e08e07f6ac8c87f94..fcc710fb7b2dd223a3e3a088dde828777fd98ccf 100644 (file)
--- a/v7/src/compiler/machines/spectrum/rules3.scm
+++ b/v7/src/compiler/machines/spectrum/rules3.scm
@@ -1,9 +1,9 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/rules3.scm,v 4.28 1990/08/22 02:03:18 jinx Rel $
-$MC68020-Header: rules3.scm,v 4.26 90/08/21 02:23:26 GMT jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/spectrum/rules3.scm,v 4.29 1991/05/07 17:44:51 jinx Exp $
+$MC68020-Header: /scheme/compiler/bobcat/RCS/rules3.scm,v 4.30 1991/05/07 13:45:31 jinx Exp $
 
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-1991 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -143,7 +143,7 @@ MIT in each case. |#
                      ;; Unknown primitive arity.  Go through apply.
                      (LAP ,@(load-immediate frame-size regnum:second-arg)
                           ,@(invoke-interface code:compiler-apply))))))))
-
+\f
 (let-syntax
     ((define-special-primitive-invocation
        (macro (name)
@@ -153,23 +153,42 @@ MIT in each case. |#
             (? continuation)
             ,(make-primitive-procedure name true))
            frame-size continuation
-           ,(list 'LAP
-                  (list 'UNQUOTE-SPLICING '(clear-map!))
-                  (list 'UNQUOTE-SPLICING
-                        `(INVOKE-INTERFACE ,(symbol-append 'CODE:COMPILER-
-                                                           name))))))))
-  (define-special-primitive-invocation &+)
-  (define-special-primitive-invocation &-)
-  (define-special-primitive-invocation &*)
-  (define-special-primitive-invocation &/)
-  (define-special-primitive-invocation &=)
-  (define-special-primitive-invocation &<)
-  (define-special-primitive-invocation &>)
-  (define-special-primitive-invocation 1+)
-  (define-special-primitive-invocation -1+)
-  (define-special-primitive-invocation zero?)
-  (define-special-primitive-invocation positive?)
-  (define-special-primitive-invocation negative?))
+           (special-primitive-invocation
+            ,(symbol-append 'CODE:COMPILER- name)))))
+
+     (define-optimized-primitive-invocation
+       (macro (name)
+        `(define-rule statement
+           (INVOCATION:SPECIAL-PRIMITIVE
+            (? frame-size)
+            (? continuation)
+            ,(make-primitive-procedure name true))
+           frame-size continuation
+           (optimized-primitive-invocation
+            ,(symbol-append 'HOOK:COMPILER- name))))))
+
+  (define-optimized-primitive-invocation &+)
+  (define-optimized-primitive-invocation &-)
+  (define-optimized-primitive-invocation &*)
+  (define-optimized-primitive-invocation &/)
+  (define-optimized-primitive-invocation &=)
+  (define-optimized-primitive-invocation &<)
+  (define-optimized-primitive-invocation &>)
+  (define-optimized-primitive-invocation 1+)
+  (define-optimized-primitive-invocation -1+)
+  (define-optimized-primitive-invocation zero?)
+  (define-optimized-primitive-invocation positive?)
+  (define-optimized-primitive-invocation negative?)
+  (define-special-primitive-invocation quotient)
+  (define-special-primitive-invocation remainder))
+
+(define (special-primitive-invocation code)
+  (LAP ,@(clear-map!)
+       ,@(invoke-interface code)))
+
+(define (optimized-primitive-invocation hook)
+  (LAP ,@(clear-map!)
+       ,@(invoke-hook hook)))
 \f
 ;;;; Invocation Prefixes
 
@@ -616,13 +635,19 @@ MIT in each case. |#
        ,@(make-external-label (continuation-code-word false)
                              (generate-label))))
 \f
-(define (generate/constants-block constants references assignments uuo-links)
+(define (generate/constants-block constants references assignments
+                                 uuo-links global-links static-vars)
   (let ((constant-info
         (declare-constants 0 (transmogrifly uuo-links)
           (declare-constants 1 references
             (declare-constants 2 assignments
-              (declare-constants false constants
-                (cons false (LAP))))))))
+              (declare-constants 3 (transmogrifly global-links)
+                (declare-constants false
+                    (map (lambda (pair)
+                           (cons false (cdr pair)))
+                         static-vars)
+                  (declare-constants false constants
+                    (cons false (LAP))))))))))
     (let ((free-ref-label (car constant-info))
          (constants-code (cdr constant-info))
          (debugging-information-label (allocate-constant-label))
@@ -630,7 +655,8 @@ MIT in each case. |#
          (n-sections
           (+ (if (null? uuo-links) 0 1)
              (if (null? references) 0 1)
-             (if (null? assignments) 0 1))))
+             (if (null? assignments) 0 1)
+             (if (null? global-links) 0 1))))
       (values
        (LAP ,@constants-code
            ;; Place holder for the debugging info filename