Blame |
Last modification |
View Log
| Download
| RSS feed
| ?url?
; December 18, 1986
; MS-DOS compatible Source code for MCS BASIC-52 (tm)
; Assembles with ASM51 Macro Assembler Version 2.2
;
; The following source code does not include the floating point math
; routines. These are seperately compiled using FP52.SRC.
;
; Both the BASIC.SRC and FP52.SRC programs assemble into ABSOLUTE
; object files, and do not need to be relocated or linked. The FP52
; object code and the BASIC object code, when compiled without modification
; of the source listings, create the same object code that is found on
; the MCS BASIC-52 Version 1.1 microcontrollers.
;
; The original source code had 7 "include" files that have been incorporated
; into this file for ease of assembly.
; These 7 files are: LOOK52.SRC, BAS52.RST, BAS52.PGM, BAS52.TL, BAS52.OUT,
; BAS52.PWM, and BAS52.CLK.
;
;
; Intel Corporation, Embedded Controller Operations
cpu 8052
page 0
newpage
include stddef51.inc
include bitfuncs.inc
bigendian on
segment code
;**************************************************************
;
; TRAP VECTORS TO MONITOR
;
; RESET TAG (0AAH) ---------2001H
;
; TAG LOCATION (5AH) ------ 2002H
;
; EXTERNAL INTERRUPT 0 ---- 2040H
;
; COMMAND MODE ENTRY ------ 2048H
;
; SERIAL PORT ------------- 2050H
;
; MONITOR (BUBBLE) OUTPUT - 2058H
;
; MONITOR (BUBBLE) INPUT -- 2060H
;
; MONITOR (BUBBLE) CSTS --- 2068H
;
; GET USER JUMP VECTOR ---- 2070H
;
; GET USER LOOKUP VECTOR -- 2078H
;
; PRINT AT VECTOR --------- 2080H
;
; INTERRUPT PWM ----------- 2088H
;
; EXTERNAL RESET ---------- 2090H
;
; USER OUTPUT-------------- 4030H
;
; USER INPUT -------------- 4033H
;
; USER CSTS --------------- 4036H
;
; USER RESET -------------- 4039H
;
; USER DEFINED PRINT @ --- 403CH
;
;***************************************************************
;
newpage
;***************************************************************
;
; MCS - 51 - 8K BASIC VERSION 1.1
;
;***************************************************************
;
AJMP CRST ;START THE PROGRAM
db 037h ; ******AA inserted
;
ORG 3H
;
;***************************************************************
;
;EXTERNAL INTERRUPT 0
;
;***************************************************************
;
JB DRQ,STQ ;SEE IF DMA IS SET
PUSH PSW ;SAVE THE STATUS
LJMP 4003H ;JUMP TO USER IF NOT SET
;
ORG 0BH
;
;***************************************************************
;
;TIMER 0 OVERFLOW INTERRUPT
;
;***************************************************************
;
PUSH PSW ;SAVE THE STATUS
JB C_BIT,STJ ;SEE IF USER WANTS INTERRUPT
LJMP 400BH ;EXIT IF USER WANTS INTERRUPTS
;
ORG 13H
;
;***************************************************************
;
;EXTERNAL INTERRUPT 1
;
;***************************************************************
;
JB INTBIT,STK
PUSH PSW
LJMP 4013H
;
newpage
;
ORG 1BH
;
;***************************************************************
;
;TIMER 1 OVERFLOW INTERRUPT
;
;***************************************************************
;
PUSH PSW
LJMP CKS_I
;
STJ: LJMP I_DR ;DO THE INTERRUPT
;
;***************************************************************
;
;SERIAL PORT INTERRUPT
;
;***************************************************************
;
ORG 23H
;
PUSH PSW
JB SPINT,STU ;SEE IF MONITOR EANTS INTERRUPT
LJMP 4023H
;
ORG 2BH
;
;**************************************************************
;
;TIMER 2 OVERFLOW INTERRUPT
;
;**************************************************************
;
PUSH PSW
LJMP 402BH
;
newpage
;**************************************************************
;
;USER ENTRY
;
;**************************************************************
;
ORG 30H
;
LJMP IBLK ;LINK TO USER BLOCK
;
STQ: JB I_T0,STS ;SEE IF MONITOR WANTS IT
CLR DACK
JNB P3.2,$ ;WAIT FOR DMA TO END
SETB DACK
RETI
;
STS: LJMP 2040H ;GO TO THE MONITOR
;
STK: SETB INTPEN ;TELL BASIC AN INTERRUPT WAS RECEIVED
RETI
;
STU: LJMP 2050H ;SERIAL PORT INTERRUPT
;
newpage
include look52.inc ; ******AA
EIG: DB "EXTRA IGNORED",'"'
;
EXA: DB "A-STACK",'"'
;
EXC: DB "C-STACK",'"'
;
newpage
include bas52.rst ; ******AA
newpage
;***************************************************************
;
; CIPROG AND CPROG - Program a prom
;
;***************************************************************
;
include bas52.pgm ; ******AA
newpage
;**************************************************************
;
PGU: ;PROGRAM A PROM FOR THE USER
;
;**************************************************************
;
CLR PROMV ;TURN ON THE VOLTAGE
MOV PSW,#00011000B ;SELECT RB3
ACALL PG1 ;DO IT
SETB PROMV ;TURN IT OFF
RET
;
;
;*************************************************************
;
CCAL: ; Set up for prom moves
; R3:R1 gets source
; R7:R6 gets # of bytes
;
;*************************************************************
;
ACALL GETEND ;GET THE LAST LOCATION
INC DPTR ;BUMP TO LOAD EOF
MOV R3,BOFAH
MOV R1,BOFAL ;RESTORE START
CLR C ;PREPARE FOR SUBB
MOV A,DPL ;SUB DPTR - BOFA > R7:R6
SUBB A,R1
MOV R6,A
MOV A,DPH
SUBB A,R3
MOV R7,A
RET
;
;
include bas52.tl ; ******AA
newpage
;***************************************************************
;
CROM: ; The command action routine - ROM - Run out of rom
;
;***************************************************************
;
CLR CONB ;CAN'T CONTINUE IF MODE CHANGE
ACALL RO1 ;DO IT
;
C_K: LJMP CL3 ;EXIT
;
RO1: LCALL DELTST ;SEE IF INTGER PRESENT ******AA CALL-->LCALL, INTGER-->DELTST
MOV R4,#R1B0 ;SAVE THE NUMBER ******AA ABS-->IMM, R0B0-->R0B1 ?!?
JNC $+6 ; ******AA $+4-->$+6 ???
;MOV R4,#01H ;ONE IF NO INTEGER PRESENT ******AA repl. by next two
LCALL ONE ; ******AA
MOV R4,A ; ******AA
ACALL ROMFD ;FIND THE PROGRAM
CJNE R4,#0,RFX ;EXIT IF R4 <> 0
INC DPTR ;BUMP PAST TAG
MOV BOFAH,DPH ;SAVE THE ADDRESS
MOV BOFAL,DPL
RET
;
ROMFD: MOV DPTR,#ROMADR+16 ;START OF USER PROGRAM
;
RF1: MOVX A,@DPTR ;GET THE BYTE
CJNE A,#55H,RF3 ;SEE IF PROPER TAG
DJNZ R4,RF2 ;BUMP COUNTER
;
RFX: RET ;DPTR HAS THE START ADDRESS
;
RF2: INC DPTR ;BUMP PAST TAG
ACALL G5
INC DPTR ;BUMP TO NEXT PROGRAM
SJMP RF1 ;DO IT AGAIN
;
RF3: JBC INBIT,RFX ;EXIT IF SET
;
NOGO: MOV DPTR,#NOROM
AJMP ERRLK
;
newpage
;***************************************************************
;
L20DPI: ; load R2:R0 with the location the DPTR is pointing to
;
;***************************************************************
;
MOVX A,@DPTR
MOV R2,A
INC DPTR
MOVX A,@DPTR
MOV R0,A
RET ;DON'T BUMP DPTR
;
;***************************************************************
;
X31DP: ; swap R3:R1 with DPTR
;
;***************************************************************
;
XCH A,R3
XCH A,DPH
XCH A,R3
XCH A,R1
XCH A,DPL
XCH A,R1
RET
;
;***************************************************************
;
LD_T: ; Load the timer save location with the value the DPTR is
; pointing to.
;
;****************************************************************
;
MOVX A,@DPTR
MOV T_HH,A
INC DPTR
MOVX A,@DPTR
MOV T_LL,A
RET
;
newpage
;
;***************************************************************
;
;GETLIN - FIND THE LOCATION OF THE LINE NUMBER IN R3:R1
; IF ACC = 0 THE LINE WAS NOT FOUND I.E. R3:R1
; WAS TOO BIG, ELSE ACC <> 0 AND THE DPTR POINTS
; AT THE LINE THAT IS GREATER THAN OR EQUAL TO THE
; VALUE IN R3:R1.
;
;***************************************************************
;
GETEND: SETB ENDBIT ;GET THE END OF THE PROGRAM
;
GETLIN: LCALL DP_B ;GET BEGINNING ADDRESS ******AA CALL-->LCALL
;
G1: LCALL B_C ; ******AA CALL-->LCALL
JZ G3 ;EXIT WITH A ZERO IN A IF AT END
INC DPTR ;POINT AT THE LINE NUMBER
JB ENDBIT,G2 ;SEE IF WE WANT TO FIND THE END
ACALL DCMPX ;SEE IF (DPTR) = R3:R1
ACALL DECDP ;POINT AT LINE COUNT
MOVX A,@DPTR ;PUT LINE LENGTH INTO ACC
JB UBIT,G3 ;EXIT IF EQUAL
JC G3 ;SEE IF LESS THAN OR ZERO
;
G2: ACALL ADDPTR ;ADD IT TO DPTR
SJMP G1 ;LOOP
;
G3: CLR ENDBIT ;RESET ENDBIT
RET ;EXIT
;
G4: MOV DPTR,#PSTART ;DO RAM
;
G5: SETB ENDBIT
SJMP G1 ;NOW DO TEST
;
newpage
;***************************************************************
;
; LDPTRI - Load the DATA POINTER with the value it is pointing
; to - DPH = (DPTR) , DPL = (DPTR+1)
;
; acc gets wasted
;
;***************************************************************
;
LDPTRI: MOVX A,@DPTR ;GET THE HIGH BYTE
PUSH ACC ;SAVE IT
INC DPTR ;BUMP THE POINTER
MOVX A,@DPTR ;GET THE LOW BYTE
MOV DPL,A ;PUT IT IN DPL
POP DPH ;GET THE HIGH BYTE
RET ;GO BACK
;
;***************************************************************
;
;L31DPI - LOAD R3 WITH (DPTR) AND R1 WITH (DPTR+1)
;
;ACC GETS CLOBBERED
;
;***************************************************************
;
L31DPI: MOVX A,@DPTR ;GET THE HIGH BYTE
MOV R3,A ;PUT IT IN THE REG
INC DPTR ;BUMP THE POINTER
MOVX A,@DPTR ;GET THE NEXT BYTE
MOV R1,A ;SAVE IT
RET
;
;***************************************************************
;
;DECDP - DECREMENT THE DATA POINTER - USED TO SAVE SPACE
;
;***************************************************************
;
DECDP2: ACALL DECDP
;
DECDP: XCH A,DPL ;GET DPL
JNZ $+4 ;BUMP IF ZERO
DEC DPH
DEC A ;DECREMENT IT
XCH A,DPL ;GET A BACK
RET ;EXIT
;
newpage
;***************************************************************
;
;DCMPX - DOUBLE COMPARE - COMPARE (DPTR) TO R3:R1
;R3:R1 - (DPTR) = SET CARRY FLAG
;
;IF R3:R1 > (DPTR) THEN C = 0
;IF R3:R1 < (DPTR) THEN C = 1
;IF R3:R1 = (DPTR) THEN C = 0
;
;***************************************************************
;
DCMPX: CLR UBIT ;ASSUME NOT EQUAL
MOVX A,@DPTR ;GET THE BYTE
CJNE A,R3B0,D1 ;IF A IS GREATER THAN R3 THEN NO CARRY
;WHICH IS R3<@DPTR = NO CARRY AND
;R3>@DPTR CARRY IS SET
INC DPTR ;BUMP THE DATA POINTER
MOVX A,@DPTR ;GET THE BYTE
ACALL DECDP ;PUT DPTR BACK
CJNE A,R1B0,D1 ;DO THE COMPARE
CPL C ;FLIP CARRY
;
CPL UBIT ;SET IT
D1: CPL C ;GET THE CARRY RIGHT
RET ;EXIT
;
;***************************************************************
;
; ADDPTR - Add acc to the dptr
;
; acc gets wasted
;
;***************************************************************
;
ADDPTR: ADD A,DPL ;ADD THE ACC TO DPL
MOV DPL,A ;PUT IT IN DPL
JNC $+4 ;JUMP IF NO CARRY
INC DPH ;BUMP DPH
RET ;EXIT
;
newpage
;*************************************************************
;
LCLR: ; Set up the storage allocation
;
;*************************************************************
;
ACALL ICLR ;CLEAR THE INTERRUPTS
ACALL G4 ;PUT END ADDRESS INTO DPTR
MOV A,#6 ;ADJUST MATRIX SPACE
ACALL ADDPTR ;ADD FOR PROPER BOUNDS
ACALL X31DP ;PUT MATRIX BOUNDS IN R3:R1
MOV DPTR,#MT_ALL ;SAVE R3:R1 IN MATRIX FREE SPACE
ACALL S31DP ;DPTR POINTS TO MEMTOP
ACALL L31DPI ;LOAD MEMTOP INTO R3:R1
MOV DPTR,#STR_AL ;GET MEMORY ALLOCATED FOR STRINGS
ACALL LDPTRI
LCALL DUBSUB ;R3:R1 = MEMTOP - STRING ALLOCATION ******AA CALL-->LCALL
MOV DPTR,#VARTOP ;SAVE R3:R1 IN VARTOP
;
; FALL THRU TO S31DP2
;
;***************************************************************
;
;S31DP - STORE R3 INTO (DPTR) AND R1 INTO (DPTR+1)
;
;ACC GETS CLOBBERED
;
;***************************************************************
;
S31DP2: ACALL S31DP ;DO IT TWICE
;
S31DP: MOV A,R3 ;GET R3 INTO ACC
MOVX @DPTR,A ;STORE IT
INC DPTR ;BUMP DPTR
MOV A,R1 ;GET R1
MOVX @DPTR,A ;STORE IT
INC DPTR ;BUMP IT AGAIN TO SAVE PROGRAM SPACE
RET ;GO BACK
;
;
;***************************************************************
;
STRING: ; Allocate memory for strings
;
;***************************************************************
;
LCALL TWO ;R3:R1 = NUMBER, R2:R0 = LEN
MOV DPTR,#STR_AL ;SAVE STRING ALLOCATION
ACALL S31DP
INC R6 ;BUMP
MOV S_LEN,R6 ;SAVE STRING LENGTH
AJMP RCLEAR ;CLEAR AND SET IT UP
;
newpage
;***************************************************************
;
; F_VAR - Find the variable in symbol table
; R7:R6 contain the variable name
; If not found create a zero entry and set the carry
; R2:R0 has the address of variable on return
;
;***************************************************************
;
F_VAR: MOV DPTR,#VARTOP ;PUT VARTOP IN DPTR
ACALL LDPTRI
ACALL DECDP2 ;ADJUST DPTR FOR LOOKUP
;
F_VAR0: MOVX A,@DPTR ;LOAD THE VARIABLE
JZ F_VAR2 ;TEST IF AT THE END OF THE TABLE
INC DPTR ;BUMP FOR NEXT BYTE
CJNE A,R7B0,F_VAR1 ;SEE IF MATCH
MOVX A,@DPTR ;LOAD THE NAME
CJNE A,R6B0,F_VAR1
;
; Found the variable now adjust and put in R2:R0
;
DLD: MOV A,DPL ;R2:R0 = DPTR-2
SUBB A,#2
MOV R0,A
MOV A,DPH
SUBB A,#0 ;CARRY IS CLEARED
MOV R2,A
RET
;
F_VAR1: MOV A,DPL ;SUBTRACT THE STACK SIZE+ADJUST
CLR C
SUBB A,#STESIZ
MOV DPL,A ;RESTORE DPL
JNC F_VAR0
DEC DPH
SJMP F_VAR0 ;CONTINUE COMPARE
;
newpage
;
; Add the entry to the symbol table
;
F_VAR2: LCALL R76S ;SAVE R7 AND R6
CLR C
ACALL DLD ;BUMP THE POINTER TO GET ENTRY ADDRESS
;
; Adjust pointer and save storage allocation
; and make sure we aren't wiping anything out
; First calculate new storage allocation
;
MOV A,R0
SUBB A,#STESIZ-3 ;NEED THIS MUCH RAM
MOV R1,A
MOV A,R2
SUBB A,#0
MOV R3,A
;
; Now save the new storage allocation
;
MOV DPTR,#ST_ALL
CALL S31DP ;SAVE STORAGE ALLOCATION
;
; Now make sure we didn't blow it, by wiping out MT_ALL
;
ACALL DCMPX ;COMPARE STORAGE ALLOCATION
JC CCLR3 ;ERROR IF CARRY
SETB C ;DID NOT FIND ENTRY
RET ;EXIT IF TEST IS OK
;
newpage
;***************************************************************
;
; Command action routine - NEW
;
;***************************************************************
;
CNEW: MOV DPTR,#PSTART ;SAVE THE START OF PROGRAM
MOV A,#EOF ;END OF FILE
MOVX @DPTR,A ;PUT IT IN MEMORY
;
; falls thru
;
;*****************************************************************
;
; The statement action routine - CLEAR
;
;*****************************************************************
;
CLR LINEB ;SET UP FOR RUN AND GOTO
;
RCLEAR: ACALL LCLR ;CLEAR THE INTERRUPTS, SET UP MATRICES
MOV DPTR,#MEMTOP ;PUT MEMTOP IN R3:R1
ACALL L31DPI
ACALL G4 ;DPTR GETS END ADDRESS
ACALL CL_1 ;CLEAR THE MEMORY
;
RC1: MOV DPTR,#STACKTP ;POINT AT CONTROL STACK TOP
CLR A ;CONTROL UNDERFLOW
;
RC2: MOVX @DPTR,A ;SAVE IN MEMORY
MOV CSTKA,#STACKTP
MOV ASTKA,#STACKTP
CLR CONB ;CAN'T CONTINUE
RET
;
newpage
;***************************************************************
;
; Loop until the memory is cleared
;
;***************************************************************
;
CL_1: INC DPTR ;BUMP MEMORY POINTER
CLR A ;CLEAR THE MEMORY
MOVX @DPTR,A ;CLEAR THE RAM
MOVX A,@DPTR ;READ IT
JNZ CCLR3 ;MAKE SURE IT IS CLEARED
MOV A,R3 ;GET POINTER FOR COMPARE
CJNE A,DPH,CL_1 ;SEE TO LOOP
MOV A,R1 ;NOW TEST LOW BYTE
CJNE A,DPL,CL_1
;
CL_2: RET
;
CCLR3: LJMP TB ;ALLOCATED MEMORY DOESN'T EXSIST ******AA JMP-->LJMP
;
;**************************************************************
;
SCLR: ;Entry point for clear return
;
;**************************************************************
;
LCALL DELTST ;TEST FOR A CR ******AA CALL-->LCALL
JNC RCLEAR
LCALL GCI1 ;BUMP THE TEST POINTER ******AA CALL-->LCALL
CJNE A,#'I',RC1 ;SEE IF I, ELSE RESET THE STACK
;
;**************************************************************
;
ICLR: ; Clear interrupts and system garbage
;
;**************************************************************
;
JNB INTBIT,$+5 ;SEE IF BASIC HAS INTERRUPTS
CLR EX1 ;IF SO, CLEAR INTERRUPTS
ANL 34,#00100000B ;SET INTERRUPTS + CONTINUE
RETI
;
newpage
;***************************************************************
;
;OUTPUT ROUTINES
;
;***************************************************************
;
CRLF2: ACALL CRLF ;DO TWO CRLF'S
;
CRLF: MOV R5,#CR ;LOAD THE CR
ACALL TEROT ;CALL TERMINAL OUT
MOV R5,#LF ;LOAD THE LF
AJMP TEROT ;OUTPUT IT AND RETURN
;
;PRINT THE MESSAGE ADDRESSED IN ROM OR RAM BY THE DPTR
;ENDS WITH THE CHARACTER IN R4
;DPTR HAS THE ADDRESS OF THE TERMINATOR
;
CRP: ACALL CRLF ;DO A CR THEN PRINT ROM
;
ROM_P: CLR A ;CLEAR A FOR LOOKUP
MOVC A,@A+DPTR ;GET THE CHARACTER
CLR ACC.7 ;CLEAR MS BIT
CJNE A,#'"',$+4 ;EXIT IF TERMINATOR
RET
SETB C0ORX1
;
PN1: MOV R5,A ;OUTPUT THE CHARACTER
ACALL TEROT
INC DPTR ;BUMP THE POINTER
SJMP PN0
;
UPRNT: ACALL X31DP
;
PRNTCR: MOV R4,#CR ;OUTPUT UNTIL A CR
;
PN0: JBC C0ORX1,ROM_P
MOVX A,@DPTR ;GET THE RAM BYTE
JZ $+5
CJNE A,R4B0,$+4 ;SEE IF THE SAME AS TERMINATOR
RET ;EXIT IF THE SAME
CJNE A,#CR,PN1 ;NEVER PRINT A CR IN THIS ROUTINE
LJMP E1XX ;BAD SYNTAX
;
newpage
;***************************************************************
;
; INLINE - Input a line to IBUF, exit when a CR is received
;
;***************************************************************
;
INL2: CJNE A,#CNTRLD,INL2B ;SEE IF A CONTROL D
;
INL0: ACALL CRLF ;DO A CR
;
INLINE: MOV P2,#HI(IBUF) ;IBUF IS IN THE ZERO PAGE
MOV R0,#LO(IBUF) ;POINT AT THE INPUT BUFFER
;
INL1: ACALL INCHAR ;GET A CHARACTER
MOV R5,A ;SAVE IN R5 FOR OUTPUT
CJNE A,#7FH,INL2 ;SEE IF A DELETE CHARACTER
CJNE R0,#LO(IBUF),INL6
MOV R5,#BELL ;OUTPUT A BELL
;
INLX: ACALL TEROT ;OUTPUT CHARACTER
SJMP INL1 ;DO IT AGAIN
;
INL2B: MOVX @R0,A ;SAVE THE CHARACTER
CJNE A,#CR,$+5 ;IS IT A CR
AJMP CRLF ;OUTPUT A CRLF AND EXIT
CJNE A,#20H,$+3
JC INLX ;ONLY ECHO CONTROL CHARACTERS
INC R0 ;BUMP THE POINTER
CJNE R0,#IBUF+79,INLX
DEC R0 ;FORCE 79
SJMP INLX-2 ;OUTPUT A BELL
;
INL6: DEC R0 ;DEC THE RAM POINTER
MOV R5,#BS ;OUTPUT A BACK SPACE
ACALL TEROT
ACALL STEROT ;OUTPUT A SPACE
MOV R5,#BS ;ANOTHER BACK SPACE
SJMP INLX ;OUTPUT IT
;
PTIME: DB 128-2 ; PROM PROGRAMMER TIMER
DB 00H
DB 00H
DB 50H
DB 67H
DB 41H
;
newpage
include bas52.out ; ******AA
;
BCK: ACALL CSTS ;CHECK STATUS
JNC CI_RET+1 ;EXIT IF NO CHARACTER
;
newpage
;***************************************************************
;
;INPUTS A CHARACTER FROM THE SYSTEM CONSOLE.
;
;***************************************************************
;
INCHAR: JNB BI,$+8 ;CHECK FOR MONITOR (BUBBLE)
LCALL 2060H
SJMP INCH1
JNB CIUB,$+8 ;CHECK FOR USER
LCALL 4033H
SJMP INCH1
JNB RI,$ ;WAIT FOR RECEIVER READY.
MOV A,SBUF
CLR RI ;RESET READY
CLR ACC.7 ;NO BIT 7
;
INCH1: CJNE A,#13H,$+5
SETB CNT_S
CJNE A,#11H,$+5
CLR CNT_S
CJNE A,#CNTRLC,$+7
JNB NO_C,C_EX ;TRAP NO CONTROL C
RET
;
CLR JKBIT
CJNE A,#17H,CI_RET ;CONTROL W
SETB JKBIT
;
CI_RET: SETB C ;CARRY SET IF A CHARACTER
RET ;EXIT
;
;*************************************************************
;
;RROM - The Statement Action Routine RROM
;
;*************************************************************
;
RROM: SETB INBIT ;SO NO ERRORS
ACALL RO1 ;FIND THE LINE NUMBER
JBC INBIT,CRUN
RET ;EXIT
;
newpage
;***************************************************************
;
CSTS: ; RETURNS CARRY = 1 IF THERE IS A CHARACTER WAITING FROM
; THE SYSTEM CONSOLE. IF NO CHARACTER THE READY CHARACTER
; WILL BE CLEARED
;
;***************************************************************
;
JNB BI,$+6 ;BUBBLE STATUS
LJMP 2068H
JNB CIUB,$+6 ;SEE IF EXTERNAL CONSOLE
LJMP 4036H
MOV C,RI
RET
;
MOV DPTR,#WB ;EGO MESSAGE
ACALL ROM_P
;
C_EX: CLR CNT_S ;NO OUTPUT STOP
LCALL SPRINT+4 ;ASSURE CONSOLE
ACALL CRLF
JBC JKBIT,C_EX-5
;
JNB DIRF,SSTOP0
AJMP C_K ;CLEAR COB AND EXIT
;
T_CMP: MOV A,TVH ;COMPARE TIMER TO SP_H AND SP_L
MOV R1,TVL
CJNE A,TVH,T_CMP
XCH A,R1
SUBB A,SP_L
MOV A,R1
SUBB A,SP_H
RET
;
;*************************************************************
;
BR0: ; Trap the timer interrupt
;
;*************************************************************
;
CALL T_CMP ;COMPARE TIMER
JC BCHR+6 ;EXIT IF TEST FAILS
SETB OTI ;DOING THE TIMER INTERRUPT
CLR OTS ;CLEAR TIMER BIT
MOV C,INPROG ;SAVE IN PROGRESS
MOV ISAV,C
MOV DPTR,#TIV
SJMP BR2
;
newpage
;***************************************************************
;
; The command action routine - RUN
;
;***************************************************************
;
CRUN: LCALL RCLEAR-2 ;CLEAR THE STORAGE ARRAYS
ACALL SRESTR+2 ;GET THE STARTING ADDRESS
ACALL B_C
JZ CMNDLK ;IF NULL GO TO COMMAND MODE
;
ACALL T_DP
ACALL B_TXA ;BUMP TO STARTING LINE
;
CILOOP: ACALL SP0 ;DO A CR AND A LF
CLR DIRF ;NOT IN DIRECT MODE
;
;INTERPERTER DRIVER
;
ILOOP: MOV SP,SPSAV ;RESTORE THE STACK EACH TIME
JB DIRF,$+9 ;NO INTERRUPTS IF IN DIRECT MODE
MOV INTXAH,TXAH ;SAVE THE TEXT POINTER
MOV INTXAL,TXAL
LCALL BCK ;GET CONSOLE STATUS
JB DIRF,I_L ;DIRECT MODE
ANL C,/GTRD ;SEE IF CHARACTER READY
JNC BCHR ;NO CHARACTER = NO CARRY
;
; DO TRAP OPERATION
;
MOV DPTR,#GTB ;SAVE TRAP CHARACTER
MOVX @DPTR,A
SETB GTRD ;SAYS READ A BYTE
;
BCHR: JB OTI,I_L ;EXIT IF TIMER INTERRUPT IN PROGRESS
JB OTS,BR0 ;TEST TIMER VALUE IF SET
JNB INTPEN,I_L ;SEE IF INTERRUPT PENDING
JB INPROG,I_L ;DON'T DO IT AGAIN IF IN PROGRESS
MOV DPTR,#INTLOC ;POINT AT INTERRUPT LOCATION
;
BR2: MOV R4,#GTYPE ;SETUP FOR A FORCED GOSUB
ACALL SGS1 ;PUT TXA ON STACK
SETB INPROG ;INTERRUPT IN PROGRESS
;
ERL4: CALL L20DPI
AJMP D_L1 ;GET THE LINE NUMBER
;
I_L: ACALL ISTAT ;LOOP
ACALL CLN_UP ;FINISH IT OFF
JNC ILOOP ;LOOP ON THE DRIVER
JNB DIRF,CMNDLK ;CMND1 IF IN RUN MODE
LJMP CMNDR ;DON'T PRINT READY
;
CMNDLK: LJMP CMND1 ;DONE ******AA JMP-->LJMP
newpage
;**************************************************************
;
; The Statement Action Routine - STOP
;
;**************************************************************
;
SSTOP: ACALL CLN_UP ;FINISH OFF THIS LINE
MOV INTXAH,TXAH ;SAVE TEXT POINTER FOR CONT
MOV INTXAL,TXAL
;
SSTOP0: SETB CONB ;CONTINUE WILL WORK
MOV DPTR,#STP ;PRINT THE STOP MESSAGE
SETB STOPBIT ;SET FOR ERROR ROUTINE
LJMP ERRS ;JUMP TO ERROR ROUTINE ******AA JMP-->LJMP
;
newpage
;**************************************************************
;
; ITRAP - Trap special function register operators
;
;**************************************************************
;
ITRAP: CJNE A,#TMR0,$+8 ;TIMER 0
MOV TH0,R3
MOV TL0,R1
RET
;
CJNE A,#TMR1,$+8 ;TIMER 1
MOV TH1,R3
MOV TL1,R1
RET
;
CJNE A,#TMR2,$+8 ;TIMER 2
DB 8BH ;MOV R3 DIRECT OP CODE
DB 0CDH ;T2H LOCATION
DB 89H ;MOV R1 DIRECT OP CODE
DB 0CCH ;T2L LOCATION
RET
;
CJNE A,#TRC2,$+8 ;RCAP2 TOKEN
RCL: DB 8BH ;MOV R3 DIRECT OP CODE
DB 0CBH ;RCAP2H LOCATION
DB 89H ;MOV R1 DIRECT OP CODE
DB 0CAH ;RCAP2L LOCATION
RET
;
ACALL R3CK ;MAKE SURE THAT R3 IS ZERO
CJNE A,#TT2C,$+6
DB 89H ;MOV R1 DIRECT OP CODE
DB 0C8H ;T2CON LOCATION
RET
;
CJNE A,#T_IE,$+6 ;IE TOKEN
MOV IE,R1
RET
;
CJNE A,#T_IP,$+6 ;IP TOKEN
MOV IP,R1
RET
;
CJNE A,#TTC,$+6 ;TCON TOKEN
MOV TCON,R1
RET
;
CJNE A,#TTM,$+6 ;TMOD TOKEN
MOV TMOD,R1
RET
;
CJNE A,#T_P1,T_T2 ;P1 TOKEN
MOV P1,R1
RET
;
;***************************************************************
;
; T_TRAP - Trap special operators
;
;***************************************************************
;
T_T: MOV TEMP5,A ;SAVE THE TOKEN
ACALL GCI1 ;BUMP POINTER
ACALL SLET2 ;EVALUATE AFTER =
MOV A,TEMP5 ;GET THE TOKEN BACK
CJNE A,#T_XTAL,$+6
LJMP AXTAL1 ;SET UP CRYSTAL
;
ACALL IFIXL ;R3:R1 HAS THE TOS
MOV A,TEMP5 ;GET THE TOKEN AGAIN
CJNE A,#T_MTOP,T_T1 ;SEE IF MTOP TOKEN
MOV DPTR,#MEMTOP
CALL S31DP
JMP RCLEAR ;CLEAR THE MEMORY
;
T_T1: CJNE A,#T_TIME,ITRAP ;SEE IF A TIME TOKEN
MOV C,EA ;SAVE INTERRUPTS
CLR EA ;NO TIMER 0 INTERRUPTS DURING LOAD
MOV TVH,R3 ;SAVE THE TIME
MOV TVL,R1
MOV EA,C ;RESTORE INTERRUPTS
RET ;EXIT
;
T_T2: CJNE A,#T_PC,INTERX ;PCON TOKEN
DB 89H ;MOV DIRECT, R1 OP CODE
DB 87H ;ADDRESS OF PCON
RET ;EXIT
;
T_TRAP: CJNE A,#T_ASC,T_T ;SEE IF ASC TOKEN
ACALL IGC ;EAT IT AND GET THE NEXT CHARACTER
CJNE A,#'$',INTERX ;ERROR IF NOT A STRING
ACALL CSY ;CALCULATE ADDRESS
ACALL X3120
LCALL TWO_EY ; ******AA CALL-->LCALL
ACALL SPEOP+4 ;EVALUATE AFTER EQUALS
AJMP ISTAX1 ;SAVE THE CHARACTER
;
newpage
;**************************************************************
;
;INTERPERT THE STATEMENT POINTED TO BY TXAL AND TXAH
;
;**************************************************************
;
ISTAT: ACALL GC ;GET THR FIRST CHARACTER
JNB XBIT,IAT ;TRAP TO EXTERNAL RUN PACKAGE
CJNE A,#20H,$+3
JNC IAT
LCALL 2070H ;LET THE USER SET UP THE DPTR
ACALL GCI1
ANL A,#0FH ;STRIP OFF BIAS
SJMP ISTA1
;
IAT: CJNE A,#T_XTAL,$+3
JNC T_TRAP
JNB ACC.7,SLET ;IMPLIED LET IF BIT 7 NOT SET
CJNE A,#T_UOP+12,ISTAX ;DBYTE TOKEN
ACALL SPEOP ;EVALUATE SPECIAL OPERATOR
ACALL R3CK ;CHECK LOCATION
MOV @R1,A ;SAVE IT
RET
;
ISTAX: CJNE A,#T_UOP+13,ISTAY ;XBYTE TOKEN
ACALL SPEOP
;
ISTAX1: MOV P2,R3
MOVX @R1,A
RET
;
ISTAY: CJNE A,#T_CR+1,$+3 ;TRAP NEW OPERATORS
JC I_S
CJNE A,#0B0H,$+3 ;SEE IF TOO BIG
JNC INTERX
ADD A,#0F9H ;BIAS FOR LOOKUP TABLE
SJMP ISTA0 ;DO THE OPERATION
;
I_S: CJNE A,#T_LAST,$+3 ;MAKE SURE AN INITIAL RESERVED WORD
JC $+5 ;ERROR IF NOT
;
INTERX: LJMP E1XX ;SYNTAX ERROR
;
JNB DIRF,ISTA0 ;EXECUTE ALL STATEMENTS IF IN RUN MODE
CJNE A,#T_DIR,$+3 ;SEE IF ON TOKEN
JC ISTA0 ;OK IF DIRECT
CJNE A,#T_GOSB+1,$+5 ;SEE IF FOR
SJMP ISTA0 ;FOR IS OK
CJNE A,#T_REM+1,$+5 ;NEXT IS OK
SJMP ISTA0
CJNE A,#T_STOP+6,INTERX ;SO IS REM
;
newpage
ISTA0: ACALL GCI1 ;ADVANCE THE TEXT POINTER
MOV DPTR,#STATD ;POINT DPTR TO LOOKUP TABLE
CJNE A,#T_GOTO-3,$+5 ;SEE IF LET TOKEN
SJMP ISTAT ;WASTE LET TOKEN
ANL A,#3FH ;STRIP OFF THE GARBAGE
;
ISTA1: RL A ;ROTATE FOR OFFSET
ADD A,DPL ;BUMP
MOV DPL,A ;SAVE IT
CLR A
MOVC A,@A+DPTR ;GET HIGH BYTE
PUSH ACC ;SAVE IT
INC DPTR
CLR A
MOVC A,@A+DPTR ;GET LOW BYTE
POP DPH
MOV DPL,A
;
AC1: CLR A
JMP @A+DPTR ;GO DO IT
;
newpage
;***************************************************************
;
; The statement action routine - LET
;
;***************************************************************
;
SLET: ACALL S_C ;CHECK FOR POSSIBLE STRING
JC SLET0 ;NO STRING
CLR LINEB ;USED STRINGS
;
CALL X31DP ;PUT ADDRESS IN DPTR
MOV R7,#T_EQU ;WASTE =
ACALL EATC
ACALL GC ;GET THE NEXT CHARACTER
CJNE A,#'"',S_3 ;CHECK FOR A "
MOV R7,S_LEN ;GET THE STRING LENGTH
;
S_0: ACALL GCI1 ;BUMP PAST "
ACALL DELTST ;CHECK FOR DELIMITER
JZ INTERX ;EXIT IF CARRIAGE RETURN
MOVX @DPTR,A ;SAVE THE CHARACTER
CJNE A,#'"',S_1 ;SEE IF DONE
;
S_E: MOV A,#CR ;PUT A CR IN A
MOVX @DPTR,A ;SAVE CR
AJMP GCI1
;
S_3: PUSH DPH
PUSH DPL ;SAVE DESTINATION
ACALL S_C ;CALCULATE SOURCE
JC INTERX ;ERROR IF CARRY
POP R0B0 ;GET DESTINATION BACK
POP R2B0
;
SSOOP: MOV R7,S_LEN ;SET UP COUNTER
;
S_4: LCALL TBYTE ;TRANSFER THE BYTE ******AA CALL-->LCALL
CJNE A,#CR,$+4 ;EXIT IF A CR
RET
DJNZ R7,S_5 ;BUMP COUNTER
MOV A,#CR ;SAVE A CR
MOVX @R0,A
AJMP EIGP ;PRINT EXTRA IGNORED
;
newpage
;
S_5: CALL INC3210 ;BUMP POINTERS
SJMP S_4 ;LOOP
;
S_1: DJNZ R7,$+8 ;SEE IF DONE
ACALL S_E
ACALL EIGP ;PRINT EXTRA IGNORED
AJMP FINDCR ;GO FIND THE END
INC DPTR ;BUMP THE STORE POINTER
SJMP S_0 ;CONTINUE TO LOOP
;
E3XX: MOV DPTR,#E3X ;BAD ARG ERROR
AJMP EK
;
SLET0: ACALL SLET1
AJMP POPAS ;COPY EXPRESSION TO VARIABLE
;
SLET1: ACALL VAR_ER ;CHECK FOR A"VARIABLE"
;
SLET2: PUSH R2B0 ;SAVE THE VARIABLE ADDRESS
PUSH R0B0
MOV R7,#T_EQU ;GET EQUAL TOKEN
ACALL WE
POP R1B0 ;POP VARIABLE TO R3:R1
POP R3B0
RET ;EXIT
;
R3CK: CJNE R3,#00H,E3XX ;CHECK TO SEE IF R3 IS ZERO
RET
;
SPEOP: ACALL GCI1 ;BUMP TXA
ACALL P_E ;EVALUATE PAREN
ACALL SLET2 ;EVALUATE AFTER =
CALL TWOL ;R7:R6 GETS VALUE, R3:R1 GETS LOCATION
MOV A,R6 ;SAVE THE VALUE
;
CJNE R7,#00H,E3XX ;R2 MUST BE = 0
RET
;
newpage
;**************************************************************
;
; ST_CAL - Calculate string Address
;
;**************************************************************
;
IST_CAL:;
;
ACALL I_PI ;BUMP TEXT, THEN EVALUATE
ACALL R3CK ;ERROR IF R3 <> 0
INC R1 ;BUMP FOR OFFSET
MOV A,R1 ;ERROR IF R1 = 255
JZ E3XX
MOV DPTR,#VARTOP ;GET TOP OF VARIABLE STORAGE
MOV B,S_LEN ;MULTIPLY FOR LOCATION
ACALL VARD ;CALCULATE THE LOCATION
MOV DPTR,#MEMTOP ;SEE IF BLEW IT
CALL FUL1
MOV DPL,S_LEN ;GET STRING LENGTH, DPH = 00H
DEC DPH ;DPH = 0
;
DUBSUB: CLR C
MOV A,R1
SUBB A,DPL
MOV R1,A
MOV A,R3
SUBB A,DPH
MOV R3,A
ORL A,R1
RET
;
;***************************************************************
;
;VARD - Calculate the offset base
;
;***************************************************************
;
VARB: MOV B,#FPSIZ ;SET UP FOR OPERATION
;
VARD: CALL LDPTRI ;LOAD DPTR
MOV A,R1 ;MULTIPLY BASE
MUL AB
ADD A,DPL
MOV R1,A
MOV A,B
ADDC A,DPH
MOV R3,A
RET
;
newpage
;*************************************************************
;
CSY: ; Calculate a biased string address and put in R3:R1
;
;*************************************************************
;
ACALL IST_CAL ;CALCULATE IT
PUSH R3B0 ;SAVE IT
PUSH R1B0
MOV R7,#',' ;WASTE THE COMMA
ACALL EATC
ACALL ONE ;GET THE NEXT EXPRESSION
MOV A,R1 ;CHECK FOR BOUNDS
CJNE A,S_LEN,$+3
JNC E3XX ;MUST HAVE A CARRY
DEC R1 ;BIAS THE POINTER
POP ACC ;GET VALUE LOW
ADD A,R1 ;ADD IT TO BASE
MOV R1,A ;SAVE IT
POP R3B0 ;GET HIGH ADDRESS
JNC $+3 ;PROPAGATE THE CARRY
INC R3
AJMP ERPAR ;WASTE THE RIGHT PAREN
;
newpage
;***************************************************************
;
; The statement action routine FOR
;
;***************************************************************
;
SFOR: ACALL SLET1 ;SET UP CONTROL VARIABLE
PUSH R3B0 ;SAVE THE CONTROL VARIABLE LOCATION
PUSH R1B0
ACALL POPAS ;POP ARG STACK AND COPY CONTROL VAR
MOV R7,#T_TO ;GET TO TOKEN
ACALL WE
ACALL GC ;GET NEXT CHARACTER
CJNE A,#T_STEP,SF2
ACALL GCI1 ;EAT THE TOKEN
ACALL EXPRB ;EVALUATE EXPRESSION
SJMP $+5 ;JUMP OVER
;
SF2: LCALL PUSH_ONE ;PUT ONE ON THE STACK
;
MOV A,#-FSIZE ;ALLOCATE FSIZE BYTES ON THE CONTROL STACK
ACALL PUSHCS ;GET CS IN R0
ACALL CSC ;CHECK CONTROL STACK
MOV R3,#CSTKAH ;IN CONTROL STACK
MOV R1,R0B0 ;STACK ADDRESS
ACALL POPAS ;PUT STEP ON STACK
ACALL POPAS ;PUT LIMIT ON STACK
ACALL DP_T ;DPTR GETS TEXT
MOV R0,R1B0 ;GET THE POINTER
ACALL T_X_S ;SAVE THE TEXT
POP TXAL ;GET CONTROL VARIABLE
POP TXAH
MOV R4,#FTYPE ;AND THE TYPE
ACALL T_X_S ;SAVE IT
;
SF3: ACALL T_DP ;GET THE TEXT POINTER
AJMP ILOOP ;CONTINUE TO PROCESS
;
newpage
;**************************************************************
;
; The statement action routines - PUSH and POP
;
;**************************************************************
;
SPUSH: ACALL EXPRB ;PUT EXPRESSION ON STACK
ACALL C_TST ;SEE IF MORE TO DO
JNC SPUSH ;IF A COMMA PUSH ANOTHER
RET
;
;
SPOP: ACALL VAR_ER ;GET VARIABLE
ACALL XPOP ;FLIP THE REGISTERS FOR POPAS
ACALL C_TST ;SEE IF MORE TO DO
JNC SPOP
;
RET
;
;***************************************************************
;
; The statement action routine - IF
;
;***************************************************************
;
SIF: ACALL RTST ;EVALUATE THE EXPRESSION
MOV R1,A ;SAVE THE RESULT
ACALL GC ;GET THE CHARACTER AFTER EXPR
CJNE A,#T_THEN,$+5 ;SEE IF THEN TOKEN
ACALL GCI1 ;WASTE THEN TOKEN
CJNE R1,#0,T_F1 ;CHECK R_OP RESULT
;
E_FIND: MOV R7,#T_ELSE ;FIND ELSE TOKEN
ACALL FINDC
JZ SIF-1 ;EXIT IF A CR
ACALL GCI1 ;BUMP PAST TOKEN
CJNE A,#T_ELSE,E_FIND;WASTE IF NO ELSE
;
T_F1: ACALL INTGER ;SEE IF NUMBER
JNC D_L1 ;EXECUTE LINE NUMBER
AJMP ISTAT ;EXECUTE STATEMENT IN NOT
;
B_C: MOVX A,@DPTR
DEC A
JB ACC.7,FL3-5
RET
;
newpage
;***************************************************************
;
; The statement action routine - GOTO
;
;***************************************************************
;
SGOTO: ACALL RLINE ;R2:R0 AND DPTR GET INTGER
;
SGT1: ACALL T_DP ;TEXT POINTER GETS DPTR
;
JBC RETBIT,SGT2 ;SEE IF RETI EXECUTED
;
JNB LINEB,$+6 ;SEE IF A LINE WAS EDITED
LCALL RCLEAR-2 ;CLEAR THE MEMORY IF SET
AJMP ILOOP-2 ;CLEAR DIRF AND LOOP
;
SGT2: JBC OTI,$+8 ;SEE IF TIMER INTERRUPT
ANL 34,#10111101B ;CLEAR INTERRUPTS
AJMP ILOOP ;EXECUTE
MOV C,ISAV
MOV INPROG,C
AJMP ILOOP ;RESTORE INTERRUPTS AND RET
;
;
;*************************************************************
;
RTST: ; Test for ZERO
;
;*************************************************************
;
ACALL EXPRB ;EVALUATE EXPRESSION
CALL INC_ASTKA ;BUMP ARG STACK
JZ $+4 ;EXIT WITH ZERO OR 0FFH
MOV A,#0FFH
RET
;
newpage
;
;**************************************************************
;
; GLN - get the line number in R2:R0, return in DPTR
;
;**************************************************************
;
GLN: ACALL DP_B ;GET THE BEGINNING ADDRESS
;
FL1: MOVX A,@DPTR ;GET THE LENGTH
MOV R7,A ;SAVE THE LENGTH
DJNZ R7,FL3 ;SEE IF END OF FILE
;
MOV DPTR,#E10X ;NO LINE NUMBER
AJMP EK ;HANDLE THE ERROR
;
FL3: JB ACC.7,$-5 ;CHECK FOR BIT 7
INC DPTR ;POINT AT HIGH BYTE
MOVX A,@DPTR ;GET HIGH BYTE
CJNE A,R2B0,FL2 ;SEE IF MATCH
INC DPTR ;BUMP TO LOW BYTE
DEC R7 ;ADJUST AGAIN
MOVX A,@DPTR ;GET THE LOW BYTE
CJNE A,R0B0,FL2 ;SEE IF LOW BYTE MATCH
INC DPTR ;POINT AT FIRST CHARACTER
RET ;FOUND IT
;
FL2: MOV A,R7 ;GET THE LENGTH COUNTER
CALL ADDPTR ;ADD A TO DATA POINTER
SJMP FL1 ;LOOP
;
;
;*************************************************************
;
;RLINE - Read in ASCII string, get line, and clean it up
;
;*************************************************************
;
RLINE: ACALL INTERR ;GET THE INTEGER
;
RL1: ACALL GLN
AJMP CLN_UP
;
;
D_L1: ACALL GLN ;GET THE LINE
AJMP SGT1 ;EXECUTE THE LINE
;
newpage
;***************************************************************
;
; The statement action routines WHILE and UNTIL
;
;***************************************************************
;
SWHILE: ACALL RTST ;EVALUATE RELATIONAL EXPRESSION
CPL A
SJMP S_WU
;
SUNTIL: ACALL RTST ;EVALUATE RELATIONAL EXPRESSION
;
S_WU: MOV R4,#DTYPE ;DO EXPECTED
MOV R5,A ;SAVE R_OP RESULT
SJMP SR0 ;GO PROCESS
;
;
;***************************************************************
;
CNULL: ; The Command Action Routine - NULL
;
;***************************************************************
;
ACALL INTERR ;GET AN INTEGER FOLLOWING NULL
MOV NULLCT,R0 ;SAVE THE NULLCOUNT
AJMP CMNDLK ;JUMP TO COMMAND MODE
;
newpage
;***************************************************************
;
; The statement action routine - RETI
;
;***************************************************************
;
SRETI: SETB RETBIT ;SAYS THAT RETI HAS BEEN EXECUTED
;
;***************************************************************
;
; The statement action routine - RETURN
;
;***************************************************************
;
SRETRN: MOV R4,#GTYPE ;MAKE SURE OF GOSUB
MOV R5,#55H ;TYPE RETURN TYPE
;
SR0: ACALL CSETUP ;SET UP CONTROL STACK
MOVX A,@R0 ;GET RETURN TEXT ADDRESS
MOV DPH,A
INC R0
MOVX A,@R0
MOV DPL,A
INC R0 ;POP CONTROL STACK
MOVX A,@DPTR ;SEE IF GOSUB WAS THE LAST STATEMENT
CJNE A,#EOF,$+5
AJMP CMNDLK
MOV A,R5 ;GET TYPE
JZ SGT1 ;EXIT IF ZERO
MOV CSTKA,R0 ;POP THE STACK
CPL A ;OPTION TEST, 00H, 55H, 0FFH, NOW 55H
JNZ SGT1 ;MUST BE GOSUB
RET ;NORMAL FALL THRU EXIT FOR NO MATCH
;
newpage
;***************************************************************
;
; The statement action routine - GOSUB
;
;***************************************************************
;
SGOSUB: ACALL RLINE ;NEW TXA IN DPTR
;
SGS0: MOV R4,#GTYPE
ACALL SGS1 ;SET EVERYTHING UP
AJMP SF3 ;EXIT
;
SGS1: MOV A,#-3 ;ALLOCATE 3 BYTES ON CONTROL STACK
ACALL PUSHCS
;
T_X_S: MOV P2,#CSTKAH ;SET UP PORT FOR CONTROL STACK
MOV A,TXAL ;GET RETURN ADDRESS AND SAVE IT
MOVX @R0,A
DEC R0
MOV A,TXAH
MOVX @R0,A
DEC R0
MOV A,R4 ;GET TYPE
MOVX @R0,A ;SAVE TYPE
RET ;EXIT
;
;
CS1: MOV A,#3 ;POP 3 BYTES
ACALL PUSHCS
;
CSETUP: MOV R0,CSTKA ;GET CONTROL STACK
MOV P2,#CSTKAH
MOVX A,@R0 ;GET BYTE
CJNE A,R4B0,$+5 ;SEE IF TYPE MATCH
INC R0
RET
JZ E4XX ;EXIT IF STACK UNDERFLOW
CJNE A,#FTYPE,CS1 ;SEE IF FOR TYPE
ACALL PUSHCS-2 ;WASTE THE FOR TYPE
SJMP CSETUP ;LOOP
;
newpage
;***************************************************************
;
; The statement action routine - NEXT
;
;***************************************************************
;
SNEXT: MOV R4,#FTYPE ;FOR TYPE
ACALL CSETUP ;SETUP CONTROL STACK
MOV TEMP5,R0 ;SAVE CONTROL VARIABLE ADDRESS
MOV R1,#TEMP1 ;SAVE VAR + RETURN IN TEMP1-4
;
XXI: MOVX A,@R0 ;LOOP UNTIL DONE
MOV @R1,A
INC R1
INC R0
CJNE R1,#TEMP5,XXI
;
ACALL VAR ;SEE IF THE USER HAS A VARIABLE
JNC $+6
MOV R2,TEMP1
MOV R0,TEMP2
MOV A,R2 ;SEE IF VAR'S AGREE
CJNE A,TEMP1,E4XX
MOV A,R0
CJNE A,TEMP2,E4XX
ACALL PUSHAS ;PUT CONTROL VARIABLE ON STACK
MOV A,#FPSIZ+FPSIZ+2;COMPUTE ADDRESS TO STEP VALUE SIGN
ADD A,TEMP5 ;ADD IT TO BASE OF STACK
MOV R0,A ;SAVE IN R0
MOV R2,#CSTKAH ;SET UP TO PUSH STEP VALUE
MOV P2,R2 ;SET UP PORT
MOVX A,@R0 ;GET SIGN
INC R0 ;BACK TO EXPONENT
PUSH ACC ;SAVE SIGN OF STEP
ACALL PUSHAS ;PUT STEP VALUE ON STACK
PUSH R0B0 ;SAVE LIMIT VALUE LOCATION
CALL AADD ;ADD STEP VALUE TO VARIABLE
CALL CSTAKA ;COPY STACK
MOV R3,TEMP1 ;GET CONTROL VARIABLE
MOV R1,TEMP2
ACALL POPAS ;SAVE THE RESULT
MOV R2,#CSTKAH ;RESTORE LIMIT LOCATION
POP R0B0
ACALL PUSHAS ;PUT LIMIT ON STACK
CALL FP_BASE+4 ;DO THE COMPARE
POP ACC ;GET LIMIT SIGN BACK
JZ $+3 ;IF SIGN NEGATIVE, TEST "BACKWARDS"
CPL C
ORL C,F0 ;SEE IF EQUAL
JC N4 ;STILL SMALLER THAN LIMIT?
MOV A,#FSIZE ;REMOVE CONTROL STACK ENTRY
;
; Fall thru to PUSHCS
;
newpage
;***************************************************************
;
; PUSHCS - push frame onto control stack
; acc has - number of bytes, also test for overflow
;
;***************************************************************
;
PUSHCS: ADD A,CSTKA ;BUMP CONTROL STACK
CJNE A,#CONVT+17,$+3 ;SEE IF OVERFLOWED
JC E4XX ;EXIT IF STACK OVERFLOW
XCH A,CSTKA ;STORE NEW CONTROL STACK VALUE, GET OLD
DEC A ;BUMP OLD VALUE
MOV R0,A ;PUT OLD-1 IN R0
;
RET ;EXIT
;
CSC: ACALL CLN_UP ;FINISH OFF THE LINE
JNC CSC-1 ;EXIT IF NO TERMINATOR
;
E4XX: MOV DPTR,#EXC ;CONTROL STACK ERROR
AJMP EK ;STACK ERROR
;
N4: MOV TXAH,TEMP3 ;GET TEXT POINTER
MOV TXAL,TEMP4
AJMP ILOOP ;EXIT
;
;***************************************************************
;
; The statement action routine - RESTORE
;
;***************************************************************
;
SRESTR: ACALL X_TR ;SWAP POINTERS
ACALL DP_B ;GET THE STARTING ADDRESS
ACALL T_DP ;PUT STARTING ADDRESS IN TEXT POINTER
ACALL B_TXA ;BUMP TXA
;
; Fall thru
;
X_TR: ;swap txa and rtxa
;
XCH A,TXAH
XCH A,RTXAH
XCH A,TXAH
XCH A,TXAL
XCH A,RTXAL
XCH A,TXAL
RET ;EXIT
;
newpage
;***************************************************************
;
; The statement action routine - READ
;
;***************************************************************
;
SREAD: ACALL X_TR ;SWAP POINTERS
;
SRD0: ACALL C_TST ;CHECK FOR COMMA
JC SRD4 ;SEE WHAT IT IS
;
SRD: ACALL EXPRB ;EVALUATE THE EXPRESSION
ACALL GC ;GET THE CHARACTER AFTER EXPRESSION
CJNE A,#',',SRD1 ;SEE IF MORE DATA
SJMP SRD2 ;BYBASS CLEAN UP IF A COMMA
;
SRD1: ACALL CLN_UP ;FINISH OFF THE LINE, IF AT END
;
SRD2: ACALL X_TR ;RESTORE POINTERS
ACALL VAR_ER ;GET VARIABLE ADDRESS
ACALL XPOP ;FLIP THE REGISTERS FOR POPAS
ACALL C_TST ;SEE IF A COMMA
JNC SREAD ;READ AGAIN IF A COMMA
RET ;EXIT IF NOT
;
SRD4: CJNE A,#T_DATA,SRD5 ;SEE IF DATA
ACALL GCI1 ;BUMP POINTER
SJMP SRD
;
SRD5: CJNE A,#EOF,SRD6 ;SEE IF YOU BLEW IT
ACALL X_TR ;GET THE TEXT POINTER BACK
MOV DPTR,#E14X ;READ ERROR
;
EK: LJMP ERROR
;
SRD6: ACALL FINDCR ;WASTE THIS LINE
ACALL CLN_UP ;CLEAN IT UP
JC SRD5+3 ;ERROR IF AT END
SJMP SRD0
;
NUMC: ACALL GC ;GET A CHARACTER
CJNE A,#'#',NUMC1 ;SEE IF A #
SETB COB ;VALID LINE PRINT
AJMP IGC ;BUMP THE TEXT POINTER
;
NUMC1: CJNE A,#'@',SRD4-1 ;EXIT IF NO GOOD
SETB LPB
AJMP IGC
;
newpage
;***************************************************************
;
; The statement action routine - PRINT
;
;***************************************************************
;
SPH0: SETB ZSURP ;NO ZEROS
;
SPH1: SETB HMODE ;HEX MODE
;
SPRINT: ACALL NUMC ;TEST FOR A LINE PRINT
ACALL $+9 ;PROCEED
ANL 35,#11110101B ;CLEAR COB AND LPB
ANL 38,#00111111B ;NO HEX MODE
;
RET
;
ACALL DELTST ;CHECK FOR A DELIMITER
JC SP1
;
SP0: JMP CRLF ;EXIT WITH A CR IF SO
;
SP2: ACALL C_TST ;CHECK FOR A COMMA
JC SP0 ;EXIT IF NO COMMA
;
SP1: ACALL CPS ;SEE IF A STRING TO PRINT
JNC SP2 ;IF A STRING, CHECK FOR A COMMA
;
SP4: CJNE A,#T_TAB,SP6
ACALL I_PI ;ALWAYS CLEARS CARRY
SUBB A,PHEAD ;TAKE DELTA BETWEEN TAB AND PHEAD
JC SP2 ;EXIT IF PHEAD > TAB
SJMP SP7 ;OUTPUT SPACES
;
SP6: CJNE A,#T_SPC,SM
ACALL I_PI ;SET UP PAREN VALUE
;
SP7: JZ SP2
LCALL STEROT ;OUTPUT A SPACE
DEC A ;DECREMENT COUNTER
SJMP SP7 ;LOOP
;
newpage
SM: CJNE A,#T_CHR,SP8
ACALL IGC
CJNE A,#'$',$+9
ACALL CNX ;PUT THE CHARACTER ON THE STACK
ACALL IFIXL ;PUT THE CHARACTER IN R1
SJMP $+6
ACALL ONE ;EVALUATE THE EXPRESSION, PUT IN R3:R1
ACALL ERPAR
MOV R5,R1B0 ;BYTE TO OUTPUT
SJMP SQ
;
SP8: CJNE A,#T_CR,SX
ACALL GCI1 ;EAT THE TOKEN
MOV R5,#CR
;
SQ: CALL TEROT
SJMP SP2 ;OUTPUT A CR AND DO IT AGAIN
;
SX: CJNE A,#T_USE,SP9 ;USING TOKEN
ACALL IGC ;GE THE CHARACTER AFTER THE USING TOKEN
CJNE A,#'F',U4 ;SEE IF FLOATING
MOV FORMAT,#0F0H ;SET FLOATING
ACALL IGC ;BUMP THE POINTER AND GET THE CHARACTER
ACALL GCI1 ;BUMP IT AGAIN
ANL A,#0FH ;STRIP OFF ASCII BIAS
JZ U3 ;EXIT IF ZERO
CJNE A,#3,$+3 ;SEE IF AT LEAST A THREE
JNC U3 ;FORCE A THREE IF NOT A THREE
MOV A,#3
;
U3: ORL FORMAT,A ;PUT DIGIT IN FORMAT
SJMP U8 ;CLEAN UP END
;
U4: CJNE A,#'0',U5
MOV FORMAT,#0 ;FREE FORMAT
ACALL GCI1 ;BUMP THE POINTER
SJMP U8
;
U5: CJNE A,#'#',U8 ;SEE IF INTGER FORMAT
ACALL U6
MOV FORMAT,R7 ;SAVE THE FORMAT
CJNE A,#'.',U8A ;SEE IF TERMINATOR WAS RADIX
ACALL IGC ;BUMP PAST .
ACALL U6 ;LOOP AGAIN
MOV A,R7 ;GET COUNT
ADD A,FORMAT ;SEE IF TOO BIG
ADD A,#0F7H
JNC U5A
;
newpage
SE0: AJMP INTERX ;ERROR, BAD SYNTAX
;
U5A: MOV A,R7 ;GET THE COUNT BACK
SWAP A ;ADJUST
ORL FORMAT,A ;GET THE COUNT
;
U8A: MOV A,FORMAT
;
U8B: SWAP A ;GET THE FORMAT RIGHT
MOV FORMAT,A
;
U8: ACALL ERPAR
AJMP SP2 ;DONE
;
U6: MOV R7,#0 ;SET COUNTER
;
U7: CJNE A,#'#',SP9A ;EXIT IF NOT A #
INC R7 ;BUMP COUNTER
ACALL IGC ;GET THE NEXT CHARACTER
SJMP U7 ;LOOP
;
SP9: ACALL DELTST+2 ;CHECK FOR DELIMITER
JNC SP9A ;EXIT IF A DELIMITER
;
CJNE A,#T_ELSE,SS
;
SP9A: RET ;EXIT IF ELSE TOKEN
;
;**************************************************************
;
; P_E - Evaluate an expression in parens ( )
;
;**************************************************************
;
P_E: MOV R7,#T_LPAR
ACALL WE
;
ERPAR: MOV R7,#')' ;EAT A RIGHT PAREN
;
EATC: ACALL GCI ;GET THE CHARACTER
CJNE A,R7B0,SE0 ;ERROR IF NOT THE SAME
RET
;
newpage
;***************************************************************
;
S_ON: ; ON Statement
;
;***************************************************************
;
ACALL ONE ;GET THE EXPRESSION
ACALL GCI ;GET THE NEXT CHARACTER
CJNE A,#T_GOTO,C0
ACALL C1 ;EAT THE COMMAS
AJMP SF3 ;DO GOTO
;
C0: CJNE A,#T_GOSB,SE0
ACALL C1
AJMP SGS0 ;DO GOSUB
;
C1: CJNE R1,#0,C2
ACALL INTERR ;GET THE LINE NUMBER
ACALL FINDCR
AJMP RL1 ;FINISH UP THIS LINE
;
C2: MOV R7,#','
ACALL FINDC
CJNE A,#',',SE0 ;ERROR IF NOT A COMMA
DEC R1
ACALL GCI1 ;BUMP PAST COMMA
SJMP C1
;
newpage
;
SS: ACALL S_C ;SEE IF A STRING
JC SA ;NO STRING IF CARRY IS SET
LCALL UPRNT ;PUT POINTER IN DPTR
AJMP SP2 ;SEE IF MORE
;
SA: ACALL EXPRB ;MUST BE AN EXPRESSION
MOV A,#72
CJNE A,PHEAD,$+3 ;CHECK PHEAD POSITION
JNC $+4
ACALL SP0 ;FORCE A CRLF
JNB HMODE,S13 ;HEX MODE?
CALL FCMP ;SEE IF TOS IS < 0FFFH
JC S13 ;EXIT IF GREATER
CALL AABS ;GET THE SIGN
JNZ OOPS ;WASTE IF NEGATIVE
ACALL IFIXL
CALL FP_BASE+22 ;PRINT HEXMODE
AJMP SP2
OOPS: CALL ANEG ;MAKE IT NEGATIVE
;
S13: CALL FP_BASE+14 ;DO FP OUTPUT
MOV A,#1 ;OUTPUT A SPACE
AJMP SP7
;
newpage
;***************************************************************
;
; ANU - Get variable name from text - set carry if not found
; if succeeds returns variable in R7:R6
; R6 = 0 if no digit in name
;
;***************************************************************
;
ANU: ACALL IGC ;INCREMENT AND GET CHARACTER
LCALL 1FEDH ;CHECK FOR DIGIT
JC $+14 ;EXIT IF VALID DIGIT
CJNE A,#'_',$+4 ;SEE IF A _
RET
;
AL: CJNE A,#'A',$+3 ;IS IT AN ASCII A?
JC $+6 ;EXIT IF CARRY IS SET
CJNE A,#'Z'+1,$+3 ;IS IT LESS THAN AN ASCII Z
CPL C ;FLIP CARRY
RET
;
JNB F0,VAR2
;
SD0: MOV DPTR,#E6X
AJMP EK
;
SDIMX: SETB F0 ;SAYS DOING A DIMENSION
SJMP VAR1
;
VAR: CLR F0 ;SAYS DOING A VARIABLE
;
VAR1: ACALL GC ;GET THE CHARACTER
ACALL AL ;CHECK FOR ALPHA
JNC $+6 ;ERROR IF IN DIM
JB F0,SD0
RET
MOV R7,A ;SAVE ALPHA CHARACTER
CLR A ;ZERO IN CASE OF FAILURE
MOV R5,A ;SAVE IT
;
VY: MOV R6,A
ACALL ANU ;CHECK FOR ALPHA OR NUMBER
JC VX ;EXIT IF NO ALPHA OR NUM
;
XCH A,R7
ADD A,R5 ;NUMBER OF CHARACTERS IN ALPHABET
XCH A,R7 ;PUT IT BACK
MOV R5,#26 ;FOR THE SECOND TIME AROUND
SJMP VY
;
VX: CLR LINEB ;TELL EDITOR A VARIABLE IS DECLARED
CJNE A,#T_LPAR,V4 ;SEE IF A LEFT PAREN
;
ORL R6B0,#80H ;SET BIT 7 TO SIGINIFY MATRIX
CALL F_VAR ;FIND THE VARIABLE
PUSH R2B0 ;SAVE THE LOCATION
PUSH R0B0
JNC SD0-3 ;DEFAULT IF NOT IN TABLE
JB F0,SDI ;NO DEFAULT FOR DIMENSION
MOV R1,#10
MOV R3,#0
ACALL D_CHK
;
VAR2: ACALL PAREN_INT ;EVALUATE INTEGER IN PARENS
CJNE R3,#0,SD0 ;ERROR IF R3<>0
POP DPL ;GET VAR FOR LOOKUP
POP DPH
MOVX A,@DPTR ;GET DIMENSION
DEC A ;BUMP OFFSET
SUBB A,R1 ;A MUST BE > R1
JC SD0
LCALL DECDP2 ;BUMP POINTER TWICE
ACALL VARB ;CALCULATE THE BASE
;
X3120: XCH A,R1 ;SWAP R2:R0, R3:R1
XCH A,R0
XCH A,R1
XCH A,R3
XCH A,R2
XCH A,R3
RET
;
V4: JB F0,SD0 ;ERROR IF NO LPAR FOR DIM
LCALL F_VAR ;GET SCALAR VARIABLE
CLR C
RET
;
newpage
;
SDI: ACALL PAREN_INT ;EVALUATE PAREN EXPRESSION
CJNE R3,#0,SD0 ;ERROR IF NOT ZERO
POP R0B0 ;SET UP R2:R0
POP R2B0
ACALL D_CHK ;DO DIM
ACALL C_TST ;CHECK FOR COMMA
JNC SDIMX ;LOOP IF COMMA
RET ;RETURN IF NO COMMA
;
D_CHK: INC R1 ;BUMP FOR TABLE LOOKUP
MOV A,R1
JZ SD0 ;ERROR IF 0FFFFH
MOV R4,A ;SAVE FOR LATER
MOV DPTR,#MT_ALL ;GET MATRIX ALLOCATION
ACALL VARB ;DO THE CALCULATION
MOV R7,DPH ;SAVE MATRIX ALLOCATION
MOV R6,DPL
MOV DPTR,#ST_ALL ;SEE IF TOO MUCH MEMORY TAKEN
CALL FUL1 ;ST_ALL SHOULD BE > R3:R1
MOV DPTR,#MT_ALL ;SAVE THE NEW MATRIX POINTER
CALL S31DP
MOV DPL,R0 ;GET VARIABLE ADDRESS
MOV DPH,R2
MOV A,R4 ;DIMENSION SIZE
MOVX @DPTR,A ;SAVE IT
CALL DECDP2 ;SAVE TARGET ADDRESS
;
R76S: MOV A,R7
MOVX @DPTR,A
INC DPTR
MOV A,R6 ;ELEMENT SIZE
MOVX @DPTR,A
RET ;R2:R0 STILL HAS SYMBOL TABLE ADDRESS
;
newpage
;***************************************************************
;
; The statement action routine - INPUT
;
;***************************************************************
;
SINPUT: ACALL CPS ;PRINT STRING IF THERE
;
ACALL C_TST ;CHECK FOR A COMMA
JNC IN2A ;NO CRLF
ACALL SP0 ;DO A CRLF
;
IN2: MOV R5,#'?' ;OUTPUT A ?
CALL TEROT
;
IN2A: SETB INP_B ;DOING INPUT
CALL INLINE ;INPUT THE LINE
CLR INP_B
MOV TEMP5,#HI(IBUF)
MOV TEMP4,#LO(IBUF)
;
IN3: ACALL S_C ;SEE IF A STRING
JC IN3A ;IF CARRY IS SET, NO STRING
ACALL X3120 ;FLIP THE ADDRESSES
MOV R3,TEMP5
MOV R1,TEMP4
ACALL SSOOP
ACALL C_TST ;SEE IF MORE TO DO
JNC IN2
RET
;
IN3A: CALL DTEMP ;GET THE USER LOCATION
CALL GET_NUM ;GET THE USER SUPPLIED NUMBER
JNZ IN5 ;ERROR IF NOT ZERO
CALL TEMPD ;SAVE THE DATA POINTER
ACALL VAR_ER ;GET THE VARIABLE
ACALL XPOP ;SAVE THE VARIABLE
CALL DTEMP ;GET DPTR BACK FROM VAR_ER
ACALL C_TST ;SEE IF MORE TO DO
JC IN6 ;EXIT IF NO COMMA
MOVX A,@DPTR ;GET INPUT TERMINATOR
CJNE A,#',',IN5 ;IF NOT A COMMA DO A CR AND TRY AGAIN
INC DPTR ;BUMP PAST COMMA AND READ NEXT VALUE
CALL TEMPD
SJMP IN3
;
newpage
;
IN5: MOV DPTR,#IAN ;PRINT INPUT A NUMBER
CALL CRP ;DO A CR, THEN, PRINT FROM ROM
LJMP CC1 ;TRY IT AGAIN
;
IN6: MOVX A,@DPTR
CJNE A,#CR,EIGP
RET
;
EIGP: MOV DPTR,#EIG
CALL CRP ;PRINT THE MESSAGE AND EXIT
AJMP SP0 ;EXIT WITH A CRLF
;
;***************************************************************
;
SOT: ; On timer interrupt
;
;***************************************************************
;
ACALL TWO ;GET THE NUMBERS
MOV SP_H,R3
MOV SP_L,R1
MOV DPTR,#TIV ;SAVE THE NUMBER
SETB OTS
AJMP R76S ;EXIT
;
;
;***************************************************************
;
SCALL: ; Call a user rountine
;
;***************************************************************
;
ACALL INTERR ;CONVERT INTEGER
CJNE R2,#0,S_C_1 ;SEE IF TRAP
MOV A,R0
JB ACC.7,S_C_1
ADD A,R0
MOV DPTR,#4100H
MOV DPL,A
;
S_C_1: ACALL AC1 ;JUMP TO USER PROGRAM
ANL PSW,#11100111B ;BACK TO BANK 0
RET ;EXIT
;
newpage
;**************************************************************
;
THREE: ; Save value for timer function
;
;**************************************************************
;
ACALL ONE ;GET THE FIRST INTEGER
CALL CBIAS ;BIAS FOR TIMER LOAD
MOV T_HH,R3
MOV T_LL,R1
MOV R7,#',' ;WASTE A COMMA
ACALL EATC ;FALL THRU TO TWO
;
;**************************************************************
;
TWO: ; Get two values seperated by a comma off the stack
;
;**************************************************************
;
ACALL EXPRB
MOV R7,#',' ;WASTE THE COMMA
ACALL WE
JMP TWOL ;EXIT
;
;*************************************************************
;
ONE: ; Evaluate an expression and get an integer
;
;*************************************************************
;
ACALL EXPRB ;EVALUATE EXPERSSION
;
IFIXL: CALL IFIX ;INTEGERS IN R3:R1
MOV A,R1
RET
;
;
;*************************************************************
;
I_PI: ; Increment text pointer then get an integer
;
;*************************************************************
;
ACALL GCI1 ;BUMP TEXT, THEN GET INTEGER
;
PAREN_INT:; Get an integer in parens ( )
;
ACALL P_E
SJMP IFIXL
;
newpage
;
DP_B: MOV DPH,BOFAH
MOV DPL,BOFAL
RET
;
DP_T: MOV DPH,TXAH
MOV DPL,TXAL
RET
;
CPS: ACALL GC ;GET THE CHARACTER
CJNE A,#'"',NOPASS ;EXIT IF NO STRING
ACALL DP_T ;GET TEXT POINTER
INC DPTR ;BUMP PAST "
MOV R4,#'"'
CALL PN0 ;DO THE PRINT
INC DPTR ;GO PAST QUOTE
CLR C ;PASSED TEST
;
T_DP: MOV TXAH,DPH ;TEXT POINTER GETS DPTR
MOV TXAL,DPL
RET
;
;*************************************************************
;
S_C: ; Check for a string
;
;*************************************************************
;
ACALL GC ;GET THE CHARACTER
CJNE A,#'$',NOPASS ;SET CARRY IF NOT A STRING
AJMP IST_CAL ;CLEAR CARRY, CALCULATE OFFSET
;
;
;
;**************************************************************
;
C_TST: ACALL GC ;GET A CHARACTER
CJNE A,#',',NOPASS ;SEE IF A COMMA
;
newpage
;***************************************************************
;
;GC AND GCI - GET A CHARACTER FROM TEXT (NO BLANKS)
; PUT CHARACTER IN THE ACC
;
;***************************************************************
;
IGC: ACALL GCI1 ;BUMP POINTER, THEN GET CHARACTER
;
GC: SETB RS0 ;USE BANK 1
MOV P2,R2 ;SET UP PORT 2
MOVX A,@R0 ;GET EXTERNAL BYTE
CLR RS0 ;BACK TO BANK 0
RET ;EXIT
;
GCI: ACALL GC
;
; This routine bumps txa by one and always clears the carry
;
GCI1: SETB RS0 ;BANK 1
INC R0 ;BUMP TXA
CJNE R0,#0,$+4
INC R2
CLR RS0
RET ;EXIT
;
newpage
;**************************************************************
;
; Check delimiters
;
;**************************************************************
;
DELTST: ACALL GC ;GET A CHARACTER
CJNE A,#CR,DT1 ;SEE IF A CR
CLR A
RET
;
DT1: CJNE A,#':',NOPASS ;SET CARRY IF NO MATCH
;
L_RET: RET
;
;
;***************************************************************
;
; FINDC - Find the character in R7, update TXA
;
;***************************************************************
;
FINDCR: MOV R7,#CR ;KILL A STATEMENT LINE
;
FINDC: ACALL DELTST
JNC L_RET
;
CJNE A,R7B0,FNDCL2 ;MATCH?
RET
;
FNDCL2: ACALL GCI1
SJMP FINDC ;LOOP
;
ACALL GCI1
;
WCR: ACALL DELTST ;WASTE UNTIL A "REAL" CR
JNZ WCR-2
RET
;
newpage
;***************************************************************
;
; VAR_ER - Check for a variable, exit if error
;
;***************************************************************
;
VAR_ER: ACALL VAR
SJMP INTERR+2
;
;
;***************************************************************
;
; S_D0 - The Statement Action Routine DO
;
;***************************************************************
;
S_DO: ACALL CSC ;FINISH UP THE LINE
MOV R4,#DTYPE ;TYPE FOR STACK
ACALL SGS1 ;SAVE ON STACK
AJMP ILOOP ;EXIT
;
newpage
;***************************************************************
;
; CLN_UP - Clean up the end of a statement, see if at end of
; file, eat character and line count after CR
;
;***************************************************************
;
C_2: CJNE A,#':',C_1 ;SEE IF A TERMINATOR
AJMP GCI1 ;BUMP POINTER AND EXIT, IF SO
;
C_1: CJNE A,#T_ELSE,EP5
ACALL WCR ;WASTE UNTIL A CR
;
CLN_UP: ACALL GC ;GET THE CHARACTER
CJNE A,#CR,C_2 ;SEE IF A CR
ACALL IGC ;GET THE NEXT CHARACTER
CJNE A,#EOF,B_TXA ;SEE IF TERMINATOR
;
NOPASS: SETB C
RET
;
B_TXA: XCH A,TXAL ;BUMP TXA BY THREE
ADD A,#3
XCH A,TXAL
JBC CY,$+4
RET
INC TXAH
RET
;
newpage
;***************************************************************
;
; Get an INTEGER from the text
; sets CARRY if not found
; returns the INTGER value in DPTR and R2:R0
; returns the terminator in ACC
;
;***************************************************************
;
INTERR: ACALL INTGER ;GET THE INTEGER
JC EP5 ;ERROR IF NOT FOUND
RET ;EXIT IF FOUND
;
INTGER: ACALL DP_T
CALL FP_BASE+18 ;CONVERT THE INTEGER
ACALL T_DP
MOV DPH,R2 ;PUT THE RETURNED VALUE IN THE DPTR
MOV DPL,R0
;
ITRET: RET ;EXIT
;
;
WE: ACALL EATC ;WASTE THE CHARACTER
;
; Fall thru to evaluate the expression
;
newpage
;***************************************************************
;
; EXPRB - Evaluate an expression
;
;***************************************************************
;
EXPRB: MOV R2,#LO(OPBOL) ;BASE PRECEDENCE
;
EP1: PUSH R2B0 ;SAVE OPERATOR PRECEDENCE
CLR ARGF ;RESET STACK DESIGNATOR
;
EP2: MOV A,SP ;GET THE STACK POINTER
ADD A,#12 ;NEED AT LEAST 12 BYTES
JNC $+5
LJMP ERROR-3
MOV A,ASTKA ;GET THE ARG STACK
SUBB A,#LO(TM_TOP+12);NEED 12 BYTES ALSO
JNC $+5
LJMP E4YY
JB ARGF,EP4 ;MUST BE AN OPERATOR, IF SET
ACALL VAR ;IS THE VALUE A VARIABLE?
JNC EP3 ;PUT VARIABLE ON STACK
;
ACALL CONST ;IS THE VALUE A NUMERIC CONSTANT?
JNC EP4 ;IF SO, CONTINUE, IF NOT, SEE WHAT
CALL GC ;GET THE CHARACTER
CJNE A,#T_LPAR,EP4 ;SEE IF A LEFT PAREN
MOV A,#(LO(OPBOL+1))
SJMP XLPAR ;PROCESS THE LEFT PAREN
;
EP3: ACALL PUSHAS ;SAVE VAR ON STACK
;
EP4: ACALL GC ;GET THE OPERATOR
;
CJNE A,#T_LPAR,$+3 ;IS IT AN OPERATOR
JNC XOP ;PROCESS OPERATOR
CJNE A,#T_UOP,$+3 ;IS IT A UNARY OPERATOR
JNC XBILT ;PROCESS UNARY (BUILT IN) OPERATOR
POP R2B0 ;GET BACK PREVIOUS OPERATOR PRECEDENCE
JB ARGF,ITRET ;OK IF ARG FLAG IS SET
;
EP5: CLR C ;NO RECOVERY
LJMP E1XX+2
;
; Process the operator
;
XOP: ANL A,#1FH ;STRIP OFF THE TOKE BITS
JB ARGF,XOP1 ;IF ARG FLAG IS SET, PROCESS
CJNE A,#T_SUB-T_LPAR,XOP3
MOV A,#T_NEG-T_LPAR
;
newpage
XOP1: ADD A,#LO(OPBOL+1) ;BIAS THE TABLE
MOV R2,A
MOV DPTR,#00H
MOVC A,@A+DPTR ;GET THE CURRENT PRECEDENCE
MOV R4,A
POP ACC ;GET THE PREVIOUS PRECEDENCE
MOV R5,A ;SAVE THE PREVIOUS PRECEDENCE
MOVC A,@A+DPTR ;GET IT
CJNE A,R4B0,$+7 ;SEE WHICH HAS HIGHER PRECEDENCE
CJNE A,#12,ITRET ;SEE IF ANEG
SETB C
JNC ITRET ;PROCESS NON-INCREASING PRECEDENCE
;
; Save increasing precedence
;
PUSH R5B0 ;SAVE OLD PRECEDENCE ADDRESS
PUSH R2B0 ;SAVE NEW PRECEDENCE ADDRESS
ACALL GCI1 ;EAT THE OPERATOR
ACALL EP1 ;EVALUATE REMAINING EXPRESSION
POP ACC
;
; R2 has the action address, now setup and perform operation
;
XOP2: MOV DPTR,#OPTAB
ADD A,#LO(~OPBOL)
CALL ISTA1 ;SET UP TO RETURN TO EP2
AJMP EP2 ;JUMP TO EVALUATE EXPRESSION
;
; Built-in operator processing
;
XBILT: ACALL GCI1 ;EAT THE TOKEN
ADD A,#LO(50H+LO(UOPBOL))
JB ARGF,EP5 ;XBILT MUST COME AFTER AN OPERATOR
CJNE A,#STP,$+3
JNC XOP2
;
XLPAR: PUSH ACC ;PUT ADDRESS ON THE STACK
ACALL P_E
SJMP XOP2-2 ;PERFORM OPERATION
;
XOP3: CJNE A,#T_ADD-T_LPAR,EP5
ACALL GCI1
AJMP EP2 ;WASTE + SIGN
;
newpage
XPOP: ACALL X3120 ;FLIP ARGS THEN POP
;
;***************************************************************
;
; POPAS - Pop arg stack and copy variable to R3:R1
;
;***************************************************************
;
POPAS: LCALL INC_ASTKA
JMP VARCOP ;COPY THE VARIABLE
;
AXTAL: MOV R2,#HI(CXTAL)
MOV R0,#LO(CXTAL)
;
; fall thru
;
;***************************************************************
;
PUSHAS: ; Push the Value addressed by R2:R0 onto the arg stack
;
;***************************************************************
;
CALL DEC_ASTKA
SETB ARGF ;SAYS THAT SOMTHING IS ON THE STACK
LJMP VARCOP
;
;
;***************************************************************
;
ST_A: ; Store at expression
;
;***************************************************************
;
ACALL ONE ;GET THE EXPRESSION
SJMP POPAS ;SAVE IT
;
;
;***************************************************************
;
LD_A: ; Load at expression
;
;***************************************************************
;
ACALL ONE ;GET THE EXPRESSION
ACALL X3120 ;FLIP ARGS
SJMP PUSHAS
;
newpage
;***************************************************************
;
CONST: ; Get a constant fron the text
;
;***************************************************************
;
CALL GC ;FIRST SEE IF LITERAL
CJNE A,#T_ASC,C0C ;SEE IF ASCII TOKEN
CALL IGC ;GET THE CHARACTER AFTER TOKEN
CJNE A,#'$',CN0 ;SEE IF A STRING
;
CNX: CALL CSY ;CALCULATE IT
LJMP AXBYTE+2 ;SAVE IT ON THE STACK ******AA JMP-->LJMP
;
CN0: LCALL TWO_R2 ;PUT IT ON THE STACK ******AA CALL-->LCALL
CALL GCI1 ;BUMP THE POINTER
LJMP ERPAR ;WASTE THE RIGHT PAREN ******AA JMP-->LJMP
;
;
C0C: CALL DP_T ;GET THE TEXT POINTER
CALL GET_NUM ;GET THE NUMBER
CJNE A,#0FFH,C1C ;SEE IF NO NUMBER
SETB C
C2C: RET
;
C1C: JNZ FPTST
CLR C
SETB ARGF
;
C3C: JMP T_DP
;
FPTST: ANL A,#00001011B ;CHECK FOR ERROR
JZ C2C ;EXIT IF ZERO
;
; Handle the error condition
;
MOV DPTR,#E2X ;DIVIDE BY ZERO
JNB ACC.0,$+6 ;UNDERFLOW
MOV DPTR,#E7X
JNB ACC.1,$+6 ;OVERFLOW
MOV DPTR,#E11X
;
FPTS: JMP ERROR
;
newpage
;***************************************************************
;
; The Command action routine - LIST
;
;***************************************************************
;
CLIST: CALL NUMC ;SEE IF TO LINE PORT
ACALL FSTK ;PUT 0FFFFH ON THE STACK
CALL INTGER ;SEE IF USER SUPPLIES LN
CLR A ;LN = 0 TO START
MOV R3,A
MOV R1,A
JC CL1 ;START FROM ZERO
;
CALL TEMPD ;SAVE THE START ADDTESS
CALL GCI ;GET THE CHARACTER AFTER LIST
CJNE A,#T_SUB,$+10 ;CHECK FOR TERMINATION ADDRESS '-'
ACALL INC_ASTKA ;WASTE 0FFFFH
LCALL INTERR ;GET TERMINATION ADDRESS
ACALL TWO_EY ;PUT TERMINATION ON THE ARG STACK
MOV R3,TEMP5 ;GET THE START ADDTESS
MOV R1,TEMP4
;
CL1: CALL GETLIN ;GET THE LINE NO IN R3:R1
JZ CL3 ;RET IF AT END
;
CL2: ACALL C3C ;SAVE THE ADDRESS
INC DPTR ;POINT TO LINE NUMBER
ACALL PMTOP+3 ;PUT LINE NUMBER ON THE STACK
ACALL CMPLK ;COMPARE LN TO END ADDRESS
JC CL3 ;EXIT IF GREATER
CALL BCK ;CHECK FOR A CONTROL C
ACALL DEC_ASTKA ;SAVE THE COMPARE ADDRESS
CALL DP_T ;RESTORE ADDRESS
ACALL UPPL ;UN-PROCESS THE LINE
ACALL C3C ;SAVE THE CR ADDRESS
ACALL CL6 ;PRINT IT
INC DPTR ;BUMP POINTER TO NEXT LINE
MOVX A,@DPTR ;GET LIN LENGTH
DJNZ ACC,CL2 ;LOOP
ACALL INC_ASTKA ;WASTE THE COMPARE BYTE
;
CL3: AJMP CMND1 ;BACK TO COMMAND PROCESSOR
;
CL6: MOV DPTR,#IBUF ;PRINT IBUF
CALL PRNTCR ;PRINT IT
CALL DP_T
;
CL7: JMP CRLF
;
LCALL X31DP
newpage
;***************************************************************
;
;UPPL - UN PREPROCESS A LINE ADDRESSED BY DPTR INTO IBUF
; RETURN SOURCE ADDRESS OF CR IN DPTR ON RETURN
;
;***************************************************************
;
UPPL: MOV R3,#HI(IBUF) ;POINT R3 AT HIGH IBUF
MOV R1,#LO(IBUF) ;POINT R1 AT IBUF
INC DPTR ;SKIP OVER LINE LENGTH
ACALL C3C ;SAVE THE DPTR (DP_T)
CALL L20DPI ;PUT LINE NUMBER IN R2:R0
CALL FP_BASE+16 ;CONVERT R2:R0 TO INTEGER
CALL DP_T
INC DPTR ;BUMP DPTR PAST THE LINE NUMBER
;
UPP0: CJNE R1,#LO(IBUF+6),$+3
JC UPP1A-4 ;PUT SPACES IN TEXT
INC DPTR ;BUMP PAST LN HIGH
MOVX A,@DPTR ;GET USER TEXT
MOV R6,A ;SAVE A IN R6 FOR TOKE COMPARE
JB ACC.7,UPP1 ;IF TOKEN, PROCESS
CJNE A,#20H,$+3 ;TRAP THE USER TOKENS
JNC $+5
CJNE A,#CR,UPP1 ;DO IT IF NOT A CR
CJNE A,#'"',UPP9 ;SEE IF STRING
ACALL UPP7 ;SAVE IT
ACALL UPP8 ;GET THE NEXT CHARACTER AND SAVE IT
CJNE A,#'"',$-2 ;LOOP ON QUOTES
SJMP UPP0
;
UPP9: CJNE A,#':',UPP1A ;PUT A SPACE IN DELIMITER
ACALL UPP7A
MOV A,R6
ACALL UPP7
ACALL UPP7A
SJMP UPP0
;
UPP1A: ACALL UPP8+2 ;SAVE THE CHARACTER, UPDATE POINTER
SJMP UPP0 ;EXIT IF A CR, ELSE LOOP
;
UPP1: ACALL C3C ;SAVE THE TEXT POINTER
MOV C,XBIT
MOV F0,C ;SAVE XBIT IN F0
MOV DPTR,#TOKTAB ;POINT AT TOKEN TABLE
JNB F0,UPP2
LCALL 2078H ;SET UP DPTR FOR LOOKUP
;
UPP2: CLR A ;ZERO A FOR LOOKUP
MOVC A,@A+DPTR ;GET TOKEN
INC DPTR ;ADVANCE THE TOKEN POINTER
CJNE A,#0FFH,UP_2 ;SEE IF DONE
JBC F0,UPP2-9 ;NOW DO NORMAL TABLE
AJMP CMND1 ;EXIT IF NOT FOUND
;
UP_2: CJNE A,R6B0,UPP2 ;LOOP UNTIL THE SAME
;
UP_3: CJNE A,#T_UOP,$+3
JNC UPP3
ACALL UPP7A ;PRINT THE SPACE IF OK
;
UPP3: CLR A ;DO LOOKUP
MOVC A,@A+DPTR
JB ACC.7,UPP4 ;EXIT IF DONE, ELSE SAVE
JZ UPP4 ;DONE IF ZERO
ACALL UPP7 ;SAVE THE CHARACTER
INC DPTR
SJMP UPP3 ;LOOP
;
UPP4: CALL DP_T ;GET IT BACK
MOV A,R6 ;SEE IF A REM TOKEN
XRL A,#T_REM
JNZ $+6
ACALL UPP8
SJMP $-2
JNC UPP0 ;START OVER AGAIN IF NO TOKEN
ACALL UPP7A ;PRINT THE SPACE IF OK
SJMP UPP0 ;DONE
;
UPP7A: MOV A,#' ' ;OUTPUT A SPACE
;
UPP7: AJMP PPL9+1 ;SAVE A
;
UPP8: INC DPTR
MOVX A,@DPTR
CJNE A,#CR,UPP7
AJMP PPL7+1
;
newpage
;**************************************************************
;
; This table contains all of the floating point constants
;
; The constants in ROM are stored "backwards" from the way
; basic normally treats floating point numbers. Instead of
; loading from the exponent and decrementing the pointer,
; ROM constants pointers load from the most significant
; digits and increment the pointers. This is done to 1) make
; arg stack loading faster and 2) compensate for the fact that
; no decrement data pointer instruction exsist.
;
; The numbers are stored as follows:
;
; BYTE X+5 = MOST SIGNIFICANT DIGITS IN BCD
; BYTE X+4 = NEXT MOST SIGNIFICANT DIGITS IN BCD
; BYTE X+3 = NEXT LEAST SIGNIFICANT DIGITS IN BCD
; BYTE X+2 = LEAST SIGNIFICANT DIGITS IN BCD
; BYTE X+1 = SIGN OF THE ABOVE MANTISSA 0 = +, 1 = -
; BYTE X = EXPONENT IN TWO'S COMPLEMENT BINARY
; ZERO EXPONENT = THE NUMBER ZERO
;
;**************************************************************
;
ATTAB: DB 128-2 ; ARCTAN LOOKUP
DB 00H
DB 57H
DB 22H
DB 66H
DB 28H
;
DB 128-1
DB 01H
DB 37H
DB 57H
DB 16H
DB 16H
;
DB 128-1
DB 00H
DB 14H
DB 96H
DB 90H
DB 42H
;
DB 128-1
DB 01H
DB 40H
DB 96H
DB 28H
DB 75H
;
DB 128
DB 00H
DB 64H
DB 62H
DB 65H
DB 10H
;
DB 128
DB 01H
DB 99H
DB 88H
DB 20H
DB 14H
;
DB 128
DB 00H
DB 51H
DB 35H
DB 99H
DB 19H
;
DB 128
DB 01H
DB 45H
DB 31H
DB 33H
DB 33H
;
DB 129
DB 00H
DB 00H
DB 00H
DB 00H
DB 10H
;
DB 0FFH ;END OF TABLE
;
NTWO: DB 129
DB 0
DB 0
DB 0
DB 0
DB 20H
;
TTIME: DB 128-4 ; CLOCK CALCULATION
DB 00H
DB 00H
DB 00H
DB 04H
DB 13H
;
newpage
;***************************************************************
;
; COSINE - Add pi/2 to stack, then fall thru to SIN
;
;***************************************************************
;
ACOS: ACALL POTWO ;PUT PI/2 ON THE STACK
ACALL AADD ;TOS = TOS+PI/2
;
;***************************************************************
;
; SINE - use taylor series to calculate sin function
;
;***************************************************************
;
ASIN: ACALL PIPI ;PUT PI ON THE STACK
ACALL RV ;REDUCE THE VALUE
MOV A,MT2 ;CALCULATE THE SIGN
ANL A,#01H ;SAVE LSB
XRL MT1,A ;SAVE SIGN IN MT1
ACALL CSTAKA ;NOW CONVERT TO ONE QUADRANT
ACALL POTWO
ACALL CMPLK ;DO COMPARE
JC $+6
ACALL PIPI
ACALL ASUB
ACALL AABS
MOV DPTR,#SINTAB ;SET UP LOOKUP TABLE
ACALL POLYC ;CALCULATE THE POLY
ACALL STRIP
AJMP SIN0
;
; Put PI/2 on the stack
;
POTWO: ACALL PIPI ;PUT PI ON THE STACK, NOW DIVIDE
;
DBTWO: MOV DPTR,#NTWO
ACALL PUSHC
;MOV A,#2 ;BY TWO
;ACALL TWO_R2
AJMP ADIV
;
newpage
;*************************************************************
;
POLYC: ; Expand a power series to calculate a polynomial
;
;*************************************************************
;
ACALL CSTAKA2 ;COPY THE STACK
ACALL AMUL ;SQUARE THE STACK
ACALL POP_T1 ;SAVE X*X
ACALL PUSHC ;PUT CONSTANT ON STACK
;
POLY1: ACALL PUSH_T1 ;PUT COMPUTED VALUE ON STACK
ACALL AMUL ;MULTIPLY CONSTANT AND COMPUTED VALUE
ACALL PUSHC ;PUT NEXT CONSTANT ON STACK
ACALL AADD ;ADD IT TO THE OLD VALUE
CLR A ;CHECK TO SEE IF DONE
MOVC A,@A+DPTR
CJNE A,#0FFH,POLY1 ;LOOP UNTIL DONE
;
AMUL: LCALL FP_BASE+6
AJMP FPTST
;
;*************************************************************
;
RV: ; Reduce a value for Trig and A**X functions
;
; value = (value/x - INT(value/x)) * x
;
;*************************************************************
;
ACALL C_T2 ;COPY TOS TO T2
ACALL ADIV ;TOS = TOS/TEMP2
ACALL AABS ;MAKE THE TOS A POSITIVE NUMBER
MOV MT1,A ;SAVE THE SIGN
ACALL CSTAKA2 ;COPY THE STACK TWICE
ACALL IFIX ;PUT THE NUMBER IN R3:R1
PUSH R3B0 ;SAVE R3
MOV MT2,R1 ;SAVE THE LS BYTE IN MT2
ACALL AINT ;MAKE THE TOS AN INTEGER
ACALL ASUB ;TOS = TOS/T2 - INT(TOS/T2)
ACALL P_T2 ;TOS = T2
ACALL AMUL ;TOS = T2*(TOS/T2 - INT(TOS/T2)
POP R3B0 ;RESTORE R3
RET ;EXIT
;
newpage
;**************************************************************
;
; TAN
;
;**************************************************************
;
ATAN: ACALL CSTAKA ;DUPLACATE STACK
ACALL ASIN ;TOS = SIN(X)
ACALL SWAP_ASTKA ;TOS = X
ACALL ACOS ;TOS = COS(X)
AJMP ADIV ;TOS = SIN(X)/COS(X)
;
STRIP: ACALL SETREG ;SETUP R0
MOV R3,#1 ;LOOP COUNT
AJMP AI2-1 ;WASTE THE LSB
;
;************************************************************
;
; ARC TAN
;
;************************************************************
;
AATAN: ACALL AABS
MOV MT1,A ;SAVE THE SIGN
ACALL SETREG ;GET THE EXPONENT
ADD A,#7FH ;BIAS THE EXPONENT
MOV UBIT,C ;SAVE CARRY STATUS
JNC $+4 ;SEE IF > 1
ACALL RECIP ;IF > 1, TAKE RECIP
MOV DPTR,#ATTAB ;SET UP TO CALCULATE THE POLY
ACALL POLYC ;CALCULATE THE POLY
JNB UBIT,SIN0 ;JUMP IF NOT SET
ACALL ANEG ;MAKE X POLY NEGATIVE
ACALL POTWO ;SUBTRACT PI/2
ACALL AADD
;
SIN0: MOV A,MT1 ;GET THE SIGN
JZ SRT
AJMP ANEG
;
newpage
;*************************************************************
;
; FCOMP - COMPARE 0FFFFH TO TOS
;
;*************************************************************
;
FCMP: ACALL CSTAKA ;COPY THE STACK
ACALL FSTK ;MAKE THE TOS = 0FFFFH
ACALL SWAP_ASTKA ;NOW COMPARE IS 0FFFFH - X
;
CMPLK: JMP FP_BASE+4 ;DO THE COMPARE
;
;*************************************************************
;
DEC_ASTKA: ;Push ARG STACK and check for underflow
;
;*************************************************************
;
MOV A,#-FPSIZ
ADD A,ASTKA
CJNE A,#LO(TM_TOP+6),$+3
JC E4YY
MOV ASTKA,A
MOV R1,A
MOV R3,#ASTKAH
;
SRT: RET
;
E4YY: MOV DPTR,#EXA
AJMP FPTS ;ARG STACK ERROR
;
;
AXTAL3: ACALL PUSHC ;PUSH CONSTANT, THEN MULTIPLY
ACALL AMUL
;
; Fall thru to IFIX
;
newpage
;***************************************************************
;
IFIX: ; Convert a floating point number to an integer, put in R3:R1
;
;***************************************************************
;
CLR A ;RESET THE START
MOV R3,A
MOV R1,A
MOV R0,ASTKA ;GET THE ARG STACK
MOV P2,#ASTKAH
MOVX A,@R0 ;READ EXPONENT
CLR C
SUBB A,#81H ;BASE EXPONENT
MOV R4,A ;SAVE IT
DEC R0 ;POINT AT SIGN
MOVX A,@R0 ;GET THE SIGN
JNZ SQ_ERR ;ERROR IF NEGATIVE
JC INC_ASTKA ;EXIT IF EXPONENT IS < 81H
INC R4 ;ADJUST LOOP COUNTER
MOV A,R0 ;BUMP THE POINTER REGISTER
SUBB A,#FPSIZ-1
MOV R0,A
;
I2: INC R0 ;POINT AT DIGIT
MOVX A,@R0 ;GET DIGIT
SWAP A ;FLIP
CALL FP_BASE+20 ;ACCUMULATE
JC SQ_ERR
DJNZ R4,$+4
SJMP INC_ASTKA
MOVX A,@R0 ;GET DIGIT
CALL FP_BASE+20
JC SQ_ERR
DJNZ R4,I2
;
newpage
;************************************************************
;
INC_ASTKA: ; Pop the ARG STACK and check for overflow
;
;************************************************************
;
MOV A,#FPSIZ ;NUMBER TO POP
SJMP SETREG+1
;
SETREG: CLR A ;DON'T POP ANYTHING
MOV R0,ASTKA
MOV R2,#ASTKAH
MOV P2,R2
ADD A,R0
JC E4YY
MOV ASTKA,A
MOVX A,@R0
A_D: RET
;
;************************************************************
;
; EBIAS - Bias a number for E to the X calculations
;
;************************************************************
;
EBIAS: ACALL PUSH_ONE
ACALL RV
CJNE R3,#00H,SQ_ERR ;ERROR IF R3 <> 0
ACALL C_T2 ;TEMP 2 GETS FRACTIONS
ACALL INC_ASTKA
ACALL POP_T1
ACALL PUSH_ONE
;
AELP: MOV A,MT2
JNZ AEL1
;
MOV A,MT1
JZ A_D
MOV DPTR,#FPT2-1
MOVX @DPTR,A ;MAKE THE FRACTIONS NEGATIVE
;
RECIP: ACALL PUSH_ONE
ACALL SWAP_ASTKA
AJMP ADIV
;
AEL1: DEC MT2
ACALL PUSH_T1
ACALL AMUL
SJMP AELP
;
SQ_ERR: LJMP E3XX ;LINK TO BAD ARG
;
newpage
;************************************************************
;
; SQUARE ROOT
;
;************************************************************
;
ASQR: ACALL AABS ;GET THE SIGN
JNZ SQ_ERR ;ERROR IF NEGATIVE
ACALL C_T2 ;COPY VARIABLE TO T2
ACALL POP_T1 ;SAVE IT IN T1
MOV R0,#LO(FPT1)
MOVX A,@R0 ;GET EXPONENT
JZ ALN-2 ;EXIT IF ZERO
ADD A,#128 ;BIAS THE EXPONENT
JNC SQR1 ;SEE IF < 80H
RR A
ANL A,#127
SJMP SQR2
;
SQR1: CPL A ;FLIP BITS
INC A
RR A
ANL A,#127 ;STRIP MSB
CPL A
INC A
;
SQR2: ADD A,#128 ;BIAS EXPONENT
MOVX @R0,A ;SAVE IT
;
; NEWGUESS = ( X/OLDGUESS + OLDGUESS) / 2
;
SQR4: ACALL P_T2 ;TOS = X
ACALL PUSH_T1 ;PUT NUMBER ON STACK
ACALL ADIV ;TOS = X/GUESS
ACALL PUSH_T1 ;PUT ON AGAIN
ACALL AADD ;TOS = X/GUESS + GUESS
ACALL DBTWO ;TOS = ( X/GUESS + GUESS ) / 2
ACALL TEMP_COMP ;SEE IF DONE
JNB F0,SQR4
;
AJMP PUSH_T1 ;PUT THE ANSWER ON THE STACK
;
newpage
;*************************************************************
;
; NATURAL LOG
;
;*************************************************************
;
ALN: ACALL AABS ;MAKE SURE THAT NUM IS POSITIVE
JNZ SQ_ERR ;ERROR IF NOT
MOV MT2,A ;CLEAR FOR LOOP
INC R0 ;POINT AT EXPONENT
MOVX A,@R0 ;READ THE EXPONENT
JZ SQ_ERR ;ERROR IF EXPONENT IS ZERO
CJNE A,#81H,$+3 ;SEE IF NUM >= 1
MOV UBIT,C ;SAVE CARRY STATUS
JC $+4 ;TAKE RECIP IF >= 1
ACALL RECIP
;
; Loop to reduce
;
ALNL: ACALL CSTAKA ;COPY THE STACK FOR COMPARE
ACALL PUSH_ONE ;COMPARE NUM TO ONE
ACALL CMPLK
JNC ALNO ;EXIT IF DONE
ACALL SETREG ;GET THE EXPONENT
ADD A,#85H ;SEE HOW BIG IT IS
JNC ALN11 ;BUMP BY EXP(11) IF TOO SMALL
ACALL PLNEXP ;PUT EXP(1) ON STACK
MOV A,#1 ;BUMP COUNT
;
ALNE: ADD A,MT2
JC SQ_ERR
MOV MT2,A
ACALL AMUL ;BIAS THE NUMBER
SJMP ALNL
;
ALN11: MOV DPTR,#EXP11 ;PUT EXP(11) ON STACK
ACALL PUSHC
MOV A,#11
SJMP ALNE
;
newpage
ALNO: ACALL C_T2 ;PUT NUM IN TEMP 2
ACALL PUSH_ONE ;TOS = 1
ACALL ASUB ;TOS = X - 1
ACALL P_T2 ;TOS = X
ACALL PUSH_ONE ;TOS = 1
ACALL AADD ;TOS = X + 1
ACALL ADIV ;TOS = (X-1)/(X+1)
MOV DPTR,#LNTAB ;LOG TABLE
ACALL POLYC
INC DPTR ;POINT AT LN(10)
ACALL PUSHC
ACALL AMUL
MOV A,MT2 ;GET THE COUNT
ACALL TWO_R2 ;PUT IT ON THE STACK
ACALL ASUB ;INT - POLY
ACALL STRIP
JNB UBIT,AABS
;
LN_D: RET
;
;*************************************************************
;
TEMP_COMP: ; Compare FPTEMP1 to TOS, FPTEMP1 gets TOS
;
;*************************************************************
;
ACALL PUSH_T1 ;SAVE THE TEMP
ACALL SWAP_ASTKA ;TRADE WITH THE NEXT NUMBER
ACALL CSTAKA ;COPY THE STACK
ACALL POP_T1 ;SAVE THE NEW NUMBER
JMP FP_BASE+4 ;DO THE COMPARE
;
newpage
AETOX: ACALL PLNEXP ;EXP(1) ON TOS
ACALL SWAP_ASTKA ;X ON TOS
;
AEXP: ;EXPONENTIATION
;
ACALL EBIAS ;T1=BASE,T2=FRACTIONS,TOS=INT MULTIPLIED
MOV DPTR,#FPT2 ;POINT AT FRACTIONS
MOVX A,@DPTR ;READ THE EXP OF THE FRACTIONS
JZ LN_D ;EXIT IF ZERO
ACALL P_T2 ;TOS = FRACTIONS
ACALL PUSH_T1 ;TOS = BASE
ACALL SETREG ;SEE IF BASE IS ZERO
JZ $+4
ACALL ALN ;TOS = LN(BASE)
ACALL AMUL ;TOS = FRACTIONS * LN(BASE)
ACALL PLNEXP ;TOS = EXP(1)
ACALL SWAP_ASTKA ;TOS = FRACTIONS * LN(BASE)
ACALL EBIAS ;T2 = FRACTIONS, TOS = INT MULTIPLIED
MOV MT2,#00H ;NOW CALCULATE E**X
ACALL PUSH_ONE
ACALL CSTAKA
ACALL POP_T1 ;T1 = 1
;
AEXL: ACALL P_T2 ;TOS = FRACTIONS
ACALL AMUL ;TOS = FRACTIONS * ACCUMLATION
INC MT2 ;DO THE DEMONIATOR
MOV A,MT2
ACALL TWO_R2
ACALL ADIV
ACALL CSTAKA ;SAVE THE ITERATION
ACALL PUSH_T1 ;NOW ACCUMLATE
ACALL AADD ;ADD ACCUMLATION
ACALL TEMP_COMP
JNB F0,AEXL ;LOOP UNTIL DONE
;
ACALL INC_ASTKA
ACALL PUSH_T1
ACALL AMUL ;LAST INT MULTIPLIED
;
MU1: AJMP AMUL ;FIRST INT MULTIPLIED
;
newpage
;***************************************************************
;
; integer operator - INT
;
;***************************************************************
;
AINT: ACALL SETREG ;SET UP THE REGISTERS, CLEAR CARRY
SUBB A,#129 ;SUBTRACT EXPONENT BIAS
JNC AI1 ;JUMP IF ACC > 81H
;
; Force the number to be a zero
;
ACALL INC_ASTKA ;BUMP THE STACK
;
P_Z: MOV DPTR,#ZRO ;PUT ZERO ON THE STACK
AJMP PUSHC
;
AI1: SUBB A,#7
JNC AI3
CPL A
INC A
MOV R3,A
DEC R0 ;POINT AT SIGN
;
AI2: DEC R0 ;NOW AT LSB'S
MOVX A,@R0 ;READ BYTE
ANL A,#0F0H ;STRIP NIBBLE
MOVX @R0,A ;WRITE BYTE
DJNZ R3,$+3
RET
CLR A
MOVX @R0,A ;CLEAR THE LOCATION
DJNZ R3,AI2
;
AI3: RET ;EXIT
;
newpage
;***************************************************************
;
AABS: ; Absolute value - Make sign of number positive
; return sign in ACC
;
;***************************************************************
;
ACALL ANEG ;CHECK TO SEE IF + OR -
JNZ ALPAR ;EXIT IF NON ZERO, BECAUSE THE NUM IS
MOVX @R0,A ;MAKE A POSITIVE SIGN
RET
;
;***************************************************************
;
ASGN: ; Returns the sign of the number 1 = +, -1 = -
;
;***************************************************************
;
ACALL INC_ASTKA ;POP STACK, GET EXPONENT
JZ P_Z ;EXIT IF ZERO
DEC R0 ;BUMP TO SIGN
MOVX A,@R0 ;GET THE SIGN
MOV R7,A ;SAVE THE SIGN
ACALL PUSH_ONE ;PUT A ONE ON THE STACK
MOV A,R7 ;GET THE SIGN
JZ ALPAR ;EXIT IF ZERO
;
; Fall thru to ANEG
;
;***************************************************************
;
ANEG: ; Flip the sign of the number on the tos
;
;***************************************************************
;
ACALL SETREG
DEC R0 ;POINT AT THE SIGN OF THE NUMBER
JZ ALPAR ;EXIT IF ZERO
MOVX A,@R0
XRL A,#01H ;FLIP THE SIGN
MOVX @R0,A
XRL A,#01H ;RESTORE THE SIGN
;
ALPAR: RET
;
newpage
;***************************************************************
;
ACBYTE: ; Read the ROM
;
;***************************************************************
;
ACALL IFIX ;GET EXPRESSION
CALL X31DP ;PUT R3:R1 INTO THE DP
CLR A
MOVC A,@A+DPTR
AJMP TWO_R2
;
;***************************************************************
;
ADBYTE: ; Read internal memory
;
;***************************************************************
;
ACALL IFIX ;GET THE EXPRESSION
CALL R3CK ;MAKE SURE R3 = 0
MOV A,@R1
AJMP TWO_R2
;
;***************************************************************
;
AXBYTE: ; Read external memory
;
;***************************************************************
;
ACALL IFIX ;GET THE EXPRESSION
MOV P2,R3
MOVX A,@R1
AJMP TWO_R2
;
newpage
;***************************************************************
;
; The relational operators - EQUAL (=)
; GREATER THAN (>)
; LESS THAN (<)
; GREATER THAN OR EQUAL (>=)
; LESS THAN OR EQUAL (<=)
; NOT EQUAL (<>)
;
;***************************************************************
;
AGT: ACALL CMPLK
ORL C,F0 ;SEE IF EITHER IS A ONE
JC P_Z
;
FSTK: MOV DPTR,#FS
AJMP PUSHC
;
FS: DB 85H
DB 00H
DB 00H
DB 50H
DB 53H
DB 65H
;
ALT: ACALL CMPLK
CPL C
SJMP AGT+4
;
AEQ: ACALL CMPLK
MOV C,F0
SJMP ALT+2
;
ANE: ACALL CMPLK
CPL F0
SJMP AEQ+2
;
AGE: ACALL CMPLK
SJMP AGT+4
;
ALE: ACALL CMPLK
ORL C,F0
SJMP ALT+2
;
newpage
;***************************************************************
;
ARND: ; Generate a random number
;
;***************************************************************
;
MOV DPTR,#RCELL ;GET THE BINARY SEED
CALL L31DPI
MOV A,R1
CLR C
RRC A
MOV R0,A
MOV A,#6
RRC A
ADD A,R1
XCH A,R0
ADDC A,R3
MOV R2,A
DEC DPL ;SAVE THE NEW SEED
ACALL S20DP
ACALL TWO_EY
ACALL FSTK
;
ADIV: LCALL FP_BASE+8
AJMP FPTST
;
newpage
;***************************************************************
;
SONERR: ; ON ERROR Statement
;
;***************************************************************
;
LCALL INTERR ;GET THE LINE NUMBER
SETB ON_ERR
MOV DPTR,#ERRNUM ;POINT AT THR ERROR LOCATION
SJMP S20DP
;
;
;**************************************************************
;
SONEXT: ; ON EXT1 Statement
;
;**************************************************************
;
LCALL INTERR
SETB INTBIT
ORL IE,#10000100B ;ENABLE INTERRUPTS
MOV DPTR,#INTLOC
;
S20DP: MOV A,R2 ;SAVE R2:R0 @DPTR
MOVX @DPTR,A
INC DPTR
MOV A,R0
MOVX @DPTR,A
RET
;
newpage
;***************************************************************
;
; CASTAK - Copy and push another top of arg stack
;
;***************************************************************
;
CSTAKA2:ACALL CSTAKA ;COPY STACK TWICE
;
CSTAKA: ACALL SETREG ;SET UP R2:R0
SJMP PUSH_T1+4
;
PLNEXP: MOV DPTR,#EXP1
;
;***************************************************************
;
; PUSHC - Push constant on to the arg stack
;
;***************************************************************
;
PUSHC: ACALL DEC_ASTKA
MOV P2,R3
MOV R3,#FPSIZ ;LOOP COUNTER
;
PCL: CLR A ;SET UP A
MOVC A,@A+DPTR ;LOAD IT
MOVX @R1,A ;SAVE IT
INC DPTR ;BUMP POINTERS
DEC R1
DJNZ R3,PCL ;LOOP
;
SETB ARGF
RET ;EXIT
;
PUSH_ONE:;
;
MOV DPTR,#FPONE
AJMP PUSHC
;
newpage
;
POP_T1:
;
MOV R3,#HI(FPT1)
MOV R1,#LO(FPT1)
JMP POPAS
;
PUSH_T1:
;
MOV R0,#LO(FPT1)
MOV R2,#HI(FPT1)
LJMP PUSHAS
;
P_T2: MOV R0,#LO(FPT2)
SJMP $-7 ;JUMP TO PUSHAS
;
;****************************************************************
;
SWAP_ASTKA: ; SWAP TOS<>TOS-1
;
;****************************************************************
;
ACALL SETREG ;SET UP R2:R0 AND P2
MOV A,#FPSIZ ;PUT TOS+1 IN R1
MOV R2,A
ADD A,R0
MOV R1,A
;
S_L: MOVX A,@R0
MOV R3,A
MOVX A,@R1
MOVX @R0,A
MOV A,R3
MOVX @R1,A
DEC R1
DEC R0
DJNZ R2,S_L
RET
;
newpage
;
C_T2: ACALL SETREG ;SET UP R2:R0
MOV R3,#HI(FPT2)
MOV R1,#LO(FPT2) ;TEMP VALUE
;
; Fall thru
;
;***************************************************************
;
; VARCOP - Copy a variable from R2:R0 to R3:R1
;
;***************************************************************
;
VARCOP: MOV R4,#FPSIZ ;LOAD THE LOOP COUNTER
;
V_C: MOV P2,R2 ;SET UP THE PORTS
MOVX A,@R0 ;READ THE VALUE
MOV P2,R3 ;PORT TIME AGAIN
MOVX @R1,A ;SAVE IT
ACALL DEC3210 ;BUMP POINTERS
DJNZ R4,V_C ;LOOP
RET ;EXIT
;
PIPI: MOV DPTR,#PIE
AJMP PUSHC
;
newpage
;***************************************************************
;
; The logical operators ANL, ORL, XRL, NOT
;
;***************************************************************
;
AANL: ACALL TWOL ;GET THE EXPRESSIONS
MOV A,R3 ;DO THE AND
ANL A,R7
MOV R2,A
MOV A,R1
ANL A,R6
SJMP TWO_EX
;
AORL: ACALL TWOL ;SAME THING FOR OR
MOV A,R3
ORL A,R7
MOV R2,A
MOV A,R1
ORL A,R6
SJMP TWO_EX
;
ANOT: ACALL FSTK ;PUT 0FFFFH ON THE STACK
;
AXRL: ACALL TWOL
MOV A,R3
XRL A,R7
MOV R2,A
MOV A,R1
XRL A,R6
SJMP TWO_EX
;
TWOL: ACALL IFIX
MOV R7,R3B0
MOV R6,R1B0
AJMP IFIX
;
newpage
;*************************************************************
;
AGET: ; READ THE BREAK BYTE AND PUT IT ON THE ARG STACK
;
;*************************************************************
;
MOV DPTR,#GTB ;GET THE BREAK BYTE
MOVX A,@DPTR
JBC GTRD,TWO_R2
CLR A
;
TWO_R2: MOV R2,#00H ;ACC GOES TO STACK
;
;
TWO_EX: MOV R0,A ;R2:ACC GOES TO STACK
;
;
TWO_EY: SETB ARGF ;R2:R0 GETS PUT ON THE STACK
JMP FP_BASE+24 ;DO IT
;
newpage
;*************************************************************
;
; Put directs onto the stack
;
;**************************************************************
;
A_IE: MOV A,IE ;IE
SJMP TWO_R2
;
A_IP: MOV A,IP ;IP
SJMP TWO_R2
;
ATIM0: MOV R2,TH0 ;TIMER 0
MOV R0,TL0
SJMP TWO_EY
;
ATIM1: MOV R2,TH1 ;TIMER 1
MOV R0,TL1
SJMP TWO_EY
;
ATIM2: DB 0AAH ;MOV R2 DIRECT OP CODE
DB 0CDH ;T2 HIGH
DB 0A8H ;MOV R0 DIRECT OP CODE
DB 0CCH ;T2 LOW
SJMP TWO_EY ;TIMER 2
;
AT2CON: DB 0E5H ;MOV A,DIRECT OPCODE
DB 0C8H ;T2CON LOCATION
SJMP TWO_R2
;
ATCON: MOV A,TCON ;TCON
SJMP TWO_R2
;
ATMOD: MOV A,TMOD ;TMOD
SJMP TWO_R2
;
ARCAP2: DB 0AAH ;MOV R2, DIRECT OP CODE
DB 0CBH ;RCAP2H LOCATION
DB 0A8H ;MOV R0, DIRECT OP CODE
DB 0CAH ;R2CAPL LOCATION
SJMP TWO_EY
;
AP1: MOV A,P1 ;GET P1
SJMP TWO_R2 ;PUT IT ON THE STACK
;
APCON: DB 0E5H ;MOV A, DIRECT OP CODE
DB 87H ;ADDRESS OF PCON
SJMP TWO_R2 ;PUT PCON ON THE STACK
;
newpage
;***************************************************************
;
;THIS IS THE LINE EDITOR
;
;TAKE THE PROCESSED LINE IN IBUF AND INSERT IT INTO THE
;BASIC TEXT FILE.
;
;***************************************************************
;
LJMP NOGO ;CAN'T EDIT A ROM
;
LINE: MOV A,BOFAH
CJNE A,#HI(PSTART),LINE-3
CALL G4 ;GET END ADDRESS FOR EDITING
MOV R4,DPL
MOV R5,DPH
MOV R3,TEMP5 ;GET HIGH ORDER IBLN
MOV R1,TEMP4 ;LOW ORDER IBLN
;
CALL GETLIN ;FIND THE LINE
JNZ INSR ;INSERT IF NOT ZERO, ELSE APPEND
;
;APPEND THE LINE AT THE END
;
MOV A,TEMP3 ;PUT IBCNT IN THE ACC
CJNE A,#4H,$+4 ;SEE IF NO ENTRY
RET ;RET IF NO ENTRY
;
ACALL FULL ;SEE IF ENOUGH SPACE LEFT
MOV R2,R5B0 ;PUT END ADDRESS A INTO TRANSFER
MOV R0,R4B0 ;REGISTERS
ACALL IMOV ;DO THE BLOCK MOVE
;
UE: MOV A,#EOF ;SAVE EOF CHARACTER
AJMP TBR
;
;INSERT A LINE INTO THE FILE
;
INSR: MOV R7,A ;SAVE IT IN R7
CALL TEMPD ;SAVE INSERATION ADDRESS
MOV A,TEMP3 ;PUT THE COUNT LENGTH IN THE ACC
JC LTX ;JUMP IF NEW LINE # NOT = OLD LINE #
CJNE A,#04H,$+4 ;SEE IF NULL
CLR A
;
SUBB A,R7 ;SUBTRACT LINE COUNT FROM ACC
JZ LIN1 ;LINE LENGTHS EQUAL
JC GTX ;SMALLER LINE
;
newpage
;
;EXPAND FOR A NEW LINE OR A LARGER LINE
;
LTX: MOV R7,A ;SAVE A IN R7
MOV A,TEMP3 ;GET THE COUNT IN THE ACC
CJNE A,#04H,$+4 ;DO NO INSERTATION IF NULL LINE
RET ;EXIT IF IT IS
;
MOV A,R7 ;GET THE COUNT BACK - DELTA IN A
ACALL FULL ;SEE IF ENOUGH MEMORY NEW EOFA IN R3:R1
CALL DTEMP ;GET INSERATION ADDRESS
ACALL NMOV ;R7:R6 GETS (EOFA)-DPTR
CALL X3120
MOV R1,R4B0 ;EOFA LOW
MOV R3,R5B0 ;EOFA HIGH
INC R6 ;INCREMENT BYTE COUNT
CJNE R6,#00,$+4 ;NEED TO BUMP HIGH BYTE?
INC R7
;
ACALL RMOV ;GO DO THE INSERTION
SJMP LIN1 ;INSERT THE CURRENT LINE
;
GTX: CPL A ;FLIP ACC
INC A ;TWOS COMPLEMENT
CALL ADDPTR ;DO THE ADDITION
ACALL NMOV ;R7:R6 GETS (EOFA)-DPTR
MOV R1,DPL ;SET UP THE REGISTERS
MOV R3,DPH
MOV R2,TEMP5 ;PUT INSERTATION ADDRESS IN THE RIGHT REG
MOV R0,TEMP4
JZ $+4 ;IF ACC WAS ZERO FROM NMOV, JUMP
ACALL LMOV ;IF NO ZERO DO A LMOV
;
ACALL UE ;SAVE NEW END ADDRESS
;
LIN1: MOV R2,TEMP5 ;GET THE INSERTATION ADDRESS
MOV R0,TEMP4
MOV A,TEMP3 ;PUT THE COUNT LENGTH IN ACC
CJNE A,#04H,IMOV ;SEE IF NULL
RET ;EXIT IF NULL
newpage
;***************************************************************
;
;INSERT A LINE AT ADDRESS R2:R0
;
;***************************************************************
;
IMOV: CLR A ;TO SET UP
MOV R1,#LO(IBCNT) ;INITIALIZE THE REGISTERS
MOV R3,A
MOV R6,TEMP3 ;PUT THE BYTE COUNT IN R6 FOR LMOV
MOV R7,A ;PUT A 0 IN R7 FOR LMOV
;
;***************************************************************
;
;COPY A BLOCK FROM THE BEGINNING
;
;R2:R0 IS THE DESTINATION ADDRESS
;R3:R1 IS THE SOURCE ADDRESS
;R7:R6 IS THE COUNT REGISTER
;
;***************************************************************
;
LMOV: ACALL TBYTE ;TRANSFER THE BYTE
ACALL INC3210 ;BUMP THE POINTER
ACALL DEC76 ;BUMP R7:R6
JNZ LMOV ;LOOP
RET ;GO BACK TO CALLING ROUTINE
;
INC3210:INC R0
CJNE R0,#00H,$+4
INC R2
;
INC R1
CJNE R1,#00H,$+4
INC R3
RET
;
newpage
;***************************************************************
;
;COPY A BLOCK STARTING AT THE END
;
;R2:R0 IS THE DESTINATION ADDRESS
;R3:R1 IS THE SOURCE ADDRESS
;R6:R7 IS THE COUNT REGISTER
;
;***************************************************************
;
RMOV: ACALL TBYTE ;TRANSFER THE BYTE
ACALL DEC3210 ;DEC THE LOCATIONS
ACALL DEC76 ;BUMP THE COUNTER
JNZ RMOV ;LOOP
;
DEC_R: NOP ;CREATE EQUAL TIMING
RET ;EXIT
;
DEC3210:DEC R0 ;BUMP THE POINTER
CJNE R0,#0FFH,$+4 ;SEE IF OVERFLOWED
DEC R2 ;BUMP THE HIGH BYTE
DEC R1 ;BUMP THE POINTER
CJNE R1,#0FFH,DEC_R ;SEE IF OVERFLOWED
DEC R3 ;CHANGE THE HIGH BYTE
RET ;EXIT
;
;***************************************************************
;
;TBYTE - TRANSFER A BYTE
;
;***************************************************************
;
TBYTE: MOV P2,R3 ;OUTPUT SOURCE REGISTER TO PORT
MOVX A,@R1 ;PUT BYTE IN ACC
;
TBR: MOV P2,R2 ;OUTPUT DESTINATION TO PORT
MOVX @R0,A ;SAVE THE BYTE
RET ;EXIT
;
newpage
;***************************************************************
;
;NMOV - R7:R6 = END ADDRESS - DPTR
;
;ACC GETS CLOBBERED
;
;***************************************************************
;
NMOV: MOV A,R4 ;THE LOW BYTE OF EOFA
CLR C ;CLEAR THE CARRY FOR SUBB
SUBB A,DPL ;SUBTRACT DATA POINTER LOW
MOV R6,A ;PUT RESULT IN R6
MOV A,R5 ;HIGH BYTE OF EOFA
SUBB A,DPH ;SUBTRACT DATA POINTER HIGH
MOV R7,A ;PUT RESULT IN R7
ORL A,R6 ;SEE IF ZERO
RET ;EXIT
;
;***************************************************************
;
;CHECK FOR A FILE OVERFLOW
;LEAVES THE NEW END ADDRESS IN R3:R1
;A HAS THE INCREASE IN SIZE
;
;***************************************************************
;
FULL: ADD A,R4 ;ADD A TO END ADDRESS
MOV R1,A ;SAVE IT
CLR A
ADDC A,R5 ;ADD THE CARRY
MOV R3,A
MOV DPTR,#VARTOP ;POINT AT VARTOP
;
FUL1: CALL DCMPX ;COMPARE THE TWO
JC FULL-1 ;OUT OF ROOM
;
TB: MOV DPTR,#E5X ;OUT OF MEMORY
AJMP FPTS
;
newpage
;***************************************************************
;
; PP - Preprocesses the line in IBUF back into IBUF
; sets F0 if no line number
; leaves the correct length of processed line in IBCNT
; puts the line number in IBLN
; wastes the text address TXAL and TXAH
;
;***************************************************************
;
PP: ACALL T_BUF ;TXA GETS IBUF
CALL INTGER ;SEE IF A NUMBER PRESENT
CALL TEMPD ;SAVE THE INTEGER IN TEMP5:TEMP4
MOV F0,C ;SAVE INTEGER IF PRESENT
MOV DPTR,#IBLN ;SAVE THE LINE NUMBER, EVEN IF NONE
ACALL S20DP
MOV R0,TXAL ;TEXT POINTER
MOV R1,#LO(IBUF) ;STORE POINTER
;
; Now process the line back into IBUF
;
PPL: CLR ARGF ;FIRST PASS DESIGNATOR
MOV DPTR,#TOKTAB ;POINT DPTR AT LOOK UP TABLE
;
PPL1: MOV R5B0,R0 ;SAVE THE READ POINTER
CLR A ;ZERO A FOR LOOKUP
MOVC A,@A+DPTR ;GET THE TOKEN
MOV R7,A ;SAVE TOKEN IN CASE OF MATCH
;
PPL2: MOVX A,@R0 ;GET THE USER CHARACTER
MOV R3,A ;SAVE FOR REM
CJNE A,#'a',$+3
JC PPX ;CONVERT LOWER TO UPPER CASE
CJNE A,#('z'+1),$+3
JNC PPX
CLR ACC.5
;
PPX: MOV R2,A
MOVX @R0,A ;SAVE UPPER CASE
INC DPTR ;BUMP THE LOOKUP POINTER
CLR A
MOVC A,@A+DPTR
CJNE A,R2B0,PPL3 ;LEAVE IF NOT THE SAME
INC R0 ;BUMP THE USER POINTER
SJMP PPL2 ;CONTINUE TO LOOP
;
PPL3: JB ACC.7,PPL6 ;JUMP IF FOUND MATCH
JZ PPL6 ;USER MATCH
;
;
; Scan to the next TOKTAB entry
;
PPL4: INC DPTR ;ADVANCE THE POINTER
CLR A ;ZERO A FOR LOOKUP
MOVC A,@A+DPTR ;LOAD A WITH TABLE
JB ACC.7,$+6 ;KEEP SCANNING IF NOT A RESERVED WORD
JNZ PPL4
INC DPTR
;
; See if at the end of TOKTAB
;
MOV R0,R5B0 ;RESTORE THE POINTER
CJNE A,#0FFH,PPL1 ;SEE IF END OF TABLE
;
; Character not in TOKTAB, so see what it is
;
CJNE R2,#' ',PPLX ;SEE IF A SPACE
INC R0 ;BUMP USER POINTER
SJMP PPL ;TRY AGAIN
;
PPLX: JNB XBIT,PPLY ;EXTERNAL TRAP
JB ARGF,PPLY
SETB ARGF ;SAYS THAT THE USER HAS TABLE
LCALL 2078H ;SET UP POINTER
AJMP PPL1
;
PPLY: ACALL PPL7 ;SAVE CHARACTER, EXIT IF A CR
CJNE A,#'"',PPL ;SEE IF QUOTED STRING, START AGAIN IF NOT
;
; Just copy a quoted string
;
ACALL PPL7 ;SAVE THE CHARACTER, TEST FOR CR
CJNE A,#'"',$-2 ;IS THERE AN ENDQUOTE, IF NOT LOOP
SJMP PPL ;DO IT AGAIN IF ENDQUOTE
;
PPL6: MOV A,R7 ;GET THE TOKEN
ACALL PPL9+1 ;SAVE THE TOKEN
CJNE A,#T_REM,PPL ;SEE IF A REM TOKEN
MOV A,R3
ACALL PPL7+1 ;WASTE THE REM STATEMENT
ACALL PPL7 ;LOOP UNTIL A CR
SJMP $-2
;
PPL7: MOVX A,@R0 ;GET THE CHARACTER
CJNE A,#CR,PPL9 ;FINISH IF A CR
POP R0B0 ;WASTE THE CALLING STACK
POP R0B0
MOVX @R1,A ;SAVE CR IN MEMORY
INC R1 ;SAVE A TERMINATOR
MOV A,#EOF
MOVX @R1,A
MOV A,R1 ;SUBTRACT FOR LENGTH
SUBB A,#4
MOV TEMP3,A ;SAVE LENGTH
MOV R1,#LO(IBCNT) ;POINT AT BUFFER COUNT
;
PPL9: INC R0
MOVX @R1,A ;SAVE THE CHARACTER
INC R1 ;BUMP THE POINTERS
RET ;EXIT TO CALLING ROUTINE
;
;
;***************************************************************
;
;DEC76 - DECREMENT THE REGISTER PAIR R7:R6
;
;ACC = ZERO IF R7:R6 = ZERO ; ELSE ACC DOES NOT
;
;***************************************************************
;
DEC76: DEC R6 ;BUMP R6
CJNE R6,#0FFH,$+4 ;SEE IF RAPPED AROUND
DEC R7
MOV A,R7 ;SEE IF ZERO
ORL A,R6
RET ;EXIT
;
;***************************************************************
;
; MTOP - Get or Put the top of assigned memory
;
;***************************************************************
;
PMTOP: MOV DPTR,#MEMTOP
CALL L20DPI
AJMP TWO_EY ;PUT R2:R0 ON THE STACK
;
newpage
;*************************************************************
;
; AXTAL - Crystal value calculations
;
;*************************************************************
;
AXTAL0: MOV DPTR,#XTALV ;CRYSTAL VALUE
ACALL PUSHC
;
AXTAL1: ACALL CSTAKA2 ;COPY CRYSTAL VALUE TWICE
ACALL CSTAKA
MOV DPTR,#PTIME ;PROM TIMER
ACALL AXTAL2
MOV DPTR,#PROGS
ACALL S31L
MOV DPTR,#IPTIME ;IPROM TIMER
ACALL AXTAL2
MOV DPTR,#IPROGS
ACALL S31L
MOV DPTR,#TTIME ;CLOCK CALCULATION
ACALL AXTAL3
MOV A,R1
CPL A
INC A
MOV SAVE_T,A
MOV R3,#HI(CXTAL)
MOV R1,#LO(CXTAL)
JMP POPAS
;
AXTAL2: ACALL AXTAL3
;
CBIAS: ;Bias the crystal calculations
;
MOV A,R1 ;GET THE LOW COUNT
CPL A ;FLIP IT FOR TIMER LOAD
ADD A,#15 ;BIAS FOR CALL AND LOAD TIMES
MOV R1,A ;RESTORE IT
MOV A,R3 ;GET THE HIGH COUNT
CPL A ;FLIP IT
ADDC A,#00H ;ADD THE CARRY
MOV R3,A ;RESTORE IT
RET
;
newpage
include bas52.pwm ; ******AA
newpage
;LNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLN
;
LNTAB: ; Natural log lookup table
;
;LNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLN
;
DB 80H
DB 00H
DB 71H
DB 37H
DB 13H
DB 19H
;
DB 7FH
DB 00H
DB 76H
DB 64H
DB 37H
DB 94H
;
DB 80H
DB 00H
DB 07H
DB 22H
DB 75H
DB 17H
;
DB 80H
DB 00H
DB 52H
DB 35H
DB 93H
DB 28H
;
DB 80H
DB 00H
DB 71H
DB 91H
DB 85H
DB 86H
;
DB 0FFH
;
DB 81H
DB 00H
DB 51H
DB 58H
DB 02H
DB 23H
;
newpage
;SINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSIN
;
SINTAB: ; Sin lookup table
;
;SINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSIN
;
DB 128-9
DB 00H
DB 44H
DB 90H
DB 05H
DB 16H
;
DB 128-7
DB 01H
DB 08H
DB 21H
DB 05H
DB 25H
;
DB 128-5
DB 00H
DB 19H
DB 73H
DB 55H
DB 27H
;
newpage
;
DB 128-3
DB 01H
DB 70H
DB 12H
DB 84H
DB 19H
;
DB 128-2
DB 00H
DB 33H
DB 33H
DB 33H
DB 83H
;
DB 128
DB 01H
DB 67H
DB 66H
DB 66H
DB 16H
;
FPONE: DB 128+1
DB 00H
DB 00H
DB 00H
DB 00H
DB 10H
;
DB 0FFH ;END OF TABLE
;
newpage
;
SBAUD: CALL AXTAL ;PUT CRYSTAL ON THE STACK
CALL EXPRB ;PUT THE NUMBER AFTER BAUD ON STACK
MOV A,#12
ACALL TWO_R2 ;TOS = 12
ACALL AMUL ;TOS = 12*BAUD
ACALL ADIV ;TOS = XTAL/(12*BAUD)
ACALL IFIX
ACALL CBIAS
MOV DPTR,#SPV
;
S31L: JMP S31DP
;
AFREE: CALL PMTOP ;PUT MTOP ON STACK
CALL G4 ;GET END ADDRESS
MOV R0,DPL
MOV R2,DPH
ACALL TWO_EY
;
ASUB: LCALL FP_BASE+2 ;DO FP SUB
AJMP FPTST
;
ALEN: CALL CCAL ;CALCULATE THE LEN OF THE SELECTED PROGRAM
MOV R2,R7B0 ;SAVE THE HIGH BYTE
MOV A,R6 ;SAVE THE LOW BYTE
AJMP TWO_EX ;PUT IT ON THE STACK
;
ATIME: MOV C,EA ;SAVE INTERRUTS
CLR EA
PUSH MILLIV ;SAVE MILLI VALUE
MOV R2,TVH ;GET THE TIMER
MOV A,TVL
MOV EA,C ;SAVE INTERRUPTS
ACALL TWO_EX ;PUT TIMER ON THE STACK
POP ACC ;GET MILLI
ACALL TWO_R2 ;PUT MILLI ON STACK
MOV A,#200
ACALL TWO_R2 ;DIVIDE MILLI BY 200
ACALL ADIV
;
AADD: LCALL FP_BASE ;DO FP ADDITION
AJMP FPTST ;CHECK FOR ERRORS
;
newpage
;**************************************************************
;
; Here are some error messages that were moved
;
;**************************************************************
;
;
E1X: DB "BAD SYNTAX",'"'
E2X: DB 128+10
DB "DIVIDE BY ZERO",'"'
;
E6X: DB "ARRAY SIZE",'"'
;
newpage
;**************************************************************
;
T_BUF: ; TXA gets IBUF
;
;**************************************************************
;
MOV TXAH,#HI(IBUF)
MOV TXAL,#LO(IBUF)
RET
;
;
;***************************************************************
;
CXFER: ; Transfer a program from rom to ram
;
;***************************************************************
;
CALL CCAL ;GET EVERYTHING SET UP
MOV R2,#HI(PSTART)
MOV R0,#LO(PSTART)
ACALL LMOV ;DO THE TRANSFER
CALL RCLEAR ;CLEAR THE MEMORY
;
; Fall thru to CRAM
;
;***************************************************************
;
CRAM: ; The command action routine - RAM - Run out of ram
;
;***************************************************************
;
CLR CONB ;CAN'T CONTINUE IF MODE CHANGE
MOV BOFAH,#HI(PSTART)
MOV BOFAL,#LO(PSTART)
;
; Fall thru to Command Processor
;
newpage
;***************************************************************
;
CMND1: ; The entry point for the command processor
;
;***************************************************************
;
LCALL SPRINT+4 ;WASTE AT AND HEX
CLR XBIT ;TO RESET IF NEEDED
CLR A
MOV DPTR,#2002H ;CHECK FOR EXTERNAL TRAP PACKAGE
MOVC A,@A+DPTR
CJNE A,#5AH,$+6
LCALL 2048H ;IF PRESENT JUMP TO LOCATION 200BH
MOV DPTR,#RDYS ;PRINT THE READY MESSAGE
CALL CRP ;DO A CR, THEN, PRINT FROM THE ROM
;
CMNDR: SETB DIRF ;SET THE DIRECT INPUT BIT
MOV SP,SPSAV ;LOAD THE STACK
ACALL CL7 ;DO A CRLF
;
CMNX: CLR GTRD ;CLEAR BREAK
MOV DPTR,#5EH ;DO RUN TRAP
MOVX A,@DPTR
XRL A,#52
JNZ $+5
LJMP CRUN
MOV R5,#'>' ;OUTPUT A PROMPT
LCALL TEROT
CALL INLINE ;INPUT A LINE INTO IBUF
CALL PP ;PRE-PROCESS THE LINE
JB F0,CMND3 ;NO LINE NUMBER
CALL LINE ;PROCESS THE LINE
LCALL LCLR
JB LINEB,CMNX ;DON'T CLEAR MEMORY IF NO NEED
SETB LINEB
LCALL RCLEAR ;CLEAR THE MEMORY
SJMP CMNX ;LOOP BACK
;
CMND3: CALL T_BUF ;SET UP THE TEXT POINTER
CALL DELTST ;GET THE CHARACTER
JZ CMNDR ;IF CR, EXIT
MOV DPTR,#CMNDD ;POINT AT THE COMMAND LOOKUP
CJNE A,#T_CMND,$+3 ;PROCESS STATEMENT IF NOT A COMMAND
JC CMND5
CALL GCI1 ;BUMP TXA
ANL A,#0FH ;STRIP MSB'S FOR LOOKUP
LCALL ISTA1 ;PROCESS COMMAND
SJMP CMNDR
;
CMND5: LJMP ILOOP ;CHECK FOR A POSSIBLE BREAK
;
;
;
;CONSTANTS
;
XTALV: DB 128+8 ; DEFAULT CRYSTAL VALUE
DB 00H
DB 00H
DB 92H
DB 05H
DB 11H
;
EXP11: DB 85H
DB 00H
DB 42H
DB 41H
DB 87H
DB 59H
;
EXP1: DB 128+1 ; EXP(1)
DB 00H
DB 18H
DB 28H
DB 18H
DB 27H
;
IPTIME: DB 128-4 ;FPROG TIMING
DB 00H
DB 00H
DB 00H
DB 75H
DB 83H
;
PIE: DB 128+1 ;PI
DB 00H
DB 26H
DB 59H
DB 41H
DB 31H ; 3.1415926
;
newpage
;***************************************************************
;
; The error messages, some have been moved
;
;***************************************************************
;
E7X: DB 128+30
DB "ARITH. UNDERFLOW",'"'
;
E5X: DB "MEMORY ALLOCATION",'"'
;
E3X: DB 128+40
DB "BAD ARGUMENT",'"'
;
EXI: DB "I-STACK",'"'
;
newpage
;***************************************************************
;
; The command action routine - CONTINUE
;
;***************************************************************
;
CCONT: MOV DPTR,#E15X
JNB CONB,ERROR ;ERROR IF CONTINUE IS NOT SET
;
CC1: ;used for input statement entry
;
MOV TXAH,INTXAH ;RESTORE TXA
MOV TXAL,INTXAL
JMP CILOOP ;EXECUTE
;
DTEMP: MOV DPH,TEMP5 ;RESTORE DPTR
MOV DPL,TEMP4
RET
;
TEMPD: MOV TEMP5,DPH
MOV TEMP4,DPL
RET
;
newpage
;**************************************************************
;
I_DL: ; IDLE
;
;**************************************************************
;
JB DIRF,E1XX ;SYNTAX ERROR IN DIRECT INPUT
CLR DACK ;ACK IDLE
;
U_ID1: DB 01000011B ;ORL DIRECT OP CODE
DB 87H ;PCON ADDRESS
DB 01H ;SET IDLE BIT
JB INTPEN,I_RET ;EXIT IF EXTERNAL INTERRUPT
JBC U_IDL,I_RET ;EXIT IF USER WANTS TO
JNB OTS,U_ID1 ;LOOP IF TIMER NOT ENABLED
LCALL T_CMP ;CHECK THE TIMER
JC U_ID1 ;LOOP IF TIME NOT BIG ENOUGH
;
I_RET: SETB DACK ;RESTORE EXECUTION
RET ;EXIT IF IT IS
;
;
;
ER0: INC DPTR ;BUMP TO TEXT
JB DIRF,ERROR0 ;CAN'T GET OUT OF DIRECT MODE
JNB ON_ERR,ERROR0 ;IF ON ERROR ISN'T SET, GO BACK
MOV DPTR,#ERRLOC ;SAVE THE ERROR CODE
CALL RC2 ;SAVE ERROR AND SET UP THE STACKS
INC DPTR ;POINT AT ERRNUM
JMP ERL4 ;LOAD ERR NUM AND EXIT
;
newpage
;
; Syntax error
;
E1XX: MOV C,DIRF ;SEE IF IN DIRECT MODE
MOV DPTR,#E1X ;ERROR MESSAGE
SJMP ERROR+1 ;TRAP ON SET DIRF
;
MOV DPTR,#EXI ;STACK ERROR
;
; Falls through
;
;***************************************************************
;
;ERROR PROCESSOR - PRINT OUT THE ERROR TYPE, CHECK TO SEE IF IN
; RUN OR COMMAND MODE, FIND AND PRINT OUT THE
; LINE NUMBER IF IN RUN MODE
;
;***************************************************************
;
ERROR: CLR C ;RESET STACK
MOV SP,SPSAV ;RESET THE STACK
LCALL SPRINT+4 ;CLEAR LINE AND AT MODE
CLR A ;SET UP TO GET ERROR CODE
MOVC A,@A+DPTR
JBC ACC.7,ER0 ;PROCESS ERROR
;
ERROR0: ACALL TEMPD ;SAVE THE DATA POINTER
JC $+5 ;NO RESET IF CARRY IS SET
LCALL RC1 ;RESET THE STACKS
CALL CRLF2 ;DO TWO CARRIAGE RET - LINE FEED
MOV DPTR,#ERS ;OUTPUT ERROR MESSAGE
CALL ROM_P
CALL DTEMP ;GET THE ERROR MESSAGE BACK
;
ERRS: CALL ROM_P ;PRINT ERROR TYPE
JNB DIRF,ER1 ;DO NOT PRINT IN LINE IF DIRF=1
;
SERR1: CLR STOPBIT ;PRINT STOP THEN EXIT, FOR LIST
JMP CMND1
;
ER1: MOV DPTR,#INS ;OUTPUT IN LINE
CALL ROM_P
;
;NOW, FIND THE LINE NUMBER
;
;
newpage
;
;
CALL DP_B ;GET THE FIRST ADDRESS OF THE PROGRAM
CLR A ;FOR INITIALIZATION
;
ER2: ACALL TEMPD ;SAVE THE DPTR
CALL ADDPTR ;ADD ACC TO DPTR
ACALL ER4 ;R3:R1 = TXA-DPTR
JC ER3 ;EXIT IF DPTR>TXA
JZ ER3 ;EXIT IF DPTR=TXA
MOVX A,@DPTR ;GET LENGTH
CJNE A,#EOF,ER2 ;SEE IF AT THE END
;
ER3: ACALL DTEMP ;PUT THE LINE IN THE DPTR
ACALL ER4 ;R3:R1 = TXA - BEGINNING OF LINE
MOV A,R1 ;GET LENGTH
ADD A,#10 ;ADD 10 TO LENGTH, DPTR STILL HAS ADR
MOV MT1,A ;SAVE THE COUNT
INC DPTR ;POINT AT LINE NUMBER HIGH BYTE
CALL PMTOP+3 ;LOAD R2:R0, PUT IT ON THE STACK
ACALL FP_BASE+14 ;OUTPUT IT
JB STOPBIT,SERR1 ;EXIT IF STOP BIT SET
CALL CRLF2 ;DO SOME CRLF'S
CALL DTEMP
CALL UPPL ;UNPROCESS THE LINE
CALL CL6 ;PRINT IT
MOV R5,#'-' ;OUTPUT DASHES, THEN AN X
ACALL T_L ;PRINT AN X IF ERROR CHARACTER FOUND
DJNZ MT1,$-4 ;LOOP UNTIL DONE
MOV R5,#'X'
ACALL T_L
AJMP SERR1
;
ER4: MOV R3,TXAH ;GET TEXT POINTER AND PERFORM SUBTRACTION
MOV R1,TXAL
JMP DUBSUB
;
newpage
;**************************************************************
;
; Interrupt driven timer
;
;**************************************************************
;
I_DR: MOV TH0,SAVE_T ;LOAD THE TIMER
XCH A,MILLIV ;SAVE A, GET MILLI COUNTER
INC A ;BUMP COUNTER
CJNE A,#200,TR ;CHECK OUT TIMER VALUE
CLR A ;FORCE ACC TO BE ZERO
INC TVL ;INCREMENT LOW TIMER
CJNE A,TVL,TR ;CHECK LOW VALUE
INC TVH ;BUMP TIMER HIGH
;
TR: XCH A,MILLIV
POP PSW
RETI
;
newpage
include bas52.clk
;***************************************************************
;
SUI: ; Statement USER IN action routine
;
;***************************************************************
;
ACALL OTST
MOV CIUB,C ;SET OR CLEAR CIUB
RET
;
;***************************************************************
;
SUO: ; Statement USER OUT action routine
;
;***************************************************************
;
ACALL OTST
MOV COUB,C
RET
;
OTST: ; Check for a one
;
LCALL GCI ;GET THE CHARACTER, CLEARS CARRY
SUBB A,#'1' ;SEE IF A ONE
CPL C ;SETS CARRY IF ONE, CLEARS IT IF ZERO
RET
;
newpage
;**************************************************************
;
; IBLK - EXECUTE USER SUPPLIED TOKEN
;
;**************************************************************
;
IBLK: JB PSW.4,IBLK-1 ;EXIT IF REGISTER BANK <> 0
JB PSW.3,IBLK-1
JBC ACC.7,$+9 ;SEE IF BIT SEVEN IS SET
MOV DPTR,#USENT ;USER ENTRY LOCATION
LJMP ISTA1
;
JB ACC.0,199FH ;FLOATING POINT INPUT
JZ T_L ;DO OUTPUT ON 80H
MOV DPTR,#FP_BASE-2
JMP @A+DPTR
;
;
;**************************************************************
;
; GET_NUM - GET A NUMBER, EITHER HEX OR FLOAT
;
;**************************************************************
;
GET_NUM:ACALL FP_BASE+10 ;SCAN FOR HEX
JNC FP_BASE+12 ;DO FP INPUT
;
ACALL FP_BASE+18 ;ASCII STRING TO R2:R0
JNZ H_RET
PUSH DPH ;SAVE THE DATA_POINTER
PUSH DPL
ACALL FP_BASE+24 ;PUT R2:R0 ON THE STACK
POP DPL ;RESTORE THE DATA_POINTER
POP DPH
CLR A ;NO ERRORS
RET ;EXIT
;
newpage
;**************************************************************
;
; WB - THE EGO MESSAGE
;
;**************************************************************
;
WB: DB 'W'+80H,'R'+80H
DB 'I'+80H,'T'+80H,'T','E'+80H,'N'+80H
DB ' ','B'+80H,'Y'+80H,' '
DB 'J'+80H,'O'+80H,'H'+80H,'N'+80H,' '+80H
DB 'K','A'+80H,'T'+80H,'A'+80H,'U'+80H
DB 'S','K'+80H,'Y'+80H
DB ", I",'N'+80H,'T'+80H,'E'+80H,'L'+80H
DB ' '+80H,'C'+80H,'O'+80H,'R'+80H,'P'+80H
DB ". 1",'9'+80H,"85"
H_RET: RET
;
newpage
ORG 1990H
;
T_L: LJMP TEROT
;
ORG 1F78H
;
CKS_I: JB CKS_B,CS_I
LJMP 401BH
;
CS_I: LJMP 2088H
;
E14X: DB "NO DATA",'"'
;
E11X: DB 128+20
DB "ARITH. OVERFLOW",'"'
;
E16X: DB "PROGRAMMING",'"'
;
E15X: DB "CAN"
DB 27H
DB "T CONTINUE",'"'
;
E10X: DB "INVALID LINE NUMBER",'"'
;
NOROM: DB "PROM MODE",'"'
;
S_N: DB "*MCS-51(tm) BASIC V1.1*",'"'
;
ORG 1FF8H
;
ERS: DB "ERROR: ",'"'
;
newpage
;***************************************************************
;
segment xdata ;External Ram
;
;***************************************************************
;
DS 4
IBCNT: DS 1 ;LENGTH OF A LINE
IBLN: DS 2 ;THE LINE NUMBER
IBUF: DS LINLEN ;THE INPUT BUFFER
CONVT: DS 15 ;CONVERSION LOCATION FOR FPIN
;
ORG 100H
;
GTB: DS 1 ;GET LOCATION
ERRLOC: DS 1 ;ERROR TYPE
ERRNUM: DS 2 ;WHERE TO GO ON AN ERROR
VARTOP: DS 2 ;TOP OF VARIABLE STORAGE
ST_ALL: DS 2 ;STORAGE ALLOCATION
MT_ALL: DS 2 ;MATRIX ALLOCATION
MEMTOP: DS 2 ;TOP OF MEMORY
RCELL: DS 2 ;RANDOM NUMBER CELL
DS FPSIZ-1
CXTAL: DS 1 ;CRYSTAL
DS FPSIZ-1
FPT1: DS 1 ;FLOATINP POINT TEMP 1
DS FPSIZ-1
FPT2: DS 1 ;FLOATING POINT TEMP 2
INTLOC: DS 2 ;LOCATION TO GO TO ON INTERRUPT
STR_AL: DS 2 ;STRING ALLOCATION
SPV: DS 2 ;SERIAL PORT BAUD RATE
TIV: DS 2 ;TIMER INTERRUPT NUM AND LOC
PROGS: DS 2 ;PROGRAM A PROM TIME OUT
IPROGS: DS 2 ;INTELLIGENT PROM PROGRAMMER TIMEOUT
TM_TOP: DS 1
include bas52.fp
END