WebSVN – pentevo – Blame – /tools/asl/asl-current/tests/t_bas52/t_bas52.asm

Rev	Author	Line No.	Line
1186	savelij	1	; December 18, 1986
		2	; MS-DOS compatible Source code for MCS BASIC-52 (tm)
		3	; Assembles with ASM51 Macro Assembler Version 2.2
		4	;
		5	; The following source code does not include the floating point math
		6	; routines. These are seperately compiled using FP52.SRC.
		7	;
		8	; Both the BASIC.SRC and FP52.SRC programs assemble into ABSOLUTE
		9	; object files, and do not need to be relocated or linked. The FP52
		10	; object code and the BASIC object code, when compiled without modification
		11	; of the source listings, create the same object code that is found on
		12	; the MCS BASIC-52 Version 1.1 microcontrollers.
		13	;
		14	; The original source code had 7 "include" files that have been incorporated
		15	; into this file for ease of assembly.
		16	; These 7 files are: LOOK52.SRC, BAS52.RST, BAS52.PGM, BAS52.TL, BAS52.OUT,
		17	; BAS52.PWM, and BAS52.CLK.
		18	;
		19	;
		20	; Intel Corporation, Embedded Controller Operations
		21
		22	cpu 8052
		23
		24	page 0
		25	newpage
		26
		27	include stddef51.inc
		28	include bitfuncs.inc
		29	bigendian on
		30
		31	segment code
		32
		33	;**************************************************************
		34	;
		35	; TRAP VECTORS TO MONITOR
		36	;
		37	; RESET TAG (0AAH) ---------2001H
		38	;
		39	; TAG LOCATION (5AH) ------ 2002H
		40	;
		41	; EXTERNAL INTERRUPT 0 ---- 2040H
		42	;
		43	; COMMAND MODE ENTRY ------ 2048H
		44	;
		45	; SERIAL PORT ------------- 2050H
		46	;
		47	; MONITOR (BUBBLE) OUTPUT - 2058H
		48	;
		49	; MONITOR (BUBBLE) INPUT -- 2060H
		50	;
		51	; MONITOR (BUBBLE) CSTS --- 2068H
		52	;
		53	; GET USER JUMP VECTOR ---- 2070H
		54	;
		55	; GET USER LOOKUP VECTOR -- 2078H
		56	;
		57	; PRINT AT VECTOR --------- 2080H
		58	;
		59	; INTERRUPT PWM ----------- 2088H
		60	;
		61	; EXTERNAL RESET ---------- 2090H
		62	;
		63	; USER OUTPUT-------------- 4030H
		64	;
		65	; USER INPUT -------------- 4033H
		66	;
		67	; USER CSTS --------------- 4036H
		68	;
		69	; USER RESET -------------- 4039H
		70	;
		71	; USER DEFINED PRINT @ --- 403CH
		72	;
		73	;***************************************************************
		74	;
		75	newpage
		76	;***************************************************************
		77	;
		78	; MCS - 51 - 8K BASIC VERSION 1.1
		79	;
		80	;***************************************************************
		81	;
		82	AJMP CRST ;START THE PROGRAM
		83	db 037h ; ******AA inserted
		84	;
		85	ORG 3H
		86	;
		87	;***************************************************************
		88	;
		89	;EXTERNAL INTERRUPT 0
		90	;
		91	;***************************************************************
		92	;
		93	JB DRQ,STQ ;SEE IF DMA IS SET
		94	PUSH PSW ;SAVE THE STATUS
		95	LJMP 4003H ;JUMP TO USER IF NOT SET
		96	;
		97	ORG 0BH
		98	;
		99	;***************************************************************
		100	;
		101	;TIMER 0 OVERFLOW INTERRUPT
		102	;
		103	;***************************************************************
		104	;
		105	PUSH PSW ;SAVE THE STATUS
		106	JB C_BIT,STJ ;SEE IF USER WANTS INTERRUPT
		107	LJMP 400BH ;EXIT IF USER WANTS INTERRUPTS
		108	;
		109	ORG 13H
		110	;
		111	;***************************************************************
		112	;
		113	;EXTERNAL INTERRUPT 1
		114	;
		115	;***************************************************************
		116	;
		117	JB INTBIT,STK
		118	PUSH PSW
		119	LJMP 4013H
		120	;
		121	newpage
		122	;
		123	ORG 1BH
		124	;
		125	;***************************************************************
		126	;
		127	;TIMER 1 OVERFLOW INTERRUPT
		128	;
		129	;***************************************************************
		130	;
		131	PUSH PSW
		132	LJMP CKS_I
		133	;
		134	STJ: LJMP I_DR ;DO THE INTERRUPT
		135	;
		136	;***************************************************************
		137	;
		138	;SERIAL PORT INTERRUPT
		139	;
		140	;***************************************************************
		141	;
		142	ORG 23H
		143	;
		144	PUSH PSW
		145	JB SPINT,STU ;SEE IF MONITOR EANTS INTERRUPT
		146	LJMP 4023H
		147	;
		148	ORG 2BH
		149	;
		150	;**************************************************************
		151	;
		152	;TIMER 2 OVERFLOW INTERRUPT
		153	;
		154	;**************************************************************
		155	;
		156	PUSH PSW
		157	LJMP 402BH
		158	;
		159	newpage
		160	;**************************************************************
		161	;
		162	;USER ENTRY
		163	;
		164	;**************************************************************
		165	;
		166	ORG 30H
		167	;
		168	LJMP IBLK ;LINK TO USER BLOCK
		169	;
		170	STQ: JB I_T0,STS ;SEE IF MONITOR WANTS IT
		171	CLR DACK
		172	JNB P3.2,$ ;WAIT FOR DMA TO END
		173	SETB DACK
		174	RETI
		175	;
		176	STS: LJMP 2040H ;GO TO THE MONITOR
		177	;
		178	STK: SETB INTPEN ;TELL BASIC AN INTERRUPT WAS RECEIVED
		179	RETI
		180	;
		181	STU: LJMP 2050H ;SERIAL PORT INTERRUPT
		182	;
		183	newpage
		184
		185	include look52.inc ; ******AA
		186
		187	EIG: DB "EXTRA IGNORED",'"'
		188	;
		189	EXA: DB "A-STACK",'"'
		190	;
		191	EXC: DB "C-STACK",'"'
		192	;
		193	newpage
		194
		195	include bas52.rst ; ******AA
		196
		197	newpage
		198	;***************************************************************
		199	;
		200	; CIPROG AND CPROG - Program a prom
		201	;
		202	;***************************************************************
		203	;
		204	include bas52.pgm ; ******AA
		205	newpage
		206	;**************************************************************
		207	;
		208	PGU: ;PROGRAM A PROM FOR THE USER
		209	;
		210	;**************************************************************
		211	;
		212	CLR PROMV ;TURN ON THE VOLTAGE
		213	MOV PSW,#00011000B ;SELECT RB3
		214	ACALL PG1 ;DO IT
		215	SETB PROMV ;TURN IT OFF
		216	RET
		217	;
		218	;
		219	;*************************************************************
		220	;
		221	CCAL: ; Set up for prom moves
		222	; R3:R1 gets source
		223	; R7:R6 gets # of bytes
		224	;
		225	;*************************************************************
		226	;
		227	ACALL GETEND ;GET THE LAST LOCATION
		228	INC DPTR ;BUMP TO LOAD EOF
		229	MOV R3,BOFAH
		230	MOV R1,BOFAL ;RESTORE START
		231	CLR C ;PREPARE FOR SUBB
		232	MOV A,DPL ;SUB DPTR - BOFA > R7:R6
		233	SUBB A,R1
		234	MOV R6,A
		235	MOV A,DPH
		236	SUBB A,R3
		237	MOV R7,A
		238	RET
		239	;
		240	;
		241	include bas52.tl ; ******AA
		242	newpage
		243	;***************************************************************
		244	;
		245	CROM: ; The command action routine - ROM - Run out of rom
		246	;
		247	;***************************************************************
		248	;
		249	CLR CONB ;CAN'T CONTINUE IF MODE CHANGE
		250	ACALL RO1 ;DO IT
		251	;
		252	C_K: LJMP CL3 ;EXIT
		253	;
		254	RO1: LCALL DELTST ;SEE IF INTGER PRESENT ******AA CALL-->LCALL, INTGER-->DELTST
		255	MOV R4,#R1B0 ;SAVE THE NUMBER ******AA ABS-->IMM, R0B0-->R0B1 ?!?
		256	JNC $+6 ; ******AA $+4-->$+6 ???
		257	;MOV R4,#01H ;ONE IF NO INTEGER PRESENT ******AA repl. by next two
		258	LCALL ONE ; ******AA
		259	MOV R4,A ; ******AA
		260	ACALL ROMFD ;FIND THE PROGRAM
		261	CJNE R4,#0,RFX ;EXIT IF R4 <> 0
		262	INC DPTR ;BUMP PAST TAG
		263	MOV BOFAH,DPH ;SAVE THE ADDRESS
		264	MOV BOFAL,DPL
		265	RET
		266	;
		267	ROMFD: MOV DPTR,#ROMADR+16 ;START OF USER PROGRAM
		268	;
		269	RF1: MOVX A,@DPTR ;GET THE BYTE
		270	CJNE A,#55H,RF3 ;SEE IF PROPER TAG
		271	DJNZ R4,RF2 ;BUMP COUNTER
		272	;
		273	RFX: RET ;DPTR HAS THE START ADDRESS
		274	;
		275	RF2: INC DPTR ;BUMP PAST TAG
		276	ACALL G5
		277	INC DPTR ;BUMP TO NEXT PROGRAM
		278	SJMP RF1 ;DO IT AGAIN
		279	;
		280	RF3: JBC INBIT,RFX ;EXIT IF SET
		281	;
		282	NOGO: MOV DPTR,#NOROM
		283	AJMP ERRLK
		284	;
		285	newpage
		286	;***************************************************************
		287	;
		288	L20DPI: ; load R2:R0 with the location the DPTR is pointing to
		289	;
		290	;***************************************************************
		291	;
		292	MOVX A,@DPTR
		293	MOV R2,A
		294	INC DPTR
		295	MOVX A,@DPTR
		296	MOV R0,A
		297	RET ;DON'T BUMP DPTR
		298	;
		299	;***************************************************************
		300	;
		301	X31DP: ; swap R3:R1 with DPTR
		302	;
		303	;***************************************************************
		304	;
		305	XCH A,R3
		306	XCH A,DPH
		307	XCH A,R3
		308	XCH A,R1
		309	XCH A,DPL
		310	XCH A,R1
		311	RET
		312	;
		313	;***************************************************************
		314	;
		315	LD_T: ; Load the timer save location with the value the DPTR is
		316	; pointing to.
		317	;
		318	;****************************************************************
		319	;
		320	MOVX A,@DPTR
		321	MOV T_HH,A
		322	INC DPTR
		323	MOVX A,@DPTR
		324	MOV T_LL,A
		325	RET
		326	;
		327	newpage
		328	;
		329	;***************************************************************
		330	;
		331	;GETLIN - FIND THE LOCATION OF THE LINE NUMBER IN R3:R1
		332	; IF ACC = 0 THE LINE WAS NOT FOUND I.E. R3:R1
		333	; WAS TOO BIG, ELSE ACC <> 0 AND THE DPTR POINTS
		334	; AT THE LINE THAT IS GREATER THAN OR EQUAL TO THE
		335	; VALUE IN R3:R1.
		336	;
		337	;***************************************************************
		338	;
		339	GETEND: SETB ENDBIT ;GET THE END OF THE PROGRAM
		340	;
		341	GETLIN: LCALL DP_B ;GET BEGINNING ADDRESS ******AA CALL-->LCALL
		342	;
		343	G1: LCALL B_C ; ******AA CALL-->LCALL
		344	JZ G3 ;EXIT WITH A ZERO IN A IF AT END
		345	INC DPTR ;POINT AT THE LINE NUMBER
		346	JB ENDBIT,G2 ;SEE IF WE WANT TO FIND THE END
		347	ACALL DCMPX ;SEE IF (DPTR) = R3:R1
		348	ACALL DECDP ;POINT AT LINE COUNT
		349	MOVX A,@DPTR ;PUT LINE LENGTH INTO ACC
		350	JB UBIT,G3 ;EXIT IF EQUAL
		351	JC G3 ;SEE IF LESS THAN OR ZERO
		352	;
		353	G2: ACALL ADDPTR ;ADD IT TO DPTR
		354	SJMP G1 ;LOOP
		355	;
		356	G3: CLR ENDBIT ;RESET ENDBIT
		357	RET ;EXIT
		358	;
		359	G4: MOV DPTR,#PSTART ;DO RAM
		360	;
		361	G5: SETB ENDBIT
		362	SJMP G1 ;NOW DO TEST
		363	;
		364	newpage
		365	;***************************************************************
		366	;
		367	; LDPTRI - Load the DATA POINTER with the value it is pointing
		368	; to - DPH = (DPTR) , DPL = (DPTR+1)
		369	;
		370	; acc gets wasted
		371	;
		372	;***************************************************************
		373	;
		374	LDPTRI: MOVX A,@DPTR ;GET THE HIGH BYTE
		375	PUSH ACC ;SAVE IT
		376	INC DPTR ;BUMP THE POINTER
		377	MOVX A,@DPTR ;GET THE LOW BYTE
		378	MOV DPL,A ;PUT IT IN DPL
		379	POP DPH ;GET THE HIGH BYTE
		380	RET ;GO BACK
		381	;
		382	;***************************************************************
		383	;
		384	;L31DPI - LOAD R3 WITH (DPTR) AND R1 WITH (DPTR+1)
		385	;
		386	;ACC GETS CLOBBERED
		387	;
		388	;***************************************************************
		389	;
		390	L31DPI: MOVX A,@DPTR ;GET THE HIGH BYTE
		391	MOV R3,A ;PUT IT IN THE REG
		392	INC DPTR ;BUMP THE POINTER
		393	MOVX A,@DPTR ;GET THE NEXT BYTE
		394	MOV R1,A ;SAVE IT
		395	RET
		396	;
		397	;***************************************************************
		398	;
		399	;DECDP - DECREMENT THE DATA POINTER - USED TO SAVE SPACE
		400	;
		401	;***************************************************************
		402	;
		403	DECDP2: ACALL DECDP
		404	;
		405	DECDP: XCH A,DPL ;GET DPL
		406	JNZ $+4 ;BUMP IF ZERO
		407	DEC DPH
		408	DEC A ;DECREMENT IT
		409	XCH A,DPL ;GET A BACK
		410	RET ;EXIT
		411	;
		412	newpage
		413	;***************************************************************
		414	;
		415	;DCMPX - DOUBLE COMPARE - COMPARE (DPTR) TO R3:R1
		416	;R3:R1 - (DPTR) = SET CARRY FLAG
		417	;
		418	;IF R3:R1 > (DPTR) THEN C = 0
		419	;IF R3:R1 < (DPTR) THEN C = 1
		420	;IF R3:R1 = (DPTR) THEN C = 0
		421	;
		422	;***************************************************************
		423	;
		424	DCMPX: CLR UBIT ;ASSUME NOT EQUAL
		425	MOVX A,@DPTR ;GET THE BYTE
		426	CJNE A,R3B0,D1 ;IF A IS GREATER THAN R3 THEN NO CARRY
		427	;WHICH IS R3<@DPTR = NO CARRY AND
		428	;R3>@DPTR CARRY IS SET
		429	INC DPTR ;BUMP THE DATA POINTER
		430	MOVX A,@DPTR ;GET THE BYTE
		431	ACALL DECDP ;PUT DPTR BACK
		432	CJNE A,R1B0,D1 ;DO THE COMPARE
		433	CPL C ;FLIP CARRY
		434	;
		435	CPL UBIT ;SET IT
		436	D1: CPL C ;GET THE CARRY RIGHT
		437	RET ;EXIT
		438	;
		439	;***************************************************************
		440	;
		441	; ADDPTR - Add acc to the dptr
		442	;
		443	; acc gets wasted
		444	;
		445	;***************************************************************
		446	;
		447	ADDPTR: ADD A,DPL ;ADD THE ACC TO DPL
		448	MOV DPL,A ;PUT IT IN DPL
		449	JNC $+4 ;JUMP IF NO CARRY
		450	INC DPH ;BUMP DPH
		451	RET ;EXIT
		452	;
		453	newpage
		454	;*************************************************************
		455	;
		456	LCLR: ; Set up the storage allocation
		457	;
		458	;*************************************************************
		459	;
		460	ACALL ICLR ;CLEAR THE INTERRUPTS
		461	ACALL G4 ;PUT END ADDRESS INTO DPTR
		462	MOV A,#6 ;ADJUST MATRIX SPACE
		463	ACALL ADDPTR ;ADD FOR PROPER BOUNDS
		464	ACALL X31DP ;PUT MATRIX BOUNDS IN R3:R1
		465	MOV DPTR,#MT_ALL ;SAVE R3:R1 IN MATRIX FREE SPACE
		466	ACALL S31DP ;DPTR POINTS TO MEMTOP
		467	ACALL L31DPI ;LOAD MEMTOP INTO R3:R1
		468	MOV DPTR,#STR_AL ;GET MEMORY ALLOCATED FOR STRINGS
		469	ACALL LDPTRI
		470	LCALL DUBSUB ;R3:R1 = MEMTOP - STRING ALLOCATION ******AA CALL-->LCALL
		471	MOV DPTR,#VARTOP ;SAVE R3:R1 IN VARTOP
		472	;
		473	; FALL THRU TO S31DP2
		474	;
		475	;***************************************************************
		476	;
		477	;S31DP - STORE R3 INTO (DPTR) AND R1 INTO (DPTR+1)
		478	;
		479	;ACC GETS CLOBBERED
		480	;
		481	;***************************************************************
		482	;
		483	S31DP2: ACALL S31DP ;DO IT TWICE
		484	;
		485	S31DP: MOV A,R3 ;GET R3 INTO ACC
		486	MOVX @DPTR,A ;STORE IT
		487	INC DPTR ;BUMP DPTR
		488	MOV A,R1 ;GET R1
		489	MOVX @DPTR,A ;STORE IT
		490	INC DPTR ;BUMP IT AGAIN TO SAVE PROGRAM SPACE
		491	RET ;GO BACK
		492	;
		493	;
		494	;***************************************************************
		495	;
		496	STRING: ; Allocate memory for strings
		497	;
		498	;***************************************************************
		499	;
		500	LCALL TWO ;R3:R1 = NUMBER, R2:R0 = LEN
		501	MOV DPTR,#STR_AL ;SAVE STRING ALLOCATION
		502	ACALL S31DP
		503	INC R6 ;BUMP
		504	MOV S_LEN,R6 ;SAVE STRING LENGTH
		505	AJMP RCLEAR ;CLEAR AND SET IT UP
		506	;
		507	newpage
		508	;***************************************************************
		509	;
		510	; F_VAR - Find the variable in symbol table
		511	; R7:R6 contain the variable name
		512	; If not found create a zero entry and set the carry
		513	; R2:R0 has the address of variable on return
		514	;
		515	;***************************************************************
		516	;
		517	F_VAR: MOV DPTR,#VARTOP ;PUT VARTOP IN DPTR
		518	ACALL LDPTRI
		519	ACALL DECDP2 ;ADJUST DPTR FOR LOOKUP
		520	;
		521	F_VAR0: MOVX A,@DPTR ;LOAD THE VARIABLE
		522	JZ F_VAR2 ;TEST IF AT THE END OF THE TABLE
		523	INC DPTR ;BUMP FOR NEXT BYTE
		524	CJNE A,R7B0,F_VAR1 ;SEE IF MATCH
		525	MOVX A,@DPTR ;LOAD THE NAME
		526	CJNE A,R6B0,F_VAR1
		527	;
		528	; Found the variable now adjust and put in R2:R0
		529	;
		530	DLD: MOV A,DPL ;R2:R0 = DPTR-2
		531	SUBB A,#2
		532	MOV R0,A
		533	MOV A,DPH
		534	SUBB A,#0 ;CARRY IS CLEARED
		535	MOV R2,A
		536	RET
		537	;
		538	F_VAR1: MOV A,DPL ;SUBTRACT THE STACK SIZE+ADJUST
		539	CLR C
		540	SUBB A,#STESIZ
		541	MOV DPL,A ;RESTORE DPL
		542	JNC F_VAR0
		543	DEC DPH
		544	SJMP F_VAR0 ;CONTINUE COMPARE
		545	;
		546	newpage
		547	;
		548	; Add the entry to the symbol table
		549	;
		550	F_VAR2: LCALL R76S ;SAVE R7 AND R6
		551	CLR C
		552	ACALL DLD ;BUMP THE POINTER TO GET ENTRY ADDRESS
		553	;
		554	; Adjust pointer and save storage allocation
		555	; and make sure we aren't wiping anything out
		556	; First calculate new storage allocation
		557	;
		558	MOV A,R0
		559	SUBB A,#STESIZ-3 ;NEED THIS MUCH RAM
		560	MOV R1,A
		561	MOV A,R2
		562	SUBB A,#0
		563	MOV R3,A
		564	;
		565	; Now save the new storage allocation
		566	;
		567	MOV DPTR,#ST_ALL
		568	CALL S31DP ;SAVE STORAGE ALLOCATION
		569	;
		570	; Now make sure we didn't blow it, by wiping out MT_ALL
		571	;
		572	ACALL DCMPX ;COMPARE STORAGE ALLOCATION
		573	JC CCLR3 ;ERROR IF CARRY
		574	SETB C ;DID NOT FIND ENTRY
		575	RET ;EXIT IF TEST IS OK
		576	;
		577	newpage
		578	;***************************************************************
		579	;
		580	; Command action routine - NEW
		581	;
		582	;***************************************************************
		583	;
		584	CNEW: MOV DPTR,#PSTART ;SAVE THE START OF PROGRAM
		585	MOV A,#EOF ;END OF FILE
		586	MOVX @DPTR,A ;PUT IT IN MEMORY
		587	;
		588	; falls thru
		589	;
		590	;*****************************************************************
		591	;
		592	; The statement action routine - CLEAR
		593	;
		594	;*****************************************************************
		595	;
		596	CLR LINEB ;SET UP FOR RUN AND GOTO
		597	;
		598	RCLEAR: ACALL LCLR ;CLEAR THE INTERRUPTS, SET UP MATRICES
		599	MOV DPTR,#MEMTOP ;PUT MEMTOP IN R3:R1
		600	ACALL L31DPI
		601	ACALL G4 ;DPTR GETS END ADDRESS
		602	ACALL CL_1 ;CLEAR THE MEMORY
		603	;
		604	RC1: MOV DPTR,#STACKTP ;POINT AT CONTROL STACK TOP
		605	CLR A ;CONTROL UNDERFLOW
		606	;
		607	RC2: MOVX @DPTR,A ;SAVE IN MEMORY
		608	MOV CSTKA,#STACKTP
		609	MOV ASTKA,#STACKTP
		610	CLR CONB ;CAN'T CONTINUE
		611	RET
		612	;
		613	newpage
		614	;***************************************************************
		615	;
		616	; Loop until the memory is cleared
		617	;
		618	;***************************************************************
		619	;
		620	CL_1: INC DPTR ;BUMP MEMORY POINTER
		621	CLR A ;CLEAR THE MEMORY
		622	MOVX @DPTR,A ;CLEAR THE RAM
		623	MOVX A,@DPTR ;READ IT
		624	JNZ CCLR3 ;MAKE SURE IT IS CLEARED
		625	MOV A,R3 ;GET POINTER FOR COMPARE
		626	CJNE A,DPH,CL_1 ;SEE TO LOOP
		627	MOV A,R1 ;NOW TEST LOW BYTE
		628	CJNE A,DPL,CL_1
		629	;
		630	CL_2: RET
		631	;
		632	CCLR3: LJMP TB ;ALLOCATED MEMORY DOESN'T EXSIST ******AA JMP-->LJMP
		633	;
		634	;**************************************************************
		635	;
		636	SCLR: ;Entry point for clear return
		637	;
		638	;**************************************************************
		639	;
		640	LCALL DELTST ;TEST FOR A CR ******AA CALL-->LCALL
		641	JNC RCLEAR
		642	LCALL GCI1 ;BUMP THE TEST POINTER ******AA CALL-->LCALL
		643	CJNE A,#'I',RC1 ;SEE IF I, ELSE RESET THE STACK
		644	;
		645	;**************************************************************
		646	;
		647	ICLR: ; Clear interrupts and system garbage
		648	;
		649	;**************************************************************
		650	;
		651	JNB INTBIT,$+5 ;SEE IF BASIC HAS INTERRUPTS
		652	CLR EX1 ;IF SO, CLEAR INTERRUPTS
		653	ANL 34,#00100000B ;SET INTERRUPTS + CONTINUE
		654	RETI
		655	;
		656	newpage
		657	;***************************************************************
		658	;
		659	;OUTPUT ROUTINES
		660	;
		661	;***************************************************************
		662	;
		663	CRLF2: ACALL CRLF ;DO TWO CRLF'S
		664	;
		665	CRLF: MOV R5,#CR ;LOAD THE CR
		666	ACALL TEROT ;CALL TERMINAL OUT
		667	MOV R5,#LF ;LOAD THE LF
		668	AJMP TEROT ;OUTPUT IT AND RETURN
		669	;
		670	;PRINT THE MESSAGE ADDRESSED IN ROM OR RAM BY THE DPTR
		671	;ENDS WITH THE CHARACTER IN R4
		672	;DPTR HAS THE ADDRESS OF THE TERMINATOR
		673	;
		674	CRP: ACALL CRLF ;DO A CR THEN PRINT ROM
		675	;
		676	ROM_P: CLR A ;CLEAR A FOR LOOKUP
		677	MOVC A,@A+DPTR ;GET THE CHARACTER
		678	CLR ACC.7 ;CLEAR MS BIT
		679	CJNE A,#'"',$+4 ;EXIT IF TERMINATOR
		680	RET
		681	SETB C0ORX1
		682	;
		683	PN1: MOV R5,A ;OUTPUT THE CHARACTER
		684	ACALL TEROT
		685	INC DPTR ;BUMP THE POINTER
		686	SJMP PN0
		687	;
		688	UPRNT: ACALL X31DP
		689	;
		690	PRNTCR: MOV R4,#CR ;OUTPUT UNTIL A CR
		691	;
		692	PN0: JBC C0ORX1,ROM_P
		693	MOVX A,@DPTR ;GET THE RAM BYTE
		694	JZ $+5
		695	CJNE A,R4B0,$+4 ;SEE IF THE SAME AS TERMINATOR
		696	RET ;EXIT IF THE SAME
		697	CJNE A,#CR,PN1 ;NEVER PRINT A CR IN THIS ROUTINE
		698	LJMP E1XX ;BAD SYNTAX
		699	;
		700	newpage
		701	;***************************************************************
		702	;
		703	; INLINE - Input a line to IBUF, exit when a CR is received
		704	;
		705	;***************************************************************
		706	;
		707	INL2: CJNE A,#CNTRLD,INL2B ;SEE IF A CONTROL D
		708	;
		709	INL0: ACALL CRLF ;DO A CR
		710	;
		711	INLINE: MOV P2,#HI(IBUF) ;IBUF IS IN THE ZERO PAGE
		712	MOV R0,#LO(IBUF) ;POINT AT THE INPUT BUFFER
		713	;
		714	INL1: ACALL INCHAR ;GET A CHARACTER
		715	MOV R5,A ;SAVE IN R5 FOR OUTPUT
		716	CJNE A,#7FH,INL2 ;SEE IF A DELETE CHARACTER
		717	CJNE R0,#LO(IBUF),INL6
		718	MOV R5,#BELL ;OUTPUT A BELL
		719	;
		720	INLX: ACALL TEROT ;OUTPUT CHARACTER
		721	SJMP INL1 ;DO IT AGAIN
		722	;
		723	INL2B: MOVX @R0,A ;SAVE THE CHARACTER
		724	CJNE A,#CR,$+5 ;IS IT A CR
		725	AJMP CRLF ;OUTPUT A CRLF AND EXIT
		726	CJNE A,#20H,$+3
		727	JC INLX ;ONLY ECHO CONTROL CHARACTERS
		728	INC R0 ;BUMP THE POINTER
		729	CJNE R0,#IBUF+79,INLX
		730	DEC R0 ;FORCE 79
		731	SJMP INLX-2 ;OUTPUT A BELL
		732	;
		733	INL6: DEC R0 ;DEC THE RAM POINTER
		734	MOV R5,#BS ;OUTPUT A BACK SPACE
		735	ACALL TEROT
		736	ACALL STEROT ;OUTPUT A SPACE
		737	MOV R5,#BS ;ANOTHER BACK SPACE
		738	SJMP INLX ;OUTPUT IT
		739	;
		740	PTIME: DB 128-2 ; PROM PROGRAMMER TIMER
		741	DB 00H
		742	DB 00H
		743	DB 50H
		744	DB 67H
		745	DB 41H
		746	;
		747	newpage
		748	include bas52.out ; ******AA
		749	;
		750	BCK: ACALL CSTS ;CHECK STATUS
		751	JNC CI_RET+1 ;EXIT IF NO CHARACTER
		752	;
		753	newpage
		754	;***************************************************************
		755	;
		756	;INPUTS A CHARACTER FROM THE SYSTEM CONSOLE.
		757	;
		758	;***************************************************************
		759	;
		760	INCHAR: JNB BI,$+8 ;CHECK FOR MONITOR (BUBBLE)
		761	LCALL 2060H
		762	SJMP INCH1
		763	JNB CIUB,$+8 ;CHECK FOR USER
		764	LCALL 4033H
		765	SJMP INCH1
		766	JNB RI,$ ;WAIT FOR RECEIVER READY.
		767	MOV A,SBUF
		768	CLR RI ;RESET READY
		769	CLR ACC.7 ;NO BIT 7
		770	;
		771	INCH1: CJNE A,#13H,$+5
		772	SETB CNT_S
		773	CJNE A,#11H,$+5
		774	CLR CNT_S
		775	CJNE A,#CNTRLC,$+7
		776	JNB NO_C,C_EX ;TRAP NO CONTROL C
		777	RET
		778	;
		779	CLR JKBIT
		780	CJNE A,#17H,CI_RET ;CONTROL W
		781	SETB JKBIT
		782	;
		783	CI_RET: SETB C ;CARRY SET IF A CHARACTER
		784	RET ;EXIT
		785	;
		786	;*************************************************************
		787	;
		788	;RROM - The Statement Action Routine RROM
		789	;
		790	;*************************************************************
		791	;
		792	RROM: SETB INBIT ;SO NO ERRORS
		793	ACALL RO1 ;FIND THE LINE NUMBER
		794	JBC INBIT,CRUN
		795	RET ;EXIT
		796	;
		797	newpage
		798	;***************************************************************
		799	;
		800	CSTS: ; RETURNS CARRY = 1 IF THERE IS A CHARACTER WAITING FROM
		801	; THE SYSTEM CONSOLE. IF NO CHARACTER THE READY CHARACTER
		802	; WILL BE CLEARED
		803	;
		804	;***************************************************************
		805	;
		806	JNB BI,$+6 ;BUBBLE STATUS
		807	LJMP 2068H
		808	JNB CIUB,$+6 ;SEE IF EXTERNAL CONSOLE
		809	LJMP 4036H
		810	MOV C,RI
		811	RET
		812	;
		813	MOV DPTR,#WB ;EGO MESSAGE
		814	ACALL ROM_P
		815	;
		816	C_EX: CLR CNT_S ;NO OUTPUT STOP
		817	LCALL SPRINT+4 ;ASSURE CONSOLE
		818	ACALL CRLF
		819	JBC JKBIT,C_EX-5
		820	;
		821	JNB DIRF,SSTOP0
		822	AJMP C_K ;CLEAR COB AND EXIT
		823	;
		824	T_CMP: MOV A,TVH ;COMPARE TIMER TO SP_H AND SP_L
		825	MOV R1,TVL
		826	CJNE A,TVH,T_CMP
		827	XCH A,R1
		828	SUBB A,SP_L
		829	MOV A,R1
		830	SUBB A,SP_H
		831	RET
		832	;
		833	;*************************************************************
		834	;
		835	BR0: ; Trap the timer interrupt
		836	;
		837	;*************************************************************
		838	;
		839	CALL T_CMP ;COMPARE TIMER
		840	JC BCHR+6 ;EXIT IF TEST FAILS
		841	SETB OTI ;DOING THE TIMER INTERRUPT
		842	CLR OTS ;CLEAR TIMER BIT
		843	MOV C,INPROG ;SAVE IN PROGRESS
		844	MOV ISAV,C
		845	MOV DPTR,#TIV
		846	SJMP BR2
		847	;
		848	newpage
		849	;***************************************************************
		850	;
		851	; The command action routine - RUN
		852	;
		853	;***************************************************************
		854	;
		855	CRUN: LCALL RCLEAR-2 ;CLEAR THE STORAGE ARRAYS
		856	ACALL SRESTR+2 ;GET THE STARTING ADDRESS
		857	ACALL B_C
		858	JZ CMNDLK ;IF NULL GO TO COMMAND MODE
		859	;
		860	ACALL T_DP
		861	ACALL B_TXA ;BUMP TO STARTING LINE
		862	;
		863	CILOOP: ACALL SP0 ;DO A CR AND A LF
		864	CLR DIRF ;NOT IN DIRECT MODE
		865	;
		866	;INTERPERTER DRIVER
		867	;
		868	ILOOP: MOV SP,SPSAV ;RESTORE THE STACK EACH TIME
		869	JB DIRF,$+9 ;NO INTERRUPTS IF IN DIRECT MODE
		870	MOV INTXAH,TXAH ;SAVE THE TEXT POINTER
		871	MOV INTXAL,TXAL
		872	LCALL BCK ;GET CONSOLE STATUS
		873	JB DIRF,I_L ;DIRECT MODE
		874	ANL C,/GTRD ;SEE IF CHARACTER READY
		875	JNC BCHR ;NO CHARACTER = NO CARRY
		876	;
		877	; DO TRAP OPERATION
		878	;
		879	MOV DPTR,#GTB ;SAVE TRAP CHARACTER
		880	MOVX @DPTR,A
		881	SETB GTRD ;SAYS READ A BYTE
		882	;
		883	BCHR: JB OTI,I_L ;EXIT IF TIMER INTERRUPT IN PROGRESS
		884	JB OTS,BR0 ;TEST TIMER VALUE IF SET
		885	JNB INTPEN,I_L ;SEE IF INTERRUPT PENDING
		886	JB INPROG,I_L ;DON'T DO IT AGAIN IF IN PROGRESS
		887	MOV DPTR,#INTLOC ;POINT AT INTERRUPT LOCATION
		888	;
		889	BR2: MOV R4,#GTYPE ;SETUP FOR A FORCED GOSUB
		890	ACALL SGS1 ;PUT TXA ON STACK
		891	SETB INPROG ;INTERRUPT IN PROGRESS
		892	;
		893	ERL4: CALL L20DPI
		894	AJMP D_L1 ;GET THE LINE NUMBER
		895	;
		896	I_L: ACALL ISTAT ;LOOP
		897	ACALL CLN_UP ;FINISH IT OFF
		898	JNC ILOOP ;LOOP ON THE DRIVER
		899	JNB DIRF,CMNDLK ;CMND1 IF IN RUN MODE
		900	LJMP CMNDR ;DON'T PRINT READY
		901	;
		902	CMNDLK: LJMP CMND1 ;DONE ******AA JMP-->LJMP
		903	newpage
		904	;**************************************************************
		905	;
		906	; The Statement Action Routine - STOP
		907	;
		908	;**************************************************************
		909	;
		910	SSTOP: ACALL CLN_UP ;FINISH OFF THIS LINE
		911	MOV INTXAH,TXAH ;SAVE TEXT POINTER FOR CONT
		912	MOV INTXAL,TXAL
		913	;
		914	SSTOP0: SETB CONB ;CONTINUE WILL WORK
		915	MOV DPTR,#STP ;PRINT THE STOP MESSAGE
		916	SETB STOPBIT ;SET FOR ERROR ROUTINE
		917	LJMP ERRS ;JUMP TO ERROR ROUTINE ******AA JMP-->LJMP
		918	;
		919	newpage
		920	;**************************************************************
		921	;
		922	; ITRAP - Trap special function register operators
		923	;
		924	;**************************************************************
		925	;
		926	ITRAP: CJNE A,#TMR0,$+8 ;TIMER 0
		927	MOV TH0,R3
		928	MOV TL0,R1
		929	RET
		930	;
		931	CJNE A,#TMR1,$+8 ;TIMER 1
		932	MOV TH1,R3
		933	MOV TL1,R1
		934	RET
		935	;
		936	CJNE A,#TMR2,$+8 ;TIMER 2
		937	DB 8BH ;MOV R3 DIRECT OP CODE
		938	DB 0CDH ;T2H LOCATION
		939	DB 89H ;MOV R1 DIRECT OP CODE
		940	DB 0CCH ;T2L LOCATION
		941	RET
		942	;
		943	CJNE A,#TRC2,$+8 ;RCAP2 TOKEN
		944	RCL: DB 8BH ;MOV R3 DIRECT OP CODE
		945	DB 0CBH ;RCAP2H LOCATION
		946	DB 89H ;MOV R1 DIRECT OP CODE
		947	DB 0CAH ;RCAP2L LOCATION
		948	RET
		949	;
		950	ACALL R3CK ;MAKE SURE THAT R3 IS ZERO
		951	CJNE A,#TT2C,$+6
		952	DB 89H ;MOV R1 DIRECT OP CODE
		953	DB 0C8H ;T2CON LOCATION
		954	RET
		955	;
		956	CJNE A,#T_IE,$+6 ;IE TOKEN
		957	MOV IE,R1
		958	RET
		959	;
		960	CJNE A,#T_IP,$+6 ;IP TOKEN
		961	MOV IP,R1
		962	RET
		963	;
		964	CJNE A,#TTC,$+6 ;TCON TOKEN
		965	MOV TCON,R1
		966	RET
		967	;
		968	CJNE A,#TTM,$+6 ;TMOD TOKEN
		969	MOV TMOD,R1
		970	RET
		971	;
		972	CJNE A,#T_P1,T_T2 ;P1 TOKEN
		973	MOV P1,R1
		974	RET
		975	;
		976	;***************************************************************
		977	;
		978	; T_TRAP - Trap special operators
		979	;
		980	;***************************************************************
		981	;
		982	T_T: MOV TEMP5,A ;SAVE THE TOKEN
		983	ACALL GCI1 ;BUMP POINTER
		984	ACALL SLET2 ;EVALUATE AFTER =
		985	MOV A,TEMP5 ;GET THE TOKEN BACK
		986	CJNE A,#T_XTAL,$+6
		987	LJMP AXTAL1 ;SET UP CRYSTAL
		988	;
		989	ACALL IFIXL ;R3:R1 HAS THE TOS
		990	MOV A,TEMP5 ;GET THE TOKEN AGAIN
		991	CJNE A,#T_MTOP,T_T1 ;SEE IF MTOP TOKEN
		992	MOV DPTR,#MEMTOP
		993	CALL S31DP
		994	JMP RCLEAR ;CLEAR THE MEMORY
		995	;
		996	T_T1: CJNE A,#T_TIME,ITRAP ;SEE IF A TIME TOKEN
		997	MOV C,EA ;SAVE INTERRUPTS
		998	CLR EA ;NO TIMER 0 INTERRUPTS DURING LOAD
		999	MOV TVH,R3 ;SAVE THE TIME
		1000	MOV TVL,R1
		1001	MOV EA,C ;RESTORE INTERRUPTS
		1002	RET ;EXIT
		1003	;
		1004	T_T2: CJNE A,#T_PC,INTERX ;PCON TOKEN
		1005	DB 89H ;MOV DIRECT, R1 OP CODE
		1006	DB 87H ;ADDRESS OF PCON
		1007	RET ;EXIT
		1008	;
		1009	T_TRAP: CJNE A,#T_ASC,T_T ;SEE IF ASC TOKEN
		1010	ACALL IGC ;EAT IT AND GET THE NEXT CHARACTER
		1011	CJNE A,#'$',INTERX ;ERROR IF NOT A STRING
		1012	ACALL CSY ;CALCULATE ADDRESS
		1013	ACALL X3120
		1014	LCALL TWO_EY ; ******AA CALL-->LCALL
		1015	ACALL SPEOP+4 ;EVALUATE AFTER EQUALS
		1016	AJMP ISTAX1 ;SAVE THE CHARACTER
		1017	;
		1018	newpage
		1019	;**************************************************************
		1020	;
		1021	;INTERPERT THE STATEMENT POINTED TO BY TXAL AND TXAH
		1022	;
		1023	;**************************************************************
		1024	;
		1025	ISTAT: ACALL GC ;GET THR FIRST CHARACTER
		1026	JNB XBIT,IAT ;TRAP TO EXTERNAL RUN PACKAGE
		1027	CJNE A,#20H,$+3
		1028	JNC IAT
		1029	LCALL 2070H ;LET THE USER SET UP THE DPTR
		1030	ACALL GCI1
		1031	ANL A,#0FH ;STRIP OFF BIAS
		1032	SJMP ISTA1
		1033	;
		1034	IAT: CJNE A,#T_XTAL,$+3
		1035	JNC T_TRAP
		1036	JNB ACC.7,SLET ;IMPLIED LET IF BIT 7 NOT SET
		1037	CJNE A,#T_UOP+12,ISTAX ;DBYTE TOKEN
		1038	ACALL SPEOP ;EVALUATE SPECIAL OPERATOR
		1039	ACALL R3CK ;CHECK LOCATION
		1040	MOV @R1,A ;SAVE IT
		1041	RET
		1042	;
		1043	ISTAX: CJNE A,#T_UOP+13,ISTAY ;XBYTE TOKEN
		1044	ACALL SPEOP
		1045	;
		1046	ISTAX1: MOV P2,R3
		1047	MOVX @R1,A
		1048	RET
		1049	;
		1050	ISTAY: CJNE A,#T_CR+1,$+3 ;TRAP NEW OPERATORS
		1051	JC I_S
		1052	CJNE A,#0B0H,$+3 ;SEE IF TOO BIG
		1053	JNC INTERX
		1054	ADD A,#0F9H ;BIAS FOR LOOKUP TABLE
		1055	SJMP ISTA0 ;DO THE OPERATION
		1056	;
		1057	I_S: CJNE A,#T_LAST,$+3 ;MAKE SURE AN INITIAL RESERVED WORD
		1058	JC $+5 ;ERROR IF NOT
		1059	;
		1060	INTERX: LJMP E1XX ;SYNTAX ERROR
		1061	;
		1062	JNB DIRF,ISTA0 ;EXECUTE ALL STATEMENTS IF IN RUN MODE
		1063	CJNE A,#T_DIR,$+3 ;SEE IF ON TOKEN
		1064	JC ISTA0 ;OK IF DIRECT
		1065	CJNE A,#T_GOSB+1,$+5 ;SEE IF FOR
		1066	SJMP ISTA0 ;FOR IS OK
		1067	CJNE A,#T_REM+1,$+5 ;NEXT IS OK
		1068	SJMP ISTA0
		1069	CJNE A,#T_STOP+6,INTERX ;SO IS REM
		1070	;
		1071	newpage
		1072	ISTA0: ACALL GCI1 ;ADVANCE THE TEXT POINTER
		1073	MOV DPTR,#STATD ;POINT DPTR TO LOOKUP TABLE
		1074	CJNE A,#T_GOTO-3,$+5 ;SEE IF LET TOKEN
		1075	SJMP ISTAT ;WASTE LET TOKEN
		1076	ANL A,#3FH ;STRIP OFF THE GARBAGE
		1077	;
		1078	ISTA1: RL A ;ROTATE FOR OFFSET
		1079	ADD A,DPL ;BUMP
		1080	MOV DPL,A ;SAVE IT
		1081	CLR A
		1082	MOVC A,@A+DPTR ;GET HIGH BYTE
		1083	PUSH ACC ;SAVE IT
		1084	INC DPTR
		1085	CLR A
		1086	MOVC A,@A+DPTR ;GET LOW BYTE
		1087	POP DPH
		1088	MOV DPL,A
		1089	;
		1090	AC1: CLR A
		1091	JMP @A+DPTR ;GO DO IT
		1092	;
		1093	newpage
		1094	;***************************************************************
		1095	;
		1096	; The statement action routine - LET
		1097	;
		1098	;***************************************************************
		1099	;
		1100	SLET: ACALL S_C ;CHECK FOR POSSIBLE STRING
		1101	JC SLET0 ;NO STRING
		1102	CLR LINEB ;USED STRINGS
		1103	;
		1104	CALL X31DP ;PUT ADDRESS IN DPTR
		1105	MOV R7,#T_EQU ;WASTE =
		1106	ACALL EATC
		1107	ACALL GC ;GET THE NEXT CHARACTER
		1108	CJNE A,#'"',S_3 ;CHECK FOR A "
		1109	MOV R7,S_LEN ;GET THE STRING LENGTH
		1110	;
		1111	S_0: ACALL GCI1 ;BUMP PAST "
		1112	ACALL DELTST ;CHECK FOR DELIMITER
		1113	JZ INTERX ;EXIT IF CARRIAGE RETURN
		1114	MOVX @DPTR,A ;SAVE THE CHARACTER
		1115	CJNE A,#'"',S_1 ;SEE IF DONE
		1116	;
		1117	S_E: MOV A,#CR ;PUT A CR IN A
		1118	MOVX @DPTR,A ;SAVE CR
		1119	AJMP GCI1
		1120	;
		1121	S_3: PUSH DPH
		1122	PUSH DPL ;SAVE DESTINATION
		1123	ACALL S_C ;CALCULATE SOURCE
		1124	JC INTERX ;ERROR IF CARRY
		1125	POP R0B0 ;GET DESTINATION BACK
		1126	POP R2B0
		1127	;
		1128	SSOOP: MOV R7,S_LEN ;SET UP COUNTER
		1129	;
		1130	S_4: LCALL TBYTE ;TRANSFER THE BYTE ******AA CALL-->LCALL
		1131	CJNE A,#CR,$+4 ;EXIT IF A CR
		1132	RET
		1133	DJNZ R7,S_5 ;BUMP COUNTER
		1134	MOV A,#CR ;SAVE A CR
		1135	MOVX @R0,A
		1136	AJMP EIGP ;PRINT EXTRA IGNORED
		1137	;
		1138	newpage
		1139	;
		1140	S_5: CALL INC3210 ;BUMP POINTERS
		1141	SJMP S_4 ;LOOP
		1142	;
		1143	S_1: DJNZ R7,$+8 ;SEE IF DONE
		1144	ACALL S_E
		1145	ACALL EIGP ;PRINT EXTRA IGNORED
		1146	AJMP FINDCR ;GO FIND THE END
		1147	INC DPTR ;BUMP THE STORE POINTER
		1148	SJMP S_0 ;CONTINUE TO LOOP
		1149	;
		1150	E3XX: MOV DPTR,#E3X ;BAD ARG ERROR
		1151	AJMP EK
		1152	;
		1153	SLET0: ACALL SLET1
		1154	AJMP POPAS ;COPY EXPRESSION TO VARIABLE
		1155	;
		1156	SLET1: ACALL VAR_ER ;CHECK FOR A"VARIABLE"
		1157	;
		1158	SLET2: PUSH R2B0 ;SAVE THE VARIABLE ADDRESS
		1159	PUSH R0B0
		1160	MOV R7,#T_EQU ;GET EQUAL TOKEN
		1161	ACALL WE
		1162	POP R1B0 ;POP VARIABLE TO R3:R1
		1163	POP R3B0
		1164	RET ;EXIT
		1165	;
		1166	R3CK: CJNE R3,#00H,E3XX ;CHECK TO SEE IF R3 IS ZERO
		1167	RET
		1168	;
		1169	SPEOP: ACALL GCI1 ;BUMP TXA
		1170	ACALL P_E ;EVALUATE PAREN
		1171	ACALL SLET2 ;EVALUATE AFTER =
		1172	CALL TWOL ;R7:R6 GETS VALUE, R3:R1 GETS LOCATION
		1173	MOV A,R6 ;SAVE THE VALUE
		1174	;
		1175	CJNE R7,#00H,E3XX ;R2 MUST BE = 0
		1176	RET
		1177	;
		1178	newpage
		1179	;**************************************************************
		1180	;
		1181	; ST_CAL - Calculate string Address
		1182	;
		1183	;**************************************************************
		1184	;
		1185	IST_CAL:;
		1186	;
		1187	ACALL I_PI ;BUMP TEXT, THEN EVALUATE
		1188	ACALL R3CK ;ERROR IF R3 <> 0
		1189	INC R1 ;BUMP FOR OFFSET
		1190	MOV A,R1 ;ERROR IF R1 = 255
		1191	JZ E3XX
		1192	MOV DPTR,#VARTOP ;GET TOP OF VARIABLE STORAGE
		1193	MOV B,S_LEN ;MULTIPLY FOR LOCATION
		1194	ACALL VARD ;CALCULATE THE LOCATION
		1195	MOV DPTR,#MEMTOP ;SEE IF BLEW IT
		1196	CALL FUL1
		1197	MOV DPL,S_LEN ;GET STRING LENGTH, DPH = 00H
		1198	DEC DPH ;DPH = 0
		1199	;
		1200	DUBSUB: CLR C
		1201	MOV A,R1
		1202	SUBB A,DPL
		1203	MOV R1,A
		1204	MOV A,R3
		1205	SUBB A,DPH
		1206	MOV R3,A
		1207	ORL A,R1
		1208	RET
		1209	;
		1210	;***************************************************************
		1211	;
		1212	;VARD - Calculate the offset base
		1213	;
		1214	;***************************************************************
		1215	;
		1216	VARB: MOV B,#FPSIZ ;SET UP FOR OPERATION
		1217	;
		1218	VARD: CALL LDPTRI ;LOAD DPTR
		1219	MOV A,R1 ;MULTIPLY BASE
		1220	MUL AB
		1221	ADD A,DPL
		1222	MOV R1,A
		1223	MOV A,B
		1224	ADDC A,DPH
		1225	MOV R3,A
		1226	RET
		1227	;
		1228	newpage
		1229	;*************************************************************
		1230	;
		1231	CSY: ; Calculate a biased string address and put in R3:R1
		1232	;
		1233	;*************************************************************
		1234	;
		1235	ACALL IST_CAL ;CALCULATE IT
		1236	PUSH R3B0 ;SAVE IT
		1237	PUSH R1B0
		1238	MOV R7,#',' ;WASTE THE COMMA
		1239	ACALL EATC
		1240	ACALL ONE ;GET THE NEXT EXPRESSION
		1241	MOV A,R1 ;CHECK FOR BOUNDS
		1242	CJNE A,S_LEN,$+3
		1243	JNC E3XX ;MUST HAVE A CARRY
		1244	DEC R1 ;BIAS THE POINTER
		1245	POP ACC ;GET VALUE LOW
		1246	ADD A,R1 ;ADD IT TO BASE
		1247	MOV R1,A ;SAVE IT
		1248	POP R3B0 ;GET HIGH ADDRESS
		1249	JNC $+3 ;PROPAGATE THE CARRY
		1250	INC R3
		1251	AJMP ERPAR ;WASTE THE RIGHT PAREN
		1252	;
		1253	newpage
		1254	;***************************************************************
		1255	;
		1256	; The statement action routine FOR
		1257	;
		1258	;***************************************************************
		1259	;
		1260	SFOR: ACALL SLET1 ;SET UP CONTROL VARIABLE
		1261	PUSH R3B0 ;SAVE THE CONTROL VARIABLE LOCATION
		1262	PUSH R1B0
		1263	ACALL POPAS ;POP ARG STACK AND COPY CONTROL VAR
		1264	MOV R7,#T_TO ;GET TO TOKEN
		1265	ACALL WE
		1266	ACALL GC ;GET NEXT CHARACTER
		1267	CJNE A,#T_STEP,SF2
		1268	ACALL GCI1 ;EAT THE TOKEN
		1269	ACALL EXPRB ;EVALUATE EXPRESSION
		1270	SJMP $+5 ;JUMP OVER
		1271	;
		1272	SF2: LCALL PUSH_ONE ;PUT ONE ON THE STACK
		1273	;
		1274	MOV A,#-FSIZE ;ALLOCATE FSIZE BYTES ON THE CONTROL STACK
		1275	ACALL PUSHCS ;GET CS IN R0
		1276	ACALL CSC ;CHECK CONTROL STACK
		1277	MOV R3,#CSTKAH ;IN CONTROL STACK
		1278	MOV R1,R0B0 ;STACK ADDRESS
		1279	ACALL POPAS ;PUT STEP ON STACK
		1280	ACALL POPAS ;PUT LIMIT ON STACK
		1281	ACALL DP_T ;DPTR GETS TEXT
		1282	MOV R0,R1B0 ;GET THE POINTER
		1283	ACALL T_X_S ;SAVE THE TEXT
		1284	POP TXAL ;GET CONTROL VARIABLE
		1285	POP TXAH
		1286	MOV R4,#FTYPE ;AND THE TYPE
		1287	ACALL T_X_S ;SAVE IT
		1288	;
		1289	SF3: ACALL T_DP ;GET THE TEXT POINTER
		1290	AJMP ILOOP ;CONTINUE TO PROCESS
		1291	;
		1292	newpage
		1293	;**************************************************************
		1294	;
		1295	; The statement action routines - PUSH and POP
		1296	;
		1297	;**************************************************************
		1298	;
		1299	SPUSH: ACALL EXPRB ;PUT EXPRESSION ON STACK
		1300	ACALL C_TST ;SEE IF MORE TO DO
		1301	JNC SPUSH ;IF A COMMA PUSH ANOTHER
		1302	RET
		1303	;
		1304	;
		1305	SPOP: ACALL VAR_ER ;GET VARIABLE
		1306	ACALL XPOP ;FLIP THE REGISTERS FOR POPAS
		1307	ACALL C_TST ;SEE IF MORE TO DO
		1308	JNC SPOP
		1309	;
		1310	RET
		1311	;
		1312	;***************************************************************
		1313	;
		1314	; The statement action routine - IF
		1315	;
		1316	;***************************************************************
		1317	;
		1318	SIF: ACALL RTST ;EVALUATE THE EXPRESSION
		1319	MOV R1,A ;SAVE THE RESULT
		1320	ACALL GC ;GET THE CHARACTER AFTER EXPR
		1321	CJNE A,#T_THEN,$+5 ;SEE IF THEN TOKEN
		1322	ACALL GCI1 ;WASTE THEN TOKEN
		1323	CJNE R1,#0,T_F1 ;CHECK R_OP RESULT
		1324	;
		1325	E_FIND: MOV R7,#T_ELSE ;FIND ELSE TOKEN
		1326	ACALL FINDC
		1327	JZ SIF-1 ;EXIT IF A CR
		1328	ACALL GCI1 ;BUMP PAST TOKEN
		1329	CJNE A,#T_ELSE,E_FIND;WASTE IF NO ELSE
		1330	;
		1331	T_F1: ACALL INTGER ;SEE IF NUMBER
		1332	JNC D_L1 ;EXECUTE LINE NUMBER
		1333	AJMP ISTAT ;EXECUTE STATEMENT IN NOT
		1334	;
		1335	B_C: MOVX A,@DPTR
		1336	DEC A
		1337	JB ACC.7,FL3-5
		1338	RET
		1339	;
		1340	newpage
		1341	;***************************************************************
		1342	;
		1343	; The statement action routine - GOTO
		1344	;
		1345	;***************************************************************
		1346	;
		1347	SGOTO: ACALL RLINE ;R2:R0 AND DPTR GET INTGER
		1348	;
		1349	SGT1: ACALL T_DP ;TEXT POINTER GETS DPTR
		1350	;
		1351	JBC RETBIT,SGT2 ;SEE IF RETI EXECUTED
		1352	;
		1353	JNB LINEB,$+6 ;SEE IF A LINE WAS EDITED
		1354	LCALL RCLEAR-2 ;CLEAR THE MEMORY IF SET
		1355	AJMP ILOOP-2 ;CLEAR DIRF AND LOOP
		1356	;
		1357	SGT2: JBC OTI,$+8 ;SEE IF TIMER INTERRUPT
		1358	ANL 34,#10111101B ;CLEAR INTERRUPTS
		1359	AJMP ILOOP ;EXECUTE
		1360	MOV C,ISAV
		1361	MOV INPROG,C
		1362	AJMP ILOOP ;RESTORE INTERRUPTS AND RET
		1363	;
		1364	;
		1365	;*************************************************************
		1366	;
		1367	RTST: ; Test for ZERO
		1368	;
		1369	;*************************************************************
		1370	;
		1371	ACALL EXPRB ;EVALUATE EXPRESSION
		1372	CALL INC_ASTKA ;BUMP ARG STACK
		1373	JZ $+4 ;EXIT WITH ZERO OR 0FFH
		1374	MOV A,#0FFH
		1375	RET
		1376	;
		1377	newpage
		1378	;
		1379	;**************************************************************
		1380	;
		1381	; GLN - get the line number in R2:R0, return in DPTR
		1382	;
		1383	;**************************************************************
		1384	;
		1385	GLN: ACALL DP_B ;GET THE BEGINNING ADDRESS
		1386	;
		1387	FL1: MOVX A,@DPTR ;GET THE LENGTH
		1388	MOV R7,A ;SAVE THE LENGTH
		1389	DJNZ R7,FL3 ;SEE IF END OF FILE
		1390	;
		1391	MOV DPTR,#E10X ;NO LINE NUMBER
		1392	AJMP EK ;HANDLE THE ERROR
		1393	;
		1394	FL3: JB ACC.7,$-5 ;CHECK FOR BIT 7
		1395	INC DPTR ;POINT AT HIGH BYTE
		1396	MOVX A,@DPTR ;GET HIGH BYTE
		1397	CJNE A,R2B0,FL2 ;SEE IF MATCH
		1398	INC DPTR ;BUMP TO LOW BYTE
		1399	DEC R7 ;ADJUST AGAIN
		1400	MOVX A,@DPTR ;GET THE LOW BYTE
		1401	CJNE A,R0B0,FL2 ;SEE IF LOW BYTE MATCH
		1402	INC DPTR ;POINT AT FIRST CHARACTER
		1403	RET ;FOUND IT
		1404	;
		1405	FL2: MOV A,R7 ;GET THE LENGTH COUNTER
		1406	CALL ADDPTR ;ADD A TO DATA POINTER
		1407	SJMP FL1 ;LOOP
		1408	;
		1409	;
		1410	;*************************************************************
		1411	;
		1412	;RLINE - Read in ASCII string, get line, and clean it up
		1413	;
		1414	;*************************************************************
		1415	;
		1416	RLINE: ACALL INTERR ;GET THE INTEGER
		1417	;
		1418	RL1: ACALL GLN
		1419	AJMP CLN_UP
		1420	;
		1421	;
		1422	D_L1: ACALL GLN ;GET THE LINE
		1423	AJMP SGT1 ;EXECUTE THE LINE
		1424	;
		1425	newpage
		1426	;***************************************************************
		1427	;
		1428	; The statement action routines WHILE and UNTIL
		1429	;
		1430	;***************************************************************
		1431	;
		1432	SWHILE: ACALL RTST ;EVALUATE RELATIONAL EXPRESSION
		1433	CPL A
		1434	SJMP S_WU
		1435	;
		1436	SUNTIL: ACALL RTST ;EVALUATE RELATIONAL EXPRESSION
		1437	;
		1438	S_WU: MOV R4,#DTYPE ;DO EXPECTED
		1439	MOV R5,A ;SAVE R_OP RESULT
		1440	SJMP SR0 ;GO PROCESS
		1441	;
		1442	;
		1443	;***************************************************************
		1444	;
		1445	CNULL: ; The Command Action Routine - NULL
		1446	;
		1447	;***************************************************************
		1448	;
		1449	ACALL INTERR ;GET AN INTEGER FOLLOWING NULL
		1450	MOV NULLCT,R0 ;SAVE THE NULLCOUNT
		1451	AJMP CMNDLK ;JUMP TO COMMAND MODE
		1452	;
		1453	newpage
		1454	;***************************************************************
		1455	;
		1456	; The statement action routine - RETI
		1457	;
		1458	;***************************************************************
		1459	;
		1460	SRETI: SETB RETBIT ;SAYS THAT RETI HAS BEEN EXECUTED
		1461	;
		1462	;***************************************************************
		1463	;
		1464	; The statement action routine - RETURN
		1465	;
		1466	;***************************************************************
		1467	;
		1468	SRETRN: MOV R4,#GTYPE ;MAKE SURE OF GOSUB
		1469	MOV R5,#55H ;TYPE RETURN TYPE
		1470	;
		1471	SR0: ACALL CSETUP ;SET UP CONTROL STACK
		1472	MOVX A,@R0 ;GET RETURN TEXT ADDRESS
		1473	MOV DPH,A
		1474	INC R0
		1475	MOVX A,@R0
		1476	MOV DPL,A
		1477	INC R0 ;POP CONTROL STACK
		1478	MOVX A,@DPTR ;SEE IF GOSUB WAS THE LAST STATEMENT
		1479	CJNE A,#EOF,$+5
		1480	AJMP CMNDLK
		1481	MOV A,R5 ;GET TYPE
		1482	JZ SGT1 ;EXIT IF ZERO
		1483	MOV CSTKA,R0 ;POP THE STACK
		1484	CPL A ;OPTION TEST, 00H, 55H, 0FFH, NOW 55H
		1485	JNZ SGT1 ;MUST BE GOSUB
		1486	RET ;NORMAL FALL THRU EXIT FOR NO MATCH
		1487	;
		1488	newpage
		1489	;***************************************************************
		1490	;
		1491	; The statement action routine - GOSUB
		1492	;
		1493	;***************************************************************
		1494	;
		1495	SGOSUB: ACALL RLINE ;NEW TXA IN DPTR
		1496	;
		1497	SGS0: MOV R4,#GTYPE
		1498	ACALL SGS1 ;SET EVERYTHING UP
		1499	AJMP SF3 ;EXIT
		1500	;
		1501	SGS1: MOV A,#-3 ;ALLOCATE 3 BYTES ON CONTROL STACK
		1502	ACALL PUSHCS
		1503	;
		1504	T_X_S: MOV P2,#CSTKAH ;SET UP PORT FOR CONTROL STACK
		1505	MOV A,TXAL ;GET RETURN ADDRESS AND SAVE IT
		1506	MOVX @R0,A
		1507	DEC R0
		1508	MOV A,TXAH
		1509	MOVX @R0,A
		1510	DEC R0
		1511	MOV A,R4 ;GET TYPE
		1512	MOVX @R0,A ;SAVE TYPE
		1513	RET ;EXIT
		1514	;
		1515	;
		1516	CS1: MOV A,#3 ;POP 3 BYTES
		1517	ACALL PUSHCS
		1518	;
		1519	CSETUP: MOV R0,CSTKA ;GET CONTROL STACK
		1520	MOV P2,#CSTKAH
		1521	MOVX A,@R0 ;GET BYTE
		1522	CJNE A,R4B0,$+5 ;SEE IF TYPE MATCH
		1523	INC R0
		1524	RET
		1525	JZ E4XX ;EXIT IF STACK UNDERFLOW
		1526	CJNE A,#FTYPE,CS1 ;SEE IF FOR TYPE
		1527	ACALL PUSHCS-2 ;WASTE THE FOR TYPE
		1528	SJMP CSETUP ;LOOP
		1529	;
		1530	newpage
		1531	;***************************************************************
		1532	;
		1533	; The statement action routine - NEXT
		1534	;
		1535	;***************************************************************
		1536	;
		1537	SNEXT: MOV R4,#FTYPE ;FOR TYPE
		1538	ACALL CSETUP ;SETUP CONTROL STACK
		1539	MOV TEMP5,R0 ;SAVE CONTROL VARIABLE ADDRESS
		1540	MOV R1,#TEMP1 ;SAVE VAR + RETURN IN TEMP1-4
		1541	;
		1542	XXI: MOVX A,@R0 ;LOOP UNTIL DONE
		1543	MOV @R1,A
		1544	INC R1
		1545	INC R0
		1546	CJNE R1,#TEMP5,XXI
		1547	;
		1548	ACALL VAR ;SEE IF THE USER HAS A VARIABLE
		1549	JNC $+6
		1550	MOV R2,TEMP1
		1551	MOV R0,TEMP2
		1552	MOV A,R2 ;SEE IF VAR'S AGREE
		1553	CJNE A,TEMP1,E4XX
		1554	MOV A,R0
		1555	CJNE A,TEMP2,E4XX
		1556	ACALL PUSHAS ;PUT CONTROL VARIABLE ON STACK
		1557	MOV A,#FPSIZ+FPSIZ+2;COMPUTE ADDRESS TO STEP VALUE SIGN
		1558	ADD A,TEMP5 ;ADD IT TO BASE OF STACK
		1559	MOV R0,A ;SAVE IN R0
		1560	MOV R2,#CSTKAH ;SET UP TO PUSH STEP VALUE
		1561	MOV P2,R2 ;SET UP PORT
		1562	MOVX A,@R0 ;GET SIGN
		1563	INC R0 ;BACK TO EXPONENT
		1564	PUSH ACC ;SAVE SIGN OF STEP
		1565	ACALL PUSHAS ;PUT STEP VALUE ON STACK
		1566	PUSH R0B0 ;SAVE LIMIT VALUE LOCATION
		1567	CALL AADD ;ADD STEP VALUE TO VARIABLE
		1568	CALL CSTAKA ;COPY STACK
		1569	MOV R3,TEMP1 ;GET CONTROL VARIABLE
		1570	MOV R1,TEMP2
		1571	ACALL POPAS ;SAVE THE RESULT
		1572	MOV R2,#CSTKAH ;RESTORE LIMIT LOCATION
		1573	POP R0B0
		1574	ACALL PUSHAS ;PUT LIMIT ON STACK
		1575	CALL FP_BASE+4 ;DO THE COMPARE
		1576	POP ACC ;GET LIMIT SIGN BACK
		1577	JZ $+3 ;IF SIGN NEGATIVE, TEST "BACKWARDS"
		1578	CPL C
		1579	ORL C,F0 ;SEE IF EQUAL
		1580	JC N4 ;STILL SMALLER THAN LIMIT?
		1581	MOV A,#FSIZE ;REMOVE CONTROL STACK ENTRY
		1582	;
		1583	; Fall thru to PUSHCS
		1584	;
		1585	newpage
		1586	;***************************************************************
		1587	;
		1588	; PUSHCS - push frame onto control stack
		1589	; acc has - number of bytes, also test for overflow
		1590	;
		1591	;***************************************************************
		1592	;
		1593	PUSHCS: ADD A,CSTKA ;BUMP CONTROL STACK
		1594	CJNE A,#CONVT+17,$+3 ;SEE IF OVERFLOWED
		1595	JC E4XX ;EXIT IF STACK OVERFLOW
		1596	XCH A,CSTKA ;STORE NEW CONTROL STACK VALUE, GET OLD
		1597	DEC A ;BUMP OLD VALUE
		1598	MOV R0,A ;PUT OLD-1 IN R0
		1599	;
		1600	RET ;EXIT
		1601	;
		1602	CSC: ACALL CLN_UP ;FINISH OFF THE LINE
		1603	JNC CSC-1 ;EXIT IF NO TERMINATOR
		1604	;
		1605	E4XX: MOV DPTR,#EXC ;CONTROL STACK ERROR
		1606	AJMP EK ;STACK ERROR
		1607	;
		1608	N4: MOV TXAH,TEMP3 ;GET TEXT POINTER
		1609	MOV TXAL,TEMP4
		1610	AJMP ILOOP ;EXIT
		1611	;
		1612	;***************************************************************
		1613	;
		1614	; The statement action routine - RESTORE
		1615	;
		1616	;***************************************************************
		1617	;
		1618	SRESTR: ACALL X_TR ;SWAP POINTERS
		1619	ACALL DP_B ;GET THE STARTING ADDRESS
		1620	ACALL T_DP ;PUT STARTING ADDRESS IN TEXT POINTER
		1621	ACALL B_TXA ;BUMP TXA
		1622	;
		1623	; Fall thru
		1624	;
		1625	X_TR: ;swap txa and rtxa
		1626	;
		1627	XCH A,TXAH
		1628	XCH A,RTXAH
		1629	XCH A,TXAH
		1630	XCH A,TXAL
		1631	XCH A,RTXAL
		1632	XCH A,TXAL
		1633	RET ;EXIT
		1634	;
		1635	newpage
		1636	;***************************************************************
		1637	;
		1638	; The statement action routine - READ
		1639	;
		1640	;***************************************************************
		1641	;
		1642	SREAD: ACALL X_TR ;SWAP POINTERS
		1643	;
		1644	SRD0: ACALL C_TST ;CHECK FOR COMMA
		1645	JC SRD4 ;SEE WHAT IT IS
		1646	;
		1647	SRD: ACALL EXPRB ;EVALUATE THE EXPRESSION
		1648	ACALL GC ;GET THE CHARACTER AFTER EXPRESSION
		1649	CJNE A,#',',SRD1 ;SEE IF MORE DATA
		1650	SJMP SRD2 ;BYBASS CLEAN UP IF A COMMA
		1651	;
		1652	SRD1: ACALL CLN_UP ;FINISH OFF THE LINE, IF AT END
		1653	;
		1654	SRD2: ACALL X_TR ;RESTORE POINTERS
		1655	ACALL VAR_ER ;GET VARIABLE ADDRESS
		1656	ACALL XPOP ;FLIP THE REGISTERS FOR POPAS
		1657	ACALL C_TST ;SEE IF A COMMA
		1658	JNC SREAD ;READ AGAIN IF A COMMA
		1659	RET ;EXIT IF NOT
		1660	;
		1661	SRD4: CJNE A,#T_DATA,SRD5 ;SEE IF DATA
		1662	ACALL GCI1 ;BUMP POINTER
		1663	SJMP SRD
		1664	;
		1665	SRD5: CJNE A,#EOF,SRD6 ;SEE IF YOU BLEW IT
		1666	ACALL X_TR ;GET THE TEXT POINTER BACK
		1667	MOV DPTR,#E14X ;READ ERROR
		1668	;
		1669	EK: LJMP ERROR
		1670	;
		1671	SRD6: ACALL FINDCR ;WASTE THIS LINE
		1672	ACALL CLN_UP ;CLEAN IT UP
		1673	JC SRD5+3 ;ERROR IF AT END
		1674	SJMP SRD0
		1675	;
		1676	NUMC: ACALL GC ;GET A CHARACTER
		1677	CJNE A,#'#',NUMC1 ;SEE IF A #
		1678	SETB COB ;VALID LINE PRINT
		1679	AJMP IGC ;BUMP THE TEXT POINTER
		1680	;
		1681	NUMC1: CJNE A,#'@',SRD4-1 ;EXIT IF NO GOOD
		1682	SETB LPB
		1683	AJMP IGC
		1684	;
		1685	newpage
		1686	;***************************************************************
		1687	;
		1688	; The statement action routine - PRINT
		1689	;
		1690	;***************************************************************
		1691	;
		1692	SPH0: SETB ZSURP ;NO ZEROS
		1693	;
		1694	SPH1: SETB HMODE ;HEX MODE
		1695	;
		1696	SPRINT: ACALL NUMC ;TEST FOR A LINE PRINT
		1697	ACALL $+9 ;PROCEED
		1698	ANL 35,#11110101B ;CLEAR COB AND LPB
		1699	ANL 38,#00111111B ;NO HEX MODE
		1700	;
		1701	RET
		1702	;
		1703	ACALL DELTST ;CHECK FOR A DELIMITER
		1704	JC SP1
		1705	;
		1706	SP0: JMP CRLF ;EXIT WITH A CR IF SO
		1707	;
		1708	SP2: ACALL C_TST ;CHECK FOR A COMMA
		1709	JC SP0 ;EXIT IF NO COMMA
		1710	;
		1711	SP1: ACALL CPS ;SEE IF A STRING TO PRINT
		1712	JNC SP2 ;IF A STRING, CHECK FOR A COMMA
		1713	;
		1714	SP4: CJNE A,#T_TAB,SP6
		1715	ACALL I_PI ;ALWAYS CLEARS CARRY
		1716	SUBB A,PHEAD ;TAKE DELTA BETWEEN TAB AND PHEAD
		1717	JC SP2 ;EXIT IF PHEAD > TAB
		1718	SJMP SP7 ;OUTPUT SPACES
		1719	;
		1720	SP6: CJNE A,#T_SPC,SM
		1721	ACALL I_PI ;SET UP PAREN VALUE
		1722	;
		1723	SP7: JZ SP2
		1724	LCALL STEROT ;OUTPUT A SPACE
		1725	DEC A ;DECREMENT COUNTER
		1726	SJMP SP7 ;LOOP
		1727	;
		1728	newpage
		1729	SM: CJNE A,#T_CHR,SP8
		1730	ACALL IGC
		1731	CJNE A,#'$',$+9
		1732	ACALL CNX ;PUT THE CHARACTER ON THE STACK
		1733	ACALL IFIXL ;PUT THE CHARACTER IN R1
		1734	SJMP $+6
		1735	ACALL ONE ;EVALUATE THE EXPRESSION, PUT IN R3:R1
		1736	ACALL ERPAR
		1737	MOV R5,R1B0 ;BYTE TO OUTPUT
		1738	SJMP SQ
		1739	;
		1740	SP8: CJNE A,#T_CR,SX
		1741	ACALL GCI1 ;EAT THE TOKEN
		1742	MOV R5,#CR
		1743	;
		1744	SQ: CALL TEROT
		1745	SJMP SP2 ;OUTPUT A CR AND DO IT AGAIN
		1746	;
		1747	SX: CJNE A,#T_USE,SP9 ;USING TOKEN
		1748	ACALL IGC ;GE THE CHARACTER AFTER THE USING TOKEN
		1749	CJNE A,#'F',U4 ;SEE IF FLOATING
		1750	MOV FORMAT,#0F0H ;SET FLOATING
		1751	ACALL IGC ;BUMP THE POINTER AND GET THE CHARACTER
		1752	ACALL GCI1 ;BUMP IT AGAIN
		1753	ANL A,#0FH ;STRIP OFF ASCII BIAS
		1754	JZ U3 ;EXIT IF ZERO
		1755	CJNE A,#3,$+3 ;SEE IF AT LEAST A THREE
		1756	JNC U3 ;FORCE A THREE IF NOT A THREE
		1757	MOV A,#3
		1758	;
		1759	U3: ORL FORMAT,A ;PUT DIGIT IN FORMAT
		1760	SJMP U8 ;CLEAN UP END
		1761	;
		1762	U4: CJNE A,#'0',U5
		1763	MOV FORMAT,#0 ;FREE FORMAT
		1764	ACALL GCI1 ;BUMP THE POINTER
		1765	SJMP U8
		1766	;
		1767	U5: CJNE A,#'#',U8 ;SEE IF INTGER FORMAT
		1768	ACALL U6
		1769	MOV FORMAT,R7 ;SAVE THE FORMAT
		1770	CJNE A,#'.',U8A ;SEE IF TERMINATOR WAS RADIX
		1771	ACALL IGC ;BUMP PAST .
		1772	ACALL U6 ;LOOP AGAIN
		1773	MOV A,R7 ;GET COUNT
		1774	ADD A,FORMAT ;SEE IF TOO BIG
		1775	ADD A,#0F7H
		1776	JNC U5A
		1777	;
		1778	newpage
		1779	SE0: AJMP INTERX ;ERROR, BAD SYNTAX
		1780	;
		1781	U5A: MOV A,R7 ;GET THE COUNT BACK
		1782	SWAP A ;ADJUST
		1783	ORL FORMAT,A ;GET THE COUNT
		1784	;
		1785	U8A: MOV A,FORMAT
		1786	;
		1787	U8B: SWAP A ;GET THE FORMAT RIGHT
		1788	MOV FORMAT,A
		1789	;
		1790	U8: ACALL ERPAR
		1791	AJMP SP2 ;DONE
		1792	;
		1793	U6: MOV R7,#0 ;SET COUNTER
		1794	;
		1795	U7: CJNE A,#'#',SP9A ;EXIT IF NOT A #
		1796	INC R7 ;BUMP COUNTER
		1797	ACALL IGC ;GET THE NEXT CHARACTER
		1798	SJMP U7 ;LOOP
		1799	;
		1800	SP9: ACALL DELTST+2 ;CHECK FOR DELIMITER
		1801	JNC SP9A ;EXIT IF A DELIMITER
		1802	;
		1803	CJNE A,#T_ELSE,SS
		1804	;
		1805	SP9A: RET ;EXIT IF ELSE TOKEN
		1806	;
		1807	;**************************************************************
		1808	;
		1809	; P_E - Evaluate an expression in parens ( )
		1810	;
		1811	;**************************************************************
		1812	;
		1813	P_E: MOV R7,#T_LPAR
		1814	ACALL WE
		1815	;
		1816	ERPAR: MOV R7,#')' ;EAT A RIGHT PAREN
		1817	;
		1818	EATC: ACALL GCI ;GET THE CHARACTER
		1819	CJNE A,R7B0,SE0 ;ERROR IF NOT THE SAME
		1820	RET
		1821	;
		1822	newpage
		1823	;***************************************************************
		1824	;
		1825	S_ON: ; ON Statement
		1826	;
		1827	;***************************************************************
		1828	;
		1829	ACALL ONE ;GET THE EXPRESSION
		1830	ACALL GCI ;GET THE NEXT CHARACTER
		1831	CJNE A,#T_GOTO,C0
		1832	ACALL C1 ;EAT THE COMMAS
		1833	AJMP SF3 ;DO GOTO
		1834	;
		1835	C0: CJNE A,#T_GOSB,SE0
		1836	ACALL C1
		1837	AJMP SGS0 ;DO GOSUB
		1838	;
		1839	C1: CJNE R1,#0,C2
		1840	ACALL INTERR ;GET THE LINE NUMBER
		1841	ACALL FINDCR
		1842	AJMP RL1 ;FINISH UP THIS LINE
		1843	;
		1844	C2: MOV R7,#','
		1845	ACALL FINDC
		1846	CJNE A,#',',SE0 ;ERROR IF NOT A COMMA
		1847	DEC R1
		1848	ACALL GCI1 ;BUMP PAST COMMA
		1849	SJMP C1
		1850	;
		1851	newpage
		1852	;
		1853	SS: ACALL S_C ;SEE IF A STRING
		1854	JC SA ;NO STRING IF CARRY IS SET
		1855	LCALL UPRNT ;PUT POINTER IN DPTR
		1856	AJMP SP2 ;SEE IF MORE
		1857	;
		1858	SA: ACALL EXPRB ;MUST BE AN EXPRESSION
		1859	MOV A,#72
		1860	CJNE A,PHEAD,$+3 ;CHECK PHEAD POSITION
		1861	JNC $+4
		1862	ACALL SP0 ;FORCE A CRLF
		1863	JNB HMODE,S13 ;HEX MODE?
		1864	CALL FCMP ;SEE IF TOS IS < 0FFFH
		1865	JC S13 ;EXIT IF GREATER
		1866	CALL AABS ;GET THE SIGN
		1867	JNZ OOPS ;WASTE IF NEGATIVE
		1868	ACALL IFIXL
		1869	CALL FP_BASE+22 ;PRINT HEXMODE
		1870	AJMP SP2
		1871	OOPS: CALL ANEG ;MAKE IT NEGATIVE
		1872	;
		1873	S13: CALL FP_BASE+14 ;DO FP OUTPUT
		1874	MOV A,#1 ;OUTPUT A SPACE
		1875	AJMP SP7
		1876	;
		1877	newpage
		1878	;***************************************************************
		1879	;
		1880	; ANU - Get variable name from text - set carry if not found
		1881	; if succeeds returns variable in R7:R6
		1882	; R6 = 0 if no digit in name
		1883	;
		1884	;***************************************************************
		1885	;
		1886	ANU: ACALL IGC ;INCREMENT AND GET CHARACTER
		1887	LCALL 1FEDH ;CHECK FOR DIGIT
		1888	JC $+14 ;EXIT IF VALID DIGIT
		1889	CJNE A,#'_',$+4 ;SEE IF A _
		1890	RET
		1891	;
		1892	AL: CJNE A,#'A',$+3 ;IS IT AN ASCII A?
		1893	JC $+6 ;EXIT IF CARRY IS SET
		1894	CJNE A,#'Z'+1,$+3 ;IS IT LESS THAN AN ASCII Z
		1895	CPL C ;FLIP CARRY
		1896	RET
		1897	;
		1898	JNB F0,VAR2
		1899	;
		1900	SD0: MOV DPTR,#E6X
		1901	AJMP EK
		1902	;
		1903	SDIMX: SETB F0 ;SAYS DOING A DIMENSION
		1904	SJMP VAR1
		1905	;
		1906	VAR: CLR F0 ;SAYS DOING A VARIABLE
		1907	;
		1908	VAR1: ACALL GC ;GET THE CHARACTER
		1909	ACALL AL ;CHECK FOR ALPHA
		1910	JNC $+6 ;ERROR IF IN DIM
		1911	JB F0,SD0
		1912	RET
		1913	MOV R7,A ;SAVE ALPHA CHARACTER
		1914	CLR A ;ZERO IN CASE OF FAILURE
		1915	MOV R5,A ;SAVE IT
		1916	;
		1917	VY: MOV R6,A
		1918	ACALL ANU ;CHECK FOR ALPHA OR NUMBER
		1919	JC VX ;EXIT IF NO ALPHA OR NUM
		1920	;
		1921	XCH A,R7
		1922	ADD A,R5 ;NUMBER OF CHARACTERS IN ALPHABET
		1923	XCH A,R7 ;PUT IT BACK
		1924	MOV R5,#26 ;FOR THE SECOND TIME AROUND
		1925	SJMP VY
		1926	;
		1927	VX: CLR LINEB ;TELL EDITOR A VARIABLE IS DECLARED
		1928	CJNE A,#T_LPAR,V4 ;SEE IF A LEFT PAREN
		1929	;
		1930	ORL R6B0,#80H ;SET BIT 7 TO SIGINIFY MATRIX
		1931	CALL F_VAR ;FIND THE VARIABLE
		1932	PUSH R2B0 ;SAVE THE LOCATION
		1933	PUSH R0B0
		1934	JNC SD0-3 ;DEFAULT IF NOT IN TABLE
		1935	JB F0,SDI ;NO DEFAULT FOR DIMENSION
		1936	MOV R1,#10
		1937	MOV R3,#0
		1938	ACALL D_CHK
		1939	;
		1940	VAR2: ACALL PAREN_INT ;EVALUATE INTEGER IN PARENS
		1941	CJNE R3,#0,SD0 ;ERROR IF R3<>0
		1942	POP DPL ;GET VAR FOR LOOKUP
		1943	POP DPH
		1944	MOVX A,@DPTR ;GET DIMENSION
		1945	DEC A ;BUMP OFFSET
		1946	SUBB A,R1 ;A MUST BE > R1
		1947	JC SD0
		1948	LCALL DECDP2 ;BUMP POINTER TWICE
		1949	ACALL VARB ;CALCULATE THE BASE
		1950	;
		1951	X3120: XCH A,R1 ;SWAP R2:R0, R3:R1
		1952	XCH A,R0
		1953	XCH A,R1
		1954	XCH A,R3
		1955	XCH A,R2
		1956	XCH A,R3
		1957	RET
		1958	;
		1959	V4: JB F0,SD0 ;ERROR IF NO LPAR FOR DIM
		1960	LCALL F_VAR ;GET SCALAR VARIABLE
		1961	CLR C
		1962	RET
		1963	;
		1964	newpage
		1965	;
		1966	SDI: ACALL PAREN_INT ;EVALUATE PAREN EXPRESSION
		1967	CJNE R3,#0,SD0 ;ERROR IF NOT ZERO
		1968	POP R0B0 ;SET UP R2:R0
		1969	POP R2B0
		1970	ACALL D_CHK ;DO DIM
		1971	ACALL C_TST ;CHECK FOR COMMA
		1972	JNC SDIMX ;LOOP IF COMMA
		1973	RET ;RETURN IF NO COMMA
		1974	;
		1975	D_CHK: INC R1 ;BUMP FOR TABLE LOOKUP
		1976	MOV A,R1
		1977	JZ SD0 ;ERROR IF 0FFFFH
		1978	MOV R4,A ;SAVE FOR LATER
		1979	MOV DPTR,#MT_ALL ;GET MATRIX ALLOCATION
		1980	ACALL VARB ;DO THE CALCULATION
		1981	MOV R7,DPH ;SAVE MATRIX ALLOCATION
		1982	MOV R6,DPL
		1983	MOV DPTR,#ST_ALL ;SEE IF TOO MUCH MEMORY TAKEN
		1984	CALL FUL1 ;ST_ALL SHOULD BE > R3:R1
		1985	MOV DPTR,#MT_ALL ;SAVE THE NEW MATRIX POINTER
		1986	CALL S31DP
		1987	MOV DPL,R0 ;GET VARIABLE ADDRESS
		1988	MOV DPH,R2
		1989	MOV A,R4 ;DIMENSION SIZE
		1990	MOVX @DPTR,A ;SAVE IT
		1991	CALL DECDP2 ;SAVE TARGET ADDRESS
		1992	;
		1993	R76S: MOV A,R7
		1994	MOVX @DPTR,A
		1995	INC DPTR
		1996	MOV A,R6 ;ELEMENT SIZE
		1997	MOVX @DPTR,A
		1998	RET ;R2:R0 STILL HAS SYMBOL TABLE ADDRESS
		1999	;
		2000	newpage
		2001	;***************************************************************
		2002	;
		2003	; The statement action routine - INPUT
		2004	;
		2005	;***************************************************************
		2006	;
		2007	SINPUT: ACALL CPS ;PRINT STRING IF THERE
		2008	;
		2009	ACALL C_TST ;CHECK FOR A COMMA
		2010	JNC IN2A ;NO CRLF
		2011	ACALL SP0 ;DO A CRLF
		2012	;
		2013	IN2: MOV R5,#'?' ;OUTPUT A ?
		2014	CALL TEROT
		2015	;
		2016	IN2A: SETB INP_B ;DOING INPUT
		2017	CALL INLINE ;INPUT THE LINE
		2018	CLR INP_B
		2019	MOV TEMP5,#HI(IBUF)
		2020	MOV TEMP4,#LO(IBUF)
		2021	;
		2022	IN3: ACALL S_C ;SEE IF A STRING
		2023	JC IN3A ;IF CARRY IS SET, NO STRING
		2024	ACALL X3120 ;FLIP THE ADDRESSES
		2025	MOV R3,TEMP5
		2026	MOV R1,TEMP4
		2027	ACALL SSOOP
		2028	ACALL C_TST ;SEE IF MORE TO DO
		2029	JNC IN2
		2030	RET
		2031	;
		2032	IN3A: CALL DTEMP ;GET THE USER LOCATION
		2033	CALL GET_NUM ;GET THE USER SUPPLIED NUMBER
		2034	JNZ IN5 ;ERROR IF NOT ZERO
		2035	CALL TEMPD ;SAVE THE DATA POINTER
		2036	ACALL VAR_ER ;GET THE VARIABLE
		2037	ACALL XPOP ;SAVE THE VARIABLE
		2038	CALL DTEMP ;GET DPTR BACK FROM VAR_ER
		2039	ACALL C_TST ;SEE IF MORE TO DO
		2040	JC IN6 ;EXIT IF NO COMMA
		2041	MOVX A,@DPTR ;GET INPUT TERMINATOR
		2042	CJNE A,#',',IN5 ;IF NOT A COMMA DO A CR AND TRY AGAIN
		2043	INC DPTR ;BUMP PAST COMMA AND READ NEXT VALUE
		2044	CALL TEMPD
		2045	SJMP IN3
		2046	;
		2047	newpage
		2048	;
		2049	IN5: MOV DPTR,#IAN ;PRINT INPUT A NUMBER
		2050	CALL CRP ;DO A CR, THEN, PRINT FROM ROM
		2051	LJMP CC1 ;TRY IT AGAIN
		2052	;
		2053	IN6: MOVX A,@DPTR
		2054	CJNE A,#CR,EIGP
		2055	RET
		2056	;
		2057	EIGP: MOV DPTR,#EIG
		2058	CALL CRP ;PRINT THE MESSAGE AND EXIT
		2059	AJMP SP0 ;EXIT WITH A CRLF
		2060	;
		2061	;***************************************************************
		2062	;
		2063	SOT: ; On timer interrupt
		2064	;
		2065	;***************************************************************
		2066	;
		2067	ACALL TWO ;GET THE NUMBERS
		2068	MOV SP_H,R3
		2069	MOV SP_L,R1
		2070	MOV DPTR,#TIV ;SAVE THE NUMBER
		2071	SETB OTS
		2072	AJMP R76S ;EXIT
		2073	;
		2074	;
		2075	;***************************************************************
		2076	;
		2077	SCALL: ; Call a user rountine
		2078	;
		2079	;***************************************************************
		2080	;
		2081	ACALL INTERR ;CONVERT INTEGER
		2082	CJNE R2,#0,S_C_1 ;SEE IF TRAP
		2083	MOV A,R0
		2084	JB ACC.7,S_C_1
		2085	ADD A,R0
		2086	MOV DPTR,#4100H
		2087	MOV DPL,A
		2088	;
		2089	S_C_1: ACALL AC1 ;JUMP TO USER PROGRAM
		2090	ANL PSW,#11100111B ;BACK TO BANK 0
		2091	RET ;EXIT
		2092	;
		2093	newpage
		2094	;**************************************************************
		2095	;
		2096	THREE: ; Save value for timer function
		2097	;
		2098	;**************************************************************
		2099	;
		2100	ACALL ONE ;GET THE FIRST INTEGER
		2101	CALL CBIAS ;BIAS FOR TIMER LOAD
		2102	MOV T_HH,R3
		2103	MOV T_LL,R1
		2104	MOV R7,#',' ;WASTE A COMMA
		2105	ACALL EATC ;FALL THRU TO TWO
		2106	;
		2107	;**************************************************************
		2108	;
		2109	TWO: ; Get two values seperated by a comma off the stack
		2110	;
		2111	;**************************************************************
		2112	;
		2113	ACALL EXPRB
		2114	MOV R7,#',' ;WASTE THE COMMA
		2115	ACALL WE
		2116	JMP TWOL ;EXIT
		2117	;
		2118	;*************************************************************
		2119	;
		2120	ONE: ; Evaluate an expression and get an integer
		2121	;
		2122	;*************************************************************
		2123	;
		2124	ACALL EXPRB ;EVALUATE EXPERSSION
		2125	;
		2126	IFIXL: CALL IFIX ;INTEGERS IN R3:R1
		2127	MOV A,R1
		2128	RET
		2129	;
		2130	;
		2131	;*************************************************************
		2132	;
		2133	I_PI: ; Increment text pointer then get an integer
		2134	;
		2135	;*************************************************************
		2136	;
		2137	ACALL GCI1 ;BUMP TEXT, THEN GET INTEGER
		2138	;
		2139	PAREN_INT:; Get an integer in parens ( )
		2140	;
		2141	ACALL P_E
		2142	SJMP IFIXL
		2143	;
		2144	newpage
		2145	;
		2146	DP_B: MOV DPH,BOFAH
		2147	MOV DPL,BOFAL
		2148	RET
		2149	;
		2150	DP_T: MOV DPH,TXAH
		2151	MOV DPL,TXAL
		2152	RET
		2153	;
		2154	CPS: ACALL GC ;GET THE CHARACTER
		2155	CJNE A,#'"',NOPASS ;EXIT IF NO STRING
		2156	ACALL DP_T ;GET TEXT POINTER
		2157	INC DPTR ;BUMP PAST "
		2158	MOV R4,#'"'
		2159	CALL PN0 ;DO THE PRINT
		2160	INC DPTR ;GO PAST QUOTE
		2161	CLR C ;PASSED TEST
		2162	;
		2163	T_DP: MOV TXAH,DPH ;TEXT POINTER GETS DPTR
		2164	MOV TXAL,DPL
		2165	RET
		2166	;
		2167	;*************************************************************
		2168	;
		2169	S_C: ; Check for a string
		2170	;
		2171	;*************************************************************
		2172	;
		2173	ACALL GC ;GET THE CHARACTER
		2174	CJNE A,#'$',NOPASS ;SET CARRY IF NOT A STRING
		2175	AJMP IST_CAL ;CLEAR CARRY, CALCULATE OFFSET
		2176	;
		2177	;
		2178	;
		2179	;**************************************************************
		2180	;
		2181	C_TST: ACALL GC ;GET A CHARACTER
		2182	CJNE A,#',',NOPASS ;SEE IF A COMMA
		2183	;
		2184	newpage
		2185	;***************************************************************
		2186	;
		2187	;GC AND GCI - GET A CHARACTER FROM TEXT (NO BLANKS)
		2188	; PUT CHARACTER IN THE ACC
		2189	;
		2190	;***************************************************************
		2191	;
		2192	IGC: ACALL GCI1 ;BUMP POINTER, THEN GET CHARACTER
		2193	;
		2194	GC: SETB RS0 ;USE BANK 1
		2195	MOV P2,R2 ;SET UP PORT 2
		2196	MOVX A,@R0 ;GET EXTERNAL BYTE
		2197	CLR RS0 ;BACK TO BANK 0
		2198	RET ;EXIT
		2199	;
		2200	GCI: ACALL GC
		2201	;
		2202	; This routine bumps txa by one and always clears the carry
		2203	;
		2204	GCI1: SETB RS0 ;BANK 1
		2205	INC R0 ;BUMP TXA
		2206	CJNE R0,#0,$+4
		2207	INC R2
		2208	CLR RS0
		2209	RET ;EXIT
		2210	;
		2211	newpage
		2212	;**************************************************************
		2213	;
		2214	; Check delimiters
		2215	;
		2216	;**************************************************************
		2217	;
		2218	DELTST: ACALL GC ;GET A CHARACTER
		2219	CJNE A,#CR,DT1 ;SEE IF A CR
		2220	CLR A
		2221	RET
		2222	;
		2223	DT1: CJNE A,#':',NOPASS ;SET CARRY IF NO MATCH
		2224	;
		2225	L_RET: RET
		2226	;
		2227	;
		2228	;***************************************************************
		2229	;
		2230	; FINDC - Find the character in R7, update TXA
		2231	;
		2232	;***************************************************************
		2233	;
		2234	FINDCR: MOV R7,#CR ;KILL A STATEMENT LINE
		2235	;
		2236	FINDC: ACALL DELTST
		2237	JNC L_RET
		2238	;
		2239	CJNE A,R7B0,FNDCL2 ;MATCH?
		2240	RET
		2241	;
		2242	FNDCL2: ACALL GCI1
		2243	SJMP FINDC ;LOOP
		2244	;
		2245	ACALL GCI1
		2246	;
		2247	WCR: ACALL DELTST ;WASTE UNTIL A "REAL" CR
		2248	JNZ WCR-2
		2249	RET
		2250	;
		2251	newpage
		2252	;***************************************************************
		2253	;
		2254	; VAR_ER - Check for a variable, exit if error
		2255	;
		2256	;***************************************************************
		2257	;
		2258	VAR_ER: ACALL VAR
		2259	SJMP INTERR+2
		2260	;
		2261	;
		2262	;***************************************************************
		2263	;
		2264	; S_D0 - The Statement Action Routine DO
		2265	;
		2266	;***************************************************************
		2267	;
		2268	S_DO: ACALL CSC ;FINISH UP THE LINE
		2269	MOV R4,#DTYPE ;TYPE FOR STACK
		2270	ACALL SGS1 ;SAVE ON STACK
		2271	AJMP ILOOP ;EXIT
		2272	;
		2273	newpage
		2274	;***************************************************************
		2275	;
		2276	; CLN_UP - Clean up the end of a statement, see if at end of
		2277	; file, eat character and line count after CR
		2278	;
		2279	;***************************************************************
		2280	;
		2281	C_2: CJNE A,#':',C_1 ;SEE IF A TERMINATOR
		2282	AJMP GCI1 ;BUMP POINTER AND EXIT, IF SO
		2283	;
		2284	C_1: CJNE A,#T_ELSE,EP5
		2285	ACALL WCR ;WASTE UNTIL A CR
		2286	;
		2287	CLN_UP: ACALL GC ;GET THE CHARACTER
		2288	CJNE A,#CR,C_2 ;SEE IF A CR
		2289	ACALL IGC ;GET THE NEXT CHARACTER
		2290	CJNE A,#EOF,B_TXA ;SEE IF TERMINATOR
		2291	;
		2292	NOPASS: SETB C
		2293	RET
		2294	;
		2295	B_TXA: XCH A,TXAL ;BUMP TXA BY THREE
		2296	ADD A,#3
		2297	XCH A,TXAL
		2298	JBC CY,$+4
		2299	RET
		2300	INC TXAH
		2301	RET
		2302	;
		2303	newpage
		2304	;***************************************************************
		2305	;
		2306	; Get an INTEGER from the text
		2307	; sets CARRY if not found
		2308	; returns the INTGER value in DPTR and R2:R0
		2309	; returns the terminator in ACC
		2310	;
		2311	;***************************************************************
		2312	;
		2313	INTERR: ACALL INTGER ;GET THE INTEGER
		2314	JC EP5 ;ERROR IF NOT FOUND
		2315	RET ;EXIT IF FOUND
		2316	;
		2317	INTGER: ACALL DP_T
		2318	CALL FP_BASE+18 ;CONVERT THE INTEGER
		2319	ACALL T_DP
		2320	MOV DPH,R2 ;PUT THE RETURNED VALUE IN THE DPTR
		2321	MOV DPL,R0
		2322	;
		2323	ITRET: RET ;EXIT
		2324	;
		2325	;
		2326	WE: ACALL EATC ;WASTE THE CHARACTER
		2327	;
		2328	; Fall thru to evaluate the expression
		2329	;
		2330	newpage
		2331	;***************************************************************
		2332	;
		2333	; EXPRB - Evaluate an expression
		2334	;
		2335	;***************************************************************
		2336	;
		2337	EXPRB: MOV R2,#LO(OPBOL) ;BASE PRECEDENCE
		2338	;
		2339	EP1: PUSH R2B0 ;SAVE OPERATOR PRECEDENCE
		2340	CLR ARGF ;RESET STACK DESIGNATOR
		2341	;
		2342	EP2: MOV A,SP ;GET THE STACK POINTER
		2343	ADD A,#12 ;NEED AT LEAST 12 BYTES
		2344	JNC $+5
		2345	LJMP ERROR-3
		2346	MOV A,ASTKA ;GET THE ARG STACK
		2347	SUBB A,#LO(TM_TOP+12);NEED 12 BYTES ALSO
		2348	JNC $+5
		2349	LJMP E4YY
		2350	JB ARGF,EP4 ;MUST BE AN OPERATOR, IF SET
		2351	ACALL VAR ;IS THE VALUE A VARIABLE?
		2352	JNC EP3 ;PUT VARIABLE ON STACK
		2353	;
		2354	ACALL CONST ;IS THE VALUE A NUMERIC CONSTANT?
		2355	JNC EP4 ;IF SO, CONTINUE, IF NOT, SEE WHAT
		2356	CALL GC ;GET THE CHARACTER
		2357	CJNE A,#T_LPAR,EP4 ;SEE IF A LEFT PAREN
		2358	MOV A,#(LO(OPBOL+1))
		2359	SJMP XLPAR ;PROCESS THE LEFT PAREN
		2360	;
		2361	EP3: ACALL PUSHAS ;SAVE VAR ON STACK
		2362	;
		2363	EP4: ACALL GC ;GET THE OPERATOR
		2364	;
		2365	CJNE A,#T_LPAR,$+3 ;IS IT AN OPERATOR
		2366	JNC XOP ;PROCESS OPERATOR
		2367	CJNE A,#T_UOP,$+3 ;IS IT A UNARY OPERATOR
		2368	JNC XBILT ;PROCESS UNARY (BUILT IN) OPERATOR
		2369	POP R2B0 ;GET BACK PREVIOUS OPERATOR PRECEDENCE
		2370	JB ARGF,ITRET ;OK IF ARG FLAG IS SET
		2371	;
		2372	EP5: CLR C ;NO RECOVERY
		2373	LJMP E1XX+2
		2374	;
		2375	; Process the operator
		2376	;
		2377	XOP: ANL A,#1FH ;STRIP OFF THE TOKE BITS
		2378	JB ARGF,XOP1 ;IF ARG FLAG IS SET, PROCESS
		2379	CJNE A,#T_SUB-T_LPAR,XOP3
		2380	MOV A,#T_NEG-T_LPAR
		2381	;
		2382	newpage
		2383	XOP1: ADD A,#LO(OPBOL+1) ;BIAS THE TABLE
		2384	MOV R2,A
		2385	MOV DPTR,#00H
		2386	MOVC A,@A+DPTR ;GET THE CURRENT PRECEDENCE
		2387	MOV R4,A
		2388	POP ACC ;GET THE PREVIOUS PRECEDENCE
		2389	MOV R5,A ;SAVE THE PREVIOUS PRECEDENCE
		2390	MOVC A,@A+DPTR ;GET IT
		2391	CJNE A,R4B0,$+7 ;SEE WHICH HAS HIGHER PRECEDENCE
		2392	CJNE A,#12,ITRET ;SEE IF ANEG
		2393	SETB C
		2394	JNC ITRET ;PROCESS NON-INCREASING PRECEDENCE
		2395	;
		2396	; Save increasing precedence
		2397	;
		2398	PUSH R5B0 ;SAVE OLD PRECEDENCE ADDRESS
		2399	PUSH R2B0 ;SAVE NEW PRECEDENCE ADDRESS
		2400	ACALL GCI1 ;EAT THE OPERATOR
		2401	ACALL EP1 ;EVALUATE REMAINING EXPRESSION
		2402	POP ACC
		2403	;
		2404	; R2 has the action address, now setup and perform operation
		2405	;
		2406	XOP2: MOV DPTR,#OPTAB
		2407	ADD A,#LO(~OPBOL)
		2408	CALL ISTA1 ;SET UP TO RETURN TO EP2
		2409	AJMP EP2 ;JUMP TO EVALUATE EXPRESSION
		2410	;
		2411	; Built-in operator processing
		2412	;
		2413	XBILT: ACALL GCI1 ;EAT THE TOKEN
		2414	ADD A,#LO(50H+LO(UOPBOL))
		2415	JB ARGF,EP5 ;XBILT MUST COME AFTER AN OPERATOR
		2416	CJNE A,#STP,$+3
		2417	JNC XOP2
		2418	;
		2419	XLPAR: PUSH ACC ;PUT ADDRESS ON THE STACK
		2420	ACALL P_E
		2421	SJMP XOP2-2 ;PERFORM OPERATION
		2422	;
		2423	XOP3: CJNE A,#T_ADD-T_LPAR,EP5
		2424	ACALL GCI1
		2425	AJMP EP2 ;WASTE + SIGN
		2426	;
		2427	newpage
		2428	XPOP: ACALL X3120 ;FLIP ARGS THEN POP
		2429	;
		2430	;***************************************************************
		2431	;
		2432	; POPAS - Pop arg stack and copy variable to R3:R1
		2433	;
		2434	;***************************************************************
		2435	;
		2436	POPAS: LCALL INC_ASTKA
		2437	JMP VARCOP ;COPY THE VARIABLE
		2438	;
		2439	AXTAL: MOV R2,#HI(CXTAL)
		2440	MOV R0,#LO(CXTAL)
		2441	;
		2442	; fall thru
		2443	;
		2444	;***************************************************************
		2445	;
		2446	PUSHAS: ; Push the Value addressed by R2:R0 onto the arg stack
		2447	;
		2448	;***************************************************************
		2449	;
		2450	CALL DEC_ASTKA
		2451	SETB ARGF ;SAYS THAT SOMTHING IS ON THE STACK
		2452	LJMP VARCOP
		2453	;
		2454	;
		2455	;***************************************************************
		2456	;
		2457	ST_A: ; Store at expression
		2458	;
		2459	;***************************************************************
		2460	;
		2461	ACALL ONE ;GET THE EXPRESSION
		2462	SJMP POPAS ;SAVE IT
		2463	;
		2464	;
		2465	;***************************************************************
		2466	;
		2467	LD_A: ; Load at expression
		2468	;
		2469	;***************************************************************
		2470	;
		2471	ACALL ONE ;GET THE EXPRESSION
		2472	ACALL X3120 ;FLIP ARGS
		2473	SJMP PUSHAS
		2474	;
		2475	newpage
		2476	;***************************************************************
		2477	;
		2478	CONST: ; Get a constant fron the text
		2479	;
		2480	;***************************************************************
		2481	;
		2482	CALL GC ;FIRST SEE IF LITERAL
		2483	CJNE A,#T_ASC,C0C ;SEE IF ASCII TOKEN
		2484	CALL IGC ;GET THE CHARACTER AFTER TOKEN
		2485	CJNE A,#'$',CN0 ;SEE IF A STRING
		2486	;
		2487	CNX: CALL CSY ;CALCULATE IT
		2488	LJMP AXBYTE+2 ;SAVE IT ON THE STACK ******AA JMP-->LJMP
		2489	;
		2490	CN0: LCALL TWO_R2 ;PUT IT ON THE STACK ******AA CALL-->LCALL
		2491	CALL GCI1 ;BUMP THE POINTER
		2492	LJMP ERPAR ;WASTE THE RIGHT PAREN ******AA JMP-->LJMP
		2493	;
		2494	;
		2495	C0C: CALL DP_T ;GET THE TEXT POINTER
		2496	CALL GET_NUM ;GET THE NUMBER
		2497	CJNE A,#0FFH,C1C ;SEE IF NO NUMBER
		2498	SETB C
		2499	C2C: RET
		2500	;
		2501	C1C: JNZ FPTST
		2502	CLR C
		2503	SETB ARGF
		2504	;
		2505	C3C: JMP T_DP
		2506	;
		2507	FPTST: ANL A,#00001011B ;CHECK FOR ERROR
		2508	JZ C2C ;EXIT IF ZERO
		2509	;
		2510	; Handle the error condition
		2511	;
		2512	MOV DPTR,#E2X ;DIVIDE BY ZERO
		2513	JNB ACC.0,$+6 ;UNDERFLOW
		2514	MOV DPTR,#E7X
		2515	JNB ACC.1,$+6 ;OVERFLOW
		2516	MOV DPTR,#E11X
		2517	;
		2518	FPTS: JMP ERROR
		2519	;
		2520	newpage
		2521	;***************************************************************
		2522	;
		2523	; The Command action routine - LIST
		2524	;
		2525	;***************************************************************
		2526	;
		2527	CLIST: CALL NUMC ;SEE IF TO LINE PORT
		2528	ACALL FSTK ;PUT 0FFFFH ON THE STACK
		2529	CALL INTGER ;SEE IF USER SUPPLIES LN
		2530	CLR A ;LN = 0 TO START
		2531	MOV R3,A
		2532	MOV R1,A
		2533	JC CL1 ;START FROM ZERO
		2534	;
		2535	CALL TEMPD ;SAVE THE START ADDTESS
		2536	CALL GCI ;GET THE CHARACTER AFTER LIST
		2537	CJNE A,#T_SUB,$+10 ;CHECK FOR TERMINATION ADDRESS '-'
		2538	ACALL INC_ASTKA ;WASTE 0FFFFH
		2539	LCALL INTERR ;GET TERMINATION ADDRESS
		2540	ACALL TWO_EY ;PUT TERMINATION ON THE ARG STACK
		2541	MOV R3,TEMP5 ;GET THE START ADDTESS
		2542	MOV R1,TEMP4
		2543	;
		2544	CL1: CALL GETLIN ;GET THE LINE NO IN R3:R1
		2545	JZ CL3 ;RET IF AT END
		2546	;
		2547	CL2: ACALL C3C ;SAVE THE ADDRESS
		2548	INC DPTR ;POINT TO LINE NUMBER
		2549	ACALL PMTOP+3 ;PUT LINE NUMBER ON THE STACK
		2550	ACALL CMPLK ;COMPARE LN TO END ADDRESS
		2551	JC CL3 ;EXIT IF GREATER
		2552	CALL BCK ;CHECK FOR A CONTROL C
		2553	ACALL DEC_ASTKA ;SAVE THE COMPARE ADDRESS
		2554	CALL DP_T ;RESTORE ADDRESS
		2555	ACALL UPPL ;UN-PROCESS THE LINE
		2556	ACALL C3C ;SAVE THE CR ADDRESS
		2557	ACALL CL6 ;PRINT IT
		2558	INC DPTR ;BUMP POINTER TO NEXT LINE
		2559	MOVX A,@DPTR ;GET LIN LENGTH
		2560	DJNZ ACC,CL2 ;LOOP
		2561	ACALL INC_ASTKA ;WASTE THE COMPARE BYTE
		2562	;
		2563	CL3: AJMP CMND1 ;BACK TO COMMAND PROCESSOR
		2564	;
		2565	CL6: MOV DPTR,#IBUF ;PRINT IBUF
		2566	CALL PRNTCR ;PRINT IT
		2567	CALL DP_T
		2568	;
		2569	CL7: JMP CRLF
		2570	;
		2571	LCALL X31DP
		2572	newpage
		2573	;***************************************************************
		2574	;
		2575	;UPPL - UN PREPROCESS A LINE ADDRESSED BY DPTR INTO IBUF
		2576	; RETURN SOURCE ADDRESS OF CR IN DPTR ON RETURN
		2577	;
		2578	;***************************************************************
		2579	;
		2580	UPPL: MOV R3,#HI(IBUF) ;POINT R3 AT HIGH IBUF
		2581	MOV R1,#LO(IBUF) ;POINT R1 AT IBUF
		2582	INC DPTR ;SKIP OVER LINE LENGTH
		2583	ACALL C3C ;SAVE THE DPTR (DP_T)
		2584	CALL L20DPI ;PUT LINE NUMBER IN R2:R0
		2585	CALL FP_BASE+16 ;CONVERT R2:R0 TO INTEGER
		2586	CALL DP_T
		2587	INC DPTR ;BUMP DPTR PAST THE LINE NUMBER
		2588	;
		2589	UPP0: CJNE R1,#LO(IBUF+6),$+3
		2590	JC UPP1A-4 ;PUT SPACES IN TEXT
		2591	INC DPTR ;BUMP PAST LN HIGH
		2592	MOVX A,@DPTR ;GET USER TEXT
		2593	MOV R6,A ;SAVE A IN R6 FOR TOKE COMPARE
		2594	JB ACC.7,UPP1 ;IF TOKEN, PROCESS
		2595	CJNE A,#20H,$+3 ;TRAP THE USER TOKENS
		2596	JNC $+5
		2597	CJNE A,#CR,UPP1 ;DO IT IF NOT A CR
		2598	CJNE A,#'"',UPP9 ;SEE IF STRING
		2599	ACALL UPP7 ;SAVE IT
		2600	ACALL UPP8 ;GET THE NEXT CHARACTER AND SAVE IT
		2601	CJNE A,#'"',$-2 ;LOOP ON QUOTES
		2602	SJMP UPP0
		2603	;
		2604	UPP9: CJNE A,#':',UPP1A ;PUT A SPACE IN DELIMITER
		2605	ACALL UPP7A
		2606	MOV A,R6
		2607	ACALL UPP7
		2608	ACALL UPP7A
		2609	SJMP UPP0
		2610	;
		2611	UPP1A: ACALL UPP8+2 ;SAVE THE CHARACTER, UPDATE POINTER
		2612	SJMP UPP0 ;EXIT IF A CR, ELSE LOOP
		2613	;
		2614	UPP1: ACALL C3C ;SAVE THE TEXT POINTER
		2615	MOV C,XBIT
		2616	MOV F0,C ;SAVE XBIT IN F0
		2617	MOV DPTR,#TOKTAB ;POINT AT TOKEN TABLE
		2618	JNB F0,UPP2
		2619	LCALL 2078H ;SET UP DPTR FOR LOOKUP
		2620	;
		2621	UPP2: CLR A ;ZERO A FOR LOOKUP
		2622	MOVC A,@A+DPTR ;GET TOKEN
		2623	INC DPTR ;ADVANCE THE TOKEN POINTER
		2624	CJNE A,#0FFH,UP_2 ;SEE IF DONE
		2625	JBC F0,UPP2-9 ;NOW DO NORMAL TABLE
		2626	AJMP CMND1 ;EXIT IF NOT FOUND
		2627	;
		2628	UP_2: CJNE A,R6B0,UPP2 ;LOOP UNTIL THE SAME
		2629	;
		2630	UP_3: CJNE A,#T_UOP,$+3
		2631	JNC UPP3
		2632	ACALL UPP7A ;PRINT THE SPACE IF OK
		2633	;
		2634	UPP3: CLR A ;DO LOOKUP
		2635	MOVC A,@A+DPTR
		2636	JB ACC.7,UPP4 ;EXIT IF DONE, ELSE SAVE
		2637	JZ UPP4 ;DONE IF ZERO
		2638	ACALL UPP7 ;SAVE THE CHARACTER
		2639	INC DPTR
		2640	SJMP UPP3 ;LOOP
		2641	;
		2642	UPP4: CALL DP_T ;GET IT BACK
		2643	MOV A,R6 ;SEE IF A REM TOKEN
		2644	XRL A,#T_REM
		2645	JNZ $+6
		2646	ACALL UPP8
		2647	SJMP $-2
		2648	JNC UPP0 ;START OVER AGAIN IF NO TOKEN
		2649	ACALL UPP7A ;PRINT THE SPACE IF OK
		2650	SJMP UPP0 ;DONE
		2651	;
		2652	UPP7A: MOV A,#' ' ;OUTPUT A SPACE
		2653	;
		2654	UPP7: AJMP PPL9+1 ;SAVE A
		2655	;
		2656	UPP8: INC DPTR
		2657	MOVX A,@DPTR
		2658	CJNE A,#CR,UPP7
		2659	AJMP PPL7+1
		2660	;
		2661	newpage
		2662	;**************************************************************
		2663	;
		2664	; This table contains all of the floating point constants
		2665	;
		2666	; The constants in ROM are stored "backwards" from the way
		2667	; basic normally treats floating point numbers. Instead of
		2668	; loading from the exponent and decrementing the pointer,
		2669	; ROM constants pointers load from the most significant
		2670	; digits and increment the pointers. This is done to 1) make
		2671	; arg stack loading faster and 2) compensate for the fact that
		2672	; no decrement data pointer instruction exsist.
		2673	;
		2674	; The numbers are stored as follows:
		2675	;
		2676	; BYTE X+5 = MOST SIGNIFICANT DIGITS IN BCD
		2677	; BYTE X+4 = NEXT MOST SIGNIFICANT DIGITS IN BCD
		2678	; BYTE X+3 = NEXT LEAST SIGNIFICANT DIGITS IN BCD
		2679	; BYTE X+2 = LEAST SIGNIFICANT DIGITS IN BCD
		2680	; BYTE X+1 = SIGN OF THE ABOVE MANTISSA 0 = +, 1 = -
		2681	; BYTE X = EXPONENT IN TWO'S COMPLEMENT BINARY
		2682	; ZERO EXPONENT = THE NUMBER ZERO
		2683	;
		2684	;**************************************************************
		2685	;
		2686	ATTAB: DB 128-2 ; ARCTAN LOOKUP
		2687	DB 00H
		2688	DB 57H
		2689	DB 22H
		2690	DB 66H
		2691	DB 28H
		2692	;
		2693	DB 128-1
		2694	DB 01H
		2695	DB 37H
		2696	DB 57H
		2697	DB 16H
		2698	DB 16H
		2699	;
		2700	DB 128-1
		2701	DB 00H
		2702	DB 14H
		2703	DB 96H
		2704	DB 90H
		2705	DB 42H
		2706	;
		2707	DB 128-1
		2708	DB 01H
		2709	DB 40H
		2710	DB 96H
		2711	DB 28H
		2712	DB 75H
		2713	;
		2714	DB 128
		2715	DB 00H
		2716	DB 64H
		2717	DB 62H
		2718	DB 65H
		2719	DB 10H
		2720	;
		2721	DB 128
		2722	DB 01H
		2723	DB 99H
		2724	DB 88H
		2725	DB 20H
		2726	DB 14H
		2727	;
		2728	DB 128
		2729	DB 00H
		2730	DB 51H
		2731	DB 35H
		2732	DB 99H
		2733	DB 19H
		2734	;
		2735	DB 128
		2736	DB 01H
		2737	DB 45H
		2738	DB 31H
		2739	DB 33H
		2740	DB 33H
		2741	;
		2742	DB 129
		2743	DB 00H
		2744	DB 00H
		2745	DB 00H
		2746	DB 00H
		2747	DB 10H
		2748	;
		2749	DB 0FFH ;END OF TABLE
		2750	;
		2751	NTWO: DB 129
		2752	DB 0
		2753	DB 0
		2754	DB 0
		2755	DB 0
		2756	DB 20H
		2757	;
		2758	TTIME: DB 128-4 ; CLOCK CALCULATION
		2759	DB 00H
		2760	DB 00H
		2761	DB 00H
		2762	DB 04H
		2763	DB 13H
		2764	;
		2765	newpage
		2766	;***************************************************************
		2767	;
		2768	; COSINE - Add pi/2 to stack, then fall thru to SIN
		2769	;
		2770	;***************************************************************
		2771	;
		2772	ACOS: ACALL POTWO ;PUT PI/2 ON THE STACK
		2773	ACALL AADD ;TOS = TOS+PI/2
		2774	;
		2775	;***************************************************************
		2776	;
		2777	; SINE - use taylor series to calculate sin function
		2778	;
		2779	;***************************************************************
		2780	;
		2781	ASIN: ACALL PIPI ;PUT PI ON THE STACK
		2782	ACALL RV ;REDUCE THE VALUE
		2783	MOV A,MT2 ;CALCULATE THE SIGN
		2784	ANL A,#01H ;SAVE LSB
		2785	XRL MT1,A ;SAVE SIGN IN MT1
		2786	ACALL CSTAKA ;NOW CONVERT TO ONE QUADRANT
		2787	ACALL POTWO
		2788	ACALL CMPLK ;DO COMPARE
		2789	JC $+6
		2790	ACALL PIPI
		2791	ACALL ASUB
		2792	ACALL AABS
		2793	MOV DPTR,#SINTAB ;SET UP LOOKUP TABLE
		2794	ACALL POLYC ;CALCULATE THE POLY
		2795	ACALL STRIP
		2796	AJMP SIN0
		2797	;
		2798	; Put PI/2 on the stack
		2799	;
		2800	POTWO: ACALL PIPI ;PUT PI ON THE STACK, NOW DIVIDE
		2801	;
		2802	DBTWO: MOV DPTR,#NTWO
		2803	ACALL PUSHC
		2804	;MOV A,#2 ;BY TWO
		2805	;ACALL TWO_R2
		2806	AJMP ADIV
		2807	;
		2808	newpage
		2809	;*************************************************************
		2810	;
		2811	POLYC: ; Expand a power series to calculate a polynomial
		2812	;
		2813	;*************************************************************
		2814	;
		2815	ACALL CSTAKA2 ;COPY THE STACK
		2816	ACALL AMUL ;SQUARE THE STACK
		2817	ACALL POP_T1 ;SAVE X*X
		2818	ACALL PUSHC ;PUT CONSTANT ON STACK
		2819	;
		2820	POLY1: ACALL PUSH_T1 ;PUT COMPUTED VALUE ON STACK
		2821	ACALL AMUL ;MULTIPLY CONSTANT AND COMPUTED VALUE
		2822	ACALL PUSHC ;PUT NEXT CONSTANT ON STACK
		2823	ACALL AADD ;ADD IT TO THE OLD VALUE
		2824	CLR A ;CHECK TO SEE IF DONE
		2825	MOVC A,@A+DPTR
		2826	CJNE A,#0FFH,POLY1 ;LOOP UNTIL DONE
		2827	;
		2828	AMUL: LCALL FP_BASE+6
		2829	AJMP FPTST
		2830	;
		2831	;*************************************************************
		2832	;
		2833	RV: ; Reduce a value for Trig and A**X functions
		2834	;
		2835	; value = (value/x - INT(value/x)) * x
		2836	;
		2837	;*************************************************************
		2838	;
		2839	ACALL C_T2 ;COPY TOS TO T2
		2840	ACALL ADIV ;TOS = TOS/TEMP2
		2841	ACALL AABS ;MAKE THE TOS A POSITIVE NUMBER
		2842	MOV MT1,A ;SAVE THE SIGN
		2843	ACALL CSTAKA2 ;COPY THE STACK TWICE
		2844	ACALL IFIX ;PUT THE NUMBER IN R3:R1
		2845	PUSH R3B0 ;SAVE R3
		2846	MOV MT2,R1 ;SAVE THE LS BYTE IN MT2
		2847	ACALL AINT ;MAKE THE TOS AN INTEGER
		2848	ACALL ASUB ;TOS = TOS/T2 - INT(TOS/T2)
		2849	ACALL P_T2 ;TOS = T2
		2850	ACALL AMUL ;TOS = T2*(TOS/T2 - INT(TOS/T2)
		2851	POP R3B0 ;RESTORE R3
		2852	RET ;EXIT
		2853	;
		2854	newpage
		2855	;**************************************************************
		2856	;
		2857	; TAN
		2858	;
		2859	;**************************************************************
		2860	;
		2861	ATAN: ACALL CSTAKA ;DUPLACATE STACK
		2862	ACALL ASIN ;TOS = SIN(X)
		2863	ACALL SWAP_ASTKA ;TOS = X
		2864	ACALL ACOS ;TOS = COS(X)
		2865	AJMP ADIV ;TOS = SIN(X)/COS(X)
		2866	;
		2867	STRIP: ACALL SETREG ;SETUP R0
		2868	MOV R3,#1 ;LOOP COUNT
		2869	AJMP AI2-1 ;WASTE THE LSB
		2870	;
		2871	;************************************************************
		2872	;
		2873	; ARC TAN
		2874	;
		2875	;************************************************************
		2876	;
		2877	AATAN: ACALL AABS
		2878	MOV MT1,A ;SAVE THE SIGN
		2879	ACALL SETREG ;GET THE EXPONENT
		2880	ADD A,#7FH ;BIAS THE EXPONENT
		2881	MOV UBIT,C ;SAVE CARRY STATUS
		2882	JNC $+4 ;SEE IF > 1
		2883	ACALL RECIP ;IF > 1, TAKE RECIP
		2884	MOV DPTR,#ATTAB ;SET UP TO CALCULATE THE POLY
		2885	ACALL POLYC ;CALCULATE THE POLY
		2886	JNB UBIT,SIN0 ;JUMP IF NOT SET
		2887	ACALL ANEG ;MAKE X POLY NEGATIVE
		2888	ACALL POTWO ;SUBTRACT PI/2
		2889	ACALL AADD
		2890	;
		2891	SIN0: MOV A,MT1 ;GET THE SIGN
		2892	JZ SRT
		2893	AJMP ANEG
		2894	;
		2895	newpage
		2896	;*************************************************************
		2897	;
		2898	; FCOMP - COMPARE 0FFFFH TO TOS
		2899	;
		2900	;*************************************************************
		2901	;
		2902	FCMP: ACALL CSTAKA ;COPY THE STACK
		2903	ACALL FSTK ;MAKE THE TOS = 0FFFFH
		2904	ACALL SWAP_ASTKA ;NOW COMPARE IS 0FFFFH - X
		2905	;
		2906	CMPLK: JMP FP_BASE+4 ;DO THE COMPARE
		2907	;
		2908	;*************************************************************
		2909	;
		2910	DEC_ASTKA: ;Push ARG STACK and check for underflow
		2911	;
		2912	;*************************************************************
		2913	;
		2914	MOV A,#-FPSIZ
		2915	ADD A,ASTKA
		2916	CJNE A,#LO(TM_TOP+6),$+3
		2917	JC E4YY
		2918	MOV ASTKA,A
		2919	MOV R1,A
		2920	MOV R3,#ASTKAH
		2921	;
		2922	SRT: RET
		2923	;
		2924	E4YY: MOV DPTR,#EXA
		2925	AJMP FPTS ;ARG STACK ERROR
		2926	;
		2927	;
		2928	AXTAL3: ACALL PUSHC ;PUSH CONSTANT, THEN MULTIPLY
		2929	ACALL AMUL
		2930	;
		2931	; Fall thru to IFIX
		2932	;
		2933	newpage
		2934	;***************************************************************
		2935	;
		2936	IFIX: ; Convert a floating point number to an integer, put in R3:R1
		2937	;
		2938	;***************************************************************
		2939	;
		2940	CLR A ;RESET THE START
		2941	MOV R3,A
		2942	MOV R1,A
		2943	MOV R0,ASTKA ;GET THE ARG STACK
		2944	MOV P2,#ASTKAH
		2945	MOVX A,@R0 ;READ EXPONENT
		2946	CLR C
		2947	SUBB A,#81H ;BASE EXPONENT
		2948	MOV R4,A ;SAVE IT
		2949	DEC R0 ;POINT AT SIGN
		2950	MOVX A,@R0 ;GET THE SIGN
		2951	JNZ SQ_ERR ;ERROR IF NEGATIVE
		2952	JC INC_ASTKA ;EXIT IF EXPONENT IS < 81H
		2953	INC R4 ;ADJUST LOOP COUNTER
		2954	MOV A,R0 ;BUMP THE POINTER REGISTER
		2955	SUBB A,#FPSIZ-1
		2956	MOV R0,A
		2957	;
		2958	I2: INC R0 ;POINT AT DIGIT
		2959	MOVX A,@R0 ;GET DIGIT
		2960	SWAP A ;FLIP
		2961	CALL FP_BASE+20 ;ACCUMULATE
		2962	JC SQ_ERR
		2963	DJNZ R4,$+4
		2964	SJMP INC_ASTKA
		2965	MOVX A,@R0 ;GET DIGIT
		2966	CALL FP_BASE+20
		2967	JC SQ_ERR
		2968	DJNZ R4,I2
		2969	;
		2970	newpage
		2971	;************************************************************
		2972	;
		2973	INC_ASTKA: ; Pop the ARG STACK and check for overflow
		2974	;
		2975	;************************************************************
		2976	;
		2977	MOV A,#FPSIZ ;NUMBER TO POP
		2978	SJMP SETREG+1
		2979	;
		2980	SETREG: CLR A ;DON'T POP ANYTHING
		2981	MOV R0,ASTKA
		2982	MOV R2,#ASTKAH
		2983	MOV P2,R2
		2984	ADD A,R0
		2985	JC E4YY
		2986	MOV ASTKA,A
		2987	MOVX A,@R0
		2988	A_D: RET
		2989	;
		2990	;************************************************************
		2991	;
		2992	; EBIAS - Bias a number for E to the X calculations
		2993	;
		2994	;************************************************************
		2995	;
		2996	EBIAS: ACALL PUSH_ONE
		2997	ACALL RV
		2998	CJNE R3,#00H,SQ_ERR ;ERROR IF R3 <> 0
		2999	ACALL C_T2 ;TEMP 2 GETS FRACTIONS
		3000	ACALL INC_ASTKA
		3001	ACALL POP_T1
		3002	ACALL PUSH_ONE
		3003	;
		3004	AELP: MOV A,MT2
		3005	JNZ AEL1
		3006	;
		3007	MOV A,MT1
		3008	JZ A_D
		3009	MOV DPTR,#FPT2-1
		3010	MOVX @DPTR,A ;MAKE THE FRACTIONS NEGATIVE
		3011	;
		3012	RECIP: ACALL PUSH_ONE
		3013	ACALL SWAP_ASTKA
		3014	AJMP ADIV
		3015	;
		3016	AEL1: DEC MT2
		3017	ACALL PUSH_T1
		3018	ACALL AMUL
		3019	SJMP AELP
		3020	;
		3021	SQ_ERR: LJMP E3XX ;LINK TO BAD ARG
		3022	;
		3023	newpage
		3024	;************************************************************
		3025	;
		3026	; SQUARE ROOT
		3027	;
		3028	;************************************************************
		3029	;
		3030	ASQR: ACALL AABS ;GET THE SIGN
		3031	JNZ SQ_ERR ;ERROR IF NEGATIVE
		3032	ACALL C_T2 ;COPY VARIABLE TO T2
		3033	ACALL POP_T1 ;SAVE IT IN T1
		3034	MOV R0,#LO(FPT1)
		3035	MOVX A,@R0 ;GET EXPONENT
		3036	JZ ALN-2 ;EXIT IF ZERO
		3037	ADD A,#128 ;BIAS THE EXPONENT
		3038	JNC SQR1 ;SEE IF < 80H
		3039	RR A
		3040	ANL A,#127
		3041	SJMP SQR2
		3042	;
		3043	SQR1: CPL A ;FLIP BITS
		3044	INC A
		3045	RR A
		3046	ANL A,#127 ;STRIP MSB
		3047	CPL A
		3048	INC A
		3049	;
		3050	SQR2: ADD A,#128 ;BIAS EXPONENT
		3051	MOVX @R0,A ;SAVE IT
		3052	;
		3053	; NEWGUESS = ( X/OLDGUESS + OLDGUESS) / 2
		3054	;
		3055	SQR4: ACALL P_T2 ;TOS = X
		3056	ACALL PUSH_T1 ;PUT NUMBER ON STACK
		3057	ACALL ADIV ;TOS = X/GUESS
		3058	ACALL PUSH_T1 ;PUT ON AGAIN
		3059	ACALL AADD ;TOS = X/GUESS + GUESS
		3060	ACALL DBTWO ;TOS = ( X/GUESS + GUESS ) / 2
		3061	ACALL TEMP_COMP ;SEE IF DONE
		3062	JNB F0,SQR4
		3063	;
		3064	AJMP PUSH_T1 ;PUT THE ANSWER ON THE STACK
		3065	;
		3066	newpage
		3067	;*************************************************************
		3068	;
		3069	; NATURAL LOG
		3070	;
		3071	;*************************************************************
		3072	;
		3073	ALN: ACALL AABS ;MAKE SURE THAT NUM IS POSITIVE
		3074	JNZ SQ_ERR ;ERROR IF NOT
		3075	MOV MT2,A ;CLEAR FOR LOOP
		3076	INC R0 ;POINT AT EXPONENT
		3077	MOVX A,@R0 ;READ THE EXPONENT
		3078	JZ SQ_ERR ;ERROR IF EXPONENT IS ZERO
		3079	CJNE A,#81H,$+3 ;SEE IF NUM >= 1
		3080	MOV UBIT,C ;SAVE CARRY STATUS
		3081	JC $+4 ;TAKE RECIP IF >= 1
		3082	ACALL RECIP
		3083	;
		3084	; Loop to reduce
		3085	;
		3086	ALNL: ACALL CSTAKA ;COPY THE STACK FOR COMPARE
		3087	ACALL PUSH_ONE ;COMPARE NUM TO ONE
		3088	ACALL CMPLK
		3089	JNC ALNO ;EXIT IF DONE
		3090	ACALL SETREG ;GET THE EXPONENT
		3091	ADD A,#85H ;SEE HOW BIG IT IS
		3092	JNC ALN11 ;BUMP BY EXP(11) IF TOO SMALL
		3093	ACALL PLNEXP ;PUT EXP(1) ON STACK
		3094	MOV A,#1 ;BUMP COUNT
		3095	;
		3096	ALNE: ADD A,MT2
		3097	JC SQ_ERR
		3098	MOV MT2,A
		3099	ACALL AMUL ;BIAS THE NUMBER
		3100	SJMP ALNL
		3101	;
		3102	ALN11: MOV DPTR,#EXP11 ;PUT EXP(11) ON STACK
		3103	ACALL PUSHC
		3104	MOV A,#11
		3105	SJMP ALNE
		3106	;
		3107	newpage
		3108	ALNO: ACALL C_T2 ;PUT NUM IN TEMP 2
		3109	ACALL PUSH_ONE ;TOS = 1
		3110	ACALL ASUB ;TOS = X - 1
		3111	ACALL P_T2 ;TOS = X
		3112	ACALL PUSH_ONE ;TOS = 1
		3113	ACALL AADD ;TOS = X + 1
		3114	ACALL ADIV ;TOS = (X-1)/(X+1)
		3115	MOV DPTR,#LNTAB ;LOG TABLE
		3116	ACALL POLYC
		3117	INC DPTR ;POINT AT LN(10)
		3118	ACALL PUSHC
		3119	ACALL AMUL
		3120	MOV A,MT2 ;GET THE COUNT
		3121	ACALL TWO_R2 ;PUT IT ON THE STACK
		3122	ACALL ASUB ;INT - POLY
		3123	ACALL STRIP
		3124	JNB UBIT,AABS
		3125	;
		3126	LN_D: RET
		3127	;
		3128	;*************************************************************
		3129	;
		3130	TEMP_COMP: ; Compare FPTEMP1 to TOS, FPTEMP1 gets TOS
		3131	;
		3132	;*************************************************************
		3133	;
		3134	ACALL PUSH_T1 ;SAVE THE TEMP
		3135	ACALL SWAP_ASTKA ;TRADE WITH THE NEXT NUMBER
		3136	ACALL CSTAKA ;COPY THE STACK
		3137	ACALL POP_T1 ;SAVE THE NEW NUMBER
		3138	JMP FP_BASE+4 ;DO THE COMPARE
		3139	;
		3140	newpage
		3141	AETOX: ACALL PLNEXP ;EXP(1) ON TOS
		3142	ACALL SWAP_ASTKA ;X ON TOS
		3143	;
		3144	AEXP: ;EXPONENTIATION
		3145	;
		3146	ACALL EBIAS ;T1=BASE,T2=FRACTIONS,TOS=INT MULTIPLIED
		3147	MOV DPTR,#FPT2 ;POINT AT FRACTIONS
		3148	MOVX A,@DPTR ;READ THE EXP OF THE FRACTIONS
		3149	JZ LN_D ;EXIT IF ZERO
		3150	ACALL P_T2 ;TOS = FRACTIONS
		3151	ACALL PUSH_T1 ;TOS = BASE
		3152	ACALL SETREG ;SEE IF BASE IS ZERO
		3153	JZ $+4
		3154	ACALL ALN ;TOS = LN(BASE)
		3155	ACALL AMUL ;TOS = FRACTIONS * LN(BASE)
		3156	ACALL PLNEXP ;TOS = EXP(1)
		3157	ACALL SWAP_ASTKA ;TOS = FRACTIONS * LN(BASE)
		3158	ACALL EBIAS ;T2 = FRACTIONS, TOS = INT MULTIPLIED
		3159	MOV MT2,#00H ;NOW CALCULATE E**X
		3160	ACALL PUSH_ONE
		3161	ACALL CSTAKA
		3162	ACALL POP_T1 ;T1 = 1
		3163	;
		3164	AEXL: ACALL P_T2 ;TOS = FRACTIONS
		3165	ACALL AMUL ;TOS = FRACTIONS * ACCUMLATION
		3166	INC MT2 ;DO THE DEMONIATOR
		3167	MOV A,MT2
		3168	ACALL TWO_R2
		3169	ACALL ADIV
		3170	ACALL CSTAKA ;SAVE THE ITERATION
		3171	ACALL PUSH_T1 ;NOW ACCUMLATE
		3172	ACALL AADD ;ADD ACCUMLATION
		3173	ACALL TEMP_COMP
		3174	JNB F0,AEXL ;LOOP UNTIL DONE
		3175	;
		3176	ACALL INC_ASTKA
		3177	ACALL PUSH_T1
		3178	ACALL AMUL ;LAST INT MULTIPLIED
		3179	;
		3180	MU1: AJMP AMUL ;FIRST INT MULTIPLIED
		3181	;
		3182	newpage
		3183	;***************************************************************
		3184	;
		3185	; integer operator - INT
		3186	;
		3187	;***************************************************************
		3188	;
		3189	AINT: ACALL SETREG ;SET UP THE REGISTERS, CLEAR CARRY
		3190	SUBB A,#129 ;SUBTRACT EXPONENT BIAS
		3191	JNC AI1 ;JUMP IF ACC > 81H
		3192	;
		3193	; Force the number to be a zero
		3194	;
		3195	ACALL INC_ASTKA ;BUMP THE STACK
		3196	;
		3197	P_Z: MOV DPTR,#ZRO ;PUT ZERO ON THE STACK
		3198	AJMP PUSHC
		3199	;
		3200	AI1: SUBB A,#7
		3201	JNC AI3
		3202	CPL A
		3203	INC A
		3204	MOV R3,A
		3205	DEC R0 ;POINT AT SIGN
		3206	;
		3207	AI2: DEC R0 ;NOW AT LSB'S
		3208	MOVX A,@R0 ;READ BYTE
		3209	ANL A,#0F0H ;STRIP NIBBLE
		3210	MOVX @R0,A ;WRITE BYTE
		3211	DJNZ R3,$+3
		3212	RET
		3213	CLR A
		3214	MOVX @R0,A ;CLEAR THE LOCATION
		3215	DJNZ R3,AI2
		3216	;
		3217	AI3: RET ;EXIT
		3218	;
		3219	newpage
		3220	;***************************************************************
		3221	;
		3222	AABS: ; Absolute value - Make sign of number positive
		3223	; return sign in ACC
		3224	;
		3225	;***************************************************************
		3226	;
		3227	ACALL ANEG ;CHECK TO SEE IF + OR -
		3228	JNZ ALPAR ;EXIT IF NON ZERO, BECAUSE THE NUM IS
		3229	MOVX @R0,A ;MAKE A POSITIVE SIGN
		3230	RET
		3231	;
		3232	;***************************************************************
		3233	;
		3234	ASGN: ; Returns the sign of the number 1 = +, -1 = -
		3235	;
		3236	;***************************************************************
		3237	;
		3238	ACALL INC_ASTKA ;POP STACK, GET EXPONENT
		3239	JZ P_Z ;EXIT IF ZERO
		3240	DEC R0 ;BUMP TO SIGN
		3241	MOVX A,@R0 ;GET THE SIGN
		3242	MOV R7,A ;SAVE THE SIGN
		3243	ACALL PUSH_ONE ;PUT A ONE ON THE STACK
		3244	MOV A,R7 ;GET THE SIGN
		3245	JZ ALPAR ;EXIT IF ZERO
		3246	;
		3247	; Fall thru to ANEG
		3248	;
		3249	;***************************************************************
		3250	;
		3251	ANEG: ; Flip the sign of the number on the tos
		3252	;
		3253	;***************************************************************
		3254	;
		3255	ACALL SETREG
		3256	DEC R0 ;POINT AT THE SIGN OF THE NUMBER
		3257	JZ ALPAR ;EXIT IF ZERO
		3258	MOVX A,@R0
		3259	XRL A,#01H ;FLIP THE SIGN
		3260	MOVX @R0,A
		3261	XRL A,#01H ;RESTORE THE SIGN
		3262	;
		3263	ALPAR: RET
		3264	;
		3265	newpage
		3266	;***************************************************************
		3267	;
		3268	ACBYTE: ; Read the ROM
		3269	;
		3270	;***************************************************************
		3271	;
		3272	ACALL IFIX ;GET EXPRESSION
		3273	CALL X31DP ;PUT R3:R1 INTO THE DP
		3274	CLR A
		3275	MOVC A,@A+DPTR
		3276	AJMP TWO_R2
		3277	;
		3278	;***************************************************************
		3279	;
		3280	ADBYTE: ; Read internal memory
		3281	;
		3282	;***************************************************************
		3283	;
		3284	ACALL IFIX ;GET THE EXPRESSION
		3285	CALL R3CK ;MAKE SURE R3 = 0
		3286	MOV A,@R1
		3287	AJMP TWO_R2
		3288	;
		3289	;***************************************************************
		3290	;
		3291	AXBYTE: ; Read external memory
		3292	;
		3293	;***************************************************************
		3294	;
		3295	ACALL IFIX ;GET THE EXPRESSION
		3296	MOV P2,R3
		3297	MOVX A,@R1
		3298	AJMP TWO_R2
		3299	;
		3300	newpage
		3301	;***************************************************************
		3302	;
		3303	; The relational operators - EQUAL (=)
		3304	; GREATER THAN (>)
		3305	; LESS THAN (<)
		3306	; GREATER THAN OR EQUAL (>=)
		3307	; LESS THAN OR EQUAL (<=)
		3308	; NOT EQUAL (<>)
		3309	;
		3310	;***************************************************************
		3311	;
		3312	AGT: ACALL CMPLK
		3313	ORL C,F0 ;SEE IF EITHER IS A ONE
		3314	JC P_Z
		3315	;
		3316	FSTK: MOV DPTR,#FS
		3317	AJMP PUSHC
		3318	;
		3319	FS: DB 85H
		3320	DB 00H
		3321	DB 00H
		3322	DB 50H
		3323	DB 53H
		3324	DB 65H
		3325	;
		3326	ALT: ACALL CMPLK
		3327	CPL C
		3328	SJMP AGT+4
		3329	;
		3330	AEQ: ACALL CMPLK
		3331	MOV C,F0
		3332	SJMP ALT+2
		3333	;
		3334	ANE: ACALL CMPLK
		3335	CPL F0
		3336	SJMP AEQ+2
		3337	;
		3338	AGE: ACALL CMPLK
		3339	SJMP AGT+4
		3340	;
		3341	ALE: ACALL CMPLK
		3342	ORL C,F0
		3343	SJMP ALT+2
		3344	;
		3345	newpage
		3346	;***************************************************************
		3347	;
		3348	ARND: ; Generate a random number
		3349	;
		3350	;***************************************************************
		3351	;
		3352	MOV DPTR,#RCELL ;GET THE BINARY SEED
		3353	CALL L31DPI
		3354	MOV A,R1
		3355	CLR C
		3356	RRC A
		3357	MOV R0,A
		3358	MOV A,#6
		3359	RRC A
		3360	ADD A,R1
		3361	XCH A,R0
		3362	ADDC A,R3
		3363	MOV R2,A
		3364	DEC DPL ;SAVE THE NEW SEED
		3365	ACALL S20DP
		3366	ACALL TWO_EY
		3367	ACALL FSTK
		3368	;
		3369	ADIV: LCALL FP_BASE+8
		3370	AJMP FPTST
		3371	;
		3372	newpage
		3373	;***************************************************************
		3374	;
		3375	SONERR: ; ON ERROR Statement
		3376	;
		3377	;***************************************************************
		3378	;
		3379	LCALL INTERR ;GET THE LINE NUMBER
		3380	SETB ON_ERR
		3381	MOV DPTR,#ERRNUM ;POINT AT THR ERROR LOCATION
		3382	SJMP S20DP
		3383	;
		3384	;
		3385	;**************************************************************
		3386	;
		3387	SONEXT: ; ON EXT1 Statement
		3388	;
		3389	;**************************************************************
		3390	;
		3391	LCALL INTERR
		3392	SETB INTBIT
		3393	ORL IE,#10000100B ;ENABLE INTERRUPTS
		3394	MOV DPTR,#INTLOC
		3395	;
		3396	S20DP: MOV A,R2 ;SAVE R2:R0 @DPTR
		3397	MOVX @DPTR,A
		3398	INC DPTR
		3399	MOV A,R0
		3400	MOVX @DPTR,A
		3401	RET
		3402	;
		3403	newpage
		3404	;***************************************************************
		3405	;
		3406	; CASTAK - Copy and push another top of arg stack
		3407	;
		3408	;***************************************************************
		3409	;
		3410	CSTAKA2:ACALL CSTAKA ;COPY STACK TWICE
		3411	;
		3412	CSTAKA: ACALL SETREG ;SET UP R2:R0
		3413	SJMP PUSH_T1+4
		3414	;
		3415	PLNEXP: MOV DPTR,#EXP1
		3416	;
		3417	;***************************************************************
		3418	;
		3419	; PUSHC - Push constant on to the arg stack
		3420	;
		3421	;***************************************************************
		3422	;
		3423	PUSHC: ACALL DEC_ASTKA
		3424	MOV P2,R3
		3425	MOV R3,#FPSIZ ;LOOP COUNTER
		3426	;
		3427	PCL: CLR A ;SET UP A
		3428	MOVC A,@A+DPTR ;LOAD IT
		3429	MOVX @R1,A ;SAVE IT
		3430	INC DPTR ;BUMP POINTERS
		3431	DEC R1
		3432	DJNZ R3,PCL ;LOOP
		3433	;
		3434	SETB ARGF
		3435	RET ;EXIT
		3436	;
		3437	PUSH_ONE:;
		3438	;
		3439	MOV DPTR,#FPONE
		3440	AJMP PUSHC
		3441	;
		3442	newpage
		3443	;
		3444	POP_T1:
		3445	;
		3446	MOV R3,#HI(FPT1)
		3447	MOV R1,#LO(FPT1)
		3448	JMP POPAS
		3449	;
		3450	PUSH_T1:
		3451	;
		3452	MOV R0,#LO(FPT1)
		3453	MOV R2,#HI(FPT1)
		3454	LJMP PUSHAS
		3455	;
		3456	P_T2: MOV R0,#LO(FPT2)
		3457	SJMP $-7 ;JUMP TO PUSHAS
		3458	;
		3459	;****************************************************************
		3460	;
		3461	SWAP_ASTKA: ; SWAP TOS<>TOS-1
		3462	;
		3463	;****************************************************************
		3464	;
		3465	ACALL SETREG ;SET UP R2:R0 AND P2
		3466	MOV A,#FPSIZ ;PUT TOS+1 IN R1
		3467	MOV R2,A
		3468	ADD A,R0
		3469	MOV R1,A
		3470	;
		3471	S_L: MOVX A,@R0
		3472	MOV R3,A
		3473	MOVX A,@R1
		3474	MOVX @R0,A
		3475	MOV A,R3
		3476	MOVX @R1,A
		3477	DEC R1
		3478	DEC R0
		3479	DJNZ R2,S_L
		3480	RET
		3481	;
		3482	newpage
		3483	;
		3484	C_T2: ACALL SETREG ;SET UP R2:R0
		3485	MOV R3,#HI(FPT2)
		3486	MOV R1,#LO(FPT2) ;TEMP VALUE
		3487	;
		3488	; Fall thru
		3489	;
		3490	;***************************************************************
		3491	;
		3492	; VARCOP - Copy a variable from R2:R0 to R3:R1
		3493	;
		3494	;***************************************************************
		3495	;
		3496	VARCOP: MOV R4,#FPSIZ ;LOAD THE LOOP COUNTER
		3497	;
		3498	V_C: MOV P2,R2 ;SET UP THE PORTS
		3499	MOVX A,@R0 ;READ THE VALUE
		3500	MOV P2,R3 ;PORT TIME AGAIN
		3501	MOVX @R1,A ;SAVE IT
		3502	ACALL DEC3210 ;BUMP POINTERS
		3503	DJNZ R4,V_C ;LOOP
		3504	RET ;EXIT
		3505	;
		3506	PIPI: MOV DPTR,#PIE
		3507	AJMP PUSHC
		3508	;
		3509	newpage
		3510	;***************************************************************
		3511	;
		3512	; The logical operators ANL, ORL, XRL, NOT
		3513	;
		3514	;***************************************************************
		3515	;
		3516	AANL: ACALL TWOL ;GET THE EXPRESSIONS
		3517	MOV A,R3 ;DO THE AND
		3518	ANL A,R7
		3519	MOV R2,A
		3520	MOV A,R1
		3521	ANL A,R6
		3522	SJMP TWO_EX
		3523	;
		3524	AORL: ACALL TWOL ;SAME THING FOR OR
		3525	MOV A,R3
		3526	ORL A,R7
		3527	MOV R2,A
		3528	MOV A,R1
		3529	ORL A,R6
		3530	SJMP TWO_EX
		3531	;
		3532	ANOT: ACALL FSTK ;PUT 0FFFFH ON THE STACK
		3533	;
		3534	AXRL: ACALL TWOL
		3535	MOV A,R3
		3536	XRL A,R7
		3537	MOV R2,A
		3538	MOV A,R1
		3539	XRL A,R6
		3540	SJMP TWO_EX
		3541	;
		3542	TWOL: ACALL IFIX
		3543	MOV R7,R3B0
		3544	MOV R6,R1B0
		3545	AJMP IFIX
		3546	;
		3547	newpage
		3548	;*************************************************************
		3549	;
		3550	AGET: ; READ THE BREAK BYTE AND PUT IT ON THE ARG STACK
		3551	;
		3552	;*************************************************************
		3553	;
		3554	MOV DPTR,#GTB ;GET THE BREAK BYTE
		3555	MOVX A,@DPTR
		3556	JBC GTRD,TWO_R2
		3557	CLR A
		3558	;
		3559	TWO_R2: MOV R2,#00H ;ACC GOES TO STACK
		3560	;
		3561	;
		3562	TWO_EX: MOV R0,A ;R2:ACC GOES TO STACK
		3563	;
		3564	;
		3565	TWO_EY: SETB ARGF ;R2:R0 GETS PUT ON THE STACK
		3566	JMP FP_BASE+24 ;DO IT
		3567	;
		3568	newpage
		3569	;*************************************************************
		3570	;
		3571	; Put directs onto the stack
		3572	;
		3573	;**************************************************************
		3574	;
		3575	A_IE: MOV A,IE ;IE
		3576	SJMP TWO_R2
		3577	;
		3578	A_IP: MOV A,IP ;IP
		3579	SJMP TWO_R2
		3580	;
		3581	ATIM0: MOV R2,TH0 ;TIMER 0
		3582	MOV R0,TL0
		3583	SJMP TWO_EY
		3584	;
		3585	ATIM1: MOV R2,TH1 ;TIMER 1
		3586	MOV R0,TL1
		3587	SJMP TWO_EY
		3588	;
		3589	ATIM2: DB 0AAH ;MOV R2 DIRECT OP CODE
		3590	DB 0CDH ;T2 HIGH
		3591	DB 0A8H ;MOV R0 DIRECT OP CODE
		3592	DB 0CCH ;T2 LOW
		3593	SJMP TWO_EY ;TIMER 2
		3594	;
		3595	AT2CON: DB 0E5H ;MOV A,DIRECT OPCODE
		3596	DB 0C8H ;T2CON LOCATION
		3597	SJMP TWO_R2
		3598	;
		3599	ATCON: MOV A,TCON ;TCON
		3600	SJMP TWO_R2
		3601	;
		3602	ATMOD: MOV A,TMOD ;TMOD
		3603	SJMP TWO_R2
		3604	;
		3605	ARCAP2: DB 0AAH ;MOV R2, DIRECT OP CODE
		3606	DB 0CBH ;RCAP2H LOCATION
		3607	DB 0A8H ;MOV R0, DIRECT OP CODE
		3608	DB 0CAH ;R2CAPL LOCATION
		3609	SJMP TWO_EY
		3610	;
		3611	AP1: MOV A,P1 ;GET P1
		3612	SJMP TWO_R2 ;PUT IT ON THE STACK
		3613	;
		3614	APCON: DB 0E5H ;MOV A, DIRECT OP CODE
		3615	DB 87H ;ADDRESS OF PCON
		3616	SJMP TWO_R2 ;PUT PCON ON THE STACK
		3617	;
		3618	newpage
		3619	;***************************************************************
		3620	;
		3621	;THIS IS THE LINE EDITOR
		3622	;
		3623	;TAKE THE PROCESSED LINE IN IBUF AND INSERT IT INTO THE
		3624	;BASIC TEXT FILE.
		3625	;
		3626	;***************************************************************
		3627	;
		3628	LJMP NOGO ;CAN'T EDIT A ROM
		3629	;
		3630	LINE: MOV A,BOFAH
		3631	CJNE A,#HI(PSTART),LINE-3
		3632	CALL G4 ;GET END ADDRESS FOR EDITING
		3633	MOV R4,DPL
		3634	MOV R5,DPH
		3635	MOV R3,TEMP5 ;GET HIGH ORDER IBLN
		3636	MOV R1,TEMP4 ;LOW ORDER IBLN
		3637	;
		3638	CALL GETLIN ;FIND THE LINE
		3639	JNZ INSR ;INSERT IF NOT ZERO, ELSE APPEND
		3640	;
		3641	;APPEND THE LINE AT THE END
		3642	;
		3643	MOV A,TEMP3 ;PUT IBCNT IN THE ACC
		3644	CJNE A,#4H,$+4 ;SEE IF NO ENTRY
		3645	RET ;RET IF NO ENTRY
		3646	;
		3647	ACALL FULL ;SEE IF ENOUGH SPACE LEFT
		3648	MOV R2,R5B0 ;PUT END ADDRESS A INTO TRANSFER
		3649	MOV R0,R4B0 ;REGISTERS
		3650	ACALL IMOV ;DO THE BLOCK MOVE
		3651	;
		3652	UE: MOV A,#EOF ;SAVE EOF CHARACTER
		3653	AJMP TBR
		3654	;
		3655	;INSERT A LINE INTO THE FILE
		3656	;
		3657	INSR: MOV R7,A ;SAVE IT IN R7
		3658	CALL TEMPD ;SAVE INSERATION ADDRESS
		3659	MOV A,TEMP3 ;PUT THE COUNT LENGTH IN THE ACC
		3660	JC LTX ;JUMP IF NEW LINE # NOT = OLD LINE #
		3661	CJNE A,#04H,$+4 ;SEE IF NULL
		3662	CLR A
		3663	;
		3664	SUBB A,R7 ;SUBTRACT LINE COUNT FROM ACC
		3665	JZ LIN1 ;LINE LENGTHS EQUAL
		3666	JC GTX ;SMALLER LINE
		3667	;
		3668	newpage
		3669	;
		3670	;EXPAND FOR A NEW LINE OR A LARGER LINE
		3671	;
		3672	LTX: MOV R7,A ;SAVE A IN R7
		3673	MOV A,TEMP3 ;GET THE COUNT IN THE ACC
		3674	CJNE A,#04H,$+4 ;DO NO INSERTATION IF NULL LINE
		3675	RET ;EXIT IF IT IS
		3676	;
		3677	MOV A,R7 ;GET THE COUNT BACK - DELTA IN A
		3678	ACALL FULL ;SEE IF ENOUGH MEMORY NEW EOFA IN R3:R1
		3679	CALL DTEMP ;GET INSERATION ADDRESS
		3680	ACALL NMOV ;R7:R6 GETS (EOFA)-DPTR
		3681	CALL X3120
		3682	MOV R1,R4B0 ;EOFA LOW
		3683	MOV R3,R5B0 ;EOFA HIGH
		3684	INC R6 ;INCREMENT BYTE COUNT
		3685	CJNE R6,#00,$+4 ;NEED TO BUMP HIGH BYTE?
		3686	INC R7
		3687	;
		3688	ACALL RMOV ;GO DO THE INSERTION
		3689	SJMP LIN1 ;INSERT THE CURRENT LINE
		3690	;
		3691	GTX: CPL A ;FLIP ACC
		3692	INC A ;TWOS COMPLEMENT
		3693	CALL ADDPTR ;DO THE ADDITION
		3694	ACALL NMOV ;R7:R6 GETS (EOFA)-DPTR
		3695	MOV R1,DPL ;SET UP THE REGISTERS
		3696	MOV R3,DPH
		3697	MOV R2,TEMP5 ;PUT INSERTATION ADDRESS IN THE RIGHT REG
		3698	MOV R0,TEMP4
		3699	JZ $+4 ;IF ACC WAS ZERO FROM NMOV, JUMP
		3700	ACALL LMOV ;IF NO ZERO DO A LMOV
		3701	;
		3702	ACALL UE ;SAVE NEW END ADDRESS
		3703	;
		3704	LIN1: MOV R2,TEMP5 ;GET THE INSERTATION ADDRESS
		3705	MOV R0,TEMP4
		3706	MOV A,TEMP3 ;PUT THE COUNT LENGTH IN ACC
		3707	CJNE A,#04H,IMOV ;SEE IF NULL
		3708	RET ;EXIT IF NULL
		3709	newpage
		3710	;***************************************************************
		3711	;
		3712	;INSERT A LINE AT ADDRESS R2:R0
		3713	;
		3714	;***************************************************************
		3715	;
		3716	IMOV: CLR A ;TO SET UP
		3717	MOV R1,#LO(IBCNT) ;INITIALIZE THE REGISTERS
		3718	MOV R3,A
		3719	MOV R6,TEMP3 ;PUT THE BYTE COUNT IN R6 FOR LMOV
		3720	MOV R7,A ;PUT A 0 IN R7 FOR LMOV
		3721	;
		3722	;***************************************************************
		3723	;
		3724	;COPY A BLOCK FROM THE BEGINNING
		3725	;
		3726	;R2:R0 IS THE DESTINATION ADDRESS
		3727	;R3:R1 IS THE SOURCE ADDRESS
		3728	;R7:R6 IS THE COUNT REGISTER
		3729	;
		3730	;***************************************************************
		3731	;
		3732	LMOV: ACALL TBYTE ;TRANSFER THE BYTE
		3733	ACALL INC3210 ;BUMP THE POINTER
		3734	ACALL DEC76 ;BUMP R7:R6
		3735	JNZ LMOV ;LOOP
		3736	RET ;GO BACK TO CALLING ROUTINE
		3737	;
		3738	INC3210:INC R0
		3739	CJNE R0,#00H,$+4
		3740	INC R2
		3741	;
		3742	INC R1
		3743	CJNE R1,#00H,$+4
		3744	INC R3
		3745	RET
		3746	;
		3747	newpage
		3748	;***************************************************************
		3749	;
		3750	;COPY A BLOCK STARTING AT THE END
		3751	;
		3752	;R2:R0 IS THE DESTINATION ADDRESS
		3753	;R3:R1 IS THE SOURCE ADDRESS
		3754	;R6:R7 IS THE COUNT REGISTER
		3755	;
		3756	;***************************************************************
		3757	;
		3758	RMOV: ACALL TBYTE ;TRANSFER THE BYTE
		3759	ACALL DEC3210 ;DEC THE LOCATIONS
		3760	ACALL DEC76 ;BUMP THE COUNTER
		3761	JNZ RMOV ;LOOP
		3762	;
		3763	DEC_R: NOP ;CREATE EQUAL TIMING
		3764	RET ;EXIT
		3765	;
		3766	DEC3210:DEC R0 ;BUMP THE POINTER
		3767	CJNE R0,#0FFH,$+4 ;SEE IF OVERFLOWED
		3768	DEC R2 ;BUMP THE HIGH BYTE
		3769	DEC R1 ;BUMP THE POINTER
		3770	CJNE R1,#0FFH,DEC_R ;SEE IF OVERFLOWED
		3771	DEC R3 ;CHANGE THE HIGH BYTE
		3772	RET ;EXIT
		3773	;
		3774	;***************************************************************
		3775	;
		3776	;TBYTE - TRANSFER A BYTE
		3777	;
		3778	;***************************************************************
		3779	;
		3780	TBYTE: MOV P2,R3 ;OUTPUT SOURCE REGISTER TO PORT
		3781	MOVX A,@R1 ;PUT BYTE IN ACC
		3782	;
		3783	TBR: MOV P2,R2 ;OUTPUT DESTINATION TO PORT
		3784	MOVX @R0,A ;SAVE THE BYTE
		3785	RET ;EXIT
		3786	;
		3787	newpage
		3788	;***************************************************************
		3789	;
		3790	;NMOV - R7:R6 = END ADDRESS - DPTR
		3791	;
		3792	;ACC GETS CLOBBERED
		3793	;
		3794	;***************************************************************
		3795	;
		3796	NMOV: MOV A,R4 ;THE LOW BYTE OF EOFA
		3797	CLR C ;CLEAR THE CARRY FOR SUBB
		3798	SUBB A,DPL ;SUBTRACT DATA POINTER LOW
		3799	MOV R6,A ;PUT RESULT IN R6
		3800	MOV A,R5 ;HIGH BYTE OF EOFA
		3801	SUBB A,DPH ;SUBTRACT DATA POINTER HIGH
		3802	MOV R7,A ;PUT RESULT IN R7
		3803	ORL A,R6 ;SEE IF ZERO
		3804	RET ;EXIT
		3805	;
		3806	;***************************************************************
		3807	;
		3808	;CHECK FOR A FILE OVERFLOW
		3809	;LEAVES THE NEW END ADDRESS IN R3:R1
		3810	;A HAS THE INCREASE IN SIZE
		3811	;
		3812	;***************************************************************
		3813	;
		3814	FULL: ADD A,R4 ;ADD A TO END ADDRESS
		3815	MOV R1,A ;SAVE IT
		3816	CLR A
		3817	ADDC A,R5 ;ADD THE CARRY
		3818	MOV R3,A
		3819	MOV DPTR,#VARTOP ;POINT AT VARTOP
		3820	;
		3821	FUL1: CALL DCMPX ;COMPARE THE TWO
		3822	JC FULL-1 ;OUT OF ROOM
		3823	;
		3824	TB: MOV DPTR,#E5X ;OUT OF MEMORY
		3825	AJMP FPTS
		3826	;
		3827	newpage
		3828	;***************************************************************
		3829	;
		3830	; PP - Preprocesses the line in IBUF back into IBUF
		3831	; sets F0 if no line number
		3832	; leaves the correct length of processed line in IBCNT
		3833	; puts the line number in IBLN
		3834	; wastes the text address TXAL and TXAH
		3835	;
		3836	;***************************************************************
		3837	;
		3838	PP: ACALL T_BUF ;TXA GETS IBUF
		3839	CALL INTGER ;SEE IF A NUMBER PRESENT
		3840	CALL TEMPD ;SAVE THE INTEGER IN TEMP5:TEMP4
		3841	MOV F0,C ;SAVE INTEGER IF PRESENT
		3842	MOV DPTR,#IBLN ;SAVE THE LINE NUMBER, EVEN IF NONE
		3843	ACALL S20DP
		3844	MOV R0,TXAL ;TEXT POINTER
		3845	MOV R1,#LO(IBUF) ;STORE POINTER
		3846	;
		3847	; Now process the line back into IBUF
		3848	;
		3849	PPL: CLR ARGF ;FIRST PASS DESIGNATOR
		3850	MOV DPTR,#TOKTAB ;POINT DPTR AT LOOK UP TABLE
		3851	;
		3852	PPL1: MOV R5B0,R0 ;SAVE THE READ POINTER
		3853	CLR A ;ZERO A FOR LOOKUP
		3854	MOVC A,@A+DPTR ;GET THE TOKEN
		3855	MOV R7,A ;SAVE TOKEN IN CASE OF MATCH
		3856	;
		3857	PPL2: MOVX A,@R0 ;GET THE USER CHARACTER
		3858	MOV R3,A ;SAVE FOR REM
		3859	CJNE A,#'a',$+3
		3860	JC PPX ;CONVERT LOWER TO UPPER CASE
		3861	CJNE A,#('z'+1),$+3
		3862	JNC PPX
		3863	CLR ACC.5
		3864	;
		3865	PPX: MOV R2,A
		3866	MOVX @R0,A ;SAVE UPPER CASE
		3867	INC DPTR ;BUMP THE LOOKUP POINTER
		3868	CLR A
		3869	MOVC A,@A+DPTR
		3870	CJNE A,R2B0,PPL3 ;LEAVE IF NOT THE SAME
		3871	INC R0 ;BUMP THE USER POINTER
		3872	SJMP PPL2 ;CONTINUE TO LOOP
		3873	;
		3874	PPL3: JB ACC.7,PPL6 ;JUMP IF FOUND MATCH
		3875	JZ PPL6 ;USER MATCH
		3876	;
		3877	;
		3878	; Scan to the next TOKTAB entry
		3879	;
		3880	PPL4: INC DPTR ;ADVANCE THE POINTER
		3881	CLR A ;ZERO A FOR LOOKUP
		3882	MOVC A,@A+DPTR ;LOAD A WITH TABLE
		3883	JB ACC.7,$+6 ;KEEP SCANNING IF NOT A RESERVED WORD
		3884	JNZ PPL4
		3885	INC DPTR
		3886	;
		3887	; See if at the end of TOKTAB
		3888	;
		3889	MOV R0,R5B0 ;RESTORE THE POINTER
		3890	CJNE A,#0FFH,PPL1 ;SEE IF END OF TABLE
		3891	;
		3892	; Character not in TOKTAB, so see what it is
		3893	;
		3894	CJNE R2,#' ',PPLX ;SEE IF A SPACE
		3895	INC R0 ;BUMP USER POINTER
		3896	SJMP PPL ;TRY AGAIN
		3897	;
		3898	PPLX: JNB XBIT,PPLY ;EXTERNAL TRAP
		3899	JB ARGF,PPLY
		3900	SETB ARGF ;SAYS THAT THE USER HAS TABLE
		3901	LCALL 2078H ;SET UP POINTER
		3902	AJMP PPL1
		3903	;
		3904	PPLY: ACALL PPL7 ;SAVE CHARACTER, EXIT IF A CR
		3905	CJNE A,#'"',PPL ;SEE IF QUOTED STRING, START AGAIN IF NOT
		3906	;
		3907	; Just copy a quoted string
		3908	;
		3909	ACALL PPL7 ;SAVE THE CHARACTER, TEST FOR CR
		3910	CJNE A,#'"',$-2 ;IS THERE AN ENDQUOTE, IF NOT LOOP
		3911	SJMP PPL ;DO IT AGAIN IF ENDQUOTE
		3912	;
		3913	PPL6: MOV A,R7 ;GET THE TOKEN
		3914	ACALL PPL9+1 ;SAVE THE TOKEN
		3915	CJNE A,#T_REM,PPL ;SEE IF A REM TOKEN
		3916	MOV A,R3
		3917	ACALL PPL7+1 ;WASTE THE REM STATEMENT
		3918	ACALL PPL7 ;LOOP UNTIL A CR
		3919	SJMP $-2
		3920	;
		3921	PPL7: MOVX A,@R0 ;GET THE CHARACTER
		3922	CJNE A,#CR,PPL9 ;FINISH IF A CR
		3923	POP R0B0 ;WASTE THE CALLING STACK
		3924	POP R0B0
		3925	MOVX @R1,A ;SAVE CR IN MEMORY
		3926	INC R1 ;SAVE A TERMINATOR
		3927	MOV A,#EOF
		3928	MOVX @R1,A
		3929	MOV A,R1 ;SUBTRACT FOR LENGTH
		3930	SUBB A,#4
		3931	MOV TEMP3,A ;SAVE LENGTH
		3932	MOV R1,#LO(IBCNT) ;POINT AT BUFFER COUNT
		3933	;
		3934	PPL9: INC R0
		3935	MOVX @R1,A ;SAVE THE CHARACTER
		3936	INC R1 ;BUMP THE POINTERS
		3937	RET ;EXIT TO CALLING ROUTINE
		3938	;
		3939	;
		3940	;***************************************************************
		3941	;
		3942	;DEC76 - DECREMENT THE REGISTER PAIR R7:R6
		3943	;
		3944	;ACC = ZERO IF R7:R6 = ZERO ; ELSE ACC DOES NOT
		3945	;
		3946	;***************************************************************
		3947	;
		3948	DEC76: DEC R6 ;BUMP R6
		3949	CJNE R6,#0FFH,$+4 ;SEE IF RAPPED AROUND
		3950	DEC R7
		3951	MOV A,R7 ;SEE IF ZERO
		3952	ORL A,R6
		3953	RET ;EXIT
		3954	;
		3955	;***************************************************************
		3956	;
		3957	; MTOP - Get or Put the top of assigned memory
		3958	;
		3959	;***************************************************************
		3960	;
		3961	PMTOP: MOV DPTR,#MEMTOP
		3962	CALL L20DPI
		3963	AJMP TWO_EY ;PUT R2:R0 ON THE STACK
		3964	;
		3965	newpage
		3966	;*************************************************************
		3967	;
		3968	; AXTAL - Crystal value calculations
		3969	;
		3970	;*************************************************************
		3971	;
		3972	AXTAL0: MOV DPTR,#XTALV ;CRYSTAL VALUE
		3973	ACALL PUSHC
		3974	;
		3975	AXTAL1: ACALL CSTAKA2 ;COPY CRYSTAL VALUE TWICE
		3976	ACALL CSTAKA
		3977	MOV DPTR,#PTIME ;PROM TIMER
		3978	ACALL AXTAL2
		3979	MOV DPTR,#PROGS
		3980	ACALL S31L
		3981	MOV DPTR,#IPTIME ;IPROM TIMER
		3982	ACALL AXTAL2
		3983	MOV DPTR,#IPROGS
		3984	ACALL S31L
		3985	MOV DPTR,#TTIME ;CLOCK CALCULATION
		3986	ACALL AXTAL3
		3987	MOV A,R1
		3988	CPL A
		3989	INC A
		3990	MOV SAVE_T,A
		3991	MOV R3,#HI(CXTAL)
		3992	MOV R1,#LO(CXTAL)
		3993	JMP POPAS
		3994	;
		3995	AXTAL2: ACALL AXTAL3
		3996	;
		3997	CBIAS: ;Bias the crystal calculations
		3998	;
		3999	MOV A,R1 ;GET THE LOW COUNT
		4000	CPL A ;FLIP IT FOR TIMER LOAD
		4001	ADD A,#15 ;BIAS FOR CALL AND LOAD TIMES
		4002	MOV R1,A ;RESTORE IT
		4003	MOV A,R3 ;GET THE HIGH COUNT
		4004	CPL A ;FLIP IT
		4005	ADDC A,#00H ;ADD THE CARRY
		4006	MOV R3,A ;RESTORE IT
		4007	RET
		4008	;
		4009	newpage
		4010	include bas52.pwm ; ******AA
		4011	newpage
		4012	;LNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLN
		4013	;
		4014	LNTAB: ; Natural log lookup table
		4015	;
		4016	;LNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLNLN
		4017	;
		4018	DB 80H
		4019	DB 00H
		4020	DB 71H
		4021	DB 37H
		4022	DB 13H
		4023	DB 19H
		4024	;
		4025	DB 7FH
		4026	DB 00H
		4027	DB 76H
		4028	DB 64H
		4029	DB 37H
		4030	DB 94H
		4031	;
		4032	DB 80H
		4033	DB 00H
		4034	DB 07H
		4035	DB 22H
		4036	DB 75H
		4037	DB 17H
		4038	;
		4039	DB 80H
		4040	DB 00H
		4041	DB 52H
		4042	DB 35H
		4043	DB 93H
		4044	DB 28H
		4045	;
		4046	DB 80H
		4047	DB 00H
		4048	DB 71H
		4049	DB 91H
		4050	DB 85H
		4051	DB 86H
		4052	;
		4053	DB 0FFH
		4054	;
		4055	DB 81H
		4056	DB 00H
		4057	DB 51H
		4058	DB 58H
		4059	DB 02H
		4060	DB 23H
		4061	;
		4062	newpage
		4063	;SINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSIN
		4064	;
		4065	SINTAB: ; Sin lookup table
		4066	;
		4067	;SINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSINSIN
		4068	;
		4069	DB 128-9
		4070	DB 00H
		4071	DB 44H
		4072	DB 90H
		4073	DB 05H
		4074	DB 16H
		4075	;
		4076	DB 128-7
		4077	DB 01H
		4078	DB 08H
		4079	DB 21H
		4080	DB 05H
		4081	DB 25H
		4082	;
		4083	DB 128-5
		4084	DB 00H
		4085	DB 19H
		4086	DB 73H
		4087	DB 55H
		4088	DB 27H
		4089	;
		4090	newpage
		4091	;
		4092	DB 128-3
		4093	DB 01H
		4094	DB 70H
		4095	DB 12H
		4096	DB 84H
		4097	DB 19H
		4098	;
		4099	DB 128-2
		4100	DB 00H
		4101	DB 33H
		4102	DB 33H
		4103	DB 33H
		4104	DB 83H
		4105	;
		4106	DB 128
		4107	DB 01H
		4108	DB 67H
		4109	DB 66H
		4110	DB 66H
		4111	DB 16H
		4112	;
		4113	FPONE: DB 128+1
		4114	DB 00H
		4115	DB 00H
		4116	DB 00H
		4117	DB 00H
		4118	DB 10H
		4119	;
		4120	DB 0FFH ;END OF TABLE
		4121	;
		4122	newpage
		4123	;
		4124	SBAUD: CALL AXTAL ;PUT CRYSTAL ON THE STACK
		4125	CALL EXPRB ;PUT THE NUMBER AFTER BAUD ON STACK
		4126	MOV A,#12
		4127	ACALL TWO_R2 ;TOS = 12
		4128	ACALL AMUL ;TOS = 12*BAUD
		4129	ACALL ADIV ;TOS = XTAL/(12*BAUD)
		4130	ACALL IFIX
		4131	ACALL CBIAS
		4132	MOV DPTR,#SPV
		4133	;
		4134	S31L: JMP S31DP
		4135	;
		4136	AFREE: CALL PMTOP ;PUT MTOP ON STACK
		4137	CALL G4 ;GET END ADDRESS
		4138	MOV R0,DPL
		4139	MOV R2,DPH
		4140	ACALL TWO_EY
		4141	;
		4142	ASUB: LCALL FP_BASE+2 ;DO FP SUB
		4143	AJMP FPTST
		4144	;
		4145	ALEN: CALL CCAL ;CALCULATE THE LEN OF THE SELECTED PROGRAM
		4146	MOV R2,R7B0 ;SAVE THE HIGH BYTE
		4147	MOV A,R6 ;SAVE THE LOW BYTE
		4148	AJMP TWO_EX ;PUT IT ON THE STACK
		4149	;
		4150	ATIME: MOV C,EA ;SAVE INTERRUTS
		4151	CLR EA
		4152	PUSH MILLIV ;SAVE MILLI VALUE
		4153	MOV R2,TVH ;GET THE TIMER
		4154	MOV A,TVL
		4155	MOV EA,C ;SAVE INTERRUPTS
		4156	ACALL TWO_EX ;PUT TIMER ON THE STACK
		4157	POP ACC ;GET MILLI
		4158	ACALL TWO_R2 ;PUT MILLI ON STACK
		4159	MOV A,#200
		4160	ACALL TWO_R2 ;DIVIDE MILLI BY 200
		4161	ACALL ADIV
		4162	;
		4163	AADD: LCALL FP_BASE ;DO FP ADDITION
		4164	AJMP FPTST ;CHECK FOR ERRORS
		4165	;
		4166	newpage
		4167	;**************************************************************
		4168	;
		4169	; Here are some error messages that were moved
		4170	;
		4171	;**************************************************************
		4172	;
		4173	;
		4174	E1X: DB "BAD SYNTAX",'"'
		4175	E2X: DB 128+10
		4176	DB "DIVIDE BY ZERO",'"'
		4177	;
		4178	E6X: DB "ARRAY SIZE",'"'
		4179	;
		4180	newpage
		4181	;**************************************************************
		4182	;
		4183	T_BUF: ; TXA gets IBUF
		4184	;
		4185	;**************************************************************
		4186	;
		4187	MOV TXAH,#HI(IBUF)
		4188	MOV TXAL,#LO(IBUF)
		4189	RET
		4190	;
		4191	;
		4192	;***************************************************************
		4193	;
		4194	CXFER: ; Transfer a program from rom to ram
		4195	;
		4196	;***************************************************************
		4197	;
		4198	CALL CCAL ;GET EVERYTHING SET UP
		4199	MOV R2,#HI(PSTART)
		4200	MOV R0,#LO(PSTART)
		4201	ACALL LMOV ;DO THE TRANSFER
		4202	CALL RCLEAR ;CLEAR THE MEMORY
		4203	;
		4204	; Fall thru to CRAM
		4205	;
		4206	;***************************************************************
		4207	;
		4208	CRAM: ; The command action routine - RAM - Run out of ram
		4209	;
		4210	;***************************************************************
		4211	;
		4212	CLR CONB ;CAN'T CONTINUE IF MODE CHANGE
		4213	MOV BOFAH,#HI(PSTART)
		4214	MOV BOFAL,#LO(PSTART)
		4215	;
		4216	; Fall thru to Command Processor
		4217	;
		4218	newpage
		4219	;***************************************************************
		4220	;
		4221	CMND1: ; The entry point for the command processor
		4222	;
		4223	;***************************************************************
		4224	;
		4225	LCALL SPRINT+4 ;WASTE AT AND HEX
		4226	CLR XBIT ;TO RESET IF NEEDED
		4227	CLR A
		4228	MOV DPTR,#2002H ;CHECK FOR EXTERNAL TRAP PACKAGE
		4229	MOVC A,@A+DPTR
		4230	CJNE A,#5AH,$+6
		4231	LCALL 2048H ;IF PRESENT JUMP TO LOCATION 200BH
		4232	MOV DPTR,#RDYS ;PRINT THE READY MESSAGE
		4233	CALL CRP ;DO A CR, THEN, PRINT FROM THE ROM
		4234	;
		4235	CMNDR: SETB DIRF ;SET THE DIRECT INPUT BIT
		4236	MOV SP,SPSAV ;LOAD THE STACK
		4237	ACALL CL7 ;DO A CRLF
		4238	;
		4239	CMNX: CLR GTRD ;CLEAR BREAK
		4240	MOV DPTR,#5EH ;DO RUN TRAP
		4241	MOVX A,@DPTR
		4242	XRL A,#52
		4243	JNZ $+5
		4244	LJMP CRUN
		4245	MOV R5,#'>' ;OUTPUT A PROMPT
		4246	LCALL TEROT
		4247	CALL INLINE ;INPUT A LINE INTO IBUF
		4248	CALL PP ;PRE-PROCESS THE LINE
		4249	JB F0,CMND3 ;NO LINE NUMBER
		4250	CALL LINE ;PROCESS THE LINE
		4251	LCALL LCLR
		4252	JB LINEB,CMNX ;DON'T CLEAR MEMORY IF NO NEED
		4253	SETB LINEB
		4254	LCALL RCLEAR ;CLEAR THE MEMORY
		4255	SJMP CMNX ;LOOP BACK
		4256	;
		4257	CMND3: CALL T_BUF ;SET UP THE TEXT POINTER
		4258	CALL DELTST ;GET THE CHARACTER
		4259	JZ CMNDR ;IF CR, EXIT
		4260	MOV DPTR,#CMNDD ;POINT AT THE COMMAND LOOKUP
		4261	CJNE A,#T_CMND,$+3 ;PROCESS STATEMENT IF NOT A COMMAND
		4262	JC CMND5
		4263	CALL GCI1 ;BUMP TXA
		4264	ANL A,#0FH ;STRIP MSB'S FOR LOOKUP
		4265	LCALL ISTA1 ;PROCESS COMMAND
		4266	SJMP CMNDR
		4267	;
		4268	CMND5: LJMP ILOOP ;CHECK FOR A POSSIBLE BREAK
		4269	;
		4270	;
		4271	;
		4272	;CONSTANTS
		4273	;
		4274	XTALV: DB 128+8 ; DEFAULT CRYSTAL VALUE
		4275	DB 00H
		4276	DB 00H
		4277	DB 92H
		4278	DB 05H
		4279	DB 11H
		4280	;
		4281	EXP11: DB 85H
		4282	DB 00H
		4283	DB 42H
		4284	DB 41H
		4285	DB 87H
		4286	DB 59H
		4287	;
		4288	EXP1: DB 128+1 ; EXP(1)
		4289	DB 00H
		4290	DB 18H
		4291	DB 28H
		4292	DB 18H
		4293	DB 27H
		4294	;
		4295	IPTIME: DB 128-4 ;FPROG TIMING
		4296	DB 00H
		4297	DB 00H
		4298	DB 00H
		4299	DB 75H
		4300	DB 83H
		4301	;
		4302	PIE: DB 128+1 ;PI
		4303	DB 00H
		4304	DB 26H
		4305	DB 59H
		4306	DB 41H
		4307	DB 31H ; 3.1415926
		4308	;
		4309	newpage
		4310	;***************************************************************
		4311	;
		4312	; The error messages, some have been moved
		4313	;
		4314	;***************************************************************
		4315	;
		4316	E7X: DB 128+30
		4317	DB "ARITH. UNDERFLOW",'"'
		4318	;
		4319	E5X: DB "MEMORY ALLOCATION",'"'
		4320	;
		4321	E3X: DB 128+40
		4322	DB "BAD ARGUMENT",'"'
		4323	;
		4324	EXI: DB "I-STACK",'"'
		4325	;
		4326	newpage
		4327	;***************************************************************
		4328	;
		4329	; The command action routine - CONTINUE
		4330	;
		4331	;***************************************************************
		4332	;
		4333	CCONT: MOV DPTR,#E15X
		4334	JNB CONB,ERROR ;ERROR IF CONTINUE IS NOT SET
		4335	;
		4336	CC1: ;used for input statement entry
		4337	;
		4338	MOV TXAH,INTXAH ;RESTORE TXA
		4339	MOV TXAL,INTXAL
		4340	JMP CILOOP ;EXECUTE
		4341	;
		4342	DTEMP: MOV DPH,TEMP5 ;RESTORE DPTR
		4343	MOV DPL,TEMP4
		4344	RET
		4345	;
		4346	TEMPD: MOV TEMP5,DPH
		4347	MOV TEMP4,DPL
		4348	RET
		4349	;
		4350	newpage
		4351	;**************************************************************
		4352	;
		4353	I_DL: ; IDLE
		4354	;
		4355	;**************************************************************
		4356	;
		4357	JB DIRF,E1XX ;SYNTAX ERROR IN DIRECT INPUT
		4358	CLR DACK ;ACK IDLE
		4359	;
		4360	U_ID1: DB 01000011B ;ORL DIRECT OP CODE
		4361	DB 87H ;PCON ADDRESS
		4362	DB 01H ;SET IDLE BIT
		4363	JB INTPEN,I_RET ;EXIT IF EXTERNAL INTERRUPT
		4364	JBC U_IDL,I_RET ;EXIT IF USER WANTS TO
		4365	JNB OTS,U_ID1 ;LOOP IF TIMER NOT ENABLED
		4366	LCALL T_CMP ;CHECK THE TIMER
		4367	JC U_ID1 ;LOOP IF TIME NOT BIG ENOUGH
		4368	;
		4369	I_RET: SETB DACK ;RESTORE EXECUTION
		4370	RET ;EXIT IF IT IS
		4371	;
		4372	;
		4373	;
		4374	ER0: INC DPTR ;BUMP TO TEXT
		4375	JB DIRF,ERROR0 ;CAN'T GET OUT OF DIRECT MODE
		4376	JNB ON_ERR,ERROR0 ;IF ON ERROR ISN'T SET, GO BACK
		4377	MOV DPTR,#ERRLOC ;SAVE THE ERROR CODE
		4378	CALL RC2 ;SAVE ERROR AND SET UP THE STACKS
		4379	INC DPTR ;POINT AT ERRNUM
		4380	JMP ERL4 ;LOAD ERR NUM AND EXIT
		4381	;
		4382	newpage
		4383	;
		4384	; Syntax error
		4385	;
		4386	E1XX: MOV C,DIRF ;SEE IF IN DIRECT MODE
		4387	MOV DPTR,#E1X ;ERROR MESSAGE
		4388	SJMP ERROR+1 ;TRAP ON SET DIRF
		4389	;
		4390	MOV DPTR,#EXI ;STACK ERROR
		4391	;
		4392	; Falls through
		4393	;
		4394	;***************************************************************
		4395	;
		4396	;ERROR PROCESSOR - PRINT OUT THE ERROR TYPE, CHECK TO SEE IF IN
		4397	; RUN OR COMMAND MODE, FIND AND PRINT OUT THE
		4398	; LINE NUMBER IF IN RUN MODE
		4399	;
		4400	;***************************************************************
		4401	;
		4402	ERROR: CLR C ;RESET STACK
		4403	MOV SP,SPSAV ;RESET THE STACK
		4404	LCALL SPRINT+4 ;CLEAR LINE AND AT MODE
		4405	CLR A ;SET UP TO GET ERROR CODE
		4406	MOVC A,@A+DPTR
		4407	JBC ACC.7,ER0 ;PROCESS ERROR
		4408	;
		4409	ERROR0: ACALL TEMPD ;SAVE THE DATA POINTER
		4410	JC $+5 ;NO RESET IF CARRY IS SET
		4411	LCALL RC1 ;RESET THE STACKS
		4412	CALL CRLF2 ;DO TWO CARRIAGE RET - LINE FEED
		4413	MOV DPTR,#ERS ;OUTPUT ERROR MESSAGE
		4414	CALL ROM_P
		4415	CALL DTEMP ;GET THE ERROR MESSAGE BACK
		4416	;
		4417	ERRS: CALL ROM_P ;PRINT ERROR TYPE
		4418	JNB DIRF,ER1 ;DO NOT PRINT IN LINE IF DIRF=1
		4419	;
		4420	SERR1: CLR STOPBIT ;PRINT STOP THEN EXIT, FOR LIST
		4421	JMP CMND1
		4422	;
		4423	ER1: MOV DPTR,#INS ;OUTPUT IN LINE
		4424	CALL ROM_P
		4425	;
		4426	;NOW, FIND THE LINE NUMBER
		4427	;
		4428	;
		4429	newpage
		4430	;
		4431	;
		4432	CALL DP_B ;GET THE FIRST ADDRESS OF THE PROGRAM
		4433	CLR A ;FOR INITIALIZATION
		4434	;
		4435	ER2: ACALL TEMPD ;SAVE THE DPTR
		4436	CALL ADDPTR ;ADD ACC TO DPTR
		4437	ACALL ER4 ;R3:R1 = TXA-DPTR
		4438	JC ER3 ;EXIT IF DPTR>TXA
		4439	JZ ER3 ;EXIT IF DPTR=TXA
		4440	MOVX A,@DPTR ;GET LENGTH
		4441	CJNE A,#EOF,ER2 ;SEE IF AT THE END
		4442	;
		4443	ER3: ACALL DTEMP ;PUT THE LINE IN THE DPTR
		4444	ACALL ER4 ;R3:R1 = TXA - BEGINNING OF LINE
		4445	MOV A,R1 ;GET LENGTH
		4446	ADD A,#10 ;ADD 10 TO LENGTH, DPTR STILL HAS ADR
		4447	MOV MT1,A ;SAVE THE COUNT
		4448	INC DPTR ;POINT AT LINE NUMBER HIGH BYTE
		4449	CALL PMTOP+3 ;LOAD R2:R0, PUT IT ON THE STACK
		4450	ACALL FP_BASE+14 ;OUTPUT IT
		4451	JB STOPBIT,SERR1 ;EXIT IF STOP BIT SET
		4452	CALL CRLF2 ;DO SOME CRLF'S
		4453	CALL DTEMP
		4454	CALL UPPL ;UNPROCESS THE LINE
		4455	CALL CL6 ;PRINT IT
		4456	MOV R5,#'-' ;OUTPUT DASHES, THEN AN X
		4457	ACALL T_L ;PRINT AN X IF ERROR CHARACTER FOUND
		4458	DJNZ MT1,$-4 ;LOOP UNTIL DONE
		4459	MOV R5,#'X'
		4460	ACALL T_L
		4461	AJMP SERR1
		4462	;
		4463	ER4: MOV R3,TXAH ;GET TEXT POINTER AND PERFORM SUBTRACTION
		4464	MOV R1,TXAL
		4465	JMP DUBSUB
		4466	;
		4467	newpage
		4468	;**************************************************************
		4469	;
		4470	; Interrupt driven timer
		4471	;
		4472	;**************************************************************
		4473	;
		4474	I_DR: MOV TH0,SAVE_T ;LOAD THE TIMER
		4475	XCH A,MILLIV ;SAVE A, GET MILLI COUNTER
		4476	INC A ;BUMP COUNTER
		4477	CJNE A,#200,TR ;CHECK OUT TIMER VALUE
		4478	CLR A ;FORCE ACC TO BE ZERO
		4479	INC TVL ;INCREMENT LOW TIMER
		4480	CJNE A,TVL,TR ;CHECK LOW VALUE
		4481	INC TVH ;BUMP TIMER HIGH
		4482	;
		4483	TR: XCH A,MILLIV
		4484	POP PSW
		4485	RETI
		4486	;
		4487	newpage
		4488	include bas52.clk
		4489	;***************************************************************
		4490	;
		4491	SUI: ; Statement USER IN action routine
		4492	;
		4493	;***************************************************************
		4494	;
		4495	ACALL OTST
		4496	MOV CIUB,C ;SET OR CLEAR CIUB
		4497	RET
		4498	;
		4499	;***************************************************************
		4500	;
		4501	SUO: ; Statement USER OUT action routine
		4502	;
		4503	;***************************************************************
		4504	;
		4505	ACALL OTST
		4506	MOV COUB,C
		4507	RET
		4508	;
		4509	OTST: ; Check for a one
		4510	;
		4511	LCALL GCI ;GET THE CHARACTER, CLEARS CARRY
		4512	SUBB A,#'1' ;SEE IF A ONE
		4513	CPL C ;SETS CARRY IF ONE, CLEARS IT IF ZERO
		4514	RET
		4515	;
		4516	newpage
		4517	;**************************************************************
		4518	;
		4519	; IBLK - EXECUTE USER SUPPLIED TOKEN
		4520	;
		4521	;**************************************************************
		4522	;
		4523	IBLK: JB PSW.4,IBLK-1 ;EXIT IF REGISTER BANK <> 0
		4524	JB PSW.3,IBLK-1
		4525	JBC ACC.7,$+9 ;SEE IF BIT SEVEN IS SET
		4526	MOV DPTR,#USENT ;USER ENTRY LOCATION
		4527	LJMP ISTA1
		4528	;
		4529	JB ACC.0,199FH ;FLOATING POINT INPUT
		4530	JZ T_L ;DO OUTPUT ON 80H
		4531	MOV DPTR,#FP_BASE-2
		4532	JMP @A+DPTR
		4533	;
		4534	;
		4535	;**************************************************************
		4536	;
		4537	; GET_NUM - GET A NUMBER, EITHER HEX OR FLOAT
		4538	;
		4539	;**************************************************************
		4540	;
		4541	GET_NUM:ACALL FP_BASE+10 ;SCAN FOR HEX
		4542	JNC FP_BASE+12 ;DO FP INPUT
		4543	;
		4544	ACALL FP_BASE+18 ;ASCII STRING TO R2:R0
		4545	JNZ H_RET
		4546	PUSH DPH ;SAVE THE DATA_POINTER
		4547	PUSH DPL
		4548	ACALL FP_BASE+24 ;PUT R2:R0 ON THE STACK
		4549	POP DPL ;RESTORE THE DATA_POINTER
		4550	POP DPH
		4551	CLR A ;NO ERRORS
		4552	RET ;EXIT
		4553	;
		4554	newpage
		4555	;**************************************************************
		4556	;
		4557	; WB - THE EGO MESSAGE
		4558	;
		4559	;**************************************************************
		4560	;
		4561	WB: DB 'W'+80H,'R'+80H
		4562	DB 'I'+80H,'T'+80H,'T','E'+80H,'N'+80H
		4563	DB ' ','B'+80H,'Y'+80H,' '
		4564	DB 'J'+80H,'O'+80H,'H'+80H,'N'+80H,' '+80H
		4565	DB 'K','A'+80H,'T'+80H,'A'+80H,'U'+80H
		4566	DB 'S','K'+80H,'Y'+80H
		4567	DB ", I",'N'+80H,'T'+80H,'E'+80H,'L'+80H
		4568	DB ' '+80H,'C'+80H,'O'+80H,'R'+80H,'P'+80H
		4569	DB ". 1",'9'+80H,"85"
		4570	H_RET: RET
		4571	;
		4572	newpage
		4573	ORG 1990H
		4574	;
		4575	T_L: LJMP TEROT
		4576	;
		4577	ORG 1F78H
		4578	;
		4579	CKS_I: JB CKS_B,CS_I
		4580	LJMP 401BH
		4581	;
		4582	CS_I: LJMP 2088H
		4583	;
		4584	E14X: DB "NO DATA",'"'
		4585	;
		4586	E11X: DB 128+20
		4587	DB "ARITH. OVERFLOW",'"'
		4588	;
		4589	E16X: DB "PROGRAMMING",'"'
		4590	;
		4591	E15X: DB "CAN"
		4592	DB 27H
		4593	DB "T CONTINUE",'"'
		4594	;
		4595	E10X: DB "INVALID LINE NUMBER",'"'
		4596	;
		4597	NOROM: DB "PROM MODE",'"'
		4598	;
		4599	S_N: DB "MCS-51(tm) BASIC V1.1",'"'
		4600	;
		4601	ORG 1FF8H
		4602	;
		4603	ERS: DB "ERROR: ",'"'
		4604	;
		4605	newpage
		4606	;***************************************************************
		4607	;
		4608	segment xdata ;External Ram
		4609	;
		4610	;***************************************************************
		4611	;
		4612	DS 4
		4613	IBCNT: DS 1 ;LENGTH OF A LINE
		4614	IBLN: DS 2 ;THE LINE NUMBER
		4615	IBUF: DS LINLEN ;THE INPUT BUFFER
		4616	CONVT: DS 15 ;CONVERSION LOCATION FOR FPIN
		4617	;
		4618	ORG 100H
		4619	;
		4620	GTB: DS 1 ;GET LOCATION
		4621	ERRLOC: DS 1 ;ERROR TYPE
		4622	ERRNUM: DS 2 ;WHERE TO GO ON AN ERROR
		4623	VARTOP: DS 2 ;TOP OF VARIABLE STORAGE
		4624	ST_ALL: DS 2 ;STORAGE ALLOCATION
		4625	MT_ALL: DS 2 ;MATRIX ALLOCATION
		4626	MEMTOP: DS 2 ;TOP OF MEMORY
		4627	RCELL: DS 2 ;RANDOM NUMBER CELL
		4628	DS FPSIZ-1
		4629	CXTAL: DS 1 ;CRYSTAL
		4630	DS FPSIZ-1
		4631	FPT1: DS 1 ;FLOATINP POINT TEMP 1
		4632	DS FPSIZ-1
		4633	FPT2: DS 1 ;FLOATING POINT TEMP 2
		4634	INTLOC: DS 2 ;LOCATION TO GO TO ON INTERRUPT
		4635	STR_AL: DS 2 ;STRING ALLOCATION
		4636	SPV: DS 2 ;SERIAL PORT BAUD RATE
		4637	TIV: DS 2 ;TIMER INTERRUPT NUM AND LOC
		4638	PROGS: DS 2 ;PROGRAM A PROM TIME OUT
		4639	IPROGS: DS 2 ;INTELLIGENT PROM PROGRAMMER TIMEOUT
		4640	TM_TOP: DS 1
		4641
		4642	include bas52.fp
		4643
		4644	END

Subversion Repositories pentevo

(root)/tools/asl/asl-current/tests/t_bas52/t_bas52.asm – Rev 1186