diff options
| -rw-r--r-- | atk16_schasm/macros.scm | 54 | ||||
| -rw-r--r-- | atk16_schasm/main.scm | 19 |
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") |