Toolbox support - we can print numbers!!
This commit is contained in:
parent
16d88efbf1
commit
cd4bf59b41
|
@ -89,7 +89,7 @@
|
|||
(local op-pdat {})
|
||||
(fn addr-page [addr] (math.floor (/ addr 0x10000)))
|
||||
(fn op-pdat.patch [op env]
|
||||
(local long-mode (match op.opcode :abs :abl :abx :alx))
|
||||
(local long-mode (match op.mode :abs :abl :abx :alx))
|
||||
(when (and long-mode (not= (addr-page (env:lookup-org op.arg))
|
||||
(addr-page env.root-block.org)))
|
||||
(set op.mode long-mode)))
|
||||
|
@ -105,7 +105,7 @@
|
|||
(where (or :abl :alx :ial)) 4
|
||||
nil 1
|
||||
_ (error (.. "unknown mode " op.mode))))
|
||||
(fn int24-to-bytes [i] (.. (int8-to-bytes (addr-page i)) (int16-to-bytes (bit.band i 0xffff))))
|
||||
(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))
|
||||
|
|
|
@ -4,18 +4,34 @@
|
|||
(local ssc (Ssc))
|
||||
(set ssc.prg.start-symbol :boot)
|
||||
(compile ssc
|
||||
(require :ssc.iigs.toolbox)
|
||||
|
||||
(org 0xc00)
|
||||
(asm
|
||||
boot
|
||||
(clc) (xce) (rep 0x30) ; disable emulation mode, 16-bit index registers
|
||||
(jsr main)
|
||||
(sec) (xce) ;re-enter emulation mode
|
||||
(rts))
|
||||
(fn printnum (num) ; TODO
|
||||
)
|
||||
(rts)
|
||||
pascalhex (db 5) hexbuf (bytes " "))
|
||||
|
||||
(fn printnum (num)
|
||||
(HexIt num (& hexbuf))
|
||||
(WriteString 0 (& pascalhex)))
|
||||
|
||||
(fn add (lhs rhs) (+ lhs rhs))
|
||||
(fn main ()
|
||||
(printnum (add 1 2)))
|
||||
(TLStartUp)
|
||||
(let (userid (MMStartUp))
|
||||
(IMStartUp)
|
||||
(TextStartUp)
|
||||
|
||||
(printnum (add 1 2))
|
||||
|
||||
(TextShutDown)
|
||||
(IMShutDown)
|
||||
(MMShutDown userid)
|
||||
(TLShutDown)))
|
||||
)
|
||||
|
||||
(ssc:assemble)
|
||||
|
|
130
ssc/iigs/toolbox.fnl
Normal file
130
ssc/iigs/toolbox.fnl
Normal file
|
@ -0,0 +1,130 @@
|
|||
(import-macros {:sss ! : compile} :ssc.macros)
|
||||
(local lume (require :lib.lume))
|
||||
|
||||
#(compile $1
|
||||
(form def-toolbox [
|
||||
(fn [ssc name cmd param-words return-words]
|
||||
(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)
|
||||
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:compile-expr resultptr) (ssc:push)))
|
||||
(for [_ 1 return-words] (lume.push block (ssc:push)))
|
||||
(for [i 1 param-words] (lume.push block (ssc:compile-expr (select i ...)) (ssc:push)))
|
||||
(lume.push block [:ldx cmd] [:jsr :0xe10000])
|
||||
(ssc:was-dropped param-words)
|
||||
(when error-handler
|
||||
(lume.push block [:bcc :-no-error-]
|
||||
(ssc:push :error) (ssc:compile-expr error-handler) (ssc:drop)
|
||||
:-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]))))
|
||||
(lume.push block (ssc:drop))))
|
||||
block))]
|
||||
(ssc:compile-expr [: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)
|
||||
|
||||
; 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)
|
||||
|
||||
; 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
|
||||
|
||||
; 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
|
||||
)
|
||||
|
16
ssc/init.fnl
16
ssc/init.fnl
|
@ -40,13 +40,15 @@
|
|||
(local lume (require :lib.lume))
|
||||
(local Ssc (Object:extend))
|
||||
(local Prg (require :asm.asm))
|
||||
(local util (require :lib.util))
|
||||
|
||||
(fn Ssc.new [self ?opts]
|
||||
(local opts (or ?opts {}))
|
||||
(set self.prg (or opts.prg (Prg.new nil :65816)))
|
||||
(set self.forms (lume.clone (or opts.forms self.__index.forms)))
|
||||
(set self.functions {})
|
||||
(set self.locals []))
|
||||
(set self.locals [])
|
||||
(set self.modules {}))
|
||||
|
||||
(fn Ssc.push [self ?local]
|
||||
(table.insert self.locals (or ?local [:tmp]))
|
||||
|
@ -57,6 +59,11 @@
|
|||
loc (when (not= ?local loc) (error (.. "Internal stack error: expected " (or ?local "temporary") " temporary, got " loc))))
|
||||
(tset self.locals (length self.locals) nil)
|
||||
[:ply])
|
||||
(fn Ssc.pop [self ?local]
|
||||
(self:drop ?local)
|
||||
[:pla])
|
||||
(fn Ssc.was-dropped [self localcount]
|
||||
(set self.locals (lume.slice self.locals 1 (- (length self.locals) localcount))))
|
||||
|
||||
(fn Ssc.defining? [self] (> (length self.locals) 0))
|
||||
|
||||
|
@ -154,6 +161,13 @@
|
|||
(assert (= (length self.locals) (+ (length args) 1)))
|
||||
(set self.locals []))
|
||||
:form (lambda [self name func] (tset self.forms name func))
|
||||
:require (lambda [self name]
|
||||
(when (= (. self.modules name) nil)
|
||||
(let [mod (util.reload name)
|
||||
func (if (= (type mod) :function) mod mod.module)]
|
||||
(tset self.modules name mod)
|
||||
(func self))))
|
||||
:& (lambda [self label] [:lda #($1:lookup-addr label)])
|
||||
})
|
||||
|
||||
(fn Ssc.local-offset [self symbol]
|
||||
|
|
Loading…
Reference in a new issue