From 3a9c2de82208642622d6c37a3617597fd4257723 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Tue, 11 Feb 1992 14:48:30 +0000 Subject: [PATCH] @RO -> @RO.B or @RO.W --- v7/src/compiler/machines/i386/lapgen.scm | 40 ++++++++-------- v7/src/compiler/machines/i386/rules1.scm | 5 +- v7/src/compiler/machines/i386/rules3.scm | 61 +++++++++++++----------- v7/src/compiler/machines/i386/rulflo.scm | 26 +++++----- 4 files changed, 72 insertions(+), 60 deletions(-) diff --git a/v7/src/compiler/machines/i386/lapgen.scm b/v7/src/compiler/machines/i386/lapgen.scm index 2b5191857..05a4a735d 100644 --- 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.6 1992/02/08 23:59:15 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/lapgen.scm,v 1.7 1992/02/11 14:47:53 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 @@ -156,9 +156,12 @@ MIT in each case. |# (byte-offset-reference register (* 4 offset))) (define (byte-offset-reference register offset) - (if (zero? offset) - (INST-EA (@R ,register)) - (INST-EA (@RO ,register ,offset)))) + (cond ((zero? offset) + (INST-EA (@R ,register))) + ((fits-in-signed-byte? offset) + (INST-EA (@RO B ,register ,offset))) + (else + (INST-EA (@RO W ,register ,offset))))) (define-integrable (pseudo-register-offset register) (+ (+ (* 16 4) (* 80 4)) @@ -240,12 +243,12 @@ MIT in each case. |# (define (load-pc-relative target label-expr) (with-pc (lambda (pc-label pc-register) - (LAP (MOV W ,target (@RO ,pc-register (- ,label-expr ,pc-label))))))) + (LAP (MOV W ,target (@RO W ,pc-register (- ,label-expr ,pc-label))))))) (define (load-pc-relative-address target label-expr) (with-pc (lambda (pc-label pc-register) - (LAP (LEA ,target (@RO ,pc-register (- ,label-expr ,pc-label))))))) + (LAP (LEA ,target (@RO W ,pc-register (- ,label-expr ,pc-label))))))) (define (with-pc recvr) (with-values (lambda () (get-cached-label)) @@ -361,26 +364,24 @@ MIT in each case. |# ;;;; Named registers, codes, and entries (define reg:compiled-memtop - #| - (INST-EA (@RO ,regnum:regs-pointer ,(* 4 register-block/memtop-offset))) - |# - (INST-EA (@R ,regnum:regs-pointer))) + (offset-reference regnum:regs-pointer + register-block/memtop-offset)) (define reg:environment - (INST-EA (@RO ,regnum:regs-pointer - ,(* 4 register-block/environment-offset)))) + (offset-reference regnum:regs-pointer + register-block/environment-offset)) (define reg:dynamic-link - (INST-EA (@RO ,regnum:regs-pointer - ,(* 4 register-block/dynamic-link-offset)))) + (offset-reference regnum:regs-pointer + register-block/dynamic-link-offset)) (define reg:lexpr-primitive-arity - (INST-EA (@RO ,regnum:regs-pointer - ,(* 4 register-block/lexpr-primitive-arity-offset)))) + (offset-reference regnum:regs-pointer + register-block/lexpr-primitive-arity-offset)) (define reg:utility-arg-4 - (INST-EA (@RO ,regnum:regs-pointer - ,(* 4 register-block/utility-arg4-offset)))) + (offset-reference regnum:regs-pointer + register-block/utility-arg4-offset)) (let-syntax ((define-codes (macro (start . names) @@ -421,7 +422,8 @@ MIT in each case. |# (cons `(DEFINE-INTEGRABLE ,(symbol-append 'ENTRY:COMPILER- (car names)) - (INST-EA (@RO ,regnum:regs-pointer ,index))) + (byte-offset-reference regnum:regs-pointer + ,index)) (loop (cdr names) (+ index 4))))) `(BEGIN ,@(loop names start))))) (define-entries (* 16 4) diff --git a/v7/src/compiler/machines/i386/rules1.scm b/v7/src/compiler/machines/i386/rules1.scm index d2d1146ac..a62a5df67 100644 --- 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.6 1992/01/30 14:07:46 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules1.scm,v 1.7 1992/02/11 14:48:05 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 @@ -283,7 +283,8 @@ MIT in each case. |# (define (load-pc-relative-address/typed target type label) (with-pc (lambda (pc-label pc-register) - (LAP (LEA ,target (@RO ,pc-register + (LAP (LEA ,target (@RO UW + ,pc-register (+ ,(make-non-pointer-literal type 0) (- ,label ,pc-label)))))))) diff --git a/v7/src/compiler/machines/i386/rules3.scm b/v7/src/compiler/machines/i386/rules3.scm index 62a669575..54ca32c88 100644 --- 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.7 1992/02/05 17:18:36 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rules3.scm,v 1.8 1992/02/11 14:48:20 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 @@ -41,7 +41,7 @@ MIT in each case. |# ;;;; Invocations (define-integrable (clear-continuation-type-code) - (LAP (AND W (@RO ,regnum:stack-pointer) (R ,regnum:datum-mask)))) + (LAP (AND W (@R ,regnum:stack-pointer) (R ,regnum:datum-mask)))) (define-rule statement (POP-RETURN) @@ -90,7 +90,7 @@ MIT in each case. |# (with-pc (lambda (pc-label pc-register) (LAP ,@(clear-map!) - (LEA (R ,ecx) (@RO ,pc-register (- ,label ,pc-label))) + (LEA (R ,ecx) (@RO W ,pc-register (- ,label ,pc-label))) (MOV W (R ,edx) (& ,number-pushed)) ,@(invoke-interface code:compiler-lexpr-apply))))) @@ -262,7 +262,7 @@ MIT in each case. |# ((= frame-size 2) (let ((temp1 (temporary-register-reference)) (temp2 (temporary-register-reference))) - (LAP (MOV W ,temp2 (@RO 4 4)) + (LAP (MOV W ,temp2 (@RO B 4 4)) (MOV W ,temp1 (@R 4)) (ADD W (R 4) (& ,(* 4 offset))) (PUSH W ,temp2) @@ -296,7 +296,8 @@ MIT in each case. |# (let ((temp (get-temp)) (ctr (allocate-temporary-register! 'GENERAL)) (label (generate-label 'MOVE-LOOP))) - (LAP (LEA (R ,reg) (@RO ,reg ,(* -4 frame-size))) + (LAP (LEA (R ,reg) + ,(byte-offset-reference reg (* -4 frame-size))) (MOV W (R ,ctr) (& (-1+ frame-size))) (LABEL ,label) (MOV W ,temp (@RI 4 ,ctr 4)) @@ -432,17 +433,19 @@ MIT in each case. |# (MOV W (@R ,regnum:free-pointer) (&U ,(make-non-pointer-literal (ucode-type manifest-closure) (+ 4 size)))) - (MOV W (@RO ,regnum:free-pointer 4) + (MOV W (@RO B ,regnum:free-pointer 4) (&U ,(make-closure-code-longword min max 8))) - (LEA ,target (@RO ,regnum:free-pointer 8)) - (MOV B (@RO ,regnum:free-pointer 8) (&U #xe8)) ; (CALL (@PCR )) + (LEA ,target (@RO B ,regnum:free-pointer 8)) + ;; (CALL (@PCR )) + (MOV B (@RO B ,regnum:free-pointer 8) (&U #xe8)) (SUB W ,temp ,target) - (MOV L (@RO ,regnum:free-pointer 9) ,temp) ; displacement + (MOV L (@RO B ,regnum:free-pointer 9) ,temp) ; displacement (ADD W (R ,regnum:free-pointer) (& ,(* 4 (+ 5 size)))) - (LEA ,temp (@RO ,target + (LEA ,temp (@RO UW + ,target ,(make-non-pointer-literal (ucode-type compiled-entry) 0))) - (MOV W (@RO ,regnum:free-pointer -4) ,temp)))) + (MOV W (@RO B ,regnum:free-pointer -4) ,temp)))) (define (generate/cons-multiclosure target nentries size entries) (let* ((target (target-register-reference)) @@ -452,16 +455,18 @@ MIT in each case. |# (define (generate-entries entries offset) (let ((entry (car entries)) (rest (cdr entries))) - (LAP (MOV W (@RO ,regnum:free-pointer -9) + (LAP (MOV W (@RO B ,regnum:free-pointer -9) (&U ,(make-closure-code-longword (cadr entry) (caddr entry) offset))) - (MOV B (@RO ,regnum:free-pointer -5) (&U #xe8)) - (LEA ,temp (@RO ,pc-reg (- ,(rtl-procedure/external-label - (label->object (car entry))) - ,pc-label))) + (MOV B (@RO B ,regnum:free-pointer -5) (&U #xe8)) + (LEA ,temp (@RO W + ,pc-reg + (- ,(rtl-procedure/external-label + (label->object (car entry))) + ,pc-label))) (SUB W ,temp (R ,regnum:free-pointer)) - (MOV W (@RO ,regnum:free-pointer -4) ,temp) + (MOV W (@RO B ,regnum:free-pointer -4) ,temp) ,@(if (null? rest) (LAP) (LAP (ADD W (R ,regnum:free-pointer) 10) @@ -471,18 +476,19 @@ MIT in each case. |# (&U ,(make-non-pointer-literal (ucode-type manifest-closure) (+ size (quotient (* 5 (1+ nentries)) 2))))) - (MOV W (@RO ,regnum:free-pointer 4) + (MOV W (@RO B ,regnum:free-pointer 4) (&U ,(make-closure-longword nentries 0))) - (LEA ,target (@RO ,regnum:free-pointer 12)) + (LEA ,target (@RO B ,regnum:free-pointer 12)) (ADD W (R ,regnum:free-pointer) (& 17)) ,@(generate-entries entries 12) (ADD W (R ,regnum:free-pointer) (& ,(+ (* 4 size) (if (odd? nentries) 7 5)))) (LEA ,temp - (@RO ,target + (@RO UW + ,target ,(make-non-pointer-literal (ucode-type compiled-entry) 0))) - (MOV W (@RO ,regnum:free-pointer -4) ,temp)))))) + (MOV W (@RO B ,regnum:free-pointer -4) ,temp)))))) (define (generate/closure-header internal-label nentries entry) nentries ; ignored @@ -557,9 +563,10 @@ MIT in each case. |# (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 (@RO W ,eax (- ,environment-label ,pc-label)) + (R ,ecx)) + (LEA (R ,edx) (@RO W ,eax (- ,*block-label* ,pc-label))) + (LEA (R ,ebx) (@RO W ,eax (- ,free-ref-label ,pc-label))) (MOV W ,reg:utility-arg-4 (& ,n-sections)) #| (CALL ,entry:compiler-link) @@ -575,11 +582,11 @@ MIT in each case. |# (pc->reg eax (lambda (pc-label prefix) (LAP ,@prefix - (MOV W (R ,edx) (@RO ,eax (- ,code-block-label ,pc-label))) + (MOV W (R ,edx) (@RO W ,eax (- ,code-block-label ,pc-label))) (AND W (R ,edx) (R ,regnum:datum-mask)) - (LEA (R ,ebx) (@RO ,edx ,free-ref-offset)) + (LEA (R ,ebx) (@RO W ,edx ,free-ref-offset)) (MOV W (R ,ecx) ,reg:environment) - (MOV W (@RO ,edx ,environment-offset) (R ,ecx)) + (MOV W (@RO W ,edx ,environment-offset) (R ,ecx)) (MOV W ,reg:utility-arg-4 (& ,n-sections)) #| (CALL ,entry:compiler-link) diff --git a/v7/src/compiler/machines/i386/rulflo.scm b/v7/src/compiler/machines/i386/rulflo.scm index f01efc5f9..a6bff6630 100644 --- a/v7/src/compiler/machines/i386/rulflo.scm +++ b/v7/src/compiler/machines/i386/rulflo.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulflo.scm,v 1.9 1992/02/08 23:08:01 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/i386/rulflo.scm,v 1.10 1992/02/11 14:48:30 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 @@ -68,17 +68,19 @@ MIT in each case. |# ;; Value is in memory home (let ((off (pseudo-register-offset source)) (temp (temporary-register-reference))) - (LAP (MOV W ,target (@RO ,regnum:regs-pointer ,off)) - (MOV W ,temp (@RO ,regnum:regs-pointer ,(+ 4 off))) - (MOV W (@RO ,regnum:free-pointer 4) ,target) - (MOV W (@RO ,regnum:free-pointer 8) ,temp))) + (LAP (MOV W ,target + ,(offset-reference regnum:regs-pointer off)) + (MOV W ,temp + ,(offset-reference regnum:regs-pointer (1+ off))) + (MOV W (@RO B ,regnum:free-pointer 4) ,target) + (MOV W (@RO B ,regnum:free-pointer 8) ,temp))) (let ((sti (floreg->sti source))) (if (zero? sti) - (LAP (FST D (@RO ,regnum:free-pointer 4))) + (LAP (FST D (@RO B ,regnum:free-pointer 4))) (LAP (FLD (ST ,(floreg->sti source))) - (FSTP D (@RO ,regnum:free-pointer 4)))))) + (FSTP D (@RO B ,regnum:free-pointer 4)))))) (LEA ,target - (@RO ,regnum:free-pointer + (@RO UW ,regnum:free-pointer ,(make-non-pointer-literal (ucode-type flonum) 0))) (ADD W (R ,regnum:free-pointer) (& 12))))) @@ -88,7 +90,7 @@ MIT in each case. |# (let* ((source (move-to-temporary-register! source 'GENERAL)) (target (flonum-target! target))) (LAP ,@(object->address source) - (FLD D (@RO ,source 4)) + (FLD D (@RO B ,source 4)) (FSTP (ST ,(1+ target)))))) (define-rule statement @@ -149,11 +151,11 @@ MIT in each case. |# ,@(if (and (zero? target) (zero? source)) (LAP) (LAP (FLD (ST ,source)))) - (MOV B ,temp (@RO ,regnum:free-pointer 1)) - (OR B (@RO ,regnum:free-pointer 1) (&U #x0c)) + (MOV B ,temp (@RO B ,regnum:free-pointer 1)) + (OR B (@RO B ,regnum:free-pointer 1) (&U #x0c)) (FNLDCW (@R ,regnum:free-pointer)) (FRNDINT) - (MOV B (@RO ,regnum:free-pointer 1) ,temp) + (MOV B (@RO B ,regnum:free-pointer 1) ,temp) ,@(if (and (zero? target) (zero? source)) (LAP) (LAP (FSTP (ST ,(1+ target))))) -- 2.25.1