diff options
Diffstat (limited to 'tests/t_bas52/t_bas52.asm')
| -rw-r--r-- | tests/t_bas52/t_bas52.asm | 4644 |
1 files changed, 4644 insertions, 0 deletions
diff --git a/tests/t_bas52/t_bas52.asm b/tests/t_bas52/t_bas52.asm new file mode 100644 index 0000000..3fff5d8 --- /dev/null +++ b/tests/t_bas52/t_bas52.asm @@ -0,0 +1,4644 @@ +; 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 |