#| -*-Scheme-*-
-$Id: lapgen.scm,v 1.5 1995/01/20 20:15:59 ssmith Exp $
+$Id: lapgen.scm,v 1.6 1995/01/20 22:45:36 ssmith Exp $
Copyright (c) 1992-1993 Massachusetts Institute of Technology
\f
;;;; Register-Allocator Interface
-(define available-machine-registers
- ;; esp holds the the stack pointer
- ;; ebp holds the pointer mask
- ;; esi holds the register array pointer
- ;; edi holds the free pointer
- ;; fr7 is not used so that we can always push on the stack once.
- (list eax ecx edx ebx fr0 fr1 fr2 fr3 fr4 fr5 fr6))
+(define available-machine-registers)
+
+(if use-ebp-as-mask?
+ (set! available-machine-registers
+ ;; esp holds the the stack pointer
+ ;; ebp holds the pointer mask
+ ;; esi holds the register array pointer
+ ;; edi holds the free pointer
+ ;; fr7 is not used so that we can always push on the stack once.
+ (list eax ecx edx ebx fr0 fr1 fr2 fr3 fr4 fr5 fr6))
+ (set! available-machine-registers
+ ;; esp holds the the stack pointer
+ ;; esi holds the register array pointer
+ ;; edi holds the free pointer
+ ;; fr7 is not used so that we can always push on the stack once.
+ (list eax ecx edx ebx ebp fr0 fr1 fr2 fr3 fr4 fr5 fr6)))
(define-integrable (sort-machine-registers registers)
registers)
(LAP (SHR W ,target (& ,scheme-datum-width))))
(define (object->datum target)
- (LAP (AND W ,target (R ,regnum:datum-mask))))
+ (LAP (AND W ,target ,datum-mask-value)))
(define (object->address target)
(declare (integrate-operator object->datum))
(error "To must be a fixnum and from must be a fixnum or #f" from to)
(cond ((eqv? from to)
(LAP))
- ((false? from)
- (if (= to 0)
- (LAP (AND W (R ,reg) (R ,regnum:datum-mask)))
- (LAP (AND W (R ,reg) (R ,regnum:datum-mask))
- (OR W (R ,reg) (& ,(fix:lsh to scheme-type-width))))))
((eqv? (fix:or from to)
to)
(LAP (OR W (R ,reg) (& ,(fix:lsh to scheme-type-width)))))
(else
- (LAP (AND W (R ,reg) (R ,regnum:datum-mask))
- (OR W (R ,reg) (& ,(fix:lsh to scheme-type-width))))))))
+ (if (= to 0)
+ (LAP (AND W (R ,reg) ,datum-mask-value))
+ (LAP (AND W (R ,reg) ,datum-mask-value)
+ (OR W (R ,reg) (& ,(fix:lsh to scheme-type-width)))))))))
#| -*-Scheme-*-
-$Id: machin.scm,v 1.6 1995/01/20 20:16:50 ssmith Exp $
+$Id: machin.scm,v 1.7 1995/01/20 22:45:45 ssmith Exp $
Copyright (c) 1992-1995 Massachusetts Institute of Technology
\f
;;;; Machine registers
+;; This gives us an extra scratch register
+(define use-ebp-as-mask? #f)
+
+
(define eax 0) ; acumulator
(define ecx 1) ; counter register
(define edx 2) ; multiplication high-half target
(define number-of-temporary-registers 256)
(define-integrable regnum:stack-pointer esp)
-(define-integrable regnum:datum-mask ebp)
+
+
+
(define-integrable regnum:regs-pointer esi)
(define-integrable regnum:free-pointer edi)
(define-integrable regnum:hook eax)
(define-integrable regnum:first-arg ecx)
(define-integrable regnum:second-arg edx)
+(define datum-mask-value)
+(define regnum:datum-mask)
+
+(if use-ebp-as-mask?
+ (begin
+ (set! regnum:datum-mask ebp)
+ (set! datum-mask-value `(R ,ebp)))
+ (set! datum-mask-value `(& ,(- (expt 2 scheme-datum-width) 1))))
+
(define-integrable (machine-register-known-value register)
register ; ignored
false)
-(define (machine-register-value-class register)
- (cond ((<= eax register ebx)
- value-class=object)
- ((= register regnum:datum-mask)
- value-class=immediate)
- ((or (= register regnum:stack-pointer)
- (= register regnum:free-pointer)
- (= register regnum:regs-pointer))
- value-class=address)
- ((<= fr0 register fr7)
- value-class=float)
- (else
- (error "illegal machine register" register))))
+(define machine-register-value-class)
+
+(if use-ebp-as-mask?
+ (set! machine-register-value-class
+ (lambda (register)
+ (cond ((<= eax register ebx)
+ value-class=object)
+ ((= register regnum:datum-mask)
+ value-class=immediate)
+ ((or (= register regnum:stack-pointer)
+ (= register regnum:free-pointer)
+ (= register regnum:regs-pointer))
+ value-class=address)
+ ((<= fr0 register fr7)
+ value-class=float)
+ (else
+ (error "illegal machine register" register)))))
+ (set! machine-register-value-class
+ (lambda (register)
+ (cond ((or (<= eax register ebx)
+ (= ebp register))
+ value-class=object)
+ ((or (= register regnum:stack-pointer)
+ (= register regnum:free-pointer)
+ (= register regnum:regs-pointer))
+ value-class=address)
+ ((<= fr0 register fr7)
+ value-class=float)
+ (else
+ (error "illegal machine register" register))))))
(define *rtlgen/argument-registers*
(vector ecx edx))
-t#| -*-Scheme-*-
+#| -*-Scheme-*-
-$Id: rules3.scm,v 1.9 1995/01/20 20:17:29 ssmith Exp $
+$Id: rules3.scm,v 1.10 1995/01/20 22:45:55 ssmith Exp $
Copyright (c) 1992-1993 Massachusetts Institute of Technology
;;;; Invocations
(define-integrable (clear-continuation-type-code)
- (LAP (AND W (@R ,regnum:stack-pointer) (R ,regnum:datum-mask))))
+ (LAP (AND W (@R ,regnum:stack-pointer) ,datum-mask-value)))
(define-rule statement
(POP-RETURN)
(lambda (pc-label prefix)
(LAP ,@prefix
(MOV W (R ,edx) (@RO W ,eax (- ,code-block-label ,pc-label)))
- (AND W (R ,edx) (R ,regnum:datum-mask))
+ (AND W (R ,edx) ,datum-mask-value)
(LEA (R ,ebx) (@RO W ,edx ,free-ref-offset))
(MOV W (R ,ecx) ,reg:environment)
(MOV W (@RO W ,edx ,environment-offset) (R ,ecx))
(XOR W (R ,ebx) (R ,ebx))
(MOV B (R ,ebx) (@ROI B ,eax (- ,bytes ,pc-label) ,ecx 1))
;; address of vector
- (AND W (R ,edx) (R ,regnum:datum-mask))
+ (AND W (R ,edx) ,datum-mask-value)
;; Store n-sections in arg
(MOV W ,reg:utility-arg-4 (R ,ebx))
;; vector-ref -> cc block
(MOV W (R ,edx) (@ROI B ,edx 4 ,ecx 4))
;; address of cc-block
- (AND W (R ,edx) (R ,regnum:datum-mask))
+ (AND W (R ,edx) ,datum-mask-value)
;; cc-block length
(MOV W (R ,ebx) (@R ,edx))
;; Get environment
(MOV W (R ,ecx) ,reg:environment)
;; Eliminate length tags
- (AND W (R ,ebx) (R ,regnum:datum-mask))
+ (AND W (R ,ebx) ,datum-mask-value)
;; Store environment
(MOV W (@RI ,edx ,ebx 4) (R ,ecx))
;; Get NMV header
(MOV W (R ,ecx) (@RO B ,edx 4))
;; Eliminate NMV tag
- (AND W (R ,ecx) (R ,regnum:datum-mask))
+ (AND W (R ,ecx) ,datum-mask-value)
;; Address of first free reference
(LEA (R ,ebx) (@ROI B ,edx 8 ,ecx 4))
;; Invoke linker
,@(invoke-hook/call entry:compiler-link)
,@(make-external-label (continuation-code-word false)
- (generate-label))
+ (generate-label))
;; Increment counter and loop
(INC W (@R ,esp))
(CMP W (@R ,esp) (& ,n-blocks))
projects / mit-scheme.git / commitdiff