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

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))