Add procedure declaration & call macros

2 files changed, 65 insertions, 8 deletions

diff --git a/atk16_schasm/macros.scm b/atk16_schasm/macros.scm
index 1a32cd4..38aa26b 100644
--- a/atk16_schasm/macros.scm
+++ b/atk16_schasm/macros.scm
@@ -72,7 +72,7 @@
 
 (define-syntax %if
   (syntax-rules ()
-    ((_ pred tb)
+    ((_ pred body body* ...)
      (let* ((lhs  (eval (car 'pred)))
 	    (op   (cadr 'pred))
 	    (rhs  (eval (caddr 'pred)))
@@ -82,6 +82,56 @@
 
        (emit-inverted-test *macro-scratch-reg* op rhs sym-end)
 
-       tb
+       body body* ...
+
        (def-label sym-end)))))
 
+(define-syntax %while
+  (syntax-rules ()
+    ((_ pred body body* ...)
+     (let* ((lhs (eval (car 'pred)))
+	    (op  (cadr 'pred))
+	    (rhs (eval (caddr 'pred)))
+	    (n   (next-unique))
+	    (sym-test (string->symbol (format "~A-test" n)))
+	    (sym-end  (string->symbol (format "~A-end"  n))))
+       (ld *macro-scratch-reg* lhs)
+
+       (def-label sym-test)
+       (emit-inverted-test *macro-scratch-reg* op rhs sym-end)
+
+       body body* ...
+
+       (ld PC (label sym-test))
+       (def-label sym-end)))))
+
+(define *procedures* '())
+
+(define-syntax %def-proc
+  (syntax-rules ()
+    ((_ name params* ...)
+     (set! *procedures*
+       (cons (list 'name 'params* ...) *procedures*)))))
+
+(define-syntax %call
+  (syntax-rules ()
+    ((_ name args* ...)
+     (let* ((params  (or (assocdr 'name *procedures*)
+		        (error "proc not defined" 'name)))
+	    (args    (list args* ...))
+	    (n       (next-unique))
+	    (sym-ret (string->symbol (format "~A-ret" n))))
+
+       (unless (= (length params) (length args))
+	 (error (format "incorrect args, expected ~A, got ~A" params args)))
+
+       (let loop ((i 0))
+	 (when (< i (length args))
+	   (let* ((rn (reg i)))
+	     (ld rn (list-ref args i)))
+	   (loop (+ 1 i))))
+
+       (st SP (label sym-ret) push: #t)
+       (ld PC (label 'name))
+       (def-label sym-ret)
+       ))))
diff --git a/atk16_schasm/main.scm b/atk16_schasm/main.scm
index 3258a7f..a3f16ad 100644
--- a/atk16_schasm/main.scm
+++ b/atk16_schasm/main.scm
@@ -47,7 +47,7 @@
 (def-label 'branch-true
   (emit-word 2))
 
-;; use macros for convenience
+;; use macros like %if, %while for convenience
 (let ((x #x5678))
   (%if-else (R1 == R2)
 	    (emit-word #x1234)
@@ -56,11 +56,18 @@
 (%if (R1 <= (u16 #xFF))
      (emit-word #xbeef))
 
-(comment
- (ld R1 (u16 10))
- (%while (R1 > (u16 0))
-	 (%call println (label 'text-data))
-	 (sub R1 (u16 1))))
+;; procedure declarations
+(%def-proc println str)
+(def-label 'println
+  ;; R0 := str
+  ;; ...
+  (ld PC SP pop: #t indirect: 1))
+
+;; procedure calls
+(ld R1 (u16 10))
+(%while (R1 > (u16 0))
+	(%call println (label 'text-data))
+	(sub R1 (u16 1)))
 
 ;; compile to a 128KB image file
 (write-image-to "out.bin")