More changes.

diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm
index c7c69fe477f6d5fc08fe8f8861bc295ce3090407..95b9e24b731914fd9d36267a157ef2808b0fc465 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.1 1992/01/30 06:33:15 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.2 1992/01/30 14:07:23 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
@@ -95,15 +95,34 @@ MIT in each case. |#
       (load-pc-relative target (free-constant-label obj))))
 
 (define (load-pc-relative target label-expr)
-  (with-pc-relative-address
+  (with-pc
     (lambda (pc-label pc-register)
       (LAP (MOV W ,target (@RO ,pc-register (- ,label-expr ,pc-label)))))))
 
 (define (load-pc-relative-address target label-expr)
-  (with-pc-relative-address
+  (with-pc
     (lambda (pc-label pc-register)
       (LAP (LEA ,target (@RO ,pc-register (- ,label-expr ,pc-label)))))))
 
+(define (with-pc recvr)
+  (let ((pc-info (pc-registered?)))
+    (if pc-info
+       (recvr (pc-info/label pc-info)
+              (pc-info/reg pc-info))
+       (let ((reg (allocate-temporary-register! 'GENERAL)))
+         (pc->reg reg
+                  (lambda (label code)
+                    (pc-register! (make-pc-info label reg))
+                    (LAP ,@code
+                         (recvr label reg))))))))
+
+(define (pc->reg reg recvr)
+  (let ((label (generate-label 'get-pc)))
+    (recvr label
+          (LAP (CALL (@PCR ,label))
+               (LABEL ,label)
+               (POP (R ,reg))))))  
+
 (define (compare/register*register reg1 reg2)
   (cond ((register-alias reg1 'GENERAL)
         =>

diff --git a/v7/src/compiler/machines/i386/rules1.scm b/v7/src/compiler/machines/i386/rules1.scm
index fd52b7a5d9364119589c5188d25bd7025ca9a682..d2d1146ac6b53d10783b05b37b850286a9c7eab6 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.5 1992/01/30 06:33:02 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.6 1992/01/30 14:07:46 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
@@ -281,7 +281,7 @@ MIT in each case. |#
                               (+ (make-non-pointer-literal type 0) n))))
 
 (define (load-pc-relative-address/typed target type label)
-  (with-pc-relative-address
+  (with-pc
     (lambda (pc-label pc-register)
       (LAP (LEA ,target (@RO ,pc-register
                             (+ ,(make-non-pointer-literal type 0)

diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm
index 44259fbc5ad2c283b61fa6a617881d22ed511527..b9c6757910b7d649fd6217ff737ca32f1e801c3a 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.3 1992/01/30 06:32:33 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.4 1992/01/30 14:07:02 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
@@ -83,7 +83,7 @@ MIT in each case. |#
 (define-rule statement
   (INVOCATION:LEXPR (? number-pushed) (? continuation) (? label))
   continuation
-  (with-pc-relative-address
+  (with-pc
     (lambda (pc-label pc-register)
       (LAP ,@(clear-map!)
           (LEA (R ,ecx) (@RO ,pc-register (- ,label ,pc-label)))
@@ -465,7 +465,7 @@ MIT in each case. |#
 (define (generate/cons-multiclosure target nentries size entries)
   (let* ((target (target-register-reference))
         (temp (temporary-register-reference)))
-    (with-pc-relative-address
+    (with-pc
       (lambda (pc-label pc-reg)
        (define (generate-entries entries offset)
          (let ((entry (car entries))
@@ -534,44 +534,38 @@ MIT in each case. |#
 ;;;; Entry Header
 ;;; This is invoked by the top level of the LAP generator.
 
-;; **** here ****
-
 (define (generate/quotation-header environment-label free-ref-label n-sections)
-  (LAP (LEA (@PCR ,environment-label) (A 0))
-       (MOV L ,reg:environment (@A 0))
-       (LEA (@PCR ,*block-label*) (A 0))
-       (MOV L (A 0) (D 2))
-       (LEA (@PCR ,free-ref-label) (A 0))
-       (MOV L (A 0) (D 3))
-       ,(load-dnl n-sections 4)
-       (JSR ,entry:compiler-link)
-       ,@(make-external-label (continuation-code-word false)
-                             (generate-label))))
+  (pc->reg eax
+          (lambda (pc-label prefix)
+            (LAP ,@prefix
+                 (MOV W (R ,ecx) ,reg:environment)
+                 (MOV W (@RO ,eax (- ,environment-label ,pc-label)) (R ,ecx))
+                 (LEA (R ,edx) (@RO ,eax (- ,*block-label* ,pc-label)))
+                 (LEA (R ,ebx) (@RO ,eax (- ,free-ref-label ,pc-label)))
+                 (MOV W ,reg:utility-arg-4 (& ,n-sections))
+                 (CALL ,entry:compiler-link)
+                 ,@(make-external-label (continuation-code-word false)
+                                        (generate-label))))))
 
 (define (generate/remote-link code-block-label
                              environment-offset
                              free-ref-offset
                              n-sections)
-  (let ((load-offset
-        (lambda (offset)
-          (if (<= -32768 offset 32767)
-              (INST (LEA (@AO 0 ,offset) (A 1)))
-              (INST (LEA (@AOF 0 E (,offset L) #F
-                               ((D 0) L 1) Z
-                               (0 N))
-                         (A 1)))))))
-    (LAP (MOV L (@PCR ,code-block-label) (D 2))
-        (AND L ,mask-reference (D 2))
-        (MOV L (D 2) (A 0))
-        ,(load-offset environment-offset)
-        (MOV L ,reg:environment (@A 1))
-        ,(load-offset free-ref-offset)
-        (MOV L (A 1) (D 3))
-        ,(load-dnl n-sections 4)
-        (JSR ,entry:compiler-link)
-        ,@(make-external-label (continuation-code-word false)
-                               (generate-label)))))
+  (pc->reg eax
+          (lambda (pc-label prefix)
+            (LAP ,@prefix
+                 (MOV W (R ,edx) (@RO ,eax (- ,code-block-label ,pc-label)))
+                 (AND W (R ,edx) (R ,regnum:pointer-mask))
+                 (LEA (R ,ebx) (@RO ,edx ,free-ref-offset))
+                 (MOV W (R ,ecx) ,reg:environment)
+                 (MOV W (@RO ,edx ,environment-offset) (R ,ecx))
+                 (MOV W ,reg:utility-arg-4 (& ,n-sections))
+                 (CALL ,entry:compiler-link)
+                 ,@(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