Working boot stub to initialize the Memory Manager toolset without an OS
Listen to keyboard events
This commit is contained in:
parent
e84fbd2c95
commit
315fd794de
|
@ -116,8 +116,12 @@
|
||||||
(when (not= f nil) (io.close f))
|
(when (not= f nil) (io.close f))
|
||||||
(not= f nil)))
|
(not= f nil)))
|
||||||
|
|
||||||
|
(fn pairoff [l]
|
||||||
|
(fn [_ iprev] (let [i (if iprev (+ iprev 2) 1)]
|
||||||
|
(when (< i (length l)) (values i (. l i) (. l (+ i 1)))))))
|
||||||
|
|
||||||
{: int8-to-bytes : int16-to-bytes : int24-to-bytes : int32-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
|
: splice : lo : hi : loword : hiword
|
||||||
: reload : hotswap : swappable :require swappable-require : hot-table : nested-tset
|
: reload : hotswap : swappable :require swappable-require : hot-table : nested-tset : pairoff
|
||||||
: readjson : writejson : file-exists : waitfor : in-coro : multival}
|
: readjson : writejson : file-exists : waitfor : in-coro : multival}
|
||||||
|
|
||||||
|
|
|
@ -1,10 +1,18 @@
|
||||||
(local Ssc (require :ssc))
|
(local Ssc (require :ssc))
|
||||||
(import-macros {:sss ! : compile} :ssc.macros)
|
(import-macros {:sss ! : compile} :ssc.macros)
|
||||||
|
|
||||||
(local ssc (Ssc {:boot-org 0xc00}))
|
(local ssc (Ssc {:boot [(! (require ssc.iigs.bootstub))]}))
|
||||||
(compile ssc
|
(compile ssc
|
||||||
(require :ssc.iigs.toolbox)
|
(require :ssc.iigs.toolbox)
|
||||||
|
|
||||||
|
(tooltable toolsets
|
||||||
|
ToolsetIntegerMath 0x0100
|
||||||
|
ToolsetText 0x0100
|
||||||
|
ToolsetQuickDraw 0x0100
|
||||||
|
ToolsetEventManager 0x0100
|
||||||
|
5 0x0100 ; desk manager
|
||||||
|
9 0x0100) ; ADB
|
||||||
|
|
||||||
(asm pascalhex (db 5) hexbuf (bytes " "))
|
(asm pascalhex (db 5) hexbuf (bytes " "))
|
||||||
|
|
||||||
(fn printnum (num)
|
(fn printnum (num)
|
||||||
|
@ -13,35 +21,49 @@
|
||||||
|
|
||||||
(fn add (lhs rhs) (+ lhs rhs))
|
(fn add (lhs rhs) (+ lhs rhs))
|
||||||
|
|
||||||
(const screen 0xe12000)
|
(asm event-buffer)
|
||||||
|
(global word event-what)
|
||||||
|
(global long event-msg)
|
||||||
|
(global long event-when)
|
||||||
|
(global word event-y)
|
||||||
|
(global word event-x)
|
||||||
|
(global word event-mod)
|
||||||
|
|
||||||
|
(fn wait-for-key ()
|
||||||
|
(FlushEvents keyDownMask 0)
|
||||||
|
(while (not (GetOSEvent keyDownMask (far-ref event-buffer)))))
|
||||||
|
|
||||||
|
(const screen-addr 0xe12000)
|
||||||
(const screen-size 0x9d00)
|
(const screen-size 0x9d00)
|
||||||
|
|
||||||
(global word screen-offset 0)
|
(global word screen-offset 0)
|
||||||
(getter screen-cursor (+ screen screen-offset))
|
(getter screen-cursor (+ screen-addr screen-offset))
|
||||||
(setter screen-cursor (pixels)
|
(setter screen-cursor (pixels)
|
||||||
(word! screen-cursor pixels)
|
(word! screen-cursor pixels)
|
||||||
(set! screen-offset (+ screen-offset 2)))
|
(set! screen-offset (+ screen-offset 2)))
|
||||||
|
|
||||||
(global word UserID)
|
(global word userID)
|
||||||
(fn main ()
|
(fn main ()
|
||||||
(TLStartUp)
|
(LoadTools (far-ref toolsets))
|
||||||
(set! UserID (MMStartUp))
|
(set! userID (MMStartUp))
|
||||||
(IMStartUp)
|
(IMStartUp)
|
||||||
(TextStartUp)
|
(TextStartUp)
|
||||||
(MTStartUp)
|
(QDStartUp 0x2100 0 0 userID)
|
||||||
|
(EMStartUp 0x2000 0 0 320 0 200 userID)
|
||||||
(GrafOn)
|
(GrafOn)
|
||||||
(set! screen-offset 0)
|
|
||||||
(while (< screen-offset screen-size)
|
|
||||||
(set! screen-cursor (+ 0x2345 screen-offset)))
|
|
||||||
|
|
||||||
|
(set! screen-offset 0)
|
||||||
|
(let (i 0)
|
||||||
|
(while (< screen-offset screen-size)
|
||||||
|
(set! screen-cursor (+ screen-offset i))
|
||||||
|
(set! i (+ i 1))))
|
||||||
|
(wait-for-key)
|
||||||
(GrafOff)
|
(GrafOff)
|
||||||
|
|
||||||
(MTShutDown)
|
(EMShutDown)
|
||||||
|
(QDShutDown)
|
||||||
(TextShutDown)
|
(TextShutDown)
|
||||||
(IMShutDown)
|
(IMShutDown)
|
||||||
(MMShutDown UserID)
|
(MMShutDown userID)))
|
||||||
(TLShutDown)))
|
|
||||||
|
|
||||||
|
|
||||||
(ssc:assemble)
|
(ssc:assemble)
|
||||||
|
|
39
ssc/iigs/bootstub.fnl
Normal file
39
ssc/iigs/bootstub.fnl
Normal file
|
@ -0,0 +1,39 @@
|
||||||
|
(import-macros {:sss ! : compile} :ssc.macros)
|
||||||
|
|
||||||
|
#(compile $1
|
||||||
|
(start-symbol boot)
|
||||||
|
(org 0x0800)
|
||||||
|
(require ssc.iigs.toolbox)
|
||||||
|
|
||||||
|
(global word BootUserID)
|
||||||
|
(global long BootHandle-00)
|
||||||
|
(global long BootHandle-01)
|
||||||
|
(global long BootHandle-e0)
|
||||||
|
(global long BootHandle-e1)
|
||||||
|
(fn boot ()
|
||||||
|
(asm (clc) (xce) (rep 0x30)) ; disable emulation mode, 16-bit index registers
|
||||||
|
; http://www.1000bit.it/support/manuali/apple/technotes/pdos/tn.pdos.27.html
|
||||||
|
; When bootstrapping with no OS, we must reserve
|
||||||
|
(TLStartUp)
|
||||||
|
(LoadOneTool ToolsetMisc 0x0100)
|
||||||
|
(MTStartUp)
|
||||||
|
(set! BootUserID (GetNewID 0x1f00))
|
||||||
|
|
||||||
|
(LoadOneTool ToolsetMemoryManager 0x0100)
|
||||||
|
(set! BootHandle-00 (NewHandle 0xb800 BootUserID 0xb017 0x000800))
|
||||||
|
(set! BootHandle-01 (NewHandle 0xb800 BootUserID 0xb017 0x010800))
|
||||||
|
(set! BootHandle-e0 (NewHandle 0x4000 BootUserID 0xb017 0xe02000))
|
||||||
|
(set! BootHandle-e1 (NewHandle 0x8000 BootUserID 0xb017 0xe12000))
|
||||||
|
|
||||||
|
(asm (jsr [(or $2 :main)]))
|
||||||
|
|
||||||
|
(DisposeHandle BootHandle-e1)
|
||||||
|
(DisposeHandle BootHandle-e0)
|
||||||
|
(DisposeHandle BootHandle-01)
|
||||||
|
(DisposeHandle BootHandle-00)
|
||||||
|
(DeleteID BootUserID)
|
||||||
|
|
||||||
|
(MTShutDown)
|
||||||
|
(asm (sec) (xce)) ; re-enter emulation mode
|
||||||
|
))
|
||||||
|
|
|
@ -1,5 +1,7 @@
|
||||||
(import-macros {:sss ! : compile} :ssc.macros)
|
(import-macros {:sss ! : compile} :ssc.macros)
|
||||||
(local lume (require :lib.lume))
|
(local lume (require :lib.lume))
|
||||||
|
(local util (require :lib.util))
|
||||||
|
(local {: pairoff} util)
|
||||||
|
|
||||||
#(compile $1 (do
|
#(compile $1 (do
|
||||||
(form def-toolbox [
|
(form def-toolbox [
|
||||||
|
@ -13,11 +15,10 @@
|
||||||
error-handler (when (= arg-count (+ expected-arg-count 1)) (select (+ expected-arg-count 1) ...))
|
error-handler (when (= arg-count (+ expected-arg-count 1)) (select (+ expected-arg-count 1) ...))
|
||||||
expected-arg-count (if error-handler (+ expected-arg-count 1) expected-arg-count)
|
expected-arg-count (if error-handler (+ expected-arg-count 1) expected-arg-count)
|
||||||
block [:block]
|
block [:block]
|
||||||
iloc-resultptr (do (assert (= arg-count expected-arg-count))
|
iloc-resultptr (do (assert (= arg-count expected-arg-count) (.. name " expected " expected-arg-count " args, got " (fv [...])))
|
||||||
(when resultptr
|
(when resultptr
|
||||||
(lume.push block (ssc:push nil (ssc:expr-word resultptr)))
|
(lume.push block (ssc:push nil (ssc:expr-word resultptr)))
|
||||||
(length ssc.locals)))]
|
(length ssc.locals)))]
|
||||||
|
|
||||||
(for [_ 1 (match return-type :void 0 :word 1 :long 2 _ return-type)]
|
(for [_ 1 (match return-type :void 0 :word 1 :long 2 _ return-type)]
|
||||||
(lume.push block (ssc:push)))
|
(lume.push block (ssc:push)))
|
||||||
(each [_ push (ipairs (ssc:push-arguments (ssc:parse-parameters args) (lume.slice [...] 1 (length args))))]
|
(each [_ push (ipairs (ssc:push-arguments (ssc:parse-parameters args) (lume.slice [...] 1 (length args))))]
|
||||||
|
@ -30,7 +31,7 @@
|
||||||
:-no-error-))
|
:-no-error-))
|
||||||
(match return-type
|
(match return-type
|
||||||
:void nil
|
:void nil
|
||||||
:word (lume.push block (ssc:pop))
|
:word (lume.push block (ssc:pop) nil)
|
||||||
:long (lume.push block (ssc:pop) [:sta ssc.LONG_LO] (ssc:pop) [:sta ssc.LONG_HI])
|
:long (lume.push block (ssc:pop) [:sta ssc.LONG_LO] (ssc:pop) [:sta ssc.LONG_HI])
|
||||||
_ (do (lume.push block [:ldy 0])
|
_ (do (lume.push block [:ldy 0])
|
||||||
(for [i 1 return-type]
|
(for [i 1 return-type]
|
||||||
|
@ -40,7 +41,13 @@
|
||||||
(values block (if (= (type return-type) :string) return-type :void))))]
|
(values block (if (= (type return-type) :string) return-type :void))))]
|
||||||
(ssc:expr-poly [:form name call])))])
|
(ssc:expr-poly [:form name call])))])
|
||||||
|
|
||||||
; toolbox locator
|
(form tooltable [(fn [ssc name ...]
|
||||||
|
(ssc.org:append name [:dw (/ (select :# ...) 2)])
|
||||||
|
(each [_ toolset-id version (pairoff [...])]
|
||||||
|
(ssc.org:append [:dw (match (type toolset-id) :number toolset-id :string (. ssc.constants toolset-id))]
|
||||||
|
[:dw version])))])
|
||||||
|
|
||||||
|
(const ToolsetToolLocator 0x01)
|
||||||
(def-toolbox 0x0201 TLStartUp () void)
|
(def-toolbox 0x0201 TLStartUp () void)
|
||||||
(def-toolbox 0x0301 TLShutDown () void)
|
(def-toolbox 0x0301 TLShutDown () void)
|
||||||
(def-toolbox 0x0401 TLVersion () word)
|
(def-toolbox 0x0401 TLVersion () word)
|
||||||
|
@ -54,7 +61,7 @@
|
||||||
(def-toolbox 0x1201 TLTextMountVolume ((long line1Ptr) (long line2Ptr) (long button1Ptr) (long button2Ptr)) word)
|
(def-toolbox 0x1201 TLTextMountVolume ((long line1Ptr) (long line2Ptr) (long button1Ptr) (long button2Ptr)) word)
|
||||||
(def-toolbox 0x1001 UnloadOneTool (toolNumber) void)
|
(def-toolbox 0x1001 UnloadOneTool (toolNumber) void)
|
||||||
|
|
||||||
; integer math
|
(const ToolsetIntegerMath 0x0b)
|
||||||
(def-toolbox 0x020b IMStartUp () void)
|
(def-toolbox 0x020b IMStartUp () void)
|
||||||
(def-toolbox 0x030b IMShutDown () void)
|
(def-toolbox 0x030b IMShutDown () void)
|
||||||
(def-toolbox 0x040b IMVersion () word)
|
(def-toolbox 0x040b IMVersion () word)
|
||||||
|
@ -94,7 +101,7 @@
|
||||||
(def-toolbox 0x200b X2Fix ((long extendPtr)) long)
|
(def-toolbox 0x200b X2Fix ((long extendPtr)) long)
|
||||||
(def-toolbox 0x210b X2Frac ((long extendPtr)) long)
|
(def-toolbox 0x210b X2Frac ((long extendPtr)) long)
|
||||||
|
|
||||||
; memory manager
|
(const ToolsetMemoryManager 0x02)
|
||||||
(def-toolbox 0x0202 MMStartUp () word)
|
(def-toolbox 0x0202 MMStartUp () word)
|
||||||
(def-toolbox 0x0302 MMShutDown (userID) void)
|
(def-toolbox 0x0302 MMShutDown (userID) void)
|
||||||
(def-toolbox 0x0402 MMVersion () word)
|
(def-toolbox 0x0402 MMVersion () word)
|
||||||
|
@ -125,7 +132,7 @@
|
||||||
(def-toolbox 0x2502 SetPurgeAll (userID newPurgeLevel) void)
|
(def-toolbox 0x2502 SetPurgeAll (userID newPurgeLevel) void)
|
||||||
(def-toolbox 0x1d02 TotalMem () long)
|
(def-toolbox 0x1d02 TotalMem () long)
|
||||||
|
|
||||||
; text
|
(const ToolsetText 0x0c)
|
||||||
(def-toolbox 0x020c TextStartUp () void)
|
(def-toolbox 0x020c TextStartUp () void)
|
||||||
(def-toolbox 0x030c TextShutDown () void)
|
(def-toolbox 0x030c TextShutDown () void)
|
||||||
(def-toolbox 0x040c TextVersion () word)
|
(def-toolbox 0x040c TextVersion () word)
|
||||||
|
@ -159,7 +166,7 @@
|
||||||
(def-toolbox 0x1a0c WriteLine ((long strPtr)) void)
|
(def-toolbox 0x1a0c WriteLine ((long strPtr)) void)
|
||||||
(def-toolbox 0x1c0c WriteString ((long strPtr)) void)
|
(def-toolbox 0x1c0c WriteString ((long strPtr)) void)
|
||||||
|
|
||||||
; Misc toolset
|
(const ToolsetMisc 0x03)
|
||||||
(def-toolbox 0x0203 MTStartUp () void)
|
(def-toolbox 0x0203 MTStartUp () void)
|
||||||
(def-toolbox 0x0303 MTShutDown () void)
|
(def-toolbox 0x0303 MTShutDown () void)
|
||||||
(def-toolbox 0x0403 MTVersion () word)
|
(def-toolbox 0x0403 MTVersion () word)
|
||||||
|
@ -201,7 +208,48 @@
|
||||||
(def-toolbox 0x1003 SetVector (vectorRefNum (long vectorPtr)) void)
|
(def-toolbox 0x1003 SetVector (vectorRefNum (long vectorPtr)) void)
|
||||||
(def-toolbox 0x1103 GetVector (vectorRefNum) long)
|
(def-toolbox 0x1103 GetVector (vectorRefNum) long)
|
||||||
|
|
||||||
; QuickDraw
|
(const ToolsetEventManager 0x06)
|
||||||
|
(const nullEvt 0)
|
||||||
|
(const mouseDownEvt 1)
|
||||||
|
(const mouseUpEvt 2)
|
||||||
|
(const keyDownEvt 3)
|
||||||
|
(const autoKeyEvt 5)
|
||||||
|
(const updateEvt 6)
|
||||||
|
(const activeFlag 0x0001)
|
||||||
|
(const changeFlag 0x0002)
|
||||||
|
(const btn1State 0x0040)
|
||||||
|
(const btn0State 0x0080)
|
||||||
|
(const appleKey 0x0100)
|
||||||
|
(const shiftKey 0x0200)
|
||||||
|
(const capsLock 0x0400)
|
||||||
|
(const optionKey 0x0800)
|
||||||
|
(const controlKey 0x1000)
|
||||||
|
(const keyPad 0x2000)
|
||||||
|
(const mDownMask 0x0002)
|
||||||
|
(const mUpMask 0x0004)
|
||||||
|
(const keyDownMask 0x0008)
|
||||||
|
(const autoKeyMask 0x0020)
|
||||||
|
(const updateMask 0x0040)
|
||||||
|
(def-toolbox 0x0206 EMStartUp (dPageAddr queueSize xMinClamp xMaxClamp yMinClamp yMaxClamp userID) void)
|
||||||
|
(def-toolbox 0x0306 EMShutDown () void)
|
||||||
|
(def-toolbox 0x0406 EMVersion () word)
|
||||||
|
(def-toolbox 0x0606 EMStatus () word)
|
||||||
|
(def-toolbox 0x0d06 Button (buttonNum) word)
|
||||||
|
(def-toolbox 0x0b06 EventAvail (eventMask (long eventPtr)) word)
|
||||||
|
(def-toolbox 0x1506 FlushEvents (eventMask stopMask) word)
|
||||||
|
(def-toolbox 0x1206 GetCaretTime () long)
|
||||||
|
(def-toolbox 0x1106 GetDblTime () long)
|
||||||
|
(def-toolbox 0x0c06 GetMouse ((long mouseLocPtr)) void)
|
||||||
|
(def-toolbox 0x0a06 GetNextEvent (eventMask (long eventPtr)) word)
|
||||||
|
(def-toolbox 0x1606 GetOSEvent (eventMask (long eventPtr)) word)
|
||||||
|
(def-toolbox 0x1706 OSEventAvail (eventMask (long eventPtr)) word)
|
||||||
|
(def-toolbox 0x1406 PostEvent (eventCode (long eventMsg)) word)
|
||||||
|
(def-toolbox 0x1806 SetEventMask (sysEventMask) void)
|
||||||
|
(def-toolbox 0x0e06 StillDown (buttonNum) word)
|
||||||
|
(def-toolbox 0x1006 TickCount () long)
|
||||||
|
(def-toolbox 0x0f06 WaitMouseUp (buttonNum) word)
|
||||||
|
|
||||||
|
(const ToolsetQuickDraw 0x04)
|
||||||
(def-toolbox 0x0204 QDStartUp (dPageAddr masterSCB maxWidth userID) void)
|
(def-toolbox 0x0204 QDStartUp (dPageAddr masterSCB maxWidth userID) void)
|
||||||
(def-toolbox 0x0304 QDShutDown () void)
|
(def-toolbox 0x0304 QDShutDown () void)
|
||||||
(def-toolbox 0x0404 QDVersion () word)
|
(def-toolbox 0x0404 QDVersion () word)
|
||||||
|
|
18
ssc/init.fnl
18
ssc/init.fnl
|
@ -37,7 +37,7 @@
|
||||||
(local Ssc (Object:extend))
|
(local Ssc (Object:extend))
|
||||||
(local Prg (require :asm.asm))
|
(local Prg (require :asm.asm))
|
||||||
(local util (require :lib.util))
|
(local util (require :lib.util))
|
||||||
(local {: loword : hiword} util)
|
(local {: loword : hiword : pairoff} util)
|
||||||
|
|
||||||
(set Ssc.LONG_LO :d0x00)
|
(set Ssc.LONG_LO :d0x00)
|
||||||
(set Ssc.LONG_HI :d0x02)
|
(set Ssc.LONG_HI :d0x02)
|
||||||
|
@ -64,7 +64,7 @@
|
||||||
(asm
|
(asm
|
||||||
boot
|
boot
|
||||||
(clc) (xce) (rep 0x30) ; disable emulation mode, 16-bit index registers
|
(clc) (xce) (rep 0x30) ; disable emulation mode, 16-bit index registers
|
||||||
(jsr main)
|
(jsr [(or opts.main :main)])
|
||||||
(sec) (xce) ;re-enter emulation mode
|
(sec) (xce) ;re-enter emulation mode
|
||||||
(rts))))))
|
(rts))))))
|
||||||
|
|
||||||
|
@ -106,10 +106,6 @@
|
||||||
(let [i (if iprev (+ iprev 1) min)]
|
(let [i (if iprev (+ iprev 1) min)]
|
||||||
(when (<= i max) i)))))
|
(when (<= i max) i)))))
|
||||||
|
|
||||||
(fn pairoff [l]
|
|
||||||
(fn [_ iprev] (let [i (if iprev (+ iprev 2) 1)]
|
|
||||||
(when (< i (length l)) (values i (. l i) (. l (+ i 1)))))))
|
|
||||||
|
|
||||||
; operations that work on the accumulator, like adc or sbc
|
; operations that work on the accumulator, like adc or sbc
|
||||||
; optimization strategy: keep the current result in the accumulator, work from the stack or immediate values
|
; optimization strategy: keep the current result in the accumulator, work from the stack or immediate values
|
||||||
; 1. take "right" arguments and push them (unless already on stack, immediate, or absolute)
|
; 1. take "right" arguments and push them (unless already on stack, immediate, or absolute)
|
||||||
|
@ -167,7 +163,6 @@
|
||||||
cond (self:rewrite-condition cond)
|
cond (self:rewrite-condition cond)
|
||||||
[op & args] cond
|
[op & args] cond
|
||||||
cmp (. self.comparisons op)]
|
cmp (. self.comparisons op)]
|
||||||
(pp cond)
|
|
||||||
(if cmp
|
(if cmp
|
||||||
(let [[lhs rhs] args
|
(let [[lhs rhs] args
|
||||||
ropgen (self:push-opgen rhs)
|
ropgen (self:push-opgen rhs)
|
||||||
|
@ -218,12 +213,12 @@
|
||||||
:setter (lambda [self name arg ...]
|
:setter (lambda [self name arg ...]
|
||||||
(assert (= (length arg) 1))
|
(assert (= (length arg) 1))
|
||||||
(tset self.setters name (self:compile-function (.. :-set- name) arg ...)))
|
(tset self.setters name (self:compile-function (.. :-set- name) arg ...)))
|
||||||
:require (lambda [self name]
|
:require (lambda [self name ...]
|
||||||
(when (= (. self.modules name) nil)
|
(when (= (. self.modules name) nil)
|
||||||
(let [mod (util.reload name)
|
(let [mod (util.reload name)
|
||||||
func (if (= (type mod) :function) mod mod.module)]
|
func (if (= (type mod) :function) mod mod.module)]
|
||||||
(tset self.modules name mod)
|
(tset self.modules name mod)
|
||||||
(func self))))
|
(func self ...))))
|
||||||
:global (lambda [self etype name ?const]
|
:global (lambda [self etype name ?const]
|
||||||
(tset self.globals name {:type etype : name})
|
(tset self.globals name {:type etype : name})
|
||||||
(self.org:append name
|
(self.org:append name
|
||||||
|
@ -250,7 +245,7 @@
|
||||||
(c-false falsetype) (when ?iffalse (self:expr-poly ?iffalse))
|
(c-false falsetype) (when ?iffalse (self:expr-poly ?iffalse))
|
||||||
etype (if (not= truetype falsetype) :void truetype)
|
etype (if (not= truetype falsetype) :void truetype)
|
||||||
block [:block (self:gen-condition test :-if-true- :-if-false-) :-if-true- c-true]
|
block [:block (self:gen-condition test :-if-true- :-if-false-) :-if-true- c-true]
|
||||||
_ (pp block)
|
; _ (pp block)
|
||||||
cl-false (if ?iffalse [[:bra :-if-done-] :-if-false- c-false :-if-done-]
|
cl-false (if ?iffalse [[:bra :-if-done-] :-if-false- c-false :-if-done-]
|
||||||
[:-if-false-])]
|
[:-if-false-])]
|
||||||
(values (lume.concat block cl-false) etype)))
|
(values (lume.concat block cl-false) etype)))
|
||||||
|
@ -328,7 +323,7 @@
|
||||||
(if (and (= (type lhs) :string) (. self.setters lhs))
|
(if (and (= (type lhs) :string) (. self.setters lhs))
|
||||||
(self:compile-function-call (. self.setters lhs) [value])
|
(self:compile-function-call (. self.setters lhs) [value])
|
||||||
(let [(c-value etype) (self:expr-poly value)
|
(let [(c-value etype) (self:expr-poly value)
|
||||||
{: lo : hi} (self:opgen-lhs lhs)
|
{: lo : hi} (assert (self:opgen-lhs lhs) (.. (fv lhs) " not valid as a target of set!"))
|
||||||
c-lo (match etype
|
c-lo (match etype
|
||||||
:word (lo :sta)
|
:word (lo :sta)
|
||||||
:long [:block [:lda self.LONG_LO] (lo :sta)])
|
:long [:block [:lda self.LONG_LO] (lo :sta)])
|
||||||
|
@ -429,6 +424,7 @@
|
||||||
(values (lume.concat [:block] pre [[:jsr f.name]] post) f.type)))
|
(values (lume.concat [:block] pre [[:jsr f.name]] post) f.type)))
|
||||||
|
|
||||||
(fn Ssc.expr-poly [self expr]
|
(fn Ssc.expr-poly [self expr]
|
||||||
|
; (pp expr)
|
||||||
(match expr
|
(match expr
|
||||||
(where lit (?. (self:opgen lit) :hi)) (let [{: lo : hi} (self:opgen lit)]
|
(where lit (?. (self:opgen lit) :hi)) (let [{: lo : hi} (self:opgen lit)]
|
||||||
(values [:block (lo :lda) [:sta self.LONG_LO] (hi :lda) [:sta self.LONG_HI]] :long))
|
(values [:block (lo :lda) [:sta self.LONG_LO] (hi :lda) [:sta self.LONG_HI]] :long))
|
||||||
|
|
Loading…
Reference in a new issue