please dont rip this site

Scenix XPL0 I2L.ASM

; *** 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
;-------------------------------------------------------------------------------


file: /Techref/scenix/xpl0/I2L.ASM, 76KB, , updated: 2000/5/12 18:20, local time: 2024/3/29 01:37,
TOP NEW HELP FIND: 
18.212.242.203:LOG IN

 ©2024 These pages are served without commercial sponsorship. (No popup ads, etc...).Bandwidth abuse increases hosting cost forcing sponsorship or shutdown. This server aggressively defends against automated copying for any reason including offline viewing, duplication, etc... Please respect this requirement and DO NOT RIP THIS SITE. Questions?
Please DO link to this page! Digg it! / MAKE!

<A HREF="http://massmind.org/Techref/scenix/xpl0/I2L.ASM"> scenix xpl0 I2L</A>

Did you find what you needed?

 

Welcome to massmind.org!

 

Welcome to massmind.org!

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

  .