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