expand asm! to allow for actually implementing the sort chal in laser
This commit is contained in:
parent
02e439fd57
commit
83a2064123
84
compiler.rkt
84
compiler.rkt
|
@ -291,13 +291,13 @@
|
|||
(branch
|
||||
(string-append
|
||||
"UU" (mem->scratch a) (mem->scratch b) "U" op "⌝")
|
||||
(list y x)
|
||||
(list x y)
|
||||
(list "pDDD" "pDDD"))))
|
||||
|
||||
(define assemblers
|
||||
(hash
|
||||
'prelude (lambda ()
|
||||
(string-append "UU" (chr* #\0 (cctx-num-globals (current-cctx))) "DD"))
|
||||
(string-append "IUU" (chr* #\0 (cctx-num-globals (current-cctx))) "DD"))
|
||||
'set! (lambda (target value)
|
||||
(if (mem-loc? value)
|
||||
(string-append "UU" (mem->scratch value) (scratch->mem target) "DD")
|
||||
|
@ -317,16 +317,25 @@
|
|||
(chr* #\u (mem-loc-value a))
|
||||
"DD"))
|
||||
'asm! (lambda args
|
||||
(define op (first args))
|
||||
(string-append
|
||||
"UU"
|
||||
(apply string-append (map mem->scratch (rest args)))
|
||||
"U" op "DDD"))
|
||||
(match args
|
||||
;; support input and output vars
|
||||
[(list asm "r" r-vars ... "w" w-var)
|
||||
(string-append
|
||||
"UU"
|
||||
(if r-vars
|
||||
(apply string-append (map mem->scratch r-vars))
|
||||
"")
|
||||
"U" asm "D"
|
||||
(if w-var
|
||||
(scratch->mem w-var)
|
||||
"")
|
||||
"DD")]
|
||||
[_ (error "invalid asm form")]))
|
||||
'asmgoto! (lambda (branches . args) (error "unimplemented"))
|
||||
'ifeq (basic-branch-op "=")
|
||||
'iflt (basic-branch-op "l")
|
||||
'goto (lambda (a) (branch "" (list a) (list "")))
|
||||
'terminate (lambda () (branch "#" '() '()))))
|
||||
'terminate (lambda () (branch "U#" '() '()))))
|
||||
|
||||
;; export
|
||||
|
||||
|
@ -389,20 +398,53 @@
|
|||
;;;;;;;; demo
|
||||
|
||||
(define prog
|
||||
'((global i)
|
||||
(global inc)
|
||||
(global ten)
|
||||
'((global count)
|
||||
(global one)
|
||||
(global zero)
|
||||
(global j)
|
||||
(global largest-j)
|
||||
(global largest-value)
|
||||
(global tmp)
|
||||
|
||||
(label main)
|
||||
(set! i 0)
|
||||
(set! ten 10)
|
||||
(set! inc 1)
|
||||
(label loop)
|
||||
(add! i inc)
|
||||
(asm! "o" i)
|
||||
(asm! "o" ten)
|
||||
(ifeq i ten done loop)
|
||||
(label done)
|
||||
(asm! "\"hello world\"o")
|
||||
(set! zero 0)
|
||||
(set! one 1)
|
||||
(set! j 0)
|
||||
(set! largest-j 0)
|
||||
(set! largest-value -999999)
|
||||
;; get size of input stack
|
||||
(asm! "DDDcsUsUsU" "r" "w" count)
|
||||
(ifeq count zero exit sort-step)
|
||||
|
||||
(label sort-step)
|
||||
;; get value from input stack
|
||||
(asm! "DDDrsuUsUsU" "r" "w" tmp)
|
||||
(iflt tmp largest-value sort-step-cont sort-step-update)
|
||||
|
||||
(label sort-step-update)
|
||||
(set! largest-j j)
|
||||
(set! largest-value tmp)
|
||||
|
||||
(label sort-step-cont)
|
||||
(add! j one)
|
||||
(ifeq j count move-val sort-step)
|
||||
|
||||
(label move-val)
|
||||
(set! j 0)
|
||||
|
||||
(label shift-loop)
|
||||
(ifeq j largest-j shift-done shift-cont)
|
||||
(label shift-cont)
|
||||
(asm! "DDDuUUU" "r" "w" #f)
|
||||
(add! j one)
|
||||
(goto shift-loop)
|
||||
|
||||
(label shift-done)
|
||||
;; move input->output
|
||||
(asm! "DDDsUUU" "r" "w" #f)
|
||||
(goto main)
|
||||
|
||||
(label exit)
|
||||
(terminate)))
|
||||
|
||||
(displayln (compile prog))
|
||||
|
|
Loading…
Reference in New Issue