; *** 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/10/10 10:55,
44.220.251.236: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! |
.