;*****************************************************************************
;*                                                                           *
;*                      MSC1210 BASIC-52 (tm) Source Listing                 *
;*                                  based on                                 *
;*	    original source code of V1.1 (BASIC.SRC and FP52.SRC) by	     *
;*	       Intel Corporation, Embedded Controller Operations	     *
;*				is public domain			     *
;*                                                                           *
;*---------------------------------------------------------------------------*
;*              Alterations made by D. Wulf , December 18, 1999              *
;*           Alterations to MSC1210 made by R. Kucera , Jul , 2002           *
;*                                                                           *
;*****************************************************************************
;
;  The BASIC-52.asm source listing, when compiled, create the object code
;  that can be loaded to the MSC1210. It is a new chip with x51 core
;  produced by Texas Instruments
;  Here was added 32 bit token SUMRES, 24 bit tokens ADCRES, OFFSET, GAIN
;  16 bit token GPWM to use internal HW generator 
;  8 bit function SFR(address) to allow access of SFR registers
;
;*****************************************************************************
;
T2CON	EQU	0C8H ; 
TL2	EQU	0CCH ; 
TH2	EQU	0CDH ; 
PCON	equ	87h  ;
MWS	equ	8fh  ;
MPAGE	equ	92h  ; MSC1210 uses MPAGE instead Port P2
CADDR	equ	93h
CDATA	equ	94h
MCON	equ	95h  ; memory control	
PWMLOW	equ	0a2h ; MSC1210 ADC result
PWMHIGH	equ	0a3h ; MSC1210 ADC result
AIE	equ	0a6h
OCL	equ	0d1h ; MSC1210 ADC offset register 
OCM	equ	0d2h ; MSC1210
OCH	equ	0d3h ; MSC1210
GCL	equ	0d4h ; MSC1210 ADC gain register
GCM	equ	0d5h ; MSC1210
GCH	equ	0d6h ; MSC1210
ADRESL	equ	0d9h ; MSC1210 ADC result
ADRESM	equ	0dah ; MSC1210 ADC result
ADRESH	equ	0dbh ; MSC1210 ADC result
ADCON0	equ	0dch ; MSC1210 ADCON0 register
ADCON1	equ	0ddh ; MSC1210 ADCON1 register
ADCON2	equ	0deh ; MSC1210 ADCON2 register  Decimation ratio low
ADCON3	equ	0dfh ; MSC1210 ADCON3 register  Decimation ratio high
SUMR0	equ	0e2h ; MSC1210 32 bit accumulator
SUMR1	equ	0e3h ; MSC1210 32 bit accumulator
SUMR2	equ	0e4h ; MSC1210 32 bit accumulator
SUMR3	equ	0e5h ; MSC1210 32 bit accumulator
FMCON	equ   	0eeH ; Flash memory control
FTCON	equ	0efh
USEC	equ	0fbh
MSECL	equ	0fch
MSECH	equ	0fdh

ReadCfgFlash	equ	0FFDFh
WriteToFlash_W	equ	0FFDBh
;
;*****************************************************************************
;
$EJECT
	;**************************************************************
	;
	; TRAP VECTORS TO MONITOR
	;
RESET_TAG	equ 	2401H ;0AAh
	;
TAG_LOCATION 	equ	2402H	;(5AH)
	;
EXTERNAL_INT0 	equ	2440H
	;
COMMAND_M_ENTRY equ	2448H
	;
SERIAL_PORT 	equ	2450H
	;
MONITOR_OUTPUT 	equ	2458H
	;
MONITOR_INPUT 	equ	2460H
	;
MONITOR_CSTS 	equ	2468H
	;
GET_USR_JMP_VEC equ	2470H
	;
GET_USR_LVECTOR equ	2478H
	;
PRINT_AT_VECTOR equ	2480H
	;
INTERRUPT_PWM 	equ	2488H
	;
EXTERNAL_RESET 	equ	2490H
	;
USER_OUTPUT	equ	4030H
	;
USER_INPUT 	equ	4033H
	;
USER_CSTS 	equ	4036H
	;
USER_RESET 	equ	4039H
	;
	; USER DEFINED PRINT @ ---  403CH
	;
	;***************************************************************
	;
$EJECT
	;***************************************************************
	;
	; MCS - 51  -  8K BASIC VERSION 1.1
	;
	;***************************************************************
	;
	AJMP	CRST		;START THE PROGRAM
        ADDC    A,@R1
        ;
	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: ; 	jmp	0FD3Bh		;monitor MSC1210
	JB	I_T0,STS	;SEE IF MONITOR WANTS IT
	CLR	DACK
	JNB	P3.2,$		;WAIT FOR DMA TO END
	SETB	DACK
	RETI
	;
STS:	LJMP	EXTERNAL_INT0	;GO TO THE MONITOR
	;
STK:	SETB	INTPEN		;TELL BASIC AN INTERRUPT WAS RECEIVED
	RETI
	;
STU:	LJMP	SERIAL_PORT	;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
Use32bitConv	BIT	56	;39.0-USE 32 bits conversion
NoZero		BIT	57	;39.1-use in IntToStr conversion
TmpEA		BIT	58	;39.2-save status of EA if programming Flash
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	40
	;
	; 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
Data24	equ	4Dh		;extended 32 bit conversion
Data32	equ	4Eh		;extended 32 bit conversion
CMNDSP	EQU	4FH		;SYSTEM STACK POINTER
RCAPH2  EQU     0CBH
RCAPL2  EQU     0CAH
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	0400H		;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	ASFR		;(       )READ SFR 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	AADCR		;(       ) ADCRES
	dw	AADCDEC		;(       ) ADCDEC
	dw	AGPWM		;(       ) GPWM read internal PWM gen.of MSC1210
	dw	AOFFSET		;(       ) OFFSET of ADC in MSC1210
	dw	AGAIN		;(       ) GAIN of ADC in MSC1210
	dw	ASUM		;(       ) 32bit SUM register of MSC1210
	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      UPPL0           ;(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
	DB	15		;SFR
	;
$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'
	;
	DB	T_UOP+14	;SFR TOKEN
	DB	'SFR'
	;
T_ULAST	EQU	T_UOP+15	;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_ADCR	equ	T_ULAST+19
	db	T_ADCR
	db	'ADCRES'
	;
T_ADCDC	equ	T_ULAST+20
	db	T_ADCDC
	db	'ADCDEC'
	;
T_PWM	equ	T_ULAST+21
	db	T_PWM
	db	'GPWM'
	;
T_OFFST	equ	T_ULAST+22
	db	T_OFFST
	db	'OFFSET'
	;
T_GAIN	equ	T_ULAST+23
	db	T_GAIN
	db	'GAIN'
	;
T_SUMRS equ	T_ULAST+24
	db	T_SUMRS
	db	'SUMRES'
	;
T_ULASC	EQU	T_SUMRS+1
T_ASC	EQU	T_ULASC		;ASC TOKEN
	DB	T_ASC
	DB	'ASC('
	;
T_USE	EQU	T_ULASC+1	;USING TOKEN
	DB	T_USE
	DB	'USING('
	DB	T_USE
	DB	'U.('
	;
T_CHR	EQU	T_ULASC+2	;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
	MOV	T2CON,#34H
	mov	FTCON,#0A5h
	mov	USEC,#10	;MHZ-1 (for clk 11059200)
	mov	MSECL,#247
	mov	MSECH,#42
;       DB      75H             ;MOV DIRECT, # OP CODE
;       DB      0C8H            ;T2CON LOCATION
;       DB      34H             ;CONFIGURATION BYTE
;	mov 	RCAPL2,#0dch
;	mov	RCAPH2,#0ffh
	;
;	call	0F97Dh		;parser MSC1210
	MOV	DPTR,#RESET_TAG	;READ CODE AT RESET_TAG
	CLR	A
	MOVC	A,@A+DPTR
        CJNE    A,#0AAH,CRST1   ;IF IT IS AN AAH, DO USER RESET
	LCALL	EXTERNAL_RESET
	;
CRST1:  MOV     R0,#IRAMTOP     ;PUT THE TOP OF RAM IN R0
	CLR	A		;ZERO THE ACC
	;
CRST2:  MOV     @R0,A           ;CLEAR INTERNAL MEMORY
        DJNZ    R0,CRST2        ;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,CRS1
        SJMP    CRS2
CRS1:   CJNE    R7,#3,CR0
CRS2:   ACALL   CL_1
        SJMP    CR1
	;
CR0:    push	r7b0
	mov	r7,#7fh	; test if Data Flash defined
	call	ReadCfgFlash
	mov	a,r7
	pop	r7b0
	mov	84h,a		; for debug DPL1
	anl	a,#7
	xrl	a,#7
	jnz	CR01
	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
	jmp	CR1
cr01:				; define onchip ram
	mov	r1,#0ffh
	mov	r3,#3
	;
CR1: 	CJNE    R3,#03H,CR11    ;NEED THIS MUCH RAM
CR11:	JC      CRST_J
	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,CR20
	LCALL	USER_RESET
CR20:   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
CRST_J:	JMP	CRST

	; START OF BAUD RATE MODIFICATIONS BY DANIEL WALLNER

BG1:	CLR	A		;DO BAUD RATE
	
	MOV	R3,A
	MOV	R1,A
	MOV	TL2,A
	CLR	T2CON.2
	JB	RXD,$		;LOOP UNTIL A CHARACTER IS RECEIVED
	MOV	T2CON,#5
	CALL	TIB2
	JNB	RXD,$
	MOV	T2CON,#34H
	CALL	RCL		;LOAD THE TIMER
	NOP
	NOP

	; END OF BAUD RATE MODIFICATIONS BY DANIEL WALLNER


BG3:	MOV	DPTR,#S_N	;GET THE MESSAGE
	ACALL	CRP		;PRINT IT
;	mov	dptr,#memtop
;	call	L20DPI		;
;	call	Two_EY
	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   PG101
	INC	R6
        MOV     A,RCAPH2
;       DB      0E5H            ;MOV A DIRECT OP CODE
;       DB      0CBH            ;ADDRESS OF R2CAP HIGH
        ACALL   PG101
        MOV     A,RCAPL2
;       DB      0E5H            ;MOV A, DIRECT OP CODE
;       DB      0CAH            ;R2CAP LOW
	MOV	R6,#3
	MOV	R1,#LOW MEMTOP-1
	MOV	R3,#HIGH MEMTOP
        ACALL   PG101           ;SAVE MEMTOP
	SJMP	PGR
	;
CIPROG:	MOV	DPTR,#IPROGS	;LOAD IPROG LOCATION
	SETB	INTELB
        SJMP    CPROG1          ;GO DO PROG
	;
CPROG:	MOV	DPTR,#PROGS	;LOAD PROG LOCATION
	CLR	INTELB
	;
CPROG1: 
;	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_BASE7        ;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,CPROG2
	INC	R7
CPROG2: ACALL   PG102
	;
$EJECT
PGR:
;	SETB	PROMV
	AJMP	C_K
	;
PG1:	MOV	MPAGE,R3	;GET THE BYTE TO PROGRAM
	MOVX	A,@R1
PG101:  LCALL   INC3210         ;BUMP POINTERS
PG102:;  MOV     R5,#1           ;SET UP INTELLIGENT COUMTER
	;
PG2:
	call	ProgFlash
	jnz	PG6
	

;	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
PG31:   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
;PG41:   ACALL   ZRO             ;AGAIN
;	ACALL	ZRO		;AND AGAIN
;	ACALL	ZRO		;AND AGAIN
;        DJNZ    R5,PG41         ;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,PG31       ;EXIT IF IN RUN MODE
	MOV	DPTR,#E16X	;PROGRAMMING ERROR
	;
ERRLK:	LJMP	ERROR		;PROCESS THE ERROR
	;
$EJECT
PG7:	;write to Flash
;	MOV	P0,R0		;SET UP THE PORTS
;	MOV	MPAGE,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
CCAL1:  RET
	;
	;
;$INCLUDE(:F2:BAS52.TL)
;BEGINNING

	;**************************************************************
	;
TIMER_LOAD:; Load the timer
	;
	;*************************************************************
	;
        ACALL   CCAL1           ;DELAY FOUR CLOCKS
TIMER_LOAD1:
        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
;        CALL   ROMFD           ;FIND THE PROGRAM
;       ACALL   ROMFD           ;FIND THE PROGRAM

RO1:    CALL    DELTST
        MOV     R4,#1
        JNC     RO11
        CALL    ONE
        MOV     R4,A
RO11:   ACALL   ROMFD
        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     DECDP1          ;BUMP IF ZERO
	DEC	DPH
DECDP1: 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     ADDPTR1         ;JUMP IF NO CARRY
	INC	DPH		;BUMP DPH
ADDPTR1: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
	;
	;*****************************************************************
	;
CNEW1:  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,ICLR1    ;SEE IF BASIC HAS INTERRUPTS
	CLR	EX1		;IF SO, CLEAR INTERRUPTS
ICLR1:  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,#'"',ROM_P1   ;EXIT IF TERMINATOR
	RET
ROM_P1: 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      PN01
        CJNE    A,R4B0,PN02     ;SEE IF THE SAME AS TERMINATOR
PN01:   RET                     ;EXIT IF THE SAME
PN02:   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	MPAGE,#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
INL11:  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,INL2B1    ;IS IT A CR
	AJMP	CRLF		;OUTPUT A CRLF AND EXIT
INL2B1: CJNE    A,#20H,INL2B2
INL2B2: JC      INLX            ;ONLY ECHO CONTROL CHARACTERS
	INC	R0		;BUMP THE POINTER
	CJNE	R0,#IBUF+79,INLX
	DEC	R0		;FORCE 79
        SJMP    INL11           ;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
TEROT01:JNB     CNT_S,TEROT02   ;WAIT FOR A CONTROL Q
	ACALL	BCK		;GET SERIAL STATUS
        SJMP    TEROT01
TEROT02:MOV     A,R5            ;PUT OUTPUT BYTE IN A
        JNB     BO,TEROT03      ;CHECK FOR MONITOR
	LCALL	2440H		;DO THE MONITOR
	AJMP	TEROT1		;CLEAN UP
TEROT03:JNB     COUB,TEROT04    ;SEE IF USER WANTS OUTPUT
	LCALL	USER_OUTPUT
	AJMP	TEROT1
TEROT04: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,TEROT11  ;SEE IF A CR
	MOV	PHEAD,#00H	;IF A CR, RESET PHEAD AND
	;
TEROT11: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,NLC1     ;DEC PHEAD IF A BACKSPACE
	DEC	PHEAD
NLC1:   CJNE    R5,#20H,NLC2    ;IS IT A PRINTABLE CHARACTER?
NLC2:   JC      NLC3            ;DON'T INCREMENT PHEAD IF NOT PRINTABLE
	INC	PHEAD		;BUMP PRINT HEAD
NLC3:   POP     DPL             ;RESTORE DPTR
	POP	DPH
	POP	ACC		;RESTORE ACC
	RET			;EXIT
	;

;END
;$INCLUDE(:F2:BAS52.OUT)
	;
BCK:	CALL	CSTS		;CHECK STATUS
        JNC     CI_RET1         ;EXIT IF NO CHARACTER
	;
$EJECT
	;***************************************************************
	;
	;INPUTS A CHARACTER FROM THE SYSTEM CONSOLE.
	;
	;***************************************************************
	;
INCHAR: JNB     BI,INCHAR1      ;CHECK FOR MONITOR (BUBBLE)
	LCALL	MONITOR_INPUT
	SJMP	INCH1
INCHAR1:JNB     CIUB,INCHAR2    ;CHECK FOR USER
	LCALL	USER_INPUT
	SJMP	INCH1
INCHAR2:JNB     RI,$            ;WAIT FOR RECEIVER READY.
	MOV	A,SBUF
	CLR	RI		;RESET READY
	CLR	ACC.7		;NO BIT 7
	;
INCH1:  CJNE    A,#13H,INCH11
	SETB	CNT_S
INCH11: CJNE    A,#11H,INCH12
	CLR	CNT_S
INCH12: CJNE    A,#CNTRLC,INCH13
	JNB	NO_C,C_EX	;TRAP NO CONTROL C
	RET
	;
INCH13: CLR     JKBIT
	CJNE	A,#17H,CI_RET	;CONTROL W
	SETB	JKBIT
	;
CI_RET:	SETB	C		;CARRY SET IF A CHARACTER
CI_RET1:RET                     ;EXIT
	;
	;*************************************************************
	;
	;RROM - The Statement Action Routine RROM
	;
	;*************************************************************
	;
RROM:	SETB	INBIT		;SO NO ERRORS
	CALL	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,CSTS1        ;BUBBLE STATUS
	LJMP	MONITOR_CSTS
CSTS1:  JNB     CIUB,CSTS2      ;SEE IF EXTERNAL CONSOLE
	LJMP	USER_CSTS
CSTS2:  MOV     C,RI
	RET
	;
C_EX0:  MOV     DPTR,#WB        ;EGO MESSAGE
	CALL	ROM_P
	;
C_EX:	CLR	CNT_S		;NO OUTPUT STOP
        LCALL   SPRINT1         ;ASSURE CONSOLE
	CALL	CRLF
        JBC     JKBIT,C_EX0
	;
	JNB	DIRF,JSSTOP0
	JMP	C_K		;CLEAR COB AND EXIT
JSSTOP0:JMP	SSTOP0
	;
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      BCHR1           ;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   CNEW1           ;CLEAR THE STORAGE ARRAYS
        ACALL   SRESTR1         ;GET THE STARTING ADDRESS
	ACALL	B_C
	JZ	CMNDLK		;IF NULL GO TO COMMAND MODE
	;
	ACALL	T_DP
        CALL   B_TXA           ;BUMP TO STARTING LINE
	;
CILOOP:	ACALL	SP0		;DO A CR AND A LF
CILOOP1:CLR     DIRF            ;NOT IN DIRECT MODE
	;
	;INTERPERTER DRIVER
	;
ILOOP:	MOV	SP,SPSAV	;RESTORE THE STACK EACH TIME
	mov	ASTKA,#STACKTP	;debug
	clr	Use32BitConv    ;reset flag
        JB      DIRF,ILOOP1     ;NO INTERRUPTS IF IN DIRECT MODE
	MOV	INTXAH,TXAH	;SAVE THE TEXT POINTER
	MOV	INTXAL,TXAL
ILOOP1: 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
BCHR1:  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
	CALL	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:	CALL	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,ITRAP1  ;TIMER 0
	MOV	TH0,R3
	MOV	TL0,R1
	RET
	;
ITRAP1: CJNE    A,#TMR1,ITRAP2  ;TIMER 1
	MOV	TH1,R3
	MOV	TL1,R1
	RET
	;
ITRAP2: CJNE    A,#TMR2,ITRAP3  ;TIMER 2
        MOV     TH2,R3
        MOV     TL2,R1
;       DB      8BH             ;MOV R3 DIRECT OP CODE
;       DB      0CDH            ;T2H LOCATION
;       DB      89H             ;MOV R1 DIRECT OP CODE
;       DB      0CCH            ;T2L LOCATION
	RET
	;
ITRAP3: cjne    A,#T_ADCDC,ITRAP4  ;ADCON2,3 - ADC decimation ratio
        mov     ADCON3,R3
        mov     ADCON2,R1
	ret
        ;
ITRAP4: cjne    A,#T_PWM,ITRAP5  ;PWMHIGH:PWMLOW
        mov     PWMHIGH,R3
        mov     PWMLOW,R1
	ret
        ;
ITRAP5: CJNE    A,#TRC2,RCL1    ;RCAP2 TOKEN
RCL:    MOV     RCAPH2,R3
        MOV     RCAPL2,R1
;       DB      8BH             ;MOV R3 DIRECT OP CODE
;       DB      0CBH            ;RCAP2H LOCATION
;       DB      89H             ;MOV R1 DIRECT OP CODE
;       DB      0CAH            ;RCAP2L LOCATION
	RET
	;
RCL1:   ACALL   R3CK            ;MAKE SURE THAT R3 IS ZERO
        CJNE    A,#TT2C,RCL2
        MOV     T2CON,R1
;       DB      89H             ;MOV R1 DIRECT OP CODE
;       DB      0C8H            ;T2CON LOCATION
	RET
	;
RCL2:   CJNE    A,#T_IE,RCL3    ;IE TOKEN
	MOV	IE,R1
	RET
	;
RCL3:   CJNE    A,#T_IP,RCL4    ;IP TOKEN
	MOV	IP,R1
	RET
	;
RCL4:   CJNE    A,#TTC,RCL5     ;TCON TOKEN
	MOV	TCON,R1
	RET
	;
RCL5:   CJNE    A,#TTM,RCL6     ;TMOD TOKEN
	MOV	TMOD,R1
	RET
	;
RCL6:   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,T_T01
	LJMP	AXTAL1		;SET UP CRYSTAL
	;
T_T01:	cjne	a,#T_ADCR,T_T02
	setb	Use32bitConv
	ACALL   IFIXL           ;Data32:Data24 R3:R1 HAS THE TOS
	clr	Use32bitConv
	mov	ADRESH,Data24
	mov	ADRESM,r3
	mov	ADRESL,r1
	ret
	;
T_T02:	cjne	a,#T_OFFST,T_T03
	setb	Use32bitConv
	ACALL   IFIXL           ;Data32:Data24 R3:R1 HAS THE TOS
	clr	Use32bitConv
	mov	OCH,Data24
	mov	OCM,r3
	mov	OCL,r1
	ret
	;
T_T03:	cjne	a,#T_SUMRS,T_T04
	setb	Use32bitConv
	ACALL   IFIXL           ;Data32:Data24 R3:R1 HAS THE TOS
	clr	Use32bitConv
	mov	SUMR3,Data32
	mov	SUMR2,Data24
	mov	SUMR1,r3
	mov	SUMR0,r1
	ret
	;
T_T04:	cjne	a,#T_GAIN,T_T05 
	setb	Use32bitConv
	ACALL   IFIXL           ;Data32:Data24 R3:R1 HAS THE TOS
	clr	Use32bitConv
	mov	GCH,Data24
	mov	GCM,r3
	mov	GCL,r1
	ret
	;
T_T05:  
	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_J;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
ITRAP_J:AJMP	ITRAP
	;
T_T2:	CJNE	A,#T_PC,INTERX	;PCON TOKEN
        MOV     PCON,R1
;       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   SPEOP1          ;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,ISTAT1
ISTAT1: JNC     IAT
	LCALL	GET_USR_JMP_VEC	;LET THE USER SET UP THE DPTR
	ACALL	GCI1
	ANL	A,#0FH		;STRIP OFF BIAS
	SJMP	ISTA1
	;
IAT:    CJNE    A,#T_XTAL,IAT1
IAT1:   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,ISTAS	;XBYTE TOKEN
	ACALL	SPEOP
	;
ISTAX1:	
	MOV	MPAGE,R3
	MOVX	@R1,A
	RET
	;
ISTAS:	CJNE	A,#T_UOP+14,ISTAY	;SFR TOKEN
	ACALL	SPEOP
	ACALL	R3CK		;CHECK LOCATION
	jmp	SetSFR
;	RET
	;
ISTAY:  CJNE    A,#T_CR+1,ISTAY1;TRAP NEW OPERATORS
ISTAY1: JC      I_S
        CJNE    A,#0B0H,ISTAY2  ;SEE IF TOO BIG
ISTAY2: JNC     INTERX
	ADD	A,#0F9H		;BIAS FOR LOOKUP TABLE
	SJMP	ISTA0		;DO THE OPERATION
	;
I_S:    CJNE    A,#T_LAST,I_S1  ;MAKE SURE AN INITIAL RESERVED WORD
I_S1:   JC      INTERX1         ;ERROR IF NOT
	;
INTERX:	LJMP	E1XX		;SYNTAX ERROR
	;
INTERX1:JNB     DIRF,ISTA0      ;EXECUTE ALL STATEMENTS IF IN RUN MODE
        CJNE    A,#T_DIR,INTERX2;SEE IF ON TOKEN
INTERX2:JC      ISTA0           ;OK IF DIRECT
        CJNE    A,#T_GOSB+1,INTERX3;SEE IF FOR
	SJMP	ISTA0		;FOR IS OK
INTERX3:CJNE    A,#T_REM+1,INTERX4      ;NEXT IS OK
	SJMP	ISTA0
INTERX4: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,ISTA01;SEE IF LET TOKEN
	SJMP	ISTAT		;WASTE LET TOKEN
ISTA01: 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,S_41      ;EXIT IF A CR
	RET
S_41:   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,S_11         ;SEE IF DONE
	ACALL	S_E
	ACALL	EIGP		;PRINT EXTRA IGNORED
        AJMP    FINDCR          ;GO FIND THE END
S_11:   INC     DPTR            ;BUMP THE STORE POINTER
	SJMP	S_0		;CONTINUE TO LOOP
	;
E3XX:	MOV	DPTR,#E3X	;BAD ARG ERROR
	AJMP	EK
	;
SLET0:	ACALL	SLET1
	JMP	POPAS		;COPY EXPRESSION TO VARIABLE
	;
SLET1:	CALL	VAR_ER		;CHECK FOR A"VARIABLE"
	;
SLET2:	PUSH	R2B0		;SAVE THE VARIABLE ADDRESS
	PUSH	R0B0
	MOV	R7,#T_EQU	;GET EQUAL TOKEN
	CALL	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
SPEOP1: 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,CSY1
CSY1:   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     CSY2            ;PROPAGATE THE CARRY
	INC	R3
CSY2:   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
	CALL	POPAS		;POP ARG STACK AND COPY CONTROL VAR
	MOV	R7,#T_TO	;GET TO TOKEN
	CALL	WE
	ACALL	GC		;GET NEXT CHARACTER
	CJNE	A,#T_STEP,SF2
	ACALL	GCI1		;EAT THE TOKEN
	CALL	EXPRB		;EVALUATE EXPRESSION
        SJMP    SF21            ;JUMP OVER
	;
SF2:	LCALL	PUSH_ONE	;PUT ONE ON THE STACK
	;
SF21:   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
	CALL	POPAS		;PUT STEP ON STACK
	CALL	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:	CALL	EXPRB		;PUT EXPRESSION ON STACK
	ACALL	C_TST		;SEE IF MORE TO DO
	JNC	SPUSH		;IF A COMMA PUSH ANOTHER
	RET
	;
	;
SPOP:	CALL	VAR_ER		;GET VARIABLE
	CALL	XPOP		;FLIP THE REGISTERS FOR POPAS
	ACALL	C_TST		;SEE IF MORE TO DO
	JNC	SPOP
	;
SPOP1:  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,SIF1  ;SEE IF THEN TOKEN
	ACALL	GCI1		;WASTE THEN TOKEN
SIF1:   CJNE    R1,#0,T_F1      ;CHECK R_OP RESULT
	;
E_FIND:	MOV	R7,#T_ELSE	;FIND ELSE TOKEN
	ACALL	FINDC
        JZ      SPOP1           ;EXIT IF A CR
	ACALL	GCI1		;BUMP PAST TOKEN
	CJNE	A,#T_ELSE,E_FIND;WASTE IF NO ELSE
	;
T_F1:	CALL	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,FL11
	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,SGT11     ;SEE IF A LINE WAS EDITED
        LCALL   CNEW1           ;CLEAR THE MEMORY IF SET
SGT11:  AJMP    CILOOP1         ;CLEAR DIRF AND LOOP
	;
SGT2:   JBC     OTI,SGT21       ;SEE IF TIMER INTERRUPT
	ANL	34,#10111101B	;CLEAR INTERRUPTS
	AJMP	ILOOP		;EXECUTE
SGT21:  MOV     C,ISAV
	MOV	INPROG,C
	AJMP	ILOOP		;RESTORE INTERRUPTS AND RET
	;
	;
	;*************************************************************
	;
RTST:	; Test for ZERO
	;
	;*************************************************************
	;
	CALL	EXPRB		;EVALUATE EXPRESSION
	CALL	INC_ASTKA	;BUMP ARG STACK
        JZ      RTST1           ;EXIT WITH ZERO OR 0FFH
	MOV	A,#0FFH
RTST1:  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
	;
FL11:   MOV     DPTR,#E10X      ;NO LINE NUMBER
	AJMP	EK		;HANDLE THE ERROR
	;
FL3:    JB      ACC.7,FL11      ;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:	CALL	INTERR		;GET THE INTEGER
	;
RL1:	ACALL	GLN
	JMP	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
	;
	;***************************************************************
	;
	CALL	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,SR01
	AJMP	CMNDLK
SR01:   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_J		;MUST BE GOSUB
	RET			;NORMAL FALL THRU EXIT FOR NO MATCH
SGT1_J:	jmp	SGT1
	;
$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	MPAGE,#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	MPAGE,#CSTKAH
	MOVX	A,@R0		;GET BYTE
        CJNE    A,R4B0,CSETUP1  ;SEE IF TYPE MATCH
	INC	R0
	RET
CSETUP1:JZ      E4XX            ;EXIT IF STACK UNDERFLOW
	CJNE	A,#FTYPE,CS1	;SEE IF FOR TYPE
        ACALL   XXI3            ;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     XXI1
	MOV	R2,TEMP1
	MOV	R0,TEMP2
XXI1:   MOV     A,R2            ;SEE IF VAR'S AGREE
	CJNE	A,TEMP1,E4XX
	MOV	A,R0
	CJNE	A,TEMP2,E4XX
	CALL	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	MPAGE,R2		;SET UP PORT
	MOVX	A,@R0		;GET SIGN
	INC	R0		;BACK TO EXPONENT
	PUSH	ACC		;SAVE SIGN OF STEP
	CALL	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
	CALL	POPAS		;SAVE THE RESULT
	MOV	R2,#CSTKAH	;RESTORE LIMIT LOCATION
	POP	R0B0
	CALL	PUSHAS		;PUT LIMIT ON STACK
        CALL    FP_BASE2        ;DO THE COMPARE
	POP	ACC		;GET LIMIT SIGN BACK
        JZ      XXI2            ;IF SIGN NEGATIVE, TEST "BACKWARDS"
	CPL	C
XXI2:   ORL     C,F0            ;SEE IF EQUAL
	JC	N4		;STILL SMALLER THAN LIMIT?
XXI3:   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,PUSHCS1 ;SEE IF OVERFLOWED
PUSHCS1: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
	;
PUSHCS2:RET                     ;EXIT
	;
CSC:	CALL	CLN_UP		;FINISH OFF THE LINE
        JNC     PUSHCS2         ;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
SRESTR1:ACALL   DP_B            ;GET THE STARTING ADDRESS
	ACALL	T_DP		;PUT STARTING ADDRESS IN TEXT POINTER
	CALL	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:	CALL	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:	CALL	CLN_UP		;FINISH OFF THE LINE, IF AT END
	;
SRD2:	ACALL	X_TR		;RESTORE POINTERS
	CALL	VAR_ER		;GET VARIABLE ADDRESS
	CALL	XPOP		;FLIP THE REGISTERS FOR POPAS
	ACALL	C_TST		;SEE IF A COMMA
	JNC	SREAD		;READ AGAIN IF A COMMA
SRD21:  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
SRD51:  ACALL   X_TR            ;GET THE TEXT POINTER BACK
	MOV	DPTR,#E14X	;READ ERROR
	;
EK:	LJMP	ERROR
	;
SRD6:	ACALL	FINDCR		;WASTE THIS LINE
	CALL	CLN_UP		;CLEAN IT UP
        JC      SRD51           ;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,#'@',SRD21    ;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   SPRINT2         ;PROCEED
SPRINT1:ANL     35,#11110101B   ;CLEAR COB AND LPB
	ANL	38,#00111111B	;NO HEX MODE
	;
	RET
	;
SPRINT2: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,#'$',SM01
	CALL	CNX		;PUT THE CHARACTER ON THE STACK
	ACALL	IFIXL		;PUT THE CHARACTER IN R1
        SJMP    SM02
SM01:   ACALL   ONE             ;EVALUATE THE EXPRESSION, PUT IN R3:R1
	ACALL	ERPAR
SM02:   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,SX1        ;SEE IF AT LEAST A THREE
SX1:    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   DELTST1         ;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
	CALL	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
	CALL	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:	CALL	EXPRB		;MUST BE AN EXPRESSION
	MOV	A,#72
        CJNE    A,PHEAD,SA1     ;CHECK PHEAD POSITION
SA1:    JNC     SA2
	ACALL	SP0		;FORCE A CRLF
SA2:    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_BASE11       ;PRINT HEXMODE
	AJMP	SP2
OOPS:	CALL	ANEG		;MAKE IT NEGATIVE
	;
S13:    CALL    FP_BASE7        ;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   DIGIT_CHECK     ;CHECK FOR DIGIT
        JC      AL2             ;EXIT IF VALID DIGIT
        CJNE    A,#'_',AL       ;SEE IF A _
	RET
	;
AL:     CJNE    A,#'A',AL1      ;IS IT AN ASCII A?
AL1:    JC      AL3             ;EXIT IF CARRY IS SET
        CJNE    A,#'Z'+1,AL2    ;IS IT LESS THAN AN ASCII Z
AL2:    CPL     C               ;FLIP CARRY
AL3:    RET
	;
SD01:   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     VAR11           ;ERROR IF IN DIM
	JB	F0,SD0
	RET
VAR11:  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     SD01            ;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
	CALL	VAR_ER		;GET THE VARIABLE
	CALL	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
	;
	;***************************************************************
	;
	CALL	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
	;
	;**************************************************************
	;
	CALL	EXPRB
	MOV	R7,#','		;WASTE THE COMMA
	CALL	WE
	JMP	TWOL		;EXIT
	;
	;*************************************************************
	;
ONE:	; Evaluate an expression and get an integer
	;
	;*************************************************************
	;
	CALL	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	MPAGE,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,GCI11
	INC	R2
GCI11:  CLR     RS0
	RET			;EXIT
	;
$EJECT
	;**************************************************************
	;
	; Check delimiters
	;
	;**************************************************************
	;
DELTST:	ACALL	GC		;GET A CHARACTER
DELTST1: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
	;
FNDCL3: ACALL   GCI1
	;
WCR:	CALL	DELTST		;WASTE UNTIL A "REAL" CR
        JNZ     FNDCL3
	RET
	;
$EJECT
	;***************************************************************
	;
	; VAR_ER - Check for a variable, exit if error
	;
	;***************************************************************
	;
VAR_ER:	CALL	VAR
        SJMP    INTERR1
	;
	;
	;***************************************************************
	;
	; S_D0 - The Statement Action Routine DO
	;
	;***************************************************************
	;
S_DO:	CALL	CSC		;FINISH UP THE LINE
	MOV	R4,#DTYPE	;TYPE FOR STACK
	CALL	SGS1		;SAVE ON STACK
	JMP	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
	JMP	GCI1		;BUMP POINTER AND EXIT, IF SO
	;
C_1:	CJNE	A,#T_ELSE,EP5
	CALL	WCR		;WASTE UNTIL A CR
	;
CLN_UP:	CALL	GC		;GET THE CHARACTER
	CJNE	A,#CR,C_2	;SEE IF A CR
	CALL	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,B_TXA1
	RET
B_TXA1: 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
INTERR1:JC      EP5             ;ERROR IF NOT FOUND
	RET			;EXIT IF FOUND
	;
INTGER:	CALL	DP_T
        CALL    FP_BASE9        ;CONVERT THE INTEGER
	CALL	T_DP
	MOV	DPH,R2		;PUT THE RETURNED VALUE IN THE DPTR
	MOV	DPL,R0
	;
ITRET:	RET			;EXIT
	;
	;
WE:	CALL	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     EP21
        LJMP    E1XX2
EP21:   MOV     A,ASTKA         ;GET THE ARG STACK
	SUBB	A,#LOW TM_TOP+12;NEED 12 BYTES ALSO
        JNC     EP22
	LJMP	E4YY
EP22:   JB      ARGF,EP4        ;MUST BE AN OPERATOR, IF SET
	CALL	VAR		;IS THE VALUE A VARIABLE?
	JNC	EP3		;PUT VARIABLE ON STACK
	;
	CALL	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:	CALL	PUSHAS		;SAVE VAR ON STACK
	;
EP4:	CALL	GC		;GET THE OPERATOR
	;
        CJNE    A,#T_LPAR,EP41  ;IS IT AN OPERATOR
EP41:   JNC     XOP             ;PROCESS OPERATOR
        CJNE    A,#T_UOP,EP42   ;IS IT A UNARY OPERATOR
EP42:   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    E1XX1
	;
	; 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,XOP11    ;SEE WHICH HAS HIGHER PRECEDENCE
	CJNE	A,#12,ITRET	;SEE IF ANEG
	SETB	C
XOP11:  JNC     ITRET           ;PROCESS NON-INCREASING PRECEDENCE
	;
	; Save increasing precedence
	;
	PUSH	R5B0		;SAVE OLD PRECEDENCE ADDRESS
	PUSH	R2B0		;SAVE NEW PRECEDENCE ADDRESS
	CALL	GCI1		;EAT THE OPERATOR
	CALL	EP1		;EVALUATE REMAINING EXPRESSION
XOP12:  POP     ACC
	;
	; R2 has the action address, now setup and perform operation
	;
XOP2:	MOV	DPTR,#OPTAB
	ADD	A,#LOW (NOT OPBOL)
;	push	psw
;	push	acc
;	call	0F97Dh		;parser MSC1210
;	pop	acc
;	pop	psw

	CALL	ISTA1		;SET UP TO RETURN TO EP2
	JMP	EP2		;JUMP TO EVALUATE EXPRESSION
	;
	; Built-in operator processing
	;
XBILT:	
	CALL	GCI1		;EAT THE TOKEN
	ADD	A,#LOW (50H+LOW UOPBOL)

	JB	ARGF,EP5	;XBILT MUST COME AFTER AN OPERATOR
	jc	XOP2
	clr	c
        CJNE    A,#STP,XBILT1
XBILT1: JNC     XOP2
	;
XLPAR:	PUSH	ACC		;PUT ADDRESS ON THE STACK
	CALL	P_E
        SJMP    XOP12           ;PERFORM OPERATION
	;
XOP3:	CJNE	A,#T_ADD-T_LPAR,EP5
	CALL	GCI1
	JMP	EP2		;WASTE + SIGN
	;
$EJECT
XPOP:	CALL	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
	;
	;***************************************************************
	;
	CALL	ONE		;GET THE EXPRESSION
	SJMP	POPAS		;SAVE IT
	;
	;
	;***************************************************************
	;
LD_A:	; Load at expression
	;
	;***************************************************************
	;
	CALL	ONE		;GET THE EXPRESSION
	CALL	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     AXBYTE1         ;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,FPTST1    ;UNDERFLOW
	MOV	DPTR,#E7X
FPTST1: JNB     ACC.1,FPTS      ;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,CLIST1 ;CHECK FOR TERMINATION ADDRESS '-'
	ACALL	INC_ASTKA	;WASTE 0FFFFH
	LCALL	INTERR		;GET TERMINATION ADDRESS
	ACALL	TWO_EY		;PUT TERMINATION ON THE ARG STACK
CLIST1: 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
        CALL   PMTOP1          ;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:	JMP	CMND1		;BACK TO COMMAND PROCESSOR
	;
CL6:	MOV	DPTR,#IBUF	;PRINT IBUF
	CALL	PRNTCR		;PRINT IT
	CALL	DP_T
	;
CL7:	JMP	CRLF
	;
UPPL0:  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_BASE8        ;CONVERT R2:R0 TO INTEGER
	CALL	DP_T
	INC	DPTR		;BUMP DPTR PAST THE LINE NUMBER
	;
UPP0:   CJNE    R1,#LOW IBUF+6,UPP01
UPP01:  JC      UPP91           ;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,UPP02    ;TRAP THE USER TOKENS
UPP02:  JNC     UPP03
	CJNE	A,#CR,UPP1	;DO IT IF NOT A CR
UPP03:  CJNE    A,#'"',UPP9     ;SEE IF STRING
	ACALL	UPP7		;SAVE IT
UPP04:  ACALL   UPP8            ;GET THE NEXT CHARACTER AND SAVE IT
        CJNE    A,#'"',UPP04    ;LOOP ON QUOTES
	SJMP	UPP0
	;
UPP9:	CJNE	A,#':',UPP1A	;PUT A SPACE IN DELIMITER
	ACALL	UPP7A
	MOV	A,R6
	ACALL	UPP7
UPP91:  ACALL   UPP7A
	SJMP	UPP0
	;
UPP1A:  ACALL   UPP81           ;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
UPP11:  MOV     DPTR,#TOKTAB    ;POINT AT TOKEN TABLE
	JNB	F0,UPP2
	LCALL	GET_USR_LVECTOR	;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,UPP11        ;NOW DO NORMAL TABLE
	JMP	CMND1		;EXIT IF NOT FOUND
	;
UP_2:	CJNE	A,R6B0,UPP2	;LOOP UNTIL THE SAME
	;
UP_3:   CJNE    A,#T_UOP,UP_4
UP_4:   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     UPP42
UPP41:  ACALL   UPP8
        SJMP    UPP41
UPP42:  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:   JMP    PPL91           ;SAVE A
	;
UPP8:	INC	DPTR
	MOVX	A,@DPTR
UPP81:  CJNE    A,#CR,UPP7
        JMP    PPL71
	;
$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
	CALL	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      ASIN1
	ACALL	PIPI
	CALL	ASUB
ASIN1:  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
	CALL	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_BASE3
	AJMP	FPTST
	;
	;*************************************************************
	;
RV:	; Reduce a value for Trig and A**X functions
	;
	; value = (value/x - INT(value/x)) * x
	;
	;*************************************************************
	;
        ACALL   C2_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
	CALL	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    AI11            ;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     AATAN1          ;SEE IF > 1
	ACALL	RECIP		;IF > 1, TAKE RECIP
AATAN1: 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
	CALL	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_BASE2        ;DO THE COMPARE
	;
	;*************************************************************
	;
DEC_ASTKA:	;Push ARG STACK and check for underflow
	;
	;*************************************************************
	;
	MOV	A,#-FPSIZ
	ADD	A,ASTKA
        CJNE    A,#LOW TM_TOP+6,DEC_ASTKA1
DEC_ASTKA1:
        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 	Data24,a
	mov	Data32,a
	MOV	R0,ASTKA	;GET THE ARG STACK
	MOV	MPAGE,#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_BASE10       ;ACCUMULATE
	JC	SQ_ERR
        DJNZ    R4,I21
	SJMP	INC_ASTKA
I21:    MOVX    A,@R0           ;GET DIGIT
        CALL    FP_BASE10
	JC	SQ_ERR
	DJNZ	R4,I2
	clr	Use32BitConv
	;
$EJECT
	;************************************************************
	;
INC_ASTKA:	; Pop the ARG STACK and check for overflow
	;
	;************************************************************
	;
	MOV	A,#FPSIZ	;NUMBER TO POP
        SJMP    SETREG1
	;
SETREG:	CLR	A		;DON'T POP ANYTHING
SETREG1:MOV     R0,ASTKA
	MOV	R2,#ASTKAH
	MOV	MPAGE,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   C2_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   C2_T2           ;COPY VARIABLE TO T2
	ACALL	POP_T1		;SAVE IT IN T1
	MOV	R0,#LOW FPT1
	MOVX	A,@R0		;GET EXPONENT
        JZ      SQR41           ;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
	CALL	AADD		;TOS = X/GUESS + GUESS
	ACALL	DBTWO		;TOS = ( X/GUESS + GUESS ) / 2
	ACALL	TEMP_COMP	;SEE IF DONE
	JNB	F0,SQR4
	;
SQR41:  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,ALN1     ;SEE IF NUM >= 1
ALN1:   MOV     UBIT,C          ;SAVE CARRY STATUS
        JC      ALNL            ;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   C2_T2           ;PUT NUM IN TEMP 2
	ACALL	PUSH_ONE	;TOS = 1
	CALL	ASUB		;TOS = X - 1
	ACALL	P_T2		;TOS = X
	ACALL	PUSH_ONE	;TOS = 1
	CALL	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
	CALL	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_BASE2        ;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      AEXP1
	ACALL	ALN		;TOS = LN(BASE)
AEXP1:  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
	CALL	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
AI11:   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,AI21
	RET
AI21:   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
AXBYTE1:MOV     MPAGE,R3
	MOVX	A,@R1
	AJMP	TWO_R2
	;***************************************************************
	;
ASFR: 	; Read SFR memory
	;
	;***************************************************************
	;
	ACALL	IFIX		;GET THE EXPRESSION
ASFR1:	CALL	R3CK		;MAKE SURE R3 = 0
	call	GetSFR
	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
AGT1:   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
ALT1:   CPL     C
        SJMP    AGT1
	;
AEQ:	ACALL	CMPLK
AEQ1:   MOV     C,F0
        SJMP    ALT1
	;
ANE:	ACALL	CMPLK
	CPL	F0
        SJMP    AEQ1
	;
AGE:	ACALL	CMPLK
        SJMP    AGT1
	;
ALE:	ACALL	CMPLK
	ORL	C,F0
        SJMP    ALT1
	;
$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_BASE4
	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_T12
	;
PLNEXP:	MOV	DPTR,#EXP1
	;
	;***************************************************************
	;
	; PUSHC - Push constant on to the arg stack
	;
	;***************************************************************
	;
PUSHC:	ACALL	DEC_ASTKA
	MOV	MPAGE,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
PUSH_T11:
        MOV     R2,#HIGH FPT1
PUSH_T12:
        LJMP    PUSHAS
	;
P_T2:	MOV	R0,#LOW FPT2
        SJMP    PUSH_T11                ;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
	;
C2_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	MPAGE,R2	;SET UP THE PORTS
	MOVX	A,@R0		;READ THE VALUE
	MOV	MPAGE,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
	;
	clr	Use32BitConv	;reset for only 16 bit conversion
	;
TWO_EY:	SETB	ARGF		;R2:R0 GETS PUT ON THE STACK
        JMP     FP_BASE12       ;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:  MOV     R2,TH2
        MOV     R0,TL2
;       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: MOV     A,T2CON
;       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: MOV     R2,RCAPH2
        MOV     R0,RCAPL2
;       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:  MOV     A,PCON
;       DB      0E5H            ;MOV A, DIRECT OP CODE
;       DB      87H             ;ADDRESS OF PCON
	SJMP	TWO_R2		;PUT PCON ON THE STACK
	;
AADCR: 	mov	Data32,#0
	mov	Data24,ADRESH
	MOV     R2,ADRESM
        MOV     R0,ADRESL
	setb	Use32BitConv
	SJMP	TWO_EY
	;
AGPWM: 	MOV     R2,PWMHIGH
        MOV     R0,PWMLOW
	SJMP	TWO_EY
	;
AADCDEC:MOV     R2,ADCON3
        MOV     R0,ADCON2
	SJMP	TWO_EY
	;
AOFFSET:mov	Data32,#0
	mov	Data24,OCH
	MOV     R2,OCM
        MOV     R0,OCL
	setb	Use32BitConv
	SJMP	TWO_EY
	;
AGAIN:	mov	Data32,#0
	mov	Data24,GCH
	MOV     R2,GCM
        MOV     R0,GCH
	setb	Use32BitConv
	SJMP	TWO_EY
	;
ASUM:	mov	Data32,SUMR0
	mov	Data24,SUMR2
	MOV     R2,SUMR1
        MOV     R0,SUMR0
	setb	Use32BitConv
	SJMP	TWO_EY
	;
GetSFRHigh: 
	push	r7b0
	mov	r7b0,r2
	call	GetSFRByte
	anl	MCON,#0feh
	mov	r2,r7b0
GetSFRLow: 
	push	r7b0
	mov	r7b0,r0
	call	GetSFRByte
	anl	MCON,#0feh
	mov	r0,r7b0
	ret
        ;
GetSFR:
	push	r7b0
	push	dpl
	push	dph
	mov	r7b0,r1
	call	GetSFRByte
	anl	MCON,#0feh
	mov	a,r7
	pop	dph
	pop	dpl
	pop	r7b0
	ret
	;
SetSFR:	push	r5b0
	push	r7b0
	push	dpl
	push	dph
	mov	r5,a
	mov	r7b0,r1
	call	SetSFRByte
	anl	MCON,#0feh
	pop	dph
	pop	dpl
	pop	r7b0
	pop	r5b0
	ret
	;

GetSFRbyte:
	mov	a,#0afh		;mov	r7,xx
	sjmp	SFRbyte_mode
SetSFRbyte:
	mov	a,#8dh		;mov	xx,r5
SFRbyte_mode:
	push	acc
	orl	MCON,#1
	mov	a,FMCON
	mov	dpl,#JUMPSFR
	jb	acc.0,SFRbyte_FPM
	mov 	dph,#84h
;	mov	dptr,#8400h	;original BootRom has 087fdh
	sjmp	SFRbyte_SaveToXRAM
SFRbyte_FPM:
	mov 	dph,#78h
;	mov	dptr,#7800h     ;original BootRom has 07ffdh
SFRbyte_SaveToXRAM:
	pop	acc
	movx	@dptr,a
	inc	dptr
	mov	a,r7
	movx	@dptr,a
	inc	dptr
	mov	a,#22h		;ret
	movx	@dptr,a
	mov	a,FMCON
	mov	dpl,#JUMPSFR
	jb	acc.0,SFRbyte_FPMCall
	clr	a
	jmp	@a+dptr
SFRbyte_FPMCall:
	clr	a
	jmp	@a+dptr

$EJECT
	;***************************************************************
	;
	;THIS IS THE LINE EDITOR
	;
	;TAKE THE PROCESSED LINE IN IBUF AND INSERT IT INTO THE
	;BASIC TEXT FILE.
	;
	;***************************************************************
	;
LINE0:  LJMP    NOGO            ;CAN'T EDIT A ROM
	;
LINE:	MOV	A,BOFAH
        CJNE    A,#HIGH PSTART,LINE0
	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,LINE1     ;SEE IF NO ENTRY
	RET			;RET IF NO ENTRY
	;
LINE1:  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,INSR1    ;SEE IF NULL
	CLR	A
	;
INSR1:  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,LTX1     ;DO NO INSERTATION IF NULL LINE
	RET			;EXIT IF IT IS
	;
LTX1:   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,LTX2     ;NEED TO BUMP HIGH BYTE?
	INC	R7
	;
LTX2:   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      GTX1            ;IF ACC WAS ZERO FROM NMOV, JUMP
	ACALL	LMOV		;IF NO ZERO DO A LMOV
	;
GTX1:   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
	CALL	DEC76		;BUMP R7:R6
	JNZ	LMOV		;LOOP
	RET			;GO BACK TO CALLING ROUTINE
	;
INC3210:INC	R0
        CJNE    R0,#00H,INC3211
	INC	R2
	;
INC3211:INC     R1
        CJNE    R1,#00H,INC3212
	INC	R3
INC3212: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
	CALL	DEC76		;BUMP THE COUNTER
	JNZ	RMOV		;LOOP
	;
DEC_R:	NOP			;CREATE EQUAL TIMING
	RET			;EXIT
	;
DEC3210:DEC	R0		;BUMP THE POINTER
        CJNE    R0,#0FFH,DEC3212;SEE IF OVERFLOWED
DEC3211:DEC     R2              ;BUMP THE HIGH BYTE
DEC3212: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	MPAGE,R3	;OUTPUT SOURCE REGISTER TO PORT
	MOVX	A,@R1		;PUT BYTE IN ACC
	;
TBR:	MOV	MPAGE,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
NMOV1:  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      NMOV1           ;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:	CALL	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',PPL21
PPL21:  JC      PPX             ;CONVERT LOWER TO UPPER CASE
        CJNE    A,#('z'+1),PPL22
PPL22:  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,PPL41     ;KEEP SCANNING IF NOT A RESERVED WORD
	JNZ	PPL4
	INC	DPTR
	;
	; See if at the end of TOKTAB
	;
PPL41:  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	2478H		;SET UP POINTER
	AJMP	PPL1
	;
PPLY:	CALL	PPL7		;SAVE CHARACTER, EXIT IF A CR
	CJNE	A,#'"',PPL	;SEE IF QUOTED STRING, START AGAIN IF NOT
	;
	; Just copy a quoted string
	;
PPLY1:  CALL   PPL7            ;SAVE THE CHARACTER, TEST FOR CR
        CJNE    A,#'"',PPLY1    ;IS THERE AN ENDQUOTE, IF NOT LOOP
	SJMP	PPL		;DO IT AGAIN IF ENDQUOTE
	;
PPL6:	MOV	A,R7		;GET THE TOKEN
        CALL   PPL91           ;SAVE THE TOKEN
	CJNE	A,#T_REM,PPL	;SEE IF A REM TOKEN
	MOV	A,R3
        CALL   PPL71           ;WASTE THE REM STATEMENT
PPL61:  CALL   PPL7            ;LOOP UNTIL A CR
        SJMP    PPL61
	;
PPL7:	MOVX	A,@R0		;GET THE CHARACTER
PPL71:  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
PPL91:  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,DEC77  ;SEE IF RAPPED AROUND
	DEC	R7
DEC77:  MOV     A,R7            ;SEE IF ZERO
	ORL	A,R6
	RET			;EXIT
	;
	;***************************************************************
	;
	; MTOP - Get or Put the top of assigned memory
	;
	;***************************************************************
	;
PMTOP:	MOV	DPTR,#MEMTOP
PMTOP1: CALL    L20DPI
	JMP	TWO_EY		;PUT R2:R0 ON THE STACK
	;
$EJECT
	;*************************************************************
	;
	; AXTAL - Crystal value calculations
	;
	;*************************************************************
	;
AXTAL0:	MOV	DPTR,#XTALV	;CRYSTAL VALUE
	CALL	PUSHC
	;
AXTAL1:	CALL	CSTAKA2		;COPY CRYSTAL VALUE TWICE
	CALL	CSTAKA
	MOV	DPTR,#PTIME	;PROM TIMER
	CALL	AXTAL2
	MOV	DPTR,#PROGS
	CALL	S31L
	MOV	DPTR,#IPTIME	;IPROM TIMER
	CALL	AXTAL2
	MOV	DPTR,#IPROGS
	CALL	S31L
	MOV	DPTR,#TTIME	;CLOCK CALCULATION
	CALL	AXTAL3
	MOV	A,R1
	CPL	A
	INC	A
	MOV	SAVE_T,A
	MOV	R3,#HIGH CXTAL
	MOV	R1,#LOW CXTAL
	JMP	POPAS
	;
AXTAL2:	CALL	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
	CALL	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
	CALL	DEC76
	JNB	TF1,$		;WAIT
	CALL	ALPAR
	SETB	T_BIT		;BACK TO A ONE
        CALL    TIMER_LOAD1     ;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
	CALL	TWO_R2		;TOS = 12
	CALL	AMUL		;TOS = 12*BAUD
	CALL	ADIV		;TOS = XTAL/(12*BAUD)
	CALL	IFIX
	CALL	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
	CALL	TWO_EY
	;
ASUB:   LCALL   FP_BASE1        ;DO FP SUB
	JMP	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
	JMP	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
	CALL	TWO_EX		;PUT TIMER ON THE STACK
	POP	ACC		;GET MILLI
	CALL	TWO_R2		;PUT MILLI ON STACK
	MOV	A,#200
	CALL	TWO_R2		;DIVIDE MILLI BY 200
	CALL	ADIV
	;
AADD:	LCALL	FP_BASE		;DO FP ADDITION
	JMP	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
	CALL	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   SPRINT1         ;WASTE AT AND HEX
	CLR	XBIT		;TO RESET IF NEEDED
	CLR	A
	MOV	DPTR,#TAG_LOCATION ;CHECK FOR EXTERNAL TRAP PACKAGE
	MOVC	A,@A+DPTR
        CJNE    A,#5AH,CMND11
	LCALL	COMMAND_M_ENTRY	;IF PRESENT JUMP TO LOCATION 200BH
CMND11: 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
	CALL	CL7		;DO A CRLF
	;
CMNX:	CLR	GTRD		;CLEAR BREAK
	MOV	DPTR,#5EH	;DO RUN TRAP
	MOVX	A,@DPTR
	XRL	A,#52
        JNZ     CMNX1
	LJMP	CRUN
CMNX1:  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,CMND31;PROCESS STATEMENT IF NOT A COMMAND
CMND31: 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:  ORL     PCON,#01H
;       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
E1XX1:  MOV     DPTR,#E1X       ;ERROR MESSAGE
        SJMP    ERROR1          ;TRAP ON SET DIRF
	;
E1XX2:  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
ERROR1: MOV     SP,SPSAV        ;RESET THE STACK
        LCALL   SPRINT1         ;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      ERROR01         ;NO RESET IF CARRY IS SET
	LCALL	RC1		;RESET THE STACKS
ERROR01: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    PMTOP1          ;LOAD R2:R0, PUT IT ON THE STACK
        ACALL   FP_BASE7        ;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
ER31:   MOV     R5,#'-'         ;OUTPUT DASHES, THEN AN X
	ACALL	T_L		;PRINT AN X IF ERROR CHARACTER FOUND
        DJNZ    MT1,ER31        ;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
OTST1:  RET
	;
$EJECT
	;**************************************************************
	;
	; IBLK - EXECUTE USER SUPPLIED TOKEN
	;
	;**************************************************************
	;
IBLK:   JB      PSW.4,OTST1     ;EXIT IF REGISTER BANK <> 0
        JB      PSW.3,OTST1
        JBC     ACC.7,IBLK1     ;SEE IF BIT SEVEN IS SET
	MOV	DPTR,#USENT	;USER ENTRY LOCATION
	LJMP	ISTA1
	;
IBLK1:  JB      ACC.0,FP_BASE6  ;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_BASE5        ;SCAN FOR HEX
        JNC     FP_BASE6        ;DO FP INPUT
	;
        ACALL   FP_BASE9        ;ASCII STRING TO R2:R0
	JNZ	H_RET
	PUSH	DPH		;SAVE THE DATA_POINTER
	PUSH	DPL
        ACALL   FP_BASE12       ;PUT R2:R0 ON THE STACK
	POP	DPL		;RESTORE THE DATA_POINTER
	POP	DPH
	CLR	A		;NO ERRORS
	RET			;EXIT
	;
$EJECT

	; START OF BAUD RATE MODIFICATIONS BY DANIEL WALLNER
TIB1:MOV	ACC,TL2
	JB	ACC.3,TIB1
	CALL    DEC3211
TIB2:	MOV	ACC,TL2
	JNB	ACC.3,TIB2
	JNB	RXD,TIB1		;16x12 CLOCKS, LOOP UNTIL DONE
	JB	RXD,$		;WAIT FOR STOP CHARACTER TO END
	RET

	;**************************************************************
	;
	; 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	'T'+80H,'I'+80H,' ','2'+80H,'0'+80H
;	DB	'0','2'+80H,' '+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
	;
OUTPUT:
T_L:    LJMP    TEROT
	;
	;
$EJECT


;************************************************************
;
; 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
;OUTPUT          EQU     1990H   ;CALL LOCATION TO OUTPUT A CHARACTER
CONVERT         EQU     58H     ;LOCATION TO CONVERT NUMBERS
INTGRC          BIT     25      ;BIT SET IF INTGER ERROR
;
;***********************************************************************
;
; The following equates are used internally
;
;***********************************************************************
;
FP_NUMBER_SIZE	EQU	6
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
	;
	;**************************************************************
	;
FP_BASE:        AJMP    FLOATING_ADD
FP_BASE1:       AJMP    FLOATING_SUB
FP_BASE2:       AJMP    FLOATING_COMP
FP_BASE3:       AJMP    FLOATING_MUL
FP_BASE4:       AJMP    FLOATING_DIV
FP_BASE5:       AJMP    HEXSCAN
FP_BASE6:       AJMP    FLOATING_POINT_INPUT
FP_BASE7:       AJMP    FLOATING_POINT_OUTPUT
FP_BASE8:       JMP     CONVERT_BINARY_TO_ASCII_STRING
FP_BASE9:       JMP     CONVERT_ASCII_STRING_TO_BINARY
FP_BASE10:      JMP     MULNUM10
FP_BASE11:      JMP     HEXOUT
FP_BASE12:      AJMP    PUSHR2R0
	;
$EJECT
	;
FLOATING_SUB:
	;
	MOV	MPAGE,#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,LOAD21
	SETB	ADD_IN
	;
$EJECT
	; Load the R1 mantissa
	;
LOAD21: 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,LOAD22
LOAD22: JC      LOAD23
	MOV	R7,#DIGIT+DIGIT+2
	;
LOAD23: 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     LOAD24
	MOV	R4,A
LOAD24: CJNE    A,#50H,LOAD25   ;TEST FOR SUBTRACTION
LOAD25: 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,FSUB81
FSUB81: 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    ARG1_EXP_IS_LARGER1
	;
ARG1_EXP_IS_LARGER:
	;
	MOV	A,R4		;GET THE SIGN OF ARG1 EXPONENT
ARG1_EXP_IS_LARGER1:
        JZ      ARG1_EXP_IS_LARGER2
	CPL	C
ARG1_EXP_IS_LARGER2:
        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,FMUL1    ;ARG 2 EXP ZERO?
FMUL0:  AJMP    ZERO_AND_EXIT
	;
	; calculate the exponent
	;
FMUL1:	MOV	FP_SIGN,R5	;SAVE THE SIGN, IN CASE OF FAILURE
	;
	MOV	A,R7
        JZ      FMUL0
	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      FMUL0           ;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,PACK11   ;SEE IF ADJUSTING NEEDED
PACK11: JC      PACK31
	;
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
PACK31: 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
RIGHT2: MOV     A,R7            ;GET THE DIGITS TO SHIFT
        JZ      RIGHTL1         ;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
RIGHTL1: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    RIGHT2
	;
$EJECT
	;***************************************************************
	;
LEFT:	; Shift ACCUMULATOR LEFT the number of nibbles in R7
	;
	;***************************************************************
	;
	MOV	R4,#00H		;CLEAR FOR SOME ENTRYS
	;
LEFT1:	CLR	C
LEFT2:  MOV     A,R7            ;GET SHIFT VALUE
        JZ      LEFTL1          ;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
LEFTL1: 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    LEFT2
	;
$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	MPAGE,#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
	CALL	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,HEX_CHECK1     ;SEE IF F OR LESS
HEX_CHECK1:
        JC      HC1
	RET
	;
HC1:    CJNE    A,#'A',HC11     ;SEE IF A OR GREATER
HC11:   CPL     C
	RET
	;
$EJECT
	;
PUSHR2R0:
	; 
        MOV     R3,#HIGH CONVERT;CONVERSION LOCATION
        MOV     R1,#LOW CONVERT
	CALL	CONVERT_BINARY_TO_ASCII_STRING
	MOV	A,#0DH		;A CR TO TERMINATE
	MOVX	@R1,A		;SAVE THE CR
        MOV     DPTR,#CONVERT
	;
	; 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:	CALL	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',GT11     ;CHECK FOR LOWER CASE
        SJMP    GT12
GT11:   CJNE    A,#'E',FINISH_UP
GT12:   ACALL   INC_AND_GET_DPTR_CHARACTER
	ACALL	PLUS_MINUS_TEST
	MOV	XSIGN,C		;SAVE SIGN STATUS
	CALL	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
	CALL	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,FINISH_UP1
	ACALL	FP_CLEAR	;CLEAR THE MEMORY IF 0
FINISH_UP1:
        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,PMT11   ;SEE IF A PLUS, PLUS TOKEN FROM BASIC
	SJMP	PMT3
PMT11:  CJNE    A,#'+',PMT12
	SJMP	PMT3
PMT12:  CJNE    A,#0E5H,PMT13   ;SEE IF MINUS, MINUS TOKEN FROM BASIC
	SJMP	PMT2
PMT13:  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,FPO1    ;SEE IF EXPONENTIAL
FPO1:   JNC     EXPOUT_J
	;
	; If here, must be integer USING format
	;
	MOV	A,R6		;GET THE EXPONENT
        JNZ     FPO2
	MOV	R6,#80H
FPO2:   MOV     A,R3            ;GET THE FORMAT
	SWAP	A		;SPLIT INTEGER AND FRACTION
	ANL	A,#0FH
	MOV	R2,A		;SAVE INTEGER
	CALL	NUM_LT		;GET THE NUMBER OF INTEGERS
	XCH	A,R2		;FLIP FOR SUBB
	CLR	C
	SUBB	A,R2
	MOV	R7,A
        JNC     FPO3
	MOV	R5,#'?'		;OUTPUT A QUESTION MARK
	CALL	SOUT1		;NUMBER IS TOO LARGE FOR FORMAT
	JMP	FREE
FPO3:   CJNE    R2,#00,USING0   ;SEE IF ZERO
	DEC	R7
	CALL	SS7
	CALL	ZOUT		;OUTPUT A ZERO
	SJMP	USING1
	;
EXPOUT_J:
	jmp	EXPOUT
	;
USING0:	CALL	SS7		;OUTPUT SPACES, IF NEED TO
	MOV	A,R2		;OUTPUT DIGITS
	MOV	R7,A
	CALL	OUTR0
	;
USING1:	MOV	A,R3
	ANL	A,#0FH		;GET THE NUMBER RIGHT OF DP
	MOV	R2,A		;SAVE IT
	JZ	PMT1		;EXIT IF ZERO
	CALL	ROUT		;OUTPUT DP
	CALL	NUM_RT
	CJNE	A,2,USINGX	;COMPARE A TO R2
	;
USINGY:	MOV	A,R2
	JMP	Z7R7
	;
USINGX:	JNC	USINGY
	;
USING2:	XCH	A,R2
	CLR	C
	SUBB	A,R2
	XCH	A,R2
	CALL	Z7R7		;OUTPUT ZEROS IF NEED TO
	MOV	A,R2
	MOV	R7,A
	JMP	OUTR0
	;
	; First, force exponential output, if need to
	;
FREE:	MOV	A,R6		;GET THE EXPONENT
	JNZ	FREE1		;IF ZERO, PRINT IT
	CALL	SOUT
	JMP	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
	;
	CALL	SINOUT		;PRINT THE SIGN OF THE NUMBER
	CALL	NUM_LT		;GET THE NUMBER LEFT OF DP
	CJNE	A,#8,FREE4
	JMP	OUTR0
	;
FREE4:	CALL	OUTR0
	CALL	ZTEST		;TEST FOR TRAILING ZEROS
	JZ	U_RET		;DONE IF ALL TRAILING ZEROS
	CALL	ROUT		;OUTPUT RADIX
	;
FREE2:	MOV	R7,#1		;OUTPUT ONE DIGIT
	CALL	OUTR0
	JNZ	U_RET
	CALL	ZTEST
	JZ	U_RET
	SJMP	FREE2		;LOOP
	;
EXPOUT:	CALL	SINOUT		;PRINT THE SIGN
	MOV	R7,#1		;OUTPUT ONE CHARACTER
	CALL	OUTR0
	CALL	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
	CALL	OUTR0
	SJMP	EXPOT4
	;
EXPOTX:	CALL	FREE2		;OUTPUT UNTIL TRAILING ZEROS
	;
EXPOT4:	CALL	SOUT		;OUTPUT A SPACE
	MOV	R5,#'E'
	CALL	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:	CALL	SOUT
	CLR	A
	SJMP	XOUT4
	;
XOUT2:	JC	XOUT3		;NEGATIVE EXPONENT
	MOV	R5,#'+'		;OUTPUT A PLUS SIGN
	CALL	SOUT1
	SJMP	XOUT4
	;
XOUT3:	CALL	MOUT
	CPL	A		;FLIP BITS
	INC	A		;BUMP
	;
XOUT4:	CLR	ACC.7
	MOV	R0,A
	MOV	R2,#0
        MOV     R1,#LOW CONVERT ;CONVERSION LOCATION
        MOV     R3,#HIGH CONVERT
	CALL	CONVERT_BINARY_TO_ASCII_STRING
        MOV     R0,#LOW CONVERT ;NOW, OUTPUT EXPONENT
	;
EXPOT5:	MOVX	A,@R0		;GET THE CHARACTER
	MOV	R5,A		;OUTPUT IT
	CALL	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
	CALL	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
	CALL	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:	CALL	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:	JMP	OUTPUT
	;
$EJECT
	;***************************************************************
	;
CONVERT_ASCII_STRING_TO_BINARY:
	;
	;DPTR POINTS TO ASCII STRING
	;PUT THE BINARY NUMBER IN R2:R0, ERROR IF >64K
	;
	;***************************************************************
	;
CASB:	CALL	HEXSCAN		;SEE IF HEX NUMBER
	MOV	ADD_IN,C	;IF ADD_IN IS SET, THE NUMBER IS HEX
	CALL	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     R2B0,R3         ;IN R2:R0
	CALL	GET_DIGIT_CHECK
	JC	CASB5
	JNB	ADD_IN,RCASB	;CONVERSION COMPLETE
	CALL	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
	push	B
	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
	mov	a,Data24
	mov	Data24,B
	pop	B
	jnb	Use32bitConv,MUL10
	push	B
	mul	ab
	mov	C,OV
	mov	F0,C
	add	a,Data24
	mov	Data24,a
	mov	a,Data32
	mov	Data32,B
	pop	B
	mul	ab
	mov	C,OV
	mov	F0,C
	add	a,Data32
	mov	Data32,a
	
MUL10:
	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
	jnb	Use32bitConv,MULX
	clr	a
	addc	a,Data24
	mov	Data24,a
	clr	a
	addc	a,Data32
	mov	Data32,a
	;
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
	;Data32:Data24 contains the value to convert
	;DPTR, R7, R6, and ACC gets clobbered
	;
	;***************************************************************
	;
	clr	A
	push	r4b0
	push	r5b0
	mov	DPL,A
	mov	DPH,A
	mov	R4,A
	mov	R5,A
	mov	R6,A
	mov	R7,#32
	clr	NoZero
	jb	Use32BitConv,RSub1
	mov	Data24,a
	mov	Data32,a
RSub1:	clr	C
	mov	a,r0
	rlc	a
	mov	r0,A
	mov	a,r2
	rlc	a
	mov	r2,a
	mov	a,Data24
	rlc	a
	mov	Data24,a
	mov	a,Data32
	rlc	a
	mov	Data32,a
	mov	a,DPL
	addc	a,acc
	da	a
	mov	DPL,A
	mov	A,DPH
	addc	a,acc
	da	a
	mov	DPH,a
	mov	a,r4
	addc	a,acc
	da	a
	mov	r4,a
	mov	a,r5
	addc	a,acc
	da	a
	mov	r5,a
	mov	a,r6
	addc	a,acc
	da	a
	mov	r6,a
	djnz	r7,RSub1
	jnb	Use32BitConv,RSub16b
	mov	a,r6
	call	RSubA1
	mov	a,r6
	call	RSubA2
	mov	a,r5
	call	RSubA1
	mov	a,r5
	call	RSubA2
RSub16b:
	mov	a,r4
	call	RSubA1
	mov	a,r4
	call	RSubA2
	mov	a,DPH
	call	RSubA1
	mov	a,DPH
	call	RSubA2
	mov	a,DPL
	call	RSubA1
	mov	a,DPL
	setb	NoZero
	call	RSubA2
	pop	r5b0
	pop	r4b0
	clr	Use32BitConv	;delete flag after conversion
	ret
;
;******* Old 16 bit routine *******************
;
;	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,RSUB11
;RSUB11: 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
;	;
RSubA1:	swap	a
RSubA2:	anl	a,#0fh
	jb	NoZero,RSub2
	jz	RSub3
	setb	NoZero
RSUB2:	add	A,#'0'		;GET THE ASCII BIAS and add the count
	;
RSUB4:	MOV	MPAGE,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
	;
	;***************************************************************
	;
	CALL	SOUT		;OUTPUT A SPACE
	MOV	C,ZSURP		;GET ZERO SUPPRESSION BIT
	MOV	ADD_IN,C
	MOV	A,R3		;GET HIGH NIBBLE AND PRINT IT
	CALL	HOUTHI
	MOV	A,R3
	CALL	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:	JMP	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
	;
	CALL	GET_DPTR_CHARACTER
	;
DIGIT_CHECK:	;CHECK FOR A VALID ASCII DIGIT, SET CARRY IF FOUND
	;
        CJNE    A,#'9'+1,DC10   ;SEE IF ASCII 9 OR LESS
DC10:   JC      DC1
	RET
	;
DC1:    CJNE    A,#'0',DC11     ;SEE IF ASCII 0 OR GREATER
DC11:   CPL     C
	RET
	;
ProgFlash:
	mov	c,EA
	mov	TmpEA,c
	clr	EA
	mov	AIE,#0
	mov	r4,a
	mov	a,r7
	push	acc
	mov	a,r6
	push	acc
	mov	a,r3
	push	acc
	mov	a,r0
	push	acc

	mov	a,r0
	mov	r7,a
	mov	a,r2
	mov	r6,a
	mov	a,r4
	mov	r5,a
	mov	r3,#1
	call	WriteToFlash_W

	pop	acc
	mov	r0,a
	pop	acc
	mov	r3,a
	pop	acc
	mov	r6,a
	pop	acc
	mov	r5,a
	mov	a,r7
	push	acc
	mov	a,r5
	mov	r7,a
	pop	acc
	
	mov	c,TmpEA
	mov	EA,c
	clr	c
	ret


;        ORG     1F78H
	;
CKS_I:	JB	CKS_B,CS_I
	LJMP	401BH
	;
CS_I:	LJMP	INTERRUPT_PWM
	;
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	'*MSC1210 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
JUMPSFR:ds	3
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


