Add globals, test various pointer setting
This commit is contained in:
parent
8a211365e4
commit
1eea56bb5b
|
@ -1,5 +1,5 @@
|
|||
(local lume (require "lib.lume"))
|
||||
(local {: int8-to-bytes : int16-to-bytes} (require "lib.util"))
|
||||
(local {: int8-to-bytes : int16-to-bytes : int24-to-bytes : int32-to-bytes} (require "lib.util"))
|
||||
|
||||
(fn make-env [block parent]
|
||||
{:parent parent
|
||||
|
@ -75,6 +75,7 @@
|
|||
|
||||
(fn dat-parser.db [db] {:type :var :init (. db 2) :size 1})
|
||||
(fn dat-parser.dw [dw] {:type :var :init (. dw 2) :size 2})
|
||||
(fn dat-parser.dl [dl] {:type :var :init (. dl 4) :size 4})
|
||||
(fn dat-parser.bytes [bytes] {:type :raw :bytes (. bytes 2)})
|
||||
(fn dat-parser.ref [ref] {:type :ref :target (. ref 2)})
|
||||
(fn dat-parser.flatten [flat block]
|
||||
|
@ -127,6 +128,8 @@
|
|||
(match d.size
|
||||
1 (int8-to-bytes init)
|
||||
2 (int16-to-bytes init)
|
||||
3 (int24-to-bytes init)
|
||||
4 (int32-to-bytes init)
|
||||
n (string.rep "\0" n)))
|
||||
(fn pdat-processor.ref.bytes [ref env]
|
||||
(int16-to-bytes (env:lookup-addr ref.target)))
|
||||
|
|
|
@ -17,7 +17,9 @@
|
|||
(fn int16-to-bytes [i]
|
||||
(string.char (lo i) (hi i)))
|
||||
(fn int24-to-bytes [i]
|
||||
(string.char (lo i) (hi i) (bit.band (bit.rshift i 16) 0xff)))
|
||||
(string.char (lo i) (hi i) (lo (bit.rshift i 16))))
|
||||
(fn int32-to-bytes [i]
|
||||
(string.char (lo i) (hi i) (lo (bit.rshift i 16)) (hi (bit.rshift i 16))))
|
||||
(fn bytes-to-uint8 [b ?offset]
|
||||
(string.byte b (+ 1 (or ?offset 0)) (+ 1 (or ?offset 0))))
|
||||
(fn bytes-to-uint16 [b ?offset]
|
||||
|
@ -114,7 +116,7 @@
|
|||
(when (not= f nil) (io.close f))
|
||||
(not= f nil)))
|
||||
|
||||
{: int8-to-bytes : int16-to-bytes : int24-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24
|
||||
{: int8-to-bytes : int16-to-bytes : int24-to-bytes : int32-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24
|
||||
: splice : lo : hi : loword : hiword
|
||||
: reload : hotswap : swappable :require swappable-require : hot-table : nested-tset
|
||||
: readjson : writejson : file-exists : waitfor : in-coro : multival}
|
||||
|
|
|
@ -141,7 +141,7 @@
|
|||
(bencode.encode addr-to-bytes)))
|
||||
(fn Machine.launch [self prg]
|
||||
(self:eval "(manager.machine:soft_reset)")
|
||||
(self:eval (string.format "(emu.keypost \"\n\n\n\nCALL-151\\n %xG\\n\")" (prg:lookup-addr prg.start-symbol))))
|
||||
(self:eval (string.format "(emu.keypost \"\n\nCALL-151\\n %xG\\n\")" (prg:lookup-addr prg.start-symbol))))
|
||||
(fn Machine.reboot [self] (self:eval "(manager.machine:hard_reset)"))
|
||||
(fn Machine.coro-eval [self code ?handlers]
|
||||
(var result nil)
|
||||
|
|
|
@ -12,23 +12,34 @@
|
|||
(WriteString (far-ref pascalhex)))
|
||||
|
||||
(fn add (lhs rhs) (+ lhs rhs))
|
||||
|
||||
(global word UserID)
|
||||
(fn main ()
|
||||
(TLStartUp)
|
||||
(let (userid (MMStartUp))
|
||||
(IMStartUp)
|
||||
(TextStartUp)
|
||||
(set! UserID (MMStartUp))
|
||||
(IMStartUp)
|
||||
(TextStartUp)
|
||||
|
||||
(let (x 1)
|
||||
(printnum x)
|
||||
(set! x (+ x 1))
|
||||
(printnum x)
|
||||
(set! (long-at (ref hexbuf)) 0x6b636548)
|
||||
(WriteString (far-ref pascalhex)))
|
||||
(let (x 1)
|
||||
(printnum x)
|
||||
(set! x (+ x 1))
|
||||
(printnum x))
|
||||
(set! (long-at (ref hexbuf)) 0x6b636548)
|
||||
(WriteString (far-ref pascalhex))
|
||||
(long! (ref hexbuf) 0x74747542)
|
||||
(WriteString (far-ref pascalhex))
|
||||
(let (buf (ref hexbuf)
|
||||
str (far-ref pascalhex))
|
||||
(long! buf 0x6b726f42)
|
||||
(WriteString str)
|
||||
(word! (+ buf 2) 0x706f)
|
||||
(WriteString str))
|
||||
(printnum (hiword (long-at (far-ref pascalhex))))
|
||||
|
||||
(TextShutDown)
|
||||
(IMShutDown)
|
||||
(MMShutDown UserID)
|
||||
(TLShutDown)))
|
||||
|
||||
(TextShutDown)
|
||||
(IMShutDown)
|
||||
(MMShutDown userid)
|
||||
(TLShutDown)))
|
||||
)
|
||||
|
||||
(ssc:assemble)
|
||||
|
|
18
ssc/init.fnl
18
ssc/init.fnl
|
@ -166,6 +166,13 @@
|
|||
func (if (= (type mod) :function) mod mod.module)]
|
||||
(tset self.modules name mod)
|
||||
(func self))))
|
||||
:global (lambda [self etype name ?const]
|
||||
(tset self.globals name {:type etype : name})
|
||||
(self.org:append name
|
||||
(match etype
|
||||
:word [:dw ?const]
|
||||
:long [:dl ?const]
|
||||
_ (error (.. "Unrecognized type " (fv etype))))))
|
||||
:do (fn [self ...]
|
||||
(var etype-body :void)
|
||||
(local c-body (lume.concat [:block] (icollect [i (countiter (select :# ...))]
|
||||
|
@ -255,11 +262,12 @@
|
|||
:long-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] [:sta self.LONG_LO] [:iny] [:iny] [:lda [1 :s] :y] [:sta self.LONG_HI] (self:drop)]
|
||||
(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)]
|
||||
:long)
|
||||
|
||||
(= etype :long)
|
||||
[:block c-ref [:ldy 0] [:lda [[self.LONG_LO]] :y]] [:tax] [:iny] [:iny] [:lda [[self.LONG_LO]] [:sta self.LONG_HI] [:stx self.LONG_LO]]))
|
||||
|
||||
(values [:block c-ref [:ldy 0] [:lda [[self.LONG_LO]] :y] [:tax] [:iny] [:iny] [:lda [[self.LONG_LO]] :y] [:sta self.LONG_HI] [:stx self.LONG_LO]]
|
||||
:long)))
|
||||
:set! (lambda [self lhs value]
|
||||
(let [(c-value etype) (self:expr-poly value)
|
||||
{: lo : hi} (self:opgen-lhs lhs)
|
||||
|
@ -380,7 +388,7 @@
|
|||
|
||||
(fn Ssc.expr-word [self expr]
|
||||
(let [(c etype) (self:expr-poly expr)]
|
||||
(when (not= etype :word) (error "Unexpected long or void in " (fv expr) " - please wrap in explicit truncation form"))
|
||||
(when (not= etype :word) (error (.. "Unexpected long or void in " (fv expr) " - please wrap in explicit truncation form")))
|
||||
c))
|
||||
|
||||
(fn Ssc.expr-long [self expr]
|
||||
|
@ -388,7 +396,7 @@
|
|||
(match etype
|
||||
:long c
|
||||
:word [:block c [:sta self.LONG_LO] [:lda 0] [:sta self.LONG_HI]]
|
||||
_ (error "Unexpected type " etype " in " (fv expr) " - wanted long or word"))))
|
||||
_ (error (.. "Unexpected type " (fv etype) " in " (fv expr) " - wanted long or word")))))
|
||||
|
||||
(fn Ssc.compile [self ...]
|
||||
(for [i 1 (select :# ...)]
|
||||
|
|
Loading…
Reference in a new issue