6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2024-10-02 20:55:30 +00:00
Code Issues Projects Releases Wiki Activity

Merge pull request #12 from dschmenk/master

Browse Source 
Merge latest upstream
This commit is contained in:
ZornsLemma 2018-04-08 15:18:23 +01:00 committed by GitHub
commit 87d43d74ce
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
48 changed files with 14549 additions and 2694 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
PLASMA-BLD1.PO
View File

Binary file not shown.

BIN
PLASMA-BLD2.PO Normal file
View File

Binary file not shown.

BIN
PLASMA-DEM1.PO → PLASMA-DEM2.PO
View File

Binary file not shown.

BIN
PLASMA-SOS1.PO → PLASMA-SOS2.PO
View File

Binary file not shown.

BIN
PLASMA-SYS1.PO
View File

Binary file not shown.

BIN
PLASMA-SYS2.PO Executable file
View File

Binary file not shown.

BIN
SANDBOX.PO
View File

Binary file not shown.

14
src/inc/cmdsys.plh
View File

@ -2,7 +2,7 @@ import cmdsys
// //
// Useful values for everyone // Useful values for everyone
// //
const _SYSVER_ = $0100 // Version built against const _SYSVER_ = $0200 // Version built against
const FALSE = 0 const FALSE = 0
const TRUE = not FALSE const TRUE = not FALSE
const NULL = 0 const NULL = 0
@ -33,6 +33,7 @@ import cmdsys
const reshgr2 = $0020 const reshgr2 = $0020
const resxhgr1 = $0040 const resxhgr1 = $0040
const resxhgr2 = $0080 const resxhgr2 = $0080
const nojitc = $0100
// //
// Module don't free memory // Module don't free memory
// //
@ -46,8 +47,15 @@ import cmdsys
word syspath word syspath
word cmdline word cmdline
word modexec word modexec
byte refcons word sysopen
byte devcons word sysclose
word sysread
word syswrite
byte syserr
byte jitcount
byte jitsize
byte refcons // Apple /// specific
byte devcons // Apple /// specific
end end
// //
// CMD exported functions // CMD exported functions

1831
src/libsrc/apple/cleanjit.pla Normal file
View File

File diff suppressed because it is too large Load Diff

1
src/libsrc/apple/conio.pla
View File

@ -1,4 +1,5 @@
include "inc/cmdsys.plh" include "inc/cmdsys.plh"
sysflags nojitc // Keep tone() from compiling and sounding different
// //
// Handy constants. // Handy constants.
// //

1
src/libsrc/apple/fileio.pla
View File

@ -1,4 +1,5 @@
include "inc/cmdsys.plh" include "inc/cmdsys.plh"
sysflags nojitc // It's file I/O. No need to hurry up and wait.
// //
// CFFA1 addresses. // CFFA1 addresses.
// //

51
src/libsrc/apple/jit.pla Normal file
View File

@ -0,0 +1,51 @@
//
// PLASMA JIT bytecode compiler
//
include "inc/cmdsys.plh"
//
// Module don't free memory
//
const modkeep = $2000
const modinitkeep = $4000
//
// Indirect interpreter DEFinition entrypoint
//
struc t_defentry
byte interpjsr
word interpaddr
word bytecodeaddr
byte callcount
byte bytecodesize
end
//
// JIT compiler constants
//
const jitcomp = $03E2
const jitcodeptr = $03E4
const codemax = $BEE0
//
// Bytecode interpreter entrypoints
//
const indirectentry = $03DC
const directentry = $03D0
//
// Copy bytecode DEF to main memory
//
def defcpy(dst, defptr)#0
*$003C = defptr=>bytecodeaddr
*$003E = *$003C + defptr->bytecodesize
*$0042 = dst
call($C311, 0, 0, 0, $04) // CALL XMOVE with carry clear (AUX->MAIN) and ints disabled
end
include "libsrc/jitcore.pla"
//
// Install JIT compiler
//
if *jitcomp
return 0
fin
*jitcomp = @compiler
cmdsys.jitcount = 44
cmdsys.jitsize = 96
return modkeep
done

51
src/libsrc/apple/jit16.pla Normal file
View File

@ -0,0 +1,51 @@
//
// PLASMA JIT bytecode compiler
//
include "inc/cmdsys.plh"
//
// Module don't free memory
//
const modkeep = $2000
const modinitkeep = $4000
//
// Indirect interpreter DEFinition entrypoint
//
struc t_defentry
byte interpjsr
word interpaddr
word bytecodeaddr
byte callcount
byte bytecodesize
end
//
// JIT compiler constants
//
const jitcomp = $03E2
const jitcodeptr = $03E4
const codemax = $BEE0
//
// Bytecode interpreter entrypoints
//
const indirectentry = $03DC
const directentry = $03D0
//
// Copy bytecode DEF to main memory
//
def defcpy(dst, defptr)#0
*$003C = defptr=>bytecodeaddr
*$003E = *$003C + defptr->bytecodesize
*$0042 = dst
call($C311, 0, 0, 0, $04) // CALL XMOVE with carry clear (AUX->MAIN) and ints disabled
end
include "libsrc/jitcore.pla"
//
// Install JIT compiler
//
if *jitcomp
return 0
fin
*jitcomp = @compiler
cmdsys.jitcount = 44
cmdsys.jitsize = 96
return modkeep
done

45
src/libsrc/apple/jitune.pla Normal file
View File

@ -0,0 +1,45 @@
//
// PLASMA JIT bytecode compiler tuner
//
include "inc/cmdsys.plh"
include "inc/args.plh"
var arg, val
def atoi(strptr)
var num, len
num = 0
len = ^strptr
strptr++
while len and ^strptr >= '0' and ^strptr <= '9'
num = num * 10 + ^strptr - '0'
strptr++
len--
loop
return num
end
arg = argNext(argFirst)
if ^arg
if arg->1 >= '0' and arg->1 <= '9'
val = atoi(arg)
if val > 255
val = 255
fin
cmdsys.jitcount = val
arg = argNext(arg)
if ^arg
val = atoi(arg)
if val > 255
val = 255
fin
cmdsys.jitsize = val
fin
else
puts("Usage: JITUNE WARMUP [CALLCOUNT [MAXSIZE]]\n")
fin
fin
puts("JIT Call Count: "); puti(cmdsys.jitcount); putln
puts("JIT Max Size: "); puti(cmdsys.jitsize); putln
done

1
src/libsrc/args.pla
View File

@ -1,4 +1,5 @@
include "inc/cmdsys.plh" include "inc/cmdsys.plh"
sysflags nojitc // No need to speed this up
def argDelim(str) def argDelim(str)
byte n byte n

1563
src/libsrc/jit16core.pla Normal file
View File

File diff suppressed because it is too large Load Diff

1563
src/libsrc/jitcore.pla Normal file
View File

File diff suppressed because it is too large Load Diff

4
src/libsrc/sane.pla
View File

@ -734,19 +734,21 @@ def loadcode(codefile)
ref = fileio:open(strcat(strcpy(@filepath, cmdsys:syspath), codefile)) ref = fileio:open(strcat(strcpy(@filepath, cmdsys:syspath), codefile))
//puts("ref = "); prbyte(ref); puts(" perr = "); prbyte(perr); putln //puts("ref = "); prbyte(ref); puts(" perr = "); prbyte(perr); putln
if ref if ref
pcode = heapmark pcode = heapalloc(512)
fileio:read(ref, pcode, 512) fileio:read(ref, pcode, 512)
//puts("Read header bytes: "); puti(seglen) //puts("Read header bytes: "); puti(seglen)
//if seglen == 0; puts(" perr = "); prbyte(perr); fin //if seglen == 0; puts(" perr = "); prbyte(perr); fin
//getc; putln //getc; putln
//dumpheader(pcode) //dumpheader(pcode)
//putname(pcode + segname + 8); putc('='); prword(pcode); putln //putname(pcode + segname + 8); putc('='); prword(pcode); putln
heaprelease(pcode + (pcode + t_diskinfo)=>codeaddr) // REserve heap to end of buffer
seglen = fileio:read(ref, pcode, (pcode + t_diskinfo)=>codeaddr) seglen = fileio:read(ref, pcode, (pcode + t_diskinfo)=>codeaddr)
//puts("Read segment bytes: "); puti(seglen); putln //puts("Read segment bytes: "); puti(seglen); putln
fileio:close(ref) fileio:close(ref)
if !fp6502 and (MACHID & $F0 == $B0) // 128K Apple //e or //c if !fp6502 and (MACHID & $F0 == $B0) // 128K Apple //e or //c
seglen = fixup(AUXADDR, pcode + seglen - 2) - pcode seglen = fixup(AUXADDR, pcode + seglen - 2) - pcode
auxmove(AUXADDR, pcode, seglen) auxmove(AUXADDR, pcode, seglen)
heaprelease(pcode)
pcode = AUXADDR pcode = AUXADDR
else else
heaprelease(fixup(pcode, pcode + seglen - 2)) // Set heap to beginning of relocation list heaprelease(fixup(pcode, pcode + seglen - 2)) // Set heap to beginning of relocation list

46
src/makefile
View File

@ -4,12 +4,18 @@ PLVM = plvm
PLVMZP_APL = vmsrc/apple/plvmzp.inc PLVMZP_APL = vmsrc/apple/plvmzp.inc
PLVM01 = rel/apple/A1PLASMA\#060280 PLVM01 = rel/apple/A1PLASMA\#060280
PLVM02 = rel/apple/PLASMA.SYSTEM\#FF2000 PLVM02 = rel/apple/PLASMA.SYSTEM\#FF2000
PLVMJIT = rel/apple/PLASMAJIT.SYSTEM\#FF2000
PLVM802 = rel/apple/PLASMA16.SYSTEM\#FF2000 PLVM802 = rel/apple/PLASMA16.SYSTEM\#FF2000
PLVM03 = rel/apple/SOS.INTERP\#050000 PLVM03 = rel/apple/SOS.INTERP\#050000
SOSCMD = rel/apple/SOS.CMD\#FE1000
CMD = rel/apple/CMD\#061000 CMD = rel/apple/CMD\#061000
CMDJIT = rel/apple/CMDJIT\#061000
PLVMZP_C64 = vmsrc/c64/plvmzp.inc PLVMZP_C64 = vmsrc/c64/plvmzp.inc
PLVMC64 = rel/c64/PLASMA PLVMC64 = rel/c64/PLASMA
ED = rel/ED\#FE1000 ED = rel/ED\#FE1000
JIT = rel/apple/JIT\#FE1000
JIT16 = rel/apple/JIT16\#FE1000
JITUNE = rel/apple/JITUNE\#FE1000
SOS = rel/apple/SOS\#FE1000 SOS = rel/apple/SOS\#FE1000
ROD = rel/ROD\#FE1000 ROD = rel/ROD\#FE1000
SIEVE = rel/SIEVE\#FE1000 SIEVE = rel/SIEVE\#FE1000
@ -75,7 +81,7 @@ TXTTYPE = .TXT
#SYSTYPE = \#FF2000 #SYSTYPE = \#FF2000
#TXTTYPE = \#040000 #TXTTYPE = \#040000
apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(SOS) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(GRAFIX) $(GFXDEMO) $(DGR) $(DGRTEST) $(FILEIO_APL) $(CONIO_APL) $(JOYBUZZ) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ) apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM802) $(PLVM03) $(CMD) $(CMDJIT) $(JIT) $(JIT16) $(JITUNE) $(SOSCMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(SOS) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(GRAFIX) $(GFXDEMO) $(DGR) $(DGRTEST) $(FILEIO_APL) $(CONIO_APL) $(JOYBUZZ) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ)
-rm vmsrc/plvmzp.inc -rm vmsrc/plvmzp.inc
c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64) c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64)
@ -84,10 +90,8 @@ c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64)
all: apple c64 all: apple c64
clean: clean:
-rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03) -rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM03)
-rm rel/* -rm -rf rel
-rm rel/apple/*
-rm rel/c64/*
-rm samplesrc/*.o samplesrc/*~ samplesrc/*.a -rm samplesrc/*.o samplesrc/*~ samplesrc/*.a
-rm toolsrc/*.o toolsrc/*~ toolsrc/*.a -rm toolsrc/*.o toolsrc/*~ toolsrc/*.a
-rm toolsrc/apple/*.o toolsrc/apple/*~ toolsrc/apple/*.a -rm toolsrc/apple/*.o toolsrc/apple/*~ toolsrc/apple/*.a
@ -150,16 +154,27 @@ $(CMD): vmsrc/apple/cmd.pla vmsrc/apple/cmdstub.s $(PLVM02) $(PLASM)
./$(PLASM) -AOW < vmsrc/apple/cmd.pla > vmsrc/apple/cmd.a ./$(PLASM) -AOW < vmsrc/apple/cmd.pla > vmsrc/apple/cmd.a
acme --setpc 8192 -o $(CMD) vmsrc/apple/cmdstub.s acme --setpc 8192 -o $(CMD) vmsrc/apple/cmdstub.s
$(CMDJIT): vmsrc/apple/cmdjit.pla vmsrc/apple/cmdjitstub.s $(PLVMJIT) $(PLASM)
./$(PLASM) -AOW < vmsrc/apple/cmdjit.pla > vmsrc/apple/cmdjit.a
acme --setpc 8192 -o $(CMDJIT) vmsrc/apple/cmdjitstub.s
$(SOSCMD): vmsrc/apple/soscmd.pla libsrc/jitcore.pla $(PLVM03) $(PLASM)
./$(PLASM) -AMOW < vmsrc/apple/soscmd.pla > vmsrc/apple/soscmd.a
acme --setpc 4094 -o $(SOSCMD) vmsrc/apple/soscmd.a
$(PLVM02): vmsrc/apple/plvm02.s $(PLVM02): vmsrc/apple/plvm02.s
acme -o $(PLVM02) -l vmsrc/apple/plvm02.sym vmsrc/apple/plvm02.s acme -o $(PLVM02) -l vmsrc/apple/plvm02.sym vmsrc/apple/plvm02.s
$(PLVMJIT): vmsrc/apple/plvmjit02.s
acme -o $(PLVMJIT) -l vmsrc/apple/plvmjit02.sym vmsrc/apple/plvmjit02.s
$(PLVM802): vmsrc/apple/plvm802.s $(PLVM802): vmsrc/apple/plvm802.s
acme -o $(PLVM802) -l vmsrc/apple/plvm802.sym vmsrc/apple/plvm802.s acme -o $(PLVM802) -l vmsrc/apple/plvm802.sym vmsrc/apple/plvm802.s
vmsrc/apple/soscmd.a: vmsrc/apple/soscmd.pla $(PLASM) vmsrc/apple/sossys.a: vmsrc/apple/sossys.pla $(PLASM)
./$(PLASM) -AOW < vmsrc/apple/soscmd.pla > vmsrc/apple/soscmd.a ./$(PLASM) -AOW < vmsrc/apple/sossys.pla > vmsrc/apple/sossys.a
$(PLVM03): vmsrc/apple/plvm03.s vmsrc/apple/soscmd.a $(PLVM03): vmsrc/apple/plvm03.s vmsrc/apple/sossys.a
acme -o $(PLVM03) -l vmsrc/apple/plvm03.sym vmsrc/apple/plvm03.s acme -o $(PLVM03) -l vmsrc/apple/plvm03.sym vmsrc/apple/plvm03.s
# #
@ -348,7 +363,20 @@ $(MON): samplesrc/mon.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/mon.pla > samplesrc/mon.a ./$(PLASM) -AMOW < samplesrc/mon.pla > samplesrc/mon.a
acme --setpc 4094 -o $(MON) samplesrc/mon.a acme --setpc 4094 -o $(MON) samplesrc/mon.a
$(SOS): libsrc/apple/sos.pla $(PLVM02) $(PLASM) $(SOS): libsrc/apple/sos.pla $(PLVM03) $(PLASM)
./$(PLASM) -AMO < libsrc/apple/sos.pla > libsrc/apple/sos.a ./$(PLASM) -AMO < libsrc/apple/sos.pla > libsrc/apple/sos.a
acme --setpc 4094 -o $(SOS) libsrc/apple/sos.a acme --setpc 4094 -o $(SOS) libsrc/apple/sos.a
$(JIT): libsrc/apple/jit.pla libsrc/jitcore.pla $(PLVMJIT) $(PLASM)
./$(PLASM) -AMO < libsrc/apple/jit.pla > libsrc/apple/jit.a
acme --setpc 4094 -o $(JIT) libsrc/apple/jit.a
$(JIT16): libsrc/apple/jit16.pla libsrc/jit16core.pla $(PLVMJIT) $(PLASM)
./$(PLASM) -AMO < libsrc/apple/jit16.pla > libsrc/apple/jit16.a
acme --setpc 4094 -o $(JIT16) libsrc/apple/jit16.a
$(JITUNE): libsrc/apple/jitune.pla $(PLVMJIT) $(PLASM)
./$(PLASM) -AMO < libsrc/apple/jitune.pla > libsrc/apple/jitune.a
acme --setpc 4094 -o $(JITUNE) libsrc/apple/jitune.a

6
src/mkrel
View File

@ -1,7 +1,10 @@
cp rel/apple/CMD#061000 prodos/CMD.BIN cp rel/apple/CMD#061000 prodos/CMD.BIN
cp rel/apple/CMDJIT#061000 prodos/CMDJIT.BIN
cp rel/apple/PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS cp rel/apple/PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS
cp rel/apple/PLASMAJIT.SYSTEM#FF2000 prodos/PLIJIT.SYSTEM.SYS
cp rel/apple/PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS cp rel/apple/PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS
cp rel/apple/SOS.INTERP#050000 prodos/SOS.INTERP.\$05 cp rel/apple/SOS.INTERP#050000 prodos/SOS.INTERP.\$05
cp rel/apple/SOS.CMD#FE1000 prodos/SOS.CMD.REL
cp ../doc/Editor.md prodos/EDITOR.README.TXT cp ../doc/Editor.md prodos/EDITOR.README.TXT
rm -rf prodos/sys rm -rf prodos/sys
@ -29,6 +32,9 @@ cp rel/apple/UTHERNET#FE1000 prodos/sys/UTHERNET.REL
cp rel/apple/UTHERNET2#FE1000 prodos/sys/UTHERNET2.REL cp rel/apple/UTHERNET2#FE1000 prodos/sys/UTHERNET2.REL
cp rel/apple/SOS#FE1000 prodos/sys/SOS.REL cp rel/apple/SOS#FE1000 prodos/sys/SOS.REL
cp rel/apple/GRAFIX#FE1000 prodos/sys/GRAFIX.REL cp rel/apple/GRAFIX#FE1000 prodos/sys/GRAFIX.REL
cp rel/apple/JIT#FE1000 prodos/sys/JIT.REL
cp rel/apple/JIT16#FE1000 prodos/sys/JIT16.REL
cp rel/apple/JITUNE#FE1000 prodos/sys/JITUNE.REL
cp ../sysfiles/FP6502.CODE#060000 prodos/sys/FP6502.CODE.BIN cp ../sysfiles/FP6502.CODE#060000 prodos/sys/FP6502.CODE.BIN
cp ../sysfiles/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN cp ../sysfiles/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN

82
src/opstat Executable file
View File

@ -0,0 +1,82 @@
echo -n "CN "; grep -c '; CN' $1
echo -n "MINUS1 "; grep -c '; MINUS' $1
echo -n "BREQ "; grep -c '; BREQ' $1
echo -n "BRNE "; grep -c '; BRNE' $1
echo -n "LA "; grep -c '; LA' $1
echo -n "LLA "; grep -c '; LLA' $1
echo -n "CB "; grep -c '; CB' $1
echo -n "CW "; grep -c '; CW' $1
echo -n "CS "; grep -c '; CS' $1
echo -n "DROP "; grep -c '; DROP ' $1
echo -n "DROP2 "; grep -c '; DROP2' $1
echo -n "DUP "; grep -c '; DUP' $1
echo -n "DIVMOD "; grep -c '; DIVMOD' $1
echo -n "ADDI "; grep -c '; ADDI' $1
echo -n "SUBI "; grep -c '; SUBI' $1
echo -n "ANDI "; grep -c '; ANDI' $1
echo -n "ORI "; grep -c '; ORI' $1
echo -n "ISEQ "; grep -c '; ISEQ' $1
echo -n "ISNE "; grep -c '; ISNE' $1
echo -n "ISGT "; grep -c '; ISGT' $1
echo -n "ISLT "; grep -c '; ISLT' $1
echo -n "ISGE "; grep -c '; ISGE' $1
echo -n "ISLE "; grep -c '; ISLE' $1
echo -n "BRFLS "; grep -c '; BRFLS' $1
echo -n "BRTRU "; grep -c '; BRTRU' $1
echo -n "BRNCH "; grep -c '; BRNCH' $1
echo -n "SEL "; grep -c '; SEL' $1
echo -n "CALL "; grep -c '; CALL' $1
echo -n "ICAL "; grep -c '; ICAL' $1
echo -n "ENTER "; grep -c '; ENTER' $1
echo -n "LEAVE "; grep -c '; LEAVE' $1
echo -n "RET "; grep -c '; RET' $1
echo -n "CFFB "; grep -c '; CFFB' $1
echo -n "LB "; grep -c '; LB' $1
echo -n "LW "; grep -c '; LW' $1
echo -n "LLB "; grep -c '; LLB' $1
echo -n "LLW "; grep -c '; LLW' $1
echo -n "LAB "; grep -c '; LAB' $1
echo -n "LAW "; grep -c '; LAW' $1
echo -n "DLB "; grep -c '; DLB' $1
echo -n "DLW "; grep -c '; DLW' $1
echo -n "SB "; grep -c '; SB' $1
echo -n "SW "; grep -c '; SW' $1
echo -n "SLB "; grep -c '; SLB' $1
echo -n "SLW "; grep -c '; SLW' $1
echo -n "SAB "; grep -c '; SAB' $1
echo -n "SAW "; grep -c '; SAW' $1
echo -n "DAB "; grep -c '; DAB' $1
echo -n "DAW "; grep -c '; DAW' $1
echo -n "NOT "; grep -c '; NOT' $1
echo -n "ADD "; grep -c '; ADD ' $1
echo -n "SUB "; grep -c '; SUB ' $1
echo -n "MUL "; grep -c '; MUL' $1
echo -n "DIV "; grep -c '; DIV' $1
echo -n "MOD "; grep -c '; MOD' $1
echo -n "INCR "; grep -c '; INCR' $1
echo -n "DECR "; grep -c '; DECR' $1
echo -n "NEG "; grep -c '; NEG' $1
echo -n "COMP "; grep -c '; COMP' $1
echo -n "AND "; grep -c '; AND ' $1
echo -n "OR "; grep -c '; OR' $1
echo -n "XOR "; grep -c '; XOR' $1
echo -n "SHL "; grep -c '; SHL' $1
echo -n "SHR "; grep -c '; SHR' $1
echo -n "IDXW "; grep -c '; IDXW' $1
echo -n "BRGT "; grep -c '; BRGT' $1
echo -n "BRLT "; grep -c '; BRLT' $1
echo -n "INCBRLE "; grep -c '; INCBRLE' $1
echo -n "ADDBRLE "; grep -c '; ADDBRLE' $1
echo -n "DECBRGE "; grep -c '; DECBRGE' $1
echo -n "SUBBRGE "; grep -c '; SUBBRGE' $1
echo -n "BRAND "; grep -c '; BRAND' $1
echo -n "BROR "; grep -c '; BROR' $1
echo -n "ADDLB "; grep -c '; ADDLB' $1
echo -n "ADDLW "; grep -c '; ADDLW' $1
echo -n "ADDAB "; grep -c '; ADDAB' $1
echo -n "ADDAW "; grep -c '; ADDAW' $1
echo -n "IDXLB "; grep -c '; IDXLB' $1
echo -n "IDXLW "; grep -c '; IDXLW' $1
echo -n "IDXAB "; grep -c '; IDXAB' $1
echo -n "IDXAW "; grep -c '; IDXAW' $1

10
src/samplesrc/playseq.pla
View File

@ -6,8 +6,8 @@ include "inc/sndseq.plh"
// //
// These are utility sequences/routines needed to test the music sequencer code. // These are utility sequences/routines needed to test the music sequencer code.
// //
word arg word arg, seq, len
word ref byte ref
// //
// Sample background process to show it's working // Sample background process to show it's working
// //
@ -19,9 +19,11 @@ arg = argNext(argFirst)
if ^arg if ^arg
ref = fileio:open(arg) ref = fileio:open(arg)
if ref if ref
fileio:read(ref, heapmark(), heapavail()) seq = heapalloc(heapavail - 256)
len = fileio:read(ref, seq, heapmark - seq)
fileio:close(ref) fileio:close(ref)
musicPlay(heapmark(), TRUE) heaprelease(seq + len)
musicPlay(seq, TRUE)
musicGetKey(8, @backgroundProc) // Yield every 8/16 second musicGetKey(8, @backgroundProc) // Yield every 8/16 second
musicStop musicStop
else else

2
src/samplesrc/rod.pla
View File

@ -4,7 +4,7 @@ include "inc/conio.plh"
// Rod's Colors // Rod's Colors
// //
def rod def rod
var i, j, k, w, fmi, fmk, color byte i, j, k, w, fmi, fmk, color
while TRUE while TRUE
for w = 3 to 50 for w = 3 to 50

73
src/samplesrc/rogue.combat.pla
View File

@ -162,48 +162,47 @@ export def fight(player, enemy)
if toupper(conio:getkey()) == 'R' if toupper(conio:getkey()) == 'R'
conio:echo(ECHO_OFF) conio:echo(ECHO_OFF)
return 1 return 1
fin
//
// Turn player in random direction
//
player->angle = conio:rnd() & 7
//
// Calculate attack (with a little random variation)
//
p_atck = player->skill + player->energy / 10 - enemy->power / 25 + (conio:rnd() & 7)
e_atck = enemy->power - player->skill / 5 - player->energy / 20 + (conio:rnd() & 7)
if enemy->life > p_atck
enemy->life = enemy->life - p_atck
else else
win
enemy->life = 0
p_atck = player->skill + enemy->power / 3
if p_atck > 100 // Limit skill
p_atck = 100
fin
player->skill = p_atck
// //
// Turn player in random direction // Unlink dead enemy from entities list
// //
player->angle = conio:rnd() & 7 if enemy == entities
// entities = enemy=>next_other
// Calculate attack (with a little random variation) fin
// if enemy=>next_other
p_atck = player->skill + player->energy / 10 - enemy->power / 25 + (conio:rnd() & 7) enemy=>next_other=>prev_other = enemy=>prev_other
e_atck = enemy->power - player->skill / 5 - player->energy / 20 + (conio:rnd() & 7) fin
if enemy->life > p_atck if enemy=>prev_other
enemy->life = enemy->life - p_atck enemy=>prev_other=>next_other = enemy=>next_other
else fin
win
enemy->life = 0
p_atck = player->skill + enemy->power / 3
if p_atck > 100 // Limit skill
p_atck = 100
fin
player->skill = p_atck
//
// Unlink dead enemy from entities list
//
if enemy == entities
entities = enemy=>next_other
fin
if enemy=>next_other
enemy=>next_other=>prev_other = enemy=>prev_other
fin fin
if enemy=>prev_other if player->health > e_atck
enemy=>prev_other=>next_other = enemy=>next_other player->health = player->health - e_atck
else
player->energy = 0
player->health = 0
fin fin
fin if player->energy >= 4
if player->health > e_atck player->energy = player->energy - 4
player->health = player->health - e_atck
else
player->energy = 0
player->health = 0
fin
if player->energy >= 4
player->energy = player->energy - 4
fin
fin fin
until player->health == 0 or enemy->life == 0 until player->health == 0 or enemy->life == 0
conio:echo(ECHO_OFF) conio:echo(ECHO_OFF)

22
src/samplesrc/rogue.map.pla
View File

@ -260,8 +260,8 @@ end
// //
export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
byte o, l, dist, tile, adjtile, occluded, darkness byte l, dist, tile, adjtile, occluded, darkness
word ymap, xmap, imap word ymap, xmap, imap, o
byte yscr, xscr byte yscr, xscr
if viewdist > beamdepth if viewdist > beamdepth
@ -279,7 +279,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
// //
darkness = 1 darkness = 1
imap = (yorg << rowshift) + xorg imap = (yorg << rowshift) + xorg
if ^(map + imap) & LIT_TILE or lightdist if lightdist or ^(map + imap) & LIT_TILE
// //
// Update current spot in viewmap // Update current spot in viewmap
// //
@ -358,7 +358,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
// //
// Run through visible octant beam points // Run through visible octant beam points
// //
for l = l to dbeam[viewdist] for l = dbeam[lightdist]+1 to dbeam[viewdist]
// //
// Check parent visiblity // Check parent visiblity
// //
@ -429,7 +429,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0 vispix[l] = 0
fin fin
next next
for l = l to dbeam[viewdist] for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]] if vispix[vbeam[l]]
imap = ((yorg - xbeam[l]) << rowshift) + xorg + ybeam[l] imap = ((yorg - xbeam[l]) << rowshift) + xorg + ybeam[l]
tile = ^(map + imap) tile = ^(map + imap)
@ -479,7 +479,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0 vispix[l] = 0
fin fin
next next
for l = l to dbeam[viewdist] for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]] if vispix[vbeam[l]]
imap = ((yorg + xbeam[l]) << rowshift) + xorg + ybeam[l] imap = ((yorg + xbeam[l]) << rowshift) + xorg + ybeam[l]
tile = ^(map + imap) tile = ^(map + imap)
@ -529,7 +529,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0 vispix[l] = 0
fin fin
next next
for l = l to dbeam[viewdist] for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]] if vispix[vbeam[l]]
imap = ((yorg + ybeam[l]) << rowshift) + xorg + xbeam[l] imap = ((yorg + ybeam[l]) << rowshift) + xorg + xbeam[l]
tile = ^(map + imap) tile = ^(map + imap)
@ -579,7 +579,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0 vispix[l] = 0
fin fin
next next
for l = l to dbeam[viewdist] for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]] if vispix[vbeam[l]]
imap = ((yorg + ybeam[l]) << rowshift) + xorg - xbeam[l] imap = ((yorg + ybeam[l]) << rowshift) + xorg - xbeam[l]
tile = ^(map + imap) tile = ^(map + imap)
@ -629,7 +629,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0 vispix[l] = 0
fin fin
next next
for l = l to dbeam[viewdist] for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]] if vispix[vbeam[l]]
imap = ((yorg + xbeam[l]) << rowshift) + xorg - ybeam[l] imap = ((yorg + xbeam[l]) << rowshift) + xorg - ybeam[l]
tile = ^(map + imap) tile = ^(map + imap)
@ -679,7 +679,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0 vispix[l] = 0
fin fin
next next
for l = l to dbeam[viewdist] for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]] if vispix[vbeam[l]]
imap = ((yorg - xbeam[l]) << rowshift) + xorg - ybeam[l] imap = ((yorg - xbeam[l]) << rowshift) + xorg - ybeam[l]
tile = ^(map + imap) tile = ^(map + imap)
@ -729,7 +729,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0 vispix[l] = 0
fin fin
next next
for l = l to dbeam[viewdist] for l = dbeam[lightdist]+1 to dbeam[viewdist]
imap = ((yorg - ybeam[l]) << rowshift) + xorg - xbeam[l] imap = ((yorg - ybeam[l]) << rowshift) + xorg - xbeam[l]
if vispix[vbeam[l]] if vispix[vbeam[l]]
tile = ^(map + imap) tile = ^(map + imap)

44
src/samplesrc/sieve.pla
View File

@ -11,26 +11,30 @@ def beep#0
putc(7) putc(7)
end end
beep def sieve#0
//for iter = 1 to 10 beep
flag = heapalloc(sizepl) //for iter = 1 to 10
memset(flag, TRUE, sizepl) flag = heapalloc(sizepl)
count = 0 memset(flag, TRUE, sizepl)
for i = 0 to size count = 0
if flag->[i] for i = 0 to size
prime = i + i + 3 if flag->[i]
k = i + prime prime = i + i + 3
while k <= size k = i + prime
flag->[k] = FALSE while k <= size
k = k + prime flag->[k] = FALSE
loop k = k + prime
count = count + 1 loop
puti(prime) count = count + 1
putln puti(prime)
fin putln
next fin
//next next
beep //next
beep
end
sieve
puti(count) puti(count)
puts(" primes.\n") puts(" primes.\n")
done done

445
src/toolsrc/codegen.c
View File

@ -382,12 +382,13 @@ void emit_header(void)
} }
void emit_rld(void) void emit_rld(void)
{ {
int i; int i, j;
printf(";\n; RE-LOCATEABLE DICTIONARY\n;\n"); printf(";\n; RE-LOCATEABLE DICTIONARY\n;\n");
/* /*
* First emit the bytecode definition entrypoint information. * First emit the bytecode definition entrypoint information.
*/ */
/*
for (i = 0; i < globals; i++) for (i = 0; i < globals; i++)
if (!(idglobal_type[i] & EXTERN_TYPE) && (idglobal_type[i] & DEF_TYPE)) if (!(idglobal_type[i] & EXTERN_TYPE) && (idglobal_type[i] & DEF_TYPE))
{ {
@ -395,6 +396,14 @@ void emit_rld(void)
printf("\t%s\t_C%03d\t\t\n", DW, idglobal_tag[i]); printf("\t%s\t_C%03d\t\t\n", DW, idglobal_tag[i]);
printf("\t%s\t$00\n", DB); printf("\t%s\t$00\n", DB);
} }
*/
j = outflags & INIT ? defs - 1 : defs;
for (i = 0; i < j; i++)
{
printf("\t%s\t$02\t\t\t; CODE TABLE FIXUP\n", DB);
printf("\t%s\t_C%03d\t\t\n", DW, i);
printf("\t%s\t$00\n", DB);
}
/* /*
* Now emit the fixup table. * Now emit the fixup table.
*/ */
@ -600,8 +609,10 @@ void emit_codetag(int tag)
void emit_const(int cval) void emit_const(int cval)
{ {
emit_pending_seq(); emit_pending_seq();
if (cval == 0x0000) if ((cval & 0xFFFF) == 0xFFFF)
printf("\t%s\t$00\t\t\t; ZERO\n", DB); printf("\t%s\t$20\t\t\t; MINUS ONE\n", DB);
else if ((cval & 0xFFF0) == 0x0000)
printf("\t%s\t$%02X\t\t\t; CN\t%d\n", DB, cval*2, cval);
else if ((cval & 0xFF00) == 0x0000) else if ((cval & 0xFF00) == 0x0000)
printf("\t%s\t$2A,$%02X\t\t\t; CB\t%d\n", DB, cval, cval); printf("\t%s\t$2A,$%02X\t\t\t; CB\t%d\n", DB, cval, cval);
else if ((cval & 0xFF00) == 0xFF00) else if ((cval & 0xFF00) == 0xFF00)
@ -614,6 +625,26 @@ void emit_conststr(long conststr)
printf("\t%s\t$2E\t\t\t; CS\n", DB); printf("\t%s\t$2E\t\t\t; CS\n", DB);
emit_data(0, STRING_TYPE, conststr, 0); emit_data(0, STRING_TYPE, conststr, 0);
} }
void emit_addi(int cval)
{
emit_pending_seq();
printf("\t%s\t$38,$%02X\t\t\t; ADDI\t%d\n", DB, cval, cval);
}
void emit_subi(int cval)
{
emit_pending_seq();
printf("\t%s\t$3A,$%02X\t\t\t; SUBI\t%d\n", DB, cval, cval);
}
void emit_andi(int cval)
{
emit_pending_seq();
printf("\t%s\t$3C,$%02X\t\t\t; ANDI\t%d\n", DB, cval, cval);
}
void emit_ori(int cval)
{
emit_pending_seq();
printf("\t%s\t$3E,$%02X\t\t\t; ORI\t%d\n", DB, cval, cval);
}
void emit_lb(void) void emit_lb(void)
{ {
printf("\t%s\t$60\t\t\t; LB\n", DB); printf("\t%s\t$60\t\t\t; LB\n", DB);
@ -630,6 +661,22 @@ void emit_llw(int index)
{ {
printf("\t%s\t$66,$%02X\t\t\t; LLW\t[%d]\n", DB, index, index); printf("\t%s\t$66,$%02X\t\t\t; LLW\t[%d]\n", DB, index, index);
} }
void emit_addlb(int index)
{
printf("\t%s\t$B0,$%02X\t\t\t; ADDLB\t[%d]\n", DB, index, index);
}
void emit_addlw(int index)
{
printf("\t%s\t$B2,$%02X\t\t\t; ADDLW\t[%d]\n", DB, index, index);
}
void emit_idxlb(int index)
{
printf("\t%s\t$B8,$%02X\t\t\t; IDXLB\t[%d]\n", DB, index, index);
}
void emit_idxlw(int index)
{
printf("\t%s\t$BA,$%02X\t\t\t; IDXLW\t[%d]\n", DB, index, index);
}
void emit_lab(int tag, int offset, int type) void emit_lab(int tag, int offset, int type)
{ {
if (type) if (type)
@ -658,6 +705,62 @@ void emit_law(int tag, int offset, int type)
printf("\t%s\t$6A,$%02X,$%02X\t\t; LAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); printf("\t%s\t$6A,$%02X,$%02X\t\t; LAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset);
} }
} }
void emit_addab(int tag, int offset, int type)
{
if (type)
{
int fixup = fixup_new(tag, type, FIXUP_WORD);
char *taglbl = tag_string(tag, type);
printf("\t%s\t$B4\t\t\t; ADDAB\t%s+%d\n", DB, taglbl, offset);
printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
}
else
{
printf("\t%s\t$B4,$%02X,$%02X\t\t; ADDAB\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset);
}
}
void emit_addaw(int tag, int offset, int type)
{
if (type)
{
int fixup = fixup_new(tag, type, FIXUP_WORD);
char *taglbl = tag_string(tag, type);
printf("\t%s\t$B6\t\t\t; ADDAW\t%s+%d\n", DB, taglbl, offset);
printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
}
else
{
printf("\t%s\t$B6,$%02X,$%02X\t\t; ADDAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset);
}
}
void emit_idxab(int tag, int offset, int type)
{
if (type)
{
int fixup = fixup_new(tag, type, FIXUP_WORD);
char *taglbl = tag_string(tag, type);
printf("\t%s\t$BC\t\t\t; IDXAB\t%s+%d\n", DB, taglbl, offset);
printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
}
else
{
printf("\t%s\t$BC,$%02X,$%02X\t\t; IDXAB\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset);
}
}
void emit_idxaw(int tag, int offset, int type)
{
if (type)
{
int fixup = fixup_new(tag, type, FIXUP_WORD);
char *taglbl = tag_string(tag, type);
printf("\t%s\t$BE\t\t\t; IDXAW\t%s+%d\n", DB, taglbl, offset);
printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
}
else
{
printf("\t%s\t$BE,$%02X,$%02X\t\t; IDXAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset);
}
}
void emit_sb(void) void emit_sb(void)
{ {
printf("\t%s\t$70\t\t\t; SB\n", DB); printf("\t%s\t$70\t\t\t; SB\n", DB);
@ -747,11 +850,41 @@ void emit_globaladdr(int tag, int offset, int type)
} }
void emit_indexbyte(void) void emit_indexbyte(void)
{ {
printf("\t%s\t$02\t\t\t; IDXB\n", DB); printf("\t%s\t$82\t\t\t; IDXB\n", DB);
} }
void emit_indexword(void) void emit_indexword(void)
{ {
printf("\t%s\t$1E\t\t\t; IDXW\n", DB); printf("\t%s\t$9E\t\t\t; IDXW\n", DB);
}
void emit_select(int tag)
{
emit_pending_seq();
printf("\t%s\t$52\t\t\t; SEL\n", DB);
printf("\t%s\t_B%03d-*\n", DW, tag);
}
void emit_caseblock(int casecnt, int *caseof, int *casetag)
{
int i;
if (casecnt < 1 || casecnt > 256)
parse_error("Switch count under/overflow\n");
emit_pending_seq();
printf("\t%s\t$%02lX\t\t\t; CASEBLOCK\n", DB, casecnt & 0xFF);
for (i = 0; i < casecnt; i++)
{
printf("\t%s\t$%04lX\n", DW, caseof[i] & 0xFFFF);
printf("\t%s\t_B%03d-*\n", DW, casetag[i]);
}
}
void emit_breq(int tag)
{
printf("\t%s\t$22\t\t\t; BREQ\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag);
}
void emit_brne(int tag)
{
printf("\t%s\t$24\t\t\t; BRNE\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag);
} }
void emit_brfls(int tag) void emit_brfls(int tag)
{ {
@ -769,28 +902,52 @@ void emit_brnch(int tag)
printf("\t%s\t$50\t\t\t; BRNCH\t_B%03d\n", DB, tag); printf("\t%s\t$50\t\t\t; BRNCH\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag); printf("\t%s\t_B%03d-*\n", DW, tag);
} }
void emit_breq(int tag) void emit_brand(int tag)
{ {
emit_pending_seq(); emit_pending_seq();
printf("\t%s\t$3C\t\t\t; BREQ\t_B%03d\n", DB, tag); printf("\t%s\t$AC\t\t\t; BRAND\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag); printf("\t%s\t_B%03d-*\n", DW, tag);
} }
void emit_brne(int tag) void emit_bror(int tag)
{ {
emit_pending_seq(); emit_pending_seq();
printf("\t%s\t$3E\t\t\t; BRNE\t_B%03d\n", DB, tag); printf("\t%s\t$AE\t\t\t; BROR\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag); printf("\t%s\t_B%03d-*\n", DW, tag);
} }
void emit_brgt(int tag) void emit_brgt(int tag)
{ {
emit_pending_seq(); emit_pending_seq();
printf("\t%s\t$38\t\t\t; BRGT\t_B%03d\n", DB, tag); printf("\t%s\t$A0\t\t\t; BRGT\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag); printf("\t%s\t_B%03d-*\n", DW, tag);
} }
void emit_brlt(int tag) void emit_brlt(int tag)
{ {
emit_pending_seq(); emit_pending_seq();
printf("\t%s\t$3A\t\t\t; BRLT\t_B%03d\n", DB, tag); printf("\t%s\t$A2\t\t\t; BRLT\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag);
}
void emit_incbrle(int tag)
{
emit_pending_seq();
printf("\t%s\t$A4\t\t\t; INCBRLE\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag);
}
void emit_addbrle(int tag)
{
emit_pending_seq();
printf("\t%s\t$A6\t\t\t; ADDBRLE\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag);
}
void emit_decbrge(int tag)
{
emit_pending_seq();
printf("\t%s\t$A8\t\t\t; DECBRGE\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag);
}
void emit_subbrge(int tag)
{
emit_pending_seq();
printf("\t%s\t$AA\t\t\t; SUBBRGE\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag); printf("\t%s\t_B%03d-*\n", DW, tag);
} }
void emit_call(int tag, int type) void emit_call(int tag, int type)
@ -839,11 +996,17 @@ void emit_start(void)
void emit_drop(void) void emit_drop(void)
{ {
emit_pending_seq(); emit_pending_seq();
printf("\t%s\t$30\t\t\t; DROP\n", DB); printf("\t%s\t$30\t\t\t; DROP \n", DB);
}
void emit_drop2(void)
{
emit_pending_seq();
printf("\t%s\t$32\t\t\t; DROP2\n", DB);
} }
void emit_dup(void) void emit_dup(void)
{ {
printf("\t%s\t$32\t\t\t; DUP\n", DB); emit_pending_seq();
printf("\t%s\t$34\t\t\t; DUP\n", DB);
} }
int emit_unaryop(t_token op) int emit_unaryop(t_token op)
{ {
@ -851,19 +1014,19 @@ int emit_unaryop(t_token op)
switch (op) switch (op)
{ {
case NEG_TOKEN: case NEG_TOKEN:
printf("\t%s\t$10\t\t\t; NEG\n", DB); printf("\t%s\t$90\t\t\t; NEG\n", DB);
break; break;
case COMP_TOKEN: case COMP_TOKEN:
printf("\t%s\t$12\t\t\t; COMP\n", DB); printf("\t%s\t$92\t\t\t; COMP\n", DB);
break; break;
case LOGIC_NOT_TOKEN: case LOGIC_NOT_TOKEN:
printf("\t%s\t$20\t\t\t; NOT\n", DB); printf("\t%s\t$80\t\t\t; NOT\n", DB);
break; break;
case INC_TOKEN: case INC_TOKEN:
printf("\t%s\t$0C\t\t\t; INCR\n", DB); printf("\t%s\t$8C\t\t\t; INCR\n", DB);
break; break;
case DEC_TOKEN: case DEC_TOKEN:
printf("\t%s\t$0E\t\t\t; DECR\n", DB); printf("\t%s\t$8E\t\t\t; DECR\n", DB);
break; break;
case BPTR_TOKEN: case BPTR_TOKEN:
emit_lb(); emit_lb();
@ -883,34 +1046,34 @@ int emit_op(t_token op)
switch (op) switch (op)
{ {
case MUL_TOKEN: case MUL_TOKEN:
printf("\t%s\t$06\t\t\t; MUL\n", DB); printf("\t%s\t$86\t\t\t; MUL\n", DB);
break; break;
case DIV_TOKEN: case DIV_TOKEN:
printf("\t%s\t$08\t\t\t; DIV\n", DB); printf("\t%s\t$88\t\t\t; DIV\n", DB);
break; break;
case MOD_TOKEN: case MOD_TOKEN:
printf("\t%s\t$0A\t\t\t; MOD\n", DB); printf("\t%s\t$8A\t\t\t; MOD\n", DB);
break; break;
case ADD_TOKEN: case ADD_TOKEN:
printf("\t%s\t$02\t\t\t; ADD\n", DB); printf("\t%s\t$82\t\t\t; ADD \n", DB);
break; break;
case SUB_TOKEN: case SUB_TOKEN:
printf("\t%s\t$04\t\t\t; SUB\n", DB); printf("\t%s\t$84\t\t\t; SUB \n", DB);
break; break;
case SHL_TOKEN: case SHL_TOKEN:
printf("\t%s\t$1A\t\t\t; SHL\n", DB); printf("\t%s\t$9A\t\t\t; SHL\n", DB);
break; break;
case SHR_TOKEN: case SHR_TOKEN:
printf("\t%s\t$1C\t\t\t; SHR\n", DB); printf("\t%s\t$9C\t\t\t; SHR\n", DB);
break; break;
case AND_TOKEN: case AND_TOKEN:
printf("\t%s\t$14\t\t\t; AND\n", DB); printf("\t%s\t$94\t\t\t; AND \n", DB);
break; break;
case OR_TOKEN: case OR_TOKEN:
printf("\t%s\t$16\t\t\t; IOR\n", DB); printf("\t%s\t$96\t\t\t; OR \n", DB);
break; break;
case EOR_TOKEN: case EOR_TOKEN:
printf("\t%s\t$18\t\t\t; XOR\n", DB); printf("\t%s\t$98\t\t\t; XOR\n", DB);
break; break;
case EQ_TOKEN: case EQ_TOKEN:
printf("\t%s\t$40\t\t\t; ISEQ\n", DB); printf("\t%s\t$40\t\t\t; ISEQ\n", DB);
@ -930,12 +1093,6 @@ int emit_op(t_token op)
case LE_TOKEN: case LE_TOKEN:
printf("\t%s\t$4A\t\t\t; ISLE\n", DB); printf("\t%s\t$4A\t\t\t; ISLE\n", DB);
break; break;
case LOGIC_OR_TOKEN:
printf("\t%s\t$22\t\t\t; LOR\n", DB);
break;
case LOGIC_AND_TOKEN:
printf("\t%s\t$24\t\t\t; LAND\n", DB);
break;
case COMMA_TOKEN: case COMMA_TOKEN:
break; break;
default: default:
@ -1063,13 +1220,6 @@ int crunch_seq(t_opseq **seq, int pass)
freeops = 1; freeops = 1;
break; break;
} }
if (opnext->code == BINARY_CODE(SHL_TOKEN))
{
op->code = DUP_CODE;
opnext->code = BINARY_CODE(ADD_TOKEN);
crunched = 1;
break;
}
} }
switch (opnext->code) switch (opnext->code)
{ {
@ -1127,6 +1277,22 @@ int crunch_seq(t_opseq **seq, int pass)
freeops = 1; freeops = 1;
} }
break; break;
case BRGT_CODE:
if (opprev && (opprev->code == CONST_CODE) && (op->val <= opprev->val))
freeops = 1;
break;
case BRLT_CODE:
if (opprev && (opprev->code == CONST_CODE) && (op->val >= opprev->val))
freeops = 1;
break;
case BROR_CODE:
if (!op->val)
freeops = -2; // Remove zero constant
break;
case BRAND_CODE:
if (op->val)
freeops = -2; // Remove non-zero constant
break;
case NE_CODE: case NE_CODE:
if (!op->val) if (!op->val)
freeops = -2; // Remove ZERO:ISNE freeops = -2; // Remove ZERO:ISNE
@ -1206,20 +1372,64 @@ int crunch_seq(t_opseq **seq, int pass)
case BINARY_CODE(LE_TOKEN): case BINARY_CODE(LE_TOKEN):
op->val = op->val <= opnext->val ? 1 : 0; op->val = op->val <= opnext->val ? 1 : 0;
freeops = 2; freeops = 2;
break; break;
case BINARY_CODE(LOGIC_OR_TOKEN):
op->val = op->val || opnext->val ? 1 : 0;
freeops = 2;
break;
case BINARY_CODE(LOGIC_AND_TOKEN):
op->val = op->val && opnext->val ? 1 : 0;
freeops = 2;
break;
} }
// End of collapse constant operation // End of collapse constant operation
if ((pass > 0) && (freeops == 0) && (op->val != 0)) if ((pass > 0) && (freeops == 0) && (op->val != 0))
crunched = try_dupify(op); crunched = try_dupify(op);
break; // CONST_CODE break; // CONST_CODE
case BINARY_CODE(ADD_TOKEN):
if (op->val == 0)
{
freeops = -2;
}
else if (op->val > 0 && op->val <= 255)
{
op->code = ADDI_CODE;
freeops = 1;
}
else if (op->val >= -255 && op->val < 0)
{
op->code = SUBI_CODE;
op->val = -op->val;
freeops = 1;
}
break;
case BINARY_CODE(SUB_TOKEN):
if (op->val == 0)
{
freeops = -2;
}
else if (op->val > 0 && op->val <= 255)
{
op->code = SUBI_CODE;
freeops = 1;
}
else if (op->val >= -255 && op->val < 0)
{
op->code = ADDI_CODE;
op->val = -op->val;
freeops = 1;
}
break;
case BINARY_CODE(AND_TOKEN):
if (op->val >= 0 && op->val <= 255)
{
op->code = ANDI_CODE;
freeops = 1;
}
break;
case BINARY_CODE(OR_TOKEN):
if (op->val == 0)
{
freeops = -2;
}
else if (op->val > 0 && op->val <= 255)
{
op->code = ORI_CODE;
freeops = 1;
}
break;
case BINARY_CODE(MUL_TOKEN): case BINARY_CODE(MUL_TOKEN):
for (shiftcnt = 0; shiftcnt < 16; shiftcnt++) for (shiftcnt = 0; shiftcnt < 16; shiftcnt++)
{ {
@ -1325,7 +1535,17 @@ int crunch_seq(t_opseq **seq, int pass)
crunched = try_dupify(op); crunched = try_dupify(op);
break; // GADDR_CODE break; // GADDR_CODE
case LLB_CODE: case LLB_CODE:
if (pass > 0) if ((opnext->code == ADD_CODE) || (opnext->code == INDEXB_CODE))
{
op->code = ADDLB_CODE;
freeops = 1;
}
else if (opnext->code == INDEXW_CODE)
{
op->code = IDXLB_CODE;
freeops = 1;
}
else if (pass > 0)
crunched = try_dupify(op); crunched = try_dupify(op);
break; // LLB_CODE break; // LLB_CODE
case LLW_CODE: case LLW_CODE:
@ -1343,11 +1563,31 @@ int crunch_seq(t_opseq **seq, int pass)
} }
} }
} }
if ((pass > 0) && (freeops == 0)) else if ((opnext->code == ADD_CODE) || (opnext->code == INDEXB_CODE))
{
op->code = ADDLW_CODE;
freeops = 1;
}
else if (opnext->code == INDEXW_CODE)
{
op->code = IDXLW_CODE;
freeops = 1;
}
else if (pass > 0)
crunched = try_dupify(op); crunched = try_dupify(op);
break; // LLW_CODE break; // LLW_CODE
case LAB_CODE: case LAB_CODE:
if ((pass > 0) && (op->type || !is_hardware_address(op->offsz))) if ((opnext->code == ADD_CODE) || (opnext->code == INDEXB_CODE))
{
op->code = ADDAB_CODE;
freeops = 1;
}
else if (opnext->code == INDEXW_CODE)
{
op->code = IDXAB_CODE;
freeops = 1;
}
else if ((pass > 0) && (op->type || !is_hardware_address(op->offsz)))
crunched = try_dupify(op); crunched = try_dupify(op);
break; // LAB_CODE break; // LAB_CODE
case LAW_CODE: case LAW_CODE:
@ -1365,8 +1605,17 @@ int crunch_seq(t_opseq **seq, int pass)
} }
} }
} }
if ((pass > 0) && (freeops == 0) && else if ((opnext->code == ADD_CODE) || (opnext->code == INDEXB_CODE))
(op->type || !is_hardware_address(op->offsz))) {
op->code = ADDAW_CODE;
freeops = 1;
}
else if (opnext->code == INDEXW_CODE)
{
op->code = IDXAW_CODE;
freeops = 1;
}
else if ((pass > 0) && (op->type || !is_hardware_address(op->offsz)))
crunched = try_dupify(op); crunched = try_dupify(op);
break; // LAW_CODE break; // LAW_CODE
case LOGIC_NOT_CODE: case LOGIC_NOT_CODE:
@ -1384,6 +1633,36 @@ int crunch_seq(t_opseq **seq, int pass)
break; break;
} }
break; // LOGIC_NOT_CODE break; // LOGIC_NOT_CODE
case EQ_CODE:
switch (opnext->code)
{
case BRFALSE_CODE:
op->code = BRNE_CODE;
op->tag = opnext->tag;
freeops = 1;
break;
case BRTRUE_CODE:
op->code = BREQ_CODE;
op->tag = opnext->tag;
freeops = 1;
break;
}
break; // EQ_CODE
case NE_CODE:
switch (opnext->code)
{
case BRFALSE_CODE:
op->code = BREQ_CODE;
op->tag = opnext->tag;
freeops = 1;
break;
case BRTRUE_CODE:
op->code = BRNE_CODE;
op->tag = opnext->tag;
freeops = 1;
break;
}
break; // NE_CODE
case SLB_CODE: case SLB_CODE:
if ((opnext->code == LLB_CODE) && (op->offsz == opnext->offsz)) if ((opnext->code == LLB_CODE) && (op->offsz == opnext->offsz))
{ {
@ -1577,8 +1856,6 @@ int emit_pending_seq()
case LT_CODE: case LT_CODE:
case GT_CODE: case GT_CODE:
case LE_CODE: case LE_CODE:
case LOGIC_OR_CODE:
case LOGIC_AND_CODE:
emit_op(op->code); emit_op(op->code);
break; break;
case CONST_CODE: case CONST_CODE:
@ -1587,6 +1864,18 @@ int emit_pending_seq()
case STR_CODE: case STR_CODE:
emit_conststr(op->val); emit_conststr(op->val);
break; break;
case ADDI_CODE:
emit_addi(op->val);
break;
case SUBI_CODE:
emit_subi(op->val);
break;
case ANDI_CODE:
emit_andi(op->val);
break;
case ORI_CODE:
emit_ori(op->val);
break;
case LB_CODE: case LB_CODE:
emit_lb(); emit_lb();
break; break;
@ -1599,12 +1888,36 @@ int emit_pending_seq()
case LLW_CODE: case LLW_CODE:
emit_llw(op->offsz); emit_llw(op->offsz);
break; break;
case ADDLB_CODE:
emit_addlb(op->offsz);
break;
case ADDLW_CODE:
emit_addlw(op->offsz);
break;
case IDXLB_CODE:
emit_idxlb(op->offsz);
break;
case IDXLW_CODE:
emit_idxlw(op->offsz);
break;
case LAB_CODE: case LAB_CODE:
emit_lab(op->tag, op->offsz, op->type); emit_lab(op->tag, op->offsz, op->type);
break; break;
case LAW_CODE: case LAW_CODE:
emit_law(op->tag, op->offsz, op->type); emit_law(op->tag, op->offsz, op->type);
break; break;
case ADDAB_CODE:
emit_addab(op->tag, op->offsz, op->type);
break;
case ADDAW_CODE:
emit_addaw(op->tag, op->offsz, op->type);
break;
case IDXAB_CODE:
emit_idxab(op->tag, op->offsz, op->type);
break;
case IDXAW_CODE:
emit_idxaw(op->tag, op->offsz, op->type);
break;
case SB_CODE: case SB_CODE:
emit_sb(); emit_sb();
break; break;
@ -1662,12 +1975,30 @@ int emit_pending_seq()
case BRNCH_CODE: case BRNCH_CODE:
emit_brnch(op->tag); emit_brnch(op->tag);
break; break;
case BRAND_CODE:
emit_brand(op->tag);
break;
case BROR_CODE:
emit_bror(op->tag);
break;
case BREQ_CODE:
emit_breq(op->tag);
break;
case BRNE_CODE:
emit_brne(op->tag);
break;
case BRFALSE_CODE: case BRFALSE_CODE:
emit_brfls(op->tag); emit_brfls(op->tag);
break; break;
case BRTRUE_CODE: case BRTRUE_CODE:
emit_brtru(op->tag); emit_brtru(op->tag);
break; break;
case BRGT_CODE:
emit_brgt(op->tag);
break;
case BRLT_CODE:
emit_brlt(op->tag);
break;
case CODETAG_CODE: case CODETAG_CODE:
printf("_B%03d%c\n", op->tag, LBL); printf("_B%03d%c\n", op->tag, LBL);
break; break;

51
src/toolsrc/codegen.h
View File

@ -31,8 +31,6 @@ typedef struct _opseq {
#define LT_CODE (0x0200|LT_TOKEN) #define LT_CODE (0x0200|LT_TOKEN)
#define GT_CODE (0x0200|GT_TOKEN) #define GT_CODE (0x0200|GT_TOKEN)
#define LE_CODE (0x0200|LE_TOKEN) #define LE_CODE (0x0200|LE_TOKEN)
#define LOGIC_OR_CODE (0x0200|LOGIC_OR_TOKEN)
#define LOGIC_AND_CODE (0x0200|LOGIC_AND_TOKEN)
#define CONST_CODE 0x0300 #define CONST_CODE 0x0300
#define STR_CODE 0x0301 #define STR_CODE 0x0301
#define LB_CODE 0x0302 #define LB_CODE 0x0302
@ -59,11 +57,29 @@ typedef struct _opseq {
#define INDEXW_CODE 0x0317 #define INDEXW_CODE 0x0317
#define DROP_CODE 0x0318 #define DROP_CODE 0x0318
#define DUP_CODE 0x0319 #define DUP_CODE 0x0319
#define BRNCH_CODE 0x031C #define ADDI_CODE 0x031A
#define BRFALSE_CODE 0x031D #define SUBI_CODE 0x031B
#define BRTRUE_CODE 0x031E #define ANDI_CODE 0x031C
#define CODETAG_CODE 0x031F #define ORI_CODE 0x31D
#define NOP_CODE 0x0320 #define BRNCH_CODE 0x0320
#define BRFALSE_CODE 0x0321
#define BRTRUE_CODE 0x0322
#define BREQ_CODE 0x0323
#define BRNE_CODE 0x0324
#define BRAND_CODE 0x0325
#define BROR_CODE 0x0326
#define BRLT_CODE 0x0327
#define BRGT_CODE 0x0328
#define CODETAG_CODE 0x0329
#define NOP_CODE 0x032A
#define ADDLB_CODE 0x0330
#define ADDLW_CODE 0x0331
#define ADDAB_CODE 0x0332
#define ADDAW_CODE 0x0333
#define IDXLB_CODE 0x0334
#define IDXLW_CODE 0x0335
#define IDXAB_CODE 0x0336
#define IDXAW_CODE 0x0337
#define gen_uop(seq,op) gen_seq(seq,UNARY_CODE(op),0,0,0,0) #define gen_uop(seq,op) gen_seq(seq,UNARY_CODE(op),0,0,0,0)
#define gen_op(seq,op) gen_seq(seq,BINARY_CODE(op),0,0,0,0) #define gen_op(seq,op) gen_seq(seq,BINARY_CODE(op),0,0,0,0)
@ -79,6 +95,10 @@ typedef struct _opseq {
#define gen_sw(seq) gen_seq(seq,SW_CODE,0,0,0,0) #define gen_sw(seq) gen_seq(seq,SW_CODE,0,0,0,0)
#define gen_icall(seq) gen_seq(seq,ICAL_CODE,0,0,0,0) #define gen_icall(seq) gen_seq(seq,ICAL_CODE,0,0,0,0)
#define gen_drop(seq) gen_seq(seq,DROP_CODE,0,0,0,0) #define gen_drop(seq) gen_seq(seq,DROP_CODE,0,0,0,0)
#define gen_brand(seq,tag) gen_seq(seq,BRAND_CODE,0,tag,0,0)
#define gen_bror(seq,tag) gen_seq(seq,BROR_CODE,0,tag,0,0)
#define gen_brgt(seq,tag) gen_seq(seq,BRGT_CODE,0,tag,0,0)
#define gen_brlt(seq,tag) gen_seq(seq,BRLT_CODE,0,tag,0,0)
#define gen_brfls(seq,tag) gen_seq(seq,BRFALSE_CODE,0,tag,0,0) #define gen_brfls(seq,tag) gen_seq(seq,BRFALSE_CODE,0,tag,0,0)
#define gen_brtru(seq,tag) gen_seq(seq,BRTRUE_CODE,0,tag,0,0) #define gen_brtru(seq,tag) gen_seq(seq,BRTRUE_CODE,0,tag,0,0)
#define gen_brnch(seq,tag) gen_seq(seq,BRNCH_CODE,0,tag,0,0) #define gen_brnch(seq,tag) gen_seq(seq,BRNCH_CODE,0,tag,0,0)
@ -102,6 +122,10 @@ int emit_data(int vartype, int consttype, long constval, int constsize);
void emit_codetag(int tag); void emit_codetag(int tag);
void emit_const(int cval); void emit_const(int cval);
void emit_conststr(long conststr); void emit_conststr(long conststr);
void emit_addi(int cval);
void emit_subi(int cval);
void emit_andi(int cval);
void emit_ori(int cval);
void emit_lb(void); void emit_lb(void);
void emit_lw(void); void emit_lw(void);
void emit_llb(int index); void emit_llb(int index);
@ -126,14 +150,23 @@ void emit_indexbyte(void);
void emit_indexword(void); void emit_indexword(void);
int emit_unaryop(t_token op); int emit_unaryop(t_token op);
int emit_op(t_token op); int emit_op(t_token op);
void emit_select(int tag);
void emit_caseblock(int casecnt, int *caseof, int *casetag);
void emit_brand(int tag);
void emit_bror(int tag);
void emit_brtru(int tag); void emit_brtru(int tag);
void emit_brfls(int tag); void emit_brfls(int tag);
void emit_brgt(int tag);
void emit_brlt(int tag);
void emit_brne(int tag); void emit_brne(int tag);
void emit_brnch(int tag); void emit_brnch(int tag);
void emit_brgt(int tag);
void emit_brlt(int tag);
void emit_addbrle(int tag);
void emit_incbrle(int tag);
void emit_subbrge(int tag);
void emit_decbrge(int tag);
void emit_empty(void); void emit_empty(void);
void emit_drop(void); void emit_drop(void);
void emit_drop2(void);
void emit_dup(void); void emit_dup(void);
void emit_leave(void); void emit_leave(void);
void emit_ret(void); void emit_ret(void);

181
src/toolsrc/codegen.pla
View File

@ -132,8 +132,10 @@ def emit_codeseg#0
end end
def emit_const(cval)#0 def emit_const(cval)#0
emit_pending_seq emit_pending_seq
if cval == $0000 // ZERO if cval == $FFFF // MINUS ONE
emit_byte($00) emit_byte($20)
elsif cval & $FFF0 == $0000 // Constant NYBBLE
emit_byte(cval*2)
elsif cval & $FF00 == $0000 // Constant BYTE elsif cval & $FF00 == $0000 // Constant BYTE
emit_byte($2A) emit_byte($2A)
emit_byte(cval) emit_byte(cval)
@ -171,26 +173,67 @@ def emit_daw(tag, offset)#0
emit_byte($7E) emit_byte($7E)
emit_addr(tag, offset) emit_addr(tag, offset)
end end
def emit_brgt(tag)#0 def emit_select(tag)#0
emit_pending_seq emit_pending_seq
emit_byte($38) emit_byte($52)
emit_reladdr(tag) emit_reladdr(tag)
end end
def emit_brlt(tag)#0 def emit_caseblock(cnt, oflist, taglist)#0
byte i
if not cnt or cnt > 256; exit_err(ERR_OVER|ERR_STATE); fin
emit_pending_seq emit_pending_seq
emit_byte($3A) emit_byte(cnt)
emit_reladdr(tag) for i = 0 to cnt-1
end emit_word(oflist=>[i])
def emit_brne(tag)#0 emit_reladdr(taglist=>[i])
emit_pending_seq next
emit_byte($3E)
emit_reladdr(tag)
end end
def emit_branch(tag)#0 def emit_branch(tag)#0
emit_pending_seq emit_pending_seq
emit_byte($50) emit_byte($50)
emit_reladdr(tag) emit_reladdr(tag)
end end
def emit_brgt(tag)#0
emit_pending_seq
emit_byte($A0)
emit_reladdr(tag)
end
def emit_brlt(tag)#0
emit_pending_seq
emit_byte($A2)
emit_reladdr(tag)
end
def emit_incbrle(tag)#0
emit_pending_seq
emit_byte($A4)
emit_reladdr(tag)
end
def emit_addbrle(tag)#0
emit_pending_seq
emit_byte($A6)
emit_reladdr(tag)
end
def emit_decbrge(tag)#0
emit_pending_seq
emit_byte($A8)
emit_reladdr(tag)
end
def emit_subbrge(tag)#0
emit_pending_seq
emit_byte($AA)
emit_reladdr(tag)
end
def emit_brand(tag)#0
emit_pending_seq
emit_byte($AC)
emit_reladdr(tag)
end
def emit_bror(tag)#0
emit_pending_seq
emit_byte($AE)
emit_reladdr(tag)
end
def emit_leave#0 def emit_leave#0
emit_pending_seq emit_pending_seq
if framesize if framesize
@ -266,8 +309,11 @@ def emit_pending_seq#0
// //
is CONST_GROUP is CONST_GROUP
if op->opcode == CONST_CODE if op->opcode == CONST_CODE
if op=>opval == $0000 // ZERO if op=>opval == $FFFF // MINUS 1
^codeptr = $00 ^codeptr = $20
codeptr++
elsif op=>opval & $FFF0 == $0000 // Constant NYBBLE
^codeptr = op->opval*2
codeptr++ codeptr++
elsif op=>opval & $FF00 == $0000 // Constant BYTE elsif op=>opval & $FF00 == $0000 // Constant BYTE
*codeptr = $2A | (op->opval << 8) *codeptr = $2A | (op->opval << 8)
@ -280,6 +326,9 @@ def emit_pending_seq#0
codeptr=>1 = op=>opval codeptr=>1 = op=>opval
codeptr = codeptr + 3 codeptr = codeptr + 3
fin fin
else
*codeptr = op->opcode | (op->opval << 8) // IMMEDIATE BYTE OP
codeptr = codeptr + 2
fin fin
break break
// //
@ -382,9 +431,10 @@ def idmatch(nameptr, len, idptr, idcnt)
while idcnt while idcnt
if len == idptr->idname if len == idptr->idname
for i = 1 to len i = 1; while i <= len and nameptr->[i - 1] == idptr->idname.[i]; i++; loop
if nameptr->[i - 1] <> idptr->idname.[i]; break; fin //for i = 1 to len
next // if nameptr->[i - 1] <> idptr->idname.[i]; break; fin
//next
if i > len; return idptr; fin if i > len; return idptr; fin
fin fin
idptr = idptr + idptr->idname + t_id idptr = idptr + idptr->idname + t_id
@ -479,11 +529,13 @@ def init_idglobal#0
word op word op
word i word i
dfd_num = DFDNUM
tag_num = TAGNUM tag_num = TAGNUM
fixup_num = FIXUPNUM fixup_num = FIXUPNUM
globalbufsz = IDGLOBALSZ globalbufsz = IDGLOBALSZ
localbufsz = IDLOCALSZ localbufsz = IDLOCALSZ
if isult(heapavail, $8000) if isult(heapavail, $4000)
dfd_num = DFDNUM/2
tag_num = TAGNUM/2 tag_num = TAGNUM/2
fixup_num = FIXUPNUM/2 fixup_num = FIXUPNUM/2
globalbufsz = IDGLOBALSZ globalbufsz = IDGLOBALSZ
@ -502,6 +554,7 @@ def init_idglobal#0
// //
// Allocate remaining buffers // Allocate remaining buffers
// //
dfd_tag = heapalloc(dfd_num*2)
tag_addr = heapalloc(tag_num*2) tag_addr = heapalloc(tag_num*2)
tag_type = heapalloc(tag_num) tag_type = heapalloc(tag_num)
fixup_tag = heapalloc(fixup_num*2) fixup_tag = heapalloc(fixup_num*2)
@ -534,13 +587,15 @@ def save_idlocal#0
savelocals = locals savelocals = locals
savesize = framesize savesize = framesize
savelast = lastlocal savelast = lastlocal
memcpy(heapmark, idlocal_tbl, lastlocal - idlocal_tbl) savetbl = heapalloc(lastlocal - idlocal_tbl)
memcpy(savetbl, idlocal_tbl, lastlocal - idlocal_tbl)
end end
def restore_idlocal#0 def restore_idlocal#0
locals = savelocals locals = savelocals
framesize = savesize framesize = savesize
lastlocal = savelast lastlocal = savelast
memcpy(idlocal_tbl, heapmark, lastlocal - idlocal_tbl) memcpy(idlocal_tbl, savetbl, lastlocal - idlocal_tbl)
heaprelease(savetbl)
end end
// //
// Module dependency list // Module dependency list
@ -554,6 +609,14 @@ def new_moddep(nameptr, len)#0
if moddep_cnt > MODDEPNUM; parse_warn("Module dependency overflow"); fin if moddep_cnt > MODDEPNUM; parse_warn("Module dependency overflow"); fin
end end
// //
// DFD list
//
def new_dfd(tag)#0
if dfd_cnt >= dfd_num; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin
dfd_tag=>[dfd_cnt] = tag
dfd_cnt++
end
//
// Generate/add to a sequence of code // Generate/add to a sequence of code
// //
def gen_op(seq, code) def gen_op(seq, code)
@ -690,15 +753,15 @@ def gen_uop(seq, tkn)
fin fin
when tkn when tkn
is NEG_TKN is NEG_TKN
code = $10; break code = $90; break
is COMP_TKN is COMP_TKN
code = $12; break code = $92; break
is LOGIC_NOT_TKN is LOGIC_NOT_TKN
code = $20; break code = $80; break
is INC_TKN is INC_TKN
code = $0C; break code = $8C; break
is DEC_TKN is DEC_TKN
code = $0E; break code = $8E; break
is BPTR_TKN is BPTR_TKN
code = $60; break code = $60; break
is WPTR_TKN is WPTR_TKN
@ -725,25 +788,25 @@ def gen_bop(seq, tkn)
fin fin
when tkn when tkn
is MUL_TKN is MUL_TKN
code = $06; break code = $86; break
is DIV_TKN is DIV_TKN
code = $08; break code = $88; break
is MOD_TKN is MOD_TKN
code = $0A; break code = $8A; break
is ADD_TKN is ADD_TKN
code = $02; break code = $82; break
is SUB_TKN is SUB_TKN
code = $04; break code = $84; break
is SHL_TKN is SHL_TKN
code = $1A; break code = $9A; break
is SHR_TKN is SHR_TKN
code = $1C; break code = $9C; break
is AND_TKN is AND_TKN
code = $14; break code = $94; break
is OR_TKN is OR_TKN
code = $16; break code = $96; break
is EOR_TKN is EOR_TKN
code = $18; break code = $98; break
is EQ_TKN is EQ_TKN
code = $40; break code = $40; break
is NE_TKN is NE_TKN
@ -756,10 +819,6 @@ def gen_bop(seq, tkn)
code = $44; break code = $44; break
is LE_TKN is LE_TKN
code = $4A; break code = $4A; break
is LOGIC_OR_TKN
code = $22; break
is LOGIC_AND_TKN
code = $24; break
otherwise otherwise
exit_err(ERR_INVAL|ERR_SYNTAX) exit_err(ERR_INVAL|ERR_SYNTAX)
wend wend
@ -824,30 +883,34 @@ end
// Write DeFinition Directory // Write DeFinition Directory
// //
def writeDFD(refnum, modfix)#0 def writeDFD(refnum, modfix)#0
word dfd, idptr, idcnt word dfd, idptr, cnt
byte defdir[128] byte defdir[128]
dfd, idptr, idcnt = @defdir, idglobal_tbl, globals dfd = @defdir
while idcnt for cnt = 0 to dfd_cnt-1
if idptr=>idtype & (FUNC_TYPE|EXTERN_TYPE) == FUNC_TYPE //dfd, idptr, cnt = @defdir, idglobal_tbl, globals
//while cnt
//if idptr=>idtype & (FUNC_TYPE|EXTERN_TYPE) == FUNC_TYPE
dfd->0 = $02 dfd->0 = $02
dfd=>1 = tag_addr=>[idptr=>idval] + modfix dfd=>1 = tag_addr=>[dfd_tag=>[cnt]] + modfix
dfd->3 = 0 dfd->3 = 0
dfd = dfd + 4 dfd = dfd + 4
fin //fin
idptr = idptr + idptr->idname + t_id //idptr = idptr + idptr->idname + t_id
idcnt-- //cnt--
loop //loop
next
fileio:write(refnum, @defdir, dfd - @defdir) fileio:write(refnum, @defdir, dfd - @defdir)
end end
// //
// Build External Symbol Directory on heap // Build External Symbol Directory on heap
// //
def buildESD(modfix)#2 def buildESD(modfix)#2
word modofst, esd, idptr, idcnt, len word modofst, esdtbl, esd, idptr, idcnt, len
byte symnum byte symnum
symnum, esd, idptr, idcnt = 0, heapmark, idglobal_tbl, globals symnum, esdtbl, idptr, idcnt = 0, heapalloc(heapavail - 256), idglobal_tbl, globals
esd = esdtbl
while idcnt while idcnt
if idptr=>idtype & EXPORT_TYPE if idptr=>idtype & EXPORT_TYPE
esd = esd + stodci(@idptr->idname, esd) esd = esd + stodci(@idptr->idname, esd)
@ -866,26 +929,27 @@ def buildESD(modfix)#2
idcnt-- idcnt--
loop loop
^esd = 0 ^esd = 0
len = esd - heapmark + 1 len = esd - esdtbl + 1
esd = heapalloc(len) heaprelease(esdtbl + len)
return esd, len return esdtbl, len
end end
// //
// Write ReLocation Directory // Write ReLocation Directory
// //
def writeRLD(refnum, modofst)#0 def writeRLD(refnum, modofst)#0
word rld, rldlen, fixups, updtptr, idptr, idcnt, tag word rldtbl, rld, rldlen, fixups, updtptr, idptr, idcnt, tag
byte type byte type
rld = heapmark rldtbl = heapalloc(heapavail - 256)
rld = rldtbl
rldlen = 0 rldlen = 0
for fixups = fixup_cnt-1 downto 0 for fixups = fixup_cnt-1 downto 0
tag = fixup_tag=>[fixups] tag = fixup_tag=>[fixups]
type = tag_type->[tag] type = tag_type->[tag]
if not (type & RELATIVE_FIXUP) if not (type & RELATIVE_FIXUP)
if rldlen == 64 // Write out blocks of entries if rldlen == 64 // Write out blocks of entries
fileio:write(refnum, heapmark, rld - heapmark) fileio:write(refnum, rldtbl, rld - rldtbl)
rld = heapmark rld = rldtbl
rldlen = 0 rldlen = 0
fin fin
if type & EXTERN_FIXUP if type & EXTERN_FIXUP
@ -907,7 +971,8 @@ def writeRLD(refnum, modofst)#0
fin fin
next next
^rld = 0 ^rld = 0
fileio:write(refnum, heapmark, rld - heapmark + 1) fileio:write(refnum, rldtbl, rld - rldtbl + 1)
heaprelease(rldtbl)
end end
// //
// Write Extended REL file // Write Extended REL file

199
src/toolsrc/codeopt.pla
View File

@ -79,13 +79,6 @@ def crunch_seq(seq, pass)
freeops = 1 freeops = 1
break break
fin fin
if nextop->opcode == SHL_CODE
op->opcode = DUP_CODE
op->opgroup = STACK_GROUP
nextop->opcode = ADD_CODE
crunched = 1
break
fin
fin fin
when nextop->opcode when nextop->opcode
is NEG_CODE is NEG_CODE
@ -120,6 +113,26 @@ def crunch_seq(seq, pass)
freeops = 1 freeops = 1
fin fin
break break
is BRGT_CODE
if opprev and (opprev->opcode == CONST_CODE) and (op=>opval <= opprev=>opval)
freeops = 1
fin
break
is BRLT_CODE
if opprev and (opprev->opcode == CONST_CODE) and (op=>opval >= opprev=>opval)
freeops = 1
fin
break
is BROR_CODE
if not op=>opval
freeops = -2 // Remove zero constant
fin
break
is BRAND_CODE
if op=>opval
freeops = -2 // Remove non-zero constant
fin
break
is NE_CODE is NE_CODE
if not op=>opval if not op=>opval
freeops = -2 // Remove ZERO:ISNE freeops = -2 // Remove ZERO:ISNE
@ -129,7 +142,7 @@ def crunch_seq(seq, pass)
if not op=>opval if not op=>opval
op->opcode = LOGIC_NOT_CODE // Replace ZERO:ISEQ op->opcode = LOGIC_NOT_CODE // Replace ZERO:ISEQ
op->opgroup = STACK_GROUP op->opgroup = STACK_GROUP
freeops = 1 freeops = 1
fin fin
break break
is CONST_CODE // Collapse constant operation is CONST_CODE // Collapse constant operation
@ -200,20 +213,50 @@ def crunch_seq(seq, pass)
op=>opval = op=>opval <= nextop=>opval op=>opval = op=>opval <= nextop=>opval
freeops = 2 freeops = 2
break break
is LOGIC_OR_CODE
op=>opval = op=>opval or nextop=>opval
freeops = 2
break
is LOGIC_AND_CODE
op=>opval = op=>opval and nextop=>opval
freeops = 2
break
wend // End of collapse constant operation wend // End of collapse constant operation
fin fin
if pass and not freeops and op=>opval if pass and not freeops and op=>opval
crunched = try_dupify(op) crunched = try_dupify(op)
fin fin
break // CONST_CODE break // CONST_CODE
is ADD_CODE
if op=>opval == 0
freeops = -2
elsif op=>opval > 0 and op=>opval <= 255
op->opcode = ADDI_CODE
freeops = 1
elsif op=>opval >= -255 and op=>opval < 0
op->opcode = SUBI_CODE
op=>opval = -op=>opval
freeops = 1
fin
break
is SUB_CODE
if op=>opval == 0
freeops = -2
elsif op=>opval > 0 and op=>opval <= 255
op->opcode = SUBI_CODE
freeops = 1
elsif op=>opval >= -255 and op=>opval < 0
op->opcode = ADDI_CODE
op=>opval = -op=>opval
freeops = 1
fin
break
is AND_CODE
if op=>opval >= 0 and op=>opval <= 255
op->opcode = ANDI_CODE
freeops = 1
fin
break
is OR_CODE
if op=>opval == 0
freeops = -2
elsif op=>opval > 0 and op=>opval <= 255
op->opcode = ORI_CODE
freeops = 1
fin
break
is MUL_CODE is MUL_CODE
for shiftcnt = 0 to 15 for shiftcnt = 0 to 15
if op=>opval == 1 << shiftcnt if op=>opval == 1 << shiftcnt
@ -240,7 +283,7 @@ def crunch_seq(seq, pass)
if nextop=>opnext if nextop=>opnext
nextopnext = nextop=>opnext nextopnext = nextop=>opnext
when nextopnext->opcode when nextopnext->opcode
is INDEXB_CODE // ADD_CODE is ADD_CODE // INDEXB_CODE
op=>opoffset = op=>opoffset + nextop=>opval op=>opoffset = op=>opoffset + nextop=>opval
freeops = 2 freeops = 2
break break
@ -278,7 +321,7 @@ def crunch_seq(seq, pass)
if nextop=>opnext if nextop=>opnext
nextopnext = nextop=>opnext nextopnext = nextop=>opnext
when nextopnext->opcode when nextopnext->opcode
is INDEXB_CODE // ADD_CODE is ADD_CODE // INDEXB_CODE
op=>opoffset = op=>opoffset + nextop=>opval op=>opoffset = op=>opoffset + nextop=>opval
freeops = 2 freeops = 2
break break
@ -315,45 +358,85 @@ def crunch_seq(seq, pass)
fin fin
break // GADDR_CODE break // GADDR_CODE
is LLB_CODE is LLB_CODE
if pass when nextop->opcode
is ADD_CODE // INDEXB_CODE
op->opcode = ADDLB_CODE
freeops = 1
break
is INDEXW_CODE
op->opcode = IDXLB_CODE
freeops = 1
break
wend
if pass and not freeops
crunched = try_dupify(op) crunched = try_dupify(op)
fin fin
break // LLB_CODE break // LLB_CODE
is LLW_CODE is LLW_CODE
// LLW [n]:CB 8:SHR -> LLB [n+1] when nextop->opcode
if nextop->opcode == CONST_CODE and nextop=>opval == 8 is ADD_CODE // INDEXB_CODE
if nextop=>opnext op->opcode = ADDLW_CODE
nextopnext = nextop=>opnext freeops = 1
if nextopnext->opcode == SHR_CODE break
op->opcode = LLB_CODE is INDEXW_CODE
op=>opoffset++ op->opcode = IDXLW_CODE
freeops = 2 freeops = 1
break break
is CONST_CODE
// LLW [n]:CB 8:SHR -> LLB [n+1]
if nextop=>opval == 8 and nextop=>opnext
nextopnext = nextop=>opnext
if nextopnext->opcode == SHR_CODE
op->opcode = LLB_CODE
op=>opoffset++
freeops = 2
break
fin
fin fin
fin break
fin wend
if pass and not freeops if pass and not freeops
crunched = try_dupify(op) crunched = try_dupify(op)
fin fin
break // LLW_CODE break // LLW_CODE
is LAB_CODE is LAB_CODE
if pass and not is_hardware_address(op=>opoffset) when nextop->opcode
is ADD_CODE // INDEXB_CODE
op->opcode = ADDAB_CODE
freeops = 1
break
is INDEXW_CODE
op->opcode = IDXAB_CODE
freeops = 1
break
wend
if pass and not freeops and not is_hardware_address(op=>opoffset)
crunched = try_dupify(op) crunched = try_dupify(op)
fin fin
break // LAB_CODE break // LAB_CODE
is LAW_CODE is LAW_CODE
// LAW x:CB 8:SHR -> LAB x+1 when nextop->opcode
if nextop->opcode == CONST_CODE and nextop=>opval == 8 is ADD_CODE // INDEXB_CODE
if nextop=>opnext op->opcode = ADDAW_CODE
nextopnext = nextop=>opnext freeops = 1
if nextopnext->opcode == SHR_CODE break
op->opcode = LAB_CODE is INDEXW_CODE
op=>opoffset++ op->opcode = IDXAW_CODE
freeops = 2 freeops = 1
break break
is CONST_CODE
// LLW [n]:CB 8:SHR -> LLB [n+1]
if nextop=>opval == 8 and nextop=>opnext
nextopnext = nextop=>opnext
if nextopnext->opcode == SHR_CODE
op->opcode = LAB_CODE
op=>opoffset++
freeops = 2
break
fin
fin fin
fin break
fin wend
if pass and not freeops and not is_hardware_address(op=>opoffset) if pass and not freeops and not is_hardware_address(op=>opoffset)
crunched = try_dupify(op) crunched = try_dupify(op)
fin fin
@ -374,6 +457,38 @@ def crunch_seq(seq, pass)
break break
wend wend
break // LOGIC_NOT_CODE break // LOGIC_NOT_CODE
is EQ_CODE
when nextop->opcode
is BRFALSE_CODE
op->opcode = BRNE_CODE
op->opgroup = RELATIVE_GROUP
op=>optag = nextop=>optag
freeops = 1
break
is BRTRUE_CODE
op->opcode = BREQ_CODE
op->opgroup = RELATIVE_GROUP
op=>optag = nextop=>optag
freeops = 1
break
wend
break // EQ_CODE
is NE_CODE
when nextop->opcode
is BRFALSE_CODE
op->opcode = BREQ_CODE
op->opgroup = RELATIVE_GROUP
op=>optag = nextop=>optag
freeops = 1
break
is BRTRUE_CODE
op->opcode = BRNE_CODE
op->opgroup = RELATIVE_GROUP
op=>optag = nextop=>optag
freeops = 1
break
wend
break // NE_CODE
is SLB_CODE is SLB_CODE
if nextop->opcode == LLB_CODE and op=>opoffset == nextop=>opoffset if nextop->opcode == LLB_CODE and op=>opoffset == nextop=>opoffset
op->opcode = DLB_CODE op->opcode = DLB_CODE

57
src/toolsrc/codeseq.plh
View File

@ -3,33 +3,36 @@
// //
const CONST_GROUP = $00 const CONST_GROUP = $00
const CONST_CODE = $2C const CONST_CODE = $2C
const ADDI_CODE = $38
const SUBI_CODE = $3A
const ANDI_CODE = $3C
const ORI_CODE = $3E
const CONSTR_GROUP = $01 const CONSTR_GROUP = $01
const CONSTR_CODE = $2E const CONSTR_CODE = $2E
// //
// Stack code group // Stack code group
// //
const STACK_GROUP = $02 const STACK_GROUP = $02
const INDEXB_CODE = $02 const INDEXB_CODE = $82
const ADD_CODE = $02 const ADD_CODE = $82
const SUB_CODE = $04 const SUB_CODE = $84
const MUL_CODE = $06 const MUL_CODE = $86
const DIV_CODE = $08 const DIV_CODE = $88
const MOD_CODE = $0A const MOD_CODE = $8A
const INC_CODE = $0C const INC_CODE = $8C
const DEC_CODE = $0E const DEC_CODE = $8E
const NEG_CODE = $10 const NEG_CODE = $90
const COMP_CODE = $12 const COMP_CODE = $92
const AND_CODE = $14 const AND_CODE = $94
const OR_CODE = $16 const OR_CODE = $96
const EOR_CODE = $18 const EOR_CODE = $98
const SHL_CODE = $1A const SHL_CODE = $9A
const SHR_CODE = $1C const SHR_CODE = $9C
const INDEXW_CODE = $1E const INDEXW_CODE = $9E
const LOGIC_NOT_CODE = $20 const LOGIC_NOT_CODE = $80
const LOGIC_OR_CODE = $22
const LOGIC_AND_CODE = $24
const DROP_CODE = $30 const DROP_CODE = $30
const DUP_CODE = $32 const DROP2_CODE = $32
const DUP_CODE = $34
const EQ_CODE = $40 const EQ_CODE = $40
const NE_CODE = $42 const NE_CODE = $42
const GT_CODE = $44 const GT_CODE = $44
@ -55,6 +58,10 @@ const DLB_CODE = $6C
const DLW_CODE = $6E const DLW_CODE = $6E
const SLB_CODE = $74 const SLB_CODE = $74
const SLW_CODE = $76 const SLW_CODE = $76
const ADDLB_CODE = $B0
const ADDLW_CODE = $B2
const IDXLB_CODE = $B8
const IDXLW_CODE = $BA
// //
// Global address code group // Global address code group
// //
@ -67,13 +74,23 @@ const SAB_CODE = $78
const SAW_CODE = $7A const SAW_CODE = $7A
const DAB_CODE = $7C const DAB_CODE = $7C
const DAW_CODE = $7E const DAW_CODE = $7E
const ADDAB_CODE = $B4
const ADDAW_CODE = $B6
const IDXAB_CODE = $BC
const IDXAW_CODE = $BE
// //
// Relative address code group // Relative address code group
// //
const RELATIVE_GROUP = $05 const RELATIVE_GROUP = $05
const BREQ_CODE = $22
const BRNE_CODE = $24
const BRFALSE_CODE = $4C const BRFALSE_CODE = $4C
const BRTRUE_CODE = $4E const BRTRUE_CODE = $4E
const BRNCH_CODE = $50 const BRNCH_CODE = $50
const BRAND_CODE = $AC
const BROR_CODE = $AE
const BRGT_CODE = $A0
const BRLT_CODE = $A2
// //
// Code tag address group // Code tag address group
// //

95
src/toolsrc/ed.pla
View File

@ -7,6 +7,7 @@
include "inc/cmdsys.plh" include "inc/cmdsys.plh"
include "inc/args.plh" include "inc/args.plh"
include "inc/fileio.plh" include "inc/fileio.plh"
sysflags nojitc // Keep JITC from compiling and pausing while editing
// //
// Hardware constants // Hardware constants
// //
@ -169,8 +170,8 @@ def sizemask(size)
return 0 return 0
end end
def strpoolalloc(size) def strpoolalloc(size)
byte szmask, i byte szmask
word mapmask, addr word mapmask, addr, i
szmask = sizemask(size) szmask = sizemask(size)
for i = strplmapsize - 1 downto 0 for i = strplmapsize - 1 downto 0
@ -357,14 +358,13 @@ def writetxt(filename)#0
// //
// Remove blank lines at end of text. // Remove blank lines at end of text.
// //
while numlines > 1 and strlinbuf=>[numlines - 1] == @nullstr; numlines = numlines - 1; loop while numlines > 1 and strlinbuf=>[numlines - 1] == @nullstr; numlines--; loop
// //
// Write all the text line to the file. // Write all the text line to the file.
// //
for i = 0 to numlines - 1 for i = 0 to numlines - 1
cpyln(strlinbuf=>[i], @txtbuf) cpyln(strlinbuf=>[i], @txtbuf)
txtbuf = txtbuf + 1 txtbuf++; txtbuf[txtbuf] = $0D // Add CR to end of line
txtbuf[txtbuf] = $0D
fileio:write(refnum, @txtbuf + 1, txtbuf) fileio:write(refnum, @txtbuf + 1, txtbuf)
if !(i & $0F); putc('.'); fin if !(i & $0F); putc('.'); fin
next next
@ -503,7 +503,7 @@ end
def pgup#0 def pgup#0
byte i byte i
for i = pgjmp downto 0 for i = 0 to pgjmp
cursup cursup
next next
end end
@ -523,7 +523,7 @@ end
def pgdown#0 def pgdown#0
byte i byte i
for i = pgjmp downto 0 for i = 0 to pgjmp
cursdown cursdown
next next
end end
@ -543,7 +543,7 @@ end
def pgleft#0 def pgleft#0
byte i byte i
for i = 7 downto 0 for i = 0 to 7
cursleft cursleft
next next
end end
@ -563,7 +563,7 @@ end
def pgright#0 def pgright#0
byte i byte i
for i = 7 downto 0 for i = 0 to 7
cursright cursright
next next
end end
@ -623,8 +623,6 @@ def keyin3
key = keyctrlf; break key = keyctrlf; break
is $80 | '\\' is $80 | '\\'
key = keydelete; break // Delete key = keydelete; break // Delete
is keyenter
key = keyctrlf; break
// //
// Map OA+keypad // Map OA+keypad
// //
@ -692,33 +690,45 @@ def keyin2
fin fin
until key >= 128 until key >= 128
^keystrobe ^keystrobe
if key == keyctrln when key
key = $DB // '[' is keyctrln
elsif key == $9E // SHIFT+CTRL+N key = $DB // '['
key = $FE // '~' break
elsif key == keyctrlp is $9E // SHIFT+CTRL+N
key = $DC // '\' key = $FE // '~'
elsif key == $80 // SHIFT+CTRL+P -> CTRL+@ break
key = $FC // '|' is keyctrlp
elsif key == keyctrlg key = $DC // '\'
key = $DF // '_' break
elsif key == keyarrowleft is $80 // SHIFT+CTRL+P -> CTRL+@
if ^pushbttn3 < 128 key = $FC // '|'
key = keydelete break
fin is keyctrlg
elsif key >= $C0 and flags < shiftlock key = $DF // '_'
if ^pushbttn3 < 128 break
if key == $C0 is keyarrowleft
key = $D0 // P if ^pushbttn3 < 128
elsif key == $DD key = keydelete
key = $CD // M
elsif key == $DE
key = $CE // N
fin fin
else break
key = key | $E0 otherwise
fin if key >= $C0 and flags < shiftlock
fin if ^pushbttn3 < 128
when key
is $C0
key = $D0 // P
break
is $DD
key = $CD // M
break
is $DE
key = $CE // N
wend
else
key = key | $E0
fin
fin
wend
return key return key
end end
def setkeyin#0 def setkeyin#0
@ -836,13 +846,7 @@ def splitline#0
fin fin
end end
def editkey(key) def editkey(key)
if key >= keyspace if key >= keyspace or key == keydelete or key == keyctrld or key == keyctrlr
return TRUE
elsif key == keydelete
return TRUE
elsif key == keyctrld
return TRUE
elsif key == keyctrlr
return TRUE return TRUE
fin fin
return FALSE return FALSE
@ -1022,7 +1026,6 @@ def editmode#0
fin fin
redraw redraw
fin fin
break
wend wend
until exit until exit
end end
@ -1123,7 +1126,7 @@ def cmdmode#0
word cmdptr word cmdptr
clrscrn clrscrn
puts("PLASMA Editor, Version 1.1\n") puts("PLASMA Editor, Version 2.0 Dev\n")
while not exit while not exit
puts(@filename) puts(@filename)
cmdptr = gets($BA) cmdptr = gets($BA)

2
src/toolsrc/lex.pla
View File

@ -325,7 +325,7 @@ def nextln
scanptr++ scanptr++
scan scan
else else
if token <> EOL_TKN and token <> EOF_TKN; puti(token&$7F); puts("Extraneous characters\n"); exit_err(0); fin if token <> EOL_TKN and token <> EOF_TKN; putc(token&$7F); puts("Extraneous characters\n"); exit_err(0); fin
scanptr = inbuff scanptr = inbuff
^instr = fileio:read(refnum, inbuff, 127) ^instr = fileio:read(refnum, inbuff, 127)
if ^instr if ^instr

258
src/toolsrc/parse.c
View File

@ -1,11 +1,14 @@
#include <stdio.h> #include <stdio.h>
#include <string.h> #include <string.h>
#include <stdlib.h>
#include "plasm.h" #include "plasm.h"
#define LVALUE 0 #define LVALUE 0
#define RVALUE 1 #define RVALUE 1
#define MAX_LAMBDA 64 #define MAX_LAMBDA 64
int infunc = 0, break_tag = 0, cont_tag = 0, stack_loop = 0; int parse_mods(void);
int infunc = 0, break_tag = 0, cont_tag = 0, stack_loop = 0, infor = 0;
long infuncvals = 0; long infuncvals = 0;
t_token prevstmnt; t_token prevstmnt;
static int lambda_num = 0; static int lambda_num = 0;
@ -23,9 +26,7 @@ t_token binary_ops_table[] = {
EOR_TOKEN, EOR_TOKEN,
OR_TOKEN, OR_TOKEN,
GT_TOKEN, GE_TOKEN, LT_TOKEN, LE_TOKEN, GT_TOKEN, GE_TOKEN, LT_TOKEN, LE_TOKEN,
EQ_TOKEN, NE_TOKEN, EQ_TOKEN, NE_TOKEN
LOGIC_AND_TOKEN,
LOGIC_OR_TOKEN
/* Lowest precedence */ /* Lowest precedence */
}; };
t_token binary_ops_precedence[] = { t_token binary_ops_precedence[] = {
@ -37,9 +38,7 @@ t_token binary_ops_precedence[] = {
5, 5,
6, 6,
7, 7, 7, 7, 7, 7, 7, 7,
8, 8, 8, 8
9,
10
/* Lowest precedence */ /* Lowest precedence */
}; };
@ -729,14 +728,48 @@ t_opseq *parse_expr(t_opseq *codeseq, int *stackdepth)
if (stackdepth) if (stackdepth)
(*stackdepth)--; (*stackdepth)--;
} }
/* if (scantoken == LOGIC_AND_TOKEN)
* Look for ternary operator {
*/ int tag_and;
if (scantoken == TERNARY_TOKEN) int stackdepth1;
/*
* Short-circuit AND
*/
if (*stackdepth != 1)
parse_error("AND must evaluate to single value");
tag_and = tag_new(BRANCH_TYPE);
codeseq = gen_brand(codeseq, tag_and);
codeseq = parse_expr(codeseq, &stackdepth1);
if (stackdepth1 != *stackdepth)
parse_error("Inconsistent AND value counts");
codeseq = gen_codetag(codeseq, tag_and);
}
else if (scantoken == LOGIC_OR_TOKEN)
{
int tag_or;
int stackdepth1;
/*
* Short-circuit OR
*/
if (*stackdepth != 1)
parse_error("OR must evaluate to single value");
tag_or = tag_new(BRANCH_TYPE);
codeseq = gen_bror(codeseq, tag_or);
codeseq = parse_expr(codeseq, &stackdepth1);
if (stackdepth1 != *stackdepth)
parse_error("Inconsistent AND value counts");
codeseq = gen_codetag(codeseq, tag_or);
}
else if (scantoken == TERNARY_TOKEN)
{ {
int tag_else, tag_endtri; int tag_else, tag_endtri;
int stackdepth1; int stackdepth1;
/*
* Look for ternary operator
*/
if (*stackdepth != 1) if (*stackdepth != 1)
parse_error("Ternary op must evaluate to single value"); parse_error("Ternary op must evaluate to single value");
tag_else = tag_new(BRANCH_TYPE); tag_else = tag_new(BRANCH_TYPE);
@ -798,9 +831,11 @@ t_opseq *parse_set(t_opseq *codeseq)
int parse_stmnt(void) int parse_stmnt(void)
{ {
int tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend, tag_repeat, tag_for, tag_choice, tag_of; int tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend, tag_repeat, tag_for, tag_choice, tag_of;
int type, addr, step, cfnvals; int type, addr, step, cfnvals, prev_for, constsize, casecnt, i;
int *caseval, *casetag;
long constval;
char *idptr; char *idptr;
t_opseq *seq; t_opseq *seq, *fromseq, *toseq;
/* /*
* Optimization for last function LEAVE and OF clause. * Optimization for last function LEAVE and OF clause.
@ -856,12 +891,15 @@ int parse_stmnt(void)
parse_error("Missing IF/FIN"); parse_error("Missing IF/FIN");
break; break;
case WHILE_TOKEN: case WHILE_TOKEN:
prev_for = infor;
infor = 0;
tag_while = tag_new(BRANCH_TYPE); tag_while = tag_new(BRANCH_TYPE);
tag_wend = tag_new(BRANCH_TYPE); tag_wend = tag_new(BRANCH_TYPE);
tag_prevcnt = cont_tag; tag_prevcnt = cont_tag;
cont_tag = tag_while; cont_tag = tag_new(BRANCH_TYPE);
tag_prevbrk = break_tag; tag_prevbrk = break_tag;
break_tag = tag_wend; break_tag = tag_wend;
emit_brnch(cont_tag);
emit_codetag(tag_while); emit_codetag(tag_while);
if (!(seq = parse_expr(NULL, &cfnvals))) if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad expression"); parse_error("Bad expression");
@ -870,17 +908,20 @@ int parse_stmnt(void)
parse_warn("Expression value overflow"); parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq); while (cfnvals-- > 1) seq = gen_drop(seq);
} }
seq = gen_brfls(seq, tag_wend); seq = gen_brtru(seq, tag_while);
emit_seq(seq);
while (parse_stmnt()) next_line(); while (parse_stmnt()) next_line();
if (scantoken != LOOP_TOKEN) if (scantoken != LOOP_TOKEN)
parse_error("Missing WHILE/END"); parse_error("Missing WHILE/END");
emit_brnch(tag_while); emit_codetag(cont_tag);
emit_seq(seq);
emit_codetag(tag_wend); emit_codetag(tag_wend);
break_tag = tag_prevbrk; break_tag = tag_prevbrk;
cont_tag = tag_prevcnt; cont_tag = tag_prevcnt;
infor = prev_for;
break; break;
case REPEAT_TOKEN: case REPEAT_TOKEN:
prev_for = infor;
infor = 0;
tag_prevbrk = break_tag; tag_prevbrk = break_tag;
break_tag = tag_new(BRANCH_TYPE); break_tag = tag_new(BRANCH_TYPE);
tag_repeat = tag_new(BRANCH_TYPE); tag_repeat = tag_new(BRANCH_TYPE);
@ -904,48 +945,43 @@ int parse_stmnt(void)
emit_seq(seq); emit_seq(seq);
emit_codetag(break_tag); emit_codetag(break_tag);
break_tag = tag_prevbrk; break_tag = tag_prevbrk;
infor = prev_for;
break; break;
case FOR_TOKEN: case FOR_TOKEN:
stack_loop++; stack_loop += 2;
prev_for = infor;
infor = 1;
tag_prevbrk = break_tag; tag_prevbrk = break_tag;
break_tag = tag_new(BRANCH_TYPE); break_tag = tag_new(BRANCH_TYPE);
tag_for = tag_new(BRANCH_TYPE); tag_for = tag_new(BRANCH_TYPE);
tag_prevcnt = cont_tag; tag_prevcnt = cont_tag;
cont_tag = tag_for; cont_tag = tag_new(BRANCH_TYPE);
if (scan() != ID_TOKEN) if (scan() != ID_TOKEN)
parse_error("Missing FOR variable"); parse_error("Missing FOR variable");
type = id_type(tokenstr, tokenlen); type = id_type(tokenstr, tokenlen);
addr = id_tag(tokenstr, tokenlen); addr = id_tag(tokenstr, tokenlen);
if (scan() != SET_TOKEN) if (scan() != SET_TOKEN)
parse_error("Missing FOR ="); parse_error("Missing FOR =");
if (!(seq = parse_expr(NULL, &cfnvals))) if (!(fromseq = parse_expr(NULL, &cfnvals)))
parse_error("Bad FOR expression"); parse_error("Bad FOR expression");
if (cfnvals > 1) if (cfnvals > 1)
{ {
parse_warn("Expression value overflow"); parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq); while (cfnvals-- > 1) seq = gen_drop(seq);
} }
emit_seq(seq);
emit_codetag(tag_for);
if (type & LOCAL_TYPE)
type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr);
else
type & BYTE_TYPE ? emit_dab(addr, 0, type) : emit_daw(addr, 0, type);
if (scantoken == TO_TOKEN) if (scantoken == TO_TOKEN)
step = 1; step = 1;
else if (scantoken == DOWNTO_TOKEN) else if (scantoken == DOWNTO_TOKEN)
step = -1; step = -1;
else else
parse_error("Missing FOR TO"); parse_error("Missing FOR TO");
if (!(seq = parse_expr(NULL, &cfnvals))) if (!(toseq = parse_expr(NULL, &cfnvals)))
parse_error("Bad FOR TO expression"); parse_error("Bad FOR TO expression");
if (cfnvals > 1) if (cfnvals > 1)
{ {
parse_warn("Expression value overflow"); parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq); while (cfnvals-- > 1) seq = gen_drop(seq);
} }
emit_seq(seq);
step > 0 ? emit_brgt(break_tag) : emit_brlt(break_tag);
if (scantoken == STEP_TOKEN) if (scantoken == STEP_TOKEN)
{ {
if (!(seq = parse_expr(NULL, &cfnvals))) if (!(seq = parse_expr(NULL, &cfnvals)))
@ -955,27 +991,57 @@ int parse_stmnt(void)
parse_warn("Expression value overflow"); parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq); while (cfnvals-- > 1) seq = gen_drop(seq);
} }
emit_seq(seq);
emit_op(step > 0 ? ADD_TOKEN : SUB_TOKEN);
} }
else else
emit_unaryop(step > 0 ? INC_TOKEN : DEC_TOKEN); {
seq = NULL;
}
toseq = cat_seq(toseq, fromseq);
emit_seq(step > 0 ? gen_brgt(toseq, break_tag) : gen_brlt(toseq, break_tag));
emit_codetag(tag_for);
if (type & LOCAL_TYPE)
type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr);
else
type & BYTE_TYPE ? emit_dab(addr, 0, type) : emit_daw(addr, 0, type);
while (parse_stmnt()) next_line(); while (parse_stmnt()) next_line();
if (scantoken != NEXT_TOKEN) if (scantoken != NEXT_TOKEN)
parse_error("Missing FOR/NEXT"); parse_error("Missing FOR/NEXT");
emit_brnch(tag_for); emit_codetag(cont_tag);
cont_tag = tag_prevcnt; cont_tag = tag_prevcnt;
if (step > 0)
{
if (seq)
{
emit_seq(seq);
emit_addbrle(tag_for);
}
else
emit_incbrle(tag_for);
}
else
{
if (seq)
{
emit_seq(seq);
emit_subbrge(tag_for);
}
else
emit_decbrge(tag_for);
}
emit_codetag(break_tag); emit_codetag(break_tag);
emit_drop(); break_tag = tag_prevbrk;
break_tag = tag_prevbrk; infor = prev_for;
stack_loop--; stack_loop -= 2;
break; break;
case CASE_TOKEN: case CASE_TOKEN:
stack_loop++; prev_for = infor;
infor = 0;
tag_prevbrk = break_tag; tag_prevbrk = break_tag;
break_tag = tag_new(BRANCH_TYPE); break_tag = tag_new(BRANCH_TYPE);
tag_choice = tag_new(BRANCH_TYPE); tag_choice = tag_new(BRANCH_TYPE);
tag_of = tag_new(BRANCH_TYPE); caseval = malloc(sizeof(int)*256);
casetag = malloc(sizeof(int)*256);
casecnt = 0;
if (!(seq = parse_expr(NULL, &cfnvals))) if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad CASE expression"); parse_error("Bad CASE expression");
if (cfnvals > 1) if (cfnvals > 1)
@ -984,33 +1050,48 @@ int parse_stmnt(void)
while (cfnvals-- > 1) seq = gen_drop(seq); while (cfnvals-- > 1) seq = gen_drop(seq);
} }
emit_seq(seq); emit_seq(seq);
emit_select(tag_choice);
next_line(); next_line();
while (scantoken != ENDCASE_TOKEN) while (scantoken != ENDCASE_TOKEN)
{ {
if (scantoken == OF_TOKEN) if (scantoken == OF_TOKEN)
{ {
if (!(seq = parse_expr(NULL, &cfnvals))) tag_of = tag_new(BRANCH_TYPE);
parse_error("Bad CASE OF expression"); constval = 0;
if (cfnvals > 1) parse_constexpr(&constval, &constsize);
i = casecnt;
while ((i > 0) && (caseval[i-1] > constval))
{ {
parse_warn("Expression value overflow"); //
while (cfnvals-- > 1) seq = gen_drop(seq); // Move larger case consts up
//
caseval[i] = caseval[i-1];
casetag[i] = casetag[i-1];
i--;
} }
emit_seq(seq); if ((i < casecnt) && (caseval[i] == constval))
emit_brne(tag_choice); parse_error("Duplicate CASE");
caseval[i] = constval;
casetag[i] = tag_of;
casecnt++;
emit_codetag(tag_of); emit_codetag(tag_of);
while (parse_stmnt()) next_line(); while (parse_stmnt()) next_line();
tag_of = tag_new(BRANCH_TYPE);
if (prevstmnt != BREAK_TOKEN) // Fall through to next OF if no break
emit_brnch(tag_of);
emit_codetag(tag_choice);
tag_choice = tag_new(BRANCH_TYPE);
} }
else if (scantoken == DEFAULT_TOKEN) else if (scantoken == DEFAULT_TOKEN)
{ {
emit_codetag(tag_of); if (prevstmnt != BREAK_TOKEN) // Branch around caseblock if falling through
tag_of = 0; {
tag_of = tag_new(BRANCH_TYPE);
emit_brnch(tag_of);
}
else
tag_of = 0;
emit_codetag(tag_choice);
emit_caseblock(casecnt, caseval, casetag);
tag_choice = 0;
scan(); scan();
if (tag_of)
emit_codetag(tag_of);
while (parse_stmnt()) next_line(); while (parse_stmnt()) next_line();
if (scantoken != ENDCASE_TOKEN) if (scantoken != ENDCASE_TOKEN)
parse_error("Bad CASE DEFAULT clause"); parse_error("Bad CASE DEFAULT clause");
@ -1020,16 +1101,25 @@ int parse_stmnt(void)
else else
parse_error("Bad CASE clause"); parse_error("Bad CASE clause");
} }
if (tag_of) if (tag_choice)
emit_codetag(tag_of); {
emit_brnch(break_tag);
emit_codetag(tag_choice);
emit_caseblock(casecnt, caseval, casetag);
}
free(caseval);
free(casetag);
emit_codetag(break_tag); emit_codetag(break_tag);
emit_drop();
break_tag = tag_prevbrk; break_tag = tag_prevbrk;
stack_loop--; infor = prev_for;
break; break;
case BREAK_TOKEN: case BREAK_TOKEN:
if (break_tag) if (break_tag)
{
if (infor)
emit_drop2();
emit_brnch(break_tag); emit_brnch(break_tag);
}
else else
parse_error("BREAK without loop"); parse_error("BREAK without loop");
break; break;
@ -1043,7 +1133,14 @@ int parse_stmnt(void)
if (infunc) if (infunc)
{ {
int i; int i;
for (i = 0; i < stack_loop; i++)
i = stack_loop;
while (i >= 2)
{
emit_drop2();
i -= 2;
}
if (i)
emit_drop(); emit_drop();
cfnvals = 0; cfnvals = 0;
emit_seq(parse_list(NULL, &cfnvals)); emit_seq(parse_list(NULL, &cfnvals));
@ -1243,7 +1340,7 @@ int parse_struc(void)
int parse_vars(int type) int parse_vars(int type)
{ {
long value; long value;
int idlen, size, cfnparms; int idlen, size, cfnparms, emit = 0;
long cfnvals; long cfnvals;
char *idstr; char *idstr;
@ -1306,6 +1403,7 @@ int parse_vars(int type)
if (type & WORD_TYPE) if (type & WORD_TYPE)
cfnvals *= 2; cfnvals *= 2;
do parse_var(type, cfnvals); while (scantoken == COMMA_TOKEN); do parse_var(type, cfnvals); while (scantoken == COMMA_TOKEN);
emit = type == GLOBAL_TYPE;
break; break;
case PREDEF_TOKEN: case PREDEF_TOKEN:
/* /*
@ -1346,6 +1444,12 @@ int parse_vars(int type)
else else
parse_error("Bad function pre-declaration"); parse_error("Bad function pre-declaration");
} while (scantoken == COMMA_TOKEN); } while (scantoken == COMMA_TOKEN);
break;
case IMPORT_TOKEN:
if (emit || type != GLOBAL_TYPE)
parse_error("IMPORT after emitting data");
parse_mods();
break;
case EOL_TOKEN: case EOL_TOKEN:
break; break;
default: default:
@ -1436,11 +1540,16 @@ int parse_defs(void)
char c, *idstr; char c, *idstr;
int idlen, func_tag, cfnparms, cfnvals, type = GLOBAL_TYPE, pretype; int idlen, func_tag, cfnparms, cfnvals, type = GLOBAL_TYPE, pretype;
static char bytecode = 0; static char bytecode = 0;
if (scantoken == EXPORT_TOKEN)
switch (scantoken)
{ {
if (scan() != DEF_TOKEN && scantoken != ASM_TOKEN) case CONST_TOKEN:
parse_error("Bad export definition"); case STRUC_TOKEN:
type = EXPORT_TYPE; return parse_vars(GLOBAL_TYPE);
case EXPORT_TOKEN:
if (scan() != DEF_TOKEN && scantoken != ASM_TOKEN)
parse_error("Bad export definition");
type = EXPORT_TYPE;
} }
if (scantoken == DEF_TOKEN) if (scantoken == DEF_TOKEN)
{ {
@ -1520,8 +1629,9 @@ int parse_defs(void)
emit_const(0); emit_const(0);
emit_leave(); emit_leave();
} }
while (lambda_cnt--) for (cfnvals = 0; cfnvals < lambda_cnt; cfnvals++)
emit_lambdafunc(lambda_tag[lambda_cnt], lambda_id[lambda_cnt], lambda_cparams[lambda_cnt], lambda_seq[lambda_cnt]); emit_lambdafunc(lambda_tag[cfnvals], lambda_id[cfnvals], lambda_cparams[cfnvals], lambda_seq[cfnvals]);
lambda_cnt = 0;
return (1); return (1);
} }
else if (scantoken == ASM_TOKEN) else if (scantoken == ASM_TOKEN)
@ -1601,21 +1711,21 @@ int parse_module(void)
while (parse_mods()) next_line(); while (parse_mods()) next_line();
while (parse_vars(GLOBAL_TYPE)) next_line(); while (parse_vars(GLOBAL_TYPE)) next_line();
while (parse_defs()) next_line(); while (parse_defs()) next_line();
emit_bytecode_seg();
emit_start();
idlocal_reset();
emit_idfunc(0, 0, NULL, 1);
prevstmnt = 0;
if (scantoken != DONE_TOKEN && scantoken != EOF_TOKEN) if (scantoken != DONE_TOKEN && scantoken != EOF_TOKEN)
{ {
emit_bytecode_seg();
emit_start();
idlocal_reset();
emit_idfunc(0, 0, NULL, 1);
prevstmnt = 0;
while (parse_stmnt()) next_line(); while (parse_stmnt()) next_line();
if (scantoken != DONE_TOKEN) if (scantoken != DONE_TOKEN)
parse_error("Missing DONE"); parse_error("Missing DONE");
if (prevstmnt != RETURN_TOKEN) }
{ if (prevstmnt != RETURN_TOKEN)
emit_const(0); {
emit_ret(); emit_const(0);
} emit_ret();
} }
} }
emit_trailer(); emit_trailer();

293
src/toolsrc/parse.pla
View File

@ -494,7 +494,7 @@ end
def parse_expr(codeseq)#2 def parse_expr(codeseq)#2
byte stackdepth, matchdepth, stkdepth1, prevmatch, matchop, i byte stackdepth, matchdepth, stkdepth1, prevmatch, matchop, i
word optos word optos
word tag_else, tag_endtri word tag_else, tag_endop
stackdepth = 0 stackdepth = 0
matchop = 0 matchop = 0
@ -524,21 +524,32 @@ def parse_expr(codeseq)#2
codeseq = gen_bop(codeseq, pop_op) codeseq = gen_bop(codeseq, pop_op)
stackdepth-- stackdepth--
loop loop
// if token == LOGIC_AND_TKN
// Look for ternary operator if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin
// tag_endop = new_tag(RELATIVE_FIXUP)
if token == TERNARY_TKN codeseq = gen_oprel(codeseq, BRAND_CODE, tag_endop)
codeseq, stkdepth1 = parse_expr(codeseq)
if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin
codeseq = gen_ctag(codeseq, tag_endop)
elsif token == LOGIC_OR_TKN
if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin
tag_endop = new_tag(RELATIVE_FIXUP)
codeseq = gen_oprel(codeseq, BROR_CODE, tag_endop)
codeseq, stkdepth1 = parse_expr(codeseq)
if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin
codeseq = gen_ctag(codeseq, tag_endop)
elsif token == TERNARY_TKN
if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin
tag_else = new_tag(RELATIVE_FIXUP) tag_else = new_tag(RELATIVE_FIXUP)
tag_endtri = new_tag(RELATIVE_FIXUP) tag_endop = new_tag(RELATIVE_FIXUP)
codeseq = gen_oprel(codeseq, BRFALSE_CODE, tag_else) codeseq = gen_oprel(codeseq, BRFALSE_CODE, tag_else)
codeseq, stkdepth1 = parse_expr(codeseq) codeseq, stkdepth1 = parse_expr(codeseq)
if token <> TRIELSE_TKN; exit_err(ERR_MISS|ERR_SYNTAX); fin if token <> TRIELSE_TKN; exit_err(ERR_MISS|ERR_SYNTAX); fin
codeseq = gen_oprel(codeseq, BRNCH_CODE, tag_endtri) codeseq = gen_oprel(codeseq, BRNCH_CODE, tag_endop)
codeseq = gen_ctag(codeseq, tag_else) codeseq = gen_ctag(codeseq, tag_else)
codeseq, stackdepth = parse_expr(codeseq) codeseq, stackdepth = parse_expr(codeseq)
if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin
codeseq = gen_ctag(codeseq, tag_endtri) codeseq = gen_ctag(codeseq, tag_endop)
fin fin
return codeseq, stackdepth return codeseq, stackdepth
end end
@ -587,9 +598,10 @@ def parse_set(codeseq)
return codeseq return codeseq
end end
def parse_stmnt def parse_stmnt
byte type, elem_type, elem_size, i, cfnvals byte type, elem_type, elem_size, cfnvals, prev_for
word seq, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend word seq, fromseq, toseq, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend
word tag_repeat, tag_for, tag_choice, tag_of, idptr, addr, stepdir word tag_repeat, tag_for, tag_choice, tag_of, idptr, addr, stepdir
word caseconst, casecnt, caseval, casetag, i
if token <> END_TKN and token <> DONE_TKN and token <> OF_TKN and token <> DEFAULT_TKN if token <> END_TKN and token <> DONE_TKN and token <> OF_TKN and token <> DEFAULT_TKN
prevstmnt = token prevstmnt = token
@ -640,12 +652,15 @@ def parse_stmnt
if token <> FIN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin if token <> FIN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin
break break
is WHILE_TKN is WHILE_TKN
prev_for = infor
infor = FALSE
tag_while = new_tag(RELATIVE_FIXUP) tag_while = new_tag(RELATIVE_FIXUP)
tag_wend = new_tag(RELATIVE_FIXUP) tag_wend = new_tag(RELATIVE_FIXUP)
tag_prevcnt = cont_tag tag_prevcnt = cont_tag
cont_tag = tag_while cont_tag = new_tag(RELATIVE_FIXUP)
tag_prevbrk = break_tag tag_prevbrk = break_tag
break_tag = tag_wend break_tag = tag_wend
emit_branch(cont_tag)
emit_tag(tag_while) emit_tag(tag_while)
seq, cfnvals = parse_expr(NULL) seq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if !seq; exit_err(ERR_INVAL|ERR_STATE); fin
@ -653,18 +668,21 @@ def parse_stmnt
parse_warn("Expression value overflow") parse_warn("Expression value overflow")
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin fin
seq = gen_oprel(seq, BRFALSE_CODE, tag_wend) seq = gen_oprel(seq, BRTRUE_CODE, tag_while)
emit_seq(seq)
while parse_stmnt while parse_stmnt
nextln nextln
loop loop
if token <> LOOP_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin if token <> LOOP_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin
emit_branch(tag_while) emit_tag(cont_tag)
emit_seq(seq)
emit_tag(tag_wend) emit_tag(tag_wend)
break_tag = tag_prevbrk break_tag = tag_prevbrk
cont_tag = tag_prevcnt cont_tag = tag_prevcnt
infor = prev_for
break break
is REPEAT_TKN is REPEAT_TKN
prev_for = infor
infor = FALSE
tag_repeat = new_tag(RELATIVE_FIXUP) tag_repeat = new_tag(RELATIVE_FIXUP)
tag_prevbrk = break_tag tag_prevbrk = break_tag
break_tag = new_tag(RELATIVE_FIXUP) break_tag = new_tag(RELATIVE_FIXUP)
@ -688,12 +706,15 @@ def parse_stmnt
emit_seq(seq) emit_seq(seq)
emit_tag(break_tag) emit_tag(break_tag)
break_tag = tag_prevbrk break_tag = tag_prevbrk
infor = prev_for
break break
is FOR_TKN is FOR_TKN
stack_loop++ prev_for = infor
infor = TRUE
stack_loop = stack_loop + 2
tag_for = new_tag(RELATIVE_FIXUP) tag_for = new_tag(RELATIVE_FIXUP)
tag_prevcnt = cont_tag tag_prevcnt = cont_tag
cont_tag = tag_for cont_tag = new_tag(RELATIVE_FIXUP)
tag_prevbrk = break_tag tag_prevbrk = break_tag
break_tag = new_tag(RELATIVE_FIXUP) break_tag = new_tag(RELATIVE_FIXUP)
if scan <> ID_TKN; exit_err(ERR_MISS|ERR_ID); fin if scan <> ID_TKN; exit_err(ERR_MISS|ERR_ID); fin
@ -705,19 +726,12 @@ def parse_stmnt
exit_err(ERR_INVAL|ERR_ID) exit_err(ERR_INVAL|ERR_ID)
fin fin
if scan <> SET_TKN; exit_err(ERR_INVAL|ERR_STATE); fin if scan <> SET_TKN; exit_err(ERR_INVAL|ERR_STATE); fin
seq, cfnvals = parse_expr(NULL) fromseq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if !fromseq; exit_err(ERR_INVAL|ERR_STATE); fin
if cfnvals > 1 if cfnvals > 1
parse_warn("Expression value overflow") parse_warn("Expression value overflow")
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin fin
emit_seq(seq)
emit_tag(tag_for)
if type & LOCAL_TYPE
if type & BYTE_TYPE; emit_dlb(addr); else; emit_dlw(addr); fin
else
if type & BYTE_TYPE; emit_dab(addr, 0); else; emit_daw(addr, 0); fin
fin
if token == TO_TKN if token == TO_TKN
stepdir = 1 stepdir = 1
elsif token == DOWNTO_TKN elsif token == DOWNTO_TKN
@ -725,14 +739,12 @@ def parse_stmnt
else else
exit_err(ERR_INVAL|ERR_STATE) exit_err(ERR_INVAL|ERR_STATE)
fin fin
seq, cfnvals = parse_expr(NULL) toseq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if !toseq; exit_err(ERR_INVAL|ERR_STATE); fin
if cfnvals > 1 if cfnvals > 1
parse_warn("Expression value overflow") parse_warn("Expression value overflow")
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin fin
emit_seq(seq)
if stepdir > 0; emit_brgt(break_tag); else; emit_brlt(break_tag); fin
if token == STEP_TKN if token == STEP_TKN
seq, cfnvals = parse_expr(NULL) seq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if !seq; exit_err(ERR_INVAL|ERR_STATE); fin
@ -740,28 +752,51 @@ def parse_stmnt
parse_warn("Expression value overflow") parse_warn("Expression value overflow")
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin fin
emit_seq(seq)
emit_code(stepdir > 0 ?? ADD_CODE :: SUB_CODE)
else else
emit_code(stepdir > 0 ?? INC_CODE :: DEC_CODE) seq = NULL
fin
emit_seq(gen_oprel(cat_seq(toseq, fromseq), stepdir > 0 ?? BRGT_CODE :: BRLT_CODE, break_tag))
emit_tag(tag_for)
if type & LOCAL_TYPE
if type & BYTE_TYPE; emit_dlb(addr); else; emit_dlw(addr); fin
else
if type & BYTE_TYPE; emit_dab(addr, 0); else; emit_daw(addr, 0); fin
fin fin
while parse_stmnt while parse_stmnt
nextln nextln
loop loop
if token <> NEXT_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin if token <> NEXT_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin
emit_branch(tag_for) emit_tag(cont_tag)
cont_tag = tag_prevcnt cont_tag = tag_prevcnt
if stepdir > 0
if seq
emit_seq(seq)
emit_addbrle(tag_for)
else
emit_incbrle(tag_for)
fin
else
if seq
emit_seq(seq)
emit_subbrge(tag_for)
else
emit_decbrge(tag_for)
fin
fin
emit_tag(break_tag) emit_tag(break_tag)
emit_code(DROP_CODE) break_tag = tag_prevbrk
break_tag = tag_prevbrk stack_loop = stack_loop - 2
stack_loop-- infor = prev_for
break break
is CASE_TKN is CASE_TKN
stack_loop++ prev_for = infor
infor = FALSE
tag_prevbrk = break_tag tag_prevbrk = break_tag
break_tag = new_tag(RELATIVE_FIXUP) break_tag = new_tag(RELATIVE_FIXUP)
tag_choice = new_tag(RELATIVE_FIXUP) tag_choice = new_tag(RELATIVE_FIXUP)
tag_of = new_tag(RELATIVE_FIXUP) caseval = heapalloc(CASENUM)
casetag = heapalloc(CASENUM)
casecnt = 0
seq, cfnvals = parse_expr(NULL) seq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin if !seq; exit_err(ERR_INVAL|ERR_STATE); fin
if cfnvals > 1 if cfnvals > 1
@ -769,32 +804,44 @@ def parse_stmnt
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin fin
emit_seq(seq) emit_seq(seq)
emit_select(tag_choice)
nextln nextln
while token <> ENDCASE_TKN while token <> ENDCASE_TKN
when token when token
is OF_TKN is OF_TKN
seq, cfnvals = parse_expr(NULL) if casecnt == CASENUM; exit_err(ERR_OVER|ERR_TABLE); fin
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin caseconst, drop, drop = parse_constexpr
if cfnvals > 1 tag_of = new_tag(RELATIVE_FIXUP)
parse_warn("Expression value overflow") i = casecnt
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop while i > 0 and caseval=>[i-1] > caseconst
fin //
emit_seq(seq) // Move larger case consts up
emit_brne(tag_choice) //
caseval=>[i] = caseval=>[i-1]
casetag=>[i] = casetag=>[i-1]
i--
loop
if i < casecnt and caseval=>[i] == caseconst; exit_err(ERR_DUP|ERR_STATE); fin
caseval=>[i] = caseconst
casetag=>[i] = tag_of
casecnt++
emit_tag(tag_of) emit_tag(tag_of)
while parse_stmnt while parse_stmnt
nextln nextln
loop loop
tag_of = new_tag(RELATIVE_FIXUP) break
if prevstmnt <> BREAK_TKN // Fall through to next OF if no break is DEFAULT_TKN
tag_of = 0
if prevstmnt <> BREAK_TKN // Branch around caseblock if falling through
tag_of = new_tag(RELATIVE_FIXUP)
emit_branch(tag_of) emit_branch(tag_of)
fin fin
emit_tag(tag_choice) emit_tag(tag_choice)
tag_choice = new_tag(RELATIVE_FIXUP) emit_caseblock(casecnt, caseval, casetag)
break tag_choice = 0
is DEFAULT_TKN if tag_of
emit_tag(tag_of) emit_tag(tag_of)
tag_of = 0 fin
scan scan
while parse_stmnt while parse_stmnt
nextln nextln
@ -808,16 +855,19 @@ def parse_stmnt
exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE) exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE)
wend wend
loop loop
if (tag_of) if tag_choice
emit_tag(tag_of) emit_branch(break_tag)
emit_tag(tag_choice)
emit_caseblock(casecnt, caseval, casetag)
fin fin
heaprelease(caseval)
emit_tag(break_tag) emit_tag(break_tag)
emit_code(DROP_CODE)
break_tag = tag_prevbrk break_tag = tag_prevbrk
stack_loop-- infor = prev_for
break break
is BREAK_TKN is BREAK_TKN
if break_tag if break_tag
if infor; emit_code(DROP2_CODE); fin
emit_branch(break_tag) emit_branch(break_tag)
else else
exit_err(ERR_INVAL|ERR_STATE) exit_err(ERR_INVAL|ERR_STATE)
@ -832,9 +882,14 @@ def parse_stmnt
break break
is RETURN_TKN is RETURN_TKN
if infunc if infunc
for i = 1 to stack_loop i = stack_loop
while i >= 2
emit_code(DROP2_CODE)
i = i - 2
loop
if i
emit_code(DROP_CODE) emit_code(DROP_CODE)
next fin
seq, cfnvals = parse_list seq, cfnvals = parse_list
emit_seq(seq) emit_seq(seq)
if cfnvals > infuncvals if cfnvals > infuncvals
@ -1076,6 +1131,10 @@ def parse_vars(type)
fin fin
until token <> COMMA_TKN until token <> COMMA_TKN
break break
is IMPORT_TKN
if codeptr <> codebuff or type <> GLOBAL_TYPE; exit_err(ERR_INVAL|ERR_INIT); fin
parse_mods
break
is EOL_TKN is EOL_TKN
break break
otherwise otherwise
@ -1161,64 +1220,68 @@ def parse_defs
word type, idstr, func_tag, idptr word type, idstr, func_tag, idptr
type = FUNC_TYPE type = FUNC_TYPE
if token == EXPORT_TKN when token
if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin is CONST_TKN
type = type | EXPORT_TYPE is STRUC_TKN
fin return parse_vars(GLOBAL_TYPE)
if token == DEF_TKN is EXPORT_TKN
if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin
lambda_cnt = 0 type = type | EXPORT_TYPE
cfnparms = 0 is DEF_TKN
infuncvals = 1 if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin
infunc = TRUE lambda_cnt = 0
idstr = tknptr cfnparms = 0
idlen = tknlen infuncvals = 1
init_idlocal infunc = TRUE
if scan == OPEN_PAREN_TKN idstr = tknptr
repeat idlen = tknlen
if scan == ID_TKN init_idlocal
cfnparms++ if scan == OPEN_PAREN_TKN
new_idlocal(tknptr, tknlen, WORD_TYPE, 2) repeat
scan if scan == ID_TKN
fin cfnparms++
until token <> COMMA_TKN new_idlocal(tknptr, tknlen, WORD_TYPE, 2)
if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin scan
fin
until token <> COMMA_TKN
if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin
scan
fin
if token == POUND_TKN
if not parse_const(@infuncvals); exit_err(ERR_INVAL|ERR_CONST); fin
scan
fin
idptr = lookup_idglobal(idstr, idlen)
if idptr
if not idptr=>idtype & PREDEF_TYPE; exit_err(ERR_DUP|ERR_ID); fin
if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err(ERR_DUP|ERR_CODE|ERR_ID); fin
func_tag = idptr=>idval
idptr=>idtype = idptr=>idtype | type
else
func_tag = new_tag(WORD_FIXUP)
new_idfunc(idstr, idlen, type, func_tag, cfnparms, infuncvals)
fin
emit_tag(func_tag)
new_dfd(func_tag)
while parse_vars(LOCAL_TYPE); nextln; loop
emit_enter(cfnparms)
prevstmnt = 0
while parse_stmnt; nextln; loop
infunc = FALSE
if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin
scan scan
fin if prevstmnt <> RETURN_TKN
if token == POUND_TKN if infuncvals; parse_warn("No return values"); fin
if not parse_const(@infuncvals); exit_err(ERR_INVAL|ERR_CONST); fin for cfnvals = infuncvals - 1 downto 0
scan emit_const(0)
fin next
idptr = lookup_idglobal(idstr, idlen) emit_leave
if idptr fin
if not idptr=>idtype & PREDEF_TYPE; exit_err(ERR_DUP|ERR_ID); fin for cfnvals = 0 to lambda_cnt-1
if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err(ERR_DUP|ERR_CODE|ERR_ID); fin emit_lambdafunc(lambda_tag[cfnvals], lambda_cparms[cfnvals], lambda_seq[cfnvals])
func_tag = idptr=>idval new_dfd(lambda_tag[cfnvals])
idptr=>idtype = idptr=>idtype | type
else
func_tag = new_tag(WORD_FIXUP)
new_idfunc(idstr, idlen, type, func_tag, cfnparms, infuncvals)
fin
emit_tag(func_tag)
while parse_vars(LOCAL_TYPE); nextln; loop
emit_enter(cfnparms)
prevstmnt = 0
while parse_stmnt; nextln; loop
infunc = FALSE
if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin
scan
if prevstmnt <> RETURN_TKN
if infuncvals; parse_warn("No return values"); fin
for cfnvals = infuncvals - 1 downto 0
emit_const(0)
next next
emit_leave wend
fin
while lambda_cnt
lambda_cnt--
emit_lambdafunc(lambda_tag[lambda_cnt], lambda_cparms[lambda_cnt], lambda_seq[lambda_cnt])
loop
fin
return token == EOL_TKN ?? TRUE :: FALSE return token == EOL_TKN ?? TRUE :: FALSE
end end
def parse_module#0 def parse_module#0

16
src/toolsrc/plasm.pla Normal file → Executable file
View File

@ -194,8 +194,6 @@ byte = EOR_TKN
byte = OR_TKN byte = OR_TKN
byte = GT_TKN, GE_TKN, LT_TKN, LE_TKN byte = GT_TKN, GE_TKN, LT_TKN, LE_TKN
byte = EQ_TKN, NE_TKN byte = EQ_TKN, NE_TKN
byte = LOGIC_AND_TKN
byte = LOGIC_OR_TKN
// Lowest precedence // Lowest precedence
byte[] bops_prec // Highest precedence byte[] bops_prec // Highest precedence
byte = 1, 1, 1 byte = 1, 1, 1
@ -206,8 +204,6 @@ byte = 5
byte = 6 byte = 6
byte = 7, 7, 7, 7 byte = 7, 7, 7, 7
byte = 8, 8 byte = 8, 8
byte = 9
byte = 10
// Lowest precedence // Lowest precedence
byte[16] opstack byte[16] opstack
byte[16] precstack byte[16] precstack
@ -236,24 +232,28 @@ end
// Generated code buffers // Generated code buffers
// //
const OPSEQNUM = 256 const OPSEQNUM = 256
const DFDNUM = 128
const TAGNUM = 1024 const TAGNUM = 1024
const FIXUPNUM = 2048 const FIXUPNUM = 2048
const MODDEPNUM = 8 const MODDEPNUM = 8
const IDGLOBALSZ = 4096 const IDGLOBALSZ = 4096
const IDLOCALSZ = 512 const IDLOCALSZ = 512
const CASENUM = 64
word fixup_cnt, tag_cnt = -1 word fixup_cnt, tag_cnt = -1
word dfd_tag, dfd_cnt
word fixup_tag, fixup_addr word fixup_tag, fixup_addr
word tag_addr, tag_type word tag_addr, tag_type
word idglobal_tbl, idlocal_tbl word idglobal_tbl, idlocal_tbl
word pending_seq word pending_seq
word globals, lastglobal, lastglobalsize, lastlocal, savelast word globals, lastglobal, lastglobalsize, lastlocal, savelast, savetbl
word tag_num, fixup_num, globalbufsz, localbufsz, codebufsz word dfd_num, tag_num, fixup_num, globalbufsz, localbufsz, codebufsz
word datasize, framesize, savesize word datasize, framesize, savesize
byte locals, savelocals byte locals, savelocals
word codebuff, codeptr, entrypoint word codebuff, codeptr, entrypoint
word modsysflags word modsysflags
byte[16] moddep_tbl[MODDEPNUM] byte[16] moddep_tbl[MODDEPNUM]
byte moddep_cnt, def_cnt = 1 byte moddep_cnt, def_cnt = 1
predef parse_mods
predef emit_pending_seq#0 predef emit_pending_seq#0
// //
// Module relocation base address // Module relocation base address
@ -298,7 +298,7 @@ const RVALUE = 1
const LAMBDANUM = 16 const LAMBDANUM = 16
word strconstbuff word strconstbuff
word strconstptr word strconstptr
byte infunc, inlambda byte infunc, inlambda, infor
byte stack_loop byte stack_loop
byte prevstmnt byte prevstmnt
word infuncvals word infuncvals
@ -511,7 +511,7 @@ include "toolsrc/parse.pla"
// //
// Look at command line arguments and compile module // Look at command line arguments and compile module
// //
puts("PLASMA Compiler, Version 1.1\n") puts("PLASMA Compiler, Version 2.0 Dev\n")
arg = argNext(argFirst) arg = argNext(argFirst)
if ^arg and ^(arg + 1) == '-' if ^arg and ^(arg + 1) == '-'
opt = arg + 2 opt = arg + 2

77
src/vmsrc/apple/cmd.pla
View File

@ -34,14 +34,17 @@ predef crout()#0, cout(c)#0, prstr(s)#0, prbyte(b)#0, prword(w)#0, print(i)#0, c
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr)#1, releaseheap(newheap)#1, availheap()#1 predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr)#1, releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0, strcpy(dst,src)#1, strcat(dst,src)#1 predef memset(addr,value,size)#0, memcpy(dst,src,size)#0, strcpy(dst,src)#1, strcat(dst,src)#1
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2 predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2
predef execmod(modfile)#1 predef execmod(modfile)#1, open(path)#1, close(refnum)#1, read(refnum, buff, len)#1, write(refnum, buff, len)#1
// //
// Exported CMDSYS table // Exported CMDSYS table
// //
word version = $0110 // 01.10 word version = $0200 // 02.00 Dev
word syspath word syspath
word syscmdln word syscmdln
word = @execmod word = @execmod, @open, @close, @read, @write
byte perr
byte jitcount = $10
byte jitsize = $FF
// //
// Working input buffer overlayed with strings table // Working input buffer overlayed with strings table
// //
@ -117,7 +120,6 @@ word sysmodsym = @exports
// System variable. // System variable.
// //
word systemflags = 0 word systemflags = 0
byte perr
word heap word heap
word xheap = $0800 word xheap = $0800
word lastsym = symtbl word lastsym = symtbl
@ -323,36 +325,6 @@ REVCPYLP LDA (SRC),Y
BNE REVCPYLP BNE REVCPYLP
CPYMEX RTS CPYMEX RTS
end end
//
// COPY FROM MAIN MEM TO AUX MEM.
//
// MEMXCPY(DST, SRC, SIZE)
//
asm memxcpy(dst,src,size)#0
LDA ESTKL+1,X
STA $3C
CLC
ADC ESTKL,X
STA $3E
LDA ESTKH+1,X
STA $3D
ADC ESTKH,X
STA $3F
LDA ESTKL+2,X
STA $42
LDA ESTKH+2,X
STA $43
STX ESP
BIT ROMEN
SEC
JSR $C311
BIT LCRDEN+LCBNK2
LDX ESP
INX
INX
INX
RTS
end
asm crout()#0 asm crout()#0
LDA #$8D LDA #$8D
BNE ++ BNE ++
@ -898,6 +870,17 @@ def read(refnum, buff, len)#1
perr = syscall($CA, @params) perr = syscall($CA, @params)
return params:6 return params:6
end end
def write(refnum, buf, len)#1
byte params[8]
params.0 = 4
params.1 = refnum
params:2 = buf
params:4 = len
params:6 = 0
perr = syscall($CB, @params)
return params:6
end
// //
// Heap routines. // Heap routines.
// //
@ -906,9 +889,10 @@ def availheap()#1
return @fp - heap return @fp - heap
end end
def allocheap(size)#1 def allocheap(size)#1
word addr word oldheap, addr
addr = heap oldheap = heap
heap = heap + size addr = heap
heap = heap + size
if systemflags & reshgr1 if systemflags & reshgr1
if uword_islt(addr, $4000) and uword_isgt(heap, $2000) if uword_islt(addr, $4000) and uword_isgt(heap, $2000)
addr = $4000 addr = $4000
@ -922,6 +906,7 @@ def allocheap(size)#1
fin fin
fin fin
if uword_isge(heap, @addr) if uword_isge(heap, @addr)
heap = oldheap
return 0 return 0
fin fin
return addr return addr
@ -1039,7 +1024,7 @@ def loadmod(mod)#1
word addr, defaddr, modaddr, modfix, modofst, modend word addr, defaddr, modaddr, modfix, modofst, modend
word deftbl, deflast word deftbl, deflast
word moddep, rld, esd, sym word moddep, rld, esd, sym
byte refnum, defbank, str[16], filename[64] byte refnum, defbank, filename[64], str[]
byte header[128] byte header[128]
// //
// Read the RELocatable module header (first 128 bytes) // Read the RELocatable module header (first 128 bytes)
@ -1053,6 +1038,13 @@ def loadmod(mod)#1
refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename))) refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename)))
fin fin
if refnum if refnum
header.0 = $0A
header:1 = @filename
if not syscall($C4, @header) and header.4 <> $FE // Make sure it's a REL module
close(refnum)
perr = $4A // Incompatible type
return -perr
fin
rdlen = read(refnum, @header, 128) rdlen = read(refnum, @header, 128)
modsize = header:0 modsize = header:0
moddep = @header.1 moddep = @header.1
@ -1212,8 +1204,13 @@ def loadmod(mod)#1
// //
// Move bytecode to AUX bank. // Move bytecode to AUX bank.
// //
memxcpy(defaddr, bytecode, modsize - (bytecode - modaddr)) *$003C = bytecode
*$003E = modaddr + modsize
*$0042 = defaddr
call($C311, 0, 0, 0, $05) // CALL XMOVE with carry set (MAIN->AUX) and ints disabled
fin fin
else
perr = $46
fin fin
if perr if perr
return -perr return -perr
@ -1433,7 +1430,7 @@ heap = *freemem
// //
// Print PLASMA version // Print PLASMA version
// //
prstr("PLASMA "); prbyte(version.1); cout('.'); prbyte(version.0); crout prstr("PLASMA 2.0 Dev\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout
// //
// Init symbol table. // Init symbol table.
// //

1497
src/vmsrc/apple/cmdjit.pla Executable file
View File

File diff suppressed because it is too large Load Diff

55
src/vmsrc/apple/cmdjitstub.s Normal file
View File

@ -0,0 +1,55 @@
INTERP = $03D0
LCRDEN = $C080
LCWTEN = $C081
ROMEN = $C082
LCRWEN = $C083
LCBNK2 = $00
LCBNK1 = $08
JITCOMP = $03E2
JITCODE = $03E4
!SOURCE "vmsrc/plvmzp.inc"
;*
;* MOVE CMD DOWN TO $1000-$2000
;*
LDA #<_CMDBEGIN
STA SRCL
LDA #>_CMDBEGIN
STA SRCH
LDY #$00
STY DSTL
LDX #$10
STX DSTH
- LDA (SRC),Y
STA (DST),Y
INY
BNE -
INC SRCH
INC DSTH
DEX ; STOP WHEN DST=$2000 REACHED
BNE -
LDA #<_CMDEND
STA SRCL
LDA #>_CMDEND
STA SRCH
;
; INIT VM ENVIRONMENT STACK POINTERS
;
STY JITCOMP
STY JITCOMP+1
STY PPL
STY IFPL ; INIT FRAME POINTER
STY JITCODE
LDA #$AF
STA PPH
STA IFPH
STA JITCODE+1
LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS)
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
JMP $1000
_CMDBEGIN = *
!PSEUDOPC $1000 {
!SOURCE "vmsrc/apple/cmdjit.a"
_CMDEND = *
}

401
src/vmsrc/apple/plvm01.s
View File

@ -109,14 +109,18 @@ COMP LDA #$FF
;* OPCODE TABLE ;* OPCODE TABLE
;* ;*
!ALIGN 255,0 !ALIGN 255,0
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 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 CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 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 ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
!WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E !WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 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 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 !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
!WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E
!WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE
!WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE
;* ;*
;* DIV TOS-1 BY TOS ;* DIV TOS-1 BY TOS
;* ;*
@ -324,31 +328,6 @@ SHR STY IPY
+ LDY IPY + LDY IPY
JMP DROP JMP DROP
;* ;*
;* LOGICAL AND
;*
LAND LDA ESTKL+1,X
ORA ESTKH+1,X
BEQ ++
LDA ESTKL,X
ORA ESTKH,X
BEQ +
LDA #$FF
+ STA ESTKL+1,X
STA ESTKH+1,X
++ JMP DROP
;*
;* LOGICAL OR
;*
LOR LDA ESTKL,X
ORA ESTKH,X
ORA ESTKL+1,X
ORA ESTKH+1,X
BEQ +
LDA #$FF
STA ESTKL+1,X
STA ESTKH+1,X
+ JMP DROP
;*
;* DUPLICATE TOS ;* DUPLICATE TOS
;* ;*
DUP DEX DUP DEX
@ -358,23 +337,69 @@ DUP DEX
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
;* ;*
;* ADD IMMEDIATE TO TOS
;*
ADDI INY ;+INC_IP
LDA (IP),Y
CLC
ADC ESTKL,X
STA ESTKL,X
BCC +
INC ESTKH,X
+ JMP NEXTOP
;*
;* SUB IMMEDIATE FROM TOS
;*
SUBI INY ;+INC_IP
LDA ESTKL,X
SEC
SBC (IP),Y
STA ESTKL,X
BCS +
DEC ESTKH,X
+ JMP NEXTOP
;*
;* AND IMMEDIATE TO TOS
;*
ANDI INY ;+INC_IP
LDA (IP),Y
AND ESTKL,X
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
;*
;* IOR IMMEDIATE TO TOS
;*
ORI INY ;+INC_IP
LDA (IP),Y
ORA ESTKL,X
STA ESTKL,X
JMP NEXTOP
;*
;* LOGICAL NOT ;* LOGICAL NOT
;* ;*
LNOT LDA ESTKL,X LNOT LDA ESTKL,X
ORA ESTKH,X ORA ESTKH,X
BNE + BEQ +
LDA #$FF LDA #$00
STA ESTKL,X STA ESTKL,X
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
;* ;*
;* CONSTANT ;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW)
;* ;*
ZERO DEX MINUS1 DEX
+ LDA #$00 + LDA #$FF
STA ESTKL,X STA ESTKL,X
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
CN DEX
LSR ; A = CONST * 2
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
CFFB LDA #$FF CFFB LDA #$FF
!BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address !BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address
CB LDA #$00 CB LDA #$00
@ -476,7 +501,7 @@ LLA INY ;+INC_IP
;* ;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET ;* LOAD VALUE FROM LOCAL FRAME OFFSET
;* ;*
LLB INY ;+INC_IP _LLB INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
STY IPY STY IPY
TAY TAY
@ -486,8 +511,8 @@ LLB INY ;+INC_IP
LDA #$00 LDA #$00
STA ESTKH,X STA ESTKH,X
LDY IPY LDY IPY
JMP NEXTOP RTS
LLW INY ;+INC_IP _LLW INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
STY IPY STY IPY
TAY TAY
@ -498,11 +523,29 @@ LLW INY ;+INC_IP
LDA (IFP),Y LDA (IFP),Y
STA ESTKH,X STA ESTKH,X
LDY IPY LDY IPY
RTS
LLB JSR _LLB
JMP NEXTOP JMP NEXTOP
LLW JSR _LLW
JMP NEXTOP
;*
;* ADD VALUE FROM LOCAL FRAME OFFSET
;*
ADDLB JSR _LLB
JMP ADD
ADDLW JSR _LLW
JMP ADD
;*
;* INDEX VALUE FROM LOCAL FRAME OFFSET
;*
IDXLB JSR _LLB
JMP IDXW
IDXLW JSR _LLW
JMP IDXW
;* ;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* LOAD VALUE FROM ABSOLUTE ADDRESS
;* ;*
LAB INY ;+INC_IP _LAB INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
STA ESTKH-2,X STA ESTKH-2,X
INY ;+INC_IP INY ;+INC_IP
@ -513,8 +556,8 @@ LAB INY ;+INC_IP
STA ESTKL,X STA ESTKL,X
LDA #$00 LDA #$00
STA ESTKH,X STA ESTKH,X
JMP NEXTOP RTS
LAW INY ;+INC_IP _LAW INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
STA TMPL STA TMPL
INY ;+INC_IP INY ;+INC_IP
@ -529,7 +572,25 @@ LAW INY ;+INC_IP
LDA (TMP),Y LDA (TMP),Y
STA ESTKH,X STA ESTKH,X
LDY IPY LDY IPY
RTS
LAB JSR _LAB
JMP NEXTOP JMP NEXTOP
LAW JSR _LAW
JMP NEXTOP
;*
;* ADD VALUE FROM ABSOLUTE ADDRESS
;*
ADDAB JSR _LAB
JMP ADD
ADDAW JSR _LAW
JMP ADD
;*
;* INDEX VALUE FROM ABSOLUTE ADDRESS
;*
IDXAB JSR _LAB
JMP IDXW
IDXAW JSR _LAW
JMP IDXW
;* ;*
;* STORE VALUE TO ADDRESS ;* STORE VALUE TO ADDRESS
;* ;*
@ -551,7 +612,10 @@ SW LDA ESTKL,X
JMP DROP JMP DROP
+ INC ESTKH,X + INC ESTKH,X
STA (ESTKH-1,X) STA (ESTKH-1,X)
INX ;*
;* DROP2
;*
DROP2 INX
JMP DROP JMP DROP
;* ;*
;* STORE VALUE TO LOCAL FRAME OFFSET ;* STORE VALUE TO LOCAL FRAME OFFSET
@ -594,6 +658,8 @@ DLB INY ;+INC_IP
TAY TAY
LDA ESTKL,X LDA ESTKL,X
STA (IFP),Y STA (IFP),Y
LDA #$00
STA ESTKH,X
LDY IPY LDY IPY
JMP NEXTOP JMP NEXTOP
DLW INY ;+INC_IP DLW INY ;+INC_IP
@ -654,6 +720,8 @@ DAB INY ;+INC_IP
STA ESTKH-1,X STA ESTKH-1,X
LDA ESTKL,X LDA ESTKL,X
STA (ESTKH-2,X) STA (ESTKH-2,X)
LDA #$00
STA ESTKH,X
JMP NEXTOP JMP NEXTOP
DAW INY ;+INC_IP DAW INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
@ -683,7 +751,6 @@ ISTRU LDA #$FF
STA ESTKL+1,X STA ESTKL+1,X
STA ESTKH+1,X STA ESTKH+1,X
JMP DROP JMP DROP
;
ISNE LDA ESTKL,X ISNE LDA ESTKL,X
CMP ESTKL+1,X CMP ESTKL+1,X
BNE ISTRU BNE ISTRU
@ -694,7 +761,6 @@ ISFLS LDA #$00
STA ESTKL+1,X STA ESTKL+1,X
STA ESTKH+1,X STA ESTKH+1,X
JMP DROP JMP DROP
;
ISGE LDA ESTKL+1,X ISGE LDA ESTKL+1,X
CMP ESTKL,X CMP ESTKL,X
LDA ESTKH+1,X LDA ESTKH+1,X
@ -702,9 +768,16 @@ ISGE LDA ESTKL+1,X
BVS + BVS +
BPL ISTRU BPL ISTRU
BMI ISFLS BMI ISFLS
+ BPL ISFLS +
- BPL ISFLS
BMI ISTRU BMI ISTRU
; ISLE LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS -
BPL ISTRU
BMI ISFLS
ISGT LDA ESTKL,X ISGT LDA ESTKL,X
CMP ESTKL+1,X CMP ESTKL+1,X
LDA ESTKH,X LDA ESTKH,X
@ -712,31 +785,114 @@ ISGT LDA ESTKL,X
BVS + BVS +
BMI ISTRU BMI ISTRU
BPL ISFLS BPL ISFLS
+ BMI ISFLS +
- BMI ISFLS
BPL ISTRU BPL ISTRU
;
ISLE LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
BMI ISTRU
;
ISLT LDA ESTKL+1,X ISLT LDA ESTKL+1,X
CMP ESTKL,X CMP ESTKL,X
LDA ESTKH+1,X LDA ESTKH+1,X
SBC ESTKH,X SBC ESTKH,X
BVS + BVS -
BMI ISTRU BMI ISTRU
BPL ISFLS BPL ISFLS
+ BMI ISFLS
BPL ISTRU
;* ;*
;* BRANCHES ;* BRANCHES
;* ;*
SEL INX
TYA ; FLATTEN IP
SEC
ADC IPL
STA TMPL
LDA #$00
TAY
ADC IPH
STA TMPH ; ADD BRANCH OFFSET
LDA (TMP),Y
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC TMPL
STA IPL
INY
LDA (TMP),Y
ADC TMPH
STA IPH
DEY
LDA (IP),Y
STA TMPL ; CASE COUNT
INC IPL
BNE CASELP
INC IPH
CASELP LDA ESTKL-1,X
CMP (IP),Y
BEQ +
LDA ESTKH-1,X
INY
SBC (IP),Y
BMI CASEEND
- INY
INY
DEC TMPL
BEQ FIXNEXT
INY
BNE CASELP
INC IPH
BNE CASELP
+ LDA ESTKH-1,X
INY
SBC (IP),Y
BEQ BRNCH
BPL -
CASEEND LDA #$00
STA TMPH
DEC TMPL
LDA TMPL
ASL ; SKIP REMAINING CASES
ROL TMPH
ASL
ROL TMPH
; CLC
ADC IPL
STA IPL
LDA TMPH
ADC IPH
STA IPH
INY
INY
FIXNEXT TYA
LDY #$00
SEC
ADC IPL
STA IPL
BCC +
INC IPH
+ JMP FETCHOP
BRAND LDA ESTKL,X
ORA ESTKH,X
BEQ BRNCH
INX ; DROP LEFT HALF OF AND
BNE NOBRNCH
BROR LDA ESTKL,X
ORA ESTKH,X
BNE BRNCH
INX ; DROP LEFT HALF OF OR
BNE NOBRNCH
BREQ INX
INX
LDA ESTKL-2,X
CMP ESTKL-1,X
BNE NOBRNCH
LDA ESTKH-2,X
CMP ESTKH-1,X
BEQ BRNCH
BNE NOBRNCH
BRNE INX
INX
LDA ESTKL-2,X
CMP ESTKL-1,X
BNE BRNCH
LDA ESTKH-2,X
CMP ESTKH-1,X
BNE BRNCH
BEQ NOBRNCH
BRTRU INX BRTRU INX
LDA ESTKH-1,X LDA ESTKH-1,X
ORA ESTKL-1,X ORA ESTKL-1,X
@ -745,14 +901,6 @@ NOBRNCH INY ;+INC_IP
INY ;+INC_IP INY ;+INC_IP
BMI FIXNEXT BMI FIXNEXT
JMP NEXTOP JMP NEXTOP
FIXNEXT TYA
LDY #$00
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ JMP NEXTOP
BRFLS INX BRFLS INX
LDA ESTKH-1,X LDA ESTKH-1,X
ORA ESTKL-1,X ORA ESTKL-1,X
@ -775,58 +923,75 @@ BRNCH TYA ; FLATTEN IP
STA IPH STA IPH
DEY DEY
JMP FETCHOP JMP FETCHOP
BREQ INX ;*
LDA ESTKL-1,X ;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK
;*
BRGT LDA ESTKL+1,X
CMP ESTKL,X CMP ESTKL,X
BNE NOBRNCH LDA ESTKH+1,X
LDA ESTKH-1,X
CMP ESTKH,X
BEQ BRNCH
BNE NOBRNCH
BRNE INX
LDA ESTKL-1,X
CMP ESTKL,X
BNE BRNCH
LDA ESTKH-1,X
CMP ESTKH,X
BEQ NOBRNCH
BNE BRNCH
BRGT INX
LDA ESTKL-1,X
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X SBC ESTKH,X
BVS + BVS +
BPL NOBRNCH BPL NOBRNCH
BMI BRNCH - INX ; DROP FOR VALUES
+ BPL BRNCH INX
BMI NOBRNCH BNE BRNCH ; BMI BRNCH
BRLT INX BRLT LDA ESTKL,X
LDA ESTKL,X CMP ESTKL+1,X
CMP ESTKL-1,X
LDA ESTKH,X LDA ESTKH,X
SBC ESTKH-1,X SBC ESTKH+1,X
BVS + BVS +
BPL NOBRNCH BPL NOBRNCH
BMI BRNCH INX ; DROP FOR VALUES
+ BPL BRNCH INX
BMI NOBRNCH BNE BRNCH ; BMI BRNCH
IBRNCH TYA ; FLATTEN IP + BMI NOBRNCH
BPL -
DECBRGE DEC ESTKL,X
LDA ESTKL,X
CMP #$FF
BNE +
DEC ESTKH,X
_BRGE LDA ESTKL,X
+ CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL BRNCH
- INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
INCBRLE INC ESTKL,X
BNE _BRLE
INC ESTKH,X
_BRLE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BPL BRNCH
INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
+ BMI BRNCH
BPL -
SUBBRGE LDA ESTKL+1,X
SEC
SBC ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
SBC ESTKH,X
STA ESTKH+1,X
INX
BNE _BRGE
ADDBRLE LDA ESTKL,X
CLC CLC
ADC IPL ADC ESTKL+1,X
STA TMPL STA ESTKL+1,X
LDA #$00 LDA ESTKH,X
TAY ADC ESTKH+1,X
ADC IPH STA ESTKH+1,X
STA TMPH ; ADD BRANCH OFFSET INX
LDA TMPL BNE _BRLE
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC ESTKL,X
STA IPL
LDA TMPH
ADC ESTKH,X
STA IPH
JMP DROP
;* ;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE) ;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;* ;*
@ -846,7 +1011,7 @@ CALL INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
STA TMPH STA TMPH
_CALL TYA _CALL TYA
CLC SEC
ADC IPL ADC IPL
PHA PHA
LDA IPH LDA IPH
@ -857,7 +1022,7 @@ _CALL TYA
STA IPH STA IPH
PLA PLA
STA IPL STA IPL
LDY #$01 LDY #$00
JMP FETCHOP JMP FETCHOP
;* ;*
;* JUMP INDIRECT TRHOUGH TMP ;* JUMP INDIRECT TRHOUGH TMP

784
src/vmsrc/apple/plvm02.s
View File

File diff suppressed because it is too large Load Diff

636
src/vmsrc/apple/plvm03.s
View File

@ -49,10 +49,6 @@ SEGSTART = $2000
!WORD SEGSTART !WORD SEGSTART
!WORD SEGEND-SEGSTART !WORD SEGEND-SEGSTART
; +SOS $40, SEGREQ ; ALLOCATE SEG 1 AND MAP IT
; BNE FAIL ; PRHEX
; LDA #$00
; STA MEMBANK
LDY #$0F ; INSTALL PAGE 0 FETCHOP ROUTINE LDY #$0F ; INSTALL PAGE 0 FETCHOP ROUTINE
LDA #$00 LDA #$00
- LDX PAGE0,Y - LDX PAGE0,Y
@ -65,16 +61,9 @@ SEGSTART = $2000
STA TMPX ; CLEAR ALL EXTENDED POINTERS STA TMPX ; CLEAR ALL EXTENDED POINTERS
STA SRCX STA SRCX
STA DSTX STA DSTX
STA PPX ; INIT FRAME & POOL POINTERS STA PPX
STA IFPX STA IFPX
LDA #$00 LDA #<VMCORE ; COPY VM+SYS INTO SBANK
STA PPL
STA IFPL
LDA #$A0
STA PPH
STA IFPH
!IF 1 {
LDA #<VMCORE ; COPY VM+CMD INTO SBANK
STA SRCL STA SRCL
LDA #>VMCORE LDA #>VMCORE
STA SRCH STA SRCH
@ -91,7 +80,16 @@ SEGSTART = $2000
LDA DSTH LDA DSTH
CMP #$B8 CMP #$B8
BNE - BNE -
} LDA #$00 ; INIT JIT, FRAME & POOL POINTERS
STA JITCOMP
STA JITCOMP+1
STA JITCODE
STA PPL
STA IFPL
LDA #$90 ; RESERVE 4K FOR JITCODE
STA JITCODE+1
STA PPH
STA IFPH
LDX #$FF ; INIT STACK POINTER LDX #$FF ; INIT STACK POINTER
TXS TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
@ -134,18 +132,30 @@ PAGE0 = *
} }
VMCORE = * VMCORE = *
!PSEUDOPC $A000 { !PSEUDOPC $A000 {
TEMPBUF !FILL $F0
CMDPARS !WORD 0 ; $A0F0
JITCOMP !WORD 0 ; $A0F2
JITCODE !WORD 0 ; $A0F4
SENTRY !WORD INTERP ; $A0F6
XENTRY !WORD XINTERP ; $A0F8
JENTRY !WORD JITINTRP ; $A0FA
;* ;*
;* OPCODE TABLE ;* OPCODE TABLE
;* ;*
!ALIGN 255,0 !ALIGN 255,0
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 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 CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 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 ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
!WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E !WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 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 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 !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
!WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E
!WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE
!WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE
!WORD NATV ; C0
;* ;*
;* SYSTEM INTERPRETER ENTRYPOINT ;* SYSTEM INTERPRETER ENTRYPOINT
;* ;*
@ -166,7 +176,7 @@ XINTERP PLA
STA TMPL STA TMPL
PLA PLA
STA TMPH STA TMPH
LDY #$03 - LDY #$03
LDA (TMP),Y LDA (TMP),Y
STA IPX STA IPX
DEY DEY
@ -178,6 +188,49 @@ XINTERP PLA
DEY DEY
JMP FETCHOP JMP FETCHOP
;* ;*
;* JIT PROFILING ENTRY INTO INTERPRETER
;*
JITINTRP PLA
STA TMPL
PLA
STA TMPH
LDY #$04
LDA (TMP),Y ; DEC JIT COUNT
SEC
SBC #$01
STA (TMP),Y
BNE - ; INTERP BYTECODE
LDA JITCOMP ; CALL JIT COMPILER
STA SRCL
LDA JITCOMP+1
STA SRCH
INY ; LDY #$05
LDA (SRC),Y
STA IPX
DEY
LDA (SRC),Y
STA IPH
DEY
LDA (SRC),Y
STA IPL
DEX ; ADD PARAMETER TO DEF ENTRY
LDA TMPL
SEC
SBC #$02 ; POINT TO DEF ENTRY
PHA ; AND SAVE IT FOR LATER
STA ESTKL,X
LDA TMPH
SBC #$00
PHA
STA ESTKH,X
LDY #$00
JSR FETCHOP ; CALL JIT COMPILER
PLA
STA TMPH
PLA
STA TMPL
JMP (TMP) ; RE-CALL ORIGINAL DEF ENTRY
;*
;* INTERNAL DIVIDE ALGORITHM ;* INTERNAL DIVIDE ALGORITHM
;* ;*
_NEG LDA #$00 _NEG LDA #$00
@ -439,31 +492,6 @@ SHR STY IPY
+ LDY IPY + LDY IPY
JMP DROP JMP DROP
;* ;*
;* LOGICAL AND
;*
LAND LDA ESTKL+1,X
ORA ESTKH+1,X
BEQ ++
LDA ESTKL,X
ORA ESTKH,X
BEQ +
LDA #$FF
+ STA ESTKL+1,X
STA ESTKH+1,X
++ JMP DROP
;*
;* LOGICAL OR
;*
LOR LDA ESTKL,X
ORA ESTKH,X
ORA ESTKL+1,X
ORA ESTKH+1,X
BEQ +
LDA #$FF
STA ESTKL+1,X
STA ESTKH+1,X
+ JMP DROP
;*
;* DUPLICATE TOS ;* DUPLICATE TOS
;* ;*
DUP DEX DUP DEX
@ -473,25 +501,76 @@ DUP DEX
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
;* ;*
;* ADD IMMEDIATE TO TOS
;*
ADDI INY ;+INC_IP
LDA (IP),Y
CLC
ADC ESTKL,X
STA ESTKL,X
BCC +
INC ESTKH,X
+ JMP NEXTOP
;*
;* SUB IMMEDIATE FROM TOS
;*
SUBI INY ;+INC_IP
LDA ESTKL,X
SEC
SBC (IP),Y
STA ESTKL,X
BCS +
DEC ESTKH,X
+ JMP NEXTOP
;*
;* AND IMMEDIATE TO TOS
;*
ANDI INY ;+INC_IP
LDA (IP),Y
AND ESTKL,X
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
;*
;* IOR IMMEDIATE TO TOS
;*
ORI INY ;+INC_IP
LDA (IP),Y
ORA ESTKL,X
STA ESTKL,X
JMP NEXTOP
;*
;* LOGICAL NOT ;* LOGICAL NOT
;* ;*
LNOT LDA ESTKL,X LNOT LDA ESTKL,X
ORA ESTKH,X ORA ESTKH,X
BNE + BEQ +
LDA #$FF LDA #$00
STA ESTKL,X STA ESTKL,X
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
;* ;*
;* CONSTANT ;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW)
;* ;*
ZERO DEX MINUS1 DEX
+ LDA #$00 + LDA #$FF
STA ESTKL,X STA ESTKL,X
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
CN DEX
LSR ; A = CONST * 2
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
CFFB LDA #$FF CFFB LDA #$FF
!BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address DEX
STA ESTKH,X
INY ;+INC_IP
LDA (IP),Y
STA ESTKL,X
JMP NEXTOP
CB LDA #$00 CB LDA #$00
DEX DEX
STA ESTKH,X STA ESTKH,X
@ -608,12 +687,9 @@ LW LDA ESTKL,X
LDA (ESTKH-1,X) LDA (ESTKH-1,X)
STA ESTKL,X STA ESTKL,X
INC ESTKH-1,X INC ESTKH-1,X
BEQ + BNE +
LDA (ESTKH-1,X) INC ESTKH,X
STA ESTKH,X + LDA (ESTKH-1,X)
JMP NEXTOP
+ INC ESTKH,X
LDA (ESTKH-1,X)
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
;* ;*
@ -664,6 +740,75 @@ LLW INY ;+INC_IP
LDY IPY LDY IPY
JMP NEXTOP JMP NEXTOP
;* ;*
;* ADD VALUE FROM LOCAL FRAME OFFSET
;*
ADDLB INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA (IFP),Y
CLC
ADC ESTKL,X
STA ESTKL,X
BCC +
INC ESTKH,X
+ LDY IPY
JMP NEXTOP
ADDLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA (IFP),Y
CLC
ADC ESTKL,X
STA ESTKL,X
INY
LDA (IFP),Y
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* INDEX VALUE FROM LOCAL FRAME OFFSET
;*
IDXLB INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA (IFP),Y
LDY #$00
ASL
BCC +
INY
CLC
+ ADC ESTKL,X
STA ESTKL,X
TYA
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
IDXLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA (IFP),Y
ASL
STA TMPL
INY
LDA (IFP),Y
ROL
STA TMPH
LDA TMPL
CLC
ADC ESTKL,X
STA ESTKL,X
LDA TMPH
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* LOAD VALUE FROM ABSOLUTE ADDRESS
;* ;*
LAB INY ;+INC_IP LAB INY ;+INC_IP
@ -695,6 +840,87 @@ LAW INY ;+INC_IP
LDY IPY LDY IPY
JMP NEXTOP JMP NEXTOP
;* ;*
;* ADD VALUE FROM ABSOLUTE ADDRESS
;*
ADDAB INY ;+INC_IP
LDA (IP),Y
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA ESTKH-1,X
LDA (ESTKH-2,X)
CLC
ADC ESTKL,X
STA ESTKL,X
BCC +
INC ESTKH,X
+ JMP NEXTOP
ADDAW INY ;+INC_IP
LDA (IP),Y
STA SRCL
INY ;+INC_IP
LDA (IP),Y
STA SRCH
STY IPY
LDY #$00
LDA (SRC),Y
CLC
ADC ESTKL,X
STA ESTKL,X
INY
LDA (SRC),Y
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* INDEX VALUE FROM ABSOLUTE ADDRESS
;*
IDXAB INY ;+INC_IP
LDA (IP),Y
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA ESTKH-1,X
LDA (ESTKH-2,X)
STY IPY
LDY #$00
ASL
BCC +
INY
CLC
+ ADC ESTKL,X
STA ESTKL,X
TYA
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
IDXAW INY ;+INC_IP
LDA (IP),Y
STA SRCL
INY ;+INC_IP
LDA (IP),Y
STA SRCH
STY IPY
LDY #$00
LDA (SRC),Y
ASL
STA TMPL
INY
LDA (SRC),Y
ROL
STA TMPH
LDA TMPL
CLC
ADC ESTKL,X
STA ESTKL,X
LDA TMPH
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* STORE VALUE TO ADDRESS ;* STORE VALUE TO ADDRESS
;* ;*
SB LDA ESTKL,X SB LDA ESTKL,X
@ -709,13 +935,13 @@ SW LDA ESTKL,X
STA (ESTKH-1,X) STA (ESTKH-1,X)
LDA ESTKH+1,X LDA ESTKH+1,X
INC ESTKH-1,X INC ESTKH-1,X
BEQ + BNE +
STA (ESTKH-1,X) INC ESTKH,X
INX + STA (ESTKH-1,X)
JMP DROP ;*
+ INC ESTKH,X ;* DROP TOS, TOS-1
STA (ESTKH-1,X) ;*
INX DROP2 INX
JMP DROP JMP DROP
;* ;*
;* STORE VALUE TO LOCAL FRAME OFFSET ;* STORE VALUE TO LOCAL FRAME OFFSET
@ -758,6 +984,8 @@ DLB INY ;+INC_IP
TAY TAY
LDA ESTKL,X LDA ESTKL,X
STA (IFP),Y STA (IFP),Y
LDA #$00
STA ESTKH,X
LDY IPY LDY IPY
JMP NEXTOP JMP NEXTOP
DLW INY ;+INC_IP DLW INY ;+INC_IP
@ -818,6 +1046,8 @@ DAB INY ;+INC_IP
STA ESTKH-1,X STA ESTKH-1,X
LDA ESTKL,X LDA ESTKL,X
STA (ESTKH-2,X) STA (ESTKH-2,X)
LDA #$00
STA ESTKH,X
JMP NEXTOP JMP NEXTOP
DAW INY ;+INC_IP DAW INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
@ -847,7 +1077,6 @@ ISTRU LDA #$FF
STA ESTKL+1,X STA ESTKL+1,X
STA ESTKH+1,X STA ESTKH+1,X
JMP DROP JMP DROP
;
ISNE LDA ESTKL,X ISNE LDA ESTKL,X
CMP ESTKL+1,X CMP ESTKL+1,X
BNE ISTRU BNE ISTRU
@ -858,7 +1087,6 @@ ISFLS LDA #$00
STA ESTKL+1,X STA ESTKL+1,X
STA ESTKH+1,X STA ESTKH+1,X
JMP DROP JMP DROP
;
ISGE LDA ESTKL+1,X ISGE LDA ESTKL+1,X
CMP ESTKL,X CMP ESTKL,X
LDA ESTKH+1,X LDA ESTKH+1,X
@ -866,9 +1094,16 @@ ISGE LDA ESTKL+1,X
BVS + BVS +
BPL ISTRU BPL ISTRU
BMI ISFLS BMI ISFLS
+ BPL ISFLS +
- BPL ISFLS
BMI ISTRU BMI ISTRU
; ISLE LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS -
BPL ISTRU
BMI ISFLS
ISGT LDA ESTKL,X ISGT LDA ESTKL,X
CMP ESTKL+1,X CMP ESTKL+1,X
LDA ESTKH,X LDA ESTKH,X
@ -876,42 +1111,117 @@ ISGT LDA ESTKL,X
BVS + BVS +
BMI ISTRU BMI ISTRU
BPL ISFLS BPL ISFLS
+ BMI ISFLS +
- BMI ISFLS
BPL ISTRU BPL ISTRU
;
ISLE LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
BMI ISTRU
;
ISLT LDA ESTKL+1,X ISLT LDA ESTKL+1,X
CMP ESTKL,X CMP ESTKL,X
LDA ESTKH+1,X LDA ESTKH+1,X
SBC ESTKH,X SBC ESTKH,X
BVS + BVS -
BMI ISTRU BMI ISTRU
BPL ISFLS BPL ISFLS
+ BMI ISFLS
BPL ISTRU
;* ;*
;* NORMALIZE IP+Y BEFORE CALLING NEXTOP ;* BRANCHES
;* ;*
SEL INX
TYA ; FLATTEN IP
SEC
ADC IPL
STA TMPL
LDA #$00
TAY
ADC IPH
STA TMPH ; ADD CASEBLOCK OFFSET
LDA IPX ; COPY XBYTE FROM IP
STA TMPX
LDA (TMP),Y
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC TMPL
STA IPL
INY
LDA (TMP),Y
ADC TMPH
STA IPH
DEY
STY TMPX ; CLEAR TMPX
LDA (IP),Y
STA TMPL ; CASE COUNT
INC IPL
BNE CASELP
INC IPH
CASELP LDA ESTKL-1,X
CMP (IP),Y
BEQ +
LDA ESTKH-1,X
INY
SBC (IP),Y
BMI CASEEND
- INY
INY
DEC TMPL
BEQ FIXNEXT
INY
BNE CASELP
INC IPH
BNE CASELP
+ LDA ESTKH-1,X
INY
SBC (IP),Y
BEQ BRNCH
BPL -
CASEEND LDA #$00
STA TMPH
DEC TMPL
LDA TMPL
ASL ; SKIP REMAINING CASES
ROL TMPH
ASL
ROL TMPH
; CLC
ADC IPL
STA IPL
LDA TMPH
ADC IPH
STA IPH
INY
INY
FIXNEXT TYA FIXNEXT TYA
LDY #$00 LDY #$00
CLC SEC
ADC IPL ADC IPL
STA IPL STA IPL
BCC + BCC +
INC IPH INC IPH
+ JMP NEXTOP + JMP FETCHOP
;* BRAND LDA ESTKL,X
;* BRANCHES ORA ESTKH,X
;* BEQ BRNCH
INX ; DROP LEFT HALF OF AND
BNE NOBRNCH
BROR LDA ESTKL,X
ORA ESTKH,X
BNE BRNCH
INX ; DROP LEFT HALF OF OR
BNE NOBRNCH
BREQ INX
INX
LDA ESTKL-2,X
CMP ESTKL-1,X
BNE NOBRNCH
LDA ESTKH-2,X
CMP ESTKH-1,X
BEQ BRNCH
BNE NOBRNCH
BRNE INX
INX
LDA ESTKL-2,X
CMP ESTKL-1,X
BNE BRNCH
LDA ESTKH-2,X
CMP ESTKH-1,X
BNE BRNCH
BEQ NOBRNCH
BRTRU INX BRTRU INX
LDA ESTKH-1,X LDA ESTKH-1,X
ORA ESTKL-1,X ORA ESTKL-1,X
@ -945,67 +1255,97 @@ BRNCH TYA ; FLATTEN IP
DEY DEY
STY TMPX ; CLEAR TMPX STY TMPX ; CLEAR TMPX
JMP FETCHOP JMP FETCHOP
BREQ INX ;*
LDA ESTKL-1,X ;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK
;*
BRGT LDA ESTKL+1,X
CMP ESTKL,X CMP ESTKL,X
BNE NOBRNCH LDA ESTKH+1,X
LDA ESTKH-1,X
CMP ESTKH,X
BEQ BRNCH
BNE NOBRNCH
BRNE INX
LDA ESTKL-1,X
CMP ESTKL,X
BNE BRNCH
LDA ESTKH-1,X
CMP ESTKH,X
BEQ NOBRNCH
BNE BRNCH
BRGT INX
LDA ESTKL-1,X
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X SBC ESTKH,X
BVS + BVS +
BPL NOBRNCH BPL NOBRNCH
BMI BRNCH - INX ; DROP FOR VALUES
+ BPL BRNCH INX
BMI NOBRNCH BNE BRNCH ; BMI BRNCH
BRLT INX BRLT LDA ESTKL,X
LDA ESTKL,X CMP ESTKL+1,X
CMP ESTKL-1,X
LDA ESTKH,X LDA ESTKH,X
SBC ESTKH-1,X SBC ESTKH+1,X
BVS + BVS +
BPL NOBRNCH BPL NOBRNCH
BMI BRNCH BMI -
+ BPL BRNCH + BMI NOBRNCH
BMI NOBRNCH BPL -
IBRNCH TYA ; FLATTEN IP INCBRLE INC ESTKL,X
BNE _BRLE
INC ESTKH,X
_BRLE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BPL BRNCH
- INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
DECBRGE DEC ESTKL,X
LDA ESTKL,X
CMP #$FF
BNE +
DEC ESTKH,X
_BRGE LDA ESTKL,X
+ CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL BRNCH
BMI -
+ BMI BRNCH
BPL -
SUBBRGE LDA ESTKL+1,X
SEC
SBC ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
SBC ESTKH,X
STA ESTKH+1,X
INX
BNE _BRGE
ADDBRLE LDA ESTKL,X
CLC CLC
ADC IPL ADC ESTKL+1,X
STA TMPL STA ESTKL+1,X
LDA #$00 LDA ESTKH,X
TAY ADC ESTKH+1,X
ADC IPH STA ESTKH+1,X
STA TMPH ; ADD BRANCH OFFSET INX
LDA TMPL BNE _BRLE
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC ESTKL,X
STA IPL
LDA TMPH
ADC ESTKH,X
STA IPH
JMP DROP
;* ;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE) ;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;* ;*
ICAL LDA ESTKL,X ICAL LDA ESTKL,X
STA CALLADR+1 STA ICALADR+1
LDA ESTKH,X LDA ESTKH,X
STA CALLADR+2 STA ICALADR+2
INX INX
BNE _CALL TYA
SEC
ADC IPL
PHA
LDA IPH
ADC #$00
PHA
LDA IPX
PHA
ICALADR JSR $FFFF
PLA
STA IPX
PLA
STA IPH
PLA
STA IPL
LDY #$00
JMP FETCHOP
;* ;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE) ;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;* ;*
@ -1016,7 +1356,7 @@ CALL INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
STA CALLADR+2 STA CALLADR+2
_CALL TYA _CALL TYA
CLC SEC
ADC IPL ADC IPL
PHA PHA
LDA IPH LDA IPH
@ -1031,7 +1371,7 @@ CALLADR JSR $FFFF
STA IPH STA IPH
PLA PLA
STA IPL STA IPL
LDY #$01 LDY #$00
JMP FETCHOP JMP FETCHOP
;* ;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT ;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
@ -1082,7 +1422,19 @@ LEAVE INY ;+INC_IP
PLA PLA
STA IFPH STA IFPH
RET RTS RET RTS
;*
;* RETURN TO NATIVE CODE
;*
NATV TYA ; FLATTEN IP
SEC
ADC IPL
STA TMPL
LDA #$00
ADC IPH
STA TMPH
JMP JMPTMP
SOSCMD = * SOSCMD = *
!SOURCE "vmsrc/apple/soscmd.a" !SOURCE "vmsrc/apple/sossys.a"
} }
SEGEND = * SEGEND = *

747
src/vmsrc/apple/plvm802.s
View File

File diff suppressed because it is too large Load Diff

2411
src/vmsrc/apple/plvmjit02.s Executable file
View File

File diff suppressed because it is too large Load Diff

1504
src/vmsrc/apple/soscmd.pla
View File

File diff suppressed because it is too large Load Diff

1335
src/vmsrc/apple/sossys.pla Executable file
View File

File diff suppressed because it is too large Load Diff

399
src/vmsrc/c64/plvmc64.s
View File

@ -109,14 +109,18 @@ COMP LDA #$FF
;* OPCODE TABLE ;* OPCODE TABLE
;* ;*
!ALIGN 255,0 !ALIGN 255,0
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 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 CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E !WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E !WORD DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 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 ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
!WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E !WORD BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 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 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 !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
!WORD LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E
!WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE
!WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE
;* ;*
;* DIV TOS-1 BY TOS ;* DIV TOS-1 BY TOS
;* ;*
@ -324,31 +328,6 @@ SHR STY IPY
+ LDY IPY + LDY IPY
JMP DROP JMP DROP
;* ;*
;* LOGICAL AND
;*
LAND LDA ESTKL+1,X
ORA ESTKH+1,X
BEQ ++
LDA ESTKL,X
ORA ESTKH,X
BEQ +
LDA #$FF
+ STA ESTKL+1,X
STA ESTKH+1,X
++ JMP DROP
;*
;* LOGICAL OR
;*
LOR LDA ESTKL,X
ORA ESTKH,X
ORA ESTKL+1,X
ORA ESTKH+1,X
BEQ +
LDA #$FF
STA ESTKL+1,X
STA ESTKH+1,X
+ JMP DROP
;*
;* DUPLICATE TOS ;* DUPLICATE TOS
;* ;*
DUP DEX DUP DEX
@ -358,23 +337,69 @@ DUP DEX
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
;* ;*
;* ADD IMMEDIATE TO TOS
;*
ADDI INY ;+INC_IP
LDA (IP),Y
CLC
ADC ESTKL,X
STA ESTKL,X
BCC +
INC ESTKH,X
+ JMP NEXTOP
;*
;* SUB IMMEDIATE FROM TOS
;*
SUBI INY ;+INC_IP
LDA ESTKL,X
SEC
SBC (IP),Y
STA ESTKL,X
BCS +
DEC ESTKH,X
+ JMP NEXTOP
;*
;* AND IMMEDIATE TO TOS
;*
ANDI INY ;+INC_IP
LDA (IP),Y
AND ESTKL,X
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
;*
;* IOR IMMEDIATE TO TOS
;*
ORI INY ;+INC_IP
LDA (IP),Y
ORA ESTKL,X
STA ESTKL,X
JMP NEXTOP
;*
;* LOGICAL NOT ;* LOGICAL NOT
;* ;*
LNOT LDA ESTKL,X LNOT LDA ESTKL,X
ORA ESTKH,X ORA ESTKH,X
BNE + BEQ +
LDA #$FF LDA #$00
STA ESTKL,X STA ESTKL,X
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
;* ;*
;* CONSTANT ;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW)
;* ;*
ZERO DEX MINUS1 DEX
+ LDA #$00 + LDA #$FF
STA ESTKL,X STA ESTKL,X
STA ESTKH,X STA ESTKH,X
JMP NEXTOP JMP NEXTOP
CN DEX
LSR ; A = CONST * 2
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
CFFB LDA #$FF CFFB LDA #$FF
!BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address !BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address
CB LDA #$00 CB LDA #$00
@ -500,6 +525,48 @@ LLW INY ;+INC_IP
LDY IPY LDY IPY
JMP NEXTOP JMP NEXTOP
;* ;*
;* ADD VALUE FROM LOCAL FRAME OFFSET
;*
ADDLB LDA #$60 ; RTS
STA NEXTOP
JSR LLB
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDLBX LDA #$60 ; RTS
STA NEXTOP
JSR LLBX
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDLW LDA #$60 ; RTS
STA NEXTOP
JSR LLW
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDLWX LDA #$60 ; RTS
STA NEXTOP
JSR LLWX
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
;*
;* INDEX VALUE FROM LOCAL FRAME OFFSET
;*
IDXLB LDA #$60 ; RTS
STA NEXTOP
JSR LLB
LDA #$C8 ; INY
STA NEXTOP
JMP IDXW
IDXLW LDA #$60 ; RTS
STA NEXTOP
JSR LLW
LDA #$C8 ; INY
STA NEXTOP
JMP IDXW
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* LOAD VALUE FROM ABSOLUTE ADDRESS
;* ;*
LAB INY ;+INC_IP LAB INY ;+INC_IP
@ -531,6 +598,36 @@ LAW INY ;+INC_IP
LDY IPY LDY IPY
JMP NEXTOP JMP NEXTOP
;* ;*
;* ADD VALUE FROM ABSOLUTE ADDRESS
;*
ADDAB LDA #$60 ; RTS
STA NEXTOP
JSR LAB
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDAW LDA #$60 ; RTS
STA NEXTOP
JSR LAW
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
;*
;* INDEX VALUE FROM ABSOLUTE ADDRESS
;*
IDXAB LDA #$60 ; RTS
STA NEXTOP
JSR LAB
LDA #$C8 ; INY
STA NEXTOP
JMP IDXW
IDXAW LDA #$60 ; RTS
STA NEXTOP
JSR LAW
LDA #$C8 ; INY
STA NEXTOP
JMP IDXW
;*
;* STORE VALUE TO ADDRESS ;* STORE VALUE TO ADDRESS
;* ;*
SB LDA ESTKL,X SB LDA ESTKL,X
@ -551,7 +648,10 @@ SW LDA ESTKL,X
JMP DROP JMP DROP
+ INC ESTKH,X + INC ESTKH,X
STA (ESTKH-1,X) STA (ESTKH-1,X)
INX ;*
;* DROP2
;*
DROP2 INX
JMP DROP JMP DROP
;* ;*
;* STORE VALUE TO LOCAL FRAME OFFSET ;* STORE VALUE TO LOCAL FRAME OFFSET
@ -683,7 +783,6 @@ ISTRU LDA #$FF
STA ESTKL+1,X STA ESTKL+1,X
STA ESTKH+1,X STA ESTKH+1,X
JMP DROP JMP DROP
;
ISNE LDA ESTKL,X ISNE LDA ESTKL,X
CMP ESTKL+1,X CMP ESTKL+1,X
BNE ISTRU BNE ISTRU
@ -694,7 +793,6 @@ ISFLS LDA #$00
STA ESTKL+1,X STA ESTKL+1,X
STA ESTKH+1,X STA ESTKH+1,X
JMP DROP JMP DROP
;
ISGE LDA ESTKL+1,X ISGE LDA ESTKL+1,X
CMP ESTKL,X CMP ESTKL,X
LDA ESTKH+1,X LDA ESTKH+1,X
@ -702,9 +800,16 @@ ISGE LDA ESTKL+1,X
BVS + BVS +
BPL ISTRU BPL ISTRU
BMI ISFLS BMI ISFLS
+ BPL ISFLS +
- BPL ISFLS
BMI ISTRU BMI ISTRU
; ISLE LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS -
BPL ISTRU
BMI ISFLS
ISGT LDA ESTKL,X ISGT LDA ESTKL,X
CMP ESTKL+1,X CMP ESTKL+1,X
LDA ESTKH,X LDA ESTKH,X
@ -712,31 +817,96 @@ ISGT LDA ESTKL,X
BVS + BVS +
BMI ISTRU BMI ISTRU
BPL ISFLS BPL ISFLS
+ BMI ISFLS +
- BMI ISFLS
BPL ISTRU BPL ISTRU
;
ISLE LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
BMI ISTRU
;
ISLT LDA ESTKL+1,X ISLT LDA ESTKL+1,X
CMP ESTKL,X CMP ESTKL,X
LDA ESTKH+1,X LDA ESTKH+1,X
SBC ESTKH,X SBC ESTKH,X
BVS + BVS -
BMI ISTRU BMI ISTRU
BPL ISFLS BPL ISFLS
+ BMI ISFLS
BPL ISTRU
;* ;*
;* BRANCHES ;* BRANCHES
;* ;*
SEL INX
TYA ; FLATTEN IP
SEC
ADC IPL
STA TMPL
LDA #$00
TAY
ADC IPH
STA TMPH ; ADD BRANCH OFFSET
LDA (TMP),Y
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC TMPL
STA IPL
INY
LDA (TMP),Y
ADC TMPH
STA IPH
DEY
LDA (IP),Y
STA TMPL ; CASE COUNT
LDA ESTKL-1,X
INC IPL
BNE CASELP
INC IPH
CASELP CMP (IP),Y
BNE +
LDA ESTKH-1,X
INY
CMP (IP),Y
BEQ BRNCH
LDA ESTKL-1,X
DEY
+ INY
INY
INY
DEC TMPL
BEQ FIXNEXT
INY
BNE CASELP
INC IPH
BNE CASELP
FIXNEXT TYA
LDY #$00
SEC
ADC IPL
STA IPL
BCC +
INC IPH
+ JMP FETCHOP
BRAND LDA ESTKL,X
ORA ESTKH,X
BEQ BRNCH
INX ; DROP LEFT HALF OF AND
BNE NOBRNCH
BROR LDA ESTKL,X
ORA ESTKH,X
BNE BRNCH
INX ; DROP LEFT HALF OF OR
BNE NOBRNCH
BREQ INX
INX
LDA ESTKL-2,X
CMP ESTKL-1,X
BNE NOBRNCH
LDA ESTKH-2,X
CMP ESTKH-1,X
BEQ BRNCH
BNE NOBRNCH
BRNE INX
INX
LDA ESTKL-2,X
CMP ESTKL-1,X
BNE BRNCH
LDA ESTKH-2,X
CMP ESTKH-1,X
BNE BRNCH
BEQ NOBRNCH
BRTRU INX BRTRU INX
LDA ESTKH-1,X LDA ESTKH-1,X
ORA ESTKL-1,X ORA ESTKL-1,X
@ -745,14 +915,6 @@ NOBRNCH INY ;+INC_IP
INY ;+INC_IP INY ;+INC_IP
BMI FIXNEXT BMI FIXNEXT
JMP NEXTOP JMP NEXTOP
FIXNEXT TYA
LDY #$00
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ JMP NEXTOP
BRFLS INX BRFLS INX
LDA ESTKH-1,X LDA ESTKH-1,X
ORA ESTKL-1,X ORA ESTKL-1,X
@ -775,58 +937,75 @@ BRNCH TYA ; FLATTEN IP
STA IPH STA IPH
DEY DEY
JMP FETCHOP JMP FETCHOP
BREQ INX ;*
LDA ESTKL-1,X ;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK
;*
BRGT LDA ESTKL+1,X
CMP ESTKL,X CMP ESTKL,X
BNE NOBRNCH LDA ESTKH+1,X
LDA ESTKH-1,X
CMP ESTKH,X
BEQ BRNCH
BNE NOBRNCH
BRNE INX
LDA ESTKL-1,X
CMP ESTKL,X
BNE BRNCH
LDA ESTKH-1,X
CMP ESTKH,X
BEQ NOBRNCH
BNE BRNCH
BRGT INX
LDA ESTKL-1,X
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X SBC ESTKH,X
BVS + BVS +
BPL NOBRNCH BPL NOBRNCH
BMI BRNCH - INX ; DROP FOR VALUES
+ BPL BRNCH INX
BMI NOBRNCH BNE BRNCH ; BMI BRNCH
BRLT INX BRLT LDA ESTKL,X
LDA ESTKL,X CMP ESTKL+1,X
CMP ESTKL-1,X
LDA ESTKH,X LDA ESTKH,X
SBC ESTKH-1,X SBC ESTKH+1,X
BVS + BVS +
BPL NOBRNCH BPL NOBRNCH
BMI BRNCH INX ; DROP FOR VALUES
+ BPL BRNCH INX
BMI NOBRNCH BNE BRNCH ; BMI BRNCH
IBRNCH TYA ; FLATTEN IP + BMI NOBRNCH
BPL -
DECBRGE DEC ESTKL,X
LDA ESTKL,X
CMP #$FF
BNE +
DEC ESTKH,X
_BRGE LDA ESTKL,X
+ CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL BRNCH
- INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
INCBRLE INC ESTKL,X
BNE _BRLE
INC ESTKH,X
_BRLE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BPL BRNCH
INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
+ BMI BRNCH
BPL -
SUBBRGE LDA ESTKL+1,X
SEC
SBC ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
SBC ESTKH,X
STA ESTKH+1,X
INX
BNE _BRGE
ADDBRLE LDA ESTKL,X
CLC CLC
ADC IPL ADC ESTKL+1,X
STA TMPL STA ESTKL+1,X
LDA #$00 LDA ESTKH,X
TAY ADC ESTKH+1,X
ADC IPH STA ESTKH+1,X
STA TMPH ; ADD BRANCH OFFSET INX
LDA TMPL BNE _BRLE
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC ESTKL,X
STA IPL
LDA TMPH
ADC ESTKH,X
STA IPH
JMP DROP
;* ;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE) ;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;* ;*

390
src/vmsrc/plvm.c
View File

@ -36,7 +36,7 @@ uword sp = 0x01FE, fp = 0xFFFF, heap = 0x0200, deftbl = DEF_CALL, lastdef = DEF_
#define UPOP ((uword)(*(esp++))) #define UPOP ((uword)(*(esp++)))
#define TOS (esp[0]) #define TOS (esp[0])
word eval_stack[EVAL_STACKSZ]; word eval_stack[EVAL_STACKSZ];
word *esp = eval_stack + EVAL_STACKSZ; word *esp = &eval_stack[EVAL_STACKSZ];
#define SYMTBLSZ 1024 #define SYMTBLSZ 1024
#define SYMSZ 16 #define SYMSZ 16
@ -524,21 +524,30 @@ void call(uword pc)
/* /*
* OPCODE TABLE * OPCODE TABLE
* *
OPTBL: DW ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E OPTBL DW CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E
DW NEG,COMP,AND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E DW CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
DW NOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E DW MINUS1,NEXTOP,NEXTOP,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
DW DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E DW DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E
DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
DW BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E DW BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E
DW LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E DW LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
DW SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E DW SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
DW LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E
DW NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E
DW BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE
*/ */
void interp(code *ip) void interp(code *ip)
{ {
int val, ea, frmsz, parmcnt; int val, ea, frmsz, parmcnt, nybble;
code *previp = ip;
while (1) while (1)
{ {
if ((esp - eval_stack) < 0 || (esp - eval_stack) > EVAL_STACKSZ)
{
printf("Eval stack over/underflow! - $%04X: $%02X [%d]\n", previp - mem_data, *previp, EVAL_STACKSZ - (esp - eval_stack));
show_state = 1;
}
if (show_state) if (show_state)
{ {
char cmdline[16]; char cmdline[16];
@ -549,83 +558,45 @@ void interp(code *ip)
printf("]\n"); printf("]\n");
gets(cmdline); gets(cmdline);
} }
nybble = 15;
previp = ip;
switch (*ip++) switch (*ip++)
{ {
/* /*
* 0x00-0x0F * 0x00-0x1F
*/ */
case 0x00: // ZERO : TOS = 0 case 0x00:
PUSH(0); nybble--;
break; case 0x02:
case 0x02: // ADD : TOS = TOS + TOS-1 nybble--;
val = POP; case 0x04:
ea = POP; nybble--;
PUSH(ea + val); case 0x06:
break; nybble--;
case 0x04: // SUB : TOS = TOS-1 - TOS case 0x08:
val = POP; nybble--;
ea = POP; case 0x0A:
PUSH(ea - val); nybble--;
break; case 0x0C:
case 0x06: // MUL : TOS = TOS * TOS-1 nybble--;
val = POP; case 0x0E:
ea = POP; nybble--;
PUSH(ea * val); case 0x10:
break; nybble--;
case 0x08: // DIV : TOS = TOS-1 / TOS case 0x12:
val = POP; nybble--;
ea = POP; case 0x14:
PUSH(ea / val); nybble--;
break; case 0x16:
case 0x0A: // MOD : TOS = TOS-1 % TOS nybble--;
val = POP; case 0x18:
ea = POP; nybble--;
PUSH(ea % val); case 0x1A:
break; nybble--;
case 0x0C: // INCR : TOS = TOS + 1 case 0x1C:
TOS++;; nybble--;
break; case 0x1E:
case 0x0E: // DECR : TOS = TOS - 1 PUSH(nybble);
TOS--;
break;
/*
* 0x10-0x1F
*/
case 0x10: // NEG : TOS = -TOS
TOS = -TOS;
break;
case 0x12: // COMP : TOS = ~TOS
TOS = ~TOS;
break;
case 0x14: // AND : TOS = TOS & TOS-1
val = POP;
ea = POP;
PUSH(ea & val);
break;
case 0x16: // IOR : TOS = TOS ! TOS-1
val = POP;
ea = POP;
PUSH(ea | val);
break;
case 0x18: // XOR : TOS = TOS ^ TOS-1
val = POP;
ea = POP;
PUSH(ea ^ val);
break;
case 0x1A: // SHL : TOS = TOS-1 << TOS
val = POP;
ea = POP;
PUSH(ea << val);
break;
case 0x1C: // SHR : TOS = TOS-1 >> TOS
val = POP;
ea = POP;
PUSH(ea >> val);
break;
case 0x1E: // IDXW : TOS = TOS * 2 + TOS-1
val = POP;
ea = POP;
PUSH(ea + val * 2);
break; break;
/* /*
* 0x20-0x2F * 0x20-0x2F
@ -669,41 +640,31 @@ void interp(code *ip)
case 0x30: // DROP : TOS = case 0x30: // DROP : TOS =
POP; POP;
break; break;
case 0x32: // DUP : TOS = TOS case 0x32: // DROP2 : TOS ==
POP;
POP;
break;
case 0x34: // DUP : TOS = TOS
val = TOS; val = TOS;
PUSH(val); PUSH(val);
break; break;
case 0x34: // NOP case 0x36: // DIVMOD
break; break;
case 0x36: // NOP case 0x38: // ADDI
PUSH(POP + BYTE_PTR(ip));
ip++;
break; break;
case 0x38: // BRGT : TOS-1 > TOS ? IP += (IP) case 0x3A: // SUBI
val = POP; PUSH(POP - BYTE_PTR(ip));
if (TOS > val) ip++;
ip += WORD_PTR(ip);
else
ip += 2;
break; break;
case 0x3A: // BRLT : TOS-1 < TOS ? IP += (IP) case 0x3C: // ANDI
val = POP; PUSH(POP & BYTE_PTR(ip));
if (TOS < val) ip++;
ip += WORD_PTR(ip);
else
ip += 2;
break; break;
case 0x3C: // BREQ : TOS == TOS-1 ? IP += (IP) case 0x3E: // ORI
val = POP; PUSH(POP | BYTE_PTR(ip));
if (TOS == val) ip++;
ip += WORD_PTR(ip);
else
ip += 2;
break;
case 0x3E: // BRNE : TOS != TOS-1 ? IP += (IP)
val = POP;
if (TOS != val)
ip += WORD_PTR(ip);
else
ip += 2;
break; break;
/* /*
* 0x40-0x4F * 0x40-0x4F
@ -756,8 +717,22 @@ void interp(code *ip)
case 0x50: // BRNCH : IP += (IP) case 0x50: // BRNCH : IP += (IP)
ip += WORD_PTR(ip); ip += WORD_PTR(ip);
break; break;
case 0x52: // IBRNCH : IP += TOS case 0x52: // SELECT
ip += POP; val = POP;
ip += WORD_PTR(ip);
parmcnt = BYTE_PTR(ip);
ip++;
while (parmcnt--)
{
if (WORD_PTR(ip) == val)
{
ip += 2;
ip += WORD_PTR(ip);
parmcnt = 0;
}
else
ip += 4;
}
break; break;
case 0x54: // CALL : TOFP = IP, IP = (IP) ; call case 0x54: // CALL : TOFP = IP, IP = (IP) ; call
call(UWORD_PTR(ip)); call(UWORD_PTR(ip));
@ -880,6 +855,191 @@ void interp(code *ip)
mem_data[ea + 1] = TOS >> 8; mem_data[ea + 1] = TOS >> 8;
ip += 2; ip += 2;
break; break;
/*
* 0x080-0x08F
*/
case 0x80: // ZERO : TOS = 0
PUSH(0);
break;
case 0x82: // ADD : TOS = TOS + TOS-1
val = POP;
ea = POP;
PUSH(ea + val);
break;
case 0x84: // SUB : TOS = TOS-1 - TOS
val = POP;
ea = POP;
PUSH(ea - val);
break;
case 0x86: // MUL : TOS = TOS * TOS-1
val = POP;
ea = POP;
PUSH(ea * val);
break;
case 0x88: // DIV : TOS = TOS-1 / TOS
val = POP;
ea = POP;
PUSH(ea / val);
break;
case 0x8A: // MOD : TOS = TOS-1 % TOS
val = POP;
ea = POP;
PUSH(ea % val);
break;
case 0x8C: // INCR : TOS = TOS + 1
TOS++;;
break;
case 0x8E: // DECR : TOS = TOS - 1
TOS--;
break;
/*
* 0x90-0x9F
*/
case 0x90: // NEG : TOS = -TOS
TOS = -TOS;
break;
case 0x92: // COMP : TOS = ~TOS
TOS = ~TOS;
break;
case 0x94: // AND : TOS = TOS & TOS-1
val = POP;
ea = POP;
PUSH(ea & val);
break;
case 0x96: // IOR : TOS = TOS ! TOS-1
val = POP;
ea = POP;
PUSH(ea | val);
break;
case 0x98: // XOR : TOS = TOS ^ TOS-1
val = POP;
ea = POP;
PUSH(ea ^ val);
break;
case 0x9A: // SHL : TOS = TOS-1 << TOS
val = POP;
ea = POP;
PUSH(ea << val);
break;
case 0x9C: // SHR : TOS = TOS-1 >> TOS
val = POP;
ea = POP;
PUSH(ea >> val);
break;
case 0x9E: // IDXW : TOS = TOS * 2 + TOS-1
val = POP;
ea = POP;
PUSH(ea + val * 2);
break;
/*
* 0xA0-0xAF
*/
case 0xA0: // BRGT : TOS-1 > TOS ? IP += (IP)
val = POP;
if (TOS < val)
{
POP;
ip += WORD_PTR(ip);
}
else
{
PUSH(val);
ip += 2;
}
break;
case 0xA2: // BRLT : TOS-1 < TOS ? IP += (IP)
val = POP;
if (TOS > val)
{
POP;
ip += WORD_PTR(ip);
}
else
{
PUSH(val);
ip += 2;
}
break;
case 0xA4: // INCBRLE : TOS = TOS + 1
val = POP;
val++;
if (TOS >= val)
{
PUSH(val);
ip += WORD_PTR(ip);
}
else
{
POP;
ip += 2;
}
break;
case 0xA6: // ADDBRLE : TOS = TOS + TOS-1
val = POP;
ea = POP;
val = ea + val;
if (TOS >= val)
{
PUSH(val);
ip += WORD_PTR(ip);
}
else
{
POP;
ip += 2;
}
break;
case 0xA8: // DECBRGE : TOS = TOS - 1
val = POP;
val--;
if (TOS <= val)
{
PUSH(val);
ip += WORD_PTR(ip);
}
else
{
POP;
ip += 2;
}
break;
case 0xAA: // SUBBRGE : TOS = TOS-1 - TOS
val = POP;
ea = POP;
val = ea - val;
if (TOS <= val)
{
PUSH(val);
ip += WORD_PTR(ip);
}
else
{
POP;
ip += 2;
}
break;
case 0xAC: // BRAND : SHORT CIRCUIT AND
if (TOS) // EVALUATE RIGHT HAND OF AND
{
POP;
ip += 2;
}
else // MUST BE FALSE, SKIP RIGHT HAND
{
ip += WORD_PTR(ip);
}
break;
case 0xAE: // BROR : SHORT CIRCUIT OR
if (!TOS) // EVALUATE RIGHT HAND OF OR
{
POP;
ip += 2;
}
else // MUST BE TRUE, SKIP RIGHT HAND
{
ip += WORD_PTR(ip);
}
break;
/* /*
* Odd codes and everything else are errors. * Odd codes and everything else are errors.
*/ */