All pastes #465325 Raw Edit

Mine

public text v1 · immutable
#465325 ·published 2007-04-30 02:11 UTC
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)))])))