aboutsummaryrefslogtreecommitdiffstats
path: root/atk16_schasm
diff options
context:
space:
mode:
Diffstat (limited to 'atk16_schasm')
-rw-r--r--atk16_schasm/bootstrap.scm6
-rw-r--r--atk16_schasm/core.scm157
-rw-r--r--atk16_schasm/macros.scm27
-rw-r--r--atk16_schasm/main.scm22
-rw-r--r--atk16_schasm/structs_idea.scm28
5 files changed, 151 insertions, 89 deletions
diff --git a/atk16_schasm/bootstrap.scm b/atk16_schasm/bootstrap.scm
index 09bfbb9..d9105f8 100644
--- a/atk16_schasm/bootstrap.scm
+++ b/atk16_schasm/bootstrap.scm
@@ -17,7 +17,7 @@
;; Set stack pointer to end of heap segment, i.e. one below addr-segment-mmio.
;; Stack grows down.
;; Heap grows up from addr-segment-heap until it meets the stack.
- (ld SP (u16 (- addr-segment-mmio 1)))
+ (ld SP ZR (u16 (- addr-segment-mmio 1)))
;; Set graphics mode to disabled.
- (ld R0 (u16 addr-mmio-graphics-mode))
- (st R0 (u16 graphics-disabled)))
+ (ld R0 ZR (u16 addr-mmio-graphics-mode))
+ (st R0 ZR (u16 graphics-disabled)))
diff --git a/atk16_schasm/core.scm b/atk16_schasm/core.scm
index 7c292f1..32462da 100644
--- a/atk16_schasm/core.scm
+++ b/atk16_schasm/core.scm
@@ -132,7 +132,7 @@
(define (emit-byte b)
(unless (and (>= b 0)
(< b (expt 2 8)))
- (error "value out of bounds" byte))
+ (error "value out of bounds" b))
(emit-byte-chunks `(8 . ,b)))
@@ -186,25 +186,34 @@
((or (< n 0) (>= n 16)) (error "invalid arg to reg" n))
(else (cons 'reg n))))
+;; R0..R5 caller saved arguments, generic
+;; R0 return value register
(define R0 (reg 0))
(define R1 (reg 1))
(define R2 (reg 2))
(define R3 (reg 3))
(define R4 (reg 4))
(define R5 (reg 5))
+;; R6..R11 callee saved arguments, generic
(define R6 (reg 6))
(define R7 (reg 7))
(define R8 (reg 8))
(define R9 (reg 9))
(define R10 (reg 10))
(define R11 (reg 11))
+;; Special (see below)
(define R12 (reg 12))
(define R13 (reg 13))
(define R14 (reg 14))
(define R15 (reg 15))
+;; Zero register (hardwired to 0)
+(define ZR (reg 12))
+;; Flag register (only lowest 4 bits set by ALU)
(define FL (reg 13))
+;; Program counter
(define PC (reg 14))
+;; Stack pointer
(define SP (reg 15))
(define (imm n)
@@ -271,6 +280,9 @@
(unless (eq? 'reg (type-of lhs)) (error "invalid lhs" lhs))
(define rhs-type (type-of rhs))
+ ;; Addressing modes
+ ;; 0: reg (1 word)
+ ;; 1: reg + word (2 words)
(define m-mode
(cond ((eq? 'reg rhs-type) 0)
((eq? 'imm rhs-type) 1)
@@ -310,81 +322,86 @@
(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 0) (pop #f))
- (unless (eq? 'reg (type-of lhs)) (error "invalid lhs" lhs))
-
- (define p-mode (if pop 1 0))
-
- (define rhs-type (type-of rhs))
- (define m-mode
- (cond ((eq? 'reg rhs-type) 0)
- ((eq? 'imm rhs-type) 1)
- ((eq? 'label rhs-type) 1)
- (else (error "invalid rhs" rhs))))
-
- (if (= m-mode 0)
- ;; reg mode
- (begin
- (emit-byte-chunks `(4 . 2)
- `(2 . ,indirect)
- `(1 . ,p-mode)
- `(1 . ,m-mode))
- (emit-byte-chunks `(4 . ,(val-of lhs))
- `(4 . ,(val-of rhs))))
+;; Load data to to-reg from memory pointed by from-reg + offset.
+;; With indirect = 0, copies the value from-reg + offset to to-reg without memory access.
+(define (ld to-reg from-reg #!optional offset #!key (indirect 0) (preinc #f))
+ (unless (eq? 'reg (type-of to-reg)) (error "invalid target register" to-reg))
+ (unless (eq? 'reg (type-of from-reg)) (error "invalid source register" from-reg))
+ (unless (or (not offset)
+ (eq? 'imm (type-of offset))
+ (eq? 'label (type-of offset)))
+ (error "invalid offset" offset))
+ (unless (and (number? indirect)
+ (>= indirect 0)
+ (< indirect 4))
+ (error "invalid indirect" indirect))
+ (unless (boolean? preinc) (error "invalid preinc" preinc))
- ;; immediate mode
- (begin
- (emit-byte-chunks `(4 . 2)
- `(2 . ,indirect)
- `(1 . ,p-mode)
- `(1 . ,m-mode))
- (emit-byte-chunks `(4 . ,(val-of lhs))
- `(4 . 0))
-
- (if (eq? 'label rhs-type)
- ;; if label, emit a label reference
- (begin (emit-deferred-sexpr `(label . (hi ,(val-of rhs))))
- (emit-deferred-sexpr `(label . (lo ,(val-of rhs)))))
- ;; otherwise, emit the value
- (emit-word (val-of rhs))))))
+ ;; Addressing modes
+ ;; 0: reg (1 word)
+ ;; 1: reg, preincrement (1 word)
+ ;; 2: reg + word (2 words)
+ ;; 3: reg + word, preincrement (2 words)
+ (define m-mode (if offset 1 0))
+ (define p-mode (if preinc 1 0))
-(define (st lhs rhs #!key (indirect 0) (push #f))
- (unless (eq? 'reg (type-of lhs)) (error "invalid lhs" lhs))
+ (emit-byte-chunks `(4 . 2)
+ `(2 . ,indirect)
+ `(1 . ,m-mode)
+ `(1 . ,p-mode))
+ (emit-byte-chunks `(4 . ,(val-of to-reg))
+ `(4 . ,(val-of from-reg)))
- (define p-mode (if push 1 0))
+ (cond
+ ;; in reg+word mode, if label, emit a label reference
+ ((and offset (eq? 'label (type-of offset)))
+ (emit-deferred-sexpr `(label . (hi ,(val-of offset))))
+ (emit-deferred-sexpr `(label . (lo ,(val-of offset)))))
+ ;; in reg+word mode, if imm, emit the value
+ ((and offset (eq? 'imm (type-of offset)))
+ (emit-word (val-of offset)))
+ (offset
+ (error "invalid offset in reg+word addressing mode" offset))))
- (define rhs-type (type-of rhs))
- (define m-mode
- (cond ((eq? 'reg rhs-type) 0)
- ((eq? 'imm rhs-type) 1)
- ((eq? 'label rhs-type) 1)
- (else (error "invalid rhs" rhs))))
+;; Store data in from-reg to memory pointed by to-reg + offset.
+(define (st from-reg to-reg #!optional offset #!key (indirect 1) (postdec #f))
+ (unless (eq? 'reg (type-of to-reg)) (error "invalid target register" to-reg))
+ (unless (eq? 'reg (type-of from-reg)) (error "invalid source register" from-reg))
+ (unless (or (not offset)
+ (eq? 'imm (type-of offset))
+ (eq? 'label (type-of offset)))
+ (error "invalid offset" offset))
+ (unless (and (number? indirect)
+ (>= indirect 1)
+ (< indirect 4))
+ (error "invalid indirect" indirect))
+ (unless (boolean? postdec) (error "invalid postdec" postdec))
- (if (= m-mode 0)
- ;; reg mode
- (begin
- (emit-byte-chunks `(4 . 4)
- `(2 . ,indirect)
- `(1 . ,p-mode)
- `(1 . ,m-mode))
- (emit-byte-chunks `(4 . ,(val-of lhs))
- `(4 . ,(val-of rhs))))
+ ;; Addressing modes
+ ;; 0: reg (1 word)
+ ;; 1: reg, postdecrement (1 word)
+ ;; 2: reg + word (2 words)
+ ;; 3: reg + word, postdecrement (2 words)
+ (define m-mode (if offset 1 0))
+ (define p-mode (if postdec 1 0))
- ;; immediate mode
- (begin
- (emit-byte-chunks `(4 . 4)
- `(2 . ,indirect)
- `(1 . ,p-mode)
- `(1 . ,m-mode))
- (emit-byte-chunks `(4 . ,(val-of lhs))
- `(4 . 0))
+ (emit-byte-chunks `(4 . 4)
+ `(2 . ,indirect)
+ `(1 . ,m-mode)
+ `(1 . ,p-mode))
+ (emit-byte-chunks `(4 . ,(val-of from-reg))
+ `(4 . ,(val-of to-reg)))
- (if (eq? 'label rhs-type)
- ;; if label, emit a label reference
- (begin (emit-deferred-sexpr `(label . (hi ,(val-of rhs))))
- (emit-deferred-sexpr `(label . (lo ,(val-of rhs)))))
- ;; otherwise, emit the value
- (emit-word (val-of rhs))))))
+ (cond
+ ;; in reg+word mode, if label, emit a label reference
+ ((and offset (eq? 'label (type-of offset)))
+ (emit-deferred-sexpr `(label . (hi ,(val-of offset))))
+ (emit-deferred-sexpr `(label . (lo ,(val-of offset)))))
+ ;; in reg+word mode, if imm, emit the value
+ ((and offset (eq? 'imm (type-of offset)))
+ (emit-word (val-of offset)))
+ (offset
+ (error "invalid offset in reg+word addressing mode" offset))))
(define (br flag offset #!key (asserted #t))
(unless (eq? 'flag (type-of flag)) (error "invalid flag selector" flag))
@@ -404,7 +421,7 @@
`(2 . ,(val-of flag))
`(1 . 0)
`(1 . ,set))
- (emit `(8 . ,imm))))
+ (emit-byte `(8 . ,imm))))
((eq? 'label offset-type)
(emit-byte-chunks `(4 . 5)
`(2 . ,(val-of flag))
diff --git a/atk16_schasm/macros.scm b/atk16_schasm/macros.scm
index 6b759b3..fb1ed3e 100644
--- a/atk16_schasm/macros.scm
+++ b/atk16_schasm/macros.scm
@@ -4,7 +4,7 @@
(define (next-unique)
(inc! *unique-counter*)
*unique-counter*)
-(define *macro-scratch-reg* R12)
+(define *macro-scratch-reg* R11)
(define (%packed-string s)
;; emit length
@@ -65,7 +65,7 @@
(emit-inverted-test *macro-scratch-reg* op rhs sym-false)
tb
- (ld PC (label sym-end))
+ (ld PC ZR (label sym-end))
(def-label sym-false)
fb
(def-label sym-end)))))
@@ -102,7 +102,7 @@
body body* ...
- (ld PC (label sym-test))
+ (ld PC ZR (label sym-test))
(def-label sym-end)))))
(define *procedures* '())
@@ -127,7 +127,7 @@
((_ pname)
(param 'pname))))
-(define-syntax %def-proc
+(define-syntax %proc
(syntax-rules ()
((_ signature body* ...)
(let* ((name (car `signature))
@@ -141,6 +141,7 @@
(def-label name)
(parameterize ((*proc-scope* bindings))
body* ...)
+ (ld PC SP #f preinc: #t indirect: 1)
))))
(define-syntax %call
@@ -171,12 +172,22 @@
;; move each argument to its designated register
;; first arg to R0, etc.
- (let* ((rn (reg i)))
- (ld rn (list-ref args i)))
+ (let* ((rn (reg i))
+ (argi (list-ref args i))
+ (itype (type-of argi)))
+ (cond
+ ((eq? 'reg itype)
+ (ld rn argi))
+ ((or (eq? 'imm itype)
+ (eq? 'label itype))
+ (ld rn ZR argi))
+ (else (error "invalid argument" argi))))
(loop (+ 1 i))))
- (st SP (label sym-ret) push: #t)
- (ld PC (label `name))
+ (ld *macro-scratch-reg* ZR (label sym-ret))
+ (st *macro-scratch-reg* SP #f postdec: #t)
+
+ (ld PC ZR (label `name))
(def-label sym-ret)
))))
diff --git a/atk16_schasm/main.scm b/atk16_schasm/main.scm
index 931a9db..4dc353a 100644
--- a/atk16_schasm/main.scm
+++ b/atk16_schasm/main.scm
@@ -8,7 +8,7 @@
(emit-word #x1234)
;; compile instructions
-(ld SP (u16 0))
+(ld SP ZR (u16 0))
;; set labels
(def-label 'some-data
@@ -22,13 +22,13 @@
(add R3 (u16 #xFF)))
;; abs jump
-(ld PC (label 'main))
+(ld PC ZR (label 'main))
;; rel jump
(add PC (i16 10))
;; jump forward to a currently undefined label
-(ld PC (label 'forward))
+(ld PC ZR (label 'forward))
(def-label 'forward
(hlt))
@@ -52,15 +52,21 @@
(emit-word x)))
(%when (R1 <= (u16 #xFF))
- (emit-word #xbeef))
+ (emit-word #xbeef))
;; procedures
-(%def-proc (println *str)
- (param '*str) ;; => R0
- (ld PC SP pop: #t indirect: 1))
+(%proc (println *str)
+
+ (%param *str) ;; => evaluates to R0
+ ;;(%svar x 1) ;; allocate a word on the stack
+ ;;(%svar y 1) ;; allocate another word on the stack
+ ;;(%soffset y) ;; => evaluates to frame offset 1
+
+ ;; %proc epilogue fees the %svars
+ )
;; procedure calls
-(ld R1 (u16 10))
+(ld R1 ZR (u16 10))
(%while (R1 > (u16 0))
(%call println (label 'text-data))
(sub R1 (u16 1)))
diff --git a/atk16_schasm/structs_idea.scm b/atk16_schasm/structs_idea.scm
new file mode 100644
index 0000000..d2fcc86
--- /dev/null
+++ b/atk16_schasm/structs_idea.scm
@@ -0,0 +1,28 @@
+# This buffer is for notes you don’t want to save, and for Chicken Scheme code.
+
+;; define structs
+(%def-struct point
+ (x u16)
+ (y u16))
+
+;; static struct instances
+(%static global-point
+ point (u16 10) (u16 20))
+
+;; use static address as load offset
+(ld R0 ZR (global-point:x))
+
+;; stack allocated instances
+(%def-proc (main)
+ ;; alloc some space on the stack
+ (%svar my-point (point:size))
+ ;; use stack offset as load offset
+ (ld R0 SP (my-point:x)))
+
+;; a vector of static instances
+(let loop ((i 0))
+ (when (< i 10)
+ (%static (string->symbol (format "global-points/~A" i))
+ point (u16 i) (u16 i))))
+
+(ld R0 ZR (global-points/0:x))

Want to contribute? Host your changes somewhere and send me the link: jan (at) sydanviita.fi. Also, check out my website.


forge.jan.systems — powered by cgit