From c1aa4afa4c41614a7aa0b1fb4e596a28911748e8 Mon Sep 17 00:00:00 2001
From: David Schmenk <dschmenk@gmail.com>
Date: Fri, 30 May 2014 22:54:41 -0700
Subject: [PATCH] Apple /// PLASMA WIP
---
src/class.pla | 31 --
src/cmd.pla | 24 +-
src/cmdstub.s | 1 +
src/codegen.c | 2 +-
src/hello.pla | 8 -
src/makefile | 69 ++-
src/plvm02.s | 38 +-
src/plvm03.s | 1016 ++++++++++++++++++++++++++++++++++++
src/soscmd.pla | 1306 +++++++++++++++++++++++++++++++++++++++++++++++
src/testcls.pla | 32 --
10 files changed, 2384 insertions(+), 143 deletions(-)
delete mode 100755 src/class.pla
delete mode 100644 src/hello.pla
create mode 100644 src/plvm03.s
create mode 100644 src/soscmd.pla
delete mode 100755 src/testcls.pla
diff --git a/src/class.pla b/src/class.pla
deleted file mode 100755
index d5c7b43..0000000
--- a/src/class.pla
+++ /dev/null
@@ -1,31 +0,0 @@
-;
-; Declare all imported modules and their data/functions.
-;
-import stdlib
- predef putc, puts
-end
-import testcls
- word print
- const dec = 0
- const hex = 2
-end
-
-byte spaces[] = " "
-
-def putln
- putc($0D)
-end
-
-def printnums
- word i
- i = 10000
- repeat
- print:dec(i)
- puts(@spaces)
- print:hex(i)
- putln
- i = i / 10
- until i == 0
-end
-printnums
-done
diff --git a/src/cmd.pla b/src/cmd.pla
index c13fe94..fd503a9 100644
--- a/src/cmd.pla
+++ b/src/cmd.pla
@@ -167,11 +167,9 @@ asm syscall
INX
LDA ESTKL,X
STA CMD
- STX ESP
JSR $BF00
CMD: !BYTE 00
PARAMS: !WORD 0000
- LDX ESP
STA ESTKL,X
LDY #$00
STY ESTKH,X
@@ -1018,7 +1016,7 @@ def adddef(bank, addr, deflast)
end
def loadmod(mod)
word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup
- word addr, defaddr, modaddr, modfix
+ word addr, defaddr, modaddr, modfix, modend
word deftbl, deflast
word moddep, rld, esd, sym
byte defbank, str[16], filename[64]
@@ -1048,7 +1046,7 @@ def loadmod(mod)
; Load module dependencies.
;
while ^moddep
- if lookupmod(moddep) == 0
+ if !lookupmod(moddep)
close(refnum)
refnum = 0
if loadmod(moddep) < 0
@@ -1063,7 +1061,7 @@ def loadmod(mod)
deftbl = allocheap(defcnt * 5 + 1)
deflast = deftbl
^deflast = 0
- if refnum == 0
+ if !refnum
;
; Reset read pointer.
;
@@ -1094,9 +1092,10 @@ def loadmod(mod)
;
modfix = modaddr - modfix
bytecode = defofst + modfix - MODADDR
- rld = modaddr + modsize ; Re-Locatable Directory
- esd = rld ; Extern+Entry Symbol Directory
- while ^esd <> $00 ; Scan to end of ESD
+ modend = modaddr + modsize
+ rld = modend ; Re-Locatable Directory
+ esd = rld ; Extern+Entry Symbol Directory
+ while !^esd ; Scan to end of ESD
esd = esd + 4
loop
esd = esd + 1
@@ -1106,6 +1105,7 @@ def loadmod(mod)
if ^MACHID & $30 == $30
defbank = 1
defaddr = allocxheap(rld - bytecode)
+ modend = bytecode
else
defbank = 0
defaddr = bytecode
@@ -1173,11 +1173,11 @@ def loadmod(mod)
; Move bytecode to AUX bank.
;
memxcpy(0, defaddr, bytecode, modsize - (bytecode - modaddr))
- ;
- ; Free up the bytecode in main memory.
- ;
- releaseheap(bytecode)
fin
+ ;
+ ; Free up the end-of-module in main memory.
+ ;
+ releaseheap(modend)
else
perr = perr | 0x100
return -perr
diff --git a/src/cmdstub.s b/src/cmdstub.s
index 6696417..6baa674 100644
--- a/src/cmdstub.s
+++ b/src/cmdstub.s
@@ -1,3 +1,4 @@
+INTERP = $03D0
;*
;* MOVE CMD DOWN TO $1000-$2000
;*
diff --git a/src/codegen.c b/src/codegen.c
index bb5ec00..5a48b96 100755
--- a/src/codegen.c
+++ b/src/codegen.c
@@ -509,7 +509,7 @@ void emit_def(char *name, int is_bytecode)
{
//printf("%s%c\n", name, LBL);
if (is_bytecode)
- printf("\tJSR $03D0\n");
+ printf("\tJSR\tINTERP\n");
}
}
void emit_codetag(int tag)
diff --git a/src/hello.pla b/src/hello.pla
deleted file mode 100644
index 36f52b6..0000000
--- a/src/hello.pla
+++ /dev/null
@@ -1,8 +0,0 @@
-import STDLIB
- predef puts
-end
-
-byte hellostr[] = "Hello, world.\n"
-
-puts(@hellostr)
-done
diff --git a/src/makefile b/src/makefile
index da8c635..b204b4f 100755
--- a/src/makefile
+++ b/src/makefile
@@ -2,8 +2,11 @@
AFLAGS = -o $@
LFLAGS = -C default.cfg
PLVM = plvm
-PLVM02 = PLVM02.SYS
-CMD = CMD.SYS
+PLVM02 = PLASMA.SYSTEM\#FF2000
+PLVM03 = SOS.INTERP\#050000
+CMD = CMD\#FF2000
+ROD = ROD\#FE1000
+HGR1 = HGR1\#FE1000
PLASM = plasm
INCS = tokens.h symbols.h lex.h parse.h codegen.h
OBJS = plasm.c parse.o lex.o codegen.o
@@ -17,15 +20,15 @@ TXTTYPE = .TXT
#
# Image filetypes for CiderPress
#
-#PLATYPE = \#ed0000
+#RELTYPE = \#fe1000
#BINTYPE = \#060000
-#SYSTYPE = \#ff0000
+#SYSTYPE = \#ff2000
#TXTTYPE = \#040000
-all: $(PLASM) $(PLVM) $(PLVM02) $(CMD) TESTLIB ROD.REL
+all: $(PLASM) $(PLVM) $(PLVM02) $(PLVM03) $(CMD) $(ROD) $(HGR1)
clean:
- -rm *.o *~ *.a *.SYM *.SYS *.REL TESTLIB $(PLASM) $(PLVM)
+ -rm *.o *~ *.a *.SYM $(CMD) *\#FE1000 $(ROD) $(HGR1) $(PLASM) $(PLVM)
$(PLASM): $(OBJS) $(INCS)
cc $(OBJS) -o $(PLASM)
@@ -39,44 +42,34 @@ cmdexec.a: cmdexec.pla $(PLASM)
$(PLVM02): plvm02.s cmdexec.a
acme -o $(PLVM02) -l PLVM02.SYM plvm02.s
-$(CMD): cmd.pla cmdstub.s $(PLVM) $(PLASM)
+soscmd.a: soscmd.pla $(PLASM)
+ ./$(PLASM) -A < soscmd.pla > soscmd.a
+
+$(PLVM03): plvm03.s soscmd.a
+ acme -o $(PLVM03) -l PLVM03.SYM plvm03.s
+
+$(CMD): cmd.pla cmdstub.s $(PLVM02) $(PLASM)
./$(PLASM) -A < cmd.pla > cmd.a
acme --setpc 8192 -o $(CMD) cmdstub.s
-TESTLIB: testlib.pla $(PLVM) $(PLASM)
- ./$(PLASM) -AM < testlib.pla > testlib.a
- acme --setpc 4094 -o TESTLIB testlib.a
-
-test: test.pla TESTLIB $(PLVM) $(PLASM)
+test: test.pla testlib.pla $(PLVM) $(PLASM)
./$(PLASM) -AM < test.pla > test.a
- acme --setpc 4094 -o TEST.REL test.a
- ./$(PLVM) TEST.REL
+ acme --setpc 4094 -o TEST#FE1000 test.a
+ ./$(PLASM) -AM < teslib.pla >testlib.a
+ acme --setpc 4094 -o TESTLIB#FE1000 testlib.a
+ ./$(PLVM) TEST\#FE1000
-TESTCLS: testcls.pla $(PLVM) $(PLASM)
- ./$(PLASM) -AM < testcls.pla > testcls.a
- acme --setpc 4094 -o TESTCLS testcls.a
-
-class: class.pla TESTCLS $(PLVM) $(PLASM)
- ./$(PLASM) -AM < class.pla > class.a
- acme --setpc 4094 -o CLASS.REL class.a
- ./$(PLVM) CLASS.REL
-
-debug: test.pla TESTLIB $(PLVM) $(PLASM)
- ./$(PLASM) -AM < test.pla > test.a
- acme --setpc 4094 -o TEST.REL test.a
- ./$(PLVM) -s TEST.REL MAIN
-
-hello: hello.pla $(PLVM) $(PLASM)
- ./$(PLASM) -AM < hello.pla > hello.a
- acme --setpc 4094 -o HELLO.REL hello.a
- ./$(PLVM) HELLO.REL
-
-ROD.REL: rod.pla $(PLVM) $(PLASM)
+$(ROD): rod.pla $(PLVM02) $(PLASM)
./$(PLASM) -AM < rod.pla > rod.a
- acme --setpc 4094 -o ROD.REL rod.a
+ acme --setpc 4094 -o $(ROD) rod.a
-HGR1: hgr1.pla hgr1test.pla $(PLVM) $(PLASM)
+$(HGR1): hgr1.pla hgr1test.pla $(PLVM02) $(PLASM)
./$(PLASM) -AM < hgr1test.pla > hgr1test.a
- acme --setpc 4094 -o HGR1TEST.REL hgr1test.a
+ acme --setpc 4094 -o HGR1TEST.REL#FE1000 hgr1test.a
./$(PLASM) -AM < hgr1.pla > hgr1.a
- acme --setpc 4094 -o HGR1 hgr1.a
+ acme --setpc 4094 -o $(HGR1) hgr1.a
+
+hello: hello.pla $(PLVM) $(PLASM)
+ m4 < hello.pla | ./$(PLASM) -AM > hello.a
+ acme --setpc 4094 -o HELLO#FE1000 hello.a
+ ./$(PLVM) HELLO#FE1000
diff --git a/src/plvm02.s b/src/plvm02.s
index 57035ec..58ee6ca 100644
--- a/src/plvm02.s
+++ b/src/plvm02.s
@@ -209,8 +209,8 @@ PAGE3 = *
;*
;* PAGE 3 VECTORS INTO INTERPRETER
;*
- BIT LCRDEN+LCBNK2 ; $03D0 - DIRECT INTERP ENTRY
- JMP INTERP
+INTERP BIT LCRDEN+LCBNK2 ; $03D0 - DIRECT INTERP ENTRY
+ JMP DINTERP
BIT LCRDEN+LCBNK2 ; $03D6 - INDIRECT INTERP ENTRY
JMP IINTRP
BIT LCRDEN+LCBNK2 ; $03DC - INDIRECT INTERPX ENTRY
@@ -306,7 +306,7 @@ DISABLE80 !BYTE 21, 13, '1', 26, 13
;*
;* ENTER INTO BYTECODE INTERPRETER
;*
-INTERP BIT LCRWEN+LCBNK2 ; WRITE ENABLE LANGUAGE CARD
+DINTERP BIT LCRWEN+LCBNK2 ; WRITE ENABLE LANGUAGE CARD
BIT LCRWEN+LCBNK2
PLA
STA IPL
@@ -384,10 +384,6 @@ TIMER JSR JMPTMR
;*
JMPTMR JMP (TMRVEC)
;*
-;* INDIRECT JUMP TO (TMP)
-;*
-JMPTMP JMP (TMP)
-;*
;* ADD TOS TO TOS-1
;*
ADD LDA ESTKL,X
@@ -1818,17 +1814,17 @@ IBRNCHX LDA IPL
;*
CALL +INC_IP
LDA (IP),Y
- STA TMPL
+ STA CALLADR+1
+INC_IP
LDA (IP),Y
- STA TMPH
+ STA CALLADR+2
LDA IPH
PHA
LDA IPL
PHA
TYA
PHA
- JSR JMPTMP
+CALLADR JSR $FFFF
PLA
TAY
PLA
@@ -1841,10 +1837,10 @@ CALL +INC_IP
;
CALLX +INC_IP
LDA (IP),Y
- STA TMPL
+ STA CALXADR+1
+INC_IP
LDA (IP),Y
- STA TMPH
+ STA CALXADR+2
LDA IPH
PHA
LDA IPL
@@ -1853,7 +1849,7 @@ CALLX +INC_IP
PHA
STA ALTRDOFF
CLI
- JSR JMPTMP
+CALXADR JSR $FFFF
SEI
STA ALTRDON
PLA
@@ -1869,9 +1865,9 @@ CALLX +INC_IP
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL LDA ESTKL,X
- STA TMPL
+ STA ICALADR+1
LDA ESTKH,X
- STA TMPH
+ STA ICALADR+2
INX
LDA IPH
PHA
@@ -1879,7 +1875,7 @@ ICAL LDA ESTKL,X
PHA
TYA
PHA
- JSR JMPTMP
+ICALADR JSR $FFFF
PLA
TAY
PLA
@@ -1891,9 +1887,9 @@ ICAL LDA ESTKL,X
JMP NEXTOP
;
ICALX LDA ESTKL,X
- STA TMPL
+ STA ICLXADR+1
LDA ESTKH,X
- STA TMPH
+ STA ICLXADR+2
INX
LDA IPH
PHA
@@ -1903,7 +1899,7 @@ ICALX LDA ESTKL,X
PHA
STA ALTRDOFF
CLI
- JSR JMPTMP
+ICLXADR JSR $FFFF
SEI
STA ALTRDON
PLA
@@ -1952,7 +1948,7 @@ ENTER4 LDA ESTKH,X
STA (IFP),Y
DEY
INX
- DEC TMPL
+ DEC NPARMS
BNE ENTER4
ENTER5 LDY IPY
JMP NEXTOP
@@ -1992,7 +1988,7 @@ ENTERX4 LDA ESTKH,X
STA (IFP),Y
DEY
INX
- DEC TMPL
+ DEC NPARMS
BNE ENTERX4
ENTERX5 STA ALTRDON
LDY IPY
diff --git a/src/plvm03.s b/src/plvm03.s
new file mode 100644
index 0000000..6b1c6ca
--- /dev/null
+++ b/src/plvm03.s
@@ -0,0 +1,1016 @@
+;**********************************************************
+;*
+;* SYSTEM ROUTINES AND LOCATIONS
+;*
+;**********************************************************
+;
+; HARDWARE REGISTERS
+;
+MEMBANK = $FFEF
+XPAGE = $1600
+;*
+;* VM ZERO PAGE LOCATIONS
+;*
+ESTKSZ = $20
+ESTK = $C0
+ESTKL = ESTK
+ESTKH = ESTK+ESTKSZ/2
+VMZP = ESTK+ESTKSZ
+IFP = VMZP
+IFPL = IFP
+IFPH = IFP+1
+IFPX = XPAGE+IFPH
+IP = IFP+2
+IPL = IP
+IPH = IP+1
+IPX = XPAGE+IPH
+IPY = IP+2
+TMP = IP+3
+TMPL = TMP
+TMPH = TMP+1
+TMPX = XPAGE+TMPH
+NPARMS = TMPL
+FRMSZ = TMPH
+DVSIGN = TMP+2
+ESP = TMP+2
+SRC = $06
+SRCL = SRC
+SRCH = SRC+1
+SRCX = XPAGE+SRCH
+DST = SRC+2
+DSTL = DST
+DSTH = DST+1
+DSTX = XPAGE+DSTH
+;*
+;* SOS
+;*
+ !MACRO SOS .CMD, .LIST {
+ BRK
+ !BYTE .CMD
+ !WORD .LIST
+ }
+;*
+;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
+;*
+ !MACRO INC_IP {
+ INY
+ BNE * + 4
+ INC IPH
+ }
+;*
+;* INTERPRETER HEADER+INITIALIZATION
+;*
+ SEGSTART = $A000
+ *= SEGSTART-$0E
+ !TEXT "SOS NTRP"
+ !WORD $0000
+ !WORD SEGSTART
+ !WORD SEGEND-SEGSTART
+
+ LDA #$00 ; CLEAR ALL EXTENDED POINTERS
+ STA TMPX
+ STA SRCX
+ STA DSTX
+ STA IFPX ; INIT FRAME POINTER
+ LDA #<INTERP
+ STA IFPL
+ LDA #>INTERP
+ STA IFPH
+ LDA #<SEGEND ; SAVE END OF SEGMENT FOR SYMBOL TABLE
+ STA SEGSTART
+ LDA #>SEGEND
+ STA SEGSTART+1
+ LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
+ JMP SOSCMD
+;*
+;* SYSTEM INTERPRETER ENTRYPOINT
+;*
+INTERP LDY #$00
+ STY IPX
+ PLA
+ STA IPL
+ PLA
+ STA IPH
+ INY ; MAP BANK $01
+ STY MEMBANK
+ BNE FETCHOP
+;*
+;* ENTER INTO USER BYTECODE INTERPRETER
+;*
+XINTERP PLA
+ STA TMPL
+ PLA
+ STA TMPH
+ LDY #$03
+ LDA (TMP),Y
+ STA IPX
+ DEY
+ LDA (TMP),Y
+ STA IPH
+ DEY
+ LDA (TMP),Y
+ STA IPL
+ DEY
+ BEQ FETCHOP
+;*
+;* INTERP BYTECODE
+;*
+NEXTOPH INC IPH
+ BNE FETCHOP
+DROP INX
+NEXTOP INY
+ BEQ NEXTOPH
+FETCHOP LDA (IP),Y
+ STA *+4
+ JMP (OPTBL)
+;*
+;* INTERNAL MULTIPLY ALGORITHM
+;*
+_MUL STY IPY
+ LDY #$00
+ STY TMPL ; PRODL
+ STY TMPH ; PRODH
+ LDY #$10
+MUL1 LSR ESTKH,X ; MULTPLRH
+ ROR ESTKL,X ; MULTPLRL
+ BCC MUL2
+ LDA ESTKL+1,X ; MULTPLNDL
+ CLC
+ ADC TMPL ; PRODL
+ STA TMPL
+ LDA ESTKH+1,X ; MULTPLNDH
+ ADC TMPH ; PRODH
+ STA TMPH
+MUL2 ASL ESTKL+1,X ; MULTPLNDL
+ ROL ESTKH+1,X ; MULTPLNDH
+ DEY
+ BNE MUL1
+ INX
+ LDA TMPL ; PRODL
+ STA ESTKL,X
+ LDA TMPH ; PRODH
+ STA ESTKH,X
+ LDY IPY
+ RTS
+;*
+;* INTERNAL DIVIDE ALGORITHM
+;*
+_NEG LDA #$00
+ SEC
+ SBC ESTKL,X
+ STA ESTKL,X
+ LDA #$00
+ SBC ESTKH,X
+ STA ESTKH,X
+ RTS
+_DIV STY IPY
+ LDA ESTKH,X
+ AND #$80
+ STA DVSIGN
+ BPL _DIV1
+ JSR _NEG
+ INC DVSIGN
+_DIV1 LDA ESTKH+1,X
+ BPL _DIV2
+ INX
+ JSR _NEG
+ DEX
+ INC DVSIGN
+ BNE _DIV3
+_DIV2 ORA ESTKL+1,X ; DVDNDL
+ BNE _DIV3
+ STA TMPL
+ STA TMPH
+ RTS
+_DIV3 LDY #$11 ; #BITS+1
+ LDA #$00
+ STA TMPL ; REMNDRL
+ STA TMPH ; REMNDRH
+_DIV4 ASL ESTKL+1,X ; DVDNDL
+ ROL ESTKH+1,X ; DVDNDH
+ DEY
+ BCC _DIV4
+ STY ESTKL-1,X
+_DIV5 ROL TMPL ; REMNDRL
+ ROL TMPH ; REMNDRH
+ LDA TMPL ; REMNDRL
+ SEC
+ SBC ESTKL,X ; DVSRL
+ TAY
+ LDA TMPH ; REMNDRH
+ SBC ESTKH,X ; DVSRH
+ BCC _DIV6
+ STA TMPH ; REMNDRH
+ STY TMPL ; REMNDRL
+_DIV6 ROL ESTKL+1,X ; DVDNDL
+ ROL ESTKH+1,X ; DVDNDH
+ DEC ESTKL-1,X
+ BNE _DIV5
+ LDY IPY
+ RTS
+;*
+;* OPCODE TABLE
+;*
+ !ALIGN 255,0
+OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
+ !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
+ !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,SWAP ; 20 22 24 26 28 2A 2C 2E
+ !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
+ !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
+ !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E
+ !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
+ !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
+;*
+;* ADD TOS TO TOS-1
+;*
+ADD LDA ESTKL,X
+ CLC
+ ADC ESTKL+1,X
+ STA ESTKL+1,X
+ LDA ESTKH,X
+ ADC ESTKH+1,X
+ STA ESTKH+1,X
+ INX
+ JMP NEXTOP
+;*
+;* SUB TOS FROM TOS-1
+;*
+SUB LDA ESTKL+1,X
+ SEC
+ SBC ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ STA ESTKH+1,X
+ INX
+ JMP NEXTOP
+;
+;*
+;* SHIFT TOS-1 LEFT BY 1, ADD TO TOS-1
+;*
+IDXW LDA ESTKL,X
+ ASL
+ ROL ESTKH,X
+ CLC
+ ADC ESTKL+1,X
+ STA ESTKL+1,X
+ LDA ESTKH,X
+ ADC ESTKH+1,X
+ STA ESTKH+1,X
+ INX
+ JMP NEXTOP
+;*
+;* MUL TOS-1 BY TOS
+;*
+MUL JSR _MUL
+ JMP NEXTOP
+;*
+;* NEGATE TOS
+;*
+NEG LDA #$00
+ SEC
+ SBC ESTKL,X
+ STA ESTKL,X
+ LDA #$00
+ SBC ESTKH,X
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* DIV TOS-1 BY TOS
+;*
+DIV JSR _DIV
+ INX
+ LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
+ BCS NEG
+ JMP NEXTOP
+;*
+;* MOD TOS-1 BY TOS
+;*
+MOD JSR _DIV
+ INX
+ LDA TMPL ; REMNDRL
+ STA ESTKL,X
+ LDA TMPH ; REMNDRH
+ STA ESTKH,X
+ LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
+ BMI NEG
+ JMP NEXTOP
+;*
+;* INCREMENT TOS
+;*
+INCR INC ESTKL,X
+ BNE INCR1
+ INC ESTKH,X
+INCR1 JMP NEXTOP
+;*
+;* DECREMENT TOS
+;*
+DECR LDA ESTKL,X
+ BNE DECR1
+ DEC ESTKH,X
+DECR1 DEC ESTKL,X
+ JMP NEXTOP
+;*
+;* BITWISE COMPLIMENT TOS
+;*
+COMP LDA #$FF
+ EOR ESTKL,X
+ STA ESTKL,X
+ LDA #$FF
+ EOR ESTKH,X
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* BITWISE AND TOS TO TOS-1
+;*
+BAND LDA ESTKL+1,X
+ AND ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ AND ESTKH,X
+ STA ESTKH+1,X
+ INX
+ JMP NEXTOP
+;*
+;* INCLUSIVE OR TOS TO TOS-1
+;*
+IOR LDA ESTKL+1,X
+ ORA ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ ORA ESTKH,X
+ STA ESTKH+1,X
+ INX
+ JMP NEXTOP
+;*
+;* EXLUSIVE OR TOS TO TOS-1
+;*
+XOR LDA ESTKL+1,X
+ EOR ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ EOR ESTKH,X
+ STA ESTKH+1,X
+ INX
+ JMP NEXTOP
+;*
+;* SHIFT TOS-1 LEFT BY TOS
+;*
+SHL STY IPY
+ LDA ESTKL,X
+ CMP #$08
+ BCC SHL1
+ LDY ESTKL+1,X
+ STY ESTKH+1,X
+ LDY #$00
+ STY ESTKL+1,X
+ SBC #$08
+SHL1 TAY
+ BEQ SHL3
+SHL2 ASL ESTKL+1,X
+ ROL ESTKH+1,X
+ DEY
+ BNE SHL2
+SHL3 INX
+ LDY IPY
+ JMP NEXTOP
+;*
+;* SHIFT TOS-1 RIGHT BY TOS
+;*
+SHR STY IPY
+ LDA ESTKL,X
+ CMP #$08
+ BCC SHR2
+ LDY ESTKH+1,X
+ STY ESTKL+1,X
+ CPY #$80
+ LDY #$00
+ BCC SHR1
+ DEY
+SHR1 STY ESTKH+1,X
+ SEC
+ SBC #$08
+SHR2 TAY
+ BEQ SHR4
+ LDA ESTKH+1,X
+SHR3 CMP #$80
+ ROR
+ ROR ESTKL+1,X
+ DEY
+ BNE SHR3
+ STA ESTKH+1,X
+SHR4 INX
+ LDY IPY
+ JMP NEXTOP
+;*
+;* LOGICAL NOT
+;*
+LNOT LDA ESTKL,X
+ ORA ESTKH,X
+ BEQ LNOT1
+ LDA #$FF
+LNOT1 EOR #$FF
+ STA ESTKL,X
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* LOGICAL AND
+;*
+LAND LDA ESTKL,X
+ ORA ESTKH,X
+ BEQ LAND1
+ LDA ESTKL+1,X
+ ORA ESTKH+1,X
+ BEQ LAND1
+ LDA #$FF
+LAND1 STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ JMP NEXTOP
+;*
+;* LOGICAL OR
+;*
+LOR LDA ESTKL,X
+ ORA ESTKH,X
+ ORA ESTKL+1,X
+ ORA ESTKH+1,X
+ BEQ LOR1
+ LDA #$FF
+LOR1 STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ JMP NEXTOP
+;*
+;* SWAP TOS WITH TOS-1
+;*
+SWAP STY IPY
+ LDA ESTKL,X
+ LDY ESTKL+1,X
+ STA ESTKL+1,X
+ STY ESTKL,X
+ LDA ESTKH,X
+ LDY ESTKH+1,X
+ STA ESTKH+1,X
+ STY ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+;*
+;* DUPLICATE TOS
+;*
+DUP DEX
+ LDA ESTKL+1,X
+ STA ESTKL,X
+ LDA ESTKH+1,X
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* PUSH FROM EVAL STACK TO CALL STACK
+;*
+PUSH LDA ESTKL,X
+ PHA
+ LDA ESTKH,X
+ PHA
+ INX
+ JMP NEXTOP
+;*
+;* PULL FROM CALL STACK TO EVAL STACK
+;*
+PULL DEX
+ PLA
+ STA ESTKH,X
+ PLA
+ STA ESTKL,X
+ JMP NEXTOP
+;*
+;* CONSTANT
+;*
+ZERO DEX
+ LDA #$00
+ STA ESTKL,X
+ STA ESTKH,X
+ JMP NEXTOP
+CB DEX
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
+;*
+LA = *
+CW DEX
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKL,X
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* LOAD VALUE FROM ADDRESS TAG
+;*
+LB LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ STA ESTKL,X
+ STY ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LW LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ STA ESTKL,X
+ INY
+ LDA (TMP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+;*
+;* LOAD ADDRESS OF LOCAL FRAME OFFSET
+;*
+LLA +INC_IP
+ LDA (IP),Y
+ DEX
+ CLC
+ ADC IFPL
+ STA ESTKL,X
+ LDA #$00
+ ADC IFPH
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* LOAD VALUE FROM LOCAL FRAME OFFSET
+;*
+LLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ DEX
+ LDA (IFP),Y
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ DEX
+ LDA (IFP),Y
+ STA ESTKL,X
+ INY
+ LDA (IFP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+;*
+;* LOAD VALUE FROM ABSOLUTE ADDRESS
+;*
+LAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ DEX
+ STA ESTKL,X
+ STY ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ DEX
+ STA ESTKL,X
+ INY
+ LDA (TMP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+;*
+;* STORE VALUE TO ADDRESS
+;*
+SB LDA ESTKL+1,X
+ STA TMPL
+ LDA ESTKH+1,X
+ STA TMPH
+ LDA ESTKL,X
+ STY IPY
+ LDY #$00
+ STA (TMP),Y
+ INX
+ INX
+ LDY IPY
+ JMP NEXTOP
+SW LDA ESTKL+1,X
+ STA TMPL
+ LDA ESTKH+1,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ INX
+ INX
+ LDY IPY
+ JMP NEXTOP
+;*
+;* STORE VALUE TO LOCAL FRAME OFFSET
+;*
+SLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ INX
+ LDY IPY
+ JMP NEXTOP
+SLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ INY
+ LDA ESTKH,X
+ STA (IFP),Y
+ INX
+ LDY IPY
+ JMP NEXTOP
+;*
+;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
+;*
+DLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ LDY IPY
+ JMP NEXTOP
+DLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ INY
+ LDA ESTKH,X
+ STA (IFP),Y
+ LDY IPY
+ JMP NEXTOP
+;*
+;* STORE VALUE TO ABSOLUTE ADDRESS
+;*
+SAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ LDA ESTKL,X
+ STY IPY
+ LDY #$00
+ STA (TMP),Y
+ INX
+ LDY IPY
+ JMP NEXTOP
+SAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ INX
+ LDY IPY
+ JMP NEXTOP
+;*
+;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
+;*
+DAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ LDY IPY
+ JMP NEXTOP
+DAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ LDY IPY
+ JMP NEXTOP
+;*
+;* COMPARES
+;*
+ISEQ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ BNE ISEQ1
+ LDA ESTKH,X
+ CMP ESTKH+1,X
+ BNE ISEQ1
+ DEY
+ISEQ1 STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ LDY IPY
+ JMP NEXTOP
+ISNE STY IPY
+ LDY #$FF
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ BNE ISNE1
+ LDA ESTKH,X
+ CMP ESTKH+1,X
+ BNE ISNE1
+ INY
+ISNE1 STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ LDY IPY
+ JMP NEXTOP
+ISGE STY IPY
+ LDY #$00
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ BVC ISGE1
+ EOR #$80
+ISGE1 BMI ISGE2
+ DEY
+ISGE2 STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ LDY IPY
+ JMP NEXTOP
+ISGT STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ BVC ISGT1
+ EOR #$80
+ISGT1 BPL ISGT2
+ DEY
+ISGT2 STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ LDY IPY
+ JMP NEXTOP
+ISLE STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ BVC ISLE1
+ EOR #$80
+ISLE1 BMI ISLE2
+ DEY
+ISLE2 STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ LDY IPY
+ JMP NEXTOP
+ISLT STY IPY
+ LDY #$00
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ BVC ISLT1
+ EOR #$80
+ISLT1 BPL ISLT2
+ DEY
+ISLT2 STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ LDY IPY
+ JMP NEXTOP
+;*
+;* BRANCHES
+;*
+BRTRU INX
+ LDA ESTKH-1,X
+ ORA ESTKL-1,X
+ BNE BRNCH
+NOBRNCH +INC_IP
+ +INC_IP
+ JMP NEXTOP
+BRFLS INX
+ LDA ESTKH-1,X
+ ORA ESTKL-1,X
+ BNE NOBRNCH
+BRNCH LDA IPH
+ STA TMPH
+ LDA IPL
+ +INC_IP
+ CLC
+ ADC (IP),Y
+ STA TMPL
+ LDA TMPH
+ +INC_IP
+ ADC (IP),Y
+ STA IPH
+ LDA TMPL
+ STA IPL
+ DEY
+ DEY
+ JMP NEXTOP
+BREQ INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BNE NOBRNCH
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BEQ BRNCH
+ BNE NOBRNCH
+BRNE INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BNE BRNCH
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BEQ NOBRNCH
+ BNE BRNCH
+BRGT INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ LDA ESTKH-1,X
+ SBC ESTKH,X
+ BMI BRNCH
+ BPL NOBRNCH
+BRLT INX
+ LDA ESTKL,X
+ CMP ESTKL-1,X
+ LDA ESTKH,X
+ SBC ESTKH-1,X
+ BMI BRNCH
+ BPL NOBRNCH
+IBRNCH LDA IPL
+ CLC
+ ADC ESTKL,X
+ STA IPL
+ LDA IPH
+ ADC ESTKH,X
+ STA IPH
+ INX
+ JMP NEXTOP
+;*
+;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
+;*
+CALL +INC_IP
+ LDA (IP),Y
+ STA CALLADR+1
+ +INC_IP
+ LDA (IP),Y
+ STA CALLADR+2
+ LDA IPX
+ PHA
+ LDA IPH
+ PHA
+ LDA IPL
+ PHA
+ TYA
+ PHA
+CALLADR JSR $FFFF
+ PLA
+ TAY
+ PLA
+ STA IPL
+ PLA
+ STA IPH
+ PLA
+ STA IPX
+ JMP NEXTOP
+;*
+;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
+;*
+ICAL LDA ESTKL,X
+ STA ICALADR+1
+ LDA ESTKH,X
+ STA ICALADR+2
+ INX
+ LDA IPX
+ PHA
+ LDA IPH
+ PHA
+ LDA IPL
+ PHA
+ TYA
+ PHA
+ICALADR JSR $FFFF
+ PLA
+ TAY
+ PLA
+ STA IPL
+ PLA
+ STA IPH
+ PLA
+ STA IPX
+ JMP NEXTOP
+;*
+;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
+;*
+ENTER +INC_IP
+ LDA (IP),Y
+ STA FRMSZ
+ +INC_IP
+ LDA (IP),Y
+ STA NPARMS
+ STY IPY
+ LDA IFPL
+ PHA
+ SEC
+ SBC FRMSZ
+ STA IFPL
+ LDA IFPH
+ PHA
+ SBC #$00
+ STA IFPH
+ LDY #$01
+ PLA
+ STA (IFP),Y
+ DEY
+ PLA
+ STA (IFP),Y
+ LDA NPARMS
+ BEQ ENTER5
+ ASL
+ TAY
+ INY
+ENTER4 LDA ESTKH,X
+ STA (IFP),Y
+ DEY
+ LDA ESTKL,X
+ STA (IFP),Y
+ DEY
+ INX
+ DEC NPARMS
+ BNE ENTER4
+ENTER5 LDY IPY
+ JMP NEXTOP
+;*
+;* LEAVE FUNCTION
+;*
+LEAVE LDY #$01
+ LDA (IFP),Y
+ DEY
+ PHA
+ LDA (IFP),Y
+ STA IFPL
+ PLA
+ STA IFPH
+RET RTS
+SOSCMD = *
+ !SOURCE "soscmd.a"
+SEGEND = *
diff --git a/src/soscmd.pla b/src/soscmd.pla
new file mode 100644
index 0000000..f9807b4
--- /dev/null
+++ b/src/soscmd.pla
@@ -0,0 +1,1306 @@
+const membank = $FFEF
+const MODADDR = $1000
+;
+; ROMCALL return register structure.
+;
+const acc = 0
+const xreg = 1
+const yreg = 2
+const preg = 3
+;
+; System flags: memory allocator screen holes.
+;
+const restxt1 = $0001
+const restxt2 = $0002
+const reshgr1 = $0004
+const reshgr2 = $0008
+const resxhgr1 = $0010
+const resxhgr2 = $0020
+;
+; SOS flags
+;
+const O_READ = 1
+const O_WRITE = 2
+const O_READ_WRITE = 3
+;
+; Pedefined functions.
+;
+predef home, gotoxy, viewport, crout, cout, prstr, cin, rdstr
+predef syscall, romcall
+predef markheap, allocheap, allocalignheap, releaseheap, availheap
+predef memset, memcpy, xmemcpy, memxcpy
+predef uword_isgt, uword_isge, uword_islt, uword_isle
+predef execmod
+;
+; Standard Library exported functions.
+;
+byte stdlibstr[] = "STDLIB"
+byte clsstr[] = "CLS"
+byte gotoxystr[] = "GOTOXY"
+byte viewstr[] = "VIEWPORT"
+byte putcstr[] = "PUTC"
+byte putsstr[] = "PUTS"
+byte getcstr[] = "GETC"
+byte getsstr[] = "GETS"
+byte sysstr[] = "SYSCALL"
+byte hpmarkstr[] = "HEAPMARK"
+byte hpalignstr[] = "HEAPALLOCALIGN"
+byte hpallocstr[] = "HEAPALLOC"
+byte hprelstr[] = "HEAPRELEASE"
+byte hpavailstr[] = "HEAPAVAIL"
+byte memsetstr[] = "MEMSET"
+byte memcpystr[] = "MEMCPY"
+byte memxcpystr[] = "MEMXCPY"
+byte uisgtstr[] = "ISUGT"
+byte uisgestr[] = "ISUGE"
+byte uisltstr[] = "ISULT"
+byte uislestr[] = "ISULE"
+byte execstr[] = "EXEC"
+word exports[] = @clsstr, @home
+word = @gotoxystr, @gotoxy
+word = @viewstr, @viewport
+word = @putcstr, @cout
+word = @putsstr, @prstr
+word = @getcstr, @cin
+word = @getsstr, @rdstr
+word = @sysstr, @syscall
+word = @hpmarkstr, @markheap
+word = @hpallocstr,@allocheap
+word = @hpalignstr,@allocalignheap
+word = @hprelstr, @releaseheap
+word = @memsetstr, @memset
+word = @memcpystr, @memcpy
+word = @memxcpystr, @memxcpy
+word = @uisgtstr, @uword_isgt
+word = @uisgestr, @uword_isge
+word = @uisltstr, @uword_islt
+word = @uislestr, @uword_isle
+word = @execstr, @execmod
+word = 0
+word stdlibsym = @exports
+;
+; String pool.
+;
+byte console[] = ".CONSOLE"
+byte devtovol[] = " => /"
+byte version[] = "PLASMA 0.9\n"
+byte freestr[] = "MEM FREE:$"
+byte errorstr[] = "ERR:$"
+byte okstr[] = "OK"
+byte huhstr[] = "?\n"
+byte prefix[128] = ""
+byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
+;
+; System variable.
+;
+word systemflags = 0
+word heap = $2000
+word symtbl, lastsym
+word refcons, devcons
+word perr, terr
+word cmdptr
+;
+; CALL SOS
+; SYSCALL(CMD, PARAMS)
+;
+asm syscall
+ LDA ESTKL,X
+ LDY ESTKH,X
+ STA PARAMS
+ STY PARAMS+1
+ INX
+ LDA ESTKL,X
+ STA CMD
+ BRK
+CMD !BYTE 00
+PARAMS !WORD 0000
+ STA ESTKL,X
+ LDY #$00
+ STY ESTKH,X
+ RTS
+end
+;
+; SET MEMORY TO VALUE
+; MEMSET(ADDR, SIZE, VALUE)
+;
+asm memset
+ LDY #$00
+ LDA ESTKL+2,X
+ STA DSTL
+ LDA ESTKH+2,X
+ STA DSTH
+ INC ESTKL+1,X
+ INC ESTKH+1,X
+SETMLP DEC ESTKL+1,X
+ BNE +
+ DEC ESTKH+1,X
+ BEQ SETMEX
++ LDA ESTKL,X
+ STA (DST),Y
+ INY
+ BNE +
+ INC DSTH
++ DEC ESTKL+1,X
+ BNE +
+ DEC ESTKH+1,X
+ BEQ SETMEX
++ LDA ESTKH,X
+ STA (DST),Y
+ INY
+ BNE SETMLP
+ INC DSTH
+ BNE SETMLP
+SETMEX INX
+ INX
+ RTS
+end
+;
+; COPY MEMORY
+; MEMCPY(DSTADDR, SRCADDR, SIZE)
+;
+asm memcpy
+ LDY #$00
+ LDA ESTKL,X
+ BNE +
+ LDA ESTKH,X
+ BEQ CPYMEX
++ LDA ESTKL+2,X
+ STA DSTL
+ LDA ESTKH+2,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ CMP DSTH
+ BCC REVCPY
+ BNE FORCPY
+ LDA SRCL
+ CMP DSTL
+ BCS FORCPY
+REVCPY ; REVERSE DIRECTION COPY
+; CLC
+ LDA ESTKL,X
+ ADC DSTL
+ STA DSTL
+ LDA ESTKH,X
+ ADC DSTH
+ STA DSTH
+ CLC
+ LDA ESTKL,X
+ ADC SRCL
+ STA SRCL
+ LDA ESTKH,X
+ ADC SRCH
+ STA SRCH
+ INC ESTKH,X
+REVCPYLP
+ LDA DSTL
+ BNE +
+ DEC DSTH
++ DEC DSTL
+ LDA SRCL
+ BNE +
+ DEC SRCH
++ DEC SRCL
+ LDA (SRC),Y
+ STA (DST),Y
+ DEC ESTKL,X
+ BNE REVCPYLP
+ DEC ESTKH,X
+ BNE REVCPYLP
+ BEQ CPYMEX
+FORCPY INC ESTKH,X
+FORCPYLP
+ LDA (SRC),Y
+ STA (DST),Y
+ INC DSTL
+ BNE +
+ INC DSTH
++ INC SRCL
+ BNE +
+ INC SRCH
++ DEC ESTKL,X
+ BNE FORCPYLP
+ DEC ESTKH,X
+ BNE FORCPYLP
+CPYMEX INX
+ INX
+ RTS
+end
+;
+; COPY FROM MAIN MEM TO EXT MEM.
+;
+; MEMXCPY(DIR, EXT, DST, SRC, SIZE)
+; DIR = 0 : COPY FROM MAIN TO EXT
+; DIR = 1 : COPY FROM EXT TO MAIN
+;
+asm memxcpy
+ RTS
+end
+;
+; Unsigned word comparisons.
+;
+asm uword_isge
+ LDY #$00
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
++ BCC +
+ DEY
++ STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ RTS
+end
+asm uword_isle
+ LDY #$00
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
++ BCC +
+ DEY
++ STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ RTS
+end
+asm uword_isgt
+ LDY #$FF
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
++ BCC +
+ INY
++ STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ RTS
+end
+asm uword_islt
+ LDY #$FF
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
++ BCC +
+ INY
++ STY ESTKL+1,X
+ STY ESTKH+1,X
+ INX
+ RTS
+end
+;
+; Addresses of internal routines.
+;
+asm interp
+ DEX
+ LDA #<XINTERP
+ STA ESTKL,X
+ LDA #>XINTERP
+ STA ESTKH,X
+ RTS
+end
+;
+; A DCI string is one that has the high bit set for every character except the last.
+; More efficient than C or Pascal strings.
+;
+;def dcitos(dci, str)
+; byte len, c
+; len = 0
+; repeat
+; c = (dci).[len]
+; len = len + 1
+; (str).[len] = c & $7F
+; until !(c & $80)
+; ^str = len
+; return len
+;end
+asm dcitos
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDY #$00
+- LDA (SRC),Y
+ INY
+ PHA
+ AND #$7F
+ STA (DST),Y
+ PLA
+ BMI -
+ TYA
+ LDY #$00
+ STA (DST),Y
+ INX
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
+end
+;def stodci(str, dci)
+; byte len, c
+; len = ^str
+; if len == 0
+; return
+; fin
+; c = toupper((str).[len]) & $7F
+; len = len - 1
+; (dci).[len] = c
+; while len
+; c = toupper((str).[len]) | $80
+; len = len - 1
+; (dci).[len] = c
+; loop
+; return ^str
+;end
+asm stodci
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ INX
+ LDY #$00
+ LDA (SRC),Y
+ BEQ ++
+ TAY
+ LDA (SRC),Y
+ JSR TOUPR
+ BNE +
+- LDA (SRC),Y
+ JSR TOUPR
+ ORA #$80
++ DEY
+ STA (DST),Y
+ BNE -
+ LDA (SRC),Y
+++ STA ESTKL,X
+ STY ESTKH,X
+ RTS
+end
+asm toupper
+ LDA ESTKL,X
+TOUPR AND #$7F
+ CMP #'a'
+ BCC +
+ CMP #'z'+1
+ BCS +
+ SEC
+ SBC #$20
++ STA ESTKL,X
+ RTS
+end
+;
+; Module symbols are entered into the symbol table
+; pre-pended with a '#' to differentiate them
+; from normal symbols.
+;
+;def modtosym(mod, dci)
+; byte len, c
+; (dci).0 = '#'|$80
+; len = 0
+; repeat
+; c = (mod).[len]
+; len = len + 1
+; (dci).[len] = c
+; until !(c & $80)
+; return dci
+;end
+asm modtosym
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDA ESTKL,X
+ STA ESTKL+1,X
+ STA DSTL
+ LDA ESTKH,X
+ STA ESTKH+1,X
+ STA DSTH
+ INX
+ LDY #$00
+ LDA #'#'+$80
+ STA (DST),Y
+- LDA (SRC),Y
+ INY
+ STA (DST),Y
+ AND #$80
+ BMI -
+ RTS
+end
+;
+; Lookup routines.
+;
+;def lookuptbl(dci, tbl)
+; word match
+; while ^tbl
+; match = dci
+; while ^tbl == ^match
+; if !(^tbl & $80)
+; return (tbl):1
+; fin
+; tbl = tbl + 1
+; match = match + 1
+; loop
+; while (^tbl & $80)
+; tbl = tbl + 1
+; loop
+; tbl = tbl + 3
+; loop
+; return 0
+asm lookuptbl
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDY #$00
+- LDA (DST),Y
+ BEQ +
+ CMP (SRC),Y
+ BNE ++
+ INY
+ AND #$80
+ BMI -
+ LDA (DST),Y
+ PHA
+ INY
+ LDA (DST),Y
+ TAY
+ PLA
++ INX
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
+++ LDY #$00
+-- LDA (DST),Y
+ INC DSTL
+ BNE ++
+ INC DSTH
+++ AND #$80
+ BMI --
+ LDA #$02
+ CLC
+ ADC DSTL
+ STA DSTL
+ TYA
+ ADC DSTH
+ STA DSTH
+ BNE -
+end
+def lookupdef(addr, deftbl)
+ while (deftbl).0 == $20
+ if (deftbl):3 == addr
+ return deftbl
+ fin
+ deftbl = deftbl + 6
+ loop
+ return 0
+;asm lookupdef
+; LDA ESTKL,X
+; STA DSTL
+; LDA ESTKH,X
+; STA DSTH
+; INX
+;- LDY #$00
+; LDA #$20
+; AND (DST),Y
+; BEQ ++
+; LDY #$03
+; LDA (DST),Y
+; CMP ESTKL,X
+; BNE +++
+; INY
+; LDA (DST),Y
+; CMP ESTKH,X
+; BNE ++
+;+ LDA DSTL
+; LDY DSTH
+;++ STA ESTKL,X
+; STY ESTKH,X
+; RTS
+;+++ LDA #$05
+; CLC
+; ADC DSTL
+; STA DSTL
+; LDA #$00
+; ADC DSTH
+; STA DSTH
+; BNE -
+end
+;
+; SOS routines
+; FILE I/O
+;
+def getpfx(path)
+ byte params[4]
+
+ ^path = 0
+ params.0 = 2
+ params:1 = path
+ params.3 = 128
+ perr = syscall($C7, @params)
+ return path
+end
+def setpfx(path)
+ byte params[3]
+
+ params.0 = 1
+ params:1 = path
+ perr = syscall($C6, @params)
+ return path
+end
+def volume(devname, volname, ttlblks, freblks)
+ byte params[9]
+
+ params.0 = 4
+ params:1 = devname
+ params:3 = volname
+ params:5 = 0
+ params:7 = 0
+ perr = syscall($C5, @params)
+ *ttlblks = params:5
+ *freblks = params:7
+ return perr
+end
+def open(path, access)
+ byte params[7]
+
+ params.0 = 4
+ params:1 = path
+ params.3 = 0
+ params:4 = @access
+ params.6 = 1
+ perr = syscall($C8, @params)
+ return params.3
+end
+def close(refnum)
+ byte params[2]
+
+ params.0 = 1
+ params.1 = refnum
+ perr = syscall($CC, @params)
+ return perr
+end
+def read(refnum, buff, len)
+ byte params[8]
+
+ params.0 = 4
+ params.1 = refnum
+ params:2 = buff
+ params:4 = len
+ params:6 = 0
+ perr = syscall($CA, @params)
+ return params:6
+end
+def write(refnum, buff, len)
+ byte params[6]
+
+ params.0 = 3
+ params.1 = refnum
+ params:2 = buff
+ params:4 = len
+ perr = syscall($CB, @params)
+ return perr
+end
+;
+; DEVICE I/O
+;
+def dev_status(devnum, list)
+ byte params[5]
+
+ params.0 = 3
+ params.1 = devnum
+ params.2 = 0
+ params:3 = list
+ perr = syscall($82, @params)
+ return params.2
+end
+def dev_control(devnum, code, list)
+ byte params[5]
+
+ params.0 = 3
+ params.1 = devnum
+ params.2 = code
+ params:3 = list
+ perr = syscall($83, @params)
+ return perr
+end
+def dev_getnum(name)
+ byte params[4]
+
+ params.0 = 2
+ params:1 = name
+ params.3 = 0
+ perr = syscall($84, @params)
+ return params.3
+end
+def dev_info(devnum, name, list, listlen)
+ byte params[7]
+
+ params.0 = 4
+ params.1 = devnum
+ params:2 = name
+ params:4 = list
+ params.6 = listlen
+ perr = syscall($85, @params)
+ return perr
+end
+;
+; MEMORY CALLS
+;
+def seg_request(base, limit, id)
+ byte params[7]
+
+ params.0 = 4
+ params:1 = base
+ params:3 = limit
+ params.5 = id
+ params.6 = 0
+ perr = syscall($40, @params)
+ return params.6
+end
+def seg_find(search, base, limit, pages, id)
+ byte params[10]
+
+ params.0 = 6
+ params.1 = search
+ params.2 = id
+ params:3 = 0
+ params:5 = 0
+ params:7 = 0
+ params.9 = 0
+ perr = syscall($41, @params)
+ *pages = params:3
+ *base = params:5
+ *limit = params:7
+ return params.9
+end
+def seg_change(segnum, mode, pages)
+ byte params[5]
+
+ params.0 = 3
+ params.1 = segnum
+ params.2 = mode
+ params:3 = pages
+ perr = syscall($42, @params)
+ return params:3
+end
+def seg_getinfo(segnum, base, limit, pages, id)
+ byte params[9]
+
+ params.0 = 6
+ params.1 = segnum
+ params:2 = 0
+ params:4 = 0
+ params:6 = 0
+ params.8 = 0
+ perr = syscall($43, @params)
+ *base = params:2
+ *limit = params:4
+ *pages = params:6
+ return params.8
+end
+def seg_getnum(segaddr)
+ byte params[4]
+
+ params.0 = 2
+ params:1 = segaddr
+ params.3 = 0
+ perr = syscall($44, @params)
+ return params.3
+end
+def seg_release(segnum)
+ byte params[2]
+
+ params.0 = 1
+ params.1 = segnum
+ perr = syscall($45, @params)
+ return perr
+end
+;
+; CONSOLE I/O
+;
+def init_cons
+ byte nlmode[2]
+ refcons = open(@console, O_READ_WRITE)
+ devcons = dev_getnum(@console)
+ nlmode.0 = $80
+ nlmode.1 = $0D
+ dev_control(devcons, $02, @nlmode)
+end
+def cout(ch)
+ if ch == $0D
+ ch = $0A0D
+ write(refcons, @ch, 2)
+ else
+ write(refcons, @ch, 1)
+ fin
+end
+def cin
+ byte ch
+ read(refcons, @ch, 1)
+ return ch
+end
+def prstr(str)
+ write(refcons, str + 1, ^str)
+ if (str).[^str] == $0D
+ cout($0A)
+ fin
+end
+def rdstr(prompt)
+ cout(prompt)
+ ^heap = read(refcons, heap + 1, 128)
+ if (heap).[^heap] == $0D
+ ^heap = ^heap - 1
+ fin
+ cout($0D)
+ return heap
+end
+def home
+ return cout(28)
+end
+def gotoxy(x, y)
+ cout(26)
+ cout(x)
+ return cout(y)
+end
+def viewport(left, top, width, height)
+ cout(1) ; Reset viewport
+ gotoxy(left, top)
+ cout(2)
+ gotoxy(width, height)
+ cout(3)
+ return gotoxy(0, 0)
+end
+def crout
+ return cout($0D)
+end
+def prbyte(v)
+ cout(hexchar[(v >> 4) & $0F])
+ return cout(hexchar[v & $0F])
+end
+def prword(v)
+ prbyte(v >> 8)
+ return prbyte(v)
+end
+;
+; Heap routines.
+;
+def availheap
+ byte fp
+ return @fp - heap
+end
+def allocheap(size)
+ word addr
+ addr = heap
+ heap = heap + size
+ if systemflags & reshgr1
+ if uword_isle(addr, $4000) and uword_isgt(heap, $2000)
+ addr = $4000
+ heap = addr + size
+ fin
+ fin
+ if systemflags & reshgr2
+ if uword_isle(addr, $6000) and uword_isgt(heap, $4000)
+ addr = $6000
+ heap = addr + size
+ fin
+ fin
+ if uword_isge(heap, @addr)
+ return 0
+ fin
+ return addr
+end
+def allocalignheap(size, pow2, freeaddr)
+ word align, addr
+ if freeaddr
+ *freeaddr = heap
+ fin
+ align = (1 << pow2) - 1
+ addr = (heap | align) + 1
+ heap = addr + size
+ if uword_isge(heap, @addr)
+ return 0
+ fin
+ return addr
+end
+def markheap
+ return heap;
+end
+def releaseheap(newheap)
+ heap = newheap;
+ return @newheap - heap;
+end
+;
+; DCI table routines,
+;
+;def dumptbl(tbl)
+; byte len
+;
+; while ^tbl
+; len = 0
+; while ^tbl & $80
+; cout(^tbl)
+; tbl = tbl + 1
+; len = len + 1
+; loop
+; cout(^tbl)
+; tbl = tbl + 1
+; cout(':')
+; while len < 15
+; cout(' ')
+; len = len + 1
+; loop
+; cout('$')
+; prword(*tbl)
+; crout
+; tbl = tbl + 2
+; loop
+;end
+def addtbl(dci, val, last)
+ while ^dci & $80
+ ^*last = ^dci
+ *last = *last + 1
+ dci = dci + 1
+ loop
+ ^*last = ^dci
+ *last = *last + 1
+ **last = val
+ *last = *last + 2
+ ^*last = 0
+end
+;
+; Symbol table routines.
+;
+def lookupsym(sym)
+ return lookuptbl(sym, symtbl)
+end
+def addsym(sym, addr)
+ return addtbl(sym, addr, @lastsym);
+end
+;
+; Module routines.
+;
+def lookupmod(mod)
+ byte dci[17]
+ return lookuptbl(modtosym(mod, @dci), symtbl)
+end
+def addmod(mod, addr)
+ byte dci[17]
+ return addtbl(modtosym(mod, @dci), addr, @lastsym)
+end
+def lookupextern(esd, index)
+ word sym
+ byte str[16]
+ while ^esd
+ sym = esd
+ esd = esd + dcitos(esd, @str)
+ if (esd).0 & $10 and (esd).1 == index
+ return lookupsym(sym)
+ fin
+ esd = esd + 3
+ loop
+ return 0
+end
+def adddef(ext, addr, deflast)
+ (*deflast).0 = $20
+ (*deflast):1 = interp
+ (*deflast):3 = addr
+ (*deflast).5 = ext
+ *deflast = *deflast + 6
+ (*deflast).0 = 0
+ return *deflast - 6
+end
+def loadmod(mod)
+ word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup
+ word addr, defaddr, modaddr, modfix, modend
+ word deftbl, deflast
+ word moddep, rld, esd, sym
+ byte defext, str[16], filename[64]
+ byte header[128]
+
+ ;
+ ; Read the RELocatable module header (first 128 bytes)
+ ;
+ dcitos(mod, @filename)
+ refnum = open(@filename, O_READ)
+ if refnum > 0
+ rdlen = read(refnum, @header, 128)
+ modsize = header:0
+ moddep = @header.1
+ defofst = modsize
+ init = 0
+ if rdlen > 4 and header:2 == $DA7E ; DAVE = magic number :-)
+ ;
+ ; This is an EXTended RELocatable (data+bytecode) module.
+ ;
+ systemflags = header:4 | systemflags
+ defofst = header:6
+ defcnt = header:8
+ init = header:10
+ moddep = @header.12
+ ;
+ ; Load module dependencies.
+ ;
+ while ^moddep
+ if !lookupmod(moddep)
+ close(refnum)
+ refnum = 0
+ if loadmod(moddep) < 0
+ return perr
+ fin
+ fin
+ moddep = moddep + dcitos(moddep, @str)
+ loop
+ ;
+ ; Init def table.
+ ;
+ deftbl = allocheap(defcnt * 6 + 1)
+ deflast = deftbl
+ ^deflast = 0
+ if !refnum
+ ;
+ ; Reset read pointer.
+ ;
+ refnum = open(@filename, O_READ)
+ rdlen = read(refnum, @header, 128)
+ fin
+ fin
+ ;
+ ; Alloc heap space for relocated module (data + bytecode).
+ ;
+ moddep = moddep + 1
+ modfix = moddep - @header.2 ; Adjust to skip header
+ modsize = modsize - modfix
+ rdlen = rdlen - modfix - 2
+ modaddr = allocheap(modsize)
+ memcpy(modaddr, moddep, rdlen)
+ ;
+ ; Read in remainder of module into memory for fixups.
+ ;
+ addr = modaddr;
+ repeat
+ addr = addr + rdlen
+ rdlen = read(refnum, addr, 4096)
+ until rdlen <= 0
+ close(refnum)
+ ;
+ ; Apply all fixups and symbol import/export.
+ ;
+ modfix = modaddr - modfix
+ bytecode = defofst + modfix - MODADDR
+ modend = modaddr + modsize
+ rld = modend ; Re-Locatable Directory
+ esd = rld ; Extern+Entry Symbol Directory
+ while !^esd ; Scan to end of ESD
+ esd = esd + 4
+ loop
+ esd = esd + 1
+ ;
+ ; Locate bytecode defs in appropriate bank.
+ ;
+ ;if ^MACHID & $30 == $30
+ ;defext = 1
+ ;defaddr = allocxheap(rld - bytecode)
+ ;modend = bytecode
+ ;else
+ defext = 0
+ defaddr = bytecode
+ ;fin
+ ;
+ ; Run through the Re-Location Dictionary.
+ ;
+ while ^rld
+ if ^rld == $02
+ ;
+ ; This is a bytcode def entry - add it to the def directory.
+ ;
+ adddef(defext, (rld):1 - defofst + defaddr, @deflast)
+ else
+ addr = (rld):1 + modfix
+ if addr >= modaddr ; Skip fixups to header
+ if ^rld & $80 ; WORD sized fixup.
+ fixup = *addr
+ else ; BYTE sized fixup.
+ fixup = ^addr
+ fin
+ if ^rld & $10 ; EXTERN reference.
+ fixup = fixup + lookupextern(esd, (rld).3)
+ else ; INTERN fixup.
+ fixup = fixup + modfix - MODADDR
+ if uword_isge(fixup, bytecode)
+ ;
+ ; Bytecode address - replace with call def directory.
+ ;
+ fixup = lookupdef(fixup - bytecode + defaddr, deftbl)
+ fin
+ fin
+ if ^rld & $80 ; WORD sized fixup.
+ *addr = fixup
+ else ; BYTE sized fixup.
+ ^addr = fixup
+ fin
+ fin
+ fin
+ rld = rld + 4
+ loop
+ ;
+ ; Run through the External/Entry Symbol Directory.
+ ;
+ while ^esd
+ sym = esd
+ esd = esd + dcitos(esd, @str)
+ if ^esd & $08
+ ;
+ ; EXPORT symbol - add it to the global symbol table.
+ ;
+ addr = (esd):1 + modfix - MODADDR
+ if uword_isge(addr, bytecode)
+ ;
+ ; Use the def directory address for bytecode.
+ ;
+ addr = lookupdef(addr - bytecode + defaddr, deftbl)
+ fin
+ addsym(sym, addr)
+ fin
+ esd = esd + 3
+ loop
+ if defext
+ ;
+ ; Move bytecode to AUX bank.
+ ;
+ memxcpy(0, defext, defaddr, bytecode, modsize - (bytecode - modaddr))
+ fin
+ ;
+ ; Free up end-of-module main memory.
+ ;
+ releaseheap(modend)
+ else
+ perr = perr | 0x100
+ return -perr
+ fin
+ ;
+ ; Call init routine if it exists.
+ ;
+ if init
+ return adddef(defext, init - defofst + defaddr, @deflast)()
+ fin
+ return 0
+end
+;
+; Command mode
+;
+def volumes
+ byte info[11]
+ byte devname[17]
+ byte volname[17]
+ byte i
+ word ttlblks, freblks
+
+ for i = $01 to $18
+ if dev_info(i, @devname, @info, 11) == 0
+ prstr(@devname)
+ if volume(@devname, @volname, @ttlblks, @freblks) == 0
+ prstr(@devtovol)
+ prstr(@volname)
+ cout('/')
+ fin
+ crout
+ fin
+ next
+ perr = 0
+end
+def catalog(optpath)
+ byte path[64]
+ byte refnum
+ byte firstblk
+ byte entrylen, entriesblk
+ byte i, type, len
+ word entry, filecnt
+
+ if ^optpath
+ memcpy(@path, optpath, ^optpath + 1)
+ else
+ getpfx(@path)
+ prstr(@path)
+ crout()
+ fin
+ refnum = open(@path, O_READ)
+ if perr
+ return perr
+ fin
+ firstblk = 1
+ repeat
+ if read(refnum, heap, 512) == 512
+ entry = heap + 4
+ if firstblk
+ entrylen = (heap).$23
+ entriesblk = (heap).$24
+ filecnt = (heap):$25
+ entry = entry + entrylen
+ fin
+ for i = firstblk to entriesblk
+ type = ^entry
+ if type <> 0
+ len = type & $0F
+ ^entry = len
+ prstr(entry)
+ if type & $F0 == $D0 ; Is it a directory?
+ cout('/')
+ len = len + 1
+ elsif (entry).$10 == $FF
+ cout('-')
+ len = len + 1
+ elsif (entry).$10 == $FE
+ cout('+')
+ len = len + 1
+ fin
+ for len = 19 - len downto 0
+ cout(' ')
+ next
+ filecnt = filecnt - 1
+ fin
+ entry = entry + entrylen
+ next
+ firstblk = 0
+ else
+ filecnt = 0
+ fin
+ until filecnt == 0
+ close(refnum)
+ crout()
+ return 0
+end
+def stripchars(strptr)
+ while ^strptr and ^(strptr + 1) <> ' '
+ memcpy(strptr + 1, strptr + 2, ^strptr)
+ ^strptr = ^strptr - 1
+ loop
+ return ^strptr
+end
+def stripspaces(strptr)
+ while ^strptr and ^(strptr + ^strptr) <= ' '
+ ^strptr = ^strptr - 1
+ loop
+ while ^strptr and ^(strptr + 1) <= ' '
+ memcpy(strptr + 1, strptr + 2, ^strptr)
+ ^strptr = ^strptr - 1
+ loop
+end
+def striptrail(strptr)
+ byte i
+
+ for i = 1 to ^strptr
+ if (strptr)[i] == ' '
+ ^strptr = i - 1
+ return
+ fin
+ next
+end
+def parsecmd(strptr)
+ byte cmd
+
+ cmd = 0
+ stripspaces(strptr)
+ if ^strptr
+ cmd = ^(strptr + 1)
+ memcpy(strptr + 1, strptr + 2, ^strptr)
+ ^strptr = ^strptr - 1
+ fin
+ stripspaces(strptr)
+ return cmd
+end
+def execmod(modfile)
+ byte moddci[17]
+ word saveheap, savesym, saveflags
+
+ if stodci(modfile, @moddci)
+ saveheap = heap
+ savesym = lastsym
+ saveflags = systemflags
+ ^lastsym = 0
+ perr = loadmod(@moddci)
+ systemflags = saveflags
+ lastsym = savesym
+ heap = saveheap
+ fin
+end
+
+;
+; Save Symbol Table start.
+;
+symtbl = *$A000
+;
+; Request bank $01.
+;
+seg_request($0120, $019F, $10)
+;
+; Init console
+;
+init_cons
+;
+; Print some startup info.
+;
+prstr(@version)
+prstr(@freestr)
+prword(availheap)
+crout
+;
+; Init symbol table.
+;
+lastsym = symtbl
+^lastsym = 0
+stodci(@stdlibstr, heap)
+addmod(heap, 1)
+while *stdlibsym
+ stodci((stdlibsym):0, heap)
+ addsym(heap, (stdlibsym):2)
+ stdlibsym = stdlibsym + 4
+loop
+;
+; Handle commands.
+;
+while 1
+ prstr(getpfx(@prefix))
+ cmdptr = rdstr($BA)
+ if ^cmdptr
+ when toupper(parsecmd(cmdptr))
+ is 'Q'
+ ; reboot()
+ is 'C'
+ catalog(cmdptr)
+ is 'P'
+ setpfx(cmdptr)
+ is 'V'
+ volumes()
+ is '+'
+ execmod(cmdptr)
+ otherwise
+ prstr(@huhstr)
+ wend
+ if perr
+ terr = perr
+ prstr(@errorstr)
+ prbyte(terr)
+ perr = 0
+ else
+ prstr(@okstr)
+ fin
+ crout()
+ fin
+loop
+done
diff --git a/src/testcls.pla b/src/testcls.pla
deleted file mode 100755
index e2ae4d6..0000000
--- a/src/testcls.pla
+++ /dev/null
@@ -1,32 +0,0 @@
-;
-; Declare all imported modules and their data/functions.
-;
-import stdlib
- predef putc
-end
-predef puti, puth
-export word print[] = @puti, @puth
-byte valstr[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
-;
-; Define functions.
-;
-def puti(i)
- if i < 0
- putc('-')
- i = -i
- fin
- if i < 10
- putc(i + '0')
- else
- puti(i / 10)
- putc(i % 10 + '0')
- fin
-end
-def puth(h)
- putc('$')
- putc(valstr[(h >> 12) & $0F])
- putc(valstr[(h >> 8) & $0F])
- putc(valstr[(h >> 4) & $0F])
- putc(valstr[ h & $0F])
-end
-done