From 29de142c4a4b024df1783d9c2f74e55a5eb7af7d Mon Sep 17 00:00:00 2001 From: Jeremy Penner Date: Mon, 9 Aug 2021 14:43:24 -0400 Subject: [PATCH] Fix toolbox, start to handle pointers --- asm/65816.fnl | 3 +- lib/util.fnl | 5 +- neutgs/init.fnl | 5 +- ssc/iigs/toolbox.fnl | 242 ++++++++++++++++++++++++------------------- ssc/init.fnl | 54 +++++++--- 5 files changed, 184 insertions(+), 125 deletions(-) diff --git a/asm/65816.fnl b/asm/65816.fnl index b616a92..2190c42 100644 --- a/asm/65816.fnl +++ b/asm/65816.fnl @@ -1,4 +1,4 @@ -(local {: int8-to-bytes : int16-to-bytes} (require "lib.util")) +(local {: int8-to-bytes : int16-to-bytes : int24-to-bytes} (require "lib.util")) (local opcodes {}) @@ -105,7 +105,6 @@ (where (or :abl :alx :ial)) 4 nil 1 _ (error (.. "unknown mode " op.mode)))) -(fn int24-to-bytes [i] (.. (int16-to-bytes (bit.band i 0xffff)) (int8-to-bytes (addr-page i)))) (fn op-pdat.bytes [op env] (local bytegen (. opcodes op.opcode)) diff --git a/lib/util.fnl b/lib/util.fnl index db73734..a158f2a 100644 --- a/lib/util.fnl +++ b/lib/util.fnl @@ -9,6 +9,9 @@ (fn lo [v] (bit.band v 0xff)) (fn hi [v] (bit.band (bit.rshift v 8) 0xff)) +(fn loword [v] (bit.band v 0xffff)) +(fn hiword [v] (bit.band (bit.rshift v 16) 0xffff)) + (fn int8-to-bytes [i] (string.char (lo i))) (fn int16-to-bytes [i] @@ -112,7 +115,7 @@ (not= f nil))) {: int8-to-bytes : int16-to-bytes : int24-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24 - : splice : lo : hi + : splice : lo : hi : loword : hiword : reload : hotswap : swappable :require swappable-require : hot-table : nested-tset : readjson : writejson : file-exists : waitfor : in-coro : multival} diff --git a/neutgs/init.fnl b/neutgs/init.fnl index 5d41110..f842d15 100644 --- a/neutgs/init.fnl +++ b/neutgs/init.fnl @@ -7,8 +7,8 @@ (asm pascalhex (db 5) hexbuf (bytes " ")) (fn printnum (num) - (HexIt num (& hexbuf)) - (WriteString 0 (& pascalhex))) + (long! (ref hexbuf) (HexIt num)) + (WriteString (far-ref pascalhex))) (fn add (lhs rhs) (+ lhs rhs)) (fn main () @@ -23,7 +23,6 @@ (IMShutDown) (MMShutDown userid) (TLShutDown))) - ) (ssc:assemble) diff --git a/ssc/iigs/toolbox.fnl b/ssc/iigs/toolbox.fnl index cf22cbb..21e3dd2 100644 --- a/ssc/iigs/toolbox.fnl +++ b/ssc/iigs/toolbox.fnl @@ -3,128 +3,162 @@ #(compile $1 (form def-toolbox [ - (fn [ssc name cmd param-words return-words] + (fn [ssc cmd name args return-type] (let [call (fn [ssc ...] (let [arg-count (select :# ...) - expected-arg-count param-words - resultptr (when (> return-words 1) (select (+ expected-arg-count 1) ...)) - expected-arg-count (if resultptr (+ expected-arg-count 1) expected-arg-count) + expected-arg-count (length args) + expected-resultptr (= (type return-type) :number) + expected-arg-count (if expected-resultptr (+ expected-arg-count 1) expected-arg-count) + resultptr (when expected-resultptr (select expected-arg-count ...)) 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) - block [:block]] - (assert (= arg-count expected-arg-count)) - (when resultptr (lume.push block (ssc:expr-word resultptr) (ssc:push))) - (for [_ 1 return-words] (lume.push block (ssc:push))) - (for [i 1 param-words] (lume.push block (ssc:expr-word (select i ...)) (ssc:push))) + block [:block] + iloc-resultptr (do (assert (= arg-count expected-arg-count)) + (when resultptr + (lume.push block (ssc:push nil (ssc:expr-word resultptr))) + (length ssc.locals)))] + + (for [_ 1 (match return-type :void 0 :word 1 :long 2 _ return-type)] + (lume.push block (ssc:push))) + (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 param-words) + (ssc:was-dropped (length args)) (when error-handler (lume.push block [:bcc :-no-error-] - (ssc:push :error) (ssc:expr-word error-handler) (ssc:drop) + (ssc:push :error) (ssc:expr-poly error-handler) (ssc:drop :error) :-no-error-)) - (if (= return-words 1) (lume.push block (ssc:pop)) - - resultptr (do (lume.push block [:ldy 0]) - (for [i 1 return-words] - (let [stack-offset (+ (* (- return-words i) 2) 1)] - (lume.push block (ssc:pop) [:sta [stack-offset :s] :y]) - (when (< i return-words) (lume.push block [:iny] [:iny])))) + (match return-type + :void nil + :word (lume.push block (ssc:pop)) + :long (lume.push block (ssc:pop) [:sta ssc.LONG_LO] (ssc:pop) [:sta ssc.LONG_HI]) + _ (do (lume.push block [:ldy 0]) + (for [i 1 return-type] + (lume.push block (ssc:pop) [:sta [(ssc:local-offset iloc-resultptr) :s] :y]) + (when (< i return-type) (lume.push block [:iny] [:iny]))) (lume.push block (ssc:drop)))) - block))] + (values block (if (= (type return-type) :string) return-type :void))))] (ssc:expr-poly [:form name call])))]) ; todo: some kind of type system, or wrappers for 32-bit pointers, god ; toolbox locator - (def-toolbox TLStartUp 0x0201 0 0) - (def-toolbox TLShutDown 0x0301 0 0) - (def-toolbox TLVersion 0x0401 0 1) - (def-toolbox GetFuncPtr 0x0b01 2 2) - (def-toolbox LoadOneTool 0x0f01 2 0) - (def-toolbox LoadTools 0x0e01 2 0) - (def-toolbox MessageCenter 0x1501 4 0) - (def-toolbox RestoreTextState 0x1401 2 0) - (def-toolbox SaveTextState 0x1301 0 2) - (def-toolbox TLMountVolume 0x1101 10 1) - (def-toolbox TLTextMountVolume 0x1201 8 1) - (def-toolbox UnloadOneTool 0x1001 1 0) + (def-toolbox 0x0201 TLStartUp () void) + (def-toolbox 0x0301 TLShutDown () void) + (def-toolbox 0x0401 TLVersion () word) + (def-toolbox 0x0b01 GetFuncPtr (userOrSystem funcNumTsNum) long) + (def-toolbox 0x0f01 LoadOneTool (toolNumber minVersion) void) + (def-toolbox 0x0e01 LoadTools ((long toolTablePtr)) void) + (def-toolbox 0x1501 MessageCenter (action type (long messageHandle)) void) + (def-toolbox 0x1401 RestoreTextState ((long stateHandle)) void) + (def-toolbox 0x1301 SaveTextState () long) + (def-toolbox 0x1101 TLMountVolume (whereX whereY (long line1ptr) (long line2ptr) (long but1ptr) (long but2ptr)) word) + (def-toolbox 0x1201 TLTextMountVolume ((long line1Ptr) (long line2Ptr) (long button1Ptr) (long button2Ptr)) word) + (def-toolbox 0x1001 UnloadOneTool (toolNumber) void) - ; integer math (skipping long, frac, and fixed because 32 is too many bits) - (def-toolbox IMStartUp 0x020b 0 0) - (def-toolbox IMShutDown 0x030b 0 0) - (def-toolbox IMVersion 0x040b 0 1) - (def-toolbox IMStatus 0x060b 0 1) - (def-toolbox Dec2Int 0x280b 6 1) - (def-toolbox HexIt 0x2a0b 1 2) - (def-toolbox Int2Dec 0x260b 5 0) - (def-toolbox Int2Hex 0x220b 4 0) - (def-toolbox Multiply 0x090b 2 2) - (def-toolbox SDivide 0x0a0b 2 2) - (def-toolbox UDivide 0x0b0b 2 2) + ; integer math + (def-toolbox 0x020b IMStartUp () void) + (def-toolbox 0x030b IMShutDown () void) + (def-toolbox 0x040b IMVersion () word) + (def-toolbox 0x060b IMStatus () word) + (def-toolbox 0x280b Dec2Int ((long strPtr) strLength signedFlag) word) + (def-toolbox 0x290b Dec2Long ((long strPtr) strLength signedFlag) long) + (def-toolbox 0x1c0b Fix2Frac ((long fixedValue)) long) + (def-toolbox 0x1b0b Fix2Long ((long fixedValue)) long) + (def-toolbox 0x1e0b Fix2X ((long fixedValue) (long extendPtr)) void) + (def-toolbox 0x170b FixATan2 ((long input1) (long input2)) long) + (def-toolbox 0x110b FixDiv ((long dividend) (long divisor)) long) + (def-toolbox 0x0f0b FixMul ((long multiplicand) (long multiplier)) long) + (def-toolbox 0x0e0b FixRatio (numerator denominator) long) + (def-toolbox 0x130b FixRound ((long fixedValue)) word) + (def-toolbox 0x1d0b Frac2Fix ((long fracValue)) long) + (def-toolbox 0x1f0b Frac2X ((long fracValue) (long extendPtr)) void) + (def-toolbox 0x150b FracCos ((long angle)) long) + (def-toolbox 0x120b FracDiv ((long dividend) (long divisor)) long) + (def-toolbox 0x100b FracMul ((long multiplicand) (long multiplier)) long) + (def-toolbox 0x160b FracSin ((long angle)) long) + (def-toolbox 0x140b FracSqrt ((long fracValue)) long) + (def-toolbox 0x240b Hex2Int ((long strPtr) strLength) word) + (def-toolbox 0x250b Hex2Long ((long strPtr) strLength) long) + (def-toolbox 0x2a0b HexIt (intValue) long) + (def-toolbox 0x180b HiWord ((long longValue)) word) + (def-toolbox 0x260b Int2Dec (wordValue (long strPtr) strLength signedFlag) void) + (def-toolbox 0x220b Int2Hex (intValue (long strPtr) strLength) void) + (def-toolbox 0x270b Long2Dec ((long longValue) (long strPtr) strLength signedFlag) void) + (def-toolbox 0x1a0b Long2Fix ((long longIntValue)) long) + (def-toolbox 0x230b Long2Hex ((long longValue) (long strPtr) strLength) void) + (def-toolbox 0x0d0b LongDivide ((long dividend) (long divisor)) 4) ; -> long remainder, long quotient + (def-toolbox 0x0c0b LongMul ((long multiplicand) (long multiplier)) 4) ; -> long msResult, long lsResult + (def-toolbox 0x190b LoWord ((long longValue)) word) + (def-toolbox 0x090b Multiply (multiplicand multiplier) long) + (def-toolbox 0x0a0b SDivide (dividend divisor) long) ; -> word remainder, word quotient + (def-toolbox 0x0b0b UDivide (dividend divisor) long) ; -> word remainder, word quotient + (def-toolbox 0x200b X2Fix ((long extendPtr)) long) + (def-toolbox 0x210b X2Frac ((long extendPtr)) long) ; memory manager - (def-toolbox MMStartUp 0x0202 0 1) ; -> word userID - (def-toolbox MMShutDown 0x0302 1 0) ; word userID - (def-toolbox MMVersion 0x0402 0 1) ; word version - (def-toolbox MMStatus 0x0602 0 1) ; bool - (def-toolbox BlockMove 0x2b02 6 0) - (def-toolbox CheckHandle 0x1e02 2 0) - (def-toolbox CompactMem 0x1f02 0 0) - (def-toolbox DisposeAll 0x1102 1 0) - (def-toolbox DisposeHandle 0x1002 2 0) - (def-toolbox FindHandle 0x1a02 2 2) - (def-toolbox FreeMem 0x1b02 0 2) - (def-toolbox GetHandleSize 0x1802 2 2) - (def-toolbox HandToHand 0x2a02 6 0) - (def-toolbox HandToPtr 0x2902 6 0) - (def-toolbox HLock 0x2002 2 0) - (def-toolbox HLockAll 0x2102 1 0) - (def-toolbox HUnlock 0x2202 2 0) - (def-toolbox HUnlockAll 0x2302 1 0) - (def-toolbox MaxBlock 0x1c02 0 2) - (def-toolbox NewHandle 0x0902 6 2) - (def-toolbox PtrToHand 0x2802 6 0) - (def-toolbox PurgeAll 0x1302 1 0) - (def-toolbox PurgeHandle 0x1202 2 0) - (def-toolbox ReAllocHandle 0x0a02 8 0) - (def-toolbox RestoreHandle 0x0b02 2 0) ; handle theHandle - (def-toolbox SetHandleSize 0x1902 4 0) ; long newSize, handle theHandle - (def-toolbox SetPurge 0x2402 2 1) ; handle theHandle -> word newPurgeLevel - (def-toolbox SetPurgeAll 0x2502 2 0) ; word userID, word newPurgeLevel - (def-toolbox TotalMem 0x1d02 0 2) ; -> long totalSize + (def-toolbox 0x0202 MMStartUp () word) + (def-toolbox 0x0302 MMShutDown (userID) void) + (def-toolbox 0x0402 MMVersion () word) + (def-toolbox 0x0602 MMStatus () word) + (def-toolbox 0x2b02 BlockMove ((long sourcePtr) (long destPtr) (long count)) void) + (def-toolbox 0x1e02 CheckHandle ((long theHandle)) void) + (def-toolbox 0x1f02 CompactMem () void) + (def-toolbox 0x1102 DisposeAll (userID) void) + (def-toolbox 0x1002 DisposeHandle ((long theHandle)) void) + (def-toolbox 0x1a02 FindHandle ((long locationPtr)) long) + (def-toolbox 0x1b02 FreeMem () long) + (def-toolbox 0x1802 GetHandleSize ((long theHandle)) long) + (def-toolbox 0x2a02 HandToHand ((long sourceHandle) (long destHandle) (long count)) void) + (def-toolbox 0x2902 HandToPtr ((long sourceHandle) (long destPtr) (long count)) void) + (def-toolbox 0x2002 HLock ((long theHandle)) void) + (def-toolbox 0x2102 HLockAll (userID) void) + (def-toolbox 0x2202 HUnlock ((long theHandle)) void) + (def-toolbox 0x2302 HUnlockAll (userID) void) + (def-toolbox 0x1c02 MaxBlock () long) + (def-toolbox 0x0902 NewHandle ((long blockSize) userID attributes (long locationPtr)) long) + (def-toolbox 0x2802 PtrToHand ((long sourcePtr) (long destHandle) (long count)) void) + (def-toolbox 0x1302 PurgeAll (userID) void) + (def-toolbox 0x1202 PurgeHandle ((long theHandle)) void) + (def-toolbox 0x0a02 ReAllocHandle ((long blockSize) userID attributes (long locationPtr) (long theHandle)) void) + (def-toolbox 0x0b02 RestoreHandle ((long theHandle)) void) + (def-toolbox 0x1902 SetHandleSize ((long newSize) (long theHandle)) void) + (def-toolbox 0x2402 SetPurge ((long theHandle)) word) + (def-toolbox 0x2502 SetPurgeAll (userID newPurgeLevel) void) + (def-toolbox 0x1d02 TotalMem () long) ; text - (def-toolbox TextStartUp 0x020c 0 0) - (def-toolbox TextShutDown 0x030c 0 0) - (def-toolbox TextVersion 0x040c 0 1) ; -> versionInfo - (def-toolbox TextStatus 0x060c 0 1) ; -> activeFlag - (def-toolbox CtlTextDev 0x160c 2 0) ; word deviceNum, word controlCode - (def-toolbox ErrWriteBlock 0x1f0c 4 0) ; ptr textPtr, word offset, word count - (def-toolbox ErrWriteChar 0x190c 1 0) ; word theChar - (def-toolbox ErrWriteCString 0x210c 2 0) ; ptr cStrPtr - (def-toolbox ErrWriteLine 0x1b0c 2 0) ; ptr strPtr - (def-toolbox ErrWriteString 0x1d0c 2 0) ; ptr strPtr - (def-toolbox GetErrGlobals 0x0e0c 0 2) ; -> word andMask, word orMask - (def-toolbox GetErrorDevice 0x140c 0 3) ; -> word deviceType, long ptrOrSlot - (def-toolbox GetInGlobals 0x0c0c 0 2) ; -> word andMask, word orMask - (def-toolbox GetInputDevice 0x120c 0 3) ; -> word deviceType, long ptrOrSlot - (def-toolbox GetOutGlobals 0x0d0c 0 2) ; -> word andMask, word orMask - (def-toolbox GetOutputDevice 0x130c 0 3) ; -> word deviceType, long ptrOrSlot - (def-toolbox InitTextDev 0x150c 1 0) ; word deviceNum - (def-toolbox ReadChar 0x220c 1 1) ; word echoFlag -> word char - (def-toolbox ReadLine 0x240c 5 1) ; ptr bufferPtr, word maxCount, word eolChar, word echoFlag -> word charCount - (def-toolbox SetErrGlobals 0x0b0c 2 0) ; word andMask, word orMask - (def-toolbox SetErrorDevice 0x110c 3 0) ; word deviceType, long ptrOrSlot - (def-toolbox SetInGlobals 0x090c 2 0) ; word andMask, word orMask - (def-toolbox SetInputDevice 0x0f0c 3 0) ; word deviceType, long ptrOrSlot - (def-toolbox SetOutGlobals 0x0a0c 2 0) ; word andMask, word orMask - (def-toolbox SetOutputDevice 0x100c 3 0) ; word deviceType, long ptrOrSlot - (def-toolbox StatusTextDev 0x170c 2 0) ; word deviceNum, word requestCode - (def-toolbox TextReadBlock 0x230c 5 0) ; ptr bufferPtr, word offset, word blockSize, word echoFlag - (def-toolbox TextWriteBlock 0x1e0c 4 0) ; ptr textPtr, word offset, word count - (def-toolbox WriteChar 0x180c 1 0) ; word theChar - (def-toolbox WriteCString 0x200c 2 0) ; ptr cStrPtr - (def-toolbox WriteLine 0x1a0c 2 0) ; ptr strPtr - (def-toolbox WriteString 0x1c0c 2 0) ; ptr strPtr + (def-toolbox 0x020c TextStartUp () void) + (def-toolbox 0x030c TextShutDown () void) + (def-toolbox 0x040c TextVersion () word) + (def-toolbox 0x060c TextStatus () word) ; -> activeFlag + (def-toolbox 0x160c CtlTextDev (deviceNum controlCode) void) + (def-toolbox 0x1f0c ErrWriteBlock ((long textPtr) offset count) void) + (def-toolbox 0x190c ErrWriteChar (theChar) void) + (def-toolbox 0x210c ErrWriteCString ((long cStrPtr)) void) + (def-toolbox 0x1b0c ErrWriteLine ((long strPtr)) void) + (def-toolbox 0x1d0c ErrWriteString ((long strPtr)) void) + (def-toolbox 0x0e0c GetErrGlobals () long) ; -> word andMask, word orMask + (def-toolbox 0x140c GetErrorDevice () 3) ; -> word deviceType, long ptrOrSlot + (def-toolbox 0x0c0c GetInGlobals () long) ; -> word andMask, word orMask + (def-toolbox 0x120c GetInputDevice () 3) ; -> word deviceType, long ptrOrSlot + (def-toolbox 0x0d0c GetOutGlobals () long) ; -> word andMask, word orMask + (def-toolbox 0x130c GetOutputDevice () 3) ; -> word deviceType, long ptrOrSlot + (def-toolbox 0x150c InitTextDev (deviceNum) void) + (def-toolbox 0x220c ReadChar (echoFlag) word) + (def-toolbox 0x240c ReadLine ((long bufferPtr) maxCount eolChar echoFlag) word) + (def-toolbox 0x0b0c SetErrGlobals (andMask orMask) void) + (def-toolbox 0x110c SetErrorDevice (deviceType (long ptrOrSlot)) void) + (def-toolbox 0x090c SetInGlobals (andMask orMask) void) + (def-toolbox 0x0f0c SetInputDevice (deviceType (long ptrOrSlot)) void) + (def-toolbox 0x0a0c SetOutGlobals (andMask orMask) void) + (def-toolbox 0x100c SetOutputDevice (deviceType ptrOrSlot) void) + (def-toolbox 0x170c StatusTextDev (deviceNum requestCode) void) + (def-toolbox 0x230c TextReadBlock ((long bufferPtr) offset blockSize echoFlag) void) + (def-toolbox 0x1e0c TextWriteBlock ((long textPtr) offset count) void) + (def-toolbox 0x180c WriteChar (theChar) void) + (def-toolbox 0x200c WriteCString ((long cStrPtr)) void) ; ptr cStrPtr + (def-toolbox 0x1a0c WriteLine ((long strPtr)) void) + (def-toolbox 0x1c0c WriteString ((long strPtr)) void) ) diff --git a/ssc/init.fnl b/ssc/init.fnl index 2819e62..969d6df 100644 --- a/ssc/init.fnl +++ b/ssc/init.fnl @@ -43,6 +43,7 @@ (local Ssc (Object:extend)) (local Prg (require :asm.asm)) (local util (require :lib.util)) +(local {: loword : hiword} util) (set Ssc.LONG_LO :d0x00) (set Ssc.LONG_HI :d0x02) @@ -65,11 +66,13 @@ (sec) (xce) ;re-enter emulation mode (rts)))))) -(fn Ssc.push [self name expr etype] +(fn Ssc.push [self name expr ?etype] + (local etype (or ?etype :word)) (table.insert self.locals {: name :type etype}) (match etype - :word [:block expr [:pha]] - :long [:block expr [:lda self.LONG_HI] [:pha] [:lda self.LONG_LO] [:pha]])) + :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))))) (fn Ssc.remove-local [self ?name] (let [loc (. self.locals (length self.locals))] @@ -178,9 +181,7 @@ (values (lume.concat [:block] compiled-bindings [compiled-body] compiled-cleanup) etype))) :fn (lambda [self name args ...] (assert (not (self:defining?)) "Can't nest function definitions") - (local arglocals (icollect [_ arg (ipairs args)] (match arg - [:long aname] {:name aname :type :long} - aname {:name aname :type :word}))) + (local arglocals (self:parse-parameters args)) (set self.locals (lume.concat arglocals [{:type :word :comment :returnaddr}])) ; todo: maybe handle mutually recursive functions? (compile-expr only has access to currently-defined functions) (local (c-function etype) (self:expr-poly [:do ...])) @@ -231,15 +232,30 @@ :not (lambda [self bool] (self:expr-poly [:if bool 0 0xffff])) :or (lambda [self lhs rhs] (self:expr-poly [:if lhs 0xffff [:if rhs 0xffff 0]])) :and (lambda [self lhs rhs] (self:expr-poly [:if lhs [:if rhs 0xffff 0] 0])) - :& (lambda [self label] [:lda #($1:lookup-addr label)]) + :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]]) + :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)) + ; TODO: maybe handle a few different addressing modes here? re-use if the value is already on the stack? + ; TODO: automatically handle far-ref + :word! (lambda [self ref value] [:block (self:push nil (self:expr-word ref) :word) (self:expr-word value) [:ldy 0] [:sta [1 :s] :y] (self:drop)]) + :long! (lambda [self ref value] [:block (self:push nil (self:expr-word 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)]) + :deref (lambda [self ref] [:block (self:push nil (self:expr-word ref) :word) [:lda [1 :s] :y] (self:drop)]) }) (fn Ssc.local-offset [self name-or-index] (var offset nil) + (var stacklen 0) (for [i 1 (length self.locals)] - (when (or (= i name-or-index) (= (. self.locals i :name) name-or-index)) - (set offset (+ 1 (* 2 (- (length self.locals) i)))))) - offset) + (let [loc (. self.locals i) + size (match loc.type :word 2 :long 4 _ (error (.. "how big is this local??" (fv loc))))] + (set stacklen (+ stacklen size)) + (when (or (= i name-or-index) (= loc.name name-or-index)) + (set offset stacklen)))) + (when offset (+ (- stacklen offset) 1))) (fn Ssc.local-type [self name-or-index] (var etype nil) @@ -271,6 +287,18 @@ iloc (length (self.locals))] (lume.merge (self:addressible-loc iloc) {:setup #c :cleanup #(self:drop)})))) +(fn Ssc.parse-parameters [self params] + (icollect [_ param (ipairs params)] (match param + [:long pname] {:name pname :type :long} + pname {:name pname :type :word}))) + +(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))) + (fn Ssc.expr-poly [self expr] (match expr (where lit (?. (self:addressible lit) :hi)) (let [{: lo : hi} (self:addressible lit)] @@ -279,11 +307,7 @@ ; TODO: Global scope (where [func & args] (= (?. self.functions func :arity) (length args))) (let [f (. self.functions func) - pre (icollect [iarg arg (ipairs args)] - (let [atype (. f.args iarg :type) - c-arg (: self (.. :expr- atype) arg) - c-push (self:push nil c-arg atype)] - c-push)) + pre (self:push-arguments f.args args) post (icollect [_ (countiter (length args))] (self:drop))] (print (fv pre) (fv post) (fv args)) (values (lume.concat [:block] pre [[:jsr func]] post) f.type))