;*** DEBUG FREE NOPED TO FIT
;I2L.ASM	MAY-23-98	Version 0.91
;I2L.ASM	10-MAR-2000	Version 1.02	Richard Ottosen
;XPL0 Interpreter for the Scenix SX Microcontroller
;Copyright (C) 1998,1999,2000 Loren Blaney
;
;Assemble using MPASM.
;;This program executes the I2L code produced by the XPL6 compiler. This
; program is based on code written for the 6502 by: P.J.R. Boyle, Wayne Wall,
; Ted Dunning, Loren Blaney, Larry Fish and Richard Ottosen.
;
;See SXPL.DOC for details about what this program does and how it differs
; from other implementations of I2L.
;
;LICENSE:
;This program is free software; you can redistribute it and/or modify it under
; the terms of the GNU General Public License version 2 as published by the
; Free Software Foundation.
;This program is distributed in the hope that it will be useful, but WITHOUT
; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
; details.
;You should have received a copy of the GNU General Public License along with
; this program (in the file LICENSE.DOC); if not, write to the Free Software
; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;
;You can reach me at:			Mail:	Loren Blaney
; Email: loren_blaney@idcomm.com		502 Pine Glade Dr.
;						Nederland, CO 80466, USA
;
;REVISIONS:
;1.0, MAY-09-98, Released.
;1.01, 22-FEB-2000, Changed the routine name "SWAP" to be "SWAPB" to prevent
;  conflicts with SX-Key assembler and removed references to pseudo-ops for
;  SXSIM.  R.O.
;1.02, 10-MAR-2000, Selected internal oscillator and enabled the watchdog
;  timer. Added CLRWDT to SOUND intrinsic and at OPGO label. Assigned
;  prescaler set to maximum time to watchdog.  R.O.

;
;
;CODING CONVENTIONS:
;Bank 0 is normally selected. This enables access to locations 00-1Fh.
;FSR is not set aside as the stack pointer (unlike in the 14-bit version);
; I2LSP is. I2LSP's bit 4 is undefined until it's used in PUSH or PULL.
;The least significant byte of a multi-byte value is at the lowest address
; (i.e. low byte first), except for the stack where the order is reversed.
;The MODE register is not assumed to be set to 0Fh.
;Location 01 is not assumed to be RTCC or W. The OPTION intrinsic can set
; it either way.
;
;Because of fragmented RAM a distinction is made between logical addresses
; and physical addresses. Logical addresses are continuous and range from
; 00 to 7Fh. Logical addresses 0-Fh correspond to physical addresses 10-1Fh.
; Bit 4 in the physical address is always set. Note that the I/O ports
; (RA, RB, RC) are not mapped into logical addresses. The intrinsics Pout
; and Pin are used to access them. All addresses are logical unless noted
; as physical addresses.
;

;***	PROCESSOR 16C57		;closest PIC chip
	RADIX	DEC
	ERRORLEVEL -302, -305	;bank args are in range; ",F" is the default
	LIST	ST=OFF		;we don't need no stinking symbol table

	INCLUDE	"SXDEFS.INC"	;macro definitions for new instructions, etc.
	ID	'X','P','L','0',' ',' ',' ',' '
;***DEVICE	EQU	PINS18+OSCRC+PAGES4+BANKS8+TURBO+SYNC+STACKX+OPTIONX+BOR40+WATCHDOG
DEVICE	EQU	PINS18+OSC4MHZ+PAGES4+BANKS8+TURBO+SYNC+STACKX+OPTIONX+WATCHDOG+BOR40


;Miscellaneous ASCII control codes:
Bel	EQU	07h		;bell
LF	EQU	0Ah		;line feed
FF	EQU	0Ch		;form feed
CR	EQU	0Dh		;carriage return
EOF	EQU	1Ah		;end of file
Esc	EQU	1Bh		;escape
Sp	EQU	20h		;space

;===============================================================================
;                              START OF RAM
;===============================================================================

	ORG	08h
TEMP	RES	1		;very temporary scratch location
RegA	RES	2		;16-bit scratch "register"
RegX	RES	1		;8-bit scratch "register"
I2LPC	RES	2		;interpreter's program counter
LOCDISP	RES	1		;base address of local variables

	ORG	0Fh
DISPLY	RES	3		;display vector table: holds base addresses of
DISPLY2	EQU	DISPLY*2	; heap variables, one for each (static) level

LEVEL	RES	1		;current (static) level (0..2)
HP	RES	1		;heap pointer, base of unused variable space
I2LSP	RES	1		;interpreter's stack pointer (physical address)

REMAIN	RES	2		;remainder from integer divide
RERUNF	RES	1		;rerun flag; set by RESTART intrinsic, etc.

ERRNO	RES	1		;I2L error number
TRAPS	RES	2		;16 flags to enable trapping specific I2L errors

NOWDEV	EQU	TEMP		;current I/O device number (always 0)

RegB	RES	2		;16-bit scratch "registers" used by various
RegC	RES	2		; routines such as MUL, DIV and DOERROR

FLAGS	RES	1		;eight scratch flag bits

	ORG	30h
HEAPLO	EQU	(($>>1) & 70h) | ($ & 0fh)	;use a logical address instead
				; of a physical one to cope with fragmented RAM
;The first two bytes in the heap are used to return integers from functions
	RES	2
SEED	RES	3		;random number seed (in unused heap space)

STACK	EQU	0FFh		;stack (PUSH =   MOVWF IND   DECF FSR)

;===============================================================================
	ORG	0		;START OF ROM
;===============================================================================
;GOTO and CALL extenders
;
ISR	FGOTO	ISRX		;interrupt vector at location 0
RESET	FGOTO	RESETX
DOERROR	FGOTO	DOERRORX
FETCHA	FGOTO	FETCHAX

;-------------------------------------------------------------------------------
;Routine to quickly load global and local variables onto the stack. Since this
; is the most common I2L instruction, it is optimized. This is a single-byte
; instruction with the high bit set. The other 7 bits are the offset. Globals
; are indicated by odd offsets, and locals by even offsets.
;
FASTLOD	BCF	RegX,7		;clear high bit of opcode to get the offset
	MOVF	LOCDISP,W	;get base address of local variables
	BTFSC	RegX,0		;skip if offset is even (it's a local variable)
	 MOVF	DISPLY,W	; else get base address of global variables
	ADDWF	RegX,W		;add offset to get (logical) address in heap
OPGOLOD	CALL	GETVAR		;f variable from heap and put it into RegA
OPGOPA	MOVF	RegA,W		;push RegA, low byte first
OPGOPAW	CALL	PUSH
	MOVF	RegA+1,W	;push RegA high byte
OPGOPW	CALL	PUSH		;fall into dispatch loop...

;===============================================================================
;			    MAIN DISPATCH LOOP
;===============================================================================
;
OPGO	CLRWDT			;***???  R.O.
	CALL	FETCH		;f opcode at I2LPC and increment I2LPC
	MOVWF	RegX		;save copy of opcode in RegX
	BTFSC	RegX,7		;skip if MSB (bit 7) is clear
	 GOTO	FASTLOD		; else go handle fast global or local load
	BTFSC	RegX,6		;skip if bit 6 is clear
	 GOTO	SSIMOP		; else go handle short, short immediate load
	ADDWF	PC		;jump to routine that handles this opcode

;Opcode Jump Table:		Opcode / No. of Bytes / Description
	GOTO	EXTOP		;$00,1, Display error message then go to START
	GOTO	LODOP		;$01,3, Load a variable onto stack
	GOTO	LDXOP		;$02,3, Indexed load a byte variable
	GOTO	STOOP		;$03,3, Store into a variable
	GOTO	STXOP		;$04,3, Indexed store into a byte
	GOTO	CALOP		;$05,4, Call a procedure
	GOTO	RETOP		;$06,1, Return from procedure
	GOTO	JMPOP		;$07,3, Jump
	GOTO	JPCOP		;$08,3, Jump if top-of-stack (TOS) is false (=0)
	GOTO	HPIOP		;$09,2, Increase heap pointer (HP) by argument
	GOTO	ARGOP		;$0A,2, Move arguments from stack to heap
	GOTO	IMMOP		;$0B,3, Load 16-bit immediate value
	GOTO	CMLOP		;$0C,2, Call an intrinsic ('code') routine
	GOTO	ADDOP		;$0D,1, Add
	GOTO	SUBOP		;$0E,1, Subtract
	GOTO	MULOP		;$0F,1, Multiply
	GOTO	DIVOP		;$10,1, Divide
	GOTO	NEGOP		;$11,1, Negate (2's complement)
	GOTO	EQOP		;$12,1, Test for =
	GOTO	NEOP		;$13,1, Test for #
	GOTO	GEOP		;$14,1, Test for >=
	GOTO	GTOP		;$15,1, Test for >
	GOTO	LEOP		;$16,1, Test for <=
	GOTO	LTOP		;$17,1, Test for <
	GOTO	FOROP		;$18,3, 'for' loop control
	GOTO	INCOP		;$19,5, Increment, push & jump ('for' loop)
	GOTO	OROP		;$1A,1, Or
	GOTO	ANDOP		;$1B,1, And
	GOTO	NOTOP		;$1C,1, Not (1's complement)
	GOTO	XOROP		;$1D,1, Exclusive or
	GOTO	DBAOP		;$1E,1, TOS:= NOS + TOS*2 (for arrays)
	GOTO	STDOP		;$1F,1, Store TOS at address in NOS
	GOTO	DBXOP		;$20,1, Load(TOS*2 + NOS)
	GOTO	ADROP		;$21,3, Load address of a variable
	GOTO	LDX2OP		;$22,2, Indexed load global or local byte
	GOTO	BRAOP		;$23,2, Branch to I2L code
	GOTO	SIMOP		;$24,2, Load short (8-bit) immediate value
	GOTO	CJPOP		;$25,3, Case jump
	GOTO	JSROP		;$26,3, Optimized procedure call
	GOTO	RTSOP		;$27,1, Optimized procedure return

;To save space the following code replaces external call and floating point ops
;-------------------------------------------------------------------------------
;$28
;Routine to pull TOS and discard it. This is used to clean up the stack in
; unusual situations such as a 'return' inside a 'for' loop.
;
DRPOP	CALL	PULLA		;$28,1, Discard TOS
	GOTO	OPGO		;($29)

;-------------------------------------------------------------------------------
;Pull into RegB and add it to RegA
;
PBDADD	CALL	PULLB		;($2A)
				;fall into DADD...
;-------------------------------------------------------------------------------
;RegA:= RegA + RegB.
;
DADD	MOVF	RegB,W		;($2B) add low bytes
	ADDWF	RegA		;($2C)
	MOVF	RegB+1,W	;($2D) get ready to add high bytes
	BTFSC	STATUS,C	;($2E) skip if there was no carry into high byte
	 INCFSZ	RegB+1,W	;($2F)  else add in carry; if zero then high byte
	 ADDWF	RegA+1		;($30)  doesn't change and carry is still set
	RETP			;($31)  i.e. carry is correct

;-------------------------------------------------------------------------------
;Compare RegA to RegB by subtracting (RegB+$8000) from (RegA+$8000). The $8000
; offset allows an unsigned compare to be used. If the carry flag is set then
; RegA is >= RegB. This works for the entire range of values so, for example,
; -30000 is correctly determined to be smaller than +30000. RegA and RegB are
; changed.
;
DCMP	MOVLW	80h		;($32) add $8000 to avoid discontinuity between
	XORWF	RegA+1		;($33)  -1 and 0
	XORWF	RegB+1		;($34) fall into DSUB...

;-------------------------------------------------------------------------------
;RegA:= RegA - RegB (with correct carry). Returns with RegB+1 in W.
;
DSUB	MOVF	RegB,W		;($35) subtract low bytes
	SUBWF	RegA		;($36)
	MOVF	RegB+1,W	;($37) get ready to subtract high bytes
	BTFSS	STATUS,C	;($38) skip if there's no borrow from high byte
	 INCFSZ	RegB+1,W	;($39)  else increase amount to subtract by 1
	 SUBWF	RegA+1		;($3A)  if it's 0 then high byte doesn't change,
	RETP			;($3B)  nor does carry

;-------------------------------------------------------------------------------
;(Resume Opcode Jump Table)

	GOTO	STO2OP		;$3C,2, Store into global or local variable
	GOTO	STX2OP		;$3D,2, Indexed store into global or local

;-------------------------------------------------------------------------------
;$3E
;Shift left. TOS:= NOS << TOS
; Only the low byte of the shift count is used. It should normally be < 16.
;
LSLOP	NOP			;$3E,1, Shift left (the NOP is necessary)
				; fall into LSROP...
;-------------------------------------------------------------------------------
;$3F
;Shift right. TOS:= NOS >> TOS
;
LSROP	CALL	PULLB		;$3F,1; TOS into RegB, low byte of RegB is in W
	BTFSC	STATUS,Z	; and the status is set accordingly
	 GOTO	OPGO		;branch if shifting zero places
	CALL	PULLA		;NOS into RegA

LSR20	BCF	STATUS,C	;clear carry bit for shifting
	BTFSS	RegX,0		;skip if odd numbered opcode (LSROP)
	 GOTO	LSR30		; else branch to shift left
	RRF	RegA+1		;shift right  -->
	RRF	RegA
	GOTO	LSR40
LSR30	RLF	RegA		;shift left  <--
	RLF	RegA+1
LSR40	DECFSZ	RegB		;loop for the number of places in RegB (=TOS)
	 GOTO	LSR20
	GOTO	OPGOPA		;go push RegA

;===============================================================================
;				  SUBROUTINES
;===============================================================================
;Return the heap address of a variable. This fetches an instruction's level and
; offset and returns the corresponding heap address in W.
;
HEAPADR	CALL	FETCH		;fetch level (times 2)
	MOVWF	FSR
	MOVLW	DISPLY2		;add base of display vector table (times 2)
	ADDWF	FSR
	RRF	FSR		;undo times 2 (carry is clear because of ADDWF)
	CALL	FETCH		;get offset (does not change FSR)
	ADDWF	IND,W		;add it to base address from table to get addr
	RETP			; in heap

;-------------------------------------------------------------------------------
;Return the heap address of a local or global variable. This fetches an
; instruction's offset and returns the corresponding heap address in W.
; Bank 0 is no longer selected.
;
HEAPADRX CALL	FETCH		;fetch offset
	MOVWF	FSR		;BANK 0 IS NO LONGER SELECTED
	MOVF	LOCDISP,W	;get base address for local level
	BTFSC	FSR,0		;skip if offset is even (it's a local variable)
	 MOVF	DISPLY,W	; else get base address of global variables
	ADDWF	FSR,W		;add offset to get heap address
	RETP

;-------------------------------------------------------------------------------
;Convert the logical address in W into a physical address in FSR (to cope with
; fragmented RAM). Bank 0 is no longer selected.
;
LOGPHYS MOVWF	FSR		;BANK 0 IS NO LONGER SELECTED
	ANDLW	0F0h		;shift the high nibble left
	ADDWF	FSR		;(bit 4 will be set later)
	BSF	FSR,4		;make sure FSR is pointing to high half of bank
	RETP

;-------------------------------------------------------------------------------
;Get the variable pointed to by W and put it into RegA.
;
GETVAR	CALL	LOGPHYS		;convert logical address to physical address
	MOVF	IND,W		;fetch low byte
	MOVWF	RegA

	INCF	FSR
	BSF	FSR,4		;make sure FSR is pointing to high half of bank
	MOVF	IND,W		;fetch high byte
	MOVWF	RegA+1
	GOTO	PULL90		;restore access to bank 0 and return

;-------------------------------------------------------------------------------
;Fetch the I2L code byte pointed to by I2LPC and then bump I2LPC. (I2LPC++) -> W
; FSR is not changed.
;
FETCH	BTFSC	I2LPC+1,3	;skip if fetching from below address 800h
	 GOTO	FET50		; else go fetch two nibbles
	MOVF	I2LPC+1,W	;fetch byte at I2LPC
	MOVWM
	MOVF	I2LPC,W
	IREAD			;return byte in W

	INCFSZ	I2LPC		;increment interpreter's program counter
	 RETP			;most of the time it returns from here
	INCF	I2LPC+1		;increment high byte
	BTFSS	I2LPC+1,3	;skip if 800h--ignore reset vector at 7FFh
	 RETP			; return

	DECF	I2LPC		;convert 800h back to 7FFh
	DECF	I2LPC+1

;When fetching at or above address 7FFh, the location to actually fetch from is:
; = (I2LPC - 7FFh)*2 + PROGLO
; = (I2LPC - (800h-1))*2 + PROGLO
; = 2*I2LPC - 1000h + 2 + PROGLO   Since 1000h is over the top, it has no effect
; = 2*I2LPC + PROGLO + 2
FET50	RLF	I2LPC,W		;RegB:= 2*I2LPC
	MOVWF	RegB
	RLF	I2LPC+1,W
	FCALL	FETCOM
	INCFSZ	I2LPC		;increment interpreter's program counter
	 RETP			; most of the time it returns from here
	INCF	I2LPC+1		;increment high byte
	RETP			;return

;-------------------------------------------------------------------------------
;Check for memory overflow. If HP > I2LSP then I2L error # 2: Out of memory.
;
CHKMEM	MOVF	HP,W		;convert logical address in HP to physical
	ANDLW	0F0h		; address in W, except that bit 4 is clear
	ADDWF	HP,W

	BCF	I2LSP,4		;compare to similar physical address in I2LSP
	SUBWF	I2LSP,W		;I2LSP - HP
	MOVLW	2		;error 2
	BTFSS	STATUS,C	;skip if no overflow
	 GOTO	DOERROR		; else flag error and return
	RETP			;return with no error

;-------------------------------------------------------------------------------
;Move arguments from stack to heap. The number of bytes of arguments to move is
; in the W register. The location in the heap is pointed to by the heap pointer
; (HP). RegX, and RegA are changed.
;
;Example showing how 2 arguments (4 bytes) are passed. FROG(NOS, TOS);
;
;      Initial	   STACK	   --->		    HEAP
;      I2LSP -->|          |			|          |
;		+----------+			+----------+
;	      1	| TOS high |		  HP -->| NOS low  |
;		+----------+			+----------+
;	      2	| TOS low  |			| NOS high |
;		+----------+			+----------+
;	      3	| NOS high |			| TOS low  |
;		+----------+			+----------+
;	      4	| NOS low  |<-- Final I2LSP	| TOS high |
;		+----------+			+----------+
;							    <-- Initial RegA
;
MOVARGS	MOVWF	RegX		;save byte count
	ADDWF	HP,W		;add base address (HP) to get pointer into heap
	MOVWF	RegA		;save this pointer

MOV10	CALL	PULL		;pull TOS byte from stack
	MOVWF	RegA+1		;save it temporarily in high byte of RegA

	DECF	RegA		;decrement pointer to heap
	MOVF	RegA,W
	CALL	LOGPHYS		;convert logical address to physical address

	MOVF	RegA+1,W	;store TOS byte into heap
	MOVWF	IND
	BANKX	0		;restore access to bank 0 (PULL needs it)

	DECFSZ	RegX		;loop for the specified number of bytes
	 GOTO	MOV10
	RETP

;-------------------------------------------------------------------------------
;Pull the 16-bit value in TOS into RegA. Returns with copy of RegA in W.
;
PULLA	CALL	PULL		;high byte
	MOVWF	RegA+1
	CALL	PULL		;low byte
	MOVWF	RegA
	RETP

;-------------------------------------------------------------------------------
;Pull the 16-bit value in TOS into RegB. Returns with copy of RegB in W.
;
PULLB	CALL	PULL		;high byte
	MOVWF	RegB+1
	CALL	PULL		;low byte
	MOVWF	RegB
	RETP

;-------------------------------------------------------------------------------
;Pull the 16-bit value in TOS into RegC. Returns with copy of RegC in W.
;
PULLC	CALL	PULL		;high byte
	MOVWF	RegC+1
	CALL	PULL		;low byte
	MOVWF	RegC
	RETP

;-------------------------------------------------------------------------------
;Pull the 16-bit value in TOS into I2LPC. Returns with copy of I2LPC in W.
;
PULLPC	CALL	PULL		;high byte
	MOVWF	I2LPC+1
	CALL	PULL		;low byte
	MOVWF	I2LPC
	RETP

;-------------------------------------------------------------------------------
;Pull a byte from the stack and return it in W with its correct Z status.
;
PULL	INCF	I2LSP		;increment stack pointer
	BSF	I2LSP,4		;make sure it's in the high half of the bank
	MOVF	I2LSP,W		;set FSR as the stack pointer
	MOVWF	FSR
	MOVF	IND,W		;get byte from stack and set Z status
PULL90	BANKX	0		;restore access to bank 0
	RETP

;-------------------------------------------------------------------------------
;Push byte in W onto the stack (without changing W or carry).
;
PUSH	MOVWF	TEMP		;save W
	BSF	I2LSP,4		;make sure it's in the high half of the bank
	MOVF	I2LSP,W		;get stack pointer
	MOVWF	FSR
	MOVF	TEMP,W		;store W onto stack
	MOVWF	IND
	BANKX	0		;restore access to bank 0
REPUSH	BCF	I2LSP,4		;force low half of bank
	DECF	I2LSP		;decrement stack pointer
	RETP			; (I2LSP is forced to high half of bank later)

;-------------------------------------------------------------------------------
;Subroutine to set up arguments for divide opcode
;
DIV100	CALL	PULLA		;TOS -> RegA
	MOVF	RegA+1,W	;get sign bit and
	XORWF	FLAGS		;toggle sign flag if its negative
				;fall into ABSA...
;-------------------------------------------------------------------------------
;Return the absolute value of RegA.
;
ABSA	BTFSS	RegA+1,7	;skip if negative and fall into NEGA...
	 RETP			; else return with positive value

;-------------------------------------------------------------------------------
;Negate RegA (two's complement).
;
NEGA	COMF	RegA
	COMF	RegA+1
				;fall into INCA...
;-------------------------------------------------------------------------------
;Increment RegA (without altering W).
;
INCA	INCFSZ	RegA
	 RETP
	INCF	RegA+1
	RETP

;===============================================================================
;		      ROUTINES TO EXECUTE I2L INSTRUCTIONS
;===============================================================================
;$00
;Exit routine. One-byte instruction. Since in this ROM-based environment there
; is nothing to exit back to (such as an operating system), this is an error.
;
EXTOP	FGOTO	ERREXIT

;-------------------------------------------------------------------------------
;$01
;Routine to fetch a 16-bit variable's value from the heap and push it onto the
; stack. This instruction is usually replaced by the fast global or local load
; (FASTLOD), but when the variable's level is neither global or local (when it's
; intermediate), this routine is used instead. This is a three-byte instruction:
;	1. The opcode ($01).
;	2. The level in the display vector table for the base address (times 2).
;	3. The offset from that base address to the variable.
;
LODOP	CALL	HEAPADR		;fetch level & offset and point W to heap addr
	GOTO	OPGOLOD		;go get variable from heap and push it on stack

;-------------------------------------------------------------------------------
;$02
;Routine to push an 8-bit byte onto the stack. This opcode contains the level
; and offset of a variable that points to the base of a character (byte) array.
; An index, which is on the stack, is added to this base address to get the
; address of the byte to push. The byte is pushed as a 16-bit value with its
; high byte zeroed. Three-byte instruction: opcode, level, and offset.
;
LDXOP	CALL	HEAPADR		;fetch level & offset and point W to heap addr
LDXOPX	CALL	GETVAR		;get array base address from heap into RegA
	CALL	PBDADD		;pull index and add it to base of array
	CALL	FETCHA		;fetch (into W) the byte pointed to by RegA
LDXPA	CLRF	RegA+1		;zero the high byte
	GOTO	OPGOPAW		;go push W & RegA+1 onto the stack

;-------------------------------------------------------------------------------
;$22
;Compact form of LDX instruction. Used when the variable is global or local.
; Two-byte instruction: opcode, offset.
;
LDX2OP	CALL	HEAPADRX	;get heap address for local or global into W
	GOTO	LDXOPX		;go to common code for LDX instruction

;-------------------------------------------------------------------------------
;$03
;Routine to store top-of-stack (TOS) into a variable.
; Three-byte instruction: opcode, level, and offset.
;
STOOP	CALL	PULLA		;TOS -> RegA
	CALL	HEAPADR		;fetch level & offset and point W to heap addr

;Store RegA into heap location pointed to by W
STOOPX	CALL	LOGPHYS		;convert logical address into physical address
	MOVF	RegA,W		;get low byte of TOS
	MOVWF	IND		;store it into heap
	INCF	FSR
	MOVF	RegA+1,W	;get high byte
	BSF	FSR,4		;make sure FSR is pointing to high half of bank
STOOPY	MOVWF	IND		;store it too
	BANKX	0		;restore access to bank 0
	GOTO	OPGO		;go process next instruction

;-------------------------------------------------------------------------------
;$3C
;Compact form of STO instruction. Used when the variable is global or local.
; Two-byte instruction: opcode, offset.
;
STO2OP	CALL	PULLA		;TOS -> RegA
	CALL	HEAPADRX	;get heap address for local or global into W
	GOTO	STOOPX		;go do common code for STO instruction

;-------------------------------------------------------------------------------
;$04
;Routine to store the value on the stack into an indexed array element. Similar
; to LDX except that the value to store is pushed on the stack after the index
; (i.e: index=NOS, value=TOS). The high byte of the value is ignored and the low
; byte is stored into the heap. Three-byte instruction: opcode, level, offset.
;
STXOP	CALL	HEAPADR		;fetch level & offset and point W to heap addr
STXOPX	CALL	GETVAR		;copy base address of array from heap into RegA

	INCF	I2LSP		;discard high byte
	CALL	PULL		;pull byte to store into array
	MOVWF	RegX		; and save it for now in RegX
	CALL	PBDADD		;pull index and add it to base of array in RegA

	MOVLW	15		;make sure high byte is clear, else flag
	MOVF	RegA+1		; I2L error # 15: Attempt to store into ROM
	BTFSS	STATUS,Z
	 CALL	DOERROR

	MOVF	RegA,W		;point FSR to RAM address
	CALL	LOGPHYS		;convert logical address to physical address
	MOVF	RegX,W		;get byte that is to be stored into the array
	GOTO	STOOPY		;go store it and return to OPGO

;-------------------------------------------------------------------------------
;$3D
;Compact form of STX instruction. Used when variable is global or local.
; Two-byte instruction: opcode, offset.
;
STX2OP	CALL	HEAPADRX	;get heap address for local or global into W
	GOTO	STXOPX		;go do common code for STX instruction

;-------------------------------------------------------------------------------
;$05
;Routine to call a procedure.
; The instruction consists of 4 bytes:
;	1. The opcode.
;	2. The (new) level of the procedure being called (high 3 bits) and the
;	   number of bytes of arguments to be passed (low 5 bits) (see ARGOP).
;	3. The procedure entry address (low byte).
;	4. The procedure entry address (high byte).
;
; After a procedure call, the stack contains:
;	1. Return address (high byte, low byte).
;	2. Base address of variables (in heap) for the called procedure
;	   (i.e. value in display vector table at the new level).
;	3. Level of procedure we are calling from.
;
;The entry in the display vector table at the new level is set to the value in
; the heap pointer (HP). This is the base address of any local variables in the
; called procedure.
;
CALOP	CALL	FETCH		;get level and number of arguments
	MOVWF	RegC		;save copy for later
	ANDLW	1Fh		;get the number of arguments
	BTFSS	STATUS,Z	;skip if no arguments
	 CALL	MOVARGS		; else move W bytes of args from stack to heap

	MOVF	LEVEL,W		;push level we are calling from
	CALL	PUSH

;Push the value in the display vector table at the new level
	SWAPF	RegC		;move the level in the high 3 bytes down
	RRF	RegC,W
	ANDLW	07h
	MOVWF	LEVEL		;set the level for the called procedure

	MOVLW	DISPLY		;index into display vector table
	ADDWF	LEVEL,W
	MOVWF	FSR		;(bank 0 is still selected)
	MOVF	IND,W		;get the base address for the called level
	MOVWF	RegC		;temporarily save base address in RegC

	MOVF	HP,W		;change this entry in the display vector table
	MOVWF	IND		; to the current heap pointer
	MOVWF	LOCDISP		;also save a copy for accessing local variables

	MOVF	RegC,W		;push base address for the called level
	CALL	PUSH		;fall into JSROP...

;-------------------------------------------------------------------------------
;$26
;Optimized procedure call. Used only if no local variables are present. Since
; the scope is unchanged, this is equivalent to a machine language call. This
; instruction is also used to load the address of a string and then jump over
; the string. Three-byte instruction: opcode, low byte of called address, high
; byte of called address.
;
JSROP	MOVLW	2		;push return address (=I2LPC+2)
	ADDWF	I2LPC,W
	CALL	PUSH		;push low byte (and don't disturb carry)
	CLRF	TEMP		;shift carry into W
	RLF	TEMP,W
	ADDWF	I2LPC+1,W	;add high byte
	CALL	PUSH		;push resulting high byte
	GOTO	JMPOP		;go do jump to procedure then return to OPGO

;-------------------------------------------------------------------------------
;$27
;Optimized procedure return, to match the above call. Pulls the return address
; and puts it into I2LPC. Single-byte instruction.
;
RTSOP	CALL	PULLPC		;pull return address into I2LPC
	GOTO	OPGO

;-------------------------------------------------------------------------------
;$06
;Routine to return from a procedure. This pops the stuff pushed by CALOP.
; Single-byte instruction.
;
RETOP	MOVF	LOCDISP,W	;restore heap pointer to its location before
	MOVWF	HP		; the call

	CALL	PULLPC		;pull return address into I2LPC

	CALL	PULL		;pull base address of variables we're ret from
	MOVWF	RegA		;save it temporarily in RegA

	CALL	PULL		;pull level for procedure we are returning to
	MOVWF	RegX		;save it temporarily in RegX

;Restore base address entry in display table for level we are returning from
	MOVLW	DISPLY		;index into display vector table for current
	ADDWF	LEVEL,W		; level
	MOVWF	FSR		;(bank 0 is still selected)
	MOVF	RegA,W		;restore base address
	MOVWF	IND

	MOVF	RegX,W		;set LEVEL to the level we are returning to
	MOVWF	LEVEL
	MOVLW	DISPLY		;get base address of variables for this level
	ADDWF	LEVEL,W
	MOVWF	FSR		;(bank 0 is still selected)
	MOVF	IND,W
	MOVWF	LOCDISP		;set pointer for locals we're returning to
	GOTO	OPGO

;-------------------------------------------------------------------------------
;$08
;The two jump instructions are each three bytes long:
;	Opcode.
;	Low order of target address.
;	High order of target address.
;
;Conditional jump routine. This routine jumps on false, not on true. Note that
; false is zero, and non-zero is true. The result of the last boolean expression
; (typically a compare) is on the stack. Note that the entry point is at JPCOP.
;
JPCOPX	MOVLW	2		;move past address to jump to. i.e. don't jump
	ADDWF	I2LPC		;skip two bytes of I2L code
	BTFSC	STATUS,C
	 INCF	I2LPC+1
	GOTO	OPGO

JPCOP	CALL	PULLA		;pull bytes
	IORWF	RegA+1,W	;combine high and low bytes
	BTFSS	STATUS,Z	;skip if false (zero) and fall into JMPOP...
	 GOTO	JPCOPX		; else TOS was true so go move past jump address

;-------------------------------------------------------------------------------
;$07
;Jump instruction.
;
JMPOP	CALL	FETCH		;get low byte of address to jump to
	MOVWF	RegX		;save it temporarily in X
	CALL	FETCH		;get high byte (pointed to by I2LPC)
	MOVWF	I2LPC+1		;now update I2L's PC
	MOVF	RegX,W
	MOVWF	I2LPC
	GOTO	OPGO

;-------------------------------------------------------------------------------
;$09
;Routine to increase the heap pointer. This is used to reserve heap space for
; local variables. Two-byte instruction: opcode, number of bytes to reserve.
;
HPIOP	CALL	FETCH		;add the amount to reserve onto HP
	ADDWF	HP
	CALL	CHKMEM		;check for memory overflow (HP > I2LSP)
	GOTO	OPGO

;-------------------------------------------------------------------------------
;$0A
;Routine to move procedure arguments from the stack to the heap. The called
; procedure will then reserve the space with an HPIOP, and the local variables
; thus created will be preset to their appropriate values. Two-byte instruction:
; opcode, number of bytes of arguments.
;
ARGOP	CALL	FETCH		;get number of bytes of arguments
	CALL	MOVARGS		;move W bytes of arguments from stack to heap
	GOTO	OPGO

;-------------------------------------------------------------------------------
;$0B
;Load a 16-bit constant onto the stack. Three-byte instruction: Opcode, low
; byte of constant, high byte of constant.
; TOS:= immediate value.
;
IMMOP	CALL	FETCH		;get low byte of constant
	MOVWF	RegA
	CALL	FETCH		;get high byte
	MOVWF	RegA+1
	GOTO	OPGOPA		;go push RegA

;===============================================================================
;			     ARITHMETIC OPERATIONS
;===============================================================================
;
;These routines operate on the two items on the top-of-stack (TOS and NOS) and
; return the result in TOS (which replaces NOS). They are all single-byte
; instructions. Items are on the stack as shown. Note that the low byte is
; pushed first. Addresses increase downward.
;
;	       Initial I2LSP -->|          |
;				+----------+
;			      1	| TOS high |
;				+----------+
;			      2	| TOS low  |<-- I2LSP when finished
;				+----------+
;			      3	| NOS high |
;				+----------+
;			      4	| NOS low  |
;				+----------+
;
;-------------------------------------------------------------------------------
;$0D
;Add. TOS:= NOS + TOS. Single-byte instruction.
;
ADDOP	CALL	PULLA		;get TOS into RegA
ADDOPX	CALL	PBDADD		;get NOS into RegB and RegA:= RegA + RegB
	GOTO	OPGOPA		;go push RegA

;-------------------------------------------------------------------------------
;$0E
;Subtract. TOS:= NOS - TOS. Single-byte instruction.
;
SUBOP	CALL	PULLB		;get TOS into RegB
	CALL	PULLA		;get NOS into RegA
	CALL	DSUB		;RegA:= RegA - RegB
	GOTO	OPGOPA		;go push RegA

;-------------------------------------------------------------------------------
;$0F
;16-bit signed multiply. TOS:= NOS * TOS. Single-byte instruction. This uses an
; early-out algorithm.
;
;	<-- RegB      RegC -->
;         + RegA -->
;
MULOP	CALL	PULLC		;get TOS (multiplier) into RegC
	CALL	PULLB		;get NOS (multiplicand) into RegB
	CLRF	RegA		;clear product register
	CLRF	RegA+1
	GOTO	MUL30

MUL10	CALL	DADD		;RegA:= RegA + RegB
	BCF	STATUS,C
MUL20	RLF	RegB		;shift multiplicand left   <-- B
	RLF	RegB+1

MUL30	BCF	STATUS,C	;clear carry (don't shift in garbage)
	RRF	RegC+1		;shift least significant bit of multiplier
	RRF	RegC		; into carry
	BTFSC	STATUS,C	;skip if bit was a 0
	 GOTO	MUL10		; else it was a 1--go add B to A

	MOVF	RegC,W		;are there any more 1 bits in C?
	IORWF	RegC+1,W
	BTFSS	STATUS,Z	;skip if not--all done
	 GOTO	MUL20		; else loop back skipping add (carry is clear)
	GOTO	OPGOPA		;go return and push product onto the stack

;-------------------------------------------------------------------------------
;$10
;16-bit signed divide. TOS:= NOS / TOS. Single-byte instruction.
;
DIVOP	CLRF	FLAGS		;bit 7 is used to determine sign of quotient
	CALL	DIV100		;get TOS and handle sign
	FCALL	DMOVAB		;copy RegA to RegB

	IORWF	RegB,W		;check for divide by 0
	MOVLW	1		;flag I2L error 1
	BTFSC	STATUS,Z	;skip if no error
	 CALL	DOERROR

	CALL	DIV100		;get NOS and handle sign
	FCALL	DIV		;RegA:= RegA / RegB.
	BTFSC	FLAGS,7		;skip if quotient should be positive
DIV90	 CALL	NEGA		; otherwise make it negative
	GOTO	OPGOPA		;go push RegA

;-------------------------------------------------------------------------------
;$11
;Negate. TOS:= -TOS. Single-byte instruction.
;
NEGOP	CALL	PULLA		;get TOS into RegA
	GOTO	DIV90		;go make it negative and push it

;===============================================================================
;			       COMPARE OPERATIONS
;===============================================================================
;
;Integer compares use the top two items on the stack, and return either a
; true ($FFFF) or false ($0000) value on the stack. They are all one-byte
; instructions. Note that RegX contains the opcode.
;
;-------------------------------------------------------------------------------
;$12
;Equal? TOS:= NOS = TOS. Single-byte instruction.
;
EQOP				;fall into NEOP...

;-------------------------------------------------------------------------------
;$13
;Not equal? TOS:= NOS # TOS. Single-byte instruction.
;
NEOP	CALL	PULLA		;get TOS into RegA
	CALL	PULLB		;get NOS into RegB (low byte of RegB is in W)

	SUBWF	RegA,W		;compare TOS to NOS
	BTFSS	STATUS,Z	;skip if equal
	 GOTO	EQOP3		; else branch--go return reversed logic
	MOVF	RegB+1,W	;compare high bytes
	SUBWF	RegA+1,W
	BTFSS	STATUS,Z	;skip if equal
EQOP3	 INCF	RegX		;reverse logic by flipping LSB
EQOP4	MOVLW	0		;push either a true or false value depending
	BTFSS	RegX,0		; on logic
	 MOVLW	0FFh		;use 'true' value
PUSHW2	CALL	PUSH		;push value in W twice and return
	GOTO	OPGOPW		;go push W

;-------------------------------------------------------------------------------
;$17
;Less than? TOS:= NOS < TOS. Single-byte instruction.
;
LTOP				;fall into GEOP...

;-------------------------------------------------------------------------------
;$14
;Greater than or equal? TOS:= NOS >= TOS. Single-byte instruction.
;
GEOP	CALL	PULLB		;get TOS into RegB
	CALL	PULLA		;get NOS into RegA

GEOP2	CALL	DCMP		;compare NOS to TOS
	BTFSS	STATUS,C	;skip if NOS >= TOS
	 GOTO	EQOP3		; else branch--go reverse logic
	GOTO	EQOP4		;go return unreversed logic

;-------------------------------------------------------------------------------
;$15
;Greater than? TOS:= NOS > TOS. Single-byte instruction.
;
GTOP				;fall into LEOP...

;-------------------------------------------------------------------------------
;$16
;Less than or equal? TOS:= NOS <= TOS. Single-byte instruction.
;
LEOP	CALL	PULLA		;get TOS into RegA
	CALL	PULLB		;get NOS into RegB
	GOTO	GEOP2		;go compare TOS to NOS

;===============================================================================
;			        FOR-LOOP CONTROL
;===============================================================================
;$19
;Routine to increment a variable's value. Five-byte instruction: opcode, level,
; offset, and two bytes for the jump address to continue the 'for' loop.
;
INCOP	CALL	HEAPADR		;fetch level & offset and point W to heap addr
	CALL	LOGPHYS		;convert logical address to physical address
	INCF	IND		;increment low byte of 'for' control variable
	MOVF	IND,W		;and save a copy
	MOVWF	RegA
	INCFSZ	FSR		;increment stack pointer without changing Z stat
	BSF	FSR,4		;make sure FSR is pointing to high half of bank
	BTFSC	STATUS,Z	;skip if no carry into high byte of variable
	 INCF	IND		; otherwise increment high byte of variable
	MOVF	IND,W		;save a copy
	MOVWF	RegA+1
	BANKX	0		;restore access to bank 0

	MOVF	RegA,W		;push RegA, low byte first
	CALL	PUSH
	MOVF	RegA+1,W	;push RegA high byte
	CALL	PUSH
	GOTO	JMPOP		;go jump to top of 'for' loop

;-------------------------------------------------------------------------------
;$18
;This routine handles the test and branch of the 'for' loop. The stack contains
; the limit (NOS) and a copy of the loop control variable (TOS). They are
; compared and if the loop variable is greater than the limit, the 'FOR' loop is
; finished. In which case this instruction's address is jumped to, and the stack
; is cleaned up. Otherwise, the 'for' loop continues and the I2LPC is advanced
; to the next opcode, leaving the limit value on the stack. Three-byte
; instruction: opcode, low byte of branch address, high byte.
;
FOROP	CALL	PULLB		;pull TOS (= control variable) into RegB
	CALL	PULLA		;pull NOS (= limit) into RegA

	CALL	DCMP		;compare limit to control variable
	BTFSS	STATUS,C	;skip if limit >= control variable
	 GOTO	JMPOP		; otherwise go jump out of the 'for' loop

	CALL	REPUSH		;effectively push limit back onto stack
	CALL	REPUSH
	GOTO	JPCOPX		;skip past branch address in opcode so that the
				; 'for' loop will continue

;===============================================================================
;			       BOOLEAN OPERATIONS
;===============================================================================
;$1A
;"OR" operation--bitwise on all 16 bits. Single-byte instruction.
; TOS:= NOS ! TOS.
;
OROP	CALL	PULLA		;TOS into RegA
	CALL	PULLB		;NOS into RegB
	IORWF	RegA		;RegA:= RegA ! RegB
	MOVF	RegB+1,W
	IORWF	RegA+1
	GOTO	OPGOPA		;go push RegA

;-------------------------------------------------------------------------------
;$1B
;"AND" operation--bitwise on all 16 bits. Single-byte instruction.
; TOS:= NOS & TOS.
;
ANDOP	CALL	PULLA		;TOS into RegA
	CALL	PULLB		;NOS into RegB
	ANDWF	RegA		;RegA:= RegA & RegB
	MOVF	RegB+1,W
	ANDWF	RegA+1
	GOTO	OPGOPA		;go push RegA

;-------------------------------------------------------------------------------
;$1C
;"NOT" complements all sixteen bits. Single-byte instruction.
; TOS:= ~TOS.
;
NOTOP	CALL	PULLA		;TOS into RegA
	COMF	RegA,W		;RegA:= ~RegA (sort of)
	COMF	RegA+1
	GOTO	OPGOPAW		;go push W & RegA+1

;-------------------------------------------------------------------------------
;$1D
;"XOR" operation--bitwise on all 16 bits. Single-byte instruction.
; TOS:= NOS | TOS.
;
XOROP	CALL	PULLA		;TOS into RegA
	CALL	PULLB		;NOS into RegB
	XORWF	RegA		;RegA:= RegA | RegB
	MOVF	RegB+1,W
	XORWF	RegA+1
	GOTO	OPGOPA		;go push RegA

;===============================================================================
;			        ARRAY OPERATIONS
;===============================================================================
;$1E
; TOS:= NOS + TOS*2. Single-byte instruction.
;
DBAOP	CALL	PULLA		;TOS into RegA
	ADDWF	RegA		;RegA:= RegA * 2
	RLF	RegA+1
	GOTO	ADDOPX		;go add RegA to NOS and return to OPGO

;-------------------------------------------------------------------------------
;$1F
;Store TOS into address in NOS and pop both. Single-byte instruction.
;
STDOP	CALL	PULLA		;TOS into RegA
	CALL	PULLB		;NOS into RegB

	MOVLW	15		;make sure high byte of address is 0, otherwise
	MOVF	RegB+1		;flag I2L error # 15: Attempt to store into ROM
	BTFSS	STATUS,Z
	 CALL	DOERROR

	MOVF	RegB,W		;get low byte of address
	GOTO	STOOPX		;store RegA into this address and return

;-------------------------------------------------------------------------------
;$20
;Form NOS+TOS*2 and then use that value as an address of a word to push onto TOS
; PUSH(NOS+TOS*2). Single-byte instruction.
;
DBXOP	CALL	PULLA		;get TOS into RegA
	ADDWF	RegA		;RegA:= RegA * 2
	RLF	RegA+1
	CALL	PBDADD		;get NOS into RegB and RegA:= RegA + RegB
	CALL	FETCHA		;fetch low byte pointed to by RegA
	CALL	PUSH		;push it
	CALL	FETCHA		;fetch high byte
	GOTO	OPGOPW		;go push it

;-------------------------------------------------------------------------------
;$21
;Load the (logical) address of a variable onto the stack. Conventional three-
; byte instruction: opcode, level, offset.
;
ADROP	CALL	HEAPADR		;fetch level & offset and point W to heap addr
	GOTO	LDXPA		;go push W & a cleared high byte indicating a
				; RAM address cuz all heap variables are in RAM
;===============================================================================
;			    MISCELLANEOUS OPERATIONS
;===============================================================================
;$23
;Short relative jump instruction. BRA 0 branches back to the BRA opcode forming
; an infinite loop. Two-byte instruction: opcode, number of bytes to branch back
;
BRAOP	CALL	FETCH		;get number of opcode bytes to branch back
	SUBWF	I2LPC		;subtract from current I2LPC
	BTFSS	STATUS,C	;skip if no borrow
	 DECF	I2LPC+1

	MOVLW	2		;adjust for the two FETCHes that incremented
	SUBWF	I2LPC		; I2LPC twice (once for opcode and once for
	BTFSS	STATUS,C	; the number of bytes to branch back)
	 DECF	I2LPC+1
	GOTO	OPGO

;-------------------------------------------------------------------------------
;$40..$7F
;Short, short immediate load of an 8-bit, signed constant.
; Single-byte instruction. $40 => -1,  $41 => 0,  $42 => 1,  ...  $7F => 62.
;
SSIMOP	MOVLW	41h		;convert opcode to constant by subtracting 41h
	SUBWF	RegX,W
	GOTO	SIMOPX		;enter common code

;-------------------------------------------------------------------------------
;$24
;TOS:= 8-bit, signed, immediate constant. Two-byte instruction: opcode, constant
;
SIMOP	CALL	FETCH		;get constant byte from opcode
SIMOPX	MOVWF	RegA
SIMOPY	CLRF	RegA+1		;assume high byte is clear
	BTFSC	RegA,7		;skip if low byte is positive
	 COMF	RegA+1		; otherwise set high byte to 0FFh (extend sign)
	GOTO	OPGOPA		;go push RegA

;-------------------------------------------------------------------------------
;$25
;This routine optimizes the case statement a little. It pops TOS, compares it
; to NOS, and takes the jump only if they are not equal. Three-byte instruction:
; opcode, low byte of jump address, high byte of jump address.
;
CJPOP	CALL	PULLB		;TOS into RegB
	CALL	PULLA		;NOS into RegA (low byte of RegA is in W)
	CALL	REPUSH		;effectively push NOS back onto stack
	CALL	REPUSH
	SUBWF	RegB,W		;compare low bytes of NOS to TOS
	BTFSS	STATUS,Z	;skip if they are equal
	 GOTO	JMPOP		; otherwise branch
	MOVF	RegA+1,W	;compare high bytes
	SUBWF	RegB+1,W
	BTFSS	STATUS,Z	;skip if equal
	 GOTO	JMPOP		; otherwise branch
	GOTO	JPCOPX		;TOS = NOS: move I2LPC past address to jump to

;-------------------------------------------------------------------------------
;$0C
;Routine to call an intrinsic. Note that intrinsics return by a direct jump to
; OPGO. Arguments, if any, are on the stack in the order they are called (TOS
; is last). If an intrinsic returns a value, it will be in TOS. The intrinsic
; must keep the stack balanced. A common way to bomb yourself is to pass the
; wrong number of arguments. Two-byte instruction: opcode, intrinsic number.
;
	ORG	1FFh		;(RETP for FETCH sets page bits for Jump Table)
CMLOP	CALL	FETCH		;get intrinsic number
	ADDWF	PC		;jump to corresponding routine

;Intrinsic Routine Jump Table:   No. / Description
	GOTO	ABS		; 0 Absolute value
	GOTO	RAN		; 1 Random number
	GOTO	REM		; 2 Remainder of last divide
	GOTO	RESERVE		; 3 Reserve array space
	GOTO	SWAPB		; 4 Swap bytes
	GOTO	EXTEND		; 5 Extend sign from low byte
	GOTO	RESTART		; 6 Restart XPL0 program
	GOTO	CHIN		; 7 Input a byte
	GOTO	CHOUT		; 8 Output a byte
	GOTO	CRLF		; 9 New line
	GOTO	INTIN		;10 Input an integer
	GOTO	INTOUT		;11 Output an integer
	GOTO	TEXT		;12 Output a string
	GOTO	OPENI		;13 Initialize input device
	GOTO	OPENO		;14 Initialize output device
	GOTO	CLOSE		;15 Close an output device
	GOTO	RESETX		;16 Reset
	GOTO	TRAP		;17 Set trap flags
	GOTO	FREE		;18 Determine remaining heap space
	GOTO	RERUN		;19 Test rerun flag
	GOTO	POUT		;20 Port output
	GOTO	SETHP		;21 Set heap pointer
	GOTO	GETERR		;22 Get I2L error number
	GOTO	PIN		;23 Port input
	GOTO	SOUND		;24 Squeak the speaker
	GOTO	SETRUN		;25 Set the rerun flag
	GOTO	HEXIN		;26 Input a hex integer
	GOTO	HEXOUT		;27 Output a hex integer
	GOTO	DOCLRWDT	;28 CLRWDT instruction
	GOTO	DOOPTION	;29 OPTION instruction
	GOTO	DOSLEEP		;30 SLEEP instruction

;-------------------------------------------------------------------------------
;GOTO and CALL extenders
;
ABSAX	FGOTO	ABSA
PULLAX	FGOTO	PULLA
PULLBX	FGOTO	PULLB
PUSHX	FGOTO	PUSH

;===============================================================================
;				  SUBROUTINES
;===============================================================================
;
;Pull TOS into NOWDEV. Currently any device number other than 0 is illegal.
; If illegal device number then RegA, RegB, RegC, RegX and FLAGS are changed.
;
PULLNOWDEV
	CALL	PULLBX		;pull device number
	MOVWF	NOWDEV		;store low byte into NOWDEV (ignore high byte)

	BTFSC	STATUS,Z	;skip if not device 0
	 RETP			; else return with no error
	MOVLW	3		;flag illegal device number
	GOTO	DOERRORX	;report error and possibly return

;-------------------------------------------------------------------------------
;Output a carriage return and line feed (new line) to NOWDEV.
;
DOCRLF	MOVLW	CR		;carriage return
	CALL	OUTTO
	MOVLW	LF		;line feed
	GOTO	OUTTO		;output byte and return

;-------------------------------------------------------------------------------
;Output a text string pointed to by RegA. The string terminates on a character
; with its MSB (bit 7) set. RegA is left pointing to the end of the string +1.
; Note that the entry point is at TEXTOUT.
;
TXT10	CALL	OUTTO		;output char
TEXTOUT	CALL	FETCHAX		;get character
	MOVWF	TEMP		;test MSB
	BTFSS	TEMP,7		;skip if MSB is set
	 GOTO	TXT10		; else loop back
	ANDLW	7Fh		;clear MSB
	GOTO	OUTTO		;output last char and return

;-------------------------------------------------------------------------------
;Multiply RegA by 16, 4, or 2. The W register is not changed.
;
REGAX16	CALL	REGAX4		;multiply RegA by 16
REGAX4	CALL	REGAX2		;multiply RegA by 4
REGAX2	BCF	STATUS,C	;multiply RegA by 2
	RLF	RegA
	RLF	RegA+1
	RETP

;-------------------------------------------------------------------------------
;Move RegA to RegB.
;
DMOVAB	MOVF	RegA,W		;move low byte
	MOVWF	RegB
	MOVF	RegA+1,W	;move high byte
	MOVWF	RegB+1
	RETP

;-------------------------------------------------------------------------------
;Routine to fetch a byte pointed to by RegA and then bump RegA. (RegA++) -> W.
; This fetches from both RAM and ROM. RAM ranges from $0000 through $00FF, and
; ROM ranges from $0100 through $FFFF. WARNING: This cannot be used to fetch
; from ROM below $0100; specifically, error messages cannot reside below $0100.
;
FETCHAX	MOVF	RegA+1,W	;load and test high byte of address pointer
	BTFSC	STATUS,Z	;skip if it's a ROM address
	 GOTO	FETA20		; else go fetch from RAM

;Fetch from ROM:
	BTFSC	RegA+1,3	;skip if fetching below 800h
	 GOTO	FETA10		; else go fetch two nibbles
	MOVWM			;fetch the byte pointed to by RegA
	MOVF	RegA,W
	IREAD			;fetch byte into W

	INCFSZ	RegA		;increment pointer
	 RETP			; most of the time it returns from here
	INCF	RegA+1		;increment high byte
	BTFSS	RegA+1,3	;skip if 800h--ignore reset vector at 7FFh
	 RETP			; return

	DECF	RegA		;convert 800h back to 7FFh
	DECF	RegA+1

;When fetching at or above address 7FFh, the location to actually fetch from is:
; = (RegA - 7FFh)*2 + PROGLO
; = (RegA - (800h-1))*2 + PROGLO
; = 2*RegA - 1000h + 2 + PROGLO   Since 1000h is over the top, it has no effect
; = 2*RegA + PROGLO + 2
FETA10	RLF	RegA,W		;RegB:= 2*RegA
	MOVWF	RegB
	RLF	RegA+1,W
	CALL	FETCOM
	GOTO	INCAX		;exit

;Fetch from RAM:
FETA20	MOVF	RegA,W		;point FSR to RAM address
	FCALL	LOGPHYS		;convert logical address to physical address
	MOVF	IND,W		;fetch byte from RAM
	BANKX	0		;restore access to bank 0
INCAX	FGOTO	INCA		;increment RegA and return

;-------------------------------------------------------------------------------
;Common code for FETCH and FETCHA. FSR is not changed.
;
FETCOM	MOVWF	RegB+1
	BCF	RegB,0		;clear possible carry in

	MOVLW	low (PROGLO+2)	;RegB:= RegB + PROGLO + 2
	ADDWF	RegB
	BTFSC	STATUS,C
	 INCF	RegB+1
	MOVLW	high (PROGLO+2)
	ADDWF	RegB+1

	MOVF	RegB+1,W	;fetch from location pointed to by RegB
	MOVWM
	MOVF	RegB,W
	IREAD
	MOVMW			;save high nibble in TEMP
	MOVWF	TEMP

	MOVF	RegB+1,W	;fetch from next location
	MOVWM
	INCF	RegB,W		;(PROGLO must be even to prevent possible carry)
	IREAD

	MOVMW			;get low nibble
	SWAPF	TEMP		;combine it with high nibble
	IORWF	TEMP,W
	RETP			;and return the resulting byte in W

;-------------------------------------------------------------------------------
;Output the 16-bit, signed integer in RegA in ASCII decimal format. RegA, RegB,
; RegC, RegX and FLAGS are changed.
;
#define	SUPRLZ	FLAGS,1		;flag: suppress leading zeros

INTO	MOVLW	'-'		;get a minus sign
	BTFSC	RegA+1,7	;skip if RegA is positive
	 CALL	OUTTO		; else output the minus sign

	CALL	ABSAX		;use absolute value of RegA
	MOVLW	4		;set up loop counter and index for POWER table
	MOVWF	RegC
	BSF	SUPRLZ		;set flag to suppress leading zeros

;Subtract a power-of-10 from RegA until it is negative. Count the number
; of subtractions in RegX.
IO20	CLRF	RegX		;init subtraction counter

	DECF	RegC,W		;move current power-of-ten into RegB
	CALL	POWERL		;index into POWER table = loop counter -1
	MOVWF	RegB
	DECF	RegC,W
	CALL	POWERH
	MOVWF	RegB+1

IO30	FCALL	DSUB		;subtract power-of-10 from RegA
	INCF	RegX		;count number of subtractions
	BTFSS	RegA+1,7	;loop until negative result
	 GOTO	IO30

	FCALL	DADD		;add back one power-of-ten
	DECFSZ	RegX,W		;undo one subtraction and get counter in W
				;skip if counter is zero
	 BCF	SUPRLZ		; else set flag to output zeros from now on
	IORLW	30h		;convert binary to an ASCII digit
	BTFSS	SUPRLZ		;skip if leading zeros are being suppressed
	 CALL	OUTTO		; else output digit

	DECFSZ	RegC		;loop for powers 10000 down to 10
	 GOTO	IO20

	MOVF	RegA,W		;the one's digit is left in RegA
	IORLW	030h		;output it whether it's a zero or not
	GOTO	OUTTO		; and return

;Power-of-Ten Tables
;
POWERL	ADDWF	PC
	RETLW	low    10	;1
	RETLW	low   100	;2
	RETLW	low  1000	;3
	RETLW	low 10000	;4

POWERH	ADDWF	PC
	RETLW	high    10	;1
	RETLW	high   100	;2
	RETLW	high  1000	;3
	RETLW	high 10000	;4

;-------------------------------------------------------------------------------
;Input a signed integer in decimal ASCII format. The 16-bit binary result is
; returned in RegA. RegB, RegX and FLAGS are changed.
;
#define	SignFlg	FLAGS,2		;sign flag: set if negative number
#define	NumFlg	FLAGS,3		;number flag: set when digit is read in

GETNO
II00	CLRF	RegA		;initialize
	CLRF	RegA+1
	CLRF	FLAGS		;clear SignFlg and NumFlg

	CALL	INPB		;read in an ASCII character
	MOVWF	RegX		;save a copy
	XORLW	EOF		;is it an end-of-file character?
	BTFSC	STATUS,Z	;skip if not
	 GOTO	II90		; branch if so--return with RegA = 0
	XORLW	EOF^'-'		;is character a minus sign? (undoes XOR EOF too)
	BTFSS	STATUS,Z	;skip if so
	 GOTO	II30		; branch if not
	BSF	SignFlg		;set the sign flag

II20	CALL	INPB		;read in an ASCII digit
	MOVWF	RegX		;save a copy
II30	MOVLW	'0'		;compare digit to '0'
	SUBWF	RegX		;save result (0-9) in RegX
	BTFSS	STATUS,C	;skip if it's >= '0'
	 GOTO	II80		; branch if digit < '0'
	MOVLW	10		;compare resulting digit to 10
	SUBWF	RegX,W		;(don't mess up RegX)
	BTFSC	STATUS,C	;skip if it's < 10
	 GOTO	II80		;branch if it's >= 10
	BSF	NumFlg		;indicate a digit (0-9) was read in

	CALL	DMOVAB		;RegA:= RegA *10
	CALL	REGAX4
	FCALL	DADD
	CALL	REGAX2
	MOVF	RegX,W		;RegA:= RegA + digit
	ADDWF	RegA
	BTFSC	STATUS,C	;propagate carry if necessary (required)
	 INCF	RegA+1
	GOTO	II20		;loop until a non-digit character is read in
II80
	BTFSS	NumFlg		;come here when a non-digit character is read in
	 GOTO	II00		;start over if no digits were read in

	BTFSS	SignFlg		;if there was no minus sign then
II90	 RETP			; just return
	FGOTO	NEGA		; else negate RegA and return

;-------------------------------------------------------------------------------
;Output the binary value in RegA as four ASCII hex digits. RegA is preserved;
; RegX is changed.
;
HEX4OUT	MOVF	RegA+1,W	;output high byte
	CALL	HEX2OUT
	MOVF	RegA,W		;get low byte and fall into HEX2OUT...

;-------------------------------------------------------------------------------
;Output the binary value in the W register as two ASCII hex digits. RegX is
; changed.
;
HEX2OUT	MOVWF	RegX		;save copy
	SWAPF	RegX,W		;output high nibble
	CALL	HEX1OUT
	MOVF	RegX,W		;get saved low nibble and fall into HEX1OUT...

;-------------------------------------------------------------------------------
;Output the binary value in the W register as an ASCII hex digit.
;
HEX1OUT	ANDLW	00Fh		;get nibble
	MOVWF	TEMP		;save copy
	MOVLW	10		;compare it to 10
	SUBWF	TEMP,W
	MOVLW	'A'-'0'-10	;set up for case where it's >= 10
	BTFSC	STATUS,C	;skip if it's less than 10
	 ADDWF	TEMP		; else add 'A' (-'0') to amount nibble is >= 10
	MOVLW	'0'		;convert to ASCII
	ADDWF	TEMP,W
	GOTO	OUTTO		;output char and return

;-------------------------------------------------------------------------------
;Randomize the random number generator.
; WARNING: A lockup condition exists if all bits in SEED are ones.
;
RANDIZE	BANKA	SEED
	MOVF	RB,W		;RB is not zeroed by initialization code
	ANDLW	0F7h
	MOVWF	SEED+1
	MOVWF	SEED+2
	BANKX	0
	RETP

;===============================================================================
;				 I/O ROUTINES
;===============================================================================
;
;Since there is only one I/O device, the dispatch routine is eliminated.
; BEWARE: These I/O routines must not change any registers used by the
; interpreter (except W and FSR).
;
;-------------------------------------------------------------------------------
;Input an ASCII character and return it in the W register
;
INPB	RETP	;***INPUTX	;GOTO	Rcv		*** DEBUG ***
				;fall into OUTTO to echo it...
;-------------------------------------------------------------------------------
;Output ASCII character in the W register
;
OUTTO	RETP	;***OUTPUTX	;GOTO	Xmit		*** DEBUG ***

;-------------------------------------------------------------------------------
;Initialize device for input
;
INIDEV
;	RETP

;-------------------------------------------------------------------------------
;Initialize device for output
;
INODEV
;	RETP

;-------------------------------------------------------------------------------
;Close output device
;
CLODEV
	RETP

;===============================================================================
;			      INTRINSIC ROUTINES
;===============================================================================
;0
;Intrinsic to return the absolute value of top-of-stack (TOS).
;	VAL:= ABS(VAL);
;
ABS	CALL	PULLAX		;pull TOS into RegA
	CALL	ABSAX		;take absolute value of RegA
OPGOPAX	FGOTO	OPGOPA		;go push RegA and return to OPGO

;-------------------------------------------------------------------------------
;1
;Intrinsic to generate a random number. The value returned is between 0 and
; TOS-1.
; If TOS = 0 then the seed is initialized for a repeatable sequence.
; If TOS < 0 then the seed is randomized and RAN(-TOS) is returned.
;	VAL:= RAN(10);		\VAL gets 0 through 9
;
RAN	CALL	PULLAX		;get the limit, which is in TOS
	IORWF	RegA+1,W	;check for limit = 0
	BTFSS	STATUS,Z	;skip if zero (W holds 0, which is used below)
	 GOTO	RAN10		; else branch if not zero

	BANKA	SEED
	CLRF	SEED		;initialize for a repeatable sequence
	CLRF	SEED+1
	CLRF	SEED+2
	BANKX	0
PUSHW2X	FGOTO	PUSHW2		;return a zero (in W) on the stack

RAN10	BTFSC	RegA+1,7	;skip if limit is positive
	 CALL	RANDIZE		; else randomize seed
	CALL	ABSAX		;use positive range
	CALL	DMOVAB		;copy limit into RegB

;pseudo-random generator using 24-bit feedback shift register
	BANKA	SEED
	RLF	SEED,W		;XNOR the 2 most significant bits
	XORLW	0FFh
	XORWF	SEED,W
	MOVWF	TEMP		;and shift result into carry
	ADDWF	TEMP

	RRF	SEED+2		;rotate the entire 24-bit shift register
	RRF	SEED+1
	RRF	SEED

	SWAPF	SEED+1,W	;move SEED into RegA (backwards)
	MOVWF	RegA
	SWAPF	SEED,W		;scramble the bits a bit
	MOVWF	RegA+1
	BCF	RegA+1,7	;force number positive
	BANKX	0

	FCALL	DIV		;RegA:= RegA / RegB
	GOTO	REM10		;go return remainder as the random number

;-------------------------------------------------------------------------------
;2
;Get remainder of most recent integer division. The argument is an expression
; whose result is thrown away. This expression can contain a division or just
; be zero to get the result of an earlier division.
;	VAL:= REM(17/5);	\VAL gets 2
;	VAL:= REM(0);
;
REM	CALL	PULLAX		;discard TOS
REM10	MOVF	REMAIN+1,W	;copy remainder of latest division into RegA
	MOVWF	RegA+1
	MOVF	REMAIN,W
	FGOTO	OPGOPAW		;go push W & RegA+1 and return to OPGO

;-------------------------------------------------------------------------------
;3
;Intrinsic to reserve bytes in the heap and return the base address of the
; reserved space. This is the way arrays are created. Since space is reserved
; in the heap allocation of a procedure, the array will disappear when the
; procedure is exited.
;	ARRAY:= RESERVE(5*2);	\Reserve a 5x3 integer array
;	for I:= 0, 5-1 do ARRAY(I):= RESERVE(3*2);
;
RESERVE	CALL	PULLAX		;get number of bytes to reserve
	MOVF	HP,W		;return the current HP on the stack
	CALL	PUSHX		;push low byte (a 0 high byte is pushed later)
	MOVF	RegA,W		;add number of bytes to reserve to current HP
	ADDWF	HP

	MOVLW	0FFh		;check for memory overflow (error 2)
	BTFSC	STATUS,C	;if there was a carry into high byte of amount
	 MOVWF	RegA+1		; to reserve then force an error (RegA+1:= 0FFh)
	MOVF	RegA+1		;test high byte of sum
	BTFSS	STATUS,Z	;skip if it's zero
	 MOVWF	HP		; else force an error (HP:= 0FFh)
	FCALL	CHKMEM		;check for memory overflow (HP > I2LSP)

	MOVLW	0		;push high byte = 0, since RAM starts at $0000
OPGOPWX	FGOTO	OPGOPW

;-------------------------------------------------------------------------------
;4
;Intrinsic to swap the high and low bytes of the value in top-of-stack.
;	VAL:= SWAP($1234);	\VAL gets $3412
;
SWAPB	CALL	PULLAX		;TOS into RegA
	MOVF	RegA+1,W	;push new low byte
	CALL	PUSHX
	MOVF	RegA,W		;push new high byte
	GOTO	OPGOPWX		;go push W

;-------------------------------------------------------------------------------
;5
;Intrinsic to extend the sign of the low byte into the high byte.
;	VAL:= EXTEND(VAL);
;
EXTEND	CALL	PULLAX		;TOS into RegA
	FGOTO	SIMOPY		;go do it (W = RegA)

;-------------------------------------------------------------------------------
;6
;Intrinsic to restart the XPL0 program.
;	RESTART;
;
RESTART	MOVLW	0FFh		;set rerun flag to true
	MOVWF	RERUNF
	GOTO	START

;-------------------------------------------------------------------------------
;7
;Intrinsic to input a byte and return it on the stack.
;	VAL:= CHIN(0);
;
CHIN	CALL	PULLNOWDEV	;pull device number
	CALL	INPB		;input a byte
LDXPAX	FGOTO	LDXPA		;go push W reg then push 0

;-------------------------------------------------------------------------------
;8
;Intrinsic to output the byte on the stack.
;	CHOUT(0, ^A);
;
CHOUT	CALL	PULLAX		;pull byte and save it in RegA
	CALL	PULLNOWDEV	;pull device number
	MOVF	RegA,W		;get byte
	CALL	OUTTO		;send it
OPGOX	FGOTO	OPGO

;-------------------------------------------------------------------------------
;9
;Intrinsic to output a carriage return and line feed, i.e. start a new line.
;	CRLF(0);
;
CRLF	CALL	PULLNOWDEV	;pull device number
	CALL	DOCRLF		;output CR & LF
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;10
;Intrinsic to input a signed integer and return its value on the stack.
;	VAL:= INTIN(0);
;
INTIN	CALL	PULLNOWDEV	;pull device number
	CALL	GETNO		;input the integer into RegA
	GOTO	OPGOPAX		;go push RegA

;-------------------------------------------------------------------------------
;11
;Intrinsic to output the value on the stack in signed, decimal ASCII format.
;	INTOUT(0, -123);
;
INTOUT	CALL	PULLAX		;pull integer into RegA
	CALL	PULLNOWDEV	;pull device number
	CALL	INTO		;output it
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;12
;Intrinsic to output a text string.
;	TEXT(0, "Hello");
;
TEXT	CALL	PULLAX		;pull address of string into RegA
	CALL	PULLNOWDEV	;pull device number
	CALL	TEXTOUT		;output the string
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;13
;Intrinsic to open, or initialize, an input device.
;	OPENI(0);
;
OPENI	CALL	PULLNOWDEV	;pull device number
	CALL	INIDEV
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;14
;Intrinsic to open, or initialize, an output device.
;	OPENO(0);
;
OPENO	CALL	PULLNOWDEV	;pull device number
	CALL	INODEV
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;15
;Intrinsic to close an output device.
;	CLOSE(0);
;
CLOSE	CALL	PULLNOWDEV	;pull device number
	CALL	CLODEV
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;16
;Intrinsic to abort the XPL0 program by jumping to the RESET start-up code.
;	RESET;
; (No code necessary--see Intrinsic Routine Jump Table.)
;
;-------------------------------------------------------------------------------
;17
;Intrinsic to set the error trap flags.
;	TRAP($FFFD);		\Ignore divide by zero (bit 1 is clear)
;
TRAP	CALL	PULLAX		;pull flag bits into RegA
	MOVWF	TRAPS		;copy RegA into TRAPS
	MOVF	RegA+1,W
	MOVWF	TRAPS+1
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;18
;Intrinsic to return the number of bytes of unused space available in the heap.
; This space should not all be reserved because some will probably be needed
; for the stack and for local variables in any procedures that are called.
;	RESERVE(FREE-8);
; Return logical(I2LSP) - HP
;
FREE	MOVF	I2LSP,W		;convert physical address to logical address
;*** DEBUG
;	ANDLW	0Fh		;convert I2LSP to logical address in TEMP
;	MOVWF	TEMP		;simply shift high nibble of I2LSP right
;	RRF	I2LSP,W		; one bit, leave low nibble intact
;	ANDLW	70h
;	IORWF	TEMP
;
;	MOVF	HP,W		;temp - HP
;	SUBWF	TEMP,W		;return result on stack
;	GOTO	LDXPAX		;push W reg then push 0

;-------------------------------------------------------------------------------
;19
;Intrinsic to return the value of the rerun flag.
;	FLAG:= RERUN;
;
RERUN	MOVF	RERUNF,W	;get the flag
	GOTO	PUSHW2X		;go push W twice

;-------------------------------------------------------------------------------
;20
;Intrinsic to output a byte to any "port" address. "Port" is not restricted
; to locations 5 through 7, thus any RAM location can be written.
;	POUT(value, port, mode);
; If "mode" is not 0 then output "value" to the control register specified by
; mode. In this case only these "ports" are valid:
;	5	TRIS RA
;	6	TRIS RB
;	7	TRIS RC
;
POUT	CALL	PULLAX		;pull mode
	BTFSS	STATUS,Z	;skip if mode = 0
	 GOTO	POUT00		; else go do TRIS

	CALL	PULLBX		;pull port address and save it in RegB
	CALL	PULLAX		;pull byte to output and save it in RegA
	MOVF	RegB,W		;set FSR to port address
	MOVWF	FSR		;BANK 0 IS NO LONGER SELECTED
	MOVF	RegA,W		;get byte to output
	MOVWF	IND		;write it to specified port
	BANKX	0		;restore access to bank 0
	GOTO	OPGOX

POUT00	MOVWM			;store pulled mode value into MODE register
	CALL	PULLBX		;pull port address and save it in RegB
	CALL	PULLAX		;pull byte to output, it's in W

	BTFSC	RegB,1		;port address bits: X01 X10 X11
	 GOTO	POUT20		;corresponds to:    RA  RB  RC

	BTFSC	RegB,0
	 TRIS	RA
	GOTO	OPGOX

POUT20	BTFSS	RegB,0
	 TRIS	RB
	BTFSC	RegB,0
	 TRIS	RC
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;21
;Intrinsic to set the heap pointer. The current value of the heap pointer is
; gotten by calling RESERVE(0). The user should have a good idea of the
; functioning of I2L before dinging with the heap pointer, or he will surely
; bomb himself.
;	SETHP($40);
;
SETHP	CALL	PULLAX		;get (logical) address
	MOVWF	HP		;set new heap pointer
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;22
;Intrinsic to return the latest I2L error number and then clear it.
;	ERR:= GETERR;
;
GETERR	MOVF	ERRNO,W		;get error number
	CLRF	ERRNO		;clear error number
	GOTO	LDXPAX		;go push W then push 0

;-------------------------------------------------------------------------------
;23
;Intrinsic to read a byte from any "port" address and return it on the stack.
; Port is not restricted to locations 5-7, thus any RAM location can be read.
;	variable:= PIN(port, mode);
;
PIN	CALL	PULLAX		;pull mode
	BTFSS	STATUS,Z	;skip if mode = 0
	 GOTO	PIN00		; else go do TRIS

	CALL	PULLAX		;pull port address
	MOVWF	FSR		;put low byte into FSR
	MOVF	IND,W
	BANKX	0		;restore access to bank 0
	GOTO	LDXPAX		;go push W reg then push 0

PIN00	MOVWM			;store pulled mode value into MODE register
	CALL	PULLAX		;pull port address and discard it
	TRIS	RB		;port is assumed to be RB; swap W with ctrl reg
	MOVWF	RegA		;save control register value in RegA
	TRIS	RB		;swap back to restore original value in ctrl reg
	CLRF	RegA+1		;clear high byte
	GOTO	OPGOPAX		;go push RegA and return

;-------------------------------------------------------------------------------
;24
;Intrinsic to emit a sound.
;	SOUND(vol, cycles, period)
;The actual period of the square wave depends on the microcontroller oscillator.
; "cycles" is actually "half-cycles". "Vol" (volume) is either full on or off.
; When the volume is off, this intrinsic provides a time delay.
;
#define	VOL	FLAGS,0		;flag indicating that volume is on

SOUND	CALL	PULLAX		;pull period
	FCALL	PULLC		;pull number of half-cycles
	CALL	PULLBX		;pull volume (on/off)
	BSF	VOL		;assume volume is on
	IORWF	RegB+1		;if any bit is set, volume is on
	BTFSC	STATUS,Z	;skip if not zero
	 BCF	VOL		; else clear volume flag

;Put out RegC half-cycles of sound
	INCF	RegC		;compensate for DECFSZ below
	INCF	RegC+1		; (RegC might be 0)
	GOTO	SND30		;go check for zero cycles

SND20	MOVLW	80h		;set bit corresponding to speaker
	BTFSC	VOL		;skip if volume is off
	 XORWF	RB		; else flip speaker bit

	CALL	DMOVAB		;delay for half a cycle; period -> RegB
	INCF	RegB		;compensate for DECF below
	INCF	RegB+1
SND50	CLRWDT			;kill 5 cycles per loop (in turbo mode)
				; (Was an NOP  R.O.)
	DECFSZ	RegB		;loop on low byte
	 GOTO	SND50
	DECFSZ	RegB+1		;loop on high byte
	 GOTO	SND50

SND30	DECFSZ	RegC		;loop on low cycle byte
	 GOTO	SND20
	DECFSZ	RegC+1		;loop on high cycle byte
	 GOTO	SND20
	GOTO	OPGOX		;return when cycle count is zero

;-------------------------------------------------------------------------------
;25
;Intrinsic to set or clear the rerun flag.
;	SETRUN(true);
;
SETRUN	CALL	PULLAX		;get TOS
	IORWF	RegA+1,W	;if any bit is set, the flag is set (true)
	MOVWF	RERUNF
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;26
;Intrinsic to input a hex integer and return it in top-of-stack.
;	HEX:= HEXIN(0);
;Input an unsigned, 16-bit ASCII hex number into RegA. Any leading non-hex
; characters are ignored (including a minus sign). The number is terminated
; either by a non-hex character or after 4 digits have been read in. 
; RegA and RegX are changed.
;
HEXIN	CALL	PULLNOWDEV	;pull device number
	CLRF	RegA		;initialize hex value
	CLRF	RegA+1
	MOVLW	4		;init digit counter
	MOVWF	RegX

HI00	CALL	INPB		;read in an ASCII character
	MOVWF	TEMP		;save copy
	XORLW	EOF		;is it an end-of-file character?
	BTFSC	STATUS,Z	;skip if not
	 GOTO	HI90		; branch if it is--return with RegA=0

	MOVLW	'0'		;subtract lower limit
	SUBWF	TEMP
	MOVLW	10		;compare to upper limit (>= 10)
	SUBWF	TEMP
	BTFSS	STATUS,C	;skip if character is > '9' or < '0'
	 GOTO	HI30		; else character is in range '0' through '9'

	BCF	TEMP,5		;make sure possible 'a'-'f' is uppercase
	MOVLW	'A'-('0'+10)	;compensate TEMP for above subtracts and
	SUBWF	TEMP		; also subtract 'A'
	MOVLW	'F'-'A'+1	;(= 6) test for upper limit of 'F'
	SUBWF	TEMP,W
	BTFSC	STATUS,C	;skip if result is negative--i.e. in range
	 GOTO	HI40		; else not a valid hex digit
	MOVLW	10		;get fix-up value
HI30	ADDWF	TEMP,W		;add 10 to get binary value

	CALL	REGAX16		;multiply current value by 16 (W is unchanged)
	IORWF	RegA		;insert hex digit

	DECFSZ	RegX		;loop for a maximum of 4 digits
	 GOTO	HI00
HI40
	BTFSC	RegX,2		;skip if any digits read in
	 GOTO	HI00		; else go back and keep trying
HI90	GOTO	OPGOPAX		;go push RegA

;-------------------------------------------------------------------------------
;27
;Intrinsic to output the value in top-of-stack in ASCII hex format.
;	HEXOUT(0, $1234);
;
HEXOUT	CALL	PULLAX		;pull integer into RegA
	CALL	PULLNOWDEV	;pull device number
	CALL	HEX4OUT		;output it
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;28
;Intrinsic to execute CLRWDT instruction.
;	CLRWDT;
;
DOCLRWDT CLRWDT			;clear WDT & prescaler; set STATUS,TO & PD
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;29
;Intrinsic to set the OPTION register.
;	OPTION($85);	\enable RTCC interrupt and set prescaler to divide by 64
;
DOOPTION CALL	PULLAX		;pull integer into RegA, W = low byte
	OPTION			;move W to OPTION register
	GOTO	OPGOX

;-------------------------------------------------------------------------------
;30
;Intrinsic to execute SLEEP instruction.
;	SLEEP;
;
DOSLEEP	SLEEP			;clear WDT & prescaler; set STATUS,TO & clear PD
	GOTO	OPGOX		; *** DEBUG ***

;-------------------------------------------------------------------------------
;I2L error handler. Call with error number in W register. Possible errors are:
;	 0: RETURN FROM MAIN
;	 1: DIV BY 0
;	 2: OUT OF MEMORY
;	 3: I/O ERROR (ILLEGAL DEVICE NUMBER)
;	 4: BAD OPCODE (DISABLED)
;	 5: BAD INTRINSIC (DISABLED)
;	15: STORE INTO ROM
; If the corresponding bit in the TRAP flags is clear then this routine returns,
; otherwise it is a fatal error and the interpreter is restarted, which restarts
; the XPL0 program. If this returns, ERRNO, RegC and RegX are changed.
;
DOERRORX MOVWF	ERRNO		;save the error number
	MOVWF	RegX		;set up loop counter

	MOVF	TRAPS,W		;use copy of trap flags
	MOVWF	RegC
	MOVF	TRAPS+1,W
	MOVWF	RegC+1

ERR10	RRF	RegC+1		;shift bit corresponding to error into bit 0
	RRF	RegC
	DECFSZ	RegX
	 GOTO	ERR10		;loop

	BTFSS	RegC,0		;if this trap bit is clear then return and
	 RETP			; ignore the error, else fall into ERREXIT...

;-------------------------------------------------------------------------------
;Send an error message and restart the interpreter
;
ERREXIT	CLRF	NOWDEV		;send I2L error message to console
	CALL	DOCRLF		;new line
	MOVLW	low ERRMSG	;display: "Error "
	MOVWF	RegA
	MOVLW	high ERRMSG
	MOVWF	RegA+1
	CALL	TEXTOUT

	MOVF	ERRNO,W		;display error number (can be 0)
	MOVWF	RegA
	CLRF	RegA+1
	CALL	INTO
	CALL	DOCRLF		;new line
	GOTO	START		;restart interpreter

;ERRMSG	DT	Bel, "Error", Sp+80h
ERRMSG	DT	Bel		;(for SxSim)   *** DEBUG ***
	DT	'E'
	DT	'r'
	DT	'r'
	DT	'o'
	DT	'r'
	DT	' '+80h

;WARNING: Messages in ROM cannot reside below 100h because of how FETCHA works.

;===============================================================================
;                            RESET ENTRY POINT
;===============================================================================
RESETX	BTFSS	STATUS,TO	;If TO=0 then WDT timeout occurred
	GOTO	START		; bypass clearing RAM and do a restart

;Clear RAM from 08h up through highest enabled bank. Also clears FSR.
	CLRF	FSR
RES10	BTFSS	FSR,4		;skip if 10-1F in each bank
	 BSF	FSR,3		; else skip if 0-7 (skip special registers)
	CLRF	IND		;clear location
	INCFSZ	FSR
	 GOTO	RES10

;Reset clears rerun flag (RERUNF). Restart leaves it set.
START	MOVLW	STACK		;initialize interpreter's stack pointer
	MOVWF	I2LSP

	MOVLW	HEAPLO		;initialize heap pointer to base of heap space
	MOVWF	HP
	MOVWF	DISPLY		;also init level 0 in display vector table
	CLRF	LEVEL

	MOVLW	0FFh		;trap all errors
	MOVWF	TRAPS
	MOVWF	TRAPS+1
	CLRF	ERRNO		;clear error number

;Initialize intrinsic routines
	CALL	RANDIZE		;randomize random number generator

	MOVLW	low PROGLO	;set interpreter's program counter to start
	MOVWF	I2LPC		; of I2L code
	MOVLW	high PROGLO
	MOVWF	I2LPC+1
	GOTO	OPGOX		;go start interpreting

;===============================================================================
;16-bit, unsigned divide. RegA:= RegA / RegB. Remainder in REMAIN.
;
;	REMAIN <-- RegA    RegX
;	- RegB
;
	ORG	400h
DIV	CLRF	REMAIN		;initialize remainder "register"
	CLRF	REMAIN+1

	MOVLW	17		;initialize loop counter
	MOVWF	RegX
	GOTO	DIV20		;(carry doesn't matter cuz RegA is shifted 17x)

DIV10	RLF	REMAIN		;shift in high bit from RegA
	RLF	REMAIN+1

	MOVF	RegB+1,W	;compare REMAIN to RegB
	SUBWF	REMAIN+1,W	;compare high bytes
	BTFSS	STATUS,Z	;skip if equal
	 GOTO	DIV15		; else branch if not equal
	MOVF	RegB,W		;compare low bytes
	SUBWF	REMAIN,W
DIV15
	BTFSS	STATUS,C	;skip if REMAIN >= RegB (carry is set)
	 GOTO	DIV20		; otherwise branch (carry is clear)

	MOVF	RegB,W		;REMAIN:= REMAIN - RegB
	SUBWF	REMAIN		;subtract low bytes
	MOVF	RegB+1,W	;get ready to subtract high bytes
	BTFSS	STATUS,C	;skip if there was no borrow from high byte
	 INCFSZ	RegB+1,W	; else increase amount to subtract by 1; if it's
	 SUBWF	REMAIN+1	; 0 then high byte doesn't change, carry is set
DIV20
	RLF	RegA		;shift carry bit into quotient
	RLF	RegA+1
	DECFSZ	RegX		;loop until done (don't disturb carry)
	 GOTO	DIV10
	RETP

;===============================================================================
;                        INTERRUPT SERVICE ROUTINE
;===============================================================================
;
ISRX	MOVLW	-100		;interrupt every 100 RTCC cycles
	RETIW

;NOTE: If code is added, PROGLO will move, and RUN.CMD might need to be changed.

;===============================================================================
;				    I2L CODE
;===============================================================================

	ERRORLEVEL	-306	;don't display "crossing page boundary" message
	ORG	($+1)&0FFEh	;this must agree with loc used by SXLODI2L.XPL
				; and it must be even because of FETCOM

;-------------------------------------------------------------------------------
;Example showing how an XPL0 program is compiled into .I2L code and how the
; loader converts it to DATA instructions.
;
;XPL0 program:
;	loop Text(0, "Hello World! ");
;
;I2L code (with commentary added):
;	;0000 0905	HPI 5		reserve space for global 0 (a real)
;	      41	IMM 0		push device 0
;	      26*0000	JSR		push address of string and jump over it
;	;0006 48656C6C6F20576F726C642120	"Hello World! "
;	;0012 A0			terminator (space char with MSB set)
;	;0013
;	^0004				fix JSR address to jump here
;	      0C0C	CML Text	call intrinsic routine to output string
;	      2313	BRA loop	branch back
;	$				end-of-file marker
;
;I2L code converted to (unpacked) DATA instructions by SXLODI2L:
;
;PROGLO	EQU	$
;	DATA	09h, 05h
;	DATA	41h
;	DATA	26h
;	DATA	13h+low PROGLO, 00h+high PROGLO
;	DATA	'H'
;	DATA	'e'
;	DATA	'l'
;	DATA	'l'
;	DATA	'o'
;	DATA	' '
;	DATA	'W'
;	DATA	'o'
;	DATA	'r'
;	DATA	'l'
;	DATA	'd'
;	DATA	'!'
;	DATA	' '|80h
;	DATA	0Ch, 0Ch
;	DATA	23h, 13h
;
;	ORG	7FFh
;	GOTO	RESET
;	END
;-------------------------------------------------------------------------------