From 4dcc033ed0be81dbda6da65fce08eb69597d3019 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Tue, 20 Mar 2018 14:19:17 -0700 Subject: [PATCH] Invokable JIT compiler version --- src/libsrc/apple/jit.pla | 48 + src/makefile | 21 +- src/mkrel | 3 + src/vmsrc/apple/cmdjit.pla | 1529 ++++++++++++++++++++++ src/vmsrc/apple/cmdjitstub.s | 48 + src/vmsrc/apple/plvm02.s | 8 +- src/vmsrc/apple/plvmjit02.s | 2353 ++++++++++++++++++++++++++++++++++ 7 files changed, 4003 insertions(+), 7 deletions(-) create mode 100644 src/libsrc/apple/jit.pla create mode 100755 src/vmsrc/apple/cmdjit.pla create mode 100644 src/vmsrc/apple/cmdjitstub.s create mode 100755 src/vmsrc/apple/plvmjit02.s diff --git a/src/libsrc/apple/jit.pla b/src/libsrc/apple/jit.pla new file mode 100644 index 0000000..968e99f --- /dev/null +++ b/src/libsrc/apple/jit.pla @@ -0,0 +1,48 @@ +// +// 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 jitcount = $10 +const jitcomp = $03E2 +const jitcodeptr = $03E4 +// +// AUX bytecode interpreter entrypoint +// +const interpentry = $03DC +// +// JIT compiler entry +// +def compiler(defptr)#0 + puts("JIT compiler invoked!\n") + + defptr=>interpaddr = interpentry +end +// +// Install JIT compiler +// +if *jitcomp + puts("JIT compiler already installed!\n") + return 0 +fin +puts("Installing JIT compiler\n") +*jitcomp = @compiler +return modkeep +done diff --git a/src/makefile b/src/makefile index 3c94fc5..48a8ba8 100755 --- a/src/makefile +++ b/src/makefile @@ -4,13 +4,16 @@ 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 SOS = rel/apple/SOS\#FE1000 ROD = rel/ROD\#FE1000 SIEVE = rel/SIEVE\#FE1000 @@ -76,7 +79,7 @@ TXTTYPE = .TXT #SYSTYPE = \#FF2000 #TXTTYPE = \#040000 -apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(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) +apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM802) $(PLVM03) $(CMD) $(CMDJIT) $(JIT) $(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) @@ -85,7 +88,7 @@ c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64) all: apple c64 clean: - -rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03) + -rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM03) -rm -rf rel -rm samplesrc/*.o samplesrc/*~ samplesrc/*.a -rm toolsrc/*.o toolsrc/*~ toolsrc/*.a @@ -149,6 +152,10 @@ $(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 $(PLVM03) $(PLASM) ./$(PLASM) -AMOW < vmsrc/apple/soscmd.pla > vmsrc/apple/soscmd.a acme --setpc 4094 -o $(SOSCMD) vmsrc/apple/soscmd.a @@ -156,6 +163,9 @@ $(SOSCMD): vmsrc/apple/soscmd.pla $(PLVM03) $(PLASM) $(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 @@ -351,7 +361,12 @@ $(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 $(PLVMJIT) $(PLASM) + ./$(PLASM) -AMO < libsrc/apple/jit.pla > libsrc/apple/jit.a + acme --setpc 4094 -o $(JIT) libsrc/apple/jit.a + + diff --git a/src/mkrel b/src/mkrel index e8a1af0..311722b 100755 --- a/src/mkrel +++ b/src/mkrel @@ -1,5 +1,7 @@ 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/PLAJIT.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 @@ -30,6 +32,7 @@ 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 ../sysfiles/FP6502.CODE#060000 prodos/sys/FP6502.CODE.BIN cp ../sysfiles/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN diff --git a/src/vmsrc/apple/cmdjit.pla b/src/vmsrc/apple/cmdjit.pla new file mode 100755 index 0000000..1b65fbd --- /dev/null +++ b/src/vmsrc/apple/cmdjit.pla @@ -0,0 +1,1529 @@ +const MACHID = $BF98 +const iobuffer = $0800 +const databuff = $2000 +const RELADDR = $1000 +const symtbl = $0C00 +const freemem = $0006 +const getlnbuf = $01FF +// +// System flags: memory allocator screen holes. +// +const restxt1 = $0001 +const restxt2 = $0002 +const resxtxt1 = $0004 +const resxtxt2 = $0008 +const reshgr1 = $0010 +const reshgr2 = $0020 +const resxhgr1 = $0040 +const resxhgr2 = $0080 +// +// Module don't free memory +// +const modkeep = $2000 +const modinitkeep = $4000 +// +// Prefix commands +// +const GET_PFX = $C7 +const SET_PFX = $C6 +// +// Indirect interpreter DEFinition entrypoint +// +struc t_defentry + byte interpjsr + word interpaddr + word bytecodeaddr + byte callcount + byte bytecodesize +end +// +// JIT compiler constants +// +const jitcount = $10 +const jitcomp = $03E2 +const jitcodeptr = $03E4 +const jitcode = $BF00 +// +// Pedefined functions. +// +predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1 +predef crout()#0, cout(c)#0, prstr(s)#0, prbyte(b)#0, prword(w)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1 +predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr)#1, releaseheap(newheap)#1, availheap()#1 +predef memset(addr,value,size)#0, memcpy(dst,src,size)#0, strcpy(dst,src)#1, strcat(dst,src)#1 +predef 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, open(path)#1, close(refnum)#1, read(refnum, buff, len)#1, write(refnum, buff, len)#1 +// +// Exported CMDSYS table +// +word version = $0200 // 02.00 Dev +word syspath +word syscmdln +word = @execmod, @open, @close, @read, @write +byte perr +// +// Working input buffer overlayed with strings table +// +byte cmdln = "" +// +// DCI version of JIT +// +byte jitmod = 'J'|$80, 'I'|$80, 'T' +// +// Name for auto-run file (must follow cmdln) +// +byte autorun = "AUTORUN" +// +// Standard Library exported functions. +// +byte sysmodstr = "CMDSYS" +byte putsstr = "PUTS" +byte putistr = "PUTI" +byte putcstr = "PUTC" +byte putlnstr = "PUTLN" +byte putbstr = "PUTB" +byte putwstr = "PUTH" +byte getcstr = "GETC" +byte getsstr = "GETS" +byte toupstr = "TOUPPER" +byte strcpystr = "STRCPY" +byte strcatstr = "STRCAT" +byte hpmarkstr = "HEAPMARK" +byte hpalignstr = "HEAPALLOCALIGN" +byte hpallocstr = "HEAPALLOC" +byte hprelstr = "HEAPRELEASE" +byte hpavlstr = "HEAPAVAIL" +byte sysmods[] // overlay with exported strings +word memsetstr = "MEMSET" +byte memcpystr = "MEMCPY" +byte uisgtstr = "ISUGT" +byte uisgestr = "ISUGE" +byte uisltstr = "ISULT" +byte uislestr = "ISULE" +byte sextstr = "SEXT" +byte divmodstr = "DIVMOD" +byte machidstr = "MACHID" +byte sysstr = "SYSCALL" +byte callstr = "CALL" +byte prefix[] // overlay with exported symbols table +word exports = @sysmodstr, @version +word = @sysstr, @syscall +word = @callstr, @call +word = @putcstr, @cout +word = @putlnstr, @crout +word = @putsstr, @prstr +word = @putbstr, @prbyte +word = @putwstr, @prword +word = @putistr, @print +word = @getcstr, @cin +word = @getsstr, @rdstr +word = @toupstr, @toupper +word = @hpmarkstr, @markheap +word = @hpallocstr,@allocheap +word = @hpalignstr,@allocalignheap +word = @hprelstr, @releaseheap +word = @hpavlstr, @availheap +word = @memsetstr, @memset +word = @memcpystr, @memcpy +word = @uisgtstr, @uword_isgt +word = @uisgestr, @uword_isge +word = @uisltstr, @uword_islt +word = @uislestr, @uword_isle +word = @strcpystr, @strcpy +word = @strcatstr, @strcat +word = @sextstr, @sext +word = @divmodstr, @divmod +word = @machidstr, MACHID +word = 0 +word sysmodsym = @exports +// +// System variable. +// +word systemflags = 0 +word heap +word xheap = $0800 +word lastsym = symtbl +// +// Utility functions +// +//asm equates included from cmdstub.s +// +asm saveX#0 + STX XREG+1 +end +asm restoreX#0 +XREG LDX #$00 + RTS +end +// CALL PRODOS +// SYSCALL(CMD, PARAMS) +// +asm syscall(cmd,params)#1 + LDA ESTKL,X + LDY ESTKH,X + STA PARAMS + STY PARAMS+1 + INX + LDA ESTKL,X + STA CMD + JSR $BF00 +CMD: !BYTE 00 +PARAMS: !WORD 0000 +; LDY #$00 + STA ESTKL,X +; STY ESTKH,X + RTS +end +// +// CALL 6502 ROUTINE +// CALL(ADDR, AREG, XREG, YREG, STATUS) +// +asm call(addr,areg,xreg,yreg,status)#1 +REGVALS = SRC + PHP + LDA ESTKL+4,X + STA TMPL + LDA ESTKH+4,X + STA TMPH + LDA ESTKL,X + PHA + LDY ESTKL+1,X + LDA ESTKL+3,X + PHA + LDA ESTKL+2,X + INX + INX + INX + INX + STX ESP + TAX + PLA + BIT ROMEN + PLP + JSR JMPTMP + PHP + BIT LCRDEN+LCBNK2 + STA REGVALS+0 + STX REGVALS+1 + STY REGVALS+2 + PLA + STA REGVALS+3 + LDX ESP + LDA #REGVALS + STA ESTKL,X + STY ESTKH,X + PLP + RTS +end +// +// CALL LOADED SYSTEM PROGRAM +// +asm exec()#0 + BIT ROMEN + JMP $2000 +end +// +// EXIT +// +asm reboot()#0 + BIT ROMEN + DEC $03F4 ; INVALIDATE POWER-UP BYTE + JMP ($FFFC) ; RESET +end +// +// SET MEMORY TO VALUE +// MEMSET(ADDR, VALUE, SIZE) +// With optimizations from Peter Ferrie +// +asm memset(addr,value,size)#0 + LDA ESTKL+2,X + STA DSTL + LDA ESTKH+2,X + STA DSTH + LDY ESTKL,X + BEQ + + INC ESTKH,X + LDY #$00 ++ LDA ESTKH,X + BEQ SETMEX +SETMLPL CLC + LDA ESTKL+1,X +SETMLPH STA (DST),Y + DEC ESTKL,X + BEQ ++ +- INY + BEQ + +-- BCS SETMLPL + SEC + LDA ESTKH+1,X + BCS SETMLPH ++ INC DSTH + BNE -- +++ DEC ESTKH,X + BNE - +SETMEX INX + INX + INX + RTS +end +// +// COPY MEMORY +// MEMCPY(DSTADDR, SRCADDR, SIZE) +// +asm memcpy(dst,src,size)#0 + INX + INX + INX + LDA ESTKL-3,X + ORA ESTKH-3,X + BEQ CPYMEX + LDA ESTKL-2,X + CMP ESTKL-1,X + LDA ESTKH-2,X + SBC ESTKH-1,X + BCC REVCPY +; +; FORWARD COPY +; + LDA ESTKL-1,X + STA DSTL + LDA ESTKH-1,X + STA DSTH + LDA ESTKL-2,X + STA SRCL + LDA ESTKH-2,X + STA SRCH + LDY ESTKL-3,X + BEQ FORCPYLP + INC ESTKH-3,X + LDY #$00 +FORCPYLP LDA (SRC),Y + STA (DST),Y + INY + BNE + + INC DSTH + INC SRCH ++ DEC ESTKL-3,X + BNE FORCPYLP + DEC ESTKH-3,X + BNE FORCPYLP + RTS +; +; REVERSE COPY +; +REVCPY ;CLC + LDA ESTKL-3,X + ADC ESTKL-1,X + STA DSTL + LDA ESTKH-3,X + ADC ESTKH-1,X + STA DSTH + CLC + LDA ESTKL-3,X + ADC ESTKL-2,X + STA SRCL + LDA ESTKH-3,X + ADC ESTKH-2,X + STA SRCH + DEC DSTH + DEC SRCH + LDY #$FF + LDA ESTKL-3,X + BEQ REVCPYLP + INC ESTKH-3,X +REVCPYLP LDA (SRC),Y + STA (DST),Y + DEY + CPY #$FF + BNE + + DEC DSTH + DEC SRCH ++ DEC ESTKL-3,X + BNE REVCPYLP + DEC ESTKH-3,X + 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 ++ +end +// +// CHAR OUT +// COUT(CHAR) +// +asm cout(c)#0 + LDA ESTKL,X + BIT $BF98 + BMI + + JSR TOUPR ++ ORA #$80 + INX +++ BIT ROMEN + JSR $FDED + BIT LCRDEN+LCBNK2 + RTS +end +// +// CHAR IN +// RDKEY() +// +asm cin()#1 + BIT ROMEN + JSR $FD0C + BIT LCRDEN+LCBNK2 + DEX + LDY #$00 + AND #$7F + STA ESTKL,X + STY ESTKH,X + RTS +end +// +// PRINT STRING +// PRSTR(STR) +// +asm prstr(s)#0 + LDY #$00 + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH + LDA (SRC),Y + BEQ ++ + STA TMP + BIT ROMEN +- INY + LDA (SRC),Y + BIT $BF98 + BMI + + JSR TOUPR ++ ORA #$80 + JSR $FDED + CPY TMP + BNE - + BIT LCRDEN+LCBNK2 +++ INX + RTS +end +// +// PRINT WORD +// +asm prword(w)#0 + LDA ESTKH,X + JSR + + DEX + ; FALL THROUGH TO PRBYTE +end +// +// PRINT BYTE +// +asm prbyte(b)#0 + LDA ESTKL,X ++ STX ESP + BIT ROMEN + JSR $FDDA + LDX ESP + BIT LCRDEN+LCBNK2 + INX + RTS +end +// +// READ STRING +// STR = RDSTR(PROMPTCHAR) +// +asm rdstr(p)#1 + LDA ESTKL,X + STA $33 + STX ESP + BIT ROMEN + JSR $FD6A + STX $01FF +- LDA $01FF,X + AND #$7F + STA $01FF,X + DEX + BPL - + TXA + LDX ESP + STA ESTKL,X + LDA #$01 + STA ESTKH,X + BIT LCRDEN+LCBNK2 + RTS +end +asm uword_isge(a,b)#1 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm uword_isle(a,b)#1 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm uword_isgt(a,b)#1 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm uword_islt(a,b)#1 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS +end +asm divmod(a,b)#2 + JSR INTERP ; CALL INTERP + !BYTE $36, $5C ; DIVMOD, RET +end +asm sext(a)#1 + LDY #$00 + LDA ESTKL,X + BPL + + DEY ++ STY ESTKH,X + RTS +end +// +// Utility routines. +// +// A DCI string is one that has the high bit set for every character except the last. +// More efficient than C or Pascal strings. +// +//def dcitos(dci, str) +// byte len, c +// len = 0 +// repeat +// c = (dci).[len] +// len = len + 1 +// (str).[len] = c & $7F +// until !(c & $80) +// ^str = len +// return len +//end +asm dcitos(dci, str)#1 + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + CMP #$80 + AND #$7F + INY + STA (DST),Y + BCS - + TYA + LDY #$00 + STA (DST),Y + INX + STA ESTKL,X + STY ESTKH,X + RTS +end +//def stodci(str, dci) +// byte len, c +// len = ^str +// if len == 0 +// return +// fin +// c = toupper((str).[len]) & $7F +// len = len - 1 +// (dci).[len] = c +// while len +// c = toupper((str).[len]) | $80 +// len = len - 1 +// (dci).[len] = c +// loop +// return ^str +//end +asm stodci(str,dci)#1 + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + INX + LDY #$00 + LDA (SRC),Y + BEQ ++ + TAY + LDA (SRC),Y + JSR TOUPR + BNE + +- LDA (SRC),Y + JSR TOUPR + ORA #$80 ++ DEY + STA (DST),Y + BNE - + LDA (SRC),Y +++ STA ESTKL,X + STY ESTKH,X + RTS +end +asm toupper(c)#1 + LDA ESTKL,X +TOUPR AND #$7F + CMP #'a' + BCC + + CMP #'z'+1 + BCS + + SBC #$1F ++ STA ESTKL,X + RTS +end +// +// Lookup routines. +// +//def lookuptbl(dci, tbl) +// word match +// while ^tbl +// match = dci +// while ^tbl == ^match +// if !(^tbl & $80) +// return (tbl):1 +// fin +// tbl = tbl + 1 +// match = match + 1 +// loop +// while (^tbl & $80) +// tbl = tbl + 1 +// loop +// tbl = tbl + 3 +// loop +// return 0 +asm lookuptbl(dci, tbl)#1 + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + INX + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH +-- LDY #$00 +- LDA (DST),Y + BEQ + + CMP (SRC),Y + BNE ++ + INY + ASL + BCS - + LDA (DST),Y + STA ESTKL,X ; MATCH + INY + LDA (DST),Y + STA ESTKH,X + RTS ++ STA ESTKL,X ; NO MATCH + STA ESTKH,X + RTS +++ +- LDA (DST),Y ; NEXT ENTRY + BPL + + INY + BNE - ++ TYA + CLC + ADC #$03 + ADC DSTL + STA DSTL + BCC -- + INC DSTH + BNE -- +end +// def lookupidx(esd, index) +// word sym +// while ^esd +// sym = esd +// esd = sym + dcitos(sym, @str) +// if esd->0 & $10 and esd->1 == index +// return sym +// fin +// esd = esd + 3 +// loop +//end +asm lookupidx(esd, index)#1 + LDA ESTKL,X + STA TMPL + INX +--- LDA ESTKH,X + STA SRCH + LDA ESTKL,X +-- STA SRCL + LDY #$00 +- LDA (SRC),Y + BPL + + INY + BNE - ++ BEQ ++ ; END OF ESD + INY + LDA (SRC),Y + INY + AND #$10 ; EXTERN FLAG? + BEQ + + LDA (SRC),Y + CMP TMPL + BEQ +++ ; MATCH ++ INY + TYA + SEC + ADC SRCL + STA ESTKL,X ; SYM PTRL + BCC -- + INC ESTKH,X ; SYM PTRH + BNE --- +++ STA ESTKL,X ; END OF ESD + STA ESTKH,X ++++ RTS +end +//def lookupdef(addr, deftbl)#1 +// while deftbl->interpjsr == $20 +// if deftbl=>bytecodeaddr == addr +// return deftbl +// fin +// deftbl = deftbl + t_defentry +// loop +// return 0 +//end +asm lookupdef(addr, deftbl)#1 + LDA ESTKH,X + STA SRCH + LDA ESTKL,X + STA SRCL + INX +- LDY #$00 + LDA (SRC),Y + CMP #$20 ; JSR OPCODE? + BNE ++ + LDY #$03 + LDA (SRC),Y + CMP ESTKL,X + BNE + + INY + LDA (SRC),Y + CMP ESTKH,X + BNE + + LDA SRCL ; MATCH + STA ESTKL,X + LDA SRCH + STA ESTKH,X + RTS ++ LDA #$07 ; NEXT ENTRY + CLC + ADC SRCL + STA SRCL + BCC - + INC SRCH + BNE - +++ STY ESTKL,X + STY ESTKH,X + RTS +end +// +// Reloc internal data +// +//def reloc(modfix, modofst, bytecode, rld)#3 +// word addr, fixup +// while ^rld +// if ^rld & $10 // EXTERN reference. +// return rld, addr, fixup +// fin +// addr = rld=>1 + modfix +// fixup = *addr + modofst +// if uword_isge(fixup, bytecode) // Bytecode address. +// return rld, addr, fixup +// fin +// *addr = fixup +// rld = rld + 4 +// loop +// return rld, addr, fixup +//end +asm reloc(modfix, modofst, bytecode, rld)#3 + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + BEQ RLDEX ; END OF RLD + PHA + INY + LDA (SRC),Y + INY + CLC + ADC ESTKL+3,X ; ADDR=ENTRY=>1+MODFIX + STA DSTL + LDA (SRC),Y + ADC ESTKH+3,X + STA DSTH + PLA + AND #$10 ; EXTERN REF - EXIT + BNE RLDEX + TAY ; FIXUP=*ADDR+MODOFST + LDA (DST),Y + INY + CLC + ADC ESTKL+2,X + STA TMPL + LDA (DST),Y + ADC ESTKH+2,X + CMP ESTKH+1,X ; FIXUP >= BYTECODE? + BCC + + STA TMPH + BNE RLDEX ; YEP, EXIT + LDA TMPL + CMP ESTKL+1,X + BCS RLDEX ; YEP, EXIT + LDA TMPH ++ STA (DST),Y ; *ADDR=FIXUP + DEY + LDA TMPL + STA (DST),Y + LDA SRCL ; NEXT ENTRY +; CLC + ADC #$04 + STA SRCL + BCC - + INC SRCH + BNE - +RLDEX INX + LDA TMPL + STA ESTKL,X + LDA TMPH + STA ESTKH,X + LDA DSTL + STA ESTKL+1,X + LDA DSTH + STA ESTKH+1,X + LDA SRCL + STA ESTKL+2,X + LDA SRCH + STA ESTKH+2,X + RTS +end +// +// Cheap and dirty print integer +// +def print(i)#0 + if i < 0; cout('-'); i = -i; fin + if i >= 10; print(i / 10); fin + cout(i % 10 + '0') +end +// +// ProDOS routines +// +def pfxop(path, op)#1 + byte params[3] + + params.0 = 1 + params:1 = path + perr = syscall(op, @params) + return path +end +def open(path)#1 + byte params[6] + + params.0 = 3 + params:1 = path + params:3 = iobuffer + params.5 = 0 + perr = syscall($C8, @params) + return params.5 +end +def close(refnum)#1 + byte params[2] + + params.0 = 1 + params.1 = refnum + perr = syscall($CC, @params) + return perr +end +def read(refnum, buff, len)#1 + byte params[8] + + params.0 = 4 + params.1 = refnum + params:2 = buff + params:4 = len + params:6 = 0 + perr = syscall($CA, @params) + return params:6 +end +def write(refnum, 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. +// +def availheap()#1 + byte fp + return @fp - heap +end +def allocheap(size)#1 + word addr + addr = heap + heap = heap + size + if systemflags & reshgr1 + if uword_islt(addr, $4000) and uword_isgt(heap, $2000) + addr = $4000 + heap = addr + size + fin + fin + if systemflags & reshgr2 + if uword_islt(addr, $6000) and uword_isgt(heap, $4000) + addr = $6000 + heap = addr + size + fin + fin + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def allocalignheap(size, pow2, freeaddr) + word align, addr + if freeaddr + *freeaddr = heap + fin + align = (1 << pow2) - 1 + addr = (heap | align) + 1 + heap = addr + size + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def markheap()#1 + return heap +end +def releaseheap(newheap)#1 + heap = newheap + return @newheap - heap +end +def allocxheap(size)#1 + word xaddr + xaddr = xheap + xheap = xheap + size + if systemflags & restxt1 + if uword_isle(xaddr, $0800) and uword_isgt(xheap, $0400) + xaddr = $0800 + xheap = xaddr + size + fin + fin + if systemflags & restxt2 + if uword_isle(xaddr, $0C00) and uword_isgt(xheap, $0800) + xaddr = $0C00 + xheap = xaddr + size + fin + fin + if systemflags & resxhgr1 + if uword_isle(xaddr, $4000) and uword_isgt(xheap, $2000) + xaddr = $4000 + xheap = xaddr + size + fin + fin + if systemflags & resxhgr2 + if uword_isle(xaddr, $6000) and uword_isgt(xheap, $4000) + xaddr = $6000 + xheap = xaddr + size + fin + fin + if uword_isge(xheap, $BF00) + return 0 + fin + return xaddr +end +// +// Symbol table routines. +// +def addsym(sym, addr)#0 + while ^sym & $80 + ^lastsym = ^sym + lastsym++ + sym++ + loop + lastsym->0 = ^sym + lastsym=>1 = addr + lastsym = lastsym + 3 + ^lastsym = 0 +end +// +// String routines. +// +def strcpy(dst, src)#1 + memcpy(dst+1, src+1, ^src) + ^dst = ^src + return dst +end +def strcat(dst, src)#1 + memcpy(dst + ^dst + 1, src + 1, ^src) + ^dst = ^dst + ^src + return dst +end +// +// Module routines. +// +def lookupextern(esd, index)#1 + word sym, addr + byte str[16] + sym = lookupidx(esd, index) + if sym + addr = lookuptbl(sym, symtbl) + if !addr + perr = $81 + dcitos(sym, @str) + cout('?'); prstr(@str); crout + fin + return addr + fin + return 0 +end +// +// Indirect interpreter DEFinition entrypoint +// +def adddef(isfirst, addr, deflast)#1 + word preventry, defentry, defsize + + defentry = *deflast + *deflast = defentry + t_defentry + if not isfirst + preventry = defentry - t_defentry + defsize = addr - preventry=>bytecodeaddr + if *jitcomp and defsize < 256 + preventry=>interpaddr = $03D6 // JSR $03D6 (JIT INTERP) + preventry->callcount = jitcount // Set count + preventry->bytecodesize = defsize // Set size + fin + fin + defentry->interpjsr = $20 + defentry=>interpaddr = $03DC // JSR $03DC (BYTECODE INTERP) + defentry=>bytecodeaddr = addr + //defentry=>5 = 0 // Clear count and size + defentry->t_defentry = 0 // NULL out next entry + return defentry +end +def loadmod(mod)#1 + word rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup + word addr, defaddr, modaddr, modfix, modofst, modend + word deftbl, deflast + word moddep, rld, esd, sym + byte refnum[], deffirst, str[16], filename[64] + byte header[128] + // + // Read the RELocatable module header (first 128 bytes) + // + dcitos(mod, @filename) + refnum = open(@filename) + if !refnum + // + // Try system path + // + 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 + defofst = modsize + RELADDR + init = 0 + if rdlen > 4 and header:2 == $6502 // magic number + // + // This is an EXTended RELocatable (data+bytecode) module. + // + systemflags = header:4 | systemflags + defofst = header:6 + defcnt = header:8 + init = header:10 + moddep = @header.12 + // + // Load module dependencies. + // + while ^moddep + if !lookuptbl(moddep, symtbl) + close(refnum) + refnum = 0 + if loadmod(moddep) < 0 + return -perr + fin + fin + moddep = moddep + dcitos(moddep, @str) + loop + // + // Init def table. + // + deftbl = allocheap(defcnt * t_defentry + 1) + deflast = deftbl + if !refnum + // + // Reset read pointer. + // + refnum = open(@filename) + rdlen = read(refnum, @header, 128) + fin + fin + // + // Alloc heap space for relocated module (data + bytecode). + // + moddep = moddep + 1 + modfix = moddep - @header.2 // Adjust to skip header + modsize = modsize - modfix + rdlen = rdlen - modfix - 2 + modaddr = allocheap(modsize) + memcpy(modaddr, moddep, rdlen) + // + // Read in remainder of module into memory for fixups. + // + addr = modaddr + repeat + addr = addr + rdlen + rdlen = read(refnum, addr, 4096) + until rdlen <= 0 + close(refnum) + // + // Add module to symbol table. + // + addsym(mod, modaddr) + // + // Apply all fixups and symbol import/export. + // + modfix = modaddr - modfix + modofst = modfix - RELADDR + modend = modaddr + modsize + bytecode = defofst + modofst + rld = modend // Re-Locatable Directory + esd = rld // Extern+Entry Symbol Directory + while ^esd // Scan to end of ESD + esd = esd + 4 + loop + esd = esd + 1 + defaddr = allocxheap(rld - bytecode) + modend = bytecode + codefix = defaddr - bytecode + defofst = defaddr - defofst + // + // Run through the DeFinition Dictionary. + // + deffirst = 1 + while ^rld == $02 + // + // This is a bytcode def entry - add it to the def directory. + // + adddef(deffirst, rld=>1 + defofst, @deflast) + deffirst = 0 + rld = rld + 4 + loop + // + // Run through the Re-Location Dictionary. + // + while ^rld + rld, addr, fixup = reloc(modfix, modofst, bytecode, rld) + if ^rld + *addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl) + rld = rld + 4 + fin + loop + // + // Run through the External/Entry Symbol Directory. + // + while ^esd + sym = esd + esd = esd + dcitos(esd, @str) + if ^esd & $08 + // + // EXPORT symbol - add it to the global symbol table. + // + addr = esd=>1 + modofst + if uword_isge(addr, bytecode) + // + // Use the def directory address for bytecode. + // + addr = lookupdef(addr + codefix, deftbl) + fin + addsym(sym, addr) + fin + esd = esd + 3 + loop + // + // Move bytecode to AUX bank. + // + memxcpy(defaddr, bytecode, modsize - (bytecode - modaddr)) + fin + if perr + return -perr + fin + // + // Free up rld+esd (and bytecode on 128K) in main memory. + // + releaseheap(modend) + // + // Call init routine if it exists. + // + fixup = 0 // This is repurposed for the return code + if init + init = init + defofst + fixup = adddef(deffirst, init, @deflast)() + if fixup < modinitkeep + // + // Free init routine unless initkeep + // + xheap = init + if fixup < 0 + perr = -fixup + fin + else + fixup = fixup & ~modinitkeep + fin + fin + return fixup +end +// +// Command mode +// +def volumes()#0 + byte params[4] + word strbuf + byte i + + params.0 = 2 + params.1 = 0 + params:2 = databuff + perr = syscall($C5, @params) + strbuf = databuff + for i = 0 to 15 + ^strbuf = ^strbuf & $0F + if ^strbuf + cout('/'); prstr(strbuf); crout() + fin + strbuf = strbuf + 16 + next +end +def catalog(path)#0 + byte refnum + byte firstblk + byte entrylen, entriesblk + byte i, type, len + word entry, filecnt + + if !^path + path = @prefix + fin + refnum = open(path) + if perr + return + fin + firstblk = 1 + repeat + if read(refnum, databuff, 512) == 512 + entry = databuff + 4 + if firstblk + entrylen = databuff.$23 + entriesblk = databuff.$24 + filecnt = databuff:$25 + entry = entry + entrylen + fin + for i = firstblk to entriesblk + type = ^entry + if type + len = type & $0F + ^entry = len + prstr(entry) + type = ' ' + when entry->$10 + is $0F // Is it a directory? + type = '/' + break + is $FF // SYSTEM file + type = '-' + break + is $FE // REL file + type = '+' + wend + cout(type) + for len = 18 - len downto 0 + cout(' ') + next + filecnt-- + fin + entry = entry + entrylen + next + firstblk = 0 + else + filecnt = 0 + fin + until !filecnt + close(refnum) + crout() +end +def stripchars(strptr)#1 + while ^strptr and ^(strptr + 1) > ' ' + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr-- + loop + return ^strptr +end +def stripspaces(strptr)#0 + while ^strptr and ^(strptr + ^strptr) <= ' ' + ^strptr-- + loop + while ^strptr and ^(strptr + 1) <= ' ' + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr-- + loop +end +def striptrail(strptr)#1 + byte i + + for i = 1 to ^strptr + if ^(strptr + i) <= ' ' + ^strptr = i - 1 + break + fin + next + return strptr +end +def parsecmd(strptr)#1 + byte cmd + + cmd = 0 + stripspaces(strptr) + if ^strptr + cmd = ^(strptr + 1) + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr-- + fin + stripspaces(strptr) + return cmd +end +def resetmemfiles()#0 + // + // Close all files + // + ^$BFD8 = 0 + close(0) + // + // Set memory bitmap + // + memset($BF58, 0, 24) + ^$BF58 = $CF + ^$BF6F = $01 +end +def execsys(sysfile)#0 + byte refnum + word len + + if ^sysfile + strcpy($280, sysfile) + striptrail(sysfile) + refnum = open(sysfile) + if refnum + len = read(refnum, databuff, $FFFF) + resetmemfiles() + if len + strcpy(sysfile, $280) + if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE + stripspaces(sysfile) + if ^$2005 >= ^sysfile + 1 + strcpy($2006, sysfile) + fin + fin + striptrail($280) + exec() + fin + fin + fin +end +def execmod(modfile)#1 + byte moddci[17] + word saveheap, savexheap, savesym, saveflags, savejit + + perr = 1 + if stodci(modfile, @moddci) + saveheap = heap + savexheap = xheap + savesym = lastsym + saveflags = systemflags + savejit = *jitcodeptr + if loadmod(@moddci) < modkeep + lastsym = savesym + xheap = savexheap + heap = saveheap + *jitcodeptr = savejit + fin + ^lastsym = 0 + systemflags = saveflags + fin + return -perr +end +// +// Get heap start. +// +heap = *freemem +// +// Print PLASMA version +// +prstr("PLASMA 2.0 Dev\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout +// +// Init symbol table. +// +while *sysmodsym + stodci(sysmodsym=>0, heap) + addsym(heap, sysmodsym=>2) + sysmodsym = sysmodsym + 4 +loop +// +// Set system path +// +strcat(strcpy(@sysmods, $280), "SYS/")) // This is the path to CMD +syspath = @sysmods // Update external interface table +syscmdln = @cmdln +loadmod(@jitmod) +// +// Try to load autorun. +// +autorun = open(@autorun) +if autorun > 0 + cmdln = read(autorun, @autorun, 128) + close(0) +else + // + // Print some startup info. + // + prstr("MEM FREE:$"); prword(availheap); crout +fin +perr = 0 +while 1 + if ^getlnbuf + when toupper(parsecmd(getlnbuf)) + is 'Q' + reboot() + break + is 'C' + catalog(getlnbuf) + break + is 'P' + pfxop(getlnbuf, SET_PFX) + break + is '/' + repeat + prefix-- + until prefix[prefix] == '/' + if prefix > 1 + pfxop(@prefix, SET_PFX) + fin + break + is 'V' + volumes() + break + is '-' + execsys(getlnbuf) + break + is '+' + saveX + execmod(striptrail(getlnbuf)) + // + // Clean up + // + restoreX + resetmemfiles + break + otherwise + cout('?') + wend + if perr + prstr("ERR:$") + prbyte(perr) + perr = 0 + else + prstr("OK") + fin + crout() + fin + prstr(pfxop(@prefix, GET_PFX)) + strcpy(@cmdln, rdstr($BA)) +loop +done diff --git a/src/vmsrc/apple/cmdjitstub.s b/src/vmsrc/apple/cmdjitstub.s new file mode 100644 index 0000000..69f3a4e --- /dev/null +++ b/src/vmsrc/apple/cmdjitstub.s @@ -0,0 +1,48 @@ +INTERP = $03D0 +LCRDEN = $C080 +LCWTEN = $C081 +ROMEN = $C082 +LCRWEN = $C083 +LCBNK2 = $00 +LCBNK1 = $08 + !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 PPL + STY IFPL ; INIT FRAME POINTER + LDA #$B0 + STA PPH + STA IFPH + 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 = * +} diff --git a/src/vmsrc/apple/plvm02.s b/src/vmsrc/apple/plvm02.s index a33d4c8..fddb3dd 100755 --- a/src/vmsrc/apple/plvm02.s +++ b/src/vmsrc/apple/plvm02.s @@ -338,7 +338,7 @@ CMDENTRY = * ; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT ; FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE - LDY #31 + LDY #11 - LDA FAILMSG,Y ORA #$80 JSR $FDED @@ -358,7 +358,7 @@ READPARMS !BYTE 4 CLOSEPARMS !BYTE 1 !BYTE 0 DISABLE80 !BYTE 21, 13, '1', 26, 13 -FAILMSG !TEXT "...TESER OT YEK YNA .DMC GNISSIM" +FAILMSG !TEXT ".DMC GNISSIM" PAGE0 = * ;****************************** ;* * @@ -384,10 +384,10 @@ PAGE3 = * BIT LCRDEN+LCBNK2 ; $03DC - INDIRECT INTERPX ENTRY JMP IINTRPX } -DEFCMD !FILL 28 +DEFCMD = * ;!FILL 28 ENDBYE = * } -LCDEFCMD = *-28 ; DEFCMD IN LC MEMORY +LCDEFCMD = * ;*-28 ; DEFCMD IN LC MEMORY ;***************** ;* * ;* OPXCODE TABLE * diff --git a/src/vmsrc/apple/plvmjit02.s b/src/vmsrc/apple/plvmjit02.s new file mode 100755 index 0000000..0c4b626 --- /dev/null +++ b/src/vmsrc/apple/plvmjit02.s @@ -0,0 +1,2353 @@ +;********************************************************** +;* +;* APPLE ][ 64K/128K PLASMA INTERPRETER +;* +;* SYSTEM ROUTINES AND LOCATIONS +;* +;********************************************************** + !CPU 65C02 +;* +;* MONITOR SPECIAL LOCATIONS +;* +CSWL = $36 +CSWH = $37 +PROMPT = $33 +;* +;* PRODOS +;* +PRODOS = $BF00 +DEVCNT = $BF31 ; GLOBAL PAGE DEVICE COUNT +DEVLST = $BF32 ; GLOBAL PAGE DEVICE LIST +MACHID = $BF98 ; GLOBAL PAGE MACHINE ID BYTE +RAMSLOT = $BF26 ; SLOT 3, DRIVE 2 IS /RAM'S DRIVER VECTOR +NODEV = $BF10 +;* +;* HARDWARE ADDRESSES +;* +KEYBD = $C000 +CLRKBD = $C010 +SPKR = $C030 +LCRDEN = $C080 +LCWTEN = $C081 +ROMEN = $C082 +LCRWEN = $C083 +LCBNK2 = $00 +LCBNK1 = $08 +ALTZPOFF= $C008 +ALTZPON = $C009 +ALTRDOFF= $C002 +ALTRDON = $C003 +ALTWROFF= $C004 +ALTWRON = $C005 + !SOURCE "vmsrc/plvmzp.inc" +PSR = TMP+2 +DVSIGN = PSR+1 +DROP = $EF +NEXTOP = $F0 +FETCHOP = NEXTOP+1 +IP = FETCHOP+1 +IPL = IP +IPH = IPL+1 +OPIDX = FETCHOP+6 +OPPAGE = OPIDX+1 +STRBUF = $0280 +INTERP = $03D0 +JITCOMP = $03E2 +;****************************** +;* * +;* INTERPRETER INITIALIZATION * +;* * +;****************************** +* = $2000 + LDX #$FE + TXS + LDX #$00 + STX $01FF +;* +;* MUST HAVE 128K FOR JIT +;* ++ LDA MACHID + AND #$30 + CMP #$30 + BEQ ++ + LDY #$00 +- LDA NEEDAUX,Y + BEQ + + ORA #$80 + JSR $FDED + INY + BNE - ++ LDA $C000 + BPL - + LDA $C010 + JSR PRODOS + !BYTE $65 + !WORD BYEPARMS +BYEPARMS !BYTE 4 + !BYTE 4 + !WORD 0 + !BYTE 0 + !WORD 0 +NEEDAUX !TEXT "128K MEMORY REQUIRED.", 13 + !TEXT "PRESS ANY KEY...", 0 +;* +;* DISCONNECT /RAM +;* +++ ;SEI ; DISABLE /RAM + LDA RAMSLOT + CMP NODEV + BNE RAMCONT + LDA RAMSLOT+1 + CMP NODEV+1 + BEQ RAMDONE +RAMCONT LDY DEVCNT +RAMLOOP LDA DEVLST,Y + AND #$F3 + CMP #$B3 + BEQ GETLOOP + DEY + BPL RAMLOOP + BMI RAMDONE +GETLOOP LDA DEVLST+1,Y + STA DEVLST,Y + BEQ RAMEXIT + INY + BNE GETLOOP +RAMEXIT LDA NODEV + STA RAMSLOT + LDA NODEV+1 + STA RAMSLOT+1 + DEC DEVCNT +RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE +;* +;* MOVE VM INTO LANGUAGE CARD +;* + BIT LCRWEN+LCBNK2 + BIT LCRWEN+LCBNK2 + LDA #VMCORE + STA SRCH + LDY #$00 + STY DSTL + LDA #$D0 + STA DSTH +- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD + STA (DST),Y + INY + BNE - + INC SRCH + INC DSTH + LDA DSTH + CMP #$E0 + BNE - +;* +;* MOVE FIRST PAGE OF 'BYE' INTO PLACE +;* + STY SRCL + LDA #$D1 + STA SRCH +- LDA (SRC),Y + STA $1000,Y + INY + BNE - +;* +;* INSERT 65C02 OPS IF APPLICABLE +;* + LDA #$00 + INC + BEQ + + JSR C02OPS +;* +;* SAVE DEFAULT COMMAND INTERPRETER PATH IN LC +;* ++ JSR PRODOS ; GET PREFIX + !BYTE $C7 + !WORD GETPFXPARMS + LDY STRBUF ; APPEND "CMDJIT" + LDA #"/" + CMP STRBUF,Y + BEQ + + INY + STA STRBUF,Y ++ LDA #"C" + INY + STA STRBUF,Y + LDA #"M" + INY + STA STRBUF,Y + LDA #"D" + INY + STA STRBUF,Y + LDA #"J" + INY + STA STRBUF,Y + LDA #"I" + INY + STA STRBUF,Y + LDA #"T" + INY + STA STRBUF,Y + STY STRBUF + BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE + BIT LCRWEN+LCBNK2 +- LDA STRBUF,Y + STA LCDEFCMD,Y + DEY + BPL - + JMP CMDENTRY +GETPFXPARMS !BYTE 1 + !WORD STRBUF ; PATH STRING GOES HERE +;************************************************ +;* * +;* LANGUAGE CARD RESIDENT PLASMA VM STARTS HERE * +;* * +;************************************************ +VMCORE = * + !PSEUDOPC $D000 { +;**************** +;* * +;* OPCODE TABLE * +;* * +;**************** + !ALIGN 255,0 +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 +;* +;* DIRECTLY ENTER INTO BYTECODE INTERPRETER +;* +DINTRP PLA + CLC + ADC #$01 + STA IPL + PLA + ADC #$00 + STA IPH + LDY #$00 + LDA #>OPTBL + STA OPPAGE + JMP FETCHOP +;* +;* INDIRECTLY ENTER INTO BYTECODE INTERPRETER +;* +IINTRPX PHP + PLA + STA PSR + SEI + PLA + STA TMPL + PLA + STA TMPH + LDY #$02 + LDA (TMP),Y + STA IPH + DEY + LDA (TMP),Y + STA IPL + DEY + LDA #>OPXTBL + STA OPPAGE + STA ALTRDON + JMP FETCHOP +;************************************************************ +;* * +;* 'BYE' PROCESSING - COPIED TO $1000 ON PRODOS BYE COMMAND * +;* * +;************************************************************ + !ALIGN 255,0 + !PSEUDOPC $1000 { +BYE LDY DEFCMD +- LDA DEFCMD,Y ; SET DEFAULT COMMAND WHEN CALLED FROM 'BYE' + STA STRBUF,Y + DEY + BPL - +; INY ; CLEAR CMDLINE BUFF +; STY $01FF +CMDENTRY = * +; +; DEACTIVATE 80 COL CARDS +; + BIT ROMEN + LDY #4 +- LDA DISABLE80,Y + ORA #$80 + JSR $FDED + DEY + BPL - + BIT $C054 ; SET TEXT MODE + BIT $C051 + BIT $C05F + JSR $FC58 ; HOME +; +; INSTALL PAGE 0 FETCHOP ROUTINE +; + LDY #$0F +- LDA PAGE0,Y + STA DROP,Y + DEY + BPL - +; +; SET JMPTMP OPCODE +; + LDA #$4C + STA JMPTMP +; +; INSTALL PAGE 3 VECTORS +; + LDY #$16 +- LDA PAGE3,Y + STA INTERP,Y + DEY + BPL - +; +; READ CMD INTO MEMORY +; + JSR PRODOS ; CLOSE EVERYTHING + !BYTE $CC + !WORD CLOSEPARMS + BNE FAIL + JSR PRODOS ; OPEN CMD + !BYTE $C8 + !WORD OPENPARMS + BNE FAIL + LDA REFNUM + STA READPARMS+1 + JSR PRODOS + !BYTE $CA + !WORD READPARMS + BNE FAIL + JSR PRODOS + !BYTE $CC + !WORD CLOSEPARMS + BNE FAIL +; +; INIT VM ENVIRONMENT STACK POINTERS +; +; LDA #$00 + STA $01FF ; CLEAR CMDLINE BUFF + STA PPL ; INIT FRAME POINTER + STA IFPL + LDA #$B0 ; FRAME POINTER AT $B000, BELOW JIT BUFFER + STA PPH + STA IFPH + LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS) + TXS + LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX +; +; CHANGE CMD STRING TO SYSPATH STRING +; + LDA STRBUF + SEC + SBC #$06 + STA STRBUF + JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND +; +; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT +; +FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE + LDY #11 +- LDA FAILMSG,Y + ORA #$80 + JSR $FDED + DEY + BPL - + JSR $FD0C ; WAIT FOR KEYPRESS + JMP ($FFFC) ; RESET +OPENPARMS !BYTE 3 + !WORD STRBUF + !WORD $0800 +REFNUM !BYTE 0 +READPARMS !BYTE 4 + !BYTE 0 + !WORD $2000 + !WORD $9F00 + !WORD 0 +CLOSEPARMS !BYTE 1 + !BYTE 0 +DISABLE80 !BYTE 21, 13, '1', 26, 13 +FAILMSG !TEXT ".DMC GNISSIM" +PAGE0 = * +;****************************** +;* * +;* INTERP BYTECODE INNER LOOP * +;* * +;****************************** + !PSEUDOPC DROP { + INX ; DROP @ $EF + INY ; NEXTOP @ $F0 + LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4 + STA OPIDX + JMP (OPTBL) ; OPIDX AND OPPAGE MAP OVER OPTBL +} +PAGE3 = * +;* +;* PAGE 3 VECTORS INTO INTERPRETER +;* + !PSEUDOPC $03D0 { + BIT LCRDEN+LCBNK2 ; $03D0 - BYTECODE DIRECT INTERP ENTRY + JMP DINTRP + BIT LCRDEN+LCBNK2 ; $03D6 - JIT INDIRECT INTERPX ENTRY + JMP JITINTRPX + BIT LCRDEN+LCBNK2 ; $03DC - BYTECODE INDIRECT INTERPX ENTRY + JMP IINTRPX +} +DEFCMD !FILL 28 +ENDBYE = * +} +LCDEFCMD = *-28 ; DEFCMD IN LC MEMORY +;***************** +;* * +;* OPXCODE TABLE * +;* * +;***************** + !ALIGN 255,0 +OPXTBL !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,CSX ; 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,CALLX,ICALX,ENTER,LEAVEX,RETX,CFFB ; 50 52 54 56 58 5A 5C 5E + !WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,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 ADDLBX,ADDLWX,ADDABX,ADDAWX,IDXLBX,IDXLWX,IDXABX,IDXAWX ; B0 B2 B4 B6 B8 BA BC BE +;* +;* JIT PROFILING ENTRY INTO INTERPRETER +;* +JITINTRPX PHP + PLA + STA PSR + SEI + PLA + SEC + SBC #$02 ; POINT TO DEF ENTRY + STA TMPL + PLA + SBC #$00 + STA TMPH + LDY #$05 ; DEC JIT COUNT + LDA (TMP),Y + SEC + SBC #$01 + STA (TMP),Y + BEQ RUNJIT + DEY +- LDA (TMP),Y + STA IPH + DEY + LDA (TMP),Y + STA IPL + LDY #$00 + LDA #>OPXTBL + STA OPPAGE + STA ALTRDON + JMP FETCHOP +RUNJIT LDA JITCOMP + STA SRCL + LDA JITCOMP+1 + STA SRCH + DEY ; LDY #$04 + LDA (SRC),Y + STA IPH + DEY + LDA (SRC),Y + STA IPL + DEX ; ADD PARAMETER TO DEF ENTRY + LDA TMPL + PHA + STA ESTKL,X + LDA TMPH + PHA + STA ESTKH,X + LDY #$00 + LDA #>OPXTBL + STA OPPAGE + STA ALTRDON + JSR FETCHOP ; CALL JIT COMPILER + PLA + STA TMPH + PLA + STA TMPL + JMP JMPTMP ; RE-CALL ORIGINAL ROUTINE +;* +;* ADD TOS TO TOS-1 +;* +ADD LDA ESTKL,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + JMP DROP +;* +;* SUB TOS FROM TOS-1 +;* +SUB LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + JMP DROP +;* +;* SHIFT TOS LEFT BY 1, ADD TO TOS-1 +;* +IDXW LDA ESTKL,X + ASL + ROL ESTKH,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + JMP DROP +;* +;* MUL TOS-1 BY TOS +;* +MUL STY IPY + LDY #$10 + LDA ESTKL+1,X + EOR #$FF + STA TMPL + LDA ESTKH+1,X + EOR #$FF + STA TMPH + LDA #$00 + STA ESTKL+1,X ; PRODL +; STA ESTKH+1,X ; PRODH +_MULLP LSR TMPH ; MULTPLRH + ROR TMPL ; MULTPLRL + BCS + + STA ESTKH+1,X ; PRODH + LDA ESTKL,X ; MULTPLNDL + ADC ESTKL+1,X ; PRODL + STA ESTKL+1,X + LDA ESTKH,X ; MULTPLNDH + ADC ESTKH+1,X ; PRODH ++ ASL ESTKL,X ; MULTPLNDL + ROL ESTKH,X ; MULTPLNDH + DEY + BNE _MULLP + STA ESTKH+1,X ; PRODH + LDY IPY + JMP DROP +;* +;* INTERNAL DIVIDE ALGORITHM +;* +_NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + RTS +_DIV STY IPY + LDY #$11 ; #BITS+1 + LDA #$00 + STA TMPL ; REMNDRL + STA TMPH ; REMNDRH + STA DVSIGN + LDA ESTKH+1,X + BPL + + INX + JSR _NEG + DEX + LDA #$81 + STA DVSIGN ++ ORA ESTKL+1,X ; DVDNDL + BEQ _DIVEX + LDA ESTKH,X + BPL _DIV1 + JSR _NEG + INC DVSIGN +_DIV1 ASL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEY + BCC _DIV1 +_DIVLP ROL TMPL ; REMNDRL + ROL TMPH ; REMNDRH + LDA TMPL ; REMNDRL + CMP ESTKL,X ; DVSRL + LDA TMPH ; REMNDRH + SBC ESTKH,X ; DVSRH + BCC + + STA TMPH ; REMNDRH + LDA TMPL ; REMNDRL + SBC ESTKL,X ; DVSRL + STA TMPL ; REMNDRL + SEC ++ ROL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEY + BNE _DIVLP +_DIVEX INX + LDY IPY + RTS +;* +;* NEGATE TOS +;* +NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + JMP NEXTOP +;* +;* DIV TOS-1 BY TOS +;* +DIV JSR _DIV + LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 + BCS NEG + JMP NEXTOP +;* +;* MOD TOS-1 BY TOS +;* +MOD JSR _DIV + LDA TMPL ; REMNDRL + STA ESTKL,X + LDA TMPH ; REMNDRH + STA ESTKH,X + LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND + BMI NEG + JMP NEXTOP +;* +;* DIVMOD TOS-1 BY TOS +;* +DIVMOD JSR _DIV + LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 + BCC + + JSR _NEG ++ DEX + LDA TMPL ; REMNDRL + STA ESTKL,X + LDA TMPH ; REMNDRH + STA ESTKH,X + ASL DVSIGN ; REMAINDER IS SIGN OF DIVIDEND + BMI NEG + JMP NEXTOP +;* +;* INCREMENT TOS +;* +INCR INC ESTKL,X + BEQ + + JMP NEXTOP ++ INC ESTKH,X + JMP NEXTOP +;* +;* DECREMENT TOS +;* +DECR LDA ESTKL,X + BEQ + + DEC ESTKL,X + JMP NEXTOP ++ DEC ESTKL,X + DEC ESTKH,X + JMP NEXTOP +;* +;* BITWISE COMPLIMENT TOS +;* +COMP LDA #$FF + EOR ESTKL,X + STA ESTKL,X + LDA #$FF + EOR ESTKH,X + STA ESTKH,X + JMP NEXTOP +;* +;* BITWISE AND TOS TO TOS-1 +;* +BAND LDA ESTKL+1,X + AND ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + AND ESTKH,X + STA ESTKH+1,X + JMP DROP +;* +;* INCLUSIVE OR TOS TO TOS-1 +;* +IOR LDA ESTKL+1,X + ORA ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + ORA ESTKH,X + STA ESTKH+1,X + JMP DROP +;* +;* EXLUSIVE OR TOS TO TOS-1 +;* +XOR LDA ESTKL+1,X + EOR ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + EOR ESTKH,X + STA ESTKH+1,X + JMP DROP +;* +;* SHIFT TOS-1 LEFT BY TOS +;* +SHL STY IPY + LDA ESTKL,X + CMP #$08 + BCC + + LDY ESTKL+1,X + STY ESTKH+1,X + LDY #$00 + STY ESTKL+1,X + SBC #$08 ++ TAY + BEQ + + LDA ESTKL+1,X +- ASL + ROL ESTKH+1,X + DEY + BNE - + STA ESTKL+1,X ++ LDY IPY + JMP DROP +;* +;* SHIFT TOS-1 RIGHT BY TOS +;* +SHR STY IPY + LDA ESTKL,X + CMP #$08 + BCC ++ + LDY ESTKH+1,X + STY ESTKL+1,X + CPY #$80 + LDY #$00 + BCC + + DEY ++ STY ESTKH+1,X + SEC + SBC #$08 +++ TAY + BEQ + + LDA ESTKH+1,X +- CMP #$80 + ROR + ROR ESTKL+1,X + DEY + BNE - + STA ESTKH+1,X ++ LDY IPY + JMP DROP +;* +;* DUPLICATE TOS +;* +DUP DEX + LDA ESTKL+1,X + STA ESTKL,X + LDA ESTKH+1,X + 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 + BEQ + + LDA #$00 + STA ESTKL,X + STA ESTKH,X + JMP NEXTOP +;* +;* CONSTANT -1, NYBBLE, BYTE, $FF BYTE, WORD (BELOW) +;* +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 +CB DEX + LDA #$00 + STA ESTKH,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKL,X + JMP NEXTOP +CFFB DEX + LDA #$FF + STA ESTKH,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKL,X + JMP NEXTOP +;* +;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP) +;* +- TYA ; RENORMALIZE IP + CLC + ADC IPL + STA IPL + BCC + + INC IPH ++ LDY #$FF +LA INY ;+INC_IP + BMI - + DEX + LDA (IP),Y + STA ESTKL,X + INY + LDA (IP),Y + STA ESTKH,X + JMP NEXTOP +CW DEX + INY ;+INC_IP + LDA (IP),Y + STA ESTKL,X + INY + LDA (IP),Y + STA ESTKH,X + JMP NEXTOP +;* +;* CONSTANT STRING +;* +CS DEX + ;INY ;+INC_IP + TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK + SEC + ADC IPL + STA IPL + STA ESTKL,X + LDA #$00 + TAY + ADC IPH + STA IPH + STA ESTKH,X + LDA (IP),Y + TAY + JMP NEXTOP +CSX DEX + ;INY ;+INC_IP + TYA ; NORMALIZE IP + SEC + ADC IPL + STA IPL + LDA #$00 + TAY + ADC IPH + STA IPH + LDA PPL ; SCAN POOL FOR STRING ALREADY THERE + STA TMPL + LDA PPH + STA TMPH +_CMPPSX ;LDA TMPH ; CHECK FOR END OF POOL + CMP IFPH + BCC _CMPSX ; CHECK FOR MATCHING STRING + BNE _CPYSX ; BEYOND END OF POOL, COPY STRING OVER + LDA TMPL + CMP IFPL + BCS _CPYSX ; AT OR BEYOND END OF POOL, COPY STRING OVER +_CMPSX STA ALTRDOFF + LDA (TMP),Y ; COMPARE STRINGS FROM AUX MEM TO STRINGS IN MAIN MEM + STA ALTRDON + CMP (IP),Y ; COMPARE STRING LENGTHS + BNE _CNXTSX1 + TAY +_CMPCSX STA ALTRDOFF + LDA (TMP),Y ; COMPARE STRING CHARS FROM END + STA ALTRDON + CMP (IP),Y + BNE _CNXTSX + DEY + BNE _CMPCSX + LDA TMPL ; MATCH - SAVE EXISTING ADDR ON ESTK AND MOVE ON + STA ESTKL,X + LDA TMPH + STA ESTKH,X + BNE _CEXSX +_CNXTSX LDY #$00 + STA ALTRDOFF + LDA (TMP),Y + STA ALTRDON +_CNXTSX1 SEC + ADC TMPL + STA TMPL + LDA #$00 + ADC TMPH + STA TMPH + BNE _CMPPSX +_CPYSX LDA (IP),Y ; COPY STRING FROM AUX TO MAIN MEM POOL + TAY ; MAKE ROOM IN POOL AND SAVE ADDR ON ESTK + EOR #$FF + CLC + ADC PPL + STA PPL + STA ESTKL,X + LDA #$FF + ADC PPH + STA PPH + STA ESTKH,X ; COPY STRING FROM AUX MEM BYTECODE TO MAIN MEM POOL +_CPYSX1 LDA (IP),Y ; ALTRD IS ON, NO NEED TO CHANGE IT HERE + STA (PP),Y ; ALTWR IS OFF, NO NEED TO CHANGE IT HERE + DEY + CPY #$FF + BNE _CPYSX1 + INY +_CEXSX LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING + TAY + JMP NEXTOP +;* +;* LOAD VALUE FROM ADDRESS TAG +;* +LB LDA ESTKL,X + STA ESTKH-1,X + LDA (ESTKH-1,X) + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +LW LDA ESTKL,X + STA ESTKH-1,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) + STA ESTKH,X + JMP NEXTOP +LBX LDA ESTKL,X + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-1,X) + STA ESTKL,X + LDA #$00 + STA ESTKH,X + STA ALTRDON + JMP NEXTOP +LWX LDA ESTKL,X + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-1,X) + STA ESTKL,X + INC ESTKH-1,X + BEQ + + LDA (ESTKH-1,X) + STA ESTKH,X + STA ALTRDON + JMP NEXTOP ++ INC ESTKH,X + LDA (ESTKH-1,X) + STA ESTKH,X + STA ALTRDON + JMP NEXTOP +;* +;* LOAD ADDRESS OF LOCAL FRAME OFFSET +;* +- TYA ; RENORMALIZE IP + CLC + ADC IPL + STA IPL + BCC + + INC IPH ++ LDY #$FF +LLA INY ;+INC_IP + BMI - + LDA (IP),Y + DEX + CLC + ADC IFPL + STA ESTKL,X + LDA #$00 + ADC IFPH + STA ESTKH,X + JMP NEXTOP +;* +;* LOAD VALUE FROM LOCAL FRAME OFFSET +;* +LLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + LDY IPY + JMP NEXTOP +LLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + INY + LDA (IFP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +LLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + STA ALTRDOFF + LDA (IFP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +LLWX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + STA ALTRDOFF + LDA (IFP),Y + STA ESTKL,X + INY + LDA (IFP),Y + STA ESTKH,X + STA ALTRDON + 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 +ADDLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ STA ALTRDON + 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 +ADDLWX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (IFP),Y + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + 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 +IDXLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + LDA (IFP),Y + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +IDXLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA TMPL + 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 +IDXLWX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA ALTRDOFF + 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 + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* LOAD VALUE FROM ABSOLUTE ADDRESS +;* +LAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + DEX + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +LAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +LABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-2,X) + DEX + STA ESTKL,X + LDA #$00 + STA ESTKH,X + STA ALTRDON + JMP NEXTOP +LAWX INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + STA ALTRDON + 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 +ADDABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-2,X) + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ STA ALTRDON + 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 +ADDAWX INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (SRC),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (SRC),Y + ADC ESTKH,X + STA ESTKH,X + STA ALTRDON + 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 +IDXABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + 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 + STA ALTRDON + 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 +IDXAWX INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + STA ALTRDOFF + 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 + STA ALTRDON + LDY IPY + JMP NEXTOP +;* +;* STORE VALUE TO ADDRESS +;* +SB LDA ESTKL,X + STA ESTKH-1,X + LDA ESTKL+1,X + STA (ESTKH-1,X) + INX + JMP DROP +SW LDA ESTKL,X + STA ESTKH-1,X + LDA ESTKL+1,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) +;* +;* DROP TOS, TOS-1 +;* +DROP2 INX + JMP DROP +;* +;* STORE VALUE TO LOCAL FRAME OFFSET +;* +SLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + LDY IPY + BMI FIXDROP + JMP DROP +SLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + LDY IPY + BMI FIXDROP + JMP DROP +FIXDROP TYA + LDY #$00 + CLC + ADC IPL + STA IPL + BCC + + INC IPH ++ JMP DROP +;* +;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK +;* +DLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + LDY IPY + JMP NEXTOP +DLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + LDY IPY + JMP NEXTOP +;* +;* STORE VALUE TO ABSOLUTE ADDRESS +;* +- TYA ; RENORMALIZE IP + CLC + ADC IPL + STA IPL + BCC + + INC IPH ++ LDY #$FF +SAB INY ;+INC_IP + BMI - + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA ESTKL,X + STA (ESTKH-2,X) + JMP DROP +SAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + LDY IPY + BMI + + JMP DROP ++ JMP FIXDROP +;* +;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK +;* +DAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA ESTKL,X + STA (ESTKH-2,X) + JMP NEXTOP +DAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + LDY IPY + JMP NEXTOP +;* +;* COMPARES +;* +ISEQ LDA ESTKL,X + CMP ESTKL+1,X + BNE ISFLS + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISFLS +ISTRU LDA #$FF + STA ESTKL+1,X + STA ESTKH+1,X + JMP DROP +ISNE LDA ESTKL,X + CMP ESTKL+1,X + BNE ISTRU + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISTRU +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 + SBC ESTKH,X + BVS + + BPL ISTRU + BMI 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 + SBC ESTKH+1,X + BVS + + BMI ISTRU + BPL ISFLS ++ +- BMI ISFLS + BPL ISTRU +ISLT LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS - + BMI ISTRU + BPL ISFLS +;* +;* 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 + BNE BRNCH +NOBRNCH INY ;+INC_IP + INY + BMI FIXNEXT + JMP NEXTOP +BRFLS INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE NOBRNCH +BRNCH 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 + JMP FETCHOP +;* +;* FOR LOOPS PUT TERMINAL VALUE AT ESTK+1 AND CURRENT COUNT ON ESTK +;* +BRGT LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVS + + BPL NOBRNCH +- INX ; DROP FOR VALUES + INX + BNE BRNCH ; BMI BRNCH +BRLT LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVS + + BPL NOBRNCH + 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 ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + BNE _BRLE +;* +;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE) +;* +CALL INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + TYA + CLC + ADC IPL + PHA + LDA IPH + ADC #$00 + PHA + JSR JMPTMP + PLA + STA IPH + PLA + STA IPL + LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE + STA OPPAGE + LDY #$01 + JMP FETCHOP +CALLX INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + TYA + CLC + ADC IPL + PHA + LDA IPH + ADC #$00 + PHA + STA ALTRDOFF + LDA PSR + PHA + PLP + JSR JMPTMP + PHP + PLA + STA PSR + SEI + STA ALTRDON + PLA + STA IPH + PLA + STA IPL + LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE + STA OPPAGE + LDY #$01 + JMP FETCHOP +;* +;* INDIRECT CALL TO ADDRESS (NATIVE CODE) +;* +ICAL LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + INX + TYA + CLC + ADC IPL + PHA + LDA IPH + ADC #$00 + PHA + JSR JMPTMP + PLA + STA IPH + PLA + STA IPL + LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE + STA OPPAGE + LDY #$01 + JMP FETCHOP +ICALX LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + INX + TYA + CLC + ADC IPL + PHA + LDA IPH + ADC #$00 + PHA + STA ALTRDOFF + LDA PSR + PHA + PLP + JSR JMPTMP + PHP + PLA + STA PSR + STA ALTRDON + PLA + STA IPH + PLA + STA IPL + LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE + STA OPPAGE + LDY #$01 + JMP FETCHOP +;* +;* JUMP INDIRECT TRHOUGH TMP +;* +;JMPTMP JMP (TMP) +;* +;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT +;* +ENTER LDA IFPH + PHA ; SAVE ON STACK FOR LEAVE + LDA IFPL + PHA + INY + LDA (IP),Y + EOR #$FF ; ALLOCATE FRAME + SEC + ADC PPL + STA PPL + STA IFPL + LDA #$FF + ADC PPH + STA PPH + STA IFPH + INY + LDA (IP),Y + BEQ + + ASL + TAY +- LDA ESTKH,X + DEY + STA (IFP),Y + LDA ESTKL,X + INX + DEY + STA (IFP),Y + BNE - ++ LDY #$03 + JMP FETCHOP +;* +;* LEAVE FUNCTION +;* +LEAVEX INY ;+INC_IP + LDA (IP),Y + CLC + ADC IFPL + STA PPL + LDA #$00 + ADC IFPH + STA PPH + PLA ; RESTORE PREVIOUS FRAME + STA IFPL + PLA + STA IFPH +RETX STA ALTRDOFF + LDA PSR + PHA + PLP + RTS +LEAVE INY ;+INC_IP + LDA (IP),Y + CLC + ADC IFPL + STA PPL + LDA #$00 + ADC IFPH + STA PPH + PLA ; RESTORE PREVIOUS FRAME + STA IFPL + PLA + STA IFPH +RET RTS +VMEND = * +} +;*************************************** +;* * +;* 65C02 OPS TO OVERWRITE STANDARD OPS * +;* * +;*************************************** +C02OPS LDA #DINTRP + LDY #(CDINTRPEND-CDINTRP) + JSR OPCPY +CDINTRP PLY + PLA + INY + BNE + + INC ++ STY IPL + STA IPH + LDY #$00 + LDA #>OPTBL + STA OPPAGE + JMP FETCHOP +CDINTRPEND +; + LDA #CN + LDY #(CCNEND-CCN) + JSR OPCPY +CCN DEX + LSR + STA ESTKL,X + STZ ESTKH,X + JMP NEXTOP +CCNEND +; + LDA #CB + LDY #(CCBEND-CCB) + JSR OPCPY +CCB DEX + STZ ESTKH,X + INY + LDA (IP),Y + STA ESTKL,X + JMP NEXTOP +CCBEND +; + LDA #CS + LDY #(CCSEND-CCS) + JSR OPCPY +CCS DEX + ;INY ;+INC_IP + TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK + SEC + ADC IPL + STA IPL + STA ESTKL,X + LDA #$00 + ADC IPH + STA IPH + STA ESTKH,X + LDA (IP) + TAY + JMP NEXTOP +CCSEND +; + LDA #SHL + LDY #(CSHLEND-CSHL) + JSR OPCPY +CSHL STY IPY + LDA ESTKL,X + CMP #$08 + BCC + + LDY ESTKL+1,X + STY ESTKH+1,X + STZ ESTKL+1,X + SBC #$08 ++ TAY + BEQ + + LDA ESTKL+1,X +- ASL + ROL ESTKH+1,X + DEY + BNE - + STA ESTKL+1,X ++ LDY IPY + JMP DROP +CSHLEND +; + LDA #LB + LDY #(CLBEND-CLB) + JSR OPCPY +CLB LDA ESTKL,X + STA ESTKH-1,X + LDA (ESTKH-1,X) + STA ESTKL,X + STZ ESTKH,X + JMP NEXTOP +CLBEND +; + LDA #LBX + LDY #(CLBXEND-CLBX) + JSR OPCPY +CLBX LDA ESTKL,X + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-1,X) + STA ESTKL,X + STZ ESTKH,X + STA ALTRDON + JMP NEXTOP +CLBXEND +; + LDA #LLB + LDY #(CLLBEND-CLLB) + JSR OPCPY +CLLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + STZ ESTKH,X + LDY IPY + JMP NEXTOP +CLLBEND +; + LDA #LLBX + LDY #(CLLBXEND-CLLBX) + JSR OPCPY +CLLBX INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + STA ALTRDOFF + LDA (IFP),Y + STA ESTKL,X + STZ ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +CLLBXEND +; + LDA #LAB + LDY #(CLABEND-CLAB) + JSR OPCPY +CLAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + DEX + STA ESTKL,X + STZ ESTKH,X + JMP NEXTOP +CLABEND +; + LDA #LAW + LDY #(CLAWEND-CLAW) + JSR OPCPY +CLAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDA (TMP) + DEX + STA ESTKL,X + LDY #$01 + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +CLAWEND +; + LDA #LABX + LDY #(CLABXEND-CLABX) + JSR OPCPY +CLABX INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + STA ALTRDOFF + LDA (ESTKH-2,X) + DEX + STA ESTKL,X + STZ ESTKH,X + STA ALTRDON + JMP NEXTOP +CLABXEND +; + LDA #LAWX + LDY #(CLAWXEND-CLAWX) + JSR OPCPY +CLAWX INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + STA ALTRDOFF + LDA (TMP) + DEX + STA ESTKL,X + LDY #$01 + LDA (TMP),Y + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOP +CLAWXEND +; + LDA #SAW + LDY #(CSAWEND-CSAW) + JSR OPCPY +CSAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDA ESTKL,X + STA (TMP) + LDY #$01 + LDA ESTKH,X + STA (TMP),Y + LDY IPY + BMI + + JMP DROP ++ JMP FIXDROP +CSAWEND +; + LDA #DAW + LDY #(CDAWEND-CDAW) + JSR OPCPY +CDAW INY ;+INC_IP + LDA (IP),Y + STA TMPL + INY ;+INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDA ESTKL,X + STA (TMP) + LDY #$01 + LDA ESTKH,X + STA (TMP),Y + LDY IPY + JMP NEXTOP +CDAWEND +; + LDA #ISFLS + LDY #(CISFLSEND-CISFLS) + JSR OPCPY +CISFLS STZ ESTKL+1,X + STZ ESTKH+1,X + JMP DROP +CISFLSEND +; + LDA #BRNCH + LDY #(CBRNCHEND-CBRNCH) + JSR OPCPY +CBRNCH TYA ; FLATTEN IP + SEC + ADC IPL + STA TMPL + LDA #$00 + ADC IPH + STA TMPH ; ADD BRANCH OFFSET + LDA (TMP) + ;CLC ; BETTER NOT CARRY OUT OF IP+Y + ADC TMPL + STA IPL + LDY #$01 + LDA (TMP),Y + ADC TMPH + STA IPH + DEY + JMP FETCHOP +CBRNCHEND +; + RTS +;* +;* COPY OP TO VM +;* +OPCPY STA DST + STX DST+1 + PLA + STA SRC + PLA + STA SRC+1 + TYA + CLC + ADC SRC + TAX + LDA #$00 + ADC SRC+1 + PHA + PHX + INC SRC + BNE + + INC SRC+1 ++ DEY +- LDA (SRC),Y + STA (DST),Y + DEY + BPL - + RTS