rendered paste body(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)))])))