6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2024-07-03 05:29: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
//
const _SYSVER_ = $0100 // Version built against
const _SYSVER_ = $0200 // Version built against
const FALSE = 0
const TRUE = not FALSE
const NULL = 0
@ -33,6 +33,7 @@ import cmdsys
const reshgr2 = $0020
const resxhgr1 = $0040
const resxhgr2 = $0080
const nojitc = $0100
//
// Module don't free memory
//
@ -46,8 +47,15 @@ import cmdsys
word syspath
word cmdline
word modexec
byte refcons
byte devcons
word sysopen
word sysclose
word sysread
word syswrite
byte syserr
byte jitcount
byte jitsize
byte refcons // Apple /// specific
byte devcons // Apple /// specific
end
//
// 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"
sysflags nojitc // Keep tone() from compiling and sounding different
//
// Handy constants.
//

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

@ -1,4 +1,5 @@
include "inc/cmdsys.plh"
sysflags nojitc // It's file I/O. No need to hurry up and wait.
//
// 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"
sysflags nojitc // No need to speed this up
def argDelim(str)
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))
//puts("ref = "); prbyte(ref); puts(" perr = "); prbyte(perr); putln
if ref
pcode = heapmark
pcode = heapalloc(512)
fileio:read(ref, pcode, 512)
//puts("Read header bytes: "); puti(seglen)
//if seglen == 0; puts(" perr = "); prbyte(perr); fin
//getc; putln
//dumpheader(pcode)
//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)
//puts("Read segment bytes: "); puti(seglen); putln
fileio:close(ref)
if !fp6502 and (MACHID & $F0 == $B0) // 128K Apple //e or //c
seglen = fixup(AUXADDR, pcode + seglen - 2) - pcode
auxmove(AUXADDR, pcode, seglen)
heaprelease(pcode)
pcode = AUXADDR
else
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
PLVM01 = rel/apple/A1PLASMA\#060280
PLVM02 = rel/apple/PLASMA.SYSTEM\#FF2000
PLVMJIT = rel/apple/PLASMAJIT.SYSTEM\#FF2000
PLVM802 = rel/apple/PLASMA16.SYSTEM\#FF2000
PLVM03 = rel/apple/SOS.INTERP\#050000
SOSCMD = rel/apple/SOS.CMD\#FE1000
CMD = rel/apple/CMD\#061000
CMDJIT = rel/apple/CMDJIT\#061000
PLVMZP_C64 = vmsrc/c64/plvmzp.inc
PLVMC64 = rel/c64/PLASMA
ED = rel/ED\#FE1000
JIT = rel/apple/JIT\#FE1000
JIT16 = rel/apple/JIT16\#FE1000
JITUNE = rel/apple/JITUNE\#FE1000
SOS = rel/apple/SOS\#FE1000
ROD = rel/ROD\#FE1000
SIEVE = rel/SIEVE\#FE1000
@ -75,7 +81,7 @@ TXTTYPE = .TXT
#SYSTYPE = \#FF2000
#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
c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64)
@ -84,10 +90,8 @@ c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64)
all: apple c64
clean:
-rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03)
-rm rel/*
-rm rel/apple/*
-rm rel/c64/*
-rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM03)
-rm -rf rel
-rm samplesrc/*.o samplesrc/*~ samplesrc/*.a
-rm toolsrc/*.o toolsrc/*~ toolsrc/*.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
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
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
acme -o $(PLVM802) -l vmsrc/apple/plvm802.sym vmsrc/apple/plvm802.s
vmsrc/apple/soscmd.a: vmsrc/apple/soscmd.pla $(PLASM)
./$(PLASM) -AOW < vmsrc/apple/soscmd.pla > vmsrc/apple/soscmd.a
vmsrc/apple/sossys.a: vmsrc/apple/sossys.pla $(PLASM)
./$(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
#
@ -348,7 +363,20 @@ $(MON): samplesrc/mon.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/mon.pla > 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
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/CMDJIT#061000 prodos/CMDJIT.BIN
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/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
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/SOS#FE1000 prodos/sys/SOS.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/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.
//
word arg
word ref
word arg, seq, len
byte ref
//
// Sample background process to show it's working
//
@ -19,9 +19,11 @@ arg = argNext(argFirst)
if ^arg
ref = fileio:open(arg)
if ref
fileio:read(ref, heapmark(), heapavail())
seq = heapalloc(heapavail - 256)
len = fileio:read(ref, seq, heapmark - seq)
fileio:close(ref)
musicPlay(heapmark(), TRUE)
heaprelease(seq + len)
musicPlay(seq, TRUE)
musicGetKey(8, @backgroundProc) // Yield every 8/16 second
musicStop
else

2
src/samplesrc/rod.pla
View File

@ -4,7 +4,7 @@ include "inc/conio.plh"
// Rod's Colors
//
def rod
var i, j, k, w, fmi, fmk, color
byte i, j, k, w, fmi, fmk, color
while TRUE
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'
conio:echo(ECHO_OFF)
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
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
//
// 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
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
if enemy == entities
entities = enemy=>next_other
fin
if enemy=>next_other
enemy=>next_other=>prev_other = enemy=>prev_other
fin
if enemy=>prev_other
enemy=>prev_other=>next_other = enemy=>next_other
fin
fin
if enemy=>prev_other
enemy=>prev_other=>next_other = enemy=>next_other
if player->health > e_atck
player->health = player->health - e_atck
else
player->energy = 0
player->health = 0
fin
fin
if player->health > e_atck
player->health = player->health - e_atck
else
player->energy = 0
player->health = 0
fin
if player->energy >= 4
player->energy = player->energy - 4
fin
if player->energy >= 4
player->energy = player->energy - 4
fin
until player->health == 0 or enemy->life == 0
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)
byte o, l, dist, tile, adjtile, occluded, darkness
word ymap, xmap, imap
byte l, dist, tile, adjtile, occluded, darkness
word ymap, xmap, imap, o
byte yscr, xscr
if viewdist > beamdepth
@ -279,7 +279,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
//
darkness = 1
imap = (yorg << rowshift) + xorg
if ^(map + imap) & LIT_TILE or lightdist
if lightdist or ^(map + imap) & LIT_TILE
//
// Update current spot in viewmap
//
@ -358,7 +358,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
//
// Run through visible octant beam points
//
for l = l to dbeam[viewdist]
for l = dbeam[lightdist]+1 to dbeam[viewdist]
//
// Check parent visiblity
//
@ -429,7 +429,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0
fin
next
for l = l to dbeam[viewdist]
for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]]
imap = ((yorg - xbeam[l]) << rowshift) + xorg + ybeam[l]
tile = ^(map + imap)
@ -479,7 +479,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0
fin
next
for l = l to dbeam[viewdist]
for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]]
imap = ((yorg + xbeam[l]) << rowshift) + xorg + ybeam[l]
tile = ^(map + imap)
@ -529,7 +529,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0
fin
next
for l = l to dbeam[viewdist]
for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]]
imap = ((yorg + ybeam[l]) << rowshift) + xorg + xbeam[l]
tile = ^(map + imap)
@ -579,7 +579,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0
fin
next
for l = l to dbeam[viewdist]
for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]]
imap = ((yorg + ybeam[l]) << rowshift) + xorg - xbeam[l]
tile = ^(map + imap)
@ -629,7 +629,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0
fin
next
for l = l to dbeam[viewdist]
for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]]
imap = ((yorg + xbeam[l]) << rowshift) + xorg - ybeam[l]
tile = ^(map + imap)
@ -679,7 +679,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0
fin
next
for l = l to dbeam[viewdist]
for l = dbeam[lightdist]+1 to dbeam[viewdist]
if vispix[vbeam[l]]
imap = ((yorg - xbeam[l]) << rowshift) + xorg - ybeam[l]
tile = ^(map + imap)
@ -729,7 +729,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
vispix[l] = 0
fin
next
for l = l to dbeam[viewdist]
for l = dbeam[lightdist]+1 to dbeam[viewdist]
imap = ((yorg - ybeam[l]) << rowshift) + xorg - xbeam[l]
if vispix[vbeam[l]]
tile = ^(map + imap)

44
src/samplesrc/sieve.pla
View File

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

445
src/toolsrc/codegen.c
View File

@ -382,12 +382,13 @@ void emit_header(void)
}
void emit_rld(void)
{
int i;
int i, j;
printf(";\n; RE-LOCATEABLE DICTIONARY\n;\n");
/*
* First emit the bytecode definition entrypoint information.
*/
/*
for (i = 0; i < globals; i++)
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$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.
*/
@ -600,8 +609,10 @@ void emit_codetag(int tag)
void emit_const(int cval)
{
emit_pending_seq();
if (cval == 0x0000)
printf("\t%s\t$00\t\t\t; ZERO\n", DB);
if ((cval & 0xFFFF) == 0xFFFF)
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)
printf("\t%s\t$2A,$%02X\t\t\t; CB\t%d\n", DB, cval, cval);
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);
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)
{
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);
}
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)
{
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);
}
}
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)
{
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)
{
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)
{
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)
{
@ -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_B%03d-*\n", DW, tag);
}
void emit_breq(int tag)
void emit_brand(int tag)
{
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);
}
void emit_brne(int tag)
void emit_bror(int tag)
{
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);
}
void emit_brgt(int tag)
{
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);
}
void emit_brlt(int tag)
{
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);
}
void emit_call(int tag, int type)
@ -839,11 +996,17 @@ void emit_start(void)
void emit_drop(void)
{
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)
{
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)
{
@ -851,19 +1014,19 @@ int emit_unaryop(t_token op)
switch (op)
{
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;
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;
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;
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;
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;
case BPTR_TOKEN:
emit_lb();
@ -883,34 +1046,34 @@ int emit_op(t_token op)
switch (op)
{
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
case EQ_TOKEN:
printf("\t%s\t$40\t\t\t; ISEQ\n", DB);
@ -930,12 +1093,6 @@ int emit_op(t_token op)
case LE_TOKEN:
printf("\t%s\t$4A\t\t\t; ISLE\n", DB);
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:
break;
default:
@ -1063,13 +1220,6 @@ int crunch_seq(t_opseq **seq, int pass)
freeops = 1;
break;
}
if (opnext->code == BINARY_CODE(SHL_TOKEN))
{
op->code = DUP_CODE;
opnext->code = BINARY_CODE(ADD_TOKEN);
crunched = 1;
break;
}
}
switch (opnext->code)
{
@ -1127,6 +1277,22 @@ int crunch_seq(t_opseq **seq, int pass)
freeops = 1;
}
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:
if (!op->val)
freeops = -2; // Remove ZERO:ISNE
@ -1206,20 +1372,64 @@ int crunch_seq(t_opseq **seq, int pass)
case BINARY_CODE(LE_TOKEN):
op->val = op->val <= opnext->val ? 1 : 0;
freeops = 2;
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;
break;
}
// End of collapse constant operation
if ((pass > 0) && (freeops == 0) && (op->val != 0))
crunched = try_dupify(op);
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):
for (shiftcnt = 0; shiftcnt < 16; shiftcnt++)
{
@ -1325,7 +1535,17 @@ int crunch_seq(t_opseq **seq, int pass)
crunched = try_dupify(op);
break; // GADDR_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);
break; // LLB_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);
break; // LLW_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);
break; // LAB_CODE
case LAW_CODE:
@ -1365,8 +1605,17 @@ int crunch_seq(t_opseq **seq, int pass)
}
}
}
if ((pass > 0) && (freeops == 0) &&
(op->type || !is_hardware_address(op->offsz)))
else if ((opnext->code == ADD_CODE) || (opnext->code == INDEXB_CODE))
{
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);
break; // LAW_CODE
case LOGIC_NOT_CODE:
@ -1384,6 +1633,36 @@ int crunch_seq(t_opseq **seq, int pass)
break;
}
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:
if ((opnext->code == LLB_CODE) && (op->offsz == opnext->offsz))
{
@ -1577,8 +1856,6 @@ int emit_pending_seq()
case LT_CODE:
case GT_CODE:
case LE_CODE:
case LOGIC_OR_CODE:
case LOGIC_AND_CODE:
emit_op(op->code);
break;
case CONST_CODE:
@ -1587,6 +1864,18 @@ int emit_pending_seq()
case STR_CODE:
emit_conststr(op->val);
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:
emit_lb();
break;
@ -1599,12 +1888,36 @@ int emit_pending_seq()
case LLW_CODE:
emit_llw(op->offsz);
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:
emit_lab(op->tag, op->offsz, op->type);
break;
case LAW_CODE:
emit_law(op->tag, op->offsz, op->type);
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:
emit_sb();
break;
@ -1662,12 +1975,30 @@ int emit_pending_seq()
case BRNCH_CODE:
emit_brnch(op->tag);
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:
emit_brfls(op->tag);
break;
case BRTRUE_CODE:
emit_brtru(op->tag);
break;
case BRGT_CODE:
emit_brgt(op->tag);
break;
case BRLT_CODE:
emit_brlt(op->tag);
break;
case CODETAG_CODE:
printf("_B%03d%c\n", op->tag, LBL);
break;

51
src/toolsrc/codegen.h
View File

@ -31,8 +31,6 @@ typedef struct _opseq {
#define LT_CODE (0x0200|LT_TOKEN)
#define GT_CODE (0x0200|GT_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 STR_CODE 0x0301
#define LB_CODE 0x0302
@ -59,11 +57,29 @@ typedef struct _opseq {
#define INDEXW_CODE 0x0317
#define DROP_CODE 0x0318
#define DUP_CODE 0x0319
#define BRNCH_CODE 0x031C
#define BRFALSE_CODE 0x031D
#define BRTRUE_CODE 0x031E
#define CODETAG_CODE 0x031F
#define NOP_CODE 0x0320
#define ADDI_CODE 0x031A
#define SUBI_CODE 0x031B
#define ANDI_CODE 0x031C
#define ORI_CODE 0x31D
#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_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_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_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_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)
@ -102,6 +122,10 @@ int emit_data(int vartype, int consttype, long constval, int constsize);
void emit_codetag(int tag);
void emit_const(int cval);
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_lw(void);
void emit_llb(int index);
@ -126,14 +150,23 @@ void emit_indexbyte(void);
void emit_indexword(void);
int emit_unaryop(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_brfls(int tag);
void emit_brgt(int tag);
void emit_brlt(int tag);
void emit_brne(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_drop(void);
void emit_drop2(void);
void emit_dup(void);
void emit_leave(void);
void emit_ret(void);

181
src/toolsrc/codegen.pla
View File

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

199
src/toolsrc/codeopt.pla
View File

@ -79,13 +79,6 @@ def crunch_seq(seq, pass)
freeops = 1
break
fin
if nextop->opcode == SHL_CODE
op->opcode = DUP_CODE
op->opgroup = STACK_GROUP
nextop->opcode = ADD_CODE
crunched = 1
break
fin
fin
when nextop->opcode
is NEG_CODE
@ -120,6 +113,26 @@ def crunch_seq(seq, pass)
freeops = 1
fin
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
if not op=>opval
freeops = -2 // Remove ZERO:ISNE
@ -129,7 +142,7 @@ def crunch_seq(seq, pass)
if not op=>opval
op->opcode = LOGIC_NOT_CODE // Replace ZERO:ISEQ
op->opgroup = STACK_GROUP
freeops = 1
freeops = 1
fin
break
is CONST_CODE // Collapse constant operation
@ -200,20 +213,50 @@ def crunch_seq(seq, pass)
op=>opval = op=>opval <= nextop=>opval
freeops = 2
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
fin
if pass and not freeops and op=>opval
crunched = try_dupify(op)
fin
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
for shiftcnt = 0 to 15
if op=>opval == 1 << shiftcnt
@ -240,7 +283,7 @@ def crunch_seq(seq, pass)
if nextop=>opnext
nextopnext = nextop=>opnext
when nextopnext->opcode
is INDEXB_CODE // ADD_CODE
is ADD_CODE // INDEXB_CODE
op=>opoffset = op=>opoffset + nextop=>opval
freeops = 2
break
@ -278,7 +321,7 @@ def crunch_seq(seq, pass)
if nextop=>opnext
nextopnext = nextop=>opnext
when nextopnext->opcode
is INDEXB_CODE // ADD_CODE
is ADD_CODE // INDEXB_CODE
op=>opoffset = op=>opoffset + nextop=>opval
freeops = 2
break
@ -315,45 +358,85 @@ def crunch_seq(seq, pass)
fin
break // GADDR_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)
fin
break // LLB_CODE
is LLW_CODE
// LLW [n]:CB 8:SHR -> LLB [n+1]
if nextop->opcode == CONST_CODE and nextop=>opval == 8
if nextop=>opnext
nextopnext = nextop=>opnext
if nextopnext->opcode == SHR_CODE
op->opcode = LLB_CODE
op=>opoffset++
freeops = 2
break
when nextop->opcode
is ADD_CODE // INDEXB_CODE
op->opcode = ADDLW_CODE
freeops = 1
break
is INDEXW_CODE
op->opcode = IDXLW_CODE
freeops = 1
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
wend
if pass and not freeops
crunched = try_dupify(op)
fin
break // LLW_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)
fin
break // LAB_CODE
is LAW_CODE
// LAW x:CB 8:SHR -> LAB x+1
if nextop->opcode == CONST_CODE and nextop=>opval == 8
if nextop=>opnext
nextopnext = nextop=>opnext
if nextopnext->opcode == SHR_CODE
op->opcode = LAB_CODE
op=>opoffset++
freeops = 2
break
when nextop->opcode
is ADD_CODE // INDEXB_CODE
op->opcode = ADDAW_CODE
freeops = 1
break
is INDEXW_CODE
op->opcode = IDXAW_CODE
freeops = 1
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
wend
if pass and not freeops and not is_hardware_address(op=>opoffset)
crunched = try_dupify(op)
fin
@ -374,6 +457,38 @@ def crunch_seq(seq, pass)
break
wend
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
if nextop->opcode == LLB_CODE and op=>opoffset == nextop=>opoffset
op->opcode = DLB_CODE

57
src/toolsrc/codeseq.plh
View File

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

95
src/toolsrc/ed.pla
View File

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

2
src/toolsrc/lex.pla
View File

@ -325,7 +325,7 @@ def nextln
scanptr++
scan
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
^instr = fileio:read(refnum, inbuff, 127)
if ^instr

258
src/toolsrc/parse.c
View File

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

293
src/toolsrc/parse.pla
View File

@ -494,7 +494,7 @@ end
def parse_expr(codeseq)#2
byte stackdepth, matchdepth, stkdepth1, prevmatch, matchop, i
word optos
word tag_else, tag_endtri
word tag_else, tag_endop
stackdepth = 0
matchop = 0
@ -524,21 +524,32 @@ def parse_expr(codeseq)#2
codeseq = gen_bop(codeseq, pop_op)
stackdepth--
loop
//
// Look for ternary operator
//
if token == TERNARY_TKN
if token == LOGIC_AND_TKN
if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin
tag_endop = new_tag(RELATIVE_FIXUP)
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
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, stkdepth1 = parse_expr(codeseq)
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, stackdepth = parse_expr(codeseq)
if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin
codeseq = gen_ctag(codeseq, tag_endtri)
codeseq = gen_ctag(codeseq, tag_endop)
fin
return codeseq, stackdepth
end
@ -587,9 +598,10 @@ def parse_set(codeseq)
return codeseq
end
def parse_stmnt
byte type, elem_type, elem_size, i, cfnvals
word seq, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend
byte type, elem_type, elem_size, cfnvals, prev_for
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 caseconst, casecnt, caseval, casetag, i
if token <> END_TKN and token <> DONE_TKN and token <> OF_TKN and token <> DEFAULT_TKN
prevstmnt = token
@ -640,12 +652,15 @@ def parse_stmnt
if token <> FIN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin
break
is WHILE_TKN
prev_for = infor
infor = FALSE
tag_while = new_tag(RELATIVE_FIXUP)
tag_wend = new_tag(RELATIVE_FIXUP)
tag_prevcnt = cont_tag
cont_tag = tag_while
cont_tag = new_tag(RELATIVE_FIXUP)
tag_prevbrk = break_tag
break_tag = tag_wend
emit_branch(cont_tag)
emit_tag(tag_while)
seq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin
@ -653,18 +668,21 @@ def parse_stmnt
parse_warn("Expression value overflow")
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin
seq = gen_oprel(seq, BRFALSE_CODE, tag_wend)
emit_seq(seq)
seq = gen_oprel(seq, BRTRUE_CODE, tag_while)
while parse_stmnt
nextln
loop
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)
break_tag = tag_prevbrk
cont_tag = tag_prevcnt
infor = prev_for
break
is REPEAT_TKN
prev_for = infor
infor = FALSE
tag_repeat = new_tag(RELATIVE_FIXUP)
tag_prevbrk = break_tag
break_tag = new_tag(RELATIVE_FIXUP)
@ -688,12 +706,15 @@ def parse_stmnt
emit_seq(seq)
emit_tag(break_tag)
break_tag = tag_prevbrk
infor = prev_for
break
is FOR_TKN
stack_loop++
prev_for = infor
infor = TRUE
stack_loop = stack_loop + 2
tag_for = new_tag(RELATIVE_FIXUP)
tag_prevcnt = cont_tag
cont_tag = tag_for
cont_tag = new_tag(RELATIVE_FIXUP)
tag_prevbrk = break_tag
break_tag = new_tag(RELATIVE_FIXUP)
if scan <> ID_TKN; exit_err(ERR_MISS|ERR_ID); fin
@ -705,19 +726,12 @@ def parse_stmnt
exit_err(ERR_INVAL|ERR_ID)
fin
if scan <> SET_TKN; exit_err(ERR_INVAL|ERR_STATE); fin
seq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin
fromseq, cfnvals = parse_expr(NULL)
if !fromseq; exit_err(ERR_INVAL|ERR_STATE); fin
if cfnvals > 1
parse_warn("Expression value overflow")
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
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
stepdir = 1
elsif token == DOWNTO_TKN
@ -725,14 +739,12 @@ def parse_stmnt
else
exit_err(ERR_INVAL|ERR_STATE)
fin
seq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin
toseq, cfnvals = parse_expr(NULL)
if !toseq; exit_err(ERR_INVAL|ERR_STATE); fin
if cfnvals > 1
parse_warn("Expression value overflow")
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin
emit_seq(seq)
if stepdir > 0; emit_brgt(break_tag); else; emit_brlt(break_tag); fin
if token == STEP_TKN
seq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin
@ -740,28 +752,51 @@ def parse_stmnt
parse_warn("Expression value overflow")
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin
emit_seq(seq)
emit_code(stepdir > 0 ?? ADD_CODE :: SUB_CODE)
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
while parse_stmnt
nextln
loop
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
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_code(DROP_CODE)
break_tag = tag_prevbrk
stack_loop--
break_tag = tag_prevbrk
stack_loop = stack_loop - 2
infor = prev_for
break
is CASE_TKN
stack_loop++
prev_for = infor
infor = FALSE
tag_prevbrk = break_tag
break_tag = 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)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin
if cfnvals > 1
@ -769,32 +804,44 @@ def parse_stmnt
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin
emit_seq(seq)
emit_select(tag_choice)
nextln
while token <> ENDCASE_TKN
when token
is OF_TKN
seq, cfnvals = parse_expr(NULL)
if !seq; exit_err(ERR_INVAL|ERR_STATE); fin
if cfnvals > 1
parse_warn("Expression value overflow")
while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop
fin
emit_seq(seq)
emit_brne(tag_choice)
if casecnt == CASENUM; exit_err(ERR_OVER|ERR_TABLE); fin
caseconst, drop, drop = parse_constexpr
tag_of = new_tag(RELATIVE_FIXUP)
i = casecnt
while i > 0 and caseval=>[i-1] > caseconst
//
// Move larger case consts up
//
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)
while parse_stmnt
nextln
loop
tag_of = new_tag(RELATIVE_FIXUP)
if prevstmnt <> BREAK_TKN // Fall through to next OF if no break
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)
fin
emit_tag(tag_choice)
tag_choice = new_tag(RELATIVE_FIXUP)
break
is DEFAULT_TKN
emit_tag(tag_of)
tag_of = 0
emit_caseblock(casecnt, caseval, casetag)
tag_choice = 0
if tag_of
emit_tag(tag_of)
fin
scan
while parse_stmnt
nextln
@ -808,16 +855,19 @@ def parse_stmnt
exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE)
wend
loop
if (tag_of)
emit_tag(tag_of)
if tag_choice
emit_branch(break_tag)
emit_tag(tag_choice)
emit_caseblock(casecnt, caseval, casetag)
fin
heaprelease(caseval)
emit_tag(break_tag)
emit_code(DROP_CODE)
break_tag = tag_prevbrk
stack_loop--
infor = prev_for
break
is BREAK_TKN
if break_tag
if infor; emit_code(DROP2_CODE); fin
emit_branch(break_tag)
else
exit_err(ERR_INVAL|ERR_STATE)
@ -832,9 +882,14 @@ def parse_stmnt
break
is RETURN_TKN
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)
next
fin
seq, cfnvals = parse_list
emit_seq(seq)
if cfnvals > infuncvals
@ -1076,6 +1131,10 @@ def parse_vars(type)
fin
until token <> COMMA_TKN
break
is IMPORT_TKN
if codeptr <> codebuff or type <> GLOBAL_TYPE; exit_err(ERR_INVAL|ERR_INIT); fin
parse_mods
break
is EOL_TKN
break
otherwise
@ -1161,64 +1220,68 @@ def parse_defs
word type, idstr, func_tag, idptr
type = FUNC_TYPE
if token == EXPORT_TKN
if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin
type = type | EXPORT_TYPE
fin
if token == DEF_TKN
if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin
lambda_cnt = 0
cfnparms = 0
infuncvals = 1
infunc = TRUE
idstr = tknptr
idlen = tknlen
init_idlocal
if scan == OPEN_PAREN_TKN
repeat
if scan == ID_TKN
cfnparms++
new_idlocal(tknptr, tknlen, WORD_TYPE, 2)
scan
fin
until token <> COMMA_TKN
if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin
when token
is CONST_TKN
is STRUC_TKN
return parse_vars(GLOBAL_TYPE)
is EXPORT_TKN
if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin
type = type | EXPORT_TYPE
is DEF_TKN
if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin
lambda_cnt = 0
cfnparms = 0
infuncvals = 1
infunc = TRUE
idstr = tknptr
idlen = tknlen
init_idlocal
if scan == OPEN_PAREN_TKN
repeat
if scan == ID_TKN
cfnparms++
new_idlocal(tknptr, tknlen, WORD_TYPE, 2)
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
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)
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)
if prevstmnt <> RETURN_TKN
if infuncvals; parse_warn("No return values"); fin
for cfnvals = infuncvals - 1 downto 0
emit_const(0)
next
emit_leave
fin
for cfnvals = 0 to lambda_cnt-1
emit_lambdafunc(lambda_tag[cfnvals], lambda_cparms[cfnvals], lambda_seq[cfnvals])
new_dfd(lambda_tag[cfnvals])
next
emit_leave
fin
while lambda_cnt
lambda_cnt--
emit_lambdafunc(lambda_tag[lambda_cnt], lambda_cparms[lambda_cnt], lambda_seq[lambda_cnt])
loop
fin
wend
return token == EOL_TKN ?? TRUE :: FALSE
end
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 = GT_TKN, GE_TKN, LT_TKN, LE_TKN
byte = EQ_TKN, NE_TKN
byte = LOGIC_AND_TKN
byte = LOGIC_OR_TKN
// Lowest precedence
byte[] bops_prec // Highest precedence
byte = 1, 1, 1
@ -206,8 +204,6 @@ byte = 5
byte = 6
byte = 7, 7, 7, 7
byte = 8, 8
byte = 9
byte = 10
// Lowest precedence
byte[16] opstack
byte[16] precstack
@ -236,24 +232,28 @@ end
// Generated code buffers
//
const OPSEQNUM = 256
const DFDNUM = 128
const TAGNUM = 1024
const FIXUPNUM = 2048
const MODDEPNUM = 8
const IDGLOBALSZ = 4096
const IDLOCALSZ = 512
const CASENUM = 64
word fixup_cnt, tag_cnt = -1
word dfd_tag, dfd_cnt
word fixup_tag, fixup_addr
word tag_addr, tag_type
word idglobal_tbl, idlocal_tbl
word pending_seq
word globals, lastglobal, lastglobalsize, lastlocal, savelast
word tag_num, fixup_num, globalbufsz, localbufsz, codebufsz
word globals, lastglobal, lastglobalsize, lastlocal, savelast, savetbl
word dfd_num, tag_num, fixup_num, globalbufsz, localbufsz, codebufsz
word datasize, framesize, savesize
byte locals, savelocals
word codebuff, codeptr, entrypoint
word modsysflags
byte[16] moddep_tbl[MODDEPNUM]
byte moddep_cnt, def_cnt = 1
predef parse_mods
predef emit_pending_seq#0
//
// Module relocation base address
@ -298,7 +298,7 @@ const RVALUE = 1
const LAMBDANUM = 16
word strconstbuff
word strconstptr
byte infunc, inlambda
byte infunc, inlambda, infor
byte stack_loop
byte prevstmnt
word infuncvals
@ -511,7 +511,7 @@ include "toolsrc/parse.pla"
//
// 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)
if ^arg and ^(arg + 1) == '-'
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 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 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
//
word version = $0110 // 01.10
word version = $0200 // 02.00 Dev
word syspath
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
//
@ -117,7 +120,6 @@ word sysmodsym = @exports
// System variable.
//
word systemflags = 0
byte perr
word heap
word xheap = $0800
word lastsym = symtbl
@ -323,36 +325,6 @@ REVCPYLP LDA (SRC),Y
BNE REVCPYLP
CPYMEX RTS
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
LDA #$8D
BNE ++
@ -898,6 +870,17 @@ def read(refnum, buff, len)#1
perr = syscall($CA, @params)
return params:6
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.
//
@ -906,9 +889,10 @@ def availheap()#1
return @fp - heap
end
def allocheap(size)#1
word addr
addr = heap
heap = heap + size
word oldheap, addr
oldheap = heap
addr = heap
heap = heap + size
if systemflags & reshgr1
if uword_islt(addr, $4000) and uword_isgt(heap, $2000)
addr = $4000
@ -922,6 +906,7 @@ def allocheap(size)#1
fin
fin
if uword_isge(heap, @addr)
heap = oldheap
return 0
fin
return addr
@ -1039,7 +1024,7 @@ def loadmod(mod)#1
word addr, defaddr, modaddr, modfix, modofst, modend
word deftbl, deflast
word moddep, rld, esd, sym
byte refnum, defbank, str[16], filename[64]
byte refnum, defbank, filename[64], str[]
byte header[128]
//
// 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)))
fin
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)
modsize = header:0
moddep = @header.1
@ -1212,8 +1204,13 @@ def loadmod(mod)#1
//
// 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
else
perr = $46
fin
if perr
return -perr
@ -1433,7 +1430,7 @@ heap = *freemem
//
// 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.
//

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
;*
!ALIGN 255,0
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,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 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 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
OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E
!WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
!WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!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 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 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
;*
@ -324,31 +328,6 @@ SHR STY IPY
+ LDY IPY
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
;*
DUP DEX
@ -358,23 +337,69 @@ DUP DEX
STA ESTKH,X
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
;*
LNOT LDA ESTKL,X
ORA ESTKH,X
BNE +
LDA #$FF
BEQ +
LDA #$00
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
;*
;* CONSTANT
;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW)
;*
ZERO DEX
+ LDA #$00
MINUS1 DEX
+ LDA #$FF
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
CN DEX
LSR ; A = CONST * 2
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
CFFB LDA #$FF
!BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address
CB LDA #$00
@ -476,7 +501,7 @@ LLA INY ;+INC_IP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
LLB INY ;+INC_IP
_LLB INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
@ -486,8 +511,8 @@ LLB INY ;+INC_IP
LDA #$00
STA ESTKH,X
LDY IPY
JMP NEXTOP
LLW INY ;+INC_IP
RTS
_LLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
@ -498,11 +523,29 @@ LLW INY ;+INC_IP
LDA (IFP),Y
STA ESTKH,X
LDY IPY
RTS
LLB JSR _LLB
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
;*
LAB INY ;+INC_IP
_LAB INY ;+INC_IP
LDA (IP),Y
STA ESTKH-2,X
INY ;+INC_IP
@ -513,8 +556,8 @@ LAB INY ;+INC_IP
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
LAW INY ;+INC_IP
RTS
_LAW INY ;+INC_IP
LDA (IP),Y
STA TMPL
INY ;+INC_IP
@ -529,7 +572,25 @@ LAW INY ;+INC_IP
LDA (TMP),Y
STA ESTKH,X
LDY IPY
RTS
LAB JSR _LAB
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
;*
@ -551,7 +612,10 @@ SW LDA ESTKL,X
JMP DROP
+ INC ESTKH,X
STA (ESTKH-1,X)
INX
;*
;* DROP2
;*
DROP2 INX
JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
@ -594,6 +658,8 @@ DLB INY ;+INC_IP
TAY
LDA ESTKL,X
STA (IFP),Y
LDA #$00
STA ESTKH,X
LDY IPY
JMP NEXTOP
DLW INY ;+INC_IP
@ -654,6 +720,8 @@ DAB INY ;+INC_IP
STA ESTKH-1,X
LDA ESTKL,X
STA (ESTKH-2,X)
LDA #$00
STA ESTKH,X
JMP NEXTOP
DAW INY ;+INC_IP
LDA (IP),Y
@ -683,7 +751,6 @@ ISTRU LDA #$FF
STA ESTKL+1,X
STA ESTKH+1,X
JMP DROP
;
ISNE LDA ESTKL,X
CMP ESTKL+1,X
BNE ISTRU
@ -694,7 +761,6 @@ ISFLS LDA #$00
STA ESTKL+1,X
STA ESTKH+1,X
JMP DROP
;
ISGE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
@ -702,9 +768,16 @@ ISGE LDA ESTKL+1,X
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
+
- BPL ISFLS
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
CMP ESTKL+1,X
LDA ESTKH,X
@ -712,31 +785,114 @@ ISGT LDA ESTKL,X
BVS +
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
+
- BMI ISFLS
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
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BVS -
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
BPL ISTRU
;*
;* 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
LDA ESTKH-1,X
ORA ESTKL-1,X
@ -745,14 +901,6 @@ NOBRNCH INY ;+INC_IP
INY ;+INC_IP
BMI FIXNEXT
JMP NEXTOP
FIXNEXT TYA
LDY #$00
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ JMP NEXTOP
BRFLS INX
LDA ESTKH-1,X
ORA ESTKL-1,X
@ -775,58 +923,75 @@ BRNCH TYA ; FLATTEN IP
STA IPH
DEY
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
BNE NOBRNCH
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
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BPL NOBRNCH
BMI BRNCH
+ BPL BRNCH
BMI NOBRNCH
BRLT INX
LDA ESTKL,X
CMP ESTKL-1,X
- INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BRLT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH-1,X
SBC ESTKH+1,X
BVS +
BPL NOBRNCH
BMI BRNCH
+ BPL BRNCH
BMI NOBRNCH
IBRNCH TYA ; FLATTEN IP
INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
+ 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
ADC IPL
STA TMPL
LDA #$00
TAY
ADC IPH
STA TMPH ; ADD BRANCH OFFSET
LDA TMPL
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC ESTKL,X
STA IPL
LDA TMPH
ADC ESTKH,X
STA IPH
JMP DROP
ADC ESTKL+1,X
STA ESTKL+1,X
LDA ESTKH,X
ADC ESTKH+1,X
STA ESTKH+1,X
INX
BNE _BRLE
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
@ -846,7 +1011,7 @@ CALL INY ;+INC_IP
LDA (IP),Y
STA TMPH
_CALL TYA
CLC
SEC
ADC IPL
PHA
LDA IPH
@ -857,7 +1022,7 @@ _CALL TYA
STA IPH
PLA
STA IPL
LDY #$01
LDY #$00
JMP FETCHOP
;*
;* 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 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
LDA #$00
- LDX PAGE0,Y
@ -65,16 +61,9 @@ SEGSTART = $2000
STA TMPX ; CLEAR ALL EXTENDED POINTERS
STA SRCX
STA DSTX
STA PPX ; INIT FRAME & POOL POINTERS
STA PPX
STA IFPX
LDA #$00
STA PPL
STA IFPL
LDA #$A0
STA PPH
STA IFPH
!IF 1 {
LDA #<VMCORE ; COPY VM+CMD INTO SBANK
LDA #<VMCORE ; COPY VM+SYS INTO SBANK
STA SRCL
LDA #>VMCORE
STA SRCH
@ -91,7 +80,16 @@ SEGSTART = $2000
LDA DSTH
CMP #$B8
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
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
@ -134,18 +132,30 @@ PAGE0 = *
}
VMCORE = *
!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
;*
!ALIGN 255,0
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,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 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 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
OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E
!WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
!WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!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 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 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
;*
@ -166,7 +176,7 @@ XINTERP PLA
STA TMPL
PLA
STA TMPH
LDY #$03
- LDY #$03
LDA (TMP),Y
STA IPX
DEY
@ -178,6 +188,49 @@ XINTERP PLA
DEY
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
;*
_NEG LDA #$00
@ -439,31 +492,6 @@ SHR STY IPY
+ LDY IPY
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
;*
DUP DEX
@ -473,25 +501,76 @@ DUP DEX
STA ESTKH,X
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
;*
LNOT LDA ESTKL,X
ORA ESTKH,X
BNE +
LDA #$FF
BEQ +
LDA #$00
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
;*
;* CONSTANT
;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW)
;*
ZERO DEX
+ LDA #$00
MINUS1 DEX
+ LDA #$FF
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
CN DEX
LSR ; A = CONST * 2
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
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
DEX
STA ESTKH,X
@ -608,12 +687,9 @@ LW LDA ESTKL,X
LDA (ESTKH-1,X)
STA ESTKL,X
INC ESTKH-1,X
BEQ +
LDA (ESTKH-1,X)
STA ESTKH,X
JMP NEXTOP
+ INC ESTKH,X
LDA (ESTKH-1,X)
BNE +
INC ESTKH,X
+ LDA (ESTKH-1,X)
STA ESTKH,X
JMP NEXTOP
;*
@ -664,6 +740,75 @@ LLW INY ;+INC_IP
LDY IPY
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
;*
LAB INY ;+INC_IP
@ -695,6 +840,87 @@ LAW INY ;+INC_IP
LDY IPY
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
;*
SB LDA ESTKL,X
@ -709,13 +935,13 @@ SW LDA ESTKL,X
STA (ESTKH-1,X)
LDA ESTKH+1,X
INC ESTKH-1,X
BEQ +
STA (ESTKH-1,X)
INX
JMP DROP
+ INC ESTKH,X
STA (ESTKH-1,X)
INX
BNE +
INC ESTKH,X
+ STA (ESTKH-1,X)
;*
;* DROP TOS, TOS-1
;*
DROP2 INX
JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
@ -758,6 +984,8 @@ DLB INY ;+INC_IP
TAY
LDA ESTKL,X
STA (IFP),Y
LDA #$00
STA ESTKH,X
LDY IPY
JMP NEXTOP
DLW INY ;+INC_IP
@ -818,6 +1046,8 @@ DAB INY ;+INC_IP
STA ESTKH-1,X
LDA ESTKL,X
STA (ESTKH-2,X)
LDA #$00
STA ESTKH,X
JMP NEXTOP
DAW INY ;+INC_IP
LDA (IP),Y
@ -847,7 +1077,6 @@ ISTRU LDA #$FF
STA ESTKL+1,X
STA ESTKH+1,X
JMP DROP
;
ISNE LDA ESTKL,X
CMP ESTKL+1,X
BNE ISTRU
@ -858,7 +1087,6 @@ ISFLS LDA #$00
STA ESTKL+1,X
STA ESTKH+1,X
JMP DROP
;
ISGE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
@ -866,9 +1094,16 @@ ISGE LDA ESTKL+1,X
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
+
- BPL ISFLS
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
CMP ESTKL+1,X
LDA ESTKH,X
@ -876,42 +1111,117 @@ ISGT LDA ESTKL,X
BVS +
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
+
- BMI ISFLS
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
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BVS -
BMI ISTRU
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
LDY #$00
CLC
SEC
ADC IPL
STA IPL
BCC +
INC IPH
+ JMP NEXTOP
;*
;* BRANCHES
;*
+ 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
LDA ESTKH-1,X
ORA ESTKL-1,X
@ -945,67 +1255,97 @@ BRNCH TYA ; FLATTEN IP
DEY
STY TMPX ; CLEAR TMPX
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
BNE NOBRNCH
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
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BPL NOBRNCH
BMI BRNCH
+ BPL BRNCH
BMI NOBRNCH
BRLT INX
LDA ESTKL,X
CMP ESTKL-1,X
- INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BRLT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH-1,X
SBC ESTKH+1,X
BVS +
BPL NOBRNCH
BMI BRNCH
+ BPL BRNCH
BMI NOBRNCH
IBRNCH TYA ; FLATTEN IP
BMI -
+ BMI NOBRNCH
BPL -
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
ADC IPL
STA TMPL
LDA #$00
TAY
ADC IPH
STA TMPH ; ADD BRANCH OFFSET
LDA TMPL
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC ESTKL,X
STA IPL
LDA TMPH
ADC ESTKH,X
STA IPH
JMP DROP
ADC ESTKL+1,X
STA ESTKL+1,X
LDA ESTKH,X
ADC ESTKH+1,X
STA ESTKH+1,X
INX
BNE _BRLE
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL LDA ESTKL,X
STA CALLADR+1
STA ICALADR+1
LDA ESTKH,X
STA CALLADR+2
STA ICALADR+2
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)
;*
@ -1016,7 +1356,7 @@ CALL INY ;+INC_IP
LDA (IP),Y
STA CALLADR+2
_CALL TYA
CLC
SEC
ADC IPL
PHA
LDA IPH
@ -1031,7 +1371,7 @@ CALLADR JSR $FFFF
STA IPH
PLA
STA IPL
LDY #$01
LDY #$00
JMP FETCHOP
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
@ -1082,7 +1422,19 @@ LEAVE INY ;+INC_IP
PLA
STA IFPH
RET RTS
;*
;* RETURN TO NATIVE CODE
;*
NATV TYA ; FLATTEN IP
SEC
ADC IPL
STA TMPL
LDA #$00
ADC IPH
STA TMPH
JMP JMPTMP
SOSCMD = *
!SOURCE "vmsrc/apple/soscmd.a"
!SOURCE "vmsrc/apple/sossys.a"
}
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
;*
!ALIGN 255,0
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,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 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 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
OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E
!WORD CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
!WORD MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!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 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 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
;*
@ -324,31 +328,6 @@ SHR STY IPY
+ LDY IPY
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
;*
DUP DEX
@ -358,23 +337,69 @@ DUP DEX
STA ESTKH,X
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
;*
LNOT LDA ESTKL,X
ORA ESTKH,X
BNE +
LDA #$FF
BEQ +
LDA #$00
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
;*
;* CONSTANT
;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW)
;*
ZERO DEX
+ LDA #$00
MINUS1 DEX
+ LDA #$FF
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
CN DEX
LSR ; A = CONST * 2
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
CFFB LDA #$FF
!BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address
CB LDA #$00
@ -500,6 +525,48 @@ LLW INY ;+INC_IP
LDY IPY
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
;*
LAB INY ;+INC_IP
@ -531,6 +598,36 @@ LAW INY ;+INC_IP
LDY IPY
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
;*
SB LDA ESTKL,X
@ -551,7 +648,10 @@ SW LDA ESTKL,X
JMP DROP
+ INC ESTKH,X
STA (ESTKH-1,X)
INX
;*
;* DROP2
;*
DROP2 INX
JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
@ -683,7 +783,6 @@ ISTRU LDA #$FF
STA ESTKL+1,X
STA ESTKH+1,X
JMP DROP
;
ISNE LDA ESTKL,X
CMP ESTKL+1,X
BNE ISTRU
@ -694,7 +793,6 @@ ISFLS LDA #$00
STA ESTKL+1,X
STA ESTKH+1,X
JMP DROP
;
ISGE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
@ -702,9 +800,16 @@ ISGE LDA ESTKL+1,X
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
+
- BPL ISFLS
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
CMP ESTKL+1,X
LDA ESTKH,X
@ -712,31 +817,96 @@ ISGT LDA ESTKL,X
BVS +
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
+
- BMI ISFLS
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
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BVS -
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
BPL ISTRU
;*
;* 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
LDA ESTKH-1,X
ORA ESTKL-1,X
@ -745,14 +915,6 @@ NOBRNCH INY ;+INC_IP
INY ;+INC_IP
BMI FIXNEXT
JMP NEXTOP
FIXNEXT TYA
LDY #$00
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ JMP NEXTOP
BRFLS INX
LDA ESTKH-1,X
ORA ESTKL-1,X
@ -775,58 +937,75 @@ BRNCH TYA ; FLATTEN IP
STA IPH
DEY
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
BNE NOBRNCH
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
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BPL NOBRNCH
BMI BRNCH
+ BPL BRNCH
BMI NOBRNCH
BRLT INX
LDA ESTKL,X
CMP ESTKL-1,X
- INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BRLT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH-1,X
SBC ESTKH+1,X
BVS +
BPL NOBRNCH
BMI BRNCH
+ BPL BRNCH
BMI NOBRNCH
IBRNCH TYA ; FLATTEN IP
INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
+ 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
ADC IPL
STA TMPL
LDA #$00
TAY
ADC IPH
STA TMPH ; ADD BRANCH OFFSET
LDA TMPL
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC ESTKL,X
STA IPL
LDA TMPH
ADC ESTKH,X
STA IPH
JMP DROP
ADC ESTKL+1,X
STA ESTKL+1,X
LDA ESTKH,X
ADC ESTKH+1,X
STA ESTKH+1,X
INX
BNE _BRLE
;*
;* 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 TOS (esp[0])
word eval_stack[EVAL_STACKSZ];
word *esp = eval_stack + EVAL_STACKSZ;
word *esp = &eval_stack[EVAL_STACKSZ];
#define SYMTBLSZ 1024
#define SYMSZ 16
@ -524,21 +524,30 @@ void call(uword pc)
/*
* OPCODE TABLE
*
OPTBL: DW ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 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 NOT,LOR,LAND,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 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 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
OPTBL DW CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E
DW CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
DW MINUS1,NEXTOP,NEXTOP,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
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 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 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)
{
int val, ea, frmsz, parmcnt;
int val, ea, frmsz, parmcnt, nybble;
code *previp = ip;
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)
{
char cmdline[16];
@ -549,83 +558,45 @@ void interp(code *ip)
printf("]\n");
gets(cmdline);
}
nybble = 15;
previp = ip;
switch (*ip++)
{
/*
* 0x00-0x0F
*/
case 0x00: // ZERO : TOS = 0
PUSH(0);
break;
case 0x02: // ADD : TOS = TOS + TOS-1
val = POP;
ea = POP;
PUSH(ea + val);
break;
case 0x04: // SUB : TOS = TOS-1 - TOS
val = POP;
ea = POP;
PUSH(ea - val);
break;
case 0x06: // MUL : TOS = TOS * TOS-1
val = POP;
ea = POP;
PUSH(ea * val);
break;
case 0x08: // DIV : TOS = TOS-1 / TOS
val = POP;
ea = POP;
PUSH(ea / val);
break;
case 0x0A: // MOD : TOS = TOS-1 % TOS
val = POP;
ea = POP;
PUSH(ea % val);
break;
case 0x0C: // INCR : TOS = TOS + 1
TOS++;;
break;
case 0x0E: // DECR : TOS = TOS - 1
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);
/*
* 0x00-0x1F
*/
case 0x00:
nybble--;
case 0x02:
nybble--;
case 0x04:
nybble--;
case 0x06:
nybble--;
case 0x08:
nybble--;
case 0x0A:
nybble--;
case 0x0C:
nybble--;
case 0x0E:
nybble--;
case 0x10:
nybble--;
case 0x12:
nybble--;
case 0x14:
nybble--;
case 0x16:
nybble--;
case 0x18:
nybble--;
case 0x1A:
nybble--;
case 0x1C:
nybble--;
case 0x1E:
PUSH(nybble);
break;
/*
* 0x20-0x2F
@ -669,41 +640,31 @@ void interp(code *ip)
case 0x30: // DROP : TOS =
POP;
break;
case 0x32: // DUP : TOS = TOS
case 0x32: // DROP2 : TOS ==
POP;
POP;
break;
case 0x34: // DUP : TOS = TOS
val = TOS;
PUSH(val);
break;
case 0x34: // NOP
case 0x36: // DIVMOD
break;
case 0x36: // NOP
case 0x38: // ADDI
PUSH(POP + BYTE_PTR(ip));
ip++;
break;
case 0x38: // BRGT : TOS-1 > TOS ? IP += (IP)
val = POP;
if (TOS > val)
ip += WORD_PTR(ip);
else
ip += 2;
case 0x3A: // SUBI
PUSH(POP - BYTE_PTR(ip));
ip++;
break;
case 0x3A: // BRLT : TOS-1 < TOS ? IP += (IP)
val = POP;
if (TOS < val)
ip += WORD_PTR(ip);
else
ip += 2;
case 0x3C: // ANDI
PUSH(POP & BYTE_PTR(ip));
ip++;
break;
case 0x3C: // BREQ : TOS == TOS-1 ? IP += (IP)
val = POP;
if (TOS == val)
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;
case 0x3E: // ORI
PUSH(POP | BYTE_PTR(ip));
ip++;
break;
/*
* 0x40-0x4F
@ -756,8 +717,22 @@ void interp(code *ip)
case 0x50: // BRNCH : IP += (IP)
ip += WORD_PTR(ip);
break;
case 0x52: // IBRNCH : IP += TOS
ip += POP;
case 0x52: // SELECT
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;
case 0x54: // CALL : TOFP = IP, IP = (IP) ; call
call(UWORD_PTR(ip));
@ -880,6 +855,191 @@ void interp(code *ip)
mem_data[ea + 1] = TOS >> 8;
ip += 2;
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.
*/