More changes.

diff --git a/v7/src/compiler/machines/i386/insmac.scm b/v7/src/compiler/machines/i386/insmac.scm
index a554921968a9d595454a7848fcea54d707f13319..2219fa409025d4de21bc8e19eda1336a5073ef36 100644 (file)
--- a/v7/src/compiler/machines/i386/insmac.scm
+++ b/v7/src/compiler/machines/i386/insmac.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/insmac.scm,v 1.7 1992/02/13 07:47:07 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/insmac.scm,v 1.8 1992/02/13 19:03:31 jinx Exp $
 $Vax-Header: insmac.scm,v 1.12 89/05/17 20:29:15 GMT jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -157,13 +157,17 @@ MIT in each case. |#
                (let ((field (car fields)))
                  (let ((digit-or-reg (cadr field))
                        (r/m (caddr field)))
-                   (collect-byte `((2 (EA/MODE ,r/m))
-                                   (3 ,digit-or-reg)
-                                   (3 (EA/REGISTER ,r/m)))
-                                 `(APPEND-SYNTAX! (EA/EXTRA ,r/m) ,tail)
-                                 (lambda (code byte-size)
-                                   (receiver code
-                                             (+ byte-size tail-size))))))))
+                   (receiver
+                    `(CONS-SYNTAX
+                      ,(integer-syntaxer `(EA/MODE ,r/m) 'UNSIGNED 2)
+                      (CONS-SYNTAX
+                       ,(integer-syntaxer digit-or-reg 'UNSIGNED 3)
+                       (CONS-SYNTAX
+                        ,(integer-syntaxer `(EA/REGISTER ,r/m) 'UNSIGNED 3)
+                        (APPEND-SYNTAX
+                         (EA/EXTRA ,r/m)
+                         ,tail))))
+                    (+ 8 tail-size))))))
           ;; For immediate operands whose size depends on the operand
           ;; size for the instruction (halfword vs. longword)
           ((IMMEDIATE)

diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm
index f19245ca0b58dce17ad8b5493a484d552124c750..5be3f5887ba2a3289144ebc74da134904321f264 100644 (file)
--- a/v7/src/compiler/machines/i386/lapgen.scm
+++ b/v7/src/compiler/machines/i386/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.10 1992/02/13 07:46:53 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.11 1992/02/13 19:03:55 jinx Exp $
 $MC68020-Header: /scheme/compiler/bobcat/RCS/lapgen.scm,v 4.42 1991/05/28 19:14:26 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -113,7 +113,7 @@ MIT in each case. |#
 
 (define (make-external-label code label)
   (set! *external-labels* (cons label *external-labels*))
-  (LAP (DC UW ,code)
+  (LAP (WORD U ,code)
        (BLOCK-OFFSET ,label)
        (LABEL ,label)))
 
@@ -418,7 +418,7 @@ MIT in each case. |#
 
 (define-integrable (invoke-interface/call code)
   (LAP (MOV W (R ,eax) (& ,code))
-       (JSR ,entry:compiler-scheme-to-interface/call)))
+       (CALL ,entry:compiler-scheme-to-interface/call)))
 \f
 (let-syntax ((define-entries
               (macro (start . names)

diff --git a/v7/src/compiler/machines/i386/rules1.scm b/v7/src/compiler/machines/i386/rules1.scm
index 4654fe1f13577c815be90ba9d3d548ad91eff212..483c2dbf723bf4e9343f0d18accfc8154997f34a 100644 (file)
--- a/v7/src/compiler/machines/i386/rules1.scm
+++ b/v7/src/compiler/machines/i386/rules1.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.8 1992/02/13 07:46:35 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.9 1992/02/13 19:04:16 jinx Exp $
 $MC68020-Header: /scheme/src/compiler/machines/bobcat/RCS/rules1.scm,v 4.36 1991/10/25 06:49:58 cph Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -179,9 +179,16 @@ MIT in each case. |#
 (define-rule statement
   (ASSIGN (OFFSET (REGISTER (? a)) (? n)) (REGISTER (? r)))
   (QUALIFIER (register-value-class=word? r))
-  (LAP (MOV W
-           ,(target-indirect-reference! a n)
-           ,(source-register-reference r))))
+  (let ((source (source-register-reference r)))
+    (LAP (MOV W
+             ,(target-indirect-reference! a n)
+             ,source))))
+
+(define-rule statement
+  (ASSIGN (OFFSET (REGISTER (? a)) (? n)) (CONSTANT (? value)))
+  (QUALIFIER (non-pointer-object? value))
+  (LAP (MOV W ,(target-indirect-reference! a n)
+           (&U ,(non-pointer->literal value)))))
 
 (define-rule statement
   (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
@@ -204,7 +211,7 @@ MIT in each case. |#
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 4) -1) (REGISTER (? r)))
   (QUALIFIER (register-value-class=word? r))
-  (LAP (PUSH W ,(source-register-reference r))))
+  (LAP (PUSH ,(source-register-reference r))))
 
 (define-rule statement
   (ASSIGN (PRE-INCREMENT (REGISTER 4) -1)

diff --git a/v7/src/compiler/machines/i386/rules2.scm b/v7/src/compiler/machines/i386/rules2.scm
index f2f291d2c24c66a3857de0888fd045e9c53638e4..d3ca5c3ad90f07fbf063d516451d9df43ab012de 100644 (file)
--- a/v7/src/compiler/machines/i386/rules2.scm
+++ b/v7/src/compiler/machines/i386/rules2.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules2.scm,v 1.3 1992/02/13 07:48:34 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules2.scm,v 1.4 1992/02/13 19:04:05 jinx Exp $
 $MC68020-Header: rules2.scm,v 4.12 90/01/18 22:44:04 GMT cph Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -47,7 +47,7 @@ MIT in each case. |#
 (define-rule predicate
   (TYPE-TEST (REGISTER (? register)) (? type))
   (set-equal-branches!)
-  (LAP (CMP B ,(reference-alias-register! register) (&U ,type))))
+  (LAP (CMP B ,(reference-alias-register! register 'GENERAL) (&U ,type))))
 
 (define-rule predicate
   (EQ-TEST (REGISTER (? register-1)) (REGISTER (? register-2)))

diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm
index 5d2d0c0a3784f1d385e38efd2606eb330f7ad9cf..04674379edc38a5d58de102cd2e570929848d5b7 100644 (file)
--- a/v7/src/compiler/machines/i386/rules3.scm
+++ b/v7/src/compiler/machines/i386/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.10 1992/02/13 06:37:24 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.11 1992/02/13 19:03:46 jinx Exp $
 $MC68020-Header: /scheme/compiler/bobcat/RCS/rules3.scm,v 4.31 1991/05/28 19:14:55 jinx Exp $
 
 Copyright (c) 1992 Massachusetts Institute of Technology
@@ -150,39 +150,35 @@ MIT in each case. |#
 
 (define-rule statement
   (INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive))
-  #|
-  (define-integrable (invoke code entry)
-    code                               ; ignored
-    (LAP (JMP ,entry)))
-  |#
-  (define-integrable (invoke code entry)
-    entry                              ; ignored
-    (invoke-interface code))
-
   continuation                         ; ignored
-  (if (eq? primitive compiled-error-procedure)
-      (LAP ,@(clear-map!)
-          (MOV W (R ,ecx) (& ,frame-size))
-          ,@(invoke code:compiler-error entry:compiler-error))
-      (let ((arity (primitive-procedure-arity primitive))
-           (get-code (object->machine-register! primitive ecx)))
-       (cond ((not (negative? arity))
-              (LAP ,@get-code
-                   ,@(clear-map!)
-                   ,@(invoke code:compiler-apply
-                             entry:compiler-primitive-apply)))
-             ((= arity -1)
-              (LAP ,@get-code
-                   ,@(clear-map!)
-                   (MOV W ,reg:lexpr-primitive-arity (& ,(-1+ frame-size)))
-                   ,@(invoke code:compiler-primitive-lexpr-apply
-                             entry:compiler-primitive-lexpr-apply)))
-             (else
-              ;; Unknown primitive arity.  Go through apply.
-              (LAP ,@get-code
-                   ,@(clear-map!)
-                   (MOV W (R ,edx) (& ,frame-size))
-                   ,@(invoke-interface code:compiler-apply)))))))
+  (define-integrable (invoke-entry entry)
+    (LAP (JMP ,entry)))
+  (let-syntax ((invoke
+               (macro (code entry)
+                 `(invoke-interface ,code))))
+    (if (eq? primitive compiled-error-procedure)
+       (LAP ,@(clear-map!)
+            (MOV W (R ,ecx) (& ,frame-size))
+            ,@(invoke code:compiler-error entry:compiler-error))
+       (let ((arity (primitive-procedure-arity primitive))
+             (get-code (object->machine-register! primitive ecx)))
+         (cond ((not (negative? arity))
+                (LAP ,@get-code
+                     ,@(clear-map!)
+                     ,@(invoke code:compiler-apply
+                               entry:compiler-primitive-apply)))
+               ((= arity -1)
+                (LAP ,@get-code
+                     ,@(clear-map!)
+                     (MOV W ,reg:lexpr-primitive-arity (& ,(-1+ frame-size)))
+                     ,@(invoke code:compiler-primitive-lexpr-apply
+                               entry:compiler-primitive-lexpr-apply)))
+               (else
+                ;; Unknown primitive arity.  Go through apply.
+                (LAP ,@get-code
+                     ,@(clear-map!)
+                     (MOV W (R ,edx) (& ,frame-size))
+                     ,@(invoke-interface code:compiler-apply))))))))
 \f
 (let-syntax
     ((define-special-primitive-invocation
@@ -596,8 +592,6 @@ MIT in each case. |#
                  ,@(make-external-label (continuation-code-word false)
                                         (generate-label))))))
 \f
-;;; **** here ****
-
 (define (generate/constants-block constants references assignments
                                  uuo-links global-links static-vars)
   (let ((constant-info