; *** 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 17:20, local time: 2024/11/8 16:23,
18.118.152.100:LOG IN ©2024 PLEASE DON'T RIP! THIS SITE CLOSES OCT 28, 2024 SO LONG AND THANKS FOR ALL THE FISH!
|
| ©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? <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! |
.