allow using opgen for reading longs from places besides the DP long "register"
This commit is contained in:
parent
315fd794de
commit
6eec75d5f2
|
@ -17,17 +17,17 @@
|
|||
block [:block]
|
||||
iloc-resultptr (do (assert (= arg-count expected-arg-count) (.. name " expected " expected-arg-count " args, got " (fv [...])))
|
||||
(when resultptr
|
||||
(lume.push block (ssc:push nil (ssc:expr-word resultptr)))
|
||||
(lume.push block (ssc:push nil resultptr :word))
|
||||
(length ssc.locals)))]
|
||||
(for [_ 1 (match return-type :void 0 :word 1 :long 2 _ return-type)]
|
||||
(lume.push block (ssc:push)))
|
||||
(lume.push block (ssc:push nil nil :register)))
|
||||
(each [_ push (ipairs (ssc:push-arguments (ssc:parse-parameters args) (lume.slice [...] 1 (length args))))]
|
||||
(lume.push block push))
|
||||
(lume.push block [:ldx cmd] [:jsr :0xe10000])
|
||||
(ssc:was-dropped (length args))
|
||||
(when error-handler
|
||||
(lume.push block [:bcc :-no-error-]
|
||||
(ssc:push :error) (ssc:expr-poly error-handler) (ssc:drop :error)
|
||||
(ssc:push :error nil :register) (ssc:expr-poly error-handler) (ssc:drop :error)
|
||||
:-no-error-))
|
||||
(match return-type
|
||||
:void nil
|
||||
|
|
63
ssc/init.fnl
63
ssc/init.fnl
|
@ -69,12 +69,17 @@
|
|||
(rts))))))
|
||||
|
||||
(fn Ssc.push [self name expr ?etype]
|
||||
(local etype (or ?etype :word))
|
||||
(table.insert self.locals {: name :type etype})
|
||||
(match etype
|
||||
:word [:block (or expr [:flatten]) [:pha]]
|
||||
:long [:block (or expr [:flatten]) [:lda self.LONG_HI] [:pha] [:lda self.LONG_LO] [:pha]]
|
||||
_ (error (.. "Unknown stack type " (tostring etype)))))
|
||||
(let [opgen (if (= ?etype :register) {:lo #[:flatten]}
|
||||
(self:expr-opgen expr ?etype))
|
||||
etype (if (= ?etype :register) :word
|
||||
?etype ?etype
|
||||
opgen.hi :long
|
||||
:word)
|
||||
c-setup (when opgen.setup (opgen.setup))
|
||||
c-lo [(opgen.lo :lda) [:pha]]
|
||||
c-hi (when opgen.hi [(opgen.hi :lda) [:pha]])]
|
||||
(table.insert self.locals {: name :type etype})
|
||||
(lume.concat [:block c-setup] c-hi c-lo)))
|
||||
|
||||
(fn Ssc.remove-local [self ?name]
|
||||
(let [loc (. self.locals (length self.locals))]
|
||||
|
@ -234,7 +239,7 @@
|
|||
expr))))
|
||||
(values c-body etype-body))
|
||||
:let (fn [self bindings ...]
|
||||
(let [compiled-bindings (icollect [_ symbol expr (pairoff bindings)] (self:push symbol (self:expr-poly expr)))
|
||||
(let [compiled-bindings (icollect [_ symbol expr (pairoff bindings)] (self:push symbol expr))
|
||||
(compiled-body etype) (self:expr-poly [:do ...])
|
||||
compiled-cleanup (icollect [i-half (countiter (/ (length bindings) 2))]
|
||||
(self:drop (. bindings (- (length bindings) (* i-half 2) -1))))]
|
||||
|
@ -284,8 +289,12 @@
|
|||
:not (lambda [self bool] (self:cmp-to-bool :not bool))
|
||||
:or (lambda [self ...] (self:cmp-to-bool :or ...))
|
||||
:and (lambda [self ...] (self:cmp-to-bool :and ...))
|
||||
:loword (lambda [self long] [:block (self:expr-long long) [:lda self.LONG_LO]])
|
||||
:hiword (lambda [self long] [:block (self:expr-long long) [:lda self.LONG_HI]])
|
||||
:loword (lambda [self long]
|
||||
(let [{: lo : setup} (self:expr-opgen long :long)]
|
||||
(lume.concat [:block] [(when setup (setup))] (lo :lda))))
|
||||
:hiword (lambda [self long]
|
||||
(let [{: hi : setup} (self:expr-opgen long :long)]
|
||||
(lume.concat [:block] [(when setup (setup))] (hi :lda))))
|
||||
:ref (lambda [self label] [:lda #(loword ($1:lookup-addr label))])
|
||||
:far-ref (lambda [self label] (values [:block [:lda #(loword ($1:lookup-addr label))] [:sta self.LONG_LO]
|
||||
[:lda #(hiword ($1:lookup-addr label))] [:sta self.LONG_HI]] :long))
|
||||
|
@ -299,13 +308,13 @@
|
|||
(self:expr-word value) [:sta [[self.ADDR_LO]]]]
|
||||
_ (error (.. "Unknown reference type " reftype)))
|
||||
:void)))
|
||||
:long! (lambda [self ref value] [:block (self:push nil (self:expr-word ref) :word)
|
||||
:long! (lambda [self ref value] [:block (self:push nil ref :word)
|
||||
(self:expr-long value) [:ldy 0] [:lda self.LONG_LO] [:sta [1 :s] :y] [:iny] [:iny] [:lda self.LONG_HI] [:sta [1 :s] :y]
|
||||
(self:drop)])
|
||||
:word-at (lambda [self ref]
|
||||
(local (c-ref etype) (self:expr-poly ref))
|
||||
(if (= etype :word)
|
||||
[:block (self:push nil c-ref :word) [:ldy 0] [:lda [1 :s] :y] (self:drop)]
|
||||
[:block (self:push nil ref :word) [:ldy 0] [:lda [1 :s] :y] (self:drop)]
|
||||
|
||||
(= etype :long)
|
||||
[:block c-ref [:ldy 0] [:lda [[self.LONG_LO]] :y]]))
|
||||
|
@ -313,7 +322,7 @@
|
|||
:long-at (lambda [self ref]
|
||||
(local (c-ref etype) (self:expr-poly ref))
|
||||
(if (= etype :word)
|
||||
(values [:block (self:push nil c-ref :word) [:ldy 0] [:lda [1 :s] :y] [:sta self.LONG_LO] [:iny] [:iny] [:lda [1 :s] :y] [:sta self.LONG_HI] (self:drop)]
|
||||
(values [:block (self:push nil ref :word) [:ldy 0] [:lda [1 :s] :y] [:sta self.LONG_LO] [:iny] [:iny] [:lda [1 :s] :y] [:sta self.LONG_HI] (self:drop)]
|
||||
:long)
|
||||
|
||||
(= etype :long)
|
||||
|
@ -322,16 +331,13 @@
|
|||
:set! (lambda [self lhs value]
|
||||
(if (and (= (type lhs) :string) (. self.setters lhs))
|
||||
(self:compile-function-call (. self.setters lhs) [value])
|
||||
(let [(c-value etype) (self:expr-poly value)
|
||||
(let [{:lo val-lo :hi val-hi : setup} (assert (self:expr-opgen value) (.. (fv value) " did not produce a value"))
|
||||
c-setup (when setup (setup))
|
||||
{: lo : hi} (assert (self:opgen-lhs lhs) (.. (fv lhs) " not valid as a target of set!"))
|
||||
c-lo (match etype
|
||||
:word (lo :sta)
|
||||
:long [:block [:lda self.LONG_LO] (lo :sta)])
|
||||
c-hi (when hi (match etype
|
||||
:word [:block [:lda 0] (hi :sta)]
|
||||
:long [:block [:lda self.LONG_HI] (hi :sta)]))
|
||||
c-lo [:flatten (val-lo :lda) (lo :sta)]
|
||||
c-hi (when hi [:flatten (if val-hi (val-hi :lda) [:lda 0]) (hi :sta)])
|
||||
block [:block]]
|
||||
(lume.push block c-value c-lo c-hi)
|
||||
(lume.push block c-setup c-lo c-hi)
|
||||
block)))
|
||||
})
|
||||
|
||||
|
@ -402,10 +408,22 @@
|
|||
|
||||
(fn Ssc.push-opgen [self expr]
|
||||
(or (self:opgen expr)
|
||||
(let [c (self:push nil (self:expr-poly expr))
|
||||
(let [c (self:push nil expr)
|
||||
iloc (length self.locals)]
|
||||
(lume.merge (self:opgen-local iloc) {:setup #c :cleanup #(self:drop)}))))
|
||||
|
||||
(fn Ssc.expr-opgen [self expr ?expected-etype]
|
||||
(var opgen (self:opgen expr))
|
||||
(when (not opgen)
|
||||
(let [(c-expr etype) (self:expr-poly expr)]
|
||||
(set opgen (match etype
|
||||
:word {:setup #c-expr :lo #[:flatten]}
|
||||
:long {:setup #c-expr :lo #[$1 self.LONG_LO] :hi #[$1 self.LONG_HI]}))))
|
||||
(when (and (= ?expected-etype :long) (= opgen.hi nil)) (set opgen.hi #[$1 0]))
|
||||
(when (and ?expected-etype (= opgen nil)) (error (.. "Expected " ?expected-etype ", got void")))
|
||||
(when (and (= ?expected-etype :word) opgen.hi) (error (.. "Expected word, got long")))
|
||||
opgen)
|
||||
|
||||
(fn Ssc.parse-parameters [self params]
|
||||
(icollect [_ param (ipairs params)] (match param
|
||||
[:long pname] {:name pname :type :long}
|
||||
|
@ -414,8 +432,7 @@
|
|||
(fn Ssc.push-arguments [self paramdefs args]
|
||||
(icollect [iarg arg (ipairs args)]
|
||||
(let [atype (. paramdefs iarg :type)
|
||||
c-arg (: self (.. :expr- atype) arg)
|
||||
c-push (self:push nil c-arg atype)]
|
||||
c-push (self:push nil arg atype)]
|
||||
c-push)))
|
||||
|
||||
(fn Ssc.compile-function-call [self f args]
|
||||
|
|
11
ssc/notes.txt
Normal file
11
ssc/notes.txt
Normal file
|
@ -0,0 +1,11 @@
|
|||
full compilation to expr-opgen TODO:
|
||||
- gen-condition could potentially use it for lhs which is on the stack / in a global
|
||||
- word! and long! are a mess right now
|
||||
- I don't think word-at and long-at could use it
|
||||
|
||||
- Could custom forms compile to opgens?? What would this look like?
|
||||
* see far-ref - it's really a constant, there's no reason to stuff the result into the temporary register just to push it onto the stack
|
||||
* if you call expr-poly / expr-word / expr-long, then put it into the register
|
||||
* but if you call expr-opgen, just return it! (opgen.setup) returns the appropriate code if needed
|
||||
* toolbox calls could actually benefit from this! function calls, not so much
|
||||
* currently expr-opgen is assumed to not have a cleanup step - this could complicate things
|
Loading…
Reference in a new issue