From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Tue, 7 May 1991 17:44:51 +0000 (+0000)
Subject: Update to match 68020 compiler version 4.84.
X-Git-Tag: 20090517-FFI~10638
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f9d8c978ac5c4c6796dce682682f3ae09e1cf45a;p=mit-scheme.git

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 c168dc7bf..fcc710fb7 100644
--- 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))))))))
-
+
 (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)))
 
 ;;;; Invocation Prefixes
 
@@ -616,13 +635,19 @@ MIT in each case. |#
        ,@(make-external-label (continuation-code-word false)
 			      (generate-label))))
 
-(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