;***************************************************************
;*
;*
;*      	TINY BASIC FOR INTEL 8086
;*
;*
;*      		VERSION: 1.1
;*
;*      			BY
;*
;*      		MICHAEL SULLIVAN
;*                              BASED
;*                               ON
;*                       LI-CHEN WANG'S
;*
;*                    8080 TINY BASIC
;*
;*
;*                    27 JUNE 1982
;*
;*		@COPYLEFT
;*		ALL WRONGS RESERVED
;*
;*	NOTE:
;*		8080 REGISTERS HAVE BEEN MAPPED AS FOLLOWS:
;*
;*		8080		8086
;*	-------------------------------------
;*
;*		BC	<->	CX
;*		DE	<->	DX
;*		HL	<->	BX
;*
;*
;*	VERS 1.1 - SUPPORT MS-DOS INTERUPT I/O
;*		   IMPROVE RND ACTION
;*		   SUPPORT TIME AND DATE FROM MS-DOS
;*
;**************************************************************
	;
	;
	ORG	100H	;STANDARD MS-DOS START ADDR.
START:
	MOV	SP,STACK	;SET UP STACK
	MOV	DX,MSG1	;GET SIGN-ON MSG
	CALL	PRTSTG	;SEND IT
	MOV	B,[BUFFER-2],80H ;INIT CMD LINE BUFFER
;
;	MAIN
;
; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
; AND STORES IT IN MEMORY.
;
; AT START, IT PRINTS OUT "(CR)OK(LF)", AND INITIALIZES THE
; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
; ">" AND READS A LINE. IF THE LINE STARTS WITH A NONZERO
; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING
; ITS (CR))IS STORED IN MEMORY. IF A LINE WITH THE SAME
; LINE NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW
; ONE. IF THE REST OF THE LINE CONSISTS OF A (CR) ONLY, IT
; IS STORED AND ANY EXISTING LINE WITH THE SAME LINE
; NUMBER IS DELETED.
;
; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE
; PROGRAM LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP
; WILL BE TERMINATED WHEN IT READS A LINE WITH ZERO OR NO
; LINE NUMBER: CONTROL IS THEN TRANSFERED TO "DIRECT".
;
; THE TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY
; LOCATION LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS
; FILL THIS AREA STARTING AT "TXTBGN", THE UNFILLED PORTION
; POINTED TO BY THE CONTENTS OF THE MEMORY LOCATION LABELED
; "TXTUNF".
;
; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE AR IN THIS
; LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
; (SEE NEXT SECTION), "CURRNT" SHOULD POINT TO A 0.
;
RSTART:
	MOV	SP,STACK	;SET STACK POINTER
ST1:
	CALL	CRLF
	MOV	DX,OK	;DE->STRING
	SUB	AL,AL
	CALL	PRTSTG	;PRINT PROMPT
	MOV	W,[CURRNT],0 ;CURRENT LINE # = 0
ST2:
	MOV	W,[LOPVAR],0
	MOV	W,[STKGOS],0
ST3:
	MOV	AL,'>'	;PROMPT ">" NOW
	CALL	GETLN	;READ A LINE
	PUSH	DI	;DI -> END OF LINE
ST3A:
	MOV	DX,BUFFER ;DX -> BEGINNING OF LINE
	CALL	TSTNUM	;TEST IF IT'S A NUMBER
	MOV	AH,0
	CALL	IGNBLNK
	OR	BX,BX	;BX:= VALUE OF # OR 0 IF NO # FOUND
	POP	CX	;CX -> END OF LINE
	JNZ	ST3B
	JMP	DIRECT
ST3B:
	DEC	DX
	DEC	DX
	MOV	AX,BX	;GET LINE #
	MOV	DI,DX
	STOW		;VALUE OF LINE # THERE
	PUSH	CX
	PUSH	DX	;BX,DX -> BEGIN,END
	MOV	AX,CX
	SUB	AX,DX
	PUSH	AX	;AX:= # BYTES IN LINE
	CALL	FNDLN	;FIND THIS LINE IN SAVE
	PUSH	DX	;AREA, DX -> SAVE AREA
	JNZ	ST4	;NZ:NOT FOUND, INSERT
	PUSH	DX	;Z:FOUND, DELERE IT
	CALL	FNDNXT	;FIND NEXT LINE
			;DE -> NEXT LIE
	POP	CX	;CX -> LINE TO BE DELETED
	MOV	BX,[TXTUNF] ;BX -> UNFILLED SAVE AREA
	CALL	MVUP	;MOVE UP TO DELETE
	MOV	BX,CX	;TXTUNF -> UNFILLED AREA
	MOV	[TXTUNF],BX ;UPDATE
ST4:
	POP	CX	;GET READY TO INSERT
	MOV	BX,[TXTUNF] ;BUT FIRST CHECK IF
	POP	AX	;AX = # CHARS IN LINE
	PUSH	BX	;IS 3 (LINE # AND CR)
	CMP	AL,3	;THEN DO NOT INSERT
	JZ	RSTART	;MUST CLEAR THE STACK
	ADD	AX,BX	;COMPUTE NEW TSTUNF
	MOV	BX,AX	;BX -> NEW UNFILLED AREA
ST4A:
	MOV	DX,TXTEND ;CHECK TO SEE IF THERE
	CMP	BX,DX	;IS ENOUGH SPACE
	JC	ST4B	;SORRY, NO ROOM FOR IT
	JMP	QSORRY
ST4B:
	MOV	[TXTUNF],BX ;OK, UPDATE TXTUNF
	POP	DX	;DX -> OLD UNFILLED AREA
	CALL	MVDOWN
	POP	DX	;DX -> BEGIN, BX -> END
	POP	BX
	CALL	MVUP	;MOVE NEW LINE TO SAVE AREA
	JP	ST3
	
TSTV:	MOV	AH,64	;TEST VARIABLES
	CALL	IGNBLNK
	JC	RET
TSTV1:
	JNZ	TV1	;NOT @ ARRAY
	CALL	PARN	;@ SHOULD BE FOLLOWED
	ADD	BX,BX
	JNC	SS1B	;IS INDEX TOO BIG?
        JMP     QHOW
SS1B:	PUSH	DX	;WILL IT OVERWRITE
	XCHG	DX,BX	;TEXT?
	CALL	SIZE	;FIND SIZE OF FREE
	CMP	BX,DX	;AND CHECK THAT
	JNC	SS1A	;IFF SO, SAY "SORRY"
        JMP     ASORRY
SS1A:
	MOV	BX,VARBGN	;IFF NOT, GET ADDRESS
	SUB	BX,DX	;OF @(EXPR) AND PUT IT
	POP	DX	;IN HL
	RET	;C FLAG IS CLEARED
TV1:
	CMP	AL,27	;NOT @, IS IT A TO Z?
CMC:
	;IFF NOT, RETURN C FLAG
	JC	RET	;IFF NOT, RETURN C FLAG
	INC	DX
TV1A:
	MOV	BX,VARBGN	;COMPUTE ADDRESS OF
	MOV	AH,0	;CLEAR UPPER BYTE
	ADD	AX,AX	;AX:=AX*2 (WORD STORAGE)
	ADD	BX,AX	;BX:=VARBGN+2*AL
	RET		;USE CARRY AS ERROR INDICATOR
;
; TSTNUM - AT ENTRY DX -> BUFFER OF ASCII CHARACTERS
;
TSTNUM:
	MOV	BX,0	;****TSTNUM****
	MOV	CH,BH	;TEST IFF THE TEXT IS
	MOV	AH,0	;FOR CMP IN IGNBLNK
	CALL	IGNBLNK	;A NUMBER.
TN1:
	CMP	AL,'0'	;IFF NOT, RETURN 0 IN
	JC	RET	;B AND HL
	CMP	AL,':'	;IFF NUMBERS, CONVERT
	JNC	RET	;TO BINARY IN BX AND
	MOV	AL,0F0H		;SET AL TO # OF DIGITS
	AND	AL,BH	;IFF BH>255, THERE IS NO
	JNZ	QHOW	;ROOM FOR NEXT DIGIT
	INC	CH	;CH COUNTS NUMBER OF DIGITS
	PUSH	CX
	MOV	AX,BX	;BX:=10*BX+(NEW DIGIT)
        MOV     CX,10
	PUSH	DX	;SAVE DX
        MUL     AX,CX
        MOV     BX,AX   ;PARTIAL RESULT NOW IN BX
	POP	DX	;RESTORE
	MOV	SI,DX
	LODB	        ;ASCII DIGIT IN AL NOW
        SUB     AL,48   ;CONVERT TO BINARY
        MOV     AH,0
        ADD     BX,AX   ;FULL RESULT NOW IN BX
	POP	CX
	LODB            ;REPEAT FOR MORE DIGITS
	LAHF		;SAVE FLAGS
	INC	DX
	SAHF		;RESTORE FLAGS
	JNS	TN1	;QUIT IF NO NUM OR OVERFLOW
QHOW:
	PUSH	DX	;****ERROR: "HOW?"****
AHOW:
	MOV	DX,HOW
	JMP	ERROR
HOW:
	DB	'HOW?',0DH
OK:
	DB	'OK',0DH
WHAT:
	DB	'WHAT?',0DH
SORRY:
	DB	'SORRY',0DH
;
;*
;**********************************************************
;*
;* *** TABLES *** DIRECT *** & EXEC ***
;*
;* THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
;* WHEN A MATCH IS FOUND, CONTROL IS TRANSFERRED TO THE SECTION
;* OF CODE ACCORDING TO THE TABLE.
;*
;* AT 'EXEC' DX SHOULD POINT TO THE STRING AND BX SHOULD POINT
;* TO THE TABLE-1. AT 'DIRECT', DX SHOULD POINT TO THE STRING,
;* BX WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
;* ALL DIRECT AND STATEMENT COMMANDS.
;*
;* A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
;* MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'PR.',
;* 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.
;*
;* THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM
;* IS A STRING OF CHARACTERS WITH BIT 7 SET TO 1 IN LAST CHAR
;* A JUMP ADDRESS IS STORED FOLLOWING EACH CHARACTER ENTRY.
;*
;* END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE 
;* STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
;* MATCH THIS NULL ITEM AS DEFAULT. THE DEFAULT IS INDICATED
;* BY FOLLOWING THE 80H DEFAULT INDICATOR.
;*

TAB1:   EQU	$	;DIRECT COMMANDS
	DM	'LIST'
	DW	LIST	;EXECUTION ADDRESSES
	DM	'EDIT'
	DW	EDIT
	DM	'E'
	DW	EDIT	;HAVE SHORT FORM DEFINED ALSO
	DM	'RUN'
	DW	RUN
	DM	'NEW'
	DW	NEW
	DM	'LOAD'
	DW	DLOAD
	DM	'SAVE'
	DW	DSAVE
	DM	'BYE'	;GO BACK TO DOS (EXIT TBASIC)
	DW	BYE
TAB2:	EQU	$	;DIRECT/STATEMENT
	DM	'NEXT'
	DW	NEXT	;EXECUTION ADDRESSES
	DM	'LET'
	DW	LET
	DM	'OUT'
	DW	OUTCMD
	DM	'POKE'
	DW	POKE
	DM	'WAIT'
	DW	WAITCM
	DM	'IF'
	DW	IFF
	DM	'GOTO'
	DW	GOTO
	DM	'GOSUB'
	DW	GOSUB
	DM	'RETURN'
	DW	RETURN
	DM	'REM'
	DW	REM
	DM	'FOR'
	DW	FOR
	DM	'INPUT'
	DW	INPUT
	DM	'PRINT'
	DW	PRINT
	DM	'STOP'
	DW	STOP
	DB	128	;SIGNALS END
			;REMEMBER TO MOVE DEFAULT DOWN.
	DW	DEFLT	;LAST POSIBILITY
TAB4:	EQU	$	;FUNCTIONS
	DM	'RND'
	DW	RND
	DM	'INP'
	DW	INP
	DM	'PEEK'
	DW	PEEK
	DM	'USR'
	DW	USR
	DM	'ABS'
	DW	ABS
	DM	'SIZE'
	DW	SIZE
	DB	128	;SIGNALS END
			;YOU CAN ADD MORE FUNCTIONS BUT REMEMBER
			;TO MOVE XP40 DOWN
	DW	XP40
TAB5:	EQU	$	;"TO" IN "FOR"
	DM	'TO'
TAB5A:	DW	FR1
	DB	128
	DW	QWHAT
TAB6:	EQU	$	;"STEP" IN "FOR"
	DM	'STEP'
TAB6A:	DW	FR2
	DB	128
	DW	FR3
TAB8:	EQU	$	;RELATION OPERATORS
	DM	'>='
	DW	XP11	;EXECUTION ADDRESS
	DM	'#'
	DW	XP12
	DM	'>'
	DW	XP13
	DM	'='
	DW	XP15
	DM	'<='
	DW	XP14
	DM	'<'
	DW	XP16
	DB	128
	DW	XP17
;
; END OF PARSER ACTION TABLE
;
;
; AT ENTRY BX -> COMMAND TABLE (ABOVE)
;	   DX -> COMMAND LINE (I.E. "BUFFER")
;
DIRECT:
	MOV	BX,TAB1-1	;***DIRECT***
	;*
EXEC:	EQU	$	;***EXEC***
EX0:
	MOV	AH,0
	CALL	IGNBLNK	;IGNORE LEADING BLANKS
	PUSH	DX	;SAVE POINTER
	MOV	SI,DX
EX1:	LODB		;GET CHAR WHERE DX ->
	INC	DX	;PRESERVE POINTER
	CMP	AL,'.'	;WE DECLARE A MATCH
	JZ	EX4
	INC	BX
	MOV	AH,[BX]
	AND	AH,127	;STRIP BIT 7
	CMP	AL,AH	;COMPARISON NOW EASY
	JZ	EX2
	; NO MATCH - CHECK NEXT ENTRY
EX0A:	CMP	B,[BX],128	;BYTE COMPARE
	JNC	EX0B
	INC	BX
	JP	EX0A
	; AT THIS POINT HAVE LAST LETTER
EX0B:	ADD	BX,3	;GET PAST EXECUTION ADDRESS
	CMP	B,[BX],128	;FOUND DEFAULT?
	JZ	EX3A	;IF SO, EXECUTE DEFAULT
	DEC	BX	;CORRECT FOR PRE-INCREMENT
	POP	DX	;RESTORE POINTER
	JP	EX0	;LOOK SOME MORE FOR A MATCH
EX4:	INC	BX
	CMP	B,[BX],128
	JC	EX4
	JP	EX3
;
EX3A:	DEC	SI
	JP	EX3	;CORRECT SI FOR DEFAULT EXECUTION
EX2:	CMP	B,[BX],128	;END OF RESERVED WORD?
	JC	EX1	;NO - CHECK SOME MORE
	; AT THIS POINT NEED TO GET EXECUTION ADDRESS

EX3:	INC	BX	;BX -> EXECUTION ADDRESS
	POP	AX	;CLEAR STACK
	MOV	DX,SI	;RESET POINTER
	JMP	[BX]	;DO IT
;*
;
;
; WHAT FOLLOWS IS THE CODE TO ECECUTE DIRECT AND STATEMENT COM-
; MANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE  COMMAND
; TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN THE LAST SECTION.
; AFTER THE COMMAND IS EXECUTED,  CONTROL  IS  TRANSFERRED   TO
; OTHER SECTIONS AS FOLLOWS:
;
; FOR 'LIST','NEW', ANS 'STOP': GO BACK TO 'RSTART'
;
; FOR 'RUN',: GO EXECUTE THE FIRST STORED LINE IFF ANY; ELSE
;			GO BACK TO RSTART.
;
; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
;
; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
;
; FOR ALL OTHERS: IFF 'CURRNT' -> 0, GO TO 'RSTART', ELSE
;			GO EXECUTE NEXT COMMAND. (THIS IS DONE
;			IN 'FINISH'.)
;
;
; ****NEW****STOP****RUN (& FRIENDS)****GOTO****
;
; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
;
; 'STOP(CR)' GOES BACK TO 'RSTART'
;
; 'RUN(CR)' FINDS THE FIRST STROED LINE, STORES ITS ADDRESS
;	(IN 'CURRNT'), AND START TO EXECUTE IT. NOTE THAT ONLY
;	THOSE COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAMS.
;
; THERE ARE THREE MORE ENTRIES IN 'RUN':
;
;	'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR AND EXEC IT.
;	'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT
;	'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
;
; 'GOTO(EXPR)' EVALUATES THE EXPRESSION, FINDS THE TARGET LINE,
;	AND JUMPS TO 'RUNTSL' TO DO IT.
;
; 'DLOAD' LOADS A NAMES PROGRAM FROM DISK (ANYNAME.TBI)
;
; 'DSAVE' SAVES A NAMES PROGRAM ON DISK
;
; 'FCBSET' SETS UP THE MSDOS FILE CONTROL BLOCK FOR SUBSEQUENT
;	DISK I/O.
;
;
NEW:
	MOV	W,[TXTUNF],TXTBGN
	;
STOP:
	CALL	ENDCHK	;****STOP(CR)****
	JMP	RSTART
	;
RUN:
	CALL	ENDCHK	;****RUN(CR)****
	MOV	DX,TXTBGN	;FIRST SAVED LINE
	;
RUNNXL:
	MOV	BX,0	;****RUNNXL****
	CALL	FNDLNP	;FIND WHATEVER LINE
	JNC	RUNTSL	;C: PASSED TXTUNF, QUIT
        JMP     RSTART
	;
RUNTSL:
	XCHG	DX,BX	;****RUNTSL****
	MOV	[CURRNT],BX	;SET 'CURRNT"->LINE #
	XCHG	DX,BX
	INC	DX
	INC	DX
	;
RUNSML:
	CALL	CHKIO	;****RUNSML****
	MOV	BX,TAB2-1	;FIND COMMAND IN TABLE 2
	JMP	EXEC	;AND EXECUTE IT
	;
GOTO:
	CALL	EXP	;****GOTO(EXPR)****
	PUSH	DX	;SAVE FOR ERROR ROUTINE
	CALL	ENDCHK	;MUST FIND A 0DH (CR)
	CALL	FNDLN	;FIND THE TARGET LINE
	JZ	GT1	;NO SUCH LINE #
        JMP     AHOW
GT1:	POP	AX
	JP	RUNTSL	;GO DO IT
	;
	; BDOS EQUATES (FOR MS-DOS)
	;
BYE:	EQU	0	;BDOS EXIT ADDRESS
FCB:	EQU	5CH
SETDMA:	EQU	26
OPEN:	EQU	15
READD:	EQU	20
WRITED:	EQU	21
CLOSE:	EQU	16
MAKE:	EQU	22
BCONIN:	EQU	10	;BUFFERED CONSOLE INPUT
DELETE:	EQU	19
CONOUT:	EQU	2	;CONSOLE OUTPUT
CONST:	EQU	11	;CONSOLE STATUS
	;
	;
DLOAD:
	MOV	AH,0
	CALL	IGNBLNK	;IGNORE BLANKS
	PUSH	BX	;SAVE H
	CALL	FCBSET	;SET UP FILE CONTROL BLOCK
	PUSH	DX	;SAVE THE REST
	PUSH	CX	;SAVE THE REST
	MOV	DX,FCB	;GET FCB ADDR
	MOV	AH,OPEN	;PREPARE TO OPEN FILE
	INT	33	;CALL MS-DOS TO OPEN FILE
	CMP	AL,0FFH	;IS IT THERE?
	JNZ	DL1	;NO, SEND ERROR
        JMP     QHOW
DL1:	XOR	AL,AL	;CLEAR A
	MOV	[FCB+32],AL	;START AT RECORD 0
	MOV	DX,TXTBGN	;GET BEGINNING
LOAD:
	PUSH	DX	;SAVE DMA ADDRESS
	MOV	AH,SETDMA
	INT	33	;CALL MS-DOS TO SET DAM ADDR
	MOV	AH,READD
	MOV	DX,FCB
	INT	33	;CALL MS-DOS TO READ SECTOR
	CMP	AL,1	;DONE?
	JC	RDMORE	;NO, READ MORE
	JZ	LL1
LOAD1:	JMP	QHOW	;BAD READ OR NO DELIMITER
LL1:	MOV	AH,CLOSE
	MOV	DX,FCB
	INT	33	;CALL MS-DOS TO CLOSE FILE
	POP	BP	;DMA ADDR IN BP
	SUB	BP,100H ;BACKUP
	MOV	CX,100H ;MAX LOOPS
RDM1:	INC	BP	;PRE INC
	CMP	W,[BP],0 ;FOUND DELIMITER?
	LOOPNZ	RDM1	;KEEP LOOKING
	CMP	CL,0	;MAC LOOPS EXECUTED?
	JZ	LOAD1	;GIVE ERROR IF SO
	MOV	[TXTUNF],BP ;UPDATE POINTER
	POP	CX	;GET OLD REG BACK
	POP	DX	;GET OLD REG BACK
	POP	BX	;GET OLD REG BACK
	CALL	FINISH	;FINISH
RDMORE:
	POP	DX	;GET DMA ADDR
	MOV	BX,80H	;GET 128
	ADD	BX,DX	;ADD IT TO DMA ADDR
	XCHG	DX,BX	;BACK IN D
	JMP	LOAD	;AND READ SOME MORE
	;
DSAVE:
	CMP	W,[TXTUNF],TXTBGN ;SEE IF ANYTHING TO SAVE
	JNZ	DS1A
	JMP	QWHAT
DS1A:
	MOV	BP,[TXTUNF]
	MOV	W,[BP],0 ;SET DELIMITER
	MOV	AH,0
	CALL	IGNBLNK	;IGNORE BLANKS
	PUSH	BX	;SAVE BX
	CALL	FCBSET	;SETUP FCB
	PUSH	DX
	PUSH	CX	;SAVE OTHERS
	MOV	DX,FCB
	MOV	AH,DELETE
	INT	33	;CALL MS-DOS TO ERASE FILE
	MOV	DX,FCB
	MOV	AH,MAKE
	INT	33	;CALL MS-DOS TO MAKE A NEW ONE
	CMP	AL,0FFH	;IS THERE SPACE?
	JNZ	DS1
        JMP     QHOW	;NO, ERROR
DS1:	XOR	AL,AL	;CLEAR A
	MOV	[FCB+32],AL	;START AT RECORD 0
	MOV	DX,TXTBGN	;GET BEGINNING
SAVE:
	PUSH	DX	;SAVE DMA ADDR
	MOV	AH,SETDMA
	INT	33	;CALL MS-DOS TO SET DMA ADDR
	MOV	AH,WRITED
	MOV	DX,FCB
	INT	33	;CALL MS-DOS TO WRITE SECTOR
	OR	AL,AL	;SET FLAGS
	JZ	SS1	;IF NOT ZERO, ERROR
        JMP     QHOW
SS1:	POP	DX	;GET DMA ADDR BACK
	MOV	AX,DX
	CMP	AX,[TXTUNF]	;SEE IF DONE
	JZ	SAVDON
	JNC	SAVDON	;JUMP IF DONE
WRITMOR:
	MOV	BX,80H
	ADD	BX,DX
	XCHG	DX,BX	;GET IT TO D
	JP	SAVE
SAVDON:
	MOV	AH,CLOSE
	MOV	DX,FCB
	INT	33	;CALL MS-DOS TO CLOSE FILE
	POP	CX	;GET REGS BACK
	POP	DX	;GET REGS BACK
	POP	BX	;GET REGS BACK
	CALL	FINISH
	;
FCBSET:
	MOV	BX,FCB	;GET FCB ADDR
	MOV	B,[BX],0	;CLEAR ENTRY TYPE
FNCLR:
	INC	BX
	MOV	B,[BX],' '	;CLEAR TO SPACE
	MOV	AX,FCB+8
	CMP	AX,BX	;DONE?
	JNZ	FNCLR	;NO, DO IT AGAIN
	INC	BX
	MOV	B,[BX],'T'	;SET FILE TYPE TO 'TBI'
	INC	BX
	MOV	B,[BX],'B'
	INC	BX
	MOV	B,[BX],'I'
EXRC:
	INC	BX
	MOV	B,[BX],0
	MOV	AX,FCB+15
	CMP	AX,BX
	JNZ	EXRC	;NO, CONTINUE
	MOV	BX,FCB+1	;GET FILENAME START
FN:
	MOV	SI,DX
	LODB	;GET CHAR
	CMP	AL,0DH	;IS IT A 'CR'
	JZ	RET	;YES, DONE
	CMP	AL,'!'	;LEGAL CHAR?
	JNC     FN1	;NO, SEND ERROR
        JMP     QWHAT
FN1:	CMP	AL,'['	;AGAIN
	JC	FN2	;DITTO
        JMP     QWHAT
FN2:	MOV	[BX],AL	;SAVE IT IN FCB
	INC	BX
	INC	DX
	MOV	AX,FCB+9
	CMP	AX,BX	;LAST?
	JNZ	FN	;NO, CONTINUE
	RET	;TRUNCATE AT EIGHT CHARS
;
;
; ****LIST**** AND ****PRINT**** AND ****EDIT****
;
; LIST HAS TWO FORMS:
;	'LIST(CR)' LISTS ALL SAVED LINES
;	'LIST #(CR)' START LIST AT THIS LINE #
; YOU CAN STOP LISTING BY CONTROL C KEY
;
; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACKARROWS, AND
; STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
;
; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS THE
; NUMBER OF SPACES THE VALUE OF AN EXPRESSION IS TO BE PRINTED.
; TED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT, UNLESS
; CHANGED BY ANOTHER FORMAT. IF NO FORMAT SPEC, 6 POSITIONS
; WILL BE USED.
;
; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR DOUBLE
; QUOTES.
;
; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF).
;
; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN PRINT OR
; IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST ENDED WITH A 
; COMMA, NO (CR) IS GENERATED.
;
;
LIST:
	CALL	TSTNUM	;TEST IFF THERE IS A #
	CALL	ENDCHK	;IFF NO # WE GET A 0
	CALL	FNDLN	;FIND THIS OR NEXT LINE
LS1:
	JNC	LS2	;C: PASSED TXTUNF
        JMP     RSTART
LS2:	CALL	PRTLN	;PRINT THE LINE
	CALL	CHKIO	;SEE IF ^X OR ^C
	CALL	FNDLNP	;FIND NEXT LINE
	JP	LS1	;LOOP BACK
	;
;
EDIT:
	CALL	TSTNUM	;TEST IF THERE IS A #
	CALL	ENDCHK	;AT END?
	CALL	FNDLN	;FIND SPEC LINE OR NEXT LINE
	PUSH	DX	;SAVE LINE #
	JNC	ED2	;C: PASSED TXTUNF
	POP	DX	;THROW AWAY LINE #
ED1:	JMP	RSTART
ED2:
	CALL	PRTLN	;PRINT THE LINE
	POP	DX	;GET LINE # BACK
	MOV	B,[OCSW],0 ;DIRECT OUTPUT TO BUFFER
	MOV	B,[BUFFER-1],0 ;CLEAR CHAR COUNT
	MOV	B,[PRTLN1+1],4 ;PRINT ONE LESS SPACE
	MOV	DI,BUFFER ;PREPARE TO MOVE
	CALL	PRTLN
	MOV	B,[OCSW],0FFH ;REDIRECT OUTPUT TO CONSOLE
	DEC	[BUFFER-1] ;AVOID CR?
	MOV	B,[PRTLN1+1],5 ;RESTORE PRTLN
	JMP	ST3	;PROMPT AND GETLINE ONLY
PRINT:
	MOV	CL,6	;C:= # OF SPACES
	MOV	AH,';'	;CHECK FOR ';' IN IGNBLNK
	CALL	IGNBLNK	;IGNORE BLANKS
	JNZ	PR2	;JUMP IF ';' NOT FOUND
	CALL	CRLF	;GIVE CR,LF AND
	JMP	RUNSML	;CONTINUE SAME LINE
PR2:
	MOV	AH,0DH
	CALL	IGNBLNK
	JNZ	PR0
	CALL	CRLF	;ALSO GIVE CRLF AND
	JMP	RUNNXL	;GOTO NEXT LINE
PR0:
	MOV	AH,'#'
	CALL	IGNBLNK
	JNZ	PR1
	CALL	EXP	;YES, EVALUATE EXPR
	MOV	CL,BL	;AND SAVE IT IN C
	JP 	PR3	;LOOK FOR MORE TO PRINT
PR1:
	CALL	QTSTG	;OR IS IT A STRING?
	JP	PR8	;IFF NOT, MUST BE EXPRESSION
PR3:
	MOV	AH,','
	CALL	IGNBLNK
	JNZ	PR6
	CALL	FIN	;IN THE LIST
	JP	PR0	;LIST CONTINUES
PR6:
	CALL	CRLF	;LIST ENDS
	CALL	FINISH
PR8:
	CALL	EXP	;EVAL THE EXPR
	PUSH	CX
	CALL	PRTNUM	;PRINT THE VALUE
	POP	CX
	JP	PR3	;MORE TO PRINT?
;
;
; ****GOSUB**** AND ****RETURN****
;
; 'GOSUB (EXPR);' OR 'GOSUB EXPR(CR)' IS LIKE THE 'GOTO' COMMAND
; EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER ETC.   ARE
; SAVED SO THAT EXECUTION CAN BE CONTINUED AFTER THE  SUBROUTINE
; 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED (AND EVEN RECUR-
; SIVE), THE SAVE AREA MUST BE  STACKED.  THE  STACK  POINTER IS
; SAVED IN 'STKGOS'. THE OLD 'STKGOS' IS SAVED IN THE STACK. IF
; WE ARE IN THE MAIN ROUTINE, 'STKGOS' IS ZERO (THIS WAS DONE BY
; THE "MAIN" SECTION OF THE CODE),  BUT  WE  STILL  SAVE  IT  AS
; A FLAG FOR NO FURTHER RETURNS.
;
; 'RETURN(CR)' UNDOES EVERYTHING THAT 'GOSUB' DID, AND THUS  RE-
; TURNS THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT  'GO-
; SUB'. IFF 'STKGOS' IS ZERO, IT INDICATES THAT WE NEVER  HAD  A
; 'GOSUB' AND IS THUS AN ERROR.
;
;
GOSUB:
	CALL	PUSHA	;SAVE THE CURRENT 'FOR'
	CALL	EXP	;PARAMETERS
	PUSH	DX
	CALL	FNDLN	;FIND THE TARGET LINE
	JZ	GS1	;NOT THERE, SAY "HOW?"
        JMP     AHOW
GS1:	MOV	BX,[CURRNT]	;FOUND IT, SAVE OLD
	PUSH	BX	;'CURRNT' OLD 'STKGOS'
	MOV	BX,[STKGOS]
	PUSH	BX
	MOV	BX,0	;AND LOAD NEW ONES
	MOV	[LOPVAR],BX
	ADD	BX,SP
	MOV	[STKGOS],BX
	JMP	RUNTSL	;THEN RUN THAT LINE
RETURN:
	CALL	ENDCHK	;THERE MUST BE A 0DH
	MOV	BX,[STKGOS]	;OLD STACK POINTER
	OR	BX,BX
	JNZ	RET1	;SO, WE SAY: "WHAT?"
        JMP     QWHAT
RET1:	XCHG	BX,SP		;ELSE RESTORE IT
	POP	BX	;ELSE RESTORE IT
	MOV	[STKGOS],BX	;AND THE OLD 'STKGOS'
	POP	BX
	MOV	[CURRNT],BX	;AND THE OLD 'CURRNT'
	POP	DX	;OLD TEXT POINTER
	CALL	POPA	;OLD "FOR" PARAMETERS
	CALL	FINISH	;AND WE ARE BACK HOME
;
;
; ****FOR**** AND ****NEXT****
;
;
; 'FOR' HAS TWO FORMS:
;	'FOR VAR=EXP1 TO EXP2 STEP EXP3'
;	'FOR VAR=EXP1 TO EXP2'
; THE SECOND FORM MEANS THE SAME AS THE FIRST FORM WITH EXP3=1.
;
; TBI WILL FIND THE VARIABLE VAR AND SET ITS VALUE TO THE CUR-
; RENT VALUE OF EXP1. IT ALSO  EVALUATES  EXP2  AND  EXP3  AND
; SAVES ALL OF THESE TOGETHER  WITH  THE  TEXT  POINTER ETC IN
; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR',   'LOPINC',
; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IFF THERE IS ALREADY   SOME-
; THING IN THE SAVE AREA (THIS IS  INDICATED  BY  A   NON-ZERO
; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK  BE-
; FORE THE NEW ONE OVERWRITES IT.
;
; TBI WILL THEN DIG IN THE  STACK  AND  FIND  OUT IFF     THIS
; SAME VARIABLE WAS USED IN  ANOTHER  CURRENTLY  ACTIVE    FOR
; LOOP. IT THAT IS THE CASE THEN THE OLD 'FOR'   LOOP IS   DE-
; IVATED (PURGED FROM THE STACK).
;
; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS  CHECKED
; WITH THE 'LOPVAR'. IFF THEY ARE NOT THE SAME, TBI DIGGS   IN
; THE STACK TO FIND THE RIGHT ONE  AND  PURGES  ALL THOSE THAT
; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO  THAT
; VARIABLE AND CHECKS THE RESULT WITH THE LIMIT.  IFF  IT   IS
; WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND  FOLLOW-
; ING THE 'FOR'. IFF OUTSIDE THE LIMIT, THE SAVE AREA IS PURG-
; ED AND EXECUTION CONTINUES.
;
;
FOR:
	CALL	PUSHA	;SAVE THE OLD SAVE AREA
	CALL	SETVAL	;SET THE CONTROL VAR.
	DEC	BX
	MOV	[LOPVAR],BX	;SAVE TGAT
	MOV	BX,TAB5-1	;USE 'EXEC' TO LOOK
	JMP	EXEC	;FOR THE WORD 'TO'
FR1:
	CALL	EXP	;EVALUATE THE LIMIT
	MOV	[LOPLMT],BX	;SAVE THAT
	MOV	BX,TAB6-1	;USED 'EXEC' TO LOOK
	JMP	EXEC	;FOR THE WORD 'STEP'
FR2:
	CALL	EXP	;FOUND IT, GET STEP
	JP	FR4	;FOUND IT, GET STEP
FR3:
	MOV	BX,1	;NOT FOUND, SET TO ONE
FR4:
	MOV	[LOPINC],BX	;SAVE THAT TOO
FR5:
	MOV	BX,[CURRNT]	;SAVE CURRENT LINE #
	MOV	[LOPLN],BX
	XCHG	DX,BX	;AND TEXT POINTER
	MOV	[LOPPT],BX
	MOV	CX,10	;DIG INTO STACK TO
	MOV	BX,[LOPVAR]	;FIND 'LOPVAR'
	XCHG	DX,BX
	MOV	BX,CX	;BX:=10 NOW
	ADD	BX,SP
	JP	FR7A
FR7:
	ADD	BX,CX
FR7A:	MOV	AX,[BX]	;GET THAT OLD 'LOPVAR'
	OR	AX,AX
	JZ	FR8	;0 SAYS NO MORE IN IT
	CMP	AX,DX	;SAME AS THIS ONE?
	JNZ	FR7
	XCHG	DX,BX
	MOV	BX,0	;THE OTHER HALF?
	ADD	BX,SP
	MOV	CX,BX
	MOV	BX,10
	ADD	BX,DX
	CALL	MVDOWN	;AND PURGE 10 WORDS
	XCHG	BX,SP		;IN THE STACK
FR8:
	MOV	BX,[LOPPT]	;JOB DONE, RESTORE DE
	XCHG	DX,BX
	CALL	FINISH	;AND CONTINUE
	;
NEXT:
	CALL	TSTV	;GET ADDR OF VAR
	JNC	NX4	;NO VARIABLE, "WHAT?"
        JMP     QWHAT
NX4:	MOV	[VARNXT],BX	;YES, SAVE IT
NX0:
	PUSH	DX	;SAVE TEXT POINTER
	XCHG	DX,BX
	MOV	BX,[LOPVAR]	;GET VAR IN 'FOR'
	MOV	AL,BH
	OR	AL,BL	;0 SAY NEVER HAD ONE
	JNZ	NX5	;SO WE ASK: "WHAT?"
        JMP     AWHAT
NX5:	CMP	DX,BX	;ELSE WE CHECK THEM
	JZ	NX3	;OK, THEY AGREE
	POP	DX	;NO, LET'S SEE
	CALL	POPA	;PURGE CURRENT LOOP
	MOV	BX,[VARNXT]	;AND POP ONE LEVEL
	JMP	NX0	;GO CHECK AGAIN
NX3:
	MOV	DL,[BX]	;COME HERE WHEN AGREED
	INC	BX
	MOV	DH,[BX]	;DE = VAL OF VAR
	MOV	BX,[LOPINC]
	PUSH	BX
	ADD	BX,DX
	XCHG	DX,BX	;ADD ONE STEP
	MOV	BX,[LOPVAR]	;PUT IT BACK
	MOV	[BX],DL
	INC	BX
	MOV	[BX],DH
	MOV	BX,[LOPLMT]	;HL-> LIMIT
	POP	AX
	XCHG	AH,AL
	OR	AX,AX
	JNS	NX1	;STEP > 0
	XCHG	DX,BX
NX1:
	CALL	CKHLDE	;COMPARE WITH LIMIT
	POP	DX	;RESTORE TEXT POINTER
	JC	NX2	;OUTSIDE LIMIT
	MOV	BX,[LOPLN]	;WITHIN LIMIT, GO
	MOV	[CURRNT],BX	;BACK TO THE SAVED
	MOV	BX,[LOPPT]	;'CURRNT' AND TEXT
	XCHG	DX,BX	;POINTER
	CALL	FINISH	;POINTER
NX2:
	CALL	POPA	;PURGE THIS LOOP
	CALL	FINISH
;
;
; ****REM**** AND ****IF**** AND ****LET*****
;
;
; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI. TBI
; TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
;
; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR  MORE
; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED  BY  SEMI-COLONS.
; NOTE THAT THE WORD 'THEN' IS NOT USED.  TBI  EVALUATES   THE
; EXPR. IFF IT IS NON-ZERO, EXECUTION CONTINUES. IFF THE EXPR.
; IS ZERO, THE COMMANDS THAT FOLLOW ARE IGNORED AND  EXECUTION
; CONTINUES AT THE NEXT LINE.
;
; 'IPUT' COMMANS IS LIKE THE 'PRINT' COMMAND, AND IS  FOLLOWED
; BY A LIST OF ITEMS. IFF THE ITEM IS A  STRING  IN  SINGLE OR
; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFEDT AS
; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN EXPR.
; TO BE TYPEN IN. THE VARIABLE IS THEN  SET  TO  THE  VALUE OF
; THIS EXPR. IFF THE VARIABLE IS PROCEDED BY A STRING  PRINTED
; FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR. AND SETS
; THE VARIABLE TO THE VALUE OF THE EXPR.
;
; IFF THE INPUT EXPR. IS INVALID,  TBI  WILL  PRINT  "WHAT?" ,
; "HOW?",OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C .
; THIS IS HANDLED IN 'INPERR'.
;
; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED  BY  COMMAS .
; EACH ITEM CONSISTS OF A VARIABLE,  AN  EQUAL  SIGN,  AND  AN
; EXPR. TBI EVALUATES THE EXPR. AND SETS THE VARIABLE TO  THAT
; VALUE. TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE   WORD
; 'LET'. THIS IS DONE BY 'DEFLT'.
;
;
;
REM:
	MOV	BX,0	;****REM****
	JP	IFF1A	;JUMP AROUND EXPR
	;
IFF:
	CALL	EXP	;****IF****
IFF1A:	CMP	BX,0	;IS THE EXPR = 0?
	JZ	IFF1	;NO, CONTINUE
        JMP     RUNSML
IFF1:	CALL	FNDSKP	;YES, SIKP REST OF LINE
	JC	IFF2	;YES, SIKP REST OF LINE
        JMP     RUNTSL
IFF2:	JMP	RSTART	;YES, SIKP REST OF LINE
	;
INPERR:
	MOV	BX,[STKINP]	;****INPERR****
	XCHG	BX,SP		;RESTORE OLD STACK POINTER
	POP	BX	;AND OLD 'CURRNT'
	MOV	[CURRNT],BX
	POP	DX
	POP	DX	;REDO INPUT
	;
INPUT:	EQU	$	;****INPUT****
IP1:
	PUSH	DX	;SAVE IN CASE OF ERROR
	CALL	QTSTG	;IS NEXT ITEM A STRING?
	JP	IP2	;NO
	CALL	TSTV	;YES, BUT FOLLOWED BY A
	JC	IP4	;VARIABLE? NO.
	JP	IP3	;YES. INPUT VAR.
IP2:
	PUSH	DX	;SAVE FOR 'PRTSTG'
	CALL	TSTV	;MUST BE A VAR NOW
	JNC	IP2A	;"WHAT" IT IS NOT!
        JMP     QWHAT
IP2A:	MOV	SI,DX
	LODB		;GET READY FOR 'RTSTG'
	MOV	CL,AL
	SUB	AL,AL
	MOV	DI,DX
	STOB
	POP	DX
	CALL	PRTSTG	;PRINT STRING AS PROMPT
	MOV	AL,CL
	DEC	DX
	MOV	DI,DX
	STOB
IP3:
	PUSH	DX
	XCHG	DX,BX
	MOV	BX,[CURRNT]	;ALSO SAVE 'CURRNT'
	PUSH	BX
	MOV	BX,IP1
	MOV	[CURRNT],BX	;NEG NUMBER AS FLAG
	MOV	[STKINP],SP
	PUSH	DX	;OLD HL
	MOV	AL,':'	;PRINT THIS TOO
	CALL	GETLN	;AND GET A LINE
IP3A:
	MOV	DX,BUFFER	; POINTS TO BUFFER
	CALL	EXP	;EVALUATE INPUT
	NOP	        ;CAN BE 'CALL ENDCHK'
	NOP	 	;CAN BE 'CALL ENDCHK'
	NOP	 	;CAN BE 'CALL ENDCHK'
	POP	DX	;OK,GET OLD HL
	XCHG	DX,BX	;OK,GET OLD HL
	MOV	[BX],DX
	POP	BX	;GET OLD 'CURRNT'
	MOV	[CURRNT],BX
	POP	DX	;AND GET OLD TEXT POINTER
IP4:
	POP	AX
	MOV	AH,','
	CALL	IGNBLNK
	JNZ	IP5
	JP	IP1	;YES, MORE ITEMS
IP5:
	CALL	FINISH
	;
DEFLT:
	MOV	SI,DX
	LODB	;****DEFLT****
	CMP	AL,0DH	;EMPTY LINE IS OK
	JZ	LT1	;ELSE IT IS 'LET'
	;
LET:
	CALL	SETVAL	;****LET****
	MOV	AH,','
	CALL	IGNBLNK
	JNZ	LT1
	JP	LET	;ITEM BY ITEM
LT1:
	CALL	FINISH	;UNTIL FINISH
;
;
; ****EXPR****
;
; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
;	<EXPR>::=<EXPR2>
;				<EXPR2><REL.OP><EXPR2>
;
; WHERE <REL.OP> IS ONE OF THE OPERATORS IN TAB8 AND THE RE-
; SULT OF THESE OPERATIONS IS 1 IFF TRUE AND  0  IFF  FALSE.
;
;	<EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>(....)
;
; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
;
;	<EXPR3>::=<EXPR4>(<* OR /><EXPR4>)(....)
;	<EXPR4>::=<VARIABLE>
;			<FUNCTION>
;			(<EXPR>)
;
; <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN EXPR
; AS INDEX, FUCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS,   AND
; <EXPR4> CAN BE AN <EXPR> IN PARANTHESES.
;
;
EXP:	CALL	EXPR2
	PUSH	BX
EXPR1:
	MOV	BX,TAB8-1	;LOOKUP REL.OP
	JMP	EXEC	;GO DO IT
XP11:
	CALL	XP18
	JC	RET	;NO RETURN HL=0
	MOV	BL,AL	;YES, RETURN HL=1
	RET
XP12:
	CALL	XP18
	JZ	RET	;FALSE, RETURN HL=0
	MOV	BL,AL	;TRUE, RETURN HL=1
	RET
XP13:
	CALL	XP18	;REL.OP '>'
	JZ	RET	;FALSE
	JC	RET	;ALSO FALSE, HL=0
	MOV	BL,AL	;TRUE, HL=1
	RET
XP14:
	CALL	XP18	;REL OP '<='
	MOV	BL,AL	;SET HL=1
	JZ	RET	;REL. TRUE, RETURN
	JC	RET	;REL. TRUE, RETURN
	MOV	BL,BH	;ELSE SET HL=0
	RET
XP15:
	CALL	XP18	;REL OP '='
	JNZ	RET	;FALSE, RETURN HL=0
	MOV	BL,AL	;ELSE SET HL=1
	RET
XP16:
	CALL	XP18	;REL.OP '<'
	JNC	RET	;FALSE, RETURN HL=0
	MOV	BL,AL	;ELSE SET HL=1
	RET
XP17:
	POP	BX	;NOT REL OP
	RET	;RETURN HL=<EPTR2>
XP18:
	MOV	AL,CL	;SUBROUTINE FOR ALL
	POP	BX	;REL.OP'S
	POP	CX	;REL.OP'S
	PUSH	BX	;REVERSE TOP OF STACK
	PUSH	CX	;REVERSE TOP OF STACK
	MOV	CL,AL
	CALL	EXPR2	;GET 2ND EXPRESSION
	XCHG	DX,BX	;VALUE IN DE NOW
	POP	AX
	PUSH	BX
	MOV	BX,AX	;LAST 3 INSTR FOR XTHL INST!
	CALL	CKHLDE	;COMPARE 1ST WITH SECOND
	POP	DX
	MOV	BX,0	;SET HL=0, A=1
	MOV	AL,1	;SET HL=0, A=1
	RET
	;
EXPR2:
	MOV	AH,'-'
	CALL	IGNBLNK	;NEGATIVE SIGN?
	JNZ	XP21
	MOV	BX,0	;YES, FAKE '0-'
	JP	XP26	;TREAT LIKE SUBTRACT
XP21:
	MOV	AH,'+'	;POSITIVE SIGN?
	CALL	IGNBLNK
XP22:
	CALL	EXPR3	;1ST <EXPR3>
XP23:
	MOV	AH,'+'
	CALL	IGNBLNK	;ADD?
	JNZ	XP25	;NOTE OFFSET WHAS 21 BYTES IN 8080 VERSION
	PUSH	BX	;YES, SAVE VALUE
	CALL	EXPR3	;GET 2ND <EXPR3>
XP24:
	XCHG	DX,BX	;2ND IN DE
	POP	AX	;THIS + NEXT 2 LINES FOR 8080 XTHL INST!!
	PUSH	BX
	MOV	BX,AX	;BX <-> [SP] NOW, [SP]->BUFFER,BX=OLD EXPR3
	ADD	BX,DX
	POP	DX
	JNO	XP23	;CHECK FOR OVERFLOW
XP24A:	JMP	QHOW	;ELSE WE HAVE OVERFLOW
XP25:
	MOV	AH,'-'
	CALL	IGNBLNK	;SUBTRACT?
	JNZ	RET
XP26:	PUSH	BX	;YES, SAVE 1ST <EXPR3>
	CALL	EXPR3	;GET 2ND <EXPR3>
	CALL	CHGSGN
	JP	XP24
	;
EXPR3:
	CALL	EXPR4	;GET 1ST <EXPR4>
XP31:
	MOV	AH,'*'
	CALL	IGNBLNK	;MULTIPLY?
	JNZ	XP34
	PUSH	BX	;YES, SAVE 1ST
	CALL	EXPR4	;AND GET 2ND <EXPR4>
	XCHG	DX,BX	;2ND IN DE NOW
	POP	AX	;SUBSITUTE FOR 8080 XTHL
	PUSH	BX
	IMUL	AX,DX	;AX:=AX*DX
	JO	XP32	;SEE INTEL BOOK ON OVERFLOW FLAG
	MOV	BX,AX	;RESULT NOW IN BX
	JP	XP35	;LOOK FOR MORE
XP34:
	MOV	AH,'/'
	CALL	IGNBLNK	;DIVIDE?
	JNZ	RET
	PUSH	BX	;YES, SAVE 1ST <EXPR4>
	CALL	EXPR4	;AND GET SECOND ONE
	XCHG	DX,BX	;PUT 2ND IN DE
	POP	AX	;REPLACEMENT FOR XTHL
	PUSH	BX
	MOV	BX,AX
	OR	DX,DX
	JNZ	XP34A	;SAY "HOW?"
XP32:	JMP	AHOW
XP34A:	CALL	DIVIDE	;USE SUBROUTINE
	MOV	BX,CX	;GET RESULT
	MOV	CX,6	;SIX SPACES
XP35:
	POP	DX	;AND TEXT POINTER
	JP	XP31	;LOOK FOR MORE TERMS
	;
EXPR4:
	MOV	BX,TAB4-1	;FIND FUCNTION IN TAB4
	JMP	EXEC	;AND GOT DO IT
XP40:
	CALL	TSTV	;NO, NOT A FUNCTION
	JC	XP41	;NOR A VARIABLE
	MOV	AL,[BX]	;VARIABLE
	LAHF
	INC	BX
	SAHF
	MOV	BH,[BX]	;VALUE IN HL
	MOV	BL,AL	;VALUE IN HL
	RET
XP41:
	CALL	TSTNUM	;OR IS IT A NUMBER?
	MOV	AL,CH	;# OF DIGITS
	OR	AL,AL
	JNZ	RET	;OK
PARN:
	MOV	AH,'('
	CALL	IGNBLNK	;NO DIGIT, MUST BE
	JNZ	PARN1
	CALL	EXP	;"(EXPR)"
PARN1:	MOV	AH,')'
	CALL	IGNBLNK	;"(EXPR)"
	JNZ	XP43	;******WHY CHECK THIS?******
XP42:
	RET
XP43:
	JMP	QWHAT	;ELSE SAY: "WHAT?"
	;
RND:
	CALL	PARN	;****RND(EXPR)****
	OR	BX,BX
	JNS	RND1	;MUST BE POSITIVE
	JNZ	RND1	;AND NON-ZERO
        JMP     QHOW
RND1:
	PUSH	CX
	PUSH	DX
	MOV	AH,2CH	;GET TIME
	INT	33	;ASK MS-DOS
	MOV	AX,327
	MOV	DH,0
	MUL	AX,DX	; 0<=AX<=32700
	XCHG	DX,BX
	MOV	BX,AX
	CALL	DIVIDE	;RND(N)=MOD(M,N)+1
	POP	DX
	POP	CX
	INC	BX
	RET
	;
ABS:
	CALL	PARN	;****ABS(EXPR)****
	CALL	CHKSGN	;CHECK SIGN
	OR	AX,BX
	JNS	RET	;OK
	JMP	QHOW	;SO SAY: "HOW?"
SIZE:
	MOV	BX,[TXTUNF]	;****SIZE****
	PUSH	DX	;GET THE NUMBER OF FREE
	XCHG	DX,BX	;BYTES BETWEEN 'TXTUNF'
SIZEA:
	MOV	BX,VARBGN	;AND 'VARBGN'
	SUB	BX,DX
	POP	DX
	RET
;
;
; ****OUT**** AND ****INP**** AND ****WAIT**** AND
; ****POKE**** AND ****PEEK**** AND ****USR****
;
;
; 'OUT I,J(,K,L)'
;
; OUTPUTS EXPRESSION 'J' TO PORT 'I', AND MAY BE REPEATED AS
; IN DATA 'L' TO PORT 'K' AS MANY TIMES AS NEEDED. THIS COM-
; MAND MODIFIES *, A SMALL SECTION OF CODE ABOVE ADDRESS 2K.
;
; 'INP (I)'
;
; THIS FUNCTION RETURNDS DATA READ FROM  INPUT  PORT 'I'  AS
; ITS VALUE. IT ALSO MODIFIES CODE JUST ABOVE 2K.
;
; 'WAIT I,J,K'
;
; THIS COMMAND READS THE STATUS OF PORT 'I', EXCLUSIVE  OR'S
; THE RESULT WITH 'K', IF THE RESULT IS ONE, OR IF NOT  WITH
; ZERO, AND'S WITH 'J' AND RETURNS WHEN THE RESULT IS   NON-
; ZERO. ITS MODIFIED CODE IS ALSO ABOVE 2K.
;
; 'POKE I,J(,K,L)
;
; THIS COMMAND WORKS LIKE OUT EXCEPT THAT IT PUTS  DATA  'J'
; INTO MEMORY LOCATION 'I'.
;
; 'PEEK (I)'
;
; THIS FUNCTION WORKS LIKE INP EXCEPT THAT IT PUTS DATA  'J'
; FROM MEMORY LOCATION 'I'.
;
; 'USR(I(,J))'
;
; USR CALL A MACHINE LANGUAGE SUBROUTINE AT LOCATION 'I'  IF
; THE OPTIONAL PARAMETER 'J' IS USED ITS VALUE IS PASSED  IN
; HL. THE VALUE OF THE FUNCTION SHOULD BE RETURNED IN HL.
;
;
OUTCMD:
	CALL	EXP
	MOV	AL,BL
	MOV	[OUTIO+1],AL
	MOV	AH,','
	CALL	IGNBLNK
	JZ	OUT1	;FOUND MORE TO WORK ON
	JMP	QWHAT
OUT1:	CALL	EXP
	MOV	AL,BL
	CALL	OUTIO
	MOV	AH,','
	CALL	IGNBLNK
	JNZ	OUTCMD1
	JP	OUTCMD
OUTCMD1:CALL	FINISH
WAITCM:
	CALL	EXP
	MOV	AL,BL
	MOV	[WAITIO+1],AL
	MOV	AH,','
	CALL	IGNBLNK
	JZ	WT1
	JMP	QWHAT
WT1:	CALL	EXP
	PUSH	BX
	MOV	AH,','
	CALL	IGNBLNK
	JNZ	WAIT1
	CALL	EXP
	MOV	AL,BL
	POP	BX
	MOV	BL,AL
	JP	WAIT2
WAIT1:	MOV	BH,0
WAIT2:	JMP	WAITIO
INP:
	CALL	PARN
	MOV	AL,BL
	MOV	[INPIO+1],AL
	MOV	BX,0
	JMP	INPIO
	JP	QWT
POKE:
	CALL	EXP
	PUSH	BX
	MOV	AH,','
	CALL	IGNBLNK
	JZ	POK1
	JMP	QWHAT
POK1:	CALL	EXP
	MOV	AL,BL
	POP	BX
	MOV	[BX],AL
	MOV	AH,','
	CALL	IGNBLNK
	JNZ	POK2
	JP	POKE
POK2:	CALL	FINISH
PEEK:
	CALL	PARN
	MOV	BL,[BX]
	MOV	BH,0
	RET
	JMP	QWHAT
USR:
	PUSH	CX
	MOV	AH,'('
	CALL	IGNBLNK
	JNZ	QWT
	CALL	EXP	;EXPR
	MOV	AH,')'
	CALL	IGNBLNK	;EXPR
	JNZ	PASPRM
	PUSH	DX
	MOV	DX,USRET
	PUSH	DX
	PUSH	BX
	RET	;CALL USR ROUTINE
PASPRM:
	MOV	AH,','
	CALL	IGNBLNK
	JNZ	USRET1
	PUSH	BX
	CALL	EXP
	MOV	AH,')'
	CALL	IGNBLNK
	JNZ	USRET1
	POP	CX
	PUSH	DX
	MOV	DX,USRET
	PUSH	DX
	PUSH	CX
	RET	;CALL USR ROUTINE
USRET:
	POP	DX
USRET1:	POP	CX
	RET
QWT:	JMP	QWHAT
;
;
; ****DIVIDE**** AND ****CHKSGN****
; ****CHKSGN**** AND ****CKHLDE****
;
;
; 'DIVIDE DIVIDES BX BY DX, RESULT IN CX, REMAINDER IN BX
;
; 'CHKSGN' CHECKS SIGN OF BX. IFF +, NO CHANGE. IFF -, CHANGE
;	SIGN AND FLIP SIGN OF C
;
; 'CHGSGN' CHANGES SIGN OF BX AND CL UNCONDITIONALLY.
;
; 'CKHLDE' CHECK SIGN OF BX AND DX. IFF DIFFERENT, BX AND DX
; ARE INTERCHANGED. IFF SAME SIGN, NOT INTERCHANGED.   EITHER
; CASE, BX AND DX ARE THEN COMPARED TO SET THE FLAGS.
;
;
DIVIDE:
	PUSH	DX	;PRESERVE DX ACCROSS CALL
	PUSH	DX
	XOR	DX,DX
	POP	CX
	MOV	AX,BX
	IDIV	AX,CX
	MOV	CX,AX	;QUOTIENT
	MOV	BX,DX	;REMAINDER
	POP	DX	;DX RESTORED
	RET
	;
CHKSGN:
	OR	BX,BX	;SET FLAGS TO CHECK SIGN
	JNS	RET	;IFF -, CHANGE SIGN
	;
CHGSGN:
	NOT	BX	;****CHGSGN****
	INC	BX
	XOR	CH,128
	RET
	;
CKHLDE:
	MOV	AL,BH
	XOR	AL,DH	;SAME SIGN?
	JNS	CK1	;YES, COMPARE
	XCHG	DX,BX
CK1:
	CMP	BX,DX
	RET
;
;
; ****SETVAL**** AND ****FIN**** AND ****ENDCHK****
; ****ERROR**** AND FRIENDS
;
;
; 'SETVAL' EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
; THEN AN EXPR. IT EVALUATES THE EXPR AND SETS THE  VARIABLE
; TO THAT VALUE.
;
; 'FIN' CHECKS THE END OF A COMMAND. IFF IT ENDED WITH ";" ,
; EXECUTION CONTINUES. IFF IT ENDED WITH A CR, IT FINDS  THE
; NEXT LINE AND CONTINUES FROM THERE.
;
; 'ENDCHK' CHECKS IFF A COMMAND IS ENDED WITH A CR, THIS  IS
; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP,ETC)
;
; 'ERROR' PRINTS THE STRING POINTED BY DX (AND ENDS  WITH  A
; CR). IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A ?.
; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD  BE  ON TOP
; OF THE STACK) POINTS TO. EXECUTION OF TB IS  STOPPED   AND
; TBI IS RESTARTED. HOWEVER, IFF 'CURRNT' -> ZERO (INDICAT -
; ING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT PRINTED ,
; AND IFF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT' COMMAND
; THE INPUT LINE IS NOT PRINTED AND EXECUTION IS NOT TERMIN-
; ATED BUR CONTINUED AT 'INPERR').
;
; RELATED TO 'ERROR' ARE THE FOLLOWING:
;
;	'QWHAT' SAVES TEXT POINTER IN STACK AND GETS MESSAGE
;		"WHAT?"
;	'AWHAT'	JUST GETS MESSAGE "WHAT?" AND JUMPS TO ERROR
;
;	'QSORRY' AND 'ASORRY' DO THE SAME KIND OF THING.
;
;	'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO   DO
;		THIS.
;
;
SETVAL:
	CALL	TSTV	;SEE IT IT'S A VARIABLE
	JC	QWHAT	;"WHAT" NO VARIABLE
	PUSH	BX	;SAVE ADDR OF VARIABLE
	MOV	AH,'='
	CALL	IGNBLNK
	JNZ	SV1
	CALL	EXP
	MOV	CX,BX	;VALUE IN CX NOW
	POP	BX	;GET ADDR
	MOV	[BX],CL	;SAVE VALUE
	INC	BX
	MOV	[BX],CH	;SAVE VALUE
	RET
SV1:
	JMP	QWHAT	;NO '=' SIGN
	;
FIN:
	MOV	AH,';'
	CALL	IGNBLNK
	JNZ	FI1
	POP	AX
	JMP	RUNSML
FI1:
	MOV	AH,0DH
	CALL	IGNBLNK
	JNZ	RET
	POP	AX
	JMP	RUNNXL	;RUN NEXT LINE
FI2:
	RET	;ELSE RETURN TO CALLER
	;
ENDCHK:
	MOV	AH,0DH	;END WITH CR?
	CALL	IGNBLNK
	JZ	RET	;OK, ELSE SAY "WHAT?"
	;
QWHAT:
	PUSH	DX	;****QWHAT****
AWHAT:
	MOV	DX,WHAT	;****AWHAT****
ERROR:
	SUB	AL,AL	;****ERROR****
	CALL	PRTSTG	;PRINT 'WHAT?','HOW?'
	POP	DX
	MOV	SI,DX
	LODB
	PUSH	AX	;SAVE THE CHARACTER
	SUB	AL,AL	;AND PUT A ZERO THERE
	MOV	DI,DX
	STOB
	MOV	BX,[CURRNT]	;GET CURRENT LINE #
	CMP	W,[CURRNT],0	;DIRECT COMMAND?
	JNZ	ERR1	;IFF ZERO, JUST RESTART
	JP	ERR2	;SAVE A BYTE
ERR1:	MOV	AL,[BX]	;IFF NEGATIVE,
	OR	AL,AL
	JNS	ERR1A
	JMP	INPERR	;REDO INPUT
ERR1A:	CALL	PRTLN	;ELSE PRINT THE LINE
	DEC	DX
	POP	AX
	MOV	DI,DX
	STOB	;RESTORE THE CHAR
	MOV	AL,63	;PRINT A '?'
	CALL	CHROUT
	SUB	AL,AL	;AND THE REST OF THE
	CALL	PRTSTG	;LINE
ERR2:	JMP	RSTART	
QSORRY:
	PUSH	DX	;****QSORRY****
ASORRY:
	MOV	DX,SORRY	;****ASORRY****
	JP	ERROR
;
;
; ****GETLN**** AND ****FNDLN****
;
;
; 'GETLN' READS AN INPUT LINE INTO 'BUFFER'. IT FIRST PROMPTS
; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS THE
; BUFFER AND ECHOS IT. IT USES BDOS PRIMITIVES TO  ACCOMPLISH
; THIS. ONCE A FULL LINE IS READ IN, 'GETLN' RETURNS.
;
; 'FNDLN' FINDS A LINE WITH A GIVEN LINE #(IN BX) IN THE TEXT
; SAVE AREA. DX IS USED AS THE TEXT POINTER. IFF THE LINE  IS
; FOUND, DX WILL POINT TO THE BEGINNING OF THAT LINE IFF THAT
; LINE (I.E. THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC&Z.
; IFF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE  #
; IS FOUND, DX POINTS TO THERE AND FLAGS ARE NC&NZ.  IFF   WE
; REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE LINE,
; FLAGS ARE C&NZ.
; 'FNDLN' WILL INITIALIZE DX TO THE  BEGINNING  OF  THE  TEXT
; SAVE AREA TO START THE SEARCH. SOME OTHER ENTRIES  OF  THIS
; ROUTINE WILL NOT INITIALIZE DX AND DO THE SEARCH.
;
; 'FNDLNP' WILL START WITH DX AND SEARCH FOR THE LINE #.
;
; 'FNDNXT' WILL BUMP DX BY  2, FIND A 0DH AND THEN START  THE
;	SEARCH.
; 'FNDSKP' USES DX TO FIND A CR, AND THEN STARTS THE SEARCH.
;
;
;
GETLN:
	CALL	CHROUT	;****GETLN****
GL1:
	MOV	DX,BUFFER-2
	PUSH	DX
	MOV	AH,BCONIN ;BUFFERED CONSOLE INPUT
	INT	33	;CALL MS-DOS
	POP	DX
	ADD	DL,[BUFFER-1]
	INC	DX
	INC	DX
	INC	DX
	MOV	DI,DX	;FOR CONSISTANCY
	PUSH	DX
	CALL	CRLF	;NEED CRLF
	POP	DX
	RET	;WE'VE GOT A LINE
;
; AT ENTRY BX -> LINE # TO BE FOUND
;
FNDLN:
	OR	BX,BX	;CHECK SIGN OF BX
	JNS	FND1	;IT CAN'T BE -
	JMP	QHOW	;ERROR
FND1:	MOV	DX,TXTBGN
	;
FNDLNP:
FL1:
	PUSH	BX	;SAVE LINE #
	MOV	BX,[TXTUNF]	;CHECK IFF WE PASSED END
	DEC	BX
	CMP	BX,DX	;SUBSTITUTE FOR CALL 4
	POP	BX	;GET LINE # BACK
	JC	RET	;C, NZ PASSED END
	MOV	SI,DX
	LODW
	CMP	AX,BX
	JC	FL2
	RET	;NC,Z:FOUND;NC,NZ:NOT FOUND
	;
FNDNXT:                 ;****FNDNXT****
	INC	DX
FL2:
	INC	DX
	;
FNDSKP:
	MOV	SI,DX
	LODB	;****FNDSKP****
	CMP	AL,0DH	;TRY TO FIND CR
	JNZ	FL2	;KEEP LOOKING
	INC	DX
	JP	FL1	;CHECK IFF END OF TEXT
;
;
; **** PRTSTG **** QTSTG **** PRTNUM **** PRTLN ****
;
;
; 'PRTSTG PRINTS A STRING POINTED TO BY DX. IT STOPS PRINTING
; AND RETURNS TO CALLER WHEN EITHER A 0DH IS PRINTED OR  WHEN
; THE NEXT BYTE IS THE SAMES AS WHAT WAS IN A  ( GIVEN BY THE
; CALLER). OLD AL IS STORED IN CH, OLD CH IS LOST.
;
; 'QTSTG' LOOKS FOR A BACK-SLASH,  SINGLE QUOTE,   OR  DOUBLE
; QUOTE. IFF NONE OF THESE, RETURN TO CALLER. IF BACK SLASH \
; OUTPUT A ODH WITHOUT A LF. IFF SINGLE OR DOUBLE QUOTE,PRINT
; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE. AF-
; TER THE PRINTING THE NEXT 3 BYTES OF THE CALLER  IS SKIPPED
; OVER (USUALLY A JMP INSTRUCTION).
;
; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS  ARE ADDED
; IFF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN  C.
; NOWEVER, IFF THE NUMBER OF DIGITS IS LARGER THAN THE NUMBER
; IN C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS  ALSO
; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
;
; 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL.
;
;
;
PRTSTG:
	MOV	CH,AL	;****PRTSTG****
PS1:
	MOV	SI,DX
	LODB	;GET A CHAR
	LAHF            ;PRESERVE FLAGS
	INC	DX
	SAHF	        ;RESTORE FLAGS
	CMP	AL,CH	;SAME AS OLD A?
	JNZ	PS2	;YES, RETURN
        RET
PS2:	CALL	CHROUT	;ELSE, PRINT IT
	CMP	AL,0DH	;WAS IT A CR?
	JNZ	PS1	;NO, NEXT
	RET
	;
QTSTG:
	MOV	AH,'"'
	CALL	IGNBLNK
	JNZ	QT3
	MOV	AL,34	;IT IS A '"'
QT1:
	CALL	PRTSTG	;PRINT UNTIL ANOTHER
	CMP	AL,0DH	;WAS LAST ONE A CR?
	POP	BX	;RETURN ADDRESS
	JNZ	QT2	;WAS CR, RUN NEXT LINE
        JMP     RUNNXL
QT2:
	INC	BX	;SKIPS TWO BYTES ON RETURN!!!!
	INC	BX
	JMP	BX	;JUMP TO ADDRESS IN BX
QT3:
	MOV	AH,39	;IS IT A SINGLE QUOTE (')?
	CALL	IGNBLNK
	JNZ	QT4
	MOV	AL,39	;YES, DO SAME
	JP	QT1	;AS IN ' " '
QT4:
	MOV	AH,'\'
	CALL	IGNBLNK	;IS IT BACK-SLASH?('\')
	JNZ	QT5
	MOV	AL,141	;YES, 0DH WITHOUT LF!
	CALL	CHROUT	;DO IT TWICE
	CALL	CHROUT	;TO GIVE TTY ENOUGH TIME
	POP	BX	;RETURN ADDRESS
	JP	QT2
QT5:
	RET		;NONE OF THE ABOVE
	;
; ON ENTRY BX = BINARY #,CL = # SPACES
;
PRTNUM:
	PUSH	DX	;****PRTNUM****
	MOV	DX,10	;DECIMAL
	PUSH	DX	;SAVE AS A FLAG
	MOV	CH,DH	;CH=SIGN
	DEC	CL	;CL=SPACES
	CALL	CHKSGN	;CHECK SIGN
	JNS	PN1	;NO SIGN
	MOV	CH,45	;CH=SIGN
	DEC	CL	;'-' TAKES SPACE
PN1:
	PUSH	CX	;SAVE SIGN % SPACE
PN2:
	CALL	DIVIDE	;DIVIDE BX BY 10 (IN DX)
	OR	CX,CX	;CX HAS QUOTIENT
	JZ	PN3	;YES, WE GOT ALL
	POP	AX	;GET SIGN AND SPACE COUNT
	PUSH	BX	;SAVE REMAINDER
	DEC	AL	;DEC SPACE COUNT
	PUSH	AX	;SAVE NEW SIGN AND SPACE COUNT
	MOV	BX,CX	;MOVE RESULT TO BX
	JP	PN2	;AND DIVIDE BY 10
PN3:
	POP	CX	;WE GOT ALL DIGITS IN
PN4:
	DEC	CL	;THE STACK
	MOV	AL,CL	;LOOK AT SPACE COUNT
	OR	AL,AL
	JS	PN5	;NO LEADING BLANKS
	MOV	AL,32	;LEADING BLANKS
	CALL	CHROUT
	JP	PN4
PN5:
	MOV	AL,CH	;PRINT SIGN
	CALL	CHROUT	;MAYBE, OR NULL
	MOV	DL,BL	;LAST REMAINDER IN E
PN6:
	MOV	AL,DL	;CHECK DIGIT IN E
	CMP	AL,10	;10 IS FLAG FOR NO MORE
	POP	DX
	JZ	RET	;IFF SO, RETURN
	ADD	AL,48	;ELSE CONVERT TO ASCII
	CALL	CHROUT	;AND PRINT THE DIGIT
	JP	PN6	;GO BACK FOR MORE
	;
PRTLN:
	MOV	SI,DX
	LODW
	MOV	BX,AX
	INC	DX
	INC	DX	;MOVE POINTER
PRTLN1:	MOV	CL,5	;PRINT 5 DIGIT LINE #
	CALL	PRTNUM
	MOV	AL,32	;FOLLOWED BY A BLANK
	CALL	CHROUT
	SUB	AL,AL	;AND THEN THE TEXT
	CALL	PRTSTG
	RET
;
;
;
; **** MVUP **** MVDOWN **** POPA **** PUSHA ****
;
; 'MVUP' MOVES A BLOCK UP FROM WHERE DX -> WHERE CX -> UNTIL
; DX = BX
;
; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DX -> TO WHERE BX->
; UNTIL DX = CX.
;
; 'POPA' RESTORES THE 'FOR' LOOP VAR SAVE AREA FROM THE STACK.
;
; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA IN THE STACK
;
;
MVUP:
	CMP	DX,BX	;***MVUP***
	JZ	RET	;DE = HL, RETURN
	MOV	SI,DX
	LODB	;GET ONE BYTE
	MOV	DI,CX
	STOB	;MOVE IT
	INC	DX
	INC	CX
	JP	MVUP	;UNTIL DONE
	;
MVDOWN:
	CMP	DX,CX
	JZ	RET	;YES, RETURN
MD1:
	LAHF
	DEC	DX
	DEC	BX
	MOV	SI,DX
	LODB	;BOTH POINTERS AND
	MOV	[BX],AL	;THEN DO IT
	JP	MVDOWN	;LOOP BACK
	;
POPA:
	POP	CX	;CX = RETURN ADDR
	POP	BX	;RESTORE LOPVAR, BUT
	MOV	[LOPVAR],BX	;=0 MEANS NO MORE
	OR	BX,BX
	JZ	PP1	;YES, GO RETURN
	POP	BX	;NO, RESTORE OTHERS
	MOV	[LOPINC],BX
	POP	BX
	MOV	[LOPLMT],BX
	POP	BX
	MOV	[LOPLN],BX
	POP	BX
	MOV	[LOPPT],BX
PP1:
	PUSH	CX	;CX = RETURN ADDR
	RET
	;
PUSHA:
	MOV	BX,STKLMT	;****PUSHA****
	CALL	CHGSGN
	POP	CX	;CX=RET ADDR
	ADD	BX,SP
	JC	PUSHB	;YES, SORRY FOR THAT.
        JMP     QSORRY
PUSHB:	MOV	BX,[LOPVAR]	;ELSE SAVE LOOP VARS
	OR	BX,BX	;THAT WILL BE ALL
	JZ	PU1
	MOV	BX,[LOPPT]	;ELSE, MORE TO SAVE
	PUSH	BX
	MOV	BX,[LOPLN]	;ELSE, MORE TO SAVE
	PUSH	BX
	MOV	BX,[LOPLMT]
	PUSH	BX
	MOV	BX,[LOPINC]
	PUSH	BX
	MOV	BX,[LOPVAR]
PU1:
	PUSH	BX
	PUSH	CX	;CX = RETURN ADDR
	RET
	;
	;
	; **** OUTC **** CHKIO ****
	;
	;
	; THESE ARE THE ONLY I/O ROUTINES IN TBI.
	;
	;
	; 'CHKIO' CHECKS THE INPUT, IFF NO INPUT, IT WILL RETURN TO  THE
	; CALLER WITH THE Z FLAG SET. IFF THERE IS INPUT, THE Z FLAG  IS
	; CLEARED AND THE INPUT BYRE IS IN A. HOWEVER, IFF THE INPUT  IS
	; A CONTROL-O, THE 'OCSW' IS COMPLIMENTED, AND THE Z FLAG IS RE-
	; TURNED. IFF A CONTROL-C IS READ, 'CHKIO' WILL RESTART TBI  AND
	; DOES NOT RETURN TO THE CALLER.
	;
CRLF:	MOV	AL,0DH	;****CRLF****
CHROUT:
	CMP	[OCSW],0
	JZ	COUT1	;SEE IF OUTPUT REDIRECTED
	PUSH	CX	;SAVE CX ON STACK
	PUSH	DX	;AND DX
	PUSH	BX	;AND BX TOO
	MOV	[OUTCAR],AL	;SAVE CHATACTER
	MOV	DL,AL	;PUT CHAR IN E FOR CP/M
	MOV	AH,CONOUT ;CONSOLE OUTPUT
	INT	33	;CALL MS-DOS AND OUTPUT CHAR
	MOV	AL,[OUTCAR]	;GET CHAR. BACK
	CMP	AL,0DH	;WAS IT A 'CR'?
	JNZ	DONE	;NO,DONE
	MOV	DL,0AH	;GET LINEFEED
	MOV	AH,CONOUT ;CONSOLE OUTPUT AGAIN
	INT	33	;CALL MS-DOS
DONE:
	MOV	AL,[OUTCAR]	;GET CHAR BACK
IDONE:
	POP	BX	;GET H BACK
	POP	DX	;AND D
	POP	CX	;THEN H
	RET	;DONE AT LAST
COUT1:
	CMP	B,AL,0	;IS IT NULL?
	JZ	RET	;SKIP IT
	STOB		;STORE AL (CHAR) IN BUFFER
	INC	[BUFFER-1] ;INCREMENT COUNTER
	RET		;DONE
CHKIO:
	PUSH	CX	;SAVE B ON STACK
	PUSH	DX	;AND D
	PUSH	BX	;THEN H
	MOV	AH,CONST ;GET CONSOLE STATUS WORD
	INT	33	;CALL MS-DOS
	OR	AL,AL	;SET FLAGS
	JNZ	CI1	;IF READY, GET CHAR
	JP	IDONE	;RESTORE AND RETURN
CI1:
	MOV	AH,1	;CALL THE BDOS
	INT	33	;CALL MS-DOS
CI2:
	CMP	AL,18H	;IS TI CONTROL-X?
	JNZ	IDONE	;RETURN AND RESTORE IF NOT
	JMP	RSTART	;YES, RESTART TBI
LSTROM:	EQU	$	;ALL ABOVE CAN BE ROM
OUTIO:
	OUTB	0FFH
	RET
WAITIO:
	INB	0FFH
	XOR	AL,BH
	AND	AL,BL
	JZ	WAITIO
	CALL	FINISH
INPIO:
	INB	0FFH
	MOV	BL,AL
	RET
	;
;
; IGNBLNK
;
;	DEBLANKS WHERE DX->
;	IF (DX)=AH THEN DX:=DX+1
;
IGNBLNK:MOV	SI,DX
IGN1:   LODB            ;GET CHAR IN AL
	CMP	AL,32	;IGNORE BLANKS
	JNZ	IGN2	;IN TEXT (WHERE DX ->)
        INC     DX
        JP      IGN1
IGN2:	CMP	AL,AH	;IS SEARCH CHARACTER FOUND AT (DX)?
	JNZ	RET	;NO, RETURN, POINTER (DX) STAYS
	LAHF		;SAVE RESULTS OF COMPARISON
	INC	DX	;INC POINTER IF CHARACTER MATCHES
	SAHF		;RETURN RESULT OF COMPARISON TO FLAGS
	RET
	;
FINISH:	POP	AX
	CALL	FIN	;CHECK END OF COMMAND
	JMP	QWHAT	;PRINT "WHAT?" IFF WRONG
	;
OUTCAR:
	DB	0	;OUTPUT CHAR STORAGE
OCSW:
	DB	0FFH	;OUTPUT SWITCH
CURRNT:
	DW	0	;POINTS TO CURRENT LINE
STKGOS:
	DW	0	;SAVES SP IN 'GOSUB'
VARNXT:
	DW	0	;TEMP STORAGE
STKINP:
	DW	0	;SAVES SP IN 'INPUT'
LOPVAR:
	DW	0	;'FOR' LOOP SAVE AREA
LOPINC:
	DW	0	;INCREMENT
LOPLMT:
	DW	0	;LIMIT
LOPLN:
	DW	0	;LINE NUMBER
LOPPT:
	DW	0	;TEST POINTER
RANPNT:
	DW	0	;RANDOM NUMBER POINTER
TXTUNF:
	DW	TXTBGN	;-> UNFILLED TEXT AREA
TXTBGN:	DS	1
MSG1:	DB	'8086 TINY BASIC V1.1 27 JUNE 82',0DH
	ORG	2000H	;MISC STORAGE, INCLUDING STACK
TXTEND:	EQU	$	;TEST AREA SAVE AREA ENDS
VARBGN:
	DS	54	;VARIABLE @(0)
	DB	80	;MAX CHARS IN BUFFER
	DB	0	;CHAR COUNT
BUFFER:
	DS	80	;BUFFER MUST BE AFTER TEXT AREA
BUFEND:	EQU	$
	DS	400	;EXTRA BYTES FOR STACK
STKLMT:	DS	100	;TOP LIMIT FOR STACK
STACK:	EQU	$	;STACK STARTS HERE
	END