expand asm! to allow for actually implementing the sort chal in laser

This commit is contained in:
xenia 2020-07-21 02:38:52 -04:00
parent 02e439fd57
commit 83a2064123
1 changed files with 63 additions and 21 deletions

View File

@ -291,13 +291,13 @@
(branch (branch
(string-append (string-append
"UU" (mem->scratch a) (mem->scratch b) "U" op "") "UU" (mem->scratch a) (mem->scratch b) "U" op "")
(list y x) (list x y)
(list "pDDD" "pDDD")))) (list "pDDD" "pDDD"))))
(define assemblers (define assemblers
(hash (hash
'prelude (lambda () '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) 'set! (lambda (target value)
(if (mem-loc? value) (if (mem-loc? value)
(string-append "UU" (mem->scratch value) (scratch->mem target) "DD") (string-append "UU" (mem->scratch value) (scratch->mem target) "DD")
@ -317,16 +317,25 @@
(chr* #\u (mem-loc-value a)) (chr* #\u (mem-loc-value a))
"DD")) "DD"))
'asm! (lambda args 'asm! (lambda args
(define op (first args)) (match args
;; support input and output vars
[(list asm "r" r-vars ... "w" w-var)
(string-append (string-append
"UU" "UU"
(apply string-append (map mem->scratch (rest args))) (if r-vars
"U" op "DDD")) (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")) 'asmgoto! (lambda (branches . args) (error "unimplemented"))
'ifeq (basic-branch-op "=") 'ifeq (basic-branch-op "=")
'iflt (basic-branch-op "l") 'iflt (basic-branch-op "l")
'goto (lambda (a) (branch "" (list a) (list ""))) 'goto (lambda (a) (branch "" (list a) (list "")))
'terminate (lambda () (branch "#" '() '())))) 'terminate (lambda () (branch "U#" '() '()))))
;; export ;; export
@ -389,20 +398,53 @@
;;;;;;;; demo ;;;;;;;; demo
(define prog (define prog
'((global i) '((global count)
(global inc) (global one)
(global ten) (global zero)
(global j)
(global largest-j)
(global largest-value)
(global tmp)
(label main) (label main)
(set! i 0) (set! zero 0)
(set! ten 10) (set! one 1)
(set! inc 1) (set! j 0)
(label loop) (set! largest-j 0)
(add! i inc) (set! largest-value -999999)
(asm! "o" i) ;; get size of input stack
(asm! "o" ten) (asm! "DDDcsUsUsU" "r" "w" count)
(ifeq i ten done loop) (ifeq count zero exit sort-step)
(label done)
(asm! "\"hello world\"o") (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))) (terminate)))
(displayln (compile prog)) (displayln (compile prog))