; 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