1(define-syntax architecture 2 (let ([fn (format "~a.ss" (constant architecture))]) 3 (with-source-path 'architecture fn 4 (lambda (fn) 5 (let* ([p ($open-file-input-port 'include fn)] 6 [sfd ($source-file-descriptor fn p)] 7 [p (transcoded-port p (current-transcoder))]) 8 (let ([do-read ($make-read p sfd 0)]) 9 (let* ([regs (do-read)] [inst (do-read)] [asm (do-read)]) 10 (when (eof-object? asm) ($oops #f "too few expressions in ~a" fn)) 11 (unless (eof-object? (do-read)) ($oops #f "too many expressions in ~a" fn)) 12 (close-input-port p) 13 (lambda (x) 14 (syntax-case x (registers instructions assembler) 15 [(k registers) (datum->syntax #'k regs)] 16 [(k instructions) (datum->syntax #'k inst)] 17 [(k assembler) (datum->syntax #'k asm)]))))))))) 18 19(define-syntax define-reserved-registers 20 (lambda (x) 21 (syntax-case x () 22 [(_ [regid alias ... callee-save? mdinfo type] ...) 23 (syntax-case #'(regid ...) (%tc %sfp) [(%tc %sfp . others) #t] [_ #f]) 24 #'(begin 25 (begin 26 (define-once regid (make-reg 'regid 'mdinfo (tc-disp regid) callee-save? 'type)) 27 (module (alias ...) (define x regid) (define alias x) ...)) 28 ...)]))) 29 30(define-syntax define-register-aliases 31 (syntax-rules () 32 [(_ regid reg-alias ...) (begin (define reg-alias regid) ...)])) 33 34(define-syntax define-allocable-registers 35 (lambda (x) 36 (assert (fx<= (constant asm-arg-reg-cnt) (constant asm-arg-reg-max))) 37 (syntax-case x () 38 [(_ regvec arg-registers extra-registers extra-fpregisters make-reg-spillinfo 39 [regid reg-alias ... callee-save? mdinfo type] ...) 40 (with-syntax ([((tc-disp ...) (arg-regid ...) (extra-regid ...) (extra-fpregid ...)) 41 (syntax-case #'([regid type] ...) (%ac0 %xp %ts %td uptr) 42 [([%ac0 _] [%xp _] [%ts _] [%td _] [other other-type] ...) 43 (let f ([other* #'(other ...)] 44 [other-type* #'(other-type ...)] 45 [rtc-disp* '()] 46 [arg-offset (constant tc-arg-regs-disp)] 47 [fp-offset (constant tc-fpregs-disp)] 48 [rextra* '()] 49 [rfpextra* '()]) 50 (if (null? other*) 51 (cond 52 [(not (fx= (length rextra*) (constant asm-arg-reg-max))) 53 (syntax-error x (format "asm-arg-reg-max extra registers are not specified ~s" (syntax->datum rextra*)))] 54 [(not (fx= (length rfpextra*) (constant asm-fpreg-max))) 55 (syntax-error x (format "asm-fpreg-max extra registers are not specified ~s" (syntax->datum rfpextra*)))] 56 [else 57 (let ([extra* (reverse rextra*)] 58 [fpextra* (reverse rfpextra*)]) 59 (list 60 (list* 61 (constant tc-ac0-disp) 62 (constant tc-xp-disp) 63 (constant tc-ts-disp) 64 (constant tc-td-disp) 65 (reverse rtc-disp*)) 66 (list-head extra* (constant asm-arg-reg-cnt)) 67 (list-tail extra* (constant asm-arg-reg-cnt)) 68 fpextra*))]) 69 (let ([other (car other*)]) 70 (if (memq (syntax->datum other) '(%ac1 %yp %cp %ret)) 71 (f (cdr other*) (cdr other-type*) (cons #`(tc-disp #,other) rtc-disp*) 72 arg-offset fp-offset rextra* rfpextra*) 73 (if (eq? (syntax->datum (car other-type*)) 'fp) 74 (f (cdr other*) (cdr other-type*) (cons fp-offset rtc-disp*) 75 arg-offset (fx+ fp-offset (constant double-bytes)) rextra* (cons other rfpextra*)) 76 (f (cdr other*) (cdr other-type*) (cons arg-offset rtc-disp*) 77 (fx+ arg-offset (constant ptr-bytes)) fp-offset (cons other rextra*) rfpextra*))))))] 78 [_ (syntax-error x "missing or out-of-order required registers")])] 79 [(reg-spillinfo-index ...) (iota (length #'(regid ...)))]) 80 #'(begin 81 (define-once regid (let ([r (make-reg 'regid 'mdinfo tc-disp callee-save? 'type)]) 82 (var-spillinfo-redirect! r reg-spillinfo-index) 83 r)) 84 ... 85 (define-register-aliases regid reg-alias ...) ... 86 (define regvec (vector regid ...)) 87 (define arg-registers (list arg-regid ...)) 88 (define extra-registers (list extra-regid ...)) 89 (define extra-fpregisters (list extra-fpregid ...)) 90 (define (make-reg-spillinfo) 91 (vector (make-redirect-var 'regid) 92 ...))))]))) 93 94(define-syntax define-machine-dependent-registers 95 (lambda (x) 96 (syntax-case x () 97 [(_ [regid alias ... callee-save? mdinfo type] ...) 98 #'(begin 99 (begin 100 (define-once regid (make-reg 'regid 'mdinfo #f callee-save? 'type)) 101 (module (alias ...) (define x regid) (define alias x) ...)) 102 ...)]))) 103 104(define-syntax define-registers 105 (lambda (x) 106 (syntax-case x (reserved allocable machine-dependent) 107 [(k (reserved [rreg rreg-alias ... rreg-callee-save? rreg-mdinfo rreg-type] ...) 108 (allocable [areg areg-alias ... areg-callee-save? areg-mdinfo areg-type] ...) 109 (machine-depdendent [mdreg mdreg-alias ... mdreg-callee-save? mdreg-mdinfo mdreg-type] ...)) 110 (with-implicit (k regvec arg-registers extra-registers extra-fpregisters real-register? make-reg-spillinfo) 111 #`(begin 112 (define-reserved-registers [rreg rreg-alias ... rreg-callee-save? rreg-mdinfo rreg-type] ...) 113 (define-allocable-registers regvec arg-registers extra-registers extra-fpregisters make-reg-spillinfo 114 [areg areg-alias ... areg-callee-save? areg-mdinfo areg-type] ...) 115 (define-machine-dependent-registers [mdreg mdreg-alias ... mdreg-callee-save? mdreg-mdinfo mdreg-type] ...) 116 (define-syntax real-register? 117 (with-syntax ([real-reg* #''(rreg ... rreg-alias ... ... areg ... areg-alias ... ... mdreg ... mdreg-alias ... ...)]) 118 (syntax-rules () 119 [(_ e) (memq e real-reg*)])))))]))) 120 121(architecture registers) 122 123; pseudo register used for mref's with no actual index 124(define-once %zero (make-reg 'zero #f #f #f #f)) 125 126;; define %ref-ret to be sfp[0] on machines w/no ret register 127;; 128;; The ret register, if any, is used to pass a return address to a 129;; function. All functions currently stash the ret register in 130;; sfp[0] and return to sfp[0] instead of the ret register, so the 131;; register doesn't have to be saved and restored for non-tail 132;; calls --- so use sfp[0] instead of the ret registerr to refer 133;; to the current call's return address. (A leaf procedure could 134;; do better, but doesn't currently.) 135(define-syntax %ref-ret 136 (lambda (x) 137 (meta-cond 138 [(real-register? '%ret) #'%ret] 139 [else (with-syntax ([%mref (datum->syntax x '%mref)]) 140 #'(%mref ,%sfp 0))]))) 141 142(define-syntax reg-cons* 143 (lambda (x) 144 (syntax-case x () 145 [(_ ?reg ... ?reg*) 146 (fold-right 147 (lambda (reg reg*) 148 (cond 149 [(real-register? (syntax->datum reg)) 150 #`(cons #,reg #,reg*)] 151 [else reg*])) 152 #'?reg* #'(?reg ...))]))) 153 154(define-syntax reg-list 155 (syntax-rules () 156 [(_ ?reg ...) (reg-cons* ?reg ... '())])) 157 158(define-syntax with-saved-ret-reg 159 (lambda (x) 160 (syntax-case x () 161 [(k ?e) 162 (if (real-register? '%ret) 163 (with-implicit (k %seq %mref) 164 #'(%seq 165 (set! ,(%mref ,%sfp 0) ,%ret) 166 ,?e 167 (set! ,%ret ,(%mref ,%sfp 0)))) 168 #'?e)]))) 169