diff options
| -rw-r--r-- | atk16_schasm/core.scm (renamed from atk16_schasm/lib.scm) | 126 | ||||
| -rw-r--r-- | atk16_schasm/main.scm | 17 | ||||
| -rw-r--r-- | atk16_schasm/note.md | 35 |
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`. |