(define-pass generate-Sparc-code (import machine-definition) (define-syntax emit (syntax-rules () [(_ opcode) (printf " ~s~%" 'opcode)] [(_ opcode rand1) (printf " ~s ~a~%" 'opcode rand1)] [(_ opcode rand1 rand2) (printf " ~s ~a,~a~%" 'opcode rand1 rand2)] [(_ opcode rand1 rand2 rand3) (printf " ~s ~a,~a,~a~%" 'opcode rand1 rand2 rand3)])) (define emit-label (lambda (lab) (printf "~a:~%" lab))) (define make-label (lambda (lab) (format "L~a" (extract-suffix lab)))) (define make-reg (lambda (reg) (cond [(assq reg register-mapping) => cdr] [else (error who "invalid register ~s" reg)]))) (define disp (lambda (r i) (if (and (integer? i) (< i 0)) (format "[~a-~a]" r (- i)) (format "[~a+~a]" r i)))) (define move-long (lambda (x dst) (emit sethi (format "%hi(~a)" x) dst) (emit or dst (format "%lo(~a)" x) dst))) (define cogen-global (lambda (label) ---)) (define cogen (lambda (expr) ---)) (define cogen-boilerplate (lambda (entry) (emit .global "scheme_entry") (emit-label "scheme_entry") (emit save "%sp" "-176" "%sp") ; save the caller's registers (emit mov "%i0" (make-reg 'fp)) ; set up frame pointer (emit mov "%i1" (make-reg 'ap)) ; set up allocation pointer (if (null? parameter-registers) ; set up return address (begin (move-long 'exit '%i0) (emit st "%i0" (disp (make-reg 'fp) 0))) (move-long 'exit (make-reg (car parameter-registers)))) (emit ba (make-label entry)) ; head to generated Scheme code (emit nop) (emit-label "exit") (let ([rv (make-reg return-value-register)]) (unless (eq? rv '%i0) ; set up return value if not (emit mov rv "%i0"))) ; already in the right place (emit jmp "%i7+8") ; return to operating environment (emit restore))) ; restore the caller's registers (lambda (prog) (match prog [(let () ,input-language-definition (global-data ,label* ...) (code (jump (label ,entry)) ,code* ...)) (with-output-to-string (lambda () (unless (null? label*) (emit .section "\".data\"") (for-each cogen-global label*) (emit .section "\".text\"")) (for-each cogen code*) (newline) (cogen-boilerplate entry)))])))