;  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
        ;
;************************************************************

;

; This is a complete BCD floating point package for the 8051 micro-

; controller. It provides 8 digits of accuracy with exponents that

; range from +127 to -127. The mantissa is in packed BCD, while the

; exponent is expressed in pseudo-twos complement. A ZERO exponent

; is used to express the number ZERO. An exponent value of 80H or

; greater than means the exponent is positive, i.e. 80H = E 0,

; 81H = E+1, 82H = E+2 and so on. If the exponent is 7FH or less,

; the exponent is negative, 7FH = E-1, 7EH = E-2, and so on.

; ALL NUMBERS ARE ASSUMED TO BE NORMALIZED and all results are

; normalized after calculation. A normalized mantissa is >=.10 and

; <=.99999999.

;

; The numbers in memory assumed to be stored as follows:

;

; EXPONENT OF ARGUMENT 2   =   VALUE OF ARG_STACK+FP_NUMBER_SIZE

; SIGN OF ARGUMENT 2       =   VALUE OF ARG_STACK+FP_NUMBER_SIZE-1

; DIGIT 78 OF ARGUMENT 2   =   VALUE OF ARG_STACK+FP_NUMBER_SIZE-2

; DIGIT 56 OF ARGUMENT 2   =   VALUE OF ARG_STACK+FP_NUMBER_SIZE-3

; DIGIT 34 OF ARGUMENT 2   =   VALUE OF ARG_STACK+FP_NUMBER_SIZE-4

; DIGIT 12 OF ARGUMENT 2   =   VALUE OF ARG_STACK+FP_NUMBER_SIZE-5

;

; EXPONENT OF ARGUMENT 1   =   VALUE OF ARG_STACK

; SIGN OF ARGUMENT 1       =   VALUE OF ARG_STACK-1

; DIGIT 78 OF ARGUMENT 1   =   VALUE OF ARG_STACK-2

; DIGIT 56 OF ARGUMENT 1   =   VALUE OF ARG_STACK-3

; DIGIT 34 OF ARGUMENT 1   =   VALUE OF ARG_STACK-4

; DIGIT 12 OF ARGUMENT 1   =   VALUE OF ARG_STACK-5

;

; The operations are performed thusly:

;

; ARG_STACK+FP_NUMBER_SIZE = ARG_STACK+FP_NUMBER_SIZE # ARG_STACK

;

; Which is ARGUMENT 2 = ARGUMENT 2 # ARGUMENT 1

;

; Where # can be ADD, SUBTRACT, MULTIPLY OR DIVIDE.

;

; Note that the stack gets popped after an operation.

;

; The FP_COMP instruction POPS the ARG_STACK TWICE and returns status.

;

;**********************************************************************

;

$EJECT

;**********************************************************************

;

; STATUS ON RETURN - After performing an operation (+, -, *, /)

;                    the accumulator contains the following status

;

; ACCUMULATOR - BIT 0 - FLOATING POINT UNDERFLOW OCCURED

;

;             - BIT 1 - FLOATING POINT OVERFLOW OCCURED

;

;             - BIT 2 - RESULT WAS ZER0

;

;             - BIT 3 - DIVIDE BY ZERO ATTEMPTED

;

;             - BIT 4 - NOT USED, 0 RETURNED

;

;             - BIT 5 - NOT USED, 0 RETURNED

;

;             - BIT 6 - NOT USED, 0 RETURNED

;

;             - BIT 7 - NOT USED, 0 RETURNED

;

; NOTE: When underflow occures, a ZERO result is returned.

;       When overflow or divide by zero occures, a result of

;       .99999999 E+127 is returned and it is up to the user

;       to handle these conditions as needed in the program.

;

; NOTE: The Compare instruction returns F0 = 0 if ARG 1 = ARG 2

;       and returns a CARRY FLAG = 1 if ARG 1 is > ARG 2

;

;***********************************************************************

;

$EJECT

;***********************************************************************

;

; The following values MUST be provided by the user

;

;***********************************************************************

;

ARG_STACK	EQU	9	;ARGUMENT STACK POINTER

ARG_STACK_PAGE	EQU	1

FORMAT		EQU	23	;LOCATION OF OUTPUT FORMAT BYTE

OUTPUT		EQU	1990H	;CALL LOCATION TO OUTPUT A CHARACTER

CONVT		EQU	58H	;LOCATION TO CONVERT NUMBERS

INTGRC		BIT	25	;BIT SET IF INTGER ERROR

ZSURP		BIT	54	;ZERO SUPRESSION FOR HEX PRINT

;

;***********************************************************************

;

; The following equates are used internally

;

;***********************************************************************

;

FP_NUMBER_SIZE	EQU	6

DIGIT		EQU	FP_NUMBER_SIZE-2

R0B0		EQU	0

R1B0		EQU	1

UNDERFLOW	EQU	0

OVERFLOW	EQU	1

ZERO		EQU	2

ZERO_DIVIDE	EQU	3

;

;***********************************************************************

$EJECT

	;**************************************************************

	;

	; The following internal locations are used by the math pack

	; ordering is important and the FP_DIGITS must be bit

	; addressable

	;

	;***************************************************************

	;

FP_STATUS	EQU	28H		;NOT USED

FP_TEMP		EQU	FP_STATUS+1	;NOT USED

FP_CARRY	EQU	FP_STATUS+2	;USED FOR BITS

ADD_IN		BIT	35		;DCMPXZ IN BASIC BACKAGE

XSIGN		BIT	FP_CARRY.0

FOUND_RADIX	BIT	FP_CARRY.1

FIRST_RADIX	BIT	FP_CARRY.2

DONE_LOAD	BIT	FP_CARRY.3

FP_DIG12	EQU	FP_CARRY+1

FP_DIG34	EQU	FP_CARRY+2

FP_DIG56	EQU	FP_CARRY+3

FP_DIG78	EQU	FP_CARRY+4

FP_SIGN		EQU	FP_CARRY+5

MSIGN		BIT	FP_SIGN.0

FP_EXP		EQU	FP_CARRY+6

FP_NIB1		EQU	FP_DIG12

FP_NIB2		EQU	FP_NIB1+1

FP_NIB3		EQU	FP_NIB1+2

FP_NIB4		EQU	FP_NIB1+3

FP_NIB5		EQU	FP_NIB1+4

FP_NIB6		EQU	FP_NIB1+5

FP_NIB7		EQU	FP_NIB1+6

FP_NIB8		EQU	FP_NIB1+7

FP_ACCX		EQU	FP_NIB1+8

FP_ACCC		EQU	FP_NIB1+9

FP_ACC1		EQU	FP_NIB1+10

FP_ACC2		EQU	FP_NIB1+11

FP_ACC3		EQU	FP_NIB1+12

FP_ACC4		EQU	FP_NIB1+13

FP_ACC5		EQU	FP_NIB1+14

FP_ACC6		EQU	FP_NIB1+15

FP_ACC7		EQU	FP_NIB1+16

FP_ACC8		EQU	FP_NIB1+17

FP_ACCS		EQU	FP_NIB1+18

	;

$EJECT

	ORG	1993H

	;

	;**************************************************************

	;

	; The floating point entry points and jump table

	;

	;**************************************************************

	;

	AJMP	FLOATING_ADD

	AJMP	FLOATING_SUB

	AJMP	FLOATING_COMP

	AJMP	FLOATING_MUL

	AJMP	FLOATING_DIV

	AJMP	HEXSCAN

	AJMP	FLOATING_POINT_INPUT

	AJMP	FLOATING_POINT_OUTPUT

	AJMP	CONVERT_BINARY_TO_ASCII_STRING

	AJMP	CONVERT_ASCII_STRING_TO_BINARY

	AJMP	MULNUM10

	AJMP	HEXOUT

	AJMP	PUSHR2R0

	;

$EJECT

	;

FLOATING_SUB:

	;

	MOV	P2,#ARG_STACK_PAGE

	MOV	R0,ARG_STACK

	DEC	R0		;POINT TO SIGN

	MOVX	A,@R0		;READ SIGN

	CPL	ACC.0

	MOVX	@R0,A

	;

	;AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA

	;

FLOATING_ADD:

	;

	;AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA

	;

	;

	ACALL 	MDES1		;R7=TOS EXP, R6=TOS-1 EXP, R4=TOS SIGN

				;R3=TOS-1 SIGN, OPERATION IS R1 # R0

	;

	MOV	A,R7		;GET TOS EXPONENT 

	JZ	POP_AND_EXIT	;IF TOS=0 THEN POP AND EXIT

	CJNE	R6,#0,LOAD1	;CLEAR CARRY EXIT IF ZERO

	;

	;**************************************************************

	;

SWAP_AND_EXIT:	; Swap external args and return

	;

	;**************************************************************

	;

	ACALL	LOAD_POINTERS

	MOV	R7,#FP_NUMBER_SIZE

	;

SE1:	MOVX	A,@R0		;SWAP THE ARGUMENTS

	MOVX	@R1,A

	DEC	R0

	DEC	R1

	DJNZ	R7,SE1

	;

POP_AND_EXIT:

	;

	MOV	A,ARG_STACK	;POP THE STACK

	ADD	A,#FP_NUMBER_SIZE

	MOV	ARG_STACK,A

	CLR	A

	RET

	;

	;

LOAD1:	SUBB	A,R6		;A = ARG 1 EXP - ARG 2 EXP

	MOV	FP_EXP,R7	;SAVE EXPONENT AND SIGN

	MOV	FP_SIGN,R4

	JNC	LOAD2		;ARG1 EXPONENT IS LARGER OR SAME

	MOV	FP_EXP,R6

	MOV	FP_SIGN,R3

	CPL	A

	INC	A		;COMPENSATE FOR EXP DELTA

	XCH	A,R0		;FORCE R0 TO POINT AT THE LARGEST

	XCH	A,R1		;EXPONENT

	XCH	A,R0

	;

LOAD2:	MOV	R7,A		;SAVE THE EXPONENT DELTA IN R7

	CLR	ADD_IN

	CJNE	R5,#0,$+5

	SETB	ADD_IN

	;

$EJECT

	; Load the R1 mantissa

	;

	ACALL	LOADR1_MANTISSA	;LOAD THE SMALLEST NUMBER

	;

	; Now align the number to the delta exponent

	; R4 points to the string of the last digits lost

	;

	CJNE	R7,#DIGIT+DIGIT+3,$+3

	JC	$+4

	MOV	R7,#DIGIT+DIGIT+2

	;

	MOV	FP_CARRY,#00	;CLEAR THE CARRY

	ACALL	RIGHT		;SHIFT THE NUMBER

	;

	; Set up for addition and subtraction

	;

	MOV	R7,#DIGIT	;LOOP COUNT

	MOV	R1,#FP_DIG78

	MOV	A,#9EH

	CLR	C

	SUBB	A,R4

	DA	A

	XCH	A,R4

	JNZ	$+3

	MOV	R4,A

	CJNE	A,#50H,$+3	;TEST FOR SUBTRACTION

	JNB	ADD_IN,SUBLP	;DO SUBTRACTION IF NO ADD_IN

	CPL	C		;FLIP CARRY FOR ADDITION

	ACALL	ADDLP		;DO ADDITION

	;

	JNC	ADD_R

	INC	FP_CARRY

	MOV	R7,#1

	ACALL	RIGHT

	ACALL	INC_FP_EXP	;SHIFT AND BUMP EXPONENT

	;

ADD_R:	AJMP	STORE_ALIGN_TEST_AND_EXIT

	;

ADDLP:	MOVX	A,@R0

	ADDC	A,@R1

	DA	A

	MOV	@R1,A

	DEC	R0

	DEC	R1

	DJNZ	R7,ADDLP	;LOOP UNTIL DONE

	RET

	;

$EJECT

	;

SUBLP:	MOVX	A,@R0		;NOW DO SUBTRACTION

	MOV	R6,A

	CLR	A

	ADDC	A,#99H

	SUBB	A,@R1

	ADD	A,R6

	DA	A

	MOV	@R1,A

	DEC	R0

	DEC	R1

	DJNZ	R7,SUBLP

	JC	FSUB6

	;

$EJECT

	;

	; Need to complement the result and sign because the floating

	; point accumulator mantissa was larger than the external

	; memory and their signs were equal.

	;

	CPL	FP_SIGN.0

	MOV	R1,#FP_DIG78

	MOV	R7,#DIGIT	;LOOP COUNT

	;

FSUB5:	MOV	A,#9AH

	SUBB	A,@R1

	ADD	A,#0

	DA	A

	MOV	@R1,A

	DEC	R1

	CPL	C

	DJNZ	R7,FSUB5	;LOOP

	;

	; Now see how many zeros their are

	;

FSUB6:	MOV	R0,#FP_DIG12

	MOV	R7,#0

	;

FSUB7:	MOV	A,@R0

	JNZ	FSUB8

	INC	R7

	INC	R7

	INC	R0

	CJNE	R0,#FP_SIGN,FSUB7

	AJMP	ZERO_AND_EXIT

	;

FSUB8:	CJNE	A,#10H,$+3

	JNC	FSUB9

	INC	R7

	;

	; Now R7 has the number of leading zeros in the FP ACC

	;

FSUB9:	MOV	A,FP_EXP	;GET THE OLD EXPONENT

	CLR	C

	SUBB	A,R7		;SUBTRACT FROM THE NUMBER OF ZEROS

	JZ	FSUB10

	JC	FSUB10

	;

	MOV	FP_EXP,A	;SAVE THE NEW EXPONENT

	;

	ACALL	LEFT1		;SHIFT THE FP ACC

	MOV	FP_CARRY,#0

	AJMP	STORE_ALIGN_TEST_AND_EXIT

	;

FSUB10:	AJMP	UNDERFLOW_AND_EXIT

	;

$EJECT

	;***************************************************************

	;

FLOATING_COMP:	; Compare two floating point numbers

		; used for relational operations and is faster

		; than subtraction. ON RETURN, The carry is set

		; if ARG1 is > ARG2, else carry is not set

		; if ARG1 = ARG2, F0 gets set

	;

	;***************************************************************

	;

	ACALL	MDES1		;SET UP THE REGISTERS

	MOV	A,ARG_STACK

	ADD	A,#FP_NUMBER_SIZE+FP_NUMBER_SIZE

	MOV	ARG_STACK,A	;POP THE STACK TWICE, CLEAR THE CARRY

	MOV	A,R6		;CHECK OUT EXPONENTS

	CLR	F0

	SUBB	A,R7

	JZ	EXPONENTS_EQUAL

	JC	ARG1_EXP_IS_LARGER

	;

	; Now the ARG2 EXPONENT is > ARG1 EXPONENT

	;

SIGNS_DIFFERENT:

	;

	MOV	A,R3		;SEE IF SIGN OF ARG2 IS POSITIVE

	SJMP	$+3

	;

ARG1_EXP_IS_LARGER:

	;

	MOV	A,R4		;GET THE SIGN OF ARG1 EXPONENT

	JZ	$+3

	CPL	C

	RET

	;

EXPONENTS_EQUAL:

	;

	; First, test the sign, then the mantissa

	;

	CJNE	R5,#0,SIGNS_DIFFERENT

	;

BOTH_PLUS:

	;

	MOV	R7,#DIGIT	;POINT AT MS DIGIT

	DEC	R0

	DEC	R0

	DEC	R0

	DEC	R1

	DEC	R1

	DEC	R1

	;

	; Now do the compare

	;

CLOOP:	MOVX	A,@R0

	MOV	R6,A

	MOVX	A,@R1

	SUBB	A,R6

	JNZ	ARG1_EXP_IS_LARGER

	INC	R0

	INC	R1

	DJNZ	R7,CLOOP

	;

	; If here, the numbers are the same, the carry is cleared

	;

	SETB	F0

	RET			;EXIT WITH EQUAL

	;

$EJECT

;MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM

;

FLOATING_MUL:	; Floating point multiply

;

;MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM

;

	ACALL	MUL_DIV_EXP_AND_SIGN

	;

	; check for zero exponents

	;

	CJNE	R6,#00,$+5	;ARG 2 EXP ZERO?

	AJMP	ZERO_AND_EXIT

	;

	; calculate the exponent

	;

FMUL1:	MOV	FP_SIGN,R5	;SAVE THE SIGN, IN CASE OF FAILURE

	;

	MOV	A,R7

	JZ	FMUL1-2

	ADD	A,R6		;ADD THE EXPONENTS

	JB	ACC.7,FMUL_OVER

	JBC	CY,FMUL2	;SEE IF CARRY IS SET

	;

	AJMP	UNDERFLOW_AND_EXIT

	;

FMUL_OVER:

	;

	JNC	FMUL2		;OK IF SET

	;

FOV:	AJMP	OVERFLOW_AND_EXIT

	;

FMUL2:	SUBB	A,#129		;SUBTRACT THE EXPONENT BIAS

	MOV	R6,A		;SAVE IT FOR LATER

	;

	; Unpack and load R0

	;

	ACALL	UNPACK_R0

	;

	; Now set up for loop multiply

	;

	MOV	R3,#DIGIT

	MOV	R4,R1B0

	;

$EJECT

	;

	; Now, do the multiply and accumulate the product

	;

FMUL3:	MOV	R1B0,R4

	MOVX	A,@R1

	MOV	R2,A

	ACALL	MUL_NIBBLE

	;

	MOV	A,R2

	SWAP	A

	ACALL	MUL_NIBBLE

	DEC	R4

	DJNZ	R3,FMUL3

	;

	; Now, pack and restore the sign

	;

	MOV	FP_EXP,R6

	MOV	FP_SIGN,R5

	AJMP	PACK		;FINISH IT OFF

	;

$EJECT

	;DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD

	;

FLOATING_DIV:

	;

	;DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD

	;

	ACALL	MDES1

	;

	; Check the exponents

	;

	MOV	FP_SIGN,R5	;SAVE THE SIGN

	CJNE	R7,#0,DIV0	;CLEARS THE CARRY

	ACALL	OVERFLOW_AND_EXIT

	CLR	A

	SETB	ACC.ZERO_DIVIDE

	RET

	;

DIV0:	MOV	A,R6		;GET EXPONENT

	JZ	FMUL1-2		;EXIT IF ZERO

	SUBB	A,R7		;DELTA EXPONENT

	JB	ACC.7,D_UNDER

	JNC	DIV3

	AJMP	UNDERFLOW_AND_EXIT

	;

D_UNDER:JNC	FOV

	;

DIV3:	ADD	A,#129		;CORRECTLY BIAS THE EXPONENT

	MOV	FP_EXP,A	;SAVE THE EXPONENT

	ACALL	LOADR1_MANTISSA	;LOAD THE DIVIDED

	;

	MOV	R2,#FP_ACCC	;SAVE LOCATION

	MOV	R3,R0B0		;SAVE POINTER IN R3

	MOV	FP_CARRY,#0	;ZERO CARRY BYTE

	;

DIV4:	MOV	R5,#0FFH	;LOOP COUNT

	SETB	C

	;

DIV5:	MOV	R0B0,R3		;RESTORE THE EXTERNAL POINTER

	MOV	R1,#FP_DIG78	;SET UP INTERNAL POINTER

	MOV	R7,#DIGIT	;LOOP COUNT

	JNC	DIV7		;EXIT IF NO CARRY

	;

DIV6:	MOVX	A,@R0		;DO ACCUMLATION

	MOV	R6,A

	CLR	A

	ADDC	A,#99H

	SUBB	A,R6

	ADD	A,@R1

	DA	A

	MOV	@R1,A

	DEC	R0

	DEC	R1

	DJNZ	R7,DIV6		;LOOP

	;

	INC	R5		;SUBTRACT COUNTER

	JC	DIV5		;KEEP LOOPING IF CARRY

	MOV	A,@R1		;GET CARRY

	SUBB	A,#1		;CARRY IS CLEARED

	MOV	@R1,A		;SAVE CARRY DIGIT

	CPL	C

	SJMP	DIV5		;LOOP

	;

	; Restore the result if carry was found

	;

DIV7:	ACALL	ADDLP		;ADD NUMBER BACK

	MOV	@R1,#0		;CLEAR CARRY

	MOV	R0B0,R2		;GET SAVE COUNTER

	MOV	@R0,5		;SAVE COUNT BYTE

	;

	INC	R2		;ADJUST SAVE COUNTER

	MOV	R7,#1		;BUMP DIVIDEND

	ACALL	LEFT

	CJNE	R2,#FP_ACC8+2,DIV4

	;

	DJNZ	FP_EXP,DIV8

	AJMP	UNDERFLOW_AND_EXIT

	;

DIV8:	MOV	FP_CARRY,#0

	;

$EJECT

	;***************************************************************

	;

PACK:	; Pack the mantissa

	;

	;***************************************************************

	;

	; First, set up the pointers

	;

	MOV	R0,#FP_ACCC

	MOV	A,@R0		;GET FP_ACCC

	MOV	R6,A		;SAVE FOR ZERO COUNT

	JZ	PACK0		;JUMP OVER IF ZERO

	ACALL	INC_FP_EXP	;BUMP THE EXPONENT

	DEC	R0

	;

PACK0:	INC	R0		;POINT AT FP_ACC1

	;

PACK1:	MOV	A,#8		;ADJUST NIBBLE POINTER

	MOV	R1,A

	ADD	A,R0

	MOV	R0,A

	CJNE	@R0,#5,$+3	;SEE IF ADJUSTING NEEDED

	JC	PACK3+1

	;

PACK2:	SETB	C

	CLR	A

	DEC	R0

	ADDC	A,@R0

	DA	A

	XCHD	A,@R0		;SAVE THE VALUE

	JNB	ACC.4,PACK3

	DJNZ	R1,PACK2

	;

	DEC	R0

	MOV	@R0,#1

	ACALL	INC_FP_EXP

	SJMP	PACK4

	;

PACK3:	DEC	R1

	MOV	A,R1

	CLR	C

	XCH	A,R0

	SUBB	A,R0

	MOV	R0,A

	;

PACK4:	MOV	R1,#FP_DIG12

	;

	; Now, pack

	;

PLOOP:	MOV	A,@R0

	SWAP	A		;FLIP THE DIGITS

	INC	R0

	XCHD	A,@R0

	ORL	6,A		;ACCUMULATE THE OR'ED DIGITS

	MOV	@R1,A

	INC	R0

	INC	R1

	CJNE	R1,#FP_SIGN,PLOOP

	MOV	A,R6

	JNZ	STORE_ALIGN_TEST_AND_EXIT

	MOV	FP_EXP,#0	;ZERO EXPONENT

	;

	;**************************************************************

	;

STORE_ALIGN_TEST_AND_EXIT:	;Save the number align carry and exit

	;

	;**************************************************************

	;

	ACALL	LOAD_POINTERS

	MOV	ARG_STACK,R1	;SET UP THE NEW STACK

	MOV	R0,#FP_EXP

	;

	; Now load the numbers

	;

STORE2:	MOV	A,@R0

	MOVX	@R1,A		;SAVE THE NUMBER

	DEC	R0

	DEC	R1

	CJNE	R0,#FP_CARRY,STORE2

	;

	CLR	A		;NO ERRORS

	;

PRET:	RET			;EXIT

	;

$EJECT

INC_FP_EXP:

	;

	INC	FP_EXP

	MOV	A,FP_EXP

	JNZ	PRET		;EXIT IF NOT ZERO

	POP	ACC		;WASTE THE CALLING STACK

	POP	ACC

	AJMP	OVERFLOW_AND_EXIT

	;

;***********************************************************************

;

UNPACK_R0:	; Unpack BCD digits and load into nibble locations

;

;***********************************************************************

	;

	PUSH	R1B0

	MOV	R1,#FP_NIB8

	;

ULOOP:	MOVX	A,@R0

	ANL	A,#0FH

	MOV	@R1,A		;SAVE THE NIBBLE

	MOVX	A,@R0

	SWAP	A

	ANL	A,#0FH

	DEC	R1

	MOV	@R1,A		;SAVE THE NIBBLE AGAIN

	DEC	R0

	DEC	R1

	CJNE	R1,#FP_NIB1-1,ULOOP

	;

	POP	R1B0

	;

LOAD7:	RET

	;

$EJECT

	;**************************************************************

	;

OVERFLOW_AND_EXIT:	;LOAD 99999999 E+127,  SET OV BIT, AND EXIT

	;

	;**************************************************************

	;

	MOV	R0,#FP_DIG78

	MOV	A,#99H

	;

OVE1:	MOV	@R0,A

	DEC	R0

	CJNE	R0,#FP_CARRY,OVE1

	;

	MOV	FP_EXP,#0FFH

	ACALL	STORE_ALIGN_TEST_AND_EXIT

	;

	SETB	ACC.OVERFLOW

	RET

	;

$EJECT

	;**************************************************************

	;

UNDERFLOW_AND_EXIT:	;LOAD 0, SET UF BIT, AND EXIT

	;

	;**************************************************************

	;

	ACALL	ZERO_AND_EXIT

	CLR	A

	SETB	ACC.UNDERFLOW

	RET

	;

	;**************************************************************

	;

ZERO_AND_EXIT:		;LOAD 0, SET ZERO BIT, AND EXIT

	;

	;**************************************************************

	;

	ACALL	FP_CLEAR

	ACALL	STORE_ALIGN_TEST_AND_EXIT

	SETB	ACC.ZERO

	RET			;EXIT

	;

	;**************************************************************

	;

FP_CLEAR:

	;

	; Clear internal storage

	;

	;**************************************************************

	;

	CLR	A

	MOV	R0,#FP_ACC8+1

	;

FPC1:	MOV	@R0,A

	DEC	R0

	CJNE	R0,#FP_TEMP,FPC1

	RET

	;

$EJECT

	;**************************************************************

	;

RIGHT:	; Shift ACCUMULATOR RIGHT the number of nibbles in R7

	; Save the shifted values in R4 if SAVE_ROUND is set

	;

	;**************************************************************

	;

	MOV	R4,#0		;IN CASE OF NO SHIFT

	;

RIGHT1:	CLR	C

	MOV	A,R7		;GET THE DIGITS TO SHIFT

	JZ	RIGHT5-1	;EXIT IF ZERO

	SUBB	A,#2		;TWO TO DO?

	JNC	RIGHT5		;SHIFT TWO NIBBLES

	;

	; Swap one nibble then exit

	;

RIGHT3:	PUSH	R0B0		;SAVE POINTER REGISTER

	PUSH	R1B0

	;

	MOV	R1,#FP_DIG78	;LOAD THE POINTERS

	MOV	R0,#FP_DIG56

	MOV	A,R4		;GET THE OVERFLOW REGISTER

	XCHD	A,@R1		;GET DIGIT 8

	SWAP	A		;FLIP FOR LOAD

	MOV	R4,A

	;

RIGHTL:	MOV	A,@R1		;GET THE LOW ORDER BYTE

	XCHD	A,@R0		;SWAP NIBBLES

	SWAP	A		;FLIP FOR STORE

	MOV	@R1,A		;SAVE THE DIGITS

	DEC	R0		;BUMP THE POINTERS

	DEC	R1

	CJNE	R1,#FP_DIG12-1,RIGHTL	;LOOP

	;

	MOV	A,@R1		;ACC = CH8

	SWAP	A		;ACC = 8CH

	ANL	A,#0FH		;ACC = 0CH

	MOV	@R1,A		;CARRY DONE

	POP	R1B0		;EXIT

	POP	R0B0		;RESTORE REGISTER

	RET

	;

RIGHT5:	MOV	R7,A		;SAVE THE NEW SHIFT NUMBER

	CLR	A

	XCH	A,FP_CARRY	;SWAP THE NIBBLES

	XCH	A,FP_DIG12

	XCH	A,FP_DIG34

	XCH	A,FP_DIG56

	XCH	A,FP_DIG78

	MOV	R4,A		;SAVE THE LAST DIGIT SHIFTED

	SJMP	RIGHT1+1

	;

$EJECT

	;***************************************************************

	;

LEFT:	; Shift ACCUMULATOR LEFT the number of nibbles in R7

	;

	;***************************************************************

	;

	MOV	R4,#00H		;CLEAR FOR SOME ENTRYS

	;

LEFT1:	CLR	C

	MOV	A,R7		;GET SHIFT VALUE

	JZ	LEFT5-1		;EXIT IF ZERO

	SUBB	A,#2		;SEE HOW MANY BYTES TO SHIFT

	JNC	LEFT5

	;

LEFT3:	PUSH	R0B0		;SAVE POINTER

	PUSH	R1B0

	MOV	R0,#FP_CARRY

	MOV	R1,#FP_DIG12

	;

	MOV	A,@R0		;ACC=CHCL

	SWAP	A		;ACC = CLCH

	MOV	@R0,A		;ACC = CLCH, @R0 = CLCH

	;

LEFTL:	MOV	A,@R1		;DIG 12

	SWAP	A		;DIG 21

	XCHD	A,@R0

	MOV	@R1,A		;SAVE IT

	INC	R0		;BUMP POINTERS

	INC	R1

	CJNE	R0,#FP_DIG78,LEFTL

	;

	MOV	A,R4

	SWAP	A

	XCHD	A,@R0

	ANL	A,#0F0H

	MOV	R4,A

	;

	POP	R1B0

	POP	R0B0		;RESTORE

	RET			;DONE

	;

LEFT5:	MOV	R7,A		;RESTORE COUNT

	CLR	A

	XCH	A,R4		;GET THE RESTORATION BYTE

	XCH	A,FP_DIG78	;DO THE SWAP

	XCH	A,FP_DIG56

	XCH	A,FP_DIG34

	XCH	A,FP_DIG12

	XCH	A,FP_CARRY

	SJMP	LEFT1+1

	;

$EJECT

MUL_NIBBLE:

	;

	; Multiply the nibble in R7 by the FP_NIB locations

	; accumulate the product in FP_ACC

	;

	; Set up the pointers for multiplication

	;

	ANL	A,#0FH		;STRIP OFF MS NIBBLE

	MOV	R7,A

	MOV	R0,#FP_ACC8

	MOV	R1,#FP_NIB8

	CLR	A

	MOV	FP_ACCX,A

	;

MNLOOP:	DEC	R0		;BUMP POINTER TO PROPAGATE CARRY

	ADD	A,@R0		;ATTEMPT TO FORCE CARRY

	DA	A		;BCD ADJUST

	JNB	ACC.4,MNL0	;DON'T ADJUST IF NO NEED

	DEC	R0		;PROPAGATE CARRY TO THE NEXT DIGIT

	INC	@R0		;DO THE ADJUSTING

	INC	R0		;RESTORE R0

	;

MNL0:	XCHD	A,@R0		;RESTORE INITIAL NUMBER

	MOV	B,R7		;GET THE NUBBLE TO MULTIPLY

	MOV	A,@R1		;GET THE OTHER NIBBLE

	MUL	AB		;DO THE MULTIPLY

	MOV	B,#10		;NOW BCD ADJUST

	DIV	AB

	XCH	A,B		;GET THE REMAINDER

	ADD	A,@R0		;PROPAGATE THE PARTIAL PRODUCTS

	DA	A		;BCD ADJUST

	JNB	ACC.4,MNL1	;PROPAGATE PARTIAL PRODUCT CARRY

	INC	B

	;

MNL1:	INC	R0

	XCHD	A,@R0		;SAVE THE NEW PRODUCT

	DEC	R0

	MOV	A,B		;GET BACK THE QUOTIENT

	DEC	R1

	CJNE	R1,#FP_NIB1-1,MNLOOP

	;

	ADD	A,FP_ACCX	;GET THE OVERFLOW

	DA	A		;ADJUST

	MOV	@R0,A		;SAVE IT

	RET			;EXIT

	;

$EJECT

	;***************************************************************

	;

LOAD_POINTERS:	; Load the ARG_STACK into R0 and bump R1

	;

	;***************************************************************

	;

	MOV	P2,#ARG_STACK_PAGE

	MOV	R0,ARG_STACK

	MOV	A,#FP_NUMBER_SIZE

	ADD	A,R0

	MOV	R1,A

	RET

	;

	;***************************************************************

	;

MUL_DIV_EXP_AND_SIGN:

	;

	; Load the sign into R7, R6. R5 gets the sign for

	; multiply and divide.

	;

	;***************************************************************

	;

	ACALL	FP_CLEAR	;CLEAR INTERNAL MEMORY

	;

MDES1:	ACALL	LOAD_POINTERS	;LOAD REGISTERS

	MOVX	A,@R0		;ARG 1 EXP

	MOV	R7,A		;SAVED IN R7

	MOVX	A,@R1		;ARG 2 EXP

	MOV	R6,A		;SAVED IN R6

	DEC	R0		;BUMP POINTERS TO SIGN

	DEC	R1

	MOVX	A,@R0		;GET THE SIGN

	MOV	R4,A		;SIGN OF ARG1

	MOVX	A,@R1		;GET SIGN OF NEXT ARG

	MOV	R3,A		;SIGN OF ARG2

	XRL	A,R4		;ACC GETS THE NEW SIGN

	MOV	R5,A		;R5 GETS THE NEW SIGN

	;

	; Bump the pointers to point at the LS digit

	;

	DEC	R0

	DEC	R1

	;

	RET

	;

$EJECT

	;***************************************************************

	;

LOADR1_MANTISSA:

	;

	; Load the mantissa of R0 into FP_Digits

	;

	;***************************************************************

	;

	PUSH	R0B0		;SAVE REGISTER 1

	MOV	R0,#FP_DIG78	;SET UP THE POINTER

	;

LOADR1:	MOVX	A,@R1

	MOV	@R0,A

	DEC	R1

	DEC	R0

	CJNE	R0,#FP_CARRY,LOADR1

	;

	POP	R0B0

	RET

	;

$EJECT

	;***************************************************************

	;

HEXSCAN:	; Scan a string to determine if it is a hex number

		; set carry if hex, else carry = 0

	;

	;***************************************************************

	;

	ACALL	GET_DPTR_CHARACTER

	PUSH	DPH

	PUSH	DPL		;SAVE THE POINTER

	;

HEXSC1:	MOVX	A,@DPTR		;GET THE CHARACTER

	ACALL	DIGIT_CHECK	;SEE IF A DIGIT

	JC	HS1		;CONTINUE IF A DIGIT

	ACALL	HEX_CHECK	;SEE IF HEX

	JC	HS1

	;

	CLR	ACC.5		;NO LOWER CASE

	CJNE	A,#'H',HEXDON

	SETB	C

	SJMP	HEXDO1		;NUMBER IS VALID HEX, MAYBE

	;

HEXDON:	CLR	C

	;

HEXDO1:	POP	DPL		;RESTORE POINTER

	POP	DPH

	RET

	;

HS1:	INC	DPTR		;BUMP TO NEXT CHARACTER

	SJMP	HEXSC1		;LOOP

	;

HEX_CHECK:	;CHECK FOR A VALID ASCII HEX, SET CARRY IF FOUND

	;

	CLR	ACC.5		;WASTE LOWER CASE

	CJNE	A,#'F'+1,$+3	;SEE IF F OR LESS

	JC	HC1

	RET

	;

HC1:	CJNE	A,#'A',$+3	;SEE IF A OR GREATER

	CPL	C

	RET

	;

$EJECT

	;

PUSHR2R0:

	; 

	MOV	R3,#HIGH CONVT	;CONVERSION LOCATION

	MOV	R1,#LOW CONVT

	ACALL	CONVERT_BINARY_TO_ASCII_STRING

	MOV	A,#0DH		;A CR TO TERMINATE

	MOVX	@R1,A		;SAVE THE CR

	MOV	DPTR,#CONVT

	;

	; Falls thru to FLOATING INPUT

	;

$EJECT

	;***************************************************************

	;

FLOATING_POINT_INPUT:	; Input a floating point number pointed to by

			; the DPTR

	;

	;***************************************************************

	;

	ACALL	FP_CLEAR	;CLEAR EVERYTHING

	ACALL	GET_DPTR_CHARACTER

	ACALL	PLUS_MINUS_TEST

	MOV	MSIGN,C		;SAVE THE MANTISSA SIGN

	;

	; Now, set up for input loop

	;

	MOV	R0,#FP_ACCC

	MOV	R6,#7FH		;BASE EXPONENT

	SETB	F0		;SET INITIAL FLAG

	;

INLOOP:	ACALL	GET_DIGIT_CHECK

	JNC	GTEST		;IF NOT A CHARACTER, WHAT IS IT?

	ANL	A,#0FH		;STRIP ASCII

	ACALL	STDIG		;STORE THE DIGITS

	;

INLPIK:	INC	DPTR		;BUMP POINTER FOR LOOP

	SJMP	INLOOP		;LOOP FOR INPUT

	;

GTEST:	CJNE	A,#'.',GT1	;SEE IF A RADIX

	JB	FOUND_RADIX,INERR

	SETB	FOUND_RADIX

	CJNE	R0,#FP_ACCC,INLPIK

	SETB	FIRST_RADIX	;SET IF FIRST RADIX

	SJMP	INLPIK		;GET ADDITIONAL DIGITS

	;

GT1:	JB	F0,INERR	;ERROR IF NOT CLEARED

	CJNE	A,#'e',$+5	;CHECK FOR LOWER CASE

	SJMP	$+5

	CJNE	A,#'E',FINISH_UP

	ACALL	INC_AND_GET_DPTR_CHARACTER

	ACALL	PLUS_MINUS_TEST

	MOV	XSIGN,C		;SAVE SIGN STATUS

	ACALL	GET_DIGIT_CHECK

	JNC	INERR

	;

	ANL	A,#0FH		;STRIP ASCII BIAS OFF THE CHARACTER

	MOV	R5,A		;SAVE THE CHARACTER IN R5

	;

GT2:	INC	DPTR

	ACALL	GET_DIGIT_CHECK

	JNC	FINISH1

	ANL	A,#0FH		;STRIP OFF BIAS

	XCH	A,R5		;GET THE LAST DIGIT

	MOV	B,#10		;MULTIPLY BY TEN

	MUL	AB

	ADD	A,R5		;ADD TO ORIGINAL VALUE

	MOV	R5,A		;SAVE IN R5

	JNC	GT2		;LOOP IF NO CARRY

	MOV	R5,#0FFH	;FORCE AN ERROR

	;

FINISH1:MOV	A,R5		;GET THE SIGN

	JNB	XSIGN,POSNUM	;SEE IF EXPONENT IS POS OR NEG

	CLR	C

	SUBB	A,R6

	CPL	A

	INC	A

	JC	FINISH2

	MOV	A,#01H

	RET

	;

POSNUM:	ADD	A,R6		;ADD TO EXPONENT

	JNC	FINISH2

	;

POSNM1:	MOV	A,#02H

	RET

	;

FINISH2:XCH	A,R6		;SAVE THE EXPONENT

	;

FINISH_UP:

	;

	MOV	FP_EXP,R6	;SAVE EXPONENT

	CJNE	R0,#FP_ACCC,$+5

	ACALL	FP_CLEAR	;CLEAR THE MEMORY IF 0

	MOV	A,ARG_STACK	;GET THE ARG STACK

	CLR	C

	SUBB	A,#FP_NUMBER_SIZE+FP_NUMBER_SIZE

	MOV	ARG_STACK,A	;ADJUST FOR STORE

	AJMP	PACK

	;

STDIG:	CLR	F0		;CLEAR INITIAL DESIGNATOR

	JNZ	STDIG1		;CONTINUE IF NOT ZERO

	CJNE	R0,#FP_ACCC,STDIG1

	JNB	FIRST_RADIX,RET_X

	;

DECX:	DJNZ	R6,RET_X

	;

INERR:	MOV	A,#0FFH

	;

RET_X:	RET

	;

STDIG1:	JB	DONE_LOAD,FRTEST

	CLR	FIRST_RADIX

	;

FRTEST:	JB	FIRST_RADIX,DECX

	;

FDTEST:	JB	FOUND_RADIX,FDT1

	INC	R6

	;

FDT1:	JB	DONE_LOAD,RET_X

	CJNE	R0,#FP_ACC8+1,FDT2

	SETB	DONE_LOAD

	;

FDT2:	MOV	@R0,A		;SAVE THE STRIPPED ACCUMULATOR

	INC	R0		;BUMP THE POINTER

	RET			;EXIT

	;

$EJECT

	;***************************************************************

	;

	; I/O utilities

	;

	;***************************************************************

	;

INC_AND_GET_DPTR_CHARACTER:

	;

	INC	DPTR

	;

GET_DPTR_CHARACTER:

	;

	MOVX	A,@DPTR		;GET THE CHARACTER

	CJNE	A,#' ',PMT1	;SEE IF A SPACE

	;

	; Kill spaces

	;

	SJMP	INC_AND_GET_DPTR_CHARACTER

	;

PLUS_MINUS_TEST:

	;

	CJNE	A,#0E3H,$+5	;SEE IF A PLUS, PLUS TOKEN FROM BASIC

	SJMP	PMT3

	CJNE	A,#'+',$+5

	SJMP	PMT3

	CJNE	A,#0E5H,$+5	;SEE IF MINUS, MINUS TOKEN FROM BASIC

	SJMP	PMT2

	CJNE	A,#'-',PMT1

	;

PMT2:	SETB	C

	;

PMT3:	INC	DPTR

	;

PMT1:	RET

	;

$EJECT

	;***************************************************************

	;

FLOATING_POINT_OUTPUT:	; Output the number, format is in location 23

	;

	; IF FORMAT = 00 - FREE FLOATING

	;           = FX - EXPONENTIAL (X IS THE NUMBER OF SIG DIGITS)

	;           = NX - N = NUM BEFORE RADIX, X = NUM AFTER RADIX

	;                  N + X = 8 MAX

	;

	;***************************************************************

	;

	ACALL	MDES1		;GET THE NUMBER TO OUTPUT, R0 IS POINTER

	ACALL	POP_AND_EXIT	;OUTPUT POPS THE STACK

	MOV	A,R7

	MOV	R6,A		;PUT THE EXPONENT IN R6

	ACALL	UNPACK_R0	;UNPACK THE NUMBER

	MOV	R0,#FP_NIB1	;POINT AT THE NUMBER

	MOV	A,FORMAT	;GET THE FORMAT

	MOV	R3,A		;SAVE IN CASE OF EXP FORMAT

	JZ	FREE		;FREE FLOATING?

	CJNE	A,#0F0H,$+3	;SEE IF EXPONENTIAL

	JNC	EXPOUT

	;

	; If here, must be integer USING format

	;

	MOV	A,R6		;GET THE EXPONENT

	JNZ	$+4

	MOV	R6,#80H

	MOV	A,R3		;GET THE FORMAT

	SWAP	A		;SPLIT INTEGER AND FRACTION

	ANL	A,#0FH

	MOV	R2,A		;SAVE INTEGER

	ACALL	NUM_LT		;GET THE NUMBER OF INTEGERS

	XCH	A,R2		;FLIP FOR SUBB

	CLR	C

	SUBB	A,R2

	MOV	R7,A

	JNC	$+8

	MOV	R5,#'?'		;OUTPUT A QUESTION MARK

	ACALL	SOUT1		;NUMBER IS TOO LARGE FOR FORMAT

	AJMP	FREE

	CJNE	R2,#00,USING0	;SEE IF ZERO

	DEC	R7

	ACALL	SS7

	ACALL	ZOUT		;OUTPUT A ZERO

	SJMP	USING1

	;

USING0:	ACALL	SS7		;OUTPUT SPACES, IF NEED TO

	MOV	A,R2		;OUTPUT DIGITS

	MOV	R7,A

	ACALL	OUTR0

	;

USING1:	MOV	A,R3

	ANL	A,#0FH		;GET THE NUMBER RIGHT OF DP

	MOV	R2,A		;SAVE IT

	JZ	PMT1		;EXIT IF ZERO

	ACALL	ROUT		;OUTPUT DP

	ACALL	NUM_RT

	CJNE	A,2,USINGX	;COMPARE A TO R2

	;

USINGY:	MOV	A,R2

	AJMP	Z7R7

	;

USINGX:	JNC	USINGY

	;

USING2:	XCH	A,R2

	CLR	C

	SUBB	A,R2

	XCH	A,R2

	ACALL	Z7R7		;OUTPUT ZEROS IF NEED TO

	MOV	A,R2

	MOV	R7,A

	AJMP	OUTR0

	;

	; First, force exponential output, if need to

	;

FREE:	MOV	A,R6		;GET THE EXPONENT

	JNZ	FREE1		;IF ZERO, PRINT IT

	ACALL	SOUT

	AJMP	ZOUT

	;

FREE1:	MOV	R3,#0F0H	;IN CASE EXP NEEDED

	MOV	A,#80H-DIGIT-DIGIT-1

	ADD	A,R6

	JC	EXPOUT

	SUBB	A,#0F7H

	JC	EXPOUT

	;

	; Now, just print the number

	;

	ACALL	SINOUT		;PRINT THE SIGN OF THE NUMBER

	ACALL	NUM_LT		;GET THE NUMBER LEFT OF DP

	CJNE	A,#8,FREE4

	AJMP	OUTR0

	;

FREE4:	ACALL	OUTR0

	ACALL	ZTEST		;TEST FOR TRAILING ZEROS

	JZ	U_RET		;DONE IF ALL TRAILING ZEROS

	ACALL	ROUT		;OUTPUT RADIX

	;

FREE2:	MOV	R7,#1		;OUTPUT ONE DIGIT

	ACALL	OUTR0

	JNZ	U_RET

	ACALL	ZTEST

	JZ	U_RET

	SJMP	FREE2		;LOOP

	;

EXPOUT:	ACALL	SINOUT		;PRINT THE SIGN

	MOV	R7,#1		;OUTPUT ONE CHARACTER

	ACALL	OUTR0

	ACALL	ROUT		;OUTPUT RADIX

	MOV	A,R3		;GET FORMAT

	ANL	A,#0FH		;STRIP INDICATOR

	JZ	EXPOTX

	;

	MOV	R7,A		;OUTPUT THE NUMBER OF DIGITS

	DEC	R7		;ADJUST BECAUSE ONE CHAR ALREADY OUT

	ACALL	OUTR0

	SJMP	EXPOT4

	;

EXPOTX:	ACALL	FREE2		;OUTPUT UNTIL TRAILING ZEROS

	;

EXPOT4:	ACALL	SOUT		;OUTPUT A SPACE

	MOV	R5,#'E'

	ACALL	SOUT1		;OUTPUT AN E

	MOV	A,R6		;GET THE EXPONENT

	JZ	XOUT0		;EXIT IF ZERO

	DEC	A		;ADJUST FOR THE DIGIT ALREADY OUTPUT

	CJNE	A,#80H,XOUT2	;SEE WHAT IT IS

	;

XOUT0:	ACALL	SOUT

	CLR	A

	SJMP	XOUT4

	;

XOUT2:	JC	XOUT3		;NEGATIVE EXPONENT

	MOV	R5,#'+'		;OUTPUT A PLUS SIGN

	ACALL	SOUT1

	SJMP	XOUT4

	;

XOUT3:	ACALL	MOUT

	CPL	A		;FLIP BITS

	INC	A		;BUMP

	;

XOUT4:	CLR	ACC.7

	MOV	R0,A

	MOV	R2,#0

	MOV	R1,#LOW CONVT	;CONVERSION LOCATION

	MOV	R3,#HIGH CONVT

	ACALL	CONVERT_BINARY_TO_ASCII_STRING

	MOV	R0,#LOW CONVT	;NOW, OUTPUT EXPONENT

	;

EXPOT5:	MOVX	A,@R0		;GET THE CHARACTER

	MOV	R5,A		;OUTPUT IT

	ACALL	SOUT1

	INC	R0		;BUMP THE POINTER

	MOV	A,R0		;GET THE POINTER

	CJNE	A,R1B0,EXPOT5	;LOOP

	;

U_RET:	RET			;EXIT

	;

OUTR0:	; Output the characters pointed to by R0, also bias ascii

	;

	MOV	A,R7		;GET THE COUNTER

	JZ	OUTR		;EXIT IF DONE

	MOV	A,@R0		;GET THE NUMBER

	ORL	A,#30H		;ASCII BIAS

	INC	R0		;BUMP POINTER AND COUNTER

	DEC	R7

	MOV	R5,A		;PUT CHARACTER IN OUTPUT REGISTER

	ACALL	SOUT1		;OUTPUT THE CHARACTER

	CLR	A		;JUST FOR TEST

	CJNE	R0,#FP_NIB8+1,OUTR0

	MOV	A,#55H		;KNOW WHERE EXIT OCCURED

	;

OUTR:	RET

	;

ZTEST:	MOV	R1,R0B0		;GET POINTER REGISTER

	;

ZT0:	MOV	A,@R1		;GET THE VALUE

	JNZ	ZT1

	INC	R1		;BUMP POINTER

	CJNE	R1,#FP_NIB8+1,ZT0

	;

ZT1:	RET

	;

NUM_LT:	MOV	A,R6		;GET EXPONENT

	CLR	C		;GET READY FOR SUBB

	SUBB	A,#80H		;SUB EXPONENT BIAS

	JNC	NL1		;OK IF NO CARRY

	CLR	A		;NO DIGITS LEFT

	;

NL1:	MOV	R7,A		;SAVE THE COUNT

	RET

	;

NUM_RT:	CLR	C		;SUBB AGAIN

	MOV	A,#80H		;EXPONENT BIAS

	SUBB	A,R6		;GET THE BIASED EXPONENT

	JNC	NR1

	CLR	A

	;

NR1:	RET			;EXIT

	;

SPACE7:	MOV	A,R7		;GET THE NUMBER OF SPACES

	JZ	NR1		;EXIT IF ZERO

	ACALL	SOUT		;OUTPUT A SPACE

	DEC	R7		;BUMP COUNTER

	SJMP	SPACE7		;LOOP

	;

Z7R7:	MOV	R7,A

	;

ZERO7:	MOV	A,R7		;GET COUNTER

	JZ	NR1		;EXIT IF ZERO

	ACALL	ZOUT		;OUTPUT A ZERO

	DEC	R7		;BUMP COUNTER

	SJMP	ZERO7		;LOOP

	;

SS7:	ACALL	SPACE7

	;

SINOUT:	MOV	A,R4		;GET THE SIGN

	JZ	SOUT		;OUTPUT A SPACE IF ZERO

	;

MOUT:	MOV	R5,#'-'

	SJMP	SOUT1		;OUTPUT A MINUS IF NOT

	;

ROUT:	MOV	R5,#'.'		;OUTPUT A RADIX

	SJMP	SOUT1

	;

ZOUT:	MOV	R5,#'0'		;OUTPUT A ZERO

	SJMP	SOUT1

	;

SOUT:	MOV	R5,#' '		;OUTPUT A SPACE

	;

SOUT1:	AJMP	OUTPUT

	;

$EJECT

	;***************************************************************

	;

CONVERT_ASCII_STRING_TO_BINARY:

	;

	;DPTR POINTS TO ASCII STRING

	;PUT THE BINARY NUMBER IN R2:R0, ERROR IF >64K

	;

	;***************************************************************

	;

CASB:	ACALL	HEXSCAN		;SEE IF HEX NUMBER

	MOV	ADD_IN,C	;IF ADD_IN IS SET, THE NUMBER IS HEX

	ACALL	GET_DIGIT_CHECK

	CPL	C		;FLIP FOR EXIT

	JC	RCASB

	MOV	R3,#00H		;ZERO R3:R1 FOR LOOP

	MOV	R1,#00H

	SJMP	CASB5

	;

CASB2:	INC	DPTR

	MOV	R0B0,R1		;SAVE THE PRESENT CONVERTED VALUE

	MOV	R0B0+2,R3	;IN R2:R0

	ACALL	GET_DIGIT_CHECK

	JC	CASB5

	JNB	ADD_IN,RCASB	;CONVERSION COMPLETE

	ACALL	HEX_CHECK	;SEE IF HEX NUMBER

	JC	CASB4		;PROCEED IF GOOD

	INC	DPTR		;BUMP PAST H

	SJMP	RCASB

	;

CASB4:	ADD	A,#9		;ADJUST HEX ASCII BIAS

	;

CASB5:	MOV	B,#10

	JNB	ADD_IN,CASB6

	MOV	B,#16		;HEX MODE

	;

CASB6:	ACALL	MULNUM		;ACCUMULATE THE DIGITS

	JNC	CASB2		;LOOP IF NO CARRY

	;

RCASB:	CLR	A		;RESET ACC

	MOV	ACC.OVERFLOW,C	;IF OVERFLOW, SAY SO

	RET			;EXIT

	;

$EJECT

	;

MULNUM10:MOV	B,#10

	;

	;***************************************************************

	;

MULNUM:	; Take the next digit in the acc (masked to 0FH)

	; accumulate in R3:R1

	;

	;***************************************************************

	;

	PUSH	ACC		;SAVE ACC

	PUSH	B		;SAVE MULTIPLIER

	MOV	A,R1		;PUT LOW ORDER BITS IN ACC

	MUL	AB		;DO THE MULTIPLY

	MOV	R1,A		;PUT THE RESULT BACK

	MOV	A,R3		;GET THE HIGH ORDER BYTE

	MOV	R3,B		;SAVE THE OVERFLOW

	POP	B		;GET THE MULTIPLIER

	MUL	AB		;DO IT

	MOV	C,OV		;SAVE OVERFLOW IN F0

	MOV	F0,C

	ADD	A,R3		;ADD OVERFLOW TO HIGH RESULT

	MOV	R3,A		;PUT IT BACK

	POP	ACC		;GET THE ORIGINAL ACC BACK

	ORL	C,F0		;OR CARRY AND OVERFLOW

	JC	MULX		;NO GOOD IF THE CARRY IS SET

	;

MUL11:	ANL	A,#0FH		;MASK OFF HIGH ORDER BITS

	ADD	A,R1		;NOW ADD THE ACC

	MOV	R1,A		;PUT IT BACK

	CLR	A		;PROPAGATE THE CARRY

	ADDC	A,R3

	MOV	R3,A		;PUT IT BACK

	;

MULX:	RET			;EXIT WITH OR WITHOUT CARRY

	;

	;***************************************************************

	;

CONVERT_BINARY_TO_ASCII_STRING:

	;

	;R3:R1 contains the address of the string

	;R2:R0 contains the value to convert

	;DPTR, R7, R6, and ACC gets clobbered

	;

	;***************************************************************

	;

	CLR	A		;NO LEADING ZEROS

	MOV	DPTR,#10000	;SUBTRACT 10000

	ACALL	RSUB		;DO THE SUBTRACTION

	MOV	DPTR,#1000	;NOW 1000

	ACALL	RSUB

	MOV	DPTR,#100	;NOW 100

	ACALL	RSUB

	MOV	DPTR,#10	;NOW 10

	ACALL	RSUB

	MOV	DPTR,#1		;NOW 1

	ACALL	RSUB

	JZ	RSUB2		;JUMP OVER RET

	;

RSUB_R:	RET

	;

RSUB:	MOV	R6,#-1		;SET UP THE COUNTER

	;

RSUB1:	INC	R6		;BUMP THE COUNTER

	XCH	A,R2		;DO A FAST COMPARE

	CJNE	A,DPH,$+3

	XCH	A,R2

	JC	FAST_DONE

	XCH	A,R0		;GET LOW BYTE

	SUBB	A,DPL		;SUBTRACT, CARRY IS CLEARED

	XCH	A,R0		;PUT IT BACK

	XCH	A,R2		;GET THE HIGH BYTE

	SUBB	A,DPH		;ADD THE HIGH BYTE

	XCH	A,R2		;PUT IT BACK

	JNC	RSUB1		;LOOP UNTIL CARRY

	;

	XCH	A,R0

	ADD	A,DPL		;RESTORE R2:R0

	XCH	A,R0

	XCH	A,R2

	ADDC	A,DPH

	XCH	A,R2

	;

FAST_DONE:

	;

	ORL	A,R6		;OR THE COUNT VALUE

	JZ	RSUB_R		;RETURN IF ZERO

	;

RSUB2:	MOV	A,#'0'		;GET THE ASCII BIAS

	ADD	A,R6		;ADD THE COUNT

	;

RSUB4:	MOV	P2,R3		;SET UP P2

	MOVX	@R1,A		;PLACE THE VALUE IN MEMORY

	INC	R1

	CJNE	R1,#00H,RSUB3	;SEE IF RAPPED AROUND

	INC	R3		;BUMP HIGH BYTE

	;

RSUB3:	RET			;EXIT

	;

$EJECT

	;***************************************************************

	;

HEXOUT:	; Output the hex number in R3:R1, supress leading zeros, if set

	;

	;***************************************************************

	;

	ACALL	SOUT		;OUTPUT A SPACE

	MOV	C,ZSURP		;GET ZERO SUPPRESSION BIT

	MOV	ADD_IN,C

	MOV	A,R3		;GET HIGH NIBBLE AND PRINT IT

	ACALL	HOUTHI

	MOV	A,R3

	ACALL	HOUTLO

	;

HEX2X:	CLR	ADD_IN		;DON'T SUPPRESS ZEROS

	MOV	A,R1		;GET LOW NIBBLE AND PRINT IT

	ACALL	HOUTHI

	MOV	A,R1

	ACALL	HOUTLO

	MOV	R5,#'H'		;OUTPUT H TO INDICATE HEX MODE

	;

SOUT_1:	AJMP	SOUT1

	;

HOUT1:	CLR	ADD_IN		;PRINTED SOMETHING, SO CLEAR ADD_IN

	ADD	A,#90H		;CONVERT TO ASCII

	DA	A

	ADDC	A,#40H

	DA	A		;GOT IT HERE

	MOV	R5,A		;OUTPUT THE BYTE

	SJMP	SOUT_1

	;

HOUTHI:	SWAP	A		;SWAP TO OUTPUT HIGH NIBBLE

	;

HOUTLO:	ANL	A,#0FH		;STRIP

	JNZ	HOUT1		;PRINT IF NOT ZERO

	JNB	ADD_IN,HOUT1	;OUTPUT A ZERO IF NOT SUPRESSED

	RET

	;

$EJECT

	ORG	1FEBH		;FOR LINK COMPATABILITY

	;

	;

GET_DIGIT_CHECK:	; Get a character, then check for digit

	;

	ACALL	GET_DPTR_CHARACTER

	;

DIGIT_CHECK:	;CHECK FOR A VALID ASCII DIGIT, SET CARRY IF FOUND

	;

	CJNE	A,#'9'+1,$+3	;SEE IF ASCII 9 OR LESS

	JC	DC1

	RET

	;

DC1:	CJNE	A,#'0',$+3	;SEE IF ASCII 0 OR GREATER

	CPL	C

	RET

	;

	END


	;
	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
	;***************************************************************
	;
	XSEG	;External Ram
	;
	;***************************************************************
	;
	DS	4
IBCNT:	DS	1		;LENGTH OF A LINE
IBLN:	DS	2		;THE LINE NUMBER
IBUF:	DS	LINLEN		;THE INPUT BUFFER
CONVT:	DS	15		;CONVERSION LOCATION FOR FPIN
	;
	ORG	100H
	;
GTB:	DS	1		;GET LOCATION
ERRLOC:	DS	1		;ERROR TYPE
ERRNUM:	DS	2		;WHERE TO GO ON AN ERROR
VARTOP:	DS	2		;TOP OF VARIABLE STORAGE
ST_ALL:	DS	2		;STORAGE ALLOCATION
MT_ALL:	DS	2		;MATRIX ALLOCATION
MEMTOP:	DS	2		;TOP OF MEMORY
RCELL:	DS	2		;RANDOM NUMBER CELL
	DS	FPSIZ-1
CXTAL:	DS	1		;CRYSTAL
	DS	FPSIZ-1
FPT1:	DS	1		;FLOATINP POINT TEMP 1
	DS	FPSIZ-1
FPT2:	DS	1		;FLOATING POINT TEMP 2
INTLOC:	DS	2		;LOCATION TO GO TO ON INTERRUPT
STR_AL:	DS	2		;STRING ALLOCATION
SPV:	DS	2		;SERIAL PORT BAUD RATE
TIV:	DS	2		;TIMER INTERRUPT NUM AND LOC
PROGS:	DS	2		;PROGRAM A PROM TIME OUT
IPROGS:	DS	2		;INTELLIGENT PROM PROGRAMMER TIMEOUT
TM_TOP:	DS	1

	END
