From: Guillermo J. Rozas Date: Tue, 28 May 1991 19:14:55 +0000 (+0000) Subject: Change the value register to d6. X-Git-Tag: 20090517-FFI~10528 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fced793fa44ce66e033d9684f7551b320d6d75dd;p=mit-scheme.git Change the value register to d6. Add compiler hooks for the 68k family. Fix a bug in the 68040 closure code. Fix a couple of broken rules that manifested themselves with the value register change. --- diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index 3f12c3fd4..cf8b3f23f 100644 --- a/v7/src/compiler/machines/bobcat/lapgen.scm +++ b/v7/src/compiler/machines/bobcat/lapgen.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.41 1991/05/06 23:05:51 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.42 1991/05/28 19:14:26 jinx Exp $ Copyright (c) 1988-1991 Massachusetts Institute of Technology @@ -63,7 +63,7 @@ MIT in each case. |# registers) (define available-machine-registers - (list d0 d1 d2 d3 d4 d5 d6 + (list d0 d1 d2 d3 d4 d5 ;; d6 is now compiled code val a0 a1 a2 a3 fp0 fp1 fp2 fp3 fp4 fp5 fp6 fp7)) @@ -112,7 +112,7 @@ MIT in each case. |# (define-integrable (pseudo-register-offset register) ;; Offset into register block for temporary registers - (+ (+ (* 16 4) (* 40 8)) + (+ (+ (* 16 4) (* 80 8)) (* 3 (register-renumber register)))) (define (pseudo-float? register) @@ -998,6 +998,9 @@ MIT in each case. |# ;;;; CHAR->ASCII rules (define (coerce->any/byte-reference register) + #| + ;; This does not guarantee that the data is in a + ;; D register, and A registers are no good. (if (machine-register? register) (register-reference register) (let ((alias (register-alias register false))) @@ -1005,7 +1008,18 @@ MIT in each case. |# (register-reference alias) (indirect-char/ascii-reference! regnum:regs-pointer - (pseudo-register-offset register)))))) + (pseudo-register-offset register))))) + |# + (let ((alias (register-alias register 'DATA))) + (cond (alias + (register-reference alias)) + ((register-alias register false) + (reference-alias-register! register 'DATA)) + (else + ;; Must be in home. + (indirect-char/ascii-reference! + regnum:regs-pointer + (pseudo-register-offset register)))))) (define (indirect-char/ascii-reference! register offset) (indirect-byte-reference! register (+ (* offset 4) 3))) diff --git a/v7/src/compiler/machines/bobcat/machin.scm b/v7/src/compiler/machines/bobcat/machin.scm index d548ec2a7..10e52eab0 100644 --- a/v7/src/compiler/machines/bobcat/machin.scm +++ b/v7/src/compiler/machines/bobcat/machin.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 4.24 1991/03/24 23:53:28 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/machin.scm,v 4.25 1991/05/28 19:14:36 jinx Exp $ Copyright (c) 1988-1991 Massachusetts Institute of Technology @@ -176,7 +176,7 @@ MIT in each case. |# ;;;; Closure choices -(define-integrable MC68K/closure-format 'MC68020) ; or MC68040 +(define-integrable MC68K/closure-format 'MC68040) ; or MC68020 (let-syntax ((define/format-dependent (macro (name) @@ -241,6 +241,8 @@ MIT in each case. |# (define-integrable number-of-machine-registers 24) (define-integrable number-of-temporary-registers 256) +(define-integrable regnum:return-value d6) +(define-integrable regnum:pointer-mask d7) (define-integrable regnum:dynamic-link a4) (define-integrable regnum:free-pointer a5) (define-integrable regnum:regs-pointer a6) @@ -275,12 +277,11 @@ MIT in each case. |# (rtl:make-machine-register d0)) (define (interpreter-value-register) - (rtl:make-offset (interpreter-regs-pointer) 2)) + (rtl:make-machine-register regnum:return-value)) (define (interpreter-value-register? expression) - (and (rtl:offset? expression) - (interpreter-regs-pointer? (rtl:offset-base expression)) - (= 2 (rtl:offset-number expression)))) + (and (rtl:register? expression) + (= (rtl:register-number expression) regnum:return-value))) (define (interpreter-environment-register) (rtl:make-offset (interpreter-regs-pointer) 3)) @@ -320,23 +321,30 @@ MIT in each case. |# (define (rtl:machine-register? rtl-register) (case rtl-register - ((STACK-POINTER) (interpreter-stack-pointer)) - ((DYNAMIC-LINK) (interpreter-dynamic-link)) - ((INTERPRETER-CALL-RESULT:ACCESS) (interpreter-register:access)) + ((STACK-POINTER) + (interpreter-stack-pointer)) + ((DYNAMIC-LINK) + (interpreter-dynamic-link)) + ((VALUE) + (interpreter-value-register)) + ((INTERPRETER-CALL-RESULT:ACCESS) + (interpreter-register:access)) ((INTERPRETER-CALL-RESULT:CACHE-REFERENCE) (interpreter-register:cache-reference)) ((INTERPRETER-CALL-RESULT:CACHE-UNASSIGNED?) (interpreter-register:cache-unassigned?)) - ((INTERPRETER-CALL-RESULT:LOOKUP) (interpreter-register:lookup)) - ((INTERPRETER-CALL-RESULT:UNASSIGNED?) (interpreter-register:unassigned?)) - ((INTERPRETER-CALL-RESULT:UNBOUND?) (interpreter-register:unbound?)) + ((INTERPRETER-CALL-RESULT:LOOKUP) + (interpreter-register:lookup)) + ((INTERPRETER-CALL-RESULT:UNASSIGNED?) + (interpreter-register:unassigned?)) + ((INTERPRETER-CALL-RESULT:UNBOUND?) + (interpreter-register:unbound?)) (else false))) (define (rtl:interpreter-register? rtl-register) (case rtl-register ((MEMORY-TOP) 0) ((STACK-GUARD) 1) - ((VALUE) 2) ((ENVIRONMENT) 3) ((TEMPORARY) 4) (else false))) diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index b2da61356..aa5ad80cd 100644 --- a/v7/src/compiler/machines/bobcat/make.scm-68040 +++ b/v7/src/compiler/machines/bobcat/make.scm-68040 @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.84 1991/05/07 13:47:44 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.85 1991/05/28 19:14:42 jinx Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -41,4 +41,4 @@ MIT in each case. |# ((package/reference (find-package name) 'INITIALIZE-PACKAGE!))) '((COMPILER MACROS) (COMPILER DECLARATIONS))) -(add-system! (make-system "Liar (Motorola MC68020)" 4 84 '())) \ No newline at end of file +(add-system! (make-system "Liar (Motorola MC68040)" 4 85 '())) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index af22c487c..a60048ece 100644 --- a/v7/src/compiler/machines/bobcat/rules1.scm +++ b/v7/src/compiler/machines/bobcat/rules1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.34 1991/01/23 21:34:30 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.35 1991/05/28 19:14:47 jinx Exp $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -77,47 +77,77 @@ MIT in each case. |# (LAP (OR UL (& ,(make-non-pointer-literal type 0)) ,target))))) (define (load-static-link target source n suffix) - (if (and (zero? n) (not suffix)) - (assign-register->register target source) - (let ((non-reusable - (cond ((not suffix) - (lambda () - (let ((source (allocate-indirection-register! source))) - (delete-dead-registers!) - (let ((target (allocate-alias-register! target - 'ADDRESS))) - (if (eqv? source target) - (increment-machine-register target n) - (LAP (LEA ,(byte-offset-reference source n) - ,(register-reference target)))))))) - ((<= -128 n 127) - (lambda () - (let ((source (register-reference source))) - (delete-dead-registers!) - (let ((target (reference-target-alias! target 'DATA))) - (LAP (MOVEQ (& ,n) ,target) - (ADD L ,source ,target)))))) - (else - (lambda () - (let ((source (indirect-byte-reference! source n))) - (delete-dead-registers!) - (let ((temp (reference-temporary-register! 'ADDRESS))) - (let ((target (reference-target-alias! target - 'DATA))) - (LAP (LEA ,source ,temp) - (MOV L ,temp ,target) - ,@(suffix target)))))))))) - (if (machine-register? source) - (non-reusable) - (reuse-pseudo-register-alias! source 'DATA - (lambda (reusable-alias) - (delete-dead-registers!) - (add-pseudo-register-alias! target reusable-alias) - (LAP ,@(increment-machine-register reusable-alias n) - ,@(if suffix - (suffix (register-reference reusable-alias)) - (LAP)))) - non-reusable))))) + (cond ((and (not suffix) (zero? n)) + (assign-register->register target source)) + ((machine-register? target) + (let ((do-data + (lambda (target) + (let ((source + (standard-register-reference source false true))) + (LAP (MOV L ,source ,target) + ,@(ea+=constant target n) + ,@(if suffix + (suffix target) + (LAP))))))) + (case (register-type target) + ((ADDRESS) + (if (not suffix) + (let ((source (allocate-indirection-register! source))) + (LAP (LEA ,(byte-offset-reference source n) + ,(register-reference target)))) + (let ((temp (reference-temporary-register! 'DATA))) + (LAP ,(do-data temp) + (MOV L ,temp ,(register-reference target)))))) + ((DATA) + (do-data (register-reference target))) + (else + (error "load-static-link: Unknown register type" + (register-type target)))))) + (else + (let ((non-reusable + (cond ((not suffix) + (lambda () + (let ((source + (allocate-indirection-register! source))) + (delete-dead-registers!) + (let ((target (allocate-alias-register! target + 'ADDRESS))) + (if (eqv? source target) + (increment-machine-register target n) + (LAP (LEA ,(byte-offset-reference source n) + ,(register-reference target)))))))) + ((<= -128 n 127) + (lambda () + (let ((source (register-reference source))) + (delete-dead-registers!) + (let ((target + (reference-target-alias! target 'DATA))) + (LAP (MOVEQ (& ,n) ,target) + (ADD L ,source ,target) + ,@(suffix target)))))) + (else + (lambda () + (let ((source (indirect-byte-reference! source n))) + (delete-dead-registers!) + (let ((temp + (reference-temporary-register! 'ADDRESS))) + (let ((target (reference-target-alias! target + 'DATA))) + (LAP (LEA ,source ,temp) + (MOV L ,temp ,target) + ,@(suffix target)))))))))) + (if (machine-register? source) + (non-reusable) + (reuse-pseudo-register-alias! + source 'DATA + (lambda (reusable-alias) + (delete-dead-registers!) + (add-pseudo-register-alias! target reusable-alias) + (LAP ,@(increment-machine-register reusable-alias n) + ,@(if suffix + (suffix (register-reference reusable-alias)) + (LAP)))) + non-reusable)))))) (define (assign-register->register target source) (standard-move-to-target! source (register-type target) target) diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index fe95604fa..5727db5d8 100644 --- a/v7/src/compiler/machines/bobcat/rules3.scm +++ b/v7/src/compiler/machines/bobcat/rules3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.30 1991/05/07 13:45:31 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.31 1991/05/28 19:14:55 jinx Exp $ Copyright (c) 1988-1991 Massachusetts Institute of Technology @@ -668,7 +668,7 @@ long-word aligned and there is no need for shuffling. ,@(ea+=constant reg:closure-space (- 0 total-size)) (B GE B (@PCR ,label)) ;; End of optional code. - ,@(MC68040/allocate-closure size) + ,@(MC68040/allocate-closure total-size) (LABEL ,label) ,@(recvr 0))))