3 files changed, 96 insertions, 1 deletions
diff --git a/atk16_schasm/core.scm b/atk16_schasm/core.scm
index 4b33648..d03816c 100644
--- a/atk16_schasm/core.scm
+++ b/atk16_schasm/core.scm
@@ -5,6 +5,11 @@
 
 ;; Utils
 
+(define-syntax comment
+  (syntax-rules ()
+    ((_ expr* ...)
+     (begin))))
+
 (define-syntax @
   (syntax-rules ()
     ((_ fn-body expr ...)
diff --git a/atk16_schasm/macros.scm b/atk16_schasm/macros.scm
new file mode 100644
index 0000000..45d2167
--- /dev/null
+++ b/atk16_schasm/macros.scm
@@ -0,0 +1,84 @@
+;; Assume that core.scm is loaded
+
+(define *unique-counter* 0)
+(define (next-unique)
+  (set! *unique-counter* (+ 1 *unique-counter*))
+  *unique-counter*)
+(define *macro-scratch-reg* R12)
+
+(define (%packed-string s)
+  ;; emit length
+  (define sl (string-length s))
+  (u16 sl)			     ; cast to u16 to get bounds check
+  (emit-word sl)
+
+  ;; compute packed words
+  (for-each (@ emit-byte) (string->ascii-list s)))
+
+(define-syntax emit-test-eq
+  (syntax-rules ()
+    ((_ lhs rhs dest set)
+     (begin (sub lhs rhs)
+	    (br flag-zero (label dest) set: set)))))
+
+(define-syntax emit-test-lt
+  (syntax-rules ()
+    ((_ lhs rhs dest set)
+     (begin (sub lhs rhs)
+	    (br flag-sign (label dest) set: set)))))
+
+(define-syntax emit-test-lte
+  (syntax-rules ()
+    ((_ lhs rhs dest set)
+     (begin (sub lhs rhs)
+	    (sub lhs (u16 1))
+	    (br flag-sign (label dest) set: set)))))
+
+(define-syntax %if-else
+  (syntax-rules ()
+    ((_ pred tb fb)
+     (let* ((lhs  (eval (car 'pred)))
+	    (op   (cadr 'pred))
+	    (rhs  (eval (caddr 'pred)))
+	    (n    (next-unique))
+	    (sym-false (string->symbol (format "~A-false" n)))
+	    (sym-end   (string->symbol (format "~A-end"   n))))
+       (ld *macro-scratch-reg* lhs)
+
+       (cond
+	((eq? '== op) (emit-test-eq  *macro-scratch-reg* rhs sym-false #f))
+	((eq? '!= op) (emit-test-eq  *macro-scratch-reg* rhs sym-false #t))
+	((eq? '<  op) (emit-test-lt  *macro-scratch-reg* rhs sym-false #f))
+	((eq? '>= op) (emit-test-lt  *macro-scratch-reg* rhs sym-false #t))
+	((eq? '<= op) (emit-test-lte *macro-scratch-reg* rhs sym-false #f))
+	((eq? '>  op) (emit-test-lte *macro-scratch-reg* rhs sym-false #t))
+	(else (error "unsupported operator" op)))
+
+       tb
+       (ld PC (label sym-end))
+       (def-label sym-false)
+       fb
+       (def-label sym-end)))))
+
+(define-syntax %if
+  (syntax-rules ()
+    ((_ pred tb)
+     (let* ((lhs  (eval (car 'pred)))
+	    (op   (cadr 'pred))
+	    (rhs  (eval (caddr 'pred)))
+	    (n    (next-unique))
+	    (sym-end   (string->symbol (format "~A-end"   n))))
+       (ld *macro-scratch-reg* lhs)
+
+       (cond
+	((eq? '== op) (emit-test-eq  *macro-scratch-reg* rhs sym-end #f))
+	((eq? '!= op) (emit-test-eq  *macro-scratch-reg* rhs sym-end #t))
+	((eq? '<  op) (emit-test-lt  *macro-scratch-reg* rhs sym-end #f))
+	((eq? '>= op) (emit-test-lt  *macro-scratch-reg* rhs sym-end #t))
+	((eq? '<= op) (emit-test-lte *macro-scratch-reg* rhs sym-end #f))
+	((eq? '>  op) (emit-test-lte *macro-scratch-reg* rhs sym-end #t))
+	(else (error "unsupported operator" op)))
+
+       tb
+       (def-label sym-end)))))
+
diff --git a/atk16_schasm/main.scm b/atk16_schasm/main.scm
index e6f63ca..3258a7f 100644
--- a/atk16_schasm/main.scm
+++ b/atk16_schasm/main.scm
@@ -35,7 +35,7 @@
   (hlt))
 
 ;; store string data in memory
-(def-label 'data
+(def-label 'text-data
   (%packed-string "hölynpöly"))
 
 (at-addr #x50)
@@ -56,5 +56,11 @@
 (%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))))
+
 ;; compile to a 128KB image file
 (write-image-to "out.bin")