Add %if and %if-else macros, refactor, add indirection levels

3 files changed, 83 insertions, 95 deletions

diff --git a/atk16_schasm/lib.scm b/atk16_schasm/core.scm
index 503e521..4b33648 100644
--- a/atk16_schasm/lib.scm
+++ b/atk16_schasm/core.scm
@@ -3,6 +3,37 @@
 	(chicken format)
 	(chicken io))
 
+;; Utils
+
+(define-syntax @
+  (syntax-rules ()
+    ((_ fn-body expr ...)
+     (lambda (x) (fn-body expr ... x)))))
+
+(define (type-of pair)
+  (if (pair? pair) (car pair) (error "not a pair" pair)))
+(define (val-of pair)
+  (if (pair? pair) (cdr pair) (error "not a pair" pair)))
+
+(define (assocar k alist)
+  (let ((v (assoc k alist)))
+    (and v (car v))))
+(define (assocdr k alist)
+  (let ((v (assoc k alist)))
+    (and v (cdr v))))
+
+(define (string->ascii-list s)
+  (let* ((len (string-length s))
+         (dummy (cons #f '()))
+         (tail dummy))
+    (do ((i 0 (+ i 1)))
+        ((= i len))
+      (set-cdr! tail (cons (char->integer (string-ref s i)) '()))
+      (set! tail (cdr tail)))
+    (cdr dummy)))
+
+;; State
+
 (define *buffer* (make-vector (* 2 (expt 2 16)) #f))
 (define *cursor* 0)
 (define *labels* '())
@@ -248,10 +279,9 @@
 (define (shr lhs rhs) (alu (alu-op 6) lhs rhs))
 (define (sar lhs rhs) (alu (alu-op 7) lhs rhs))
 
-(define (ld lhs rhs #!key (indirect #f) (pop #f))
+(define (ld lhs rhs #!key (indirect 0) (pop #f))
   (unless (eq? 'reg (type-of lhs)) (error "invalid lhs" lhs))
 
-  (define d-mode (if indirect 1 0))
   (define p-mode (if pop 1 0))
 
   (define rhs-type (type-of rhs))
@@ -265,9 +295,8 @@
       ;; reg mode
       (begin
 	(emit-byte-chunks `(4 . 2)
-			  `(1 . ,d-mode)
+			  `(2 . ,indirect)
 			  `(1 . ,p-mode)
-			  `(1 . 0)
 			  `(1 . ,m-mode))
 	(emit-byte-chunks `(4 . ,(val-of lhs))
 			  `(4 . ,(val-of rhs))))
@@ -275,9 +304,8 @@
       ;; immediate mode
       (begin
 	(emit-byte-chunks `(4 . 2)
-			  `(1 . ,d-mode)
+			  `(2 . ,indirect)
 			  `(1 . ,p-mode)
-			  `(1 . 0)
 			  `(1 . ,m-mode))
 	(emit-byte-chunks `(4 . ,(val-of lhs))
 			  `(4 . 0))
@@ -289,19 +317,9 @@
 	    ;; otherwise, emit the value
 	    (emit-word (val-of rhs))))))
 
-(define (mov lhs rhs)
-  (unless (eq? 'reg (type-of lhs)) (error "invalid lhs" lhs))
-  (unless (eq? 'reg (type-of rhs)) (error "invalid rhs" rhs))
-
-  (emit-byte-chunks `(4 . 3)
-		    `(4 . 0))
-  (emit-byte-chunks `(4 . ,(val-of lhs))
-		    `(4 . ,(val-of rhs))))
-
-(define (st lhs rhs #!key (indirect #f) (push #f))
+(define (st lhs rhs #!key (indirect 0) (push #f))
   (unless (eq? 'reg (type-of lhs)) (error "invalid lhs" lhs))
 
-  (define d-mode (if indirect 1 0))
   (define p-mode (if push 1 0))
 
   (define rhs-type (type-of rhs))
@@ -315,9 +333,8 @@
       ;; reg mode
       (begin
 	(emit-byte-chunks `(4 . 4)
-			  `(1 . ,d-mode)
+			  `(2 . ,indirect)
 			  `(1 . ,p-mode)
-			  `(1 . 0)
 			  `(1 . ,m-mode))
 	(emit-byte-chunks `(4 . ,(val-of lhs))
 			  `(4 . ,(val-of rhs))))
@@ -325,9 +342,8 @@
       ;; immediate mode
       (begin
 	(emit-byte-chunks `(4 . 4)
-			  `(1 . ,d-mode)
+			  `(2 . ,indirect)
 			  `(1 . ,p-mode)
-			  `(1 . 0)
 			  `(1 . ,m-mode))
 	(emit-byte-chunks `(4 . ,(val-of lhs))
 			  `(4 . 0))
@@ -365,71 +381,3 @@
 		      `(1 . ,set))
     (emit-deferred-sexpr `(label . (rel ,(val-of offset) ,(+ *cursor* 1)))))
    (else (error "invalid offset" offset))))
-
-;; "Macros"
-
-(define (emit-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
-  (emit-bytes (string->ascii-list s)))
-
-(define (emit-bytes bytes)
-  (let loop ((bs bytes))
-    (if (null? bs)
-	;; if done, return total number of bytes emitted
-	(length bytes)
-	;; if not, emit the byte and loop
-	(begin (emit-byte (car bs))
-	       (loop (cdr bs))))))
-
-;; Utils
-
-(define (type-of pair)
-  (if (pair? pair) (car pair) (error "not a pair" pair)))
-(define (val-of pair)
-  (if (pair? pair) (cdr pair) (error "not a pair" pair)))
-
-(define (assocar k alist)
-  (let ((v (assoc k alist)))
-    (and v (car v))))
-(define (assocdr k alist)
-  (let ((v (assoc k alist)))
-    (and v (cdr v))))
-
-(define (string->ascii-list s)
-  (let* ((len (string-length s))
-         (dummy (cons #f '()))
-         (tail dummy))
-    (do ((i 0 (+ i 1)))
-        ((= i len))
-      (set-cdr! tail (cons (char->integer (string-ref s i)) '()))
-      (set! tail (cdr tail)))
-    (cdr dummy)))
-
-(define (pack-bytes-to-words bytes)
-  (cond
-   ((>= (length bytes) 2)
-    (let* ((hi   (car bytes))
-	   (lo   (cadr bytes))
-	   (word (+ (arithmetic-shift hi 8) lo)))
-
-      (unless (and (>= word 0)
-		   (<  word (expt 2 16)))
-	(error "packing of two bytes produced an invalid 16 bit word" word))
-
-      (cons word (pack-bytes-to-words (cddr bytes)))))
-   ((= (length bytes) 1)
-    (let* ((hi   (car bytes))
-	   (word (arithmetic-shift hi 8)))
-
-      (unless (and (>= word 0)
-		   (<  word (expt 2 16)))
-	(error "packing of one byte produced an invalid 16 bit word" word))
-
-      (list word)))
-   ((= (length bytes) 0)
-    '())))
diff --git a/atk16_schasm/main.scm b/atk16_schasm/main.scm
index 2810df7..e6f63ca 100644
--- a/atk16_schasm/main.scm
+++ b/atk16_schasm/main.scm
@@ -1,6 +1,7 @@
 (import (chicken base))
 
-(load "lib.scm")
+(load "core.scm")
+(load "macros.scm")
 
 ;; load asm modules
 (load "bootstrap.scm")
@@ -33,12 +34,9 @@
 (def-label 'forward
   (hlt))
 
-;; copy to register
-(mov R0 R1)
-
 ;; store string data in memory
 (def-label 'data
-  (emit-packed-string "hölynpöly"))
+  (%packed-string "hölynpöly"))
 
 (at-addr #x50)
 
@@ -49,7 +47,14 @@
 (def-label 'branch-true
   (emit-word 2))
 
-;;(print *buffer*)
+;; use macros for convenience
+(let ((x #x5678))
+  (%if-else (R1 == R2)
+	    (emit-word #x1234)
+	    (emit-word x)))
+
+(%if (R1 <= (u16 #xFF))
+     (emit-word #xbeef))
 
 ;; compile to a 128KB image file
 (write-image-to "out.bin")
diff --git a/atk16_schasm/note.md b/atk16_schasm/note.md
new file mode 100644
index 0000000..e48e7a5
--- /dev/null
+++ b/atk16_schasm/note.md
@@ -0,0 +1,35 @@
+# note about loads & stores
+
+the indirection count tells the CPU how many times to dereference the address before reading or writing the value. in loads, the value can range from 0 to 3, and in stores, the value can range from 1 to 3. the indirection count is 0-indexed, so a value of 0 means no indirection, 1 means one level of indirection, and so on.
+
+    ;; asm
+    (ld R0 (u16 #x1234) indirect: 0)
+    ;; equivalent pseudocode
+    R0 := 0x1234
+
+    ;; asm
+    (ld R0 (u16 #x1234) indirect: 2)
+    ;; equivalent pseudocode
+    R0 := **(0x1234)
+
+    ;; asm
+    (ld R0 R1)
+    ;; equivalent pseudocode
+    R0 := R1
+
+    ;; asm
+    (ld R0 R1 indirect: 3)
+    ;; equivalent pseudocode
+    R0 := ***R1
+
+    ;; asm
+    (st R0 (u16 #x1234) indirect: 2)
+    ;; equivalent pseudocode
+    **(0x1234) := R0
+
+    ;; asm
+    (st R0 R1 indirect: 1)
+    ;; equivalent pseudocode
+    *R1 := R0
+
+a load with an indirection count of 0 in reg mode is a `mov`.