;**************************************************************************************
; Copyright (C) 2015 The 8-Bit Bunch. Licensed under the Apache License, Version 1.1 
; (the "License"); you may not use this file except in compliance with the License.
; You may obtain a copy of the License at <http://www.apache.org/licenses/LICENSE-1.1>.
; Unless required by applicable law or agreed to in writing, software distributed under 
; the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF 
; ANY KIND, either express or implied. See the License for the specific language 
; governing permissions and limitations under the License.
;**************************************************************************************

;**********************************************************
;*
;*           APPLE ][ 64K/128K PLASMA INTERPETER
;*
;*             SYSTEM ROUTINES AND LOCATIONS
;*
;**********************************************************
;*
;* 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	"plvm02zp.inc"
STRBUF	=	$0280
INTERP	=	$03D0
;*
;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
;*
	!MACRO	INC_IP	{
	INY
	BNE	* + 4
	INC	IPH
	}
;******************************
;*                            *
;* INTERPRETER INITIALIZATION *
;*                            *
;******************************
*	=	$2000
	LDX     #$FE
	TXS
	LDX	#$00
	STX	$01FF
;*
;* DISCONNECT /RAM
;*
	SEI			; DISABLE /RAM
	LDA	MACHID
	AND	#$30
	CMP	#$30
	BNE	RAMDONE
	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
;*
;* MOVE VM INTO LANGUAGE CARD
;*
	BIT	LCRWEN+LCBNK2
	BIT	LCRWEN+LCBNK2
	LDA	#<VMCORE
	STA	SRCL
	LDA	#>VMCORE
	STA	SRCH
	LDA	#$00
	STA	DSTL
	LDA	#$D0
	STA	DSTH
	LDY	#$00
-	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
;*
	LDY     #$00
	STY     SRCL
	LDA	#$D1
	STA	SRCH
-	LDA	(SRC),Y
	STA	$1000,Y
	INY
	BNE	-
;*
;* SAVE DEFAULT COMMAND INTERPRETER PATH IN LC
;*
	JSR     PRODOS          ; GET PREFIX
	!BYTE	$C7
	!WORD	GETPFXPARMS
	LDY	STRBUF		; APPEND "CMD"
	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
	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	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,PUSH,PULL,BRGT,BRLT,BREQ,BRNE		; 30 32 34 36 38 3A 3C 3E
	!WORD	ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU	; 40 42 44 46 48 4A 4C 4E
	!WORD	BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP 	; 50 52 54 56 58 5A 5C 5E
	!WORD	LB,LW,LLB,LLW,LAB,LAW,DLB,DLW			; 60 62 64 66 68 6A 6C 6E
	!WORD	SB,SW,SLB,SLW,SAB,SAW,DAB,DAW			; 70 72 74 76 78 7A 7C 7E
;*
;* ENTER INTO BYTECODE INTERPRETER
;*
DINTRP	PLA
	CLC
	ADC	#$01
        STA     IPL
        PLA
	ADC	#$00
        STA     IPH
	LDA	IFPH
	PHA			; SAVE ON STACK FOR LEAVE/RET
	LDA	IFPL
	PHA			; SAVE ON STACK FOR LEAVE/RET
	LDA	PPL		; SET FP TO PP
	STA	IFPL
	LDA	PPH
	STA	IFPH
	LDY	#$00
	LDA	#>OPTBL
	STA	OPPAGE
	JMP	FETCHOP
IINTRP	PLA
        STA     TMPL
        PLA
        STA     TMPH
	LDY	#$02
	LDA     (TMP),Y
        STA	IPH
	DEY
	LDA     (TMP),Y
	STA	IPL
        DEY
	LDA	IFPH
	PHA			; SAVE ON STACK FOR LEAVE/RET
	LDA	IFPL
	PHA			; SAVE ON STACK FOR LEAVE/RET
	LDA	PPL		; SET FP TO PP
	STA	IFPL
	LDA	PPH
	STA	IFPH
	LDA	#>OPTBL
	STA	OPPAGE
	JMP	FETCHOP
IINTRPX	PLA
        STA     TMPL
        PLA
        STA     TMPH
	LDY	#$02
	LDA     (TMP),Y
        STA	IPH
	DEY
	LDA     (TMP),Y
	STA	IPL
        DEY
	LDA	IFPH
	PHA			; SAVE ON STACK FOR LEAVE/RET
	LDA	IFPL
	PHA			; SAVE ON STACK FOR LEAVE/RET
	LDA	PPL		; SET FP TO PP
	STA	IFPL
	LDA	PPH
	STA	IFPH
	LDA	#>OPXTBL
	STA	OPPAGE
	SEI
	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	-
;
; INSTALL PAGE 3 VECTORS
;
	LDY	#$12
- 	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		; INIT FRAME POINTER
	STA	PPL
	STA	IFPL
	LDA	#$BF
	STA	PPH
	STA	IFPH
	LDX	#$FE		; INIT STACK POINTER (YES, $FE. SEE GETS)
	TXS
        LDX	#ESTKSZ/2	; INIT EVAL STACK INDEX
	JMP     $2000		; JUMP TO LOADED SYSTEM COMMAND
;
; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT
;
FAIL	INC	$3F4		; INVALIDATE POWER-UP BYTE
	LDY	#33
-	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	"...TESER OT YEK YNA .DMC GNISSIM"
PAGE0	=	*
;******************************
;*                            *
;* INTERP BYTECODE INNER LOOP *
;*                            *
;******************************
       	!PSEUDOPC	$00EF {
	INX			; DROP @ $EF
	INY			; NEXTOP @ $F0
	BEQ	NEXTOPH
	LDA	$FFFF,Y		; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
	STA	OPIDX
	JMP	(OPTBL)		; OPIDX AND OPPAGE MAP OVER OPTBL
NEXTOPH	INC	IPH
	BNE	FETCHOP
}
PAGE3	=	*
;*
;* PAGE 3 VECTORS INTO INTERPRETER
;*
	!PSEUDOPC	$03D0 {
	BIT	LCRDEN+LCBNK2	; $03D0 - DIRECT INTERP ENTRY
	JMP	DINTRP
	BIT	LCRDEN+LCBNK2	; $03D6 - INDIRECT INTERP ENTRY
	JMP	IINTRP
	BIT	LCRDEN+LCBNK2	; $03DC - INDIRECT INTERPX ENTRY
	JMP	IINTRPX
}
DEFCMD	!FILL	28
ENDBYE	=	*
}
LCDEFCMD =	*-28		; DEFCMD IN LC MEMORY
;*****************
;*               *
;* OPXCODE TABLE *
;*               *
;*****************
	!ALIGN	255,0
OPXTBL  !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,CSX			; 20 22 24 26 28 2A 2C 2E
	!WORD	DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE		; 30 32 34 36 38 3A 3C 3E
	!WORD	ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU	; 40 42 44 46 48 4A 4C 4E
	!WORD	BRNCH,IBRNCH,CALLX,ICALX,ENTER,LEAVEX,RETX,NEXTOP; 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
;*
;* ADD TOS TO TOS-1
;*
ADD 	LDA	ESTKL,X
	CLC
	ADC	ESTKL+1,X
	STA	ESTKL+1,X
	LDA	ESTKH,X
	ADC	ESTKH+1,X
	STA	ESTKH+1,X
	INX
	JMP	NEXTOP
;*
;* SUB TOS FROM TOS-1
;*
SUB 	LDA	ESTKL+1,X
	SEC
	SBC	ESTKL,X
	STA	ESTKL+1,X
	LDA	ESTKH+1,X
	SBC	ESTKH,X
	STA	ESTKH+1,X
	INX
	JMP	NEXTOP
;*
;* SHIFT TOS-1 LEFT BY 1, ADD TO TOS-1
;*
IDXW 	LDA	ESTKL,X
	ASL
	ROL	ESTKH,X
	CLC
	ADC	ESTKL+1,X
	STA	ESTKL+1,X
	LDA	ESTKH,X
	ADC	ESTKH+1,X
	STA	ESTKH+1,X
	INX
	JMP	NEXTOP
;*
;* MUL TOS-1 BY TOS
;*
MUL	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
	INX
	LDY	IPY
	JMP	NEXTOP
;*
;* 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
	LDA	ESTKH,X
	AND	#$80
	STA	DVSIGN
	BPL	+
	JSR	_NEG
	INC	DVSIGN
+ 	LDA	ESTKH+1,X
	BPL	+
	INX
	JSR	_NEG
	DEX
	INC	DVSIGN
	BNE	_DIV1
+ 	ORA	ESTKL+1,X	; DVDNDL
	BEQ	_DIVEX
_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
;*
;* INCREMENT TOS
;*
INCR 	INC	ESTKL,X
	BNE	INCR1
	INC	ESTKH,X
INCR1 	JMP	NEXTOP
;*
;* DECREMENT TOS
;*
DECR 	LDA	ESTKL,X
	BNE	DECR1
	DEC	ESTKH,X
DECR1 	DEC	ESTKL,X
	JMP	NEXTOP
;*
;* BITWISE COMPLIMENT TOS
;*
COMP 	LDA	#$FF
	EOR	ESTKL,X
	STA	ESTKL,X
	LDA	#$FF
	EOR	ESTKH,X
	STA	ESTKH,X
	JMP	NEXTOP
;*
;* BITWISE AND TOS TO TOS-1
;*
BAND 	LDA	ESTKL+1,X
	AND	ESTKL,X
	STA	ESTKL+1,X
	LDA	ESTKH+1,X
	AND	ESTKH,X
	STA	ESTKH+1,X
	INX
	JMP	NEXTOP
;*
;* INCLUSIVE OR TOS TO TOS-1
;*
IOR 	LDA	ESTKL+1,X
	ORA	ESTKL,X
	STA	ESTKL+1,X
	LDA	ESTKH+1,X
	ORA	ESTKH,X
	STA	ESTKH+1,X
	INX
	JMP	NEXTOP
;*
;* EXLUSIVE OR TOS TO TOS-1
;*
XOR 	LDA	ESTKL+1,X
	EOR	ESTKL,X
	STA	ESTKL+1,X
	LDA	ESTKH+1,X
	EOR	ESTKH,X
	STA	ESTKH+1,X
	INX
	JMP	NEXTOP
;*
;* SHIFT TOS-1 LEFT BY TOS
;*
SHL	STY	IPY
	LDA	ESTKL,X
	CMP	#$08
	BCC	SHL1
	LDY	ESTKL+1,X
	STY	ESTKH+1,X
	LDY	#$00
	STY	ESTKL+1,X
	SBC	#$08
SHL1 	TAY
	BEQ	SHL3
SHL2 	ASL	ESTKL+1,X
	ROL	ESTKH+1,X
	DEY
	BNE	SHL2
SHL3 	INX
	LDY	IPY
	JMP	NEXTOP
;*
;* SHIFT TOS-1 RIGHT BY TOS
;*
SHR	STY	IPY
	LDA	ESTKL,X
	CMP	#$08
	BCC	SHR2
	LDY	ESTKH+1,X
	STY	ESTKL+1,X
	CPY	#$80
	LDY	#$00
	BCC	SHR1
	DEY
SHR1 	STY	ESTKH+1,X
	SEC
	SBC	#$08
SHR2 	TAY
	BEQ	SHR4
	LDA	ESTKH+1,X
SHR3 	CMP	#$80
	ROR
	ROR	ESTKL+1,X
	DEY
	BNE	SHR3
	STA	ESTKH+1,X
SHR4 	INX
	LDY	IPY
	JMP	NEXTOP
;*
;* LOGICAL NOT
;*
LNOT	LDA	ESTKL,X
	ORA	ESTKH,X
	BEQ	LNOT1
	LDA	#$FF
LNOT1	EOR	#$FF
	STA	ESTKL,X
	STA	ESTKH,X
	JMP	NEXTOP
;*
;* LOGICAL AND
;*
LAND 	LDA	ESTKL+1,X
	ORA	ESTKH+1,X
	BEQ	LAND2
	LDA	ESTKL,X
	ORA	ESTKH,X
	BEQ	LAND1
	LDA	#$FF
LAND1 	STA	ESTKL+1,X
	STA	ESTKH+1,X
LAND2	INX
	JMP	NEXTOP
;*
;* LOGICAL OR
;*
LOR 	LDA	ESTKL,X
	ORA	ESTKH,X
	ORA	ESTKL+1,X
	ORA	ESTKH+1,X
	BEQ	LOR1
	LDA	#$FF
 	STA	ESTKL+1,X
	STA	ESTKH+1,X
LOR1	INX
	JMP	NEXTOP
;*
;* DUPLICATE TOS
;*
DUP 	DEX
	LDA	ESTKL+1,X
	STA	ESTKL,X
	LDA	ESTKH+1,X
	STA	ESTKH,X
	JMP	NEXTOP
;*
;* PUSH FROM EVAL STACK TO CALL STACK
;*
PUSH 	LDA	ESTKL,X
	PHA
	LDA	ESTKH,X
	PHA
	INX
	JMP	NEXTOP
;*
;* PULL FROM CALL STACK TO EVAL STACK
;*
PULL 	DEX
	PLA
	STA	ESTKH,X
	PLA
	STA	ESTKL,X
	JMP	NEXTOP
;*
;* CONSTANT
;*
ZERO 	DEX
	LDA	#$00
	STA	ESTKL,X
	STA	ESTKH,X
	JMP	NEXTOP
CB 	DEX
	+INC_IP
	LDA	(IP),Y
	STA	ESTKL,X
	LDA	#$00
	STA	ESTKH,X
	JMP	NEXTOP
;*
;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
;*
LA	=	*
CW	DEX
	+INC_IP
 	LDA	(IP),Y
	STA	ESTKL,X
	+INC_IP
 	LDA	(IP),Y
	STA	ESTKH,X
	JMP	NEXTOP
;*
;* CONSTANT STRING
;*
CS	DEX
	+INC_IP
	TYA			; NORMALIZE IP AND SAVE STRING ADDR ON ESTK
	CLC
	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
	+INC_IP
	TYA			; NORMALIZE IP
	CLC
	ADC	IPL
	STA	IPL
	LDA	#$00
	TAY
	ADC	IPH
	STA	IPH
	LDA	(IP),Y
	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
-	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	-
	INY
	LDA	(IP),Y		; SKIP TO NEXT OP ADDR AFTER STRING
	TAY
	JMP	NEXTOP
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
LB 	LDA	ESTKL,X
	STA	TMPL
	LDA	ESTKH,X
	STA	TMPH
	STY	IPY
	LDY	#$00
	LDA	(TMP),Y
	STA	ESTKL,X
	STY	ESTKH,X
	LDY	IPY
	JMP	NEXTOP
LW 	LDA	ESTKL,X
	STA	TMPL
	LDA	ESTKH,X
	STA	TMPH
       	STY	IPY
	LDY	#$00
	LDA	(TMP),Y
	STA	ESTKL,X
	INY
	LDA	(TMP),Y
	STA	ESTKH,X
	LDY	IPY
	JMP	NEXTOP
;
LBX	LDA	ESTKL,X
	STA	TMPL
	LDA	ESTKH,X
	STA	TMPH
	STY	IPY
	STA	ALTRDOFF
	LDY	#$00
	LDA	(TMP),Y
	STA	ESTKL,X
	STY	ESTKH,X
	LDY	IPY
	STA	ALTRDON
	JMP	NEXTOP
LWX	LDA	ESTKL,X
	STA	TMPL
	LDA	ESTKH,X
	STA	TMPH
       	STY	IPY
	STA	ALTRDOFF
 	LDY	#$00
	LDA	(TMP),Y
	STA	ESTKL,X
	INY
	LDA	(TMP),Y
	STA	ESTKH,X
	LDY	IPY
	STA	ALTRDON
	JMP	NEXTOP
;*
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
;*
LLA 	+INC_IP
 	LDA	(IP),Y
	DEX
	CLC
	ADC	IFPL
	STA	ESTKL,X
	LDA	#$00
	ADC	IFPH
	STA	ESTKH,X
	JMP	NEXTOP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
LLB 	+INC_IP
 	LDA	(IP),Y
	STY	IPY
	TAY
	DEX
	LDA	(IFP),Y
	STA	ESTKL,X
	LDA	#$00
	STA	ESTKH,X
	LDY	IPY
	JMP	NEXTOP
LLW 	+INC_IP
 	LDA	(IP),Y
	STY	IPY
	TAY
	DEX
	LDA	(IFP),Y
	STA	ESTKL,X
	INY
	LDA	(IFP),Y
	STA	ESTKH,X
	LDY	IPY
	JMP	NEXTOP
;
LLBX	+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	+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
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
LAB 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+INC_IP
	LDA	(IP),Y
	STA	TMPH
	STY	IPY
	LDY	#$00
	LDA	(TMP),Y
	DEX
	STA	ESTKL,X
	STY	ESTKH,X
	LDY	IPY
	JMP	NEXTOP
LAW 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+INC_IP
	LDA	(IP),Y
	STA	TMPH
	STY	IPY
	LDY	#$00
	LDA	(TMP),Y
	DEX
	STA	ESTKL,X
	INY
	LDA	(TMP),Y
	STA	ESTKH,X
	LDY	IPY
	JMP	NEXTOP
;
LABX 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+INC_IP
	LDA	(IP),Y
	STA	TMPH
	STY	IPY
	STA	ALTRDOFF
	LDY	#$00
	LDA	(TMP),Y
	DEX
	STA	ESTKL,X
	STY	ESTKH,X
	STA	ALTRDON
	LDY	IPY
	JMP	NEXTOP
LAWX 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+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
;*
;* STORE VALUE TO ADDRESS
;*
SB 	LDA	ESTKL+1,X
	STA	TMPL
	LDA	ESTKH+1,X
	STA	TMPH
	LDA	ESTKL,X
	STY	IPY
	LDY	#$00
	STA	(TMP),Y
	INX
	INX
	LDY	IPY
	JMP	NEXTOP
SW 	LDA	ESTKL+1,X
	STA	TMPL
	LDA	ESTKH+1,X
	STA	TMPH
	STY	IPY
	LDY	#$00
	LDA	ESTKL,X
	STA	(TMP),Y
	INY
	LDA	ESTKH,X
	STA	(TMP),Y
	INX
	INX
	LDY	IPY
	JMP	NEXTOP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
;*
SLB 	+INC_IP
 	LDA	(IP),Y
	STY	IPY
	TAY
	LDA	ESTKL,X
	STA	(IFP),Y
	INX
	LDY	IPY
	JMP	NEXTOP
SLW 	+INC_IP
 	LDA	(IP),Y
	STY	IPY
	TAY
	LDA	ESTKL,X
	STA	(IFP),Y
	INY
	LDA	ESTKH,X
	STA	(IFP),Y
	INX
	LDY	IPY
	JMP	NEXTOP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
;*
DLB 	+INC_IP
	LDA	(IP),Y
	STY	IPY
	TAY
	LDA	ESTKL,X
	STA	(IFP),Y
	LDY	IPY
	JMP	NEXTOP
DLW 	+INC_IP
	LDA	(IP),Y
	STY	IPY
	TAY
	LDA	ESTKL,X
	STA	(IFP),Y
	INY
	LDA	ESTKH,X
	STA	(IFP),Y
	LDY	IPY
	JMP	NEXTOP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
SAB 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+INC_IP
	LDA	(IP),Y
	STA	TMPH
	LDA	ESTKL,X
	STY	IPY
	LDY	#$00
	STA	(TMP),Y
	INX
	LDY	IPY
	JMP	NEXTOP
SAW 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+INC_IP
	LDA	(IP),Y
	STA	TMPH
	STY	IPY
	LDY	#$00
	LDA	ESTKL,X
	STA	(TMP),Y
	INY
	LDA	ESTKH,X
	STA	(TMP),Y
	INX
	LDY	IPY
	JMP	NEXTOP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
DAB 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+INC_IP
	LDA	(IP),Y
	STA	TMPH
	STY	IPY
	LDY	#$00
	LDA	ESTKL,X
	STA	(TMP),Y
	LDY	IPY
	JMP	NEXTOP
DAW 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+INC_IP
	LDA	(IP),Y
	STA	TMPH
	STY	IPY
	LDY	#$00
	LDA	ESTKL,X
	STA	(TMP),Y
	INY
	LDA	ESTKH,X
	STA	(TMP),Y
	LDY	IPY
	JMP	NEXTOP
;*
;* COMPARES
;*
ISEQ	LDA	ESTKL,X
	CMP	ESTKL+1,X
	BNE	ISFLS
	LDA	ESTKH,X
	CMP	ESTKH+1,X
	BNE	ISFLS
ISTRU	LDA	#$FF
	INX
	STA	ESTKL,X
	STA	ESTKH,X
	JMP	NEXTOP
;
ISNE	LDA	ESTKL,X
	CMP	ESTKL+1,X
	BNE	ISTRU
	LDA	ESTKH,X
	CMP	ESTKH+1,X
	BNE	ISTRU
ISFLS 	LDA	#$00
	INX
	STA	ESTKL,X
	STA	ESTKH,X
	JMP	NEXTOP
;
ISGE	LDA	ESTKL+1,X
	CMP	ESTKL,X
	LDA	ESTKH+1,X
	SBC	ESTKH,X
	BVC	ISGE1
	EOR	#$80
ISGE1 	BPL	ISTRU
	BMI	ISFLS
;
ISGT	LDA	ESTKL,X
	CMP	ESTKL+1,X
	LDA	ESTKH,X
	SBC	ESTKH+1,X
	BVC	ISGT1
	EOR	#$80
ISGT1 	BMI	ISTRU
	BPL	ISFLS
;
ISLE	LDA	ESTKL,X
	CMP	ESTKL+1,X
	LDA	ESTKH,X
	SBC	ESTKH+1,X
	BVC	ISLE1
	EOR	#$80
ISLE1 	BPL	ISTRU
	BMI	ISFLS
;
ISLT	LDA	ESTKL+1,X
	CMP	ESTKL,X
	LDA	ESTKH+1,X
	SBC	ESTKH,X
	BVC	ISLT1
	EOR	#$80
ISLT1 	BMI	ISTRU
	BPL	ISFLS
;*
;* BRANCHES
;*
BRTRU 	INX
	LDA	ESTKH-1,X
	ORA	ESTKL-1,X
	BNE	BRNCH
NOBRNCH	+INC_IP
	+INC_IP
	JMP	NEXTOP
BRFLS 	INX
	LDA	ESTKH-1,X
	ORA	ESTKL-1,X
	BNE	NOBRNCH
BRNCH	LDA	IPH
	STA	TMPH
	LDA	IPL
	+INC_IP
	CLC
	ADC	(IP),Y
	STA	TMPL
	LDA	TMPH
	+INC_IP
	ADC	(IP),Y
	STA	IPH
	LDA	TMPL
	STA	IPL
	DEY
	DEY
	JMP	NEXTOP
BREQ 	INX
	LDA	ESTKL-1,X
	CMP	ESTKL,X
	BNE	NOBRNCH
	LDA	ESTKH-1,X
	CMP	ESTKH,X
	BEQ	BRNCH
	BNE	NOBRNCH
BRNE 	INX
	LDA	ESTKL-1,X
	CMP	ESTKL,X
	BNE	BRNCH
	LDA	ESTKH-1,X
	CMP	ESTKH,X
	BEQ	NOBRNCH
	BNE	BRNCH
BRGT 	INX
	LDA	ESTKL-1,X
	CMP	ESTKL,X
	LDA	ESTKH-1,X
	SBC	ESTKH,X
	BMI	BRNCH
	BPL	NOBRNCH
BRLT 	INX
	LDA	ESTKL,X
	CMP	ESTKL-1,X
	LDA	ESTKH,X
	SBC	ESTKH-1,X
	BMI	BRNCH
	BPL	NOBRNCH
IBRNCH	LDA	IPL
	CLC
	ADC	ESTKL,X
	STA	IPL
	LDA	IPH
	ADC	ESTKH,X
	STA	IPH
	INX
	JMP	NEXTOP
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALL 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+INC_IP
	LDA	(IP),Y
	STA	TMPH
	LDA	IPH
	PHA
	LDA	IPL
	PHA
	TYA
	PHA
	JSR	JMPTMP
	PLA
	TAY
	PLA
	STA	IPL
	PLA
	STA	IPH
	LDA	#>OPTBL		; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
	STA	OPPAGE
	JMP	NEXTOP
;
CALLX 	+INC_IP
	LDA	(IP),Y
	STA	TMPL
	+INC_IP
	LDA	(IP),Y
	STA	TMPH
	LDA	IPH
	PHA
	LDA	IPL
	PHA
	TYA
	PHA
	STA	ALTRDOFF
	CLI
	JSR     JMPTMP
	SEI
	STA	ALTRDON
	PLA
	TAY
	PLA
	STA	IPL
	PLA
	STA	IPH
	LDA	#>OPXTBL	; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
	STA	OPPAGE
	JMP	NEXTOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL 	LDA	ESTKL,X
	STA	TMPL
	LDA	ESTKH,X
	STA	TMPH
	INX
	LDA	IPH
	PHA
	LDA	IPL
	PHA
	TYA
	PHA
	JSR	JMPTMP
	PLA
	TAY
	PLA
	STA	IPL
	PLA
	STA	IPH
	LDA	#>OPTBL		; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
	STA	OPPAGE
	JMP	NEXTOP
;
ICALX 	LDA	ESTKL,X
	STA	TMPL
	LDA	ESTKH,X
	STA	TMPH
	INX
	LDA	IPH
	PHA
	LDA	IPL
	PHA
	TYA
	PHA
	STA	ALTRDOFF
	CLI
	JSR	JMPTMP
	SEI
	STA	ALTRDON
	PLA
	TAY
	PLA
	STA	IPL
	PLA
	STA	IPH
	LDA	#>OPXTBL	; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
	STA	OPPAGE
	JMP	NEXTOP
;*
;* JUMP INDIRECT TRHOUGH TMP
;*
JMPTMP	JMP	(TMP)
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
ENTER 	INY
	LDA	(IP),Y
	PHA			; SAVE ON STACK FOR LEAVE
	EOR	#$FF		; ALLOCATE FRAME
	SEC
	ADC	PPL
	STA	PPL
	STA	IFPL
	LDA	#$FF
	ADC	PPH
	STA	PPH
	STA	IFPH
	INY
	LDA	(IP),Y
	ASL
	TAY
	BEQ	+
-	LDA	ESTKH,X
	DEY
	STA	(IFP),Y
	LDA	ESTKL,X
	INX
	DEY
	STA	(IFP),Y
	BNE	-
+	LDY	#$02
	JMP	NEXTOP
;*
;* LEAVE FUNCTION
;*
LEAVEX 	STA	ALTRDOFF
	CLI
LEAVE 	PLA			; DEALLOCATE POOL + FRAME
	CLC
	ADC	IFPL
	STA	PPL
	LDA	#$00
	ADC	IFPH
	STA	PPH
 	PLA			; RESTORE PREVIOUS FRAME
	STA	IFPL
	PLA
	STA	IFPH
	RTS
;
RETX	STA	ALTRDOFF
	CLI
RET	LDA	IFPL		; DEALLOCATE POOL
	STA	PPL
	LDA	IFPH
	STA	PPH
 	PLA			; RESTORE PREVIOUS FRAME
	STA	IFPL
	PLA
	STA	IFPH
	RTS
VMEND	=	*
}
