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.
#| -*-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
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))
(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)
;;;; 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)))
(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)))
#| -*-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
\f
;;;; 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)
(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)
(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))
\f
(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)))
#| -*-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
((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
#| -*-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
(LAP (OR UL (& ,(make-non-pointer-literal type 0)) ,target)))))
\f
(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)
#| -*-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
,@(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))))
projects / mit-scheme.git / commitdiff