GWMAIN.ASM

; [ This translation created 10-Feb-83 by Version 4.3 ]

	.RADIX	8		; To be safe

CSEG	SEGMENT PUBLIC 'CODESG'
	ASSUME	CS:CSEG

INCLUDE BINTRP.H

	TITLE	GWMAIN Copied from BINTRP.MAC

	.RADIX	10

COMMENT *

--------- ---- -- ---- ----- --- ---- -----
COPYRIGHT 1975 BY BILL GATES AND PAUL ALLEN
--------- ---- -- ---- ----- --- ---- -----

ORIGINALLY WRITTEN ON THE PDP-10 FROM
FEBRUARY 9 TO  APRIL 9 1975

BILL GATES WROTE A LOT OF STUFF.
PAUL ALLEN WROTE A LOT OF OTHER STUFF AND FAST CODE.
MONTE DAVIDOFF WROTE THE MATH PACKAGE (F4I.MAC).

*

	.XLIST

FETOK=0			;For FE extended tokens
FDTOK=0			;For FD tokens too.  (Must have
				;FETOK==1.)
				;tokens.
INTDEX=0			;For Intelledex version.
NMPAGE=1			;Number of text pages (for GW
				;Multi-page)
				;KPOS, etc.
LNREAD=0			;For LINE READ statement
MELCO=0			;Mitsubishi Electronics Co.
SIRIUS=0
MCI=0
ZENITH=0			;ZENITH 8086
TETRA=0
CPM86=0
HAL=0
GENFLS=0
PANDBL=0
TSHIBA=0
SGS=0
ALPS=0
ALPCPM=0
GENWID=0
NNECBS=0
CAN8=0
PC8A=0

	FN2SW=0		;IBMTOK versions dispatch from IBMRES.MAC
	_LABEL=PC8A
	HLPEDT=PC8A

OKI=0
BUBL=0
	NORNF=0
IEESLV=0
TRSHHC=0
OLVPPC=0
NECPPC=0
USA=0				;For HHC-USA version
EUROPE=0			;For HHC-EUROPE version

	.LIST

;Local Switches
;
	LTRACE=ALPCPM		;trace output selectable
	_LABEL=PC8A
	HLPEDT=PC8A
	UCEMSG=NNECBS		;Upper case error messages.
	OLD86=MELCO AND CPM86	;For "old" 8086 error messages (prior
				;to alignment for IBM compatibility).

	OLDBLD=ALPCPM OR ALPS OR OKI OR HAL OR PC8A OR BUBL OR GW OR TSHIBA

	INCLUDE GIO86U
	INCLUDE MSDOSU		;MSDOS constants




	EXTRN	INIT:NEAR



	EXTRN	SETGSB:NEAR
DSEG	SEGMENT PUBLIC 'DATASG'
	ASSUME DS:DSEG
	EXTRN	ONGSBF:WORD
DSEG	ENDS


	BUFOFS=0

	BUFOFS=2		;MUST CRUNCH INTO ERALIER PLACE FOR
				; SINGLE QUOTE

	KBFLEN=BUFLEN+(BUFLEN/4)	;MAKE KRUNCH BUFFER SOMEWHAT
				; LARGER THAN SOURCE BUFFER (BUF)




	EXTRN	_NAME:NEAR
	EXTRN	INLIN:NEAR,CRDO:NEAR,CRDONZ:NEAR,STRCMP:NEAR,PPSWRT:NEAR

	EXTRN	OUTDO:NEAR

	EXTRN	BLTU:NEAR,CLEARC:NEAR,GTMPRT:NEAR,ISLET:NEAR,ISLET2:NEAR
	EXTRN	PTRGET:NEAR
	EXTRN	QINLIN:NEAR,SCRTCH:NEAR,STKINI:NEAR,RUNC:NEAR,RESFIN:NEAR
	EXTRN	PTRGT2:NEAR,STPEND:NEAR

	EXTRN	SYNCHR:NEAR

	EXTRN	SIGN:NEAR

	EXTRN	PRGFIN:NEAR,FILIND:NEAR

	EXTRN	FILINP:NEAR,INDSKC:NEAR


	EXTRN	LRUN:NEAR


	EXTRN	INXHRT:NEAR
	EXTRN	ZERO:NEAR,MOVE:NEAR,FOUT:NEAR,FIN:NEAR,_PUSHF:NEAR
	EXTRN	MOVFR:NEAR,MOVRF:NEAR,MOVRM:NEAR,INPRT:NEAR,LINPRT:NEAR
	EXTRN	MOVFM:NEAR,MOVMF:NEAR
	EXTRN	INRART:NEAR,_NEG:NEAR
	EXTRN	FREFAC:NEAR,FRETMS:NEAR,STRCPY:NEAR,GETSTK:NEAR
	EXTRN	STRLIT:NEAR,STRLT2:NEAR,STRLT3:NEAR,STRLTI:NEAR,STROUT:NEAR
	EXTRN	STRPRT:NEAR,STROUI:NEAR
	EXTRN	GETSPA:NEAR,PUTNEW:NEAR,STOP:NEAR,OMERR:NEAR,REASON:NEAR


	EXTRN	_INSTR:NEAR

	EXTRN	PRINUS:NEAR,PUTTMP:NEAR

	EXTRN	FOUTH:NEAR,FOUTO:NEAR,STRO$:NEAR,STRH$:NEAR


	EXTRN	STRNG$:NEAR
	EXTRN	TON:NEAR,TOFF:NEAR
	EXTRN	SPACE$:NEAR

	EXTRN	SIGNS:NEAR




	EXTRN	UMULT:NEAR

	EXTRN	SIGNC:NEAR,POPHRT:NEAR

	EXTRN	FINLPT:NEAR

	EXTRN	VMOVFA:NEAR,VMOVAF:NEAR,ISIGN:NEAR,VSIGN:NEAR,VDFACS:NEAR
	EXTRN	VMOVMF:NEAR,VMOVFM:NEAR,FRCINT:NEAR,FRCDBL:NEAR,FRCSNG:NEAR
	EXTRN	VNEG:NEAR,PUFOUT:NEAR,DCXBRT:NEAR,IADD:NEAR
	EXTRN	FINDBL:NEAR
	EXTRN	VMOVE:NEAR,VALINT:NEAR,VALSNG:NEAR,FRCSTR:NEAR,CHKSTR:NEAR
	EXTRN	MAKINT:NEAR
	EXTRN	MOVE1:NEAR

	EXTRN	SCNSEM:NEAR
	EXTRN	_WHILE:NEAR,WEND:NEAR
	EXTRN	CALLS:NEAR
	EXTRN	PROCHK:NEAR
	EXTRN	WRITE:NEAR
;The following block of externals was added on Dec 19, 1982 when BINTRP was
; Split up after the freeze of GW-BASIC Version 1.0
; This Split-up was not reflected in the PS1:<BASIC>BINTRP.MAC source.
; See Tom Corbett if you have any questions.
;
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	MEMSIZ:WORD,FRETOP:WORD,VARTAB:WORD,STREND:WORD,TXTTAB:WORD
	EXTRN	ARYTAB:WORD
	EXTRN	CURLIN:WORD,DOT:WORD,DATLIN:WORD,NLONLY:WORD,ERRLIN:WORD
	EXTRN	ERRTXT:WORD
	EXTRN	MRGFLG:WORD,CHNFLG:WORD
	EXTRN	SAVSTK:WORD,SAVTXT:WORD,OLDLIN:WORD,NXTLIN:WORD,OLDTXT:WORD
	EXTRN	ONELIN:WORD,ONEFLG:WORD
	EXTRN	CNTOFL:WORD,TRCFLG:WORD,CONSAV:WORD,CONTXT:WORD,CONTYP:WORD
	EXTRN	NUMCON:WORD,CONLO:WORD
	EXTRN	AUTFLG:WORD,AUTLIN:WORD,AUTINC:WORD
	EXTRN	KBUF:WORD,BUFMIN:WORD,BUF:WORD
	EXTRN	PTRFIL:WORD,PTRFLG:WORD,DORES:WORD,VALTYP:WORD,FACLO:WORD
	EXTRN	DFACLO:WORD,FAC:WORD
	EXTRN	TEMP:WORD,TEMP2:WORD,TEMP3:WORD,TEMPA:WORD
	EXTRN	DSCTMP:WORD,TEMPST:WORD
	EXTRN	OPRTYP:WORD
	EXTRN	SUBFLG:WORD,FVALSV:WORD,DEFTBL:WORD,FLGINP:WORD,FLGSCN:WORD
	EXTRN	OVCSTR:WORD,INPPAS:WORD
	EXTRN	USRTAB:WORD,DONUM:WORD,ENDPRG:WORD,ENDFOR:WORD,DATPTR:WORD
	EXTRN	FLGOVC:WORD
	EXTRN	ERRFLG:WORD,SAVSEG:WORD,PRMLN2:WORD,PRMSIZ:WORD,PARM2:WORD
	EXTRN	PRMLEN:WORD,PRMSTK:WORD,PARM1:WORD
	EXTRN	FUNACT:WORD,NOFUNS:WORD,OPTVAL:WORD,OPTFLG:WORD,RNDX:WORD
DSEG	ENDS

	EXTRN	INEG2:NEAR,_FADD:NEAR
	EXTRN	$OVMSG:NEAR,ERRTAB:NEAR,LSTERR:NEAR,DSKERR:NEAR,NONDSK:NEAR
	EXTRN	REDDY:NEAR
	EXTRN	ERRSN:NEAR,ERRDV0:NEAR,ERRRE:NEAR,ERROV:NEAR,ERRMO:NEAR
	EXTRN	ERRTM:NEAR,ERRNF:NEAR
	EXTRN	ERRNR:NEAR,ERRLBO:NEAR,ERRDD:NEAR,ERRUF:NEAR,ERRFC:NEAR
	EXTRN	ERRIFN:NEAR,ERRFNO:NEAR,ERRDNA:NEAR,ERRFDR:NEAR,ERRRAD:NEAR
	EXTRN	ERRDFL:NEAR
	EXTRN	ERRIOE:NEAR,ERRBFM:NEAR,ERRFNF:NEAR,ERRBFN:NEAR,ERRIER:NEAR
	EXTRN	ERRRPE:NEAR
	EXTRN	ERRFAO:NEAR,ERRNMF:NEAR,ERRWH:NEAR,ERRBRN:NEAR,ERRFOV:NEAR
	EXTRN	ERRTMF:NEAR
	EXTRN	ERRFAE:NEAR,ERRUS:NEAR,ERRRG:NEAR,ERROD:NEAR,ERRFN:NEAR
	EXTRN	ERRUE1:NEAR	;ERRUE+DSKERR-NONDSK
	EXTRN	DSKER1:NEAR	;DSKERR-NONDSK

;The following externs are defined in GWEVAL.MAC
;
	EXTRN	MAKUPL:NEAR,MAKUPS:NEAR,GETYPR:NEAR,OCTCNS:NEAR,DOCNVF:NEAR
	EXTRN	ISMID$:NEAR
	EXTRN	FRMEVL:NEAR,FRMCHK:NEAR,GETINT:NEAR,GETBYT:NEAR,GETIN2:NEAR
	EXTRN	SNGFLT:NEAR

;The following externs are defined in GWLIST.MAC
;
	EXTRN	DELETE:NEAR,DEL:NEAR,TSTANM:NEAR,PLOOP2:NEAR



	SUBTTL ROM VERSION INITALIZATION, AND CONSTANTS



;
; The reserved word tables are in another module.  Consequently
; many things must be declared external.  All of these things
; are in the code segement or are absolutes (like tokens).
; I.e., they are not in the data segment.
;

	EXTRN	ALPTAB:NEAR
	EXTRN	EQULTK:NEAR
	EXTRN	STMDSP:NEAR
	EXTRN	GREATK:NEAR
	EXTRN	INSRTK:NEAR
	EXTRN	LESSTK:NEAR,LSTOPK:NEAR
	EXTRN	MIDTK:NEAR,MINUTK:NEAR
	EXTRN	NMREL:NEAR,NOTTK:NEAR,NUMCMD:NEAR
	EXTRN	ONEFUN:NEAR
	EXTRN	POS:NEAR,PLUSTK:NEAR,PRINT:NEAR
	EXTRN	RESLST:NEAR
	EXTRN	SNGQTK:NEAR,SPCTAB:NEAR,SQRTK:NEAR,STEPTK:NEAR
	EXTRN	THENTK:NEAR
	EXTRN	USRTK:NEAR
	EXTRN	$AUTO:NEAR
	EXTRN	$DATA:NEAR,$DATCO:NEAR,$DELETE:NEAR
	EXTRN	$EDIT:NEAR,$ELSE:NEAR,$END:NEAR,$ERL:NEAR,$ERROR:NEAR
	EXTRN	$FN:NEAR,$FOR:NEAR
	EXTRN	$GOSUB:NEAR,$GOTO:NEAR
	EXTRN	$IF:NEAR,$INKEY$:NEAR,$INPUT:NEAR
	EXTRN	$LIST:NEAR,$LLIST:NEAR
	EXTRN	$NEXT:NEAR
	EXTRN	$POINT:NEAR,$PRINT:NEAR
	EXTRN	$REM:NEAR,$REMCO:NEAR,$RENUM:NEAR,$RESTORE:NEAR,$RESUME:NEAR
	EXTRN	$RETURN:NEAR,$RND:NEAR,$RUN:NEAR
	EXTRN	$SCREEN:NEAR,$STOP:NEAR,$STRING$:NEAR
	EXTRN	$THEN:NEAR,$TO:NEAR
	EXTRN	$USR:NEAR
	EXTRN	$VARPTR:NEAR
	EXTRN	$WEND:NEAR,$WHILE:NEAR

;
; Since the dispatch table is also no longer in BINTRP many
; addresses need to be declared internal.
;

	PUBLIC	AUTO
	PUBLIC	DATAS,DEFDBL,DEFINT,DEFREA,DEFSTR
	PUBLIC	ELSES,ERRORS
	PUBLIC	_FOR
	PUBLIC	GOSUB,_GOTO
	PUBLIC	IFS,INPUT
	PUBLIC	LET,LINE
	PUBLIC	ONGOTO,_OPTION
	PUBLIC	PEEK,POKE
	PUBLIC	RANDOM,READ,REM,RESEQ,RESUME,RETURN,RUN


	SUBTTL	      GENERAL STORAGE MANAGEMENT ROUTINES - FNDFOR, BLTU, GETSTK
;
; FIND A "FOR" ENTRY ON THE STACK WITH THE VARIABLE POINTER
; PASSED IN [D,E].
;
PUBLIC	FNDFOR
FNDFOR: MOV	BX,OFFSET 4+0	;IGNORING EVERYONES "NEWSTT"
				;AND THE RETURN ADDRESS OF THIS
	ADD	BX,SP		;SUBROUTINE, SET [H,L]=SP
LOOPER:

	INC	BX		;8086 USES TWO BYTE ENTRIES

	MOV	AL,BYTE PTR [BX]	;SEE WHAT TYPE OF THING IS ON THE STACK
	INC	BX

	WHLSIZ=6
	CMP	AL,LOW OFFSET $WHILE
	JNZ	SHORT STKSRC
	MOV	CX,OFFSET WHLSIZ
	ADD	BX,CX
	JMP	SHORT LOOPER
STKSRC:

	CMP	AL,LOW OFFSET $FOR	;IS THIS STACK ENTRY A "FOR"?
	JZ	SHORT $+3
	RET			;NO SO OK
	MOV	CL,BYTE PTR [BX]
	INC	BX		;DO EQUIVALENT OF PUSHM / XTHL
	MOV	CH,BYTE PTR [BX]
	INC	BX
	PUSH	BX		;PUT H  ON
	MOV	BX,CX

	OR	DX,DX		;"NEXT" STATMENT WITHOUT AN ARGUMENT ?
				;WE MATCH ON ANYTHING
	XCHG	BX,DX		;MAKE SURE WE RETURN [D,E]
	JZ	SHORT POPGOF	;POINTING TO THE VARIABLE
	XCHG	BX,DX

	CMP	BX,DX
	FORSIZ=16

	FORSIZ=17
	FORSIZ=FORSIZ+2	;For text pointer into NEXT.

;
; Note - 8086 versions force stack entries to be an even length
; so stack accesses won't cross word boundaries.  This is done
; for speed.  To accomplish this, an extra byte is pushed on
; top of the FOR token.  This extra byte is NOT reflected in
; the value of FORSIZ but is taken care of by the code.
;

PUBLIC	FORSZC
	FORSZC=0+FORSIZ
POPGOF: MOV	CX,OFFSET FORSZC-3	;TO WIPE OUT A "FOR" ENTRY
				;Note that the pointer has already
				;been incremented three times.
	POP	BX
	JNZ	SHORT $+3
	RET			;IF VARIABLE IN THIS ENTRY MATCHES
				;RETURN WITH [H,L] POINTING THE BOTTOM
				;OF THE ENTRY
	ADD	BX,CX
	JMP	SHORT LOOPER	;NOW POINTING TO THE START OF THE NEXT
				;ENTRY. SEE IF ITS A "FOR" ENTRY
				;AND IF THE VARIABLE MATCHES




	SUBTTL ERROR HANDLING



;
; THIS ROUTINE IS CALLED TO RESET THE STACK IF BASIC IS
; EXTERNALLY STOPPED AND THEN RESTARTED.
;
PUBLIC	READYR
READYR: MOV	CX,OFFSET STPRDY	;ADDRESS GO TO, ALSO POP OFF GARBAGE STACK ENTRY.
	JMP	ERESET		;RESET STACK, GOTO READY.

PRGEND:
	MOV	BX,CURLIN	;GET CURRENT LINE #
	MOV	AL,BH		;SEE IF DIRECT
	AND	AL,BL		;AND TOGETHER
	INC	AL		;SET CC'S
	JZ	SHORT ENDCNJ	;IF DIRECT DONE, ALLOW FOR DEBUGGING PURPOSES
	MOV	AL,BYTE PTR ONEFLG	;SEE IF IN ON ERROR
	OR	AL,AL		;SET CC
	MOV	DL,LOW OFFSET ERRNR	;"NO RESUME" ERROR
	JNZ	SHORT ERROR	;YES, FORGOT RESUME
	EXTRN	ENDCON:NEAR
ENDCNJ: JMP	ENDCON		;NO, LET IT END

	DERMAK	IFN		;"Illegal File Name"
	DERMAK	FNO		;"File Not Open"
	DERMAK	DNA		;"Device not available"
	DERMAK	FDR		;"Direct statement in file"
	DERMAK	RAD		;"Rename across disk"
	DERMAK	DFL		;"DISK FULL"
	DERMAK	IOE		;"DISK I/O ERROR"
	DERMAK	BFM		;"BAD FILE MODE"
	DERMAK	FNF		;"FILE NOT FOUND"
	DERMAK	BFN		;"BAD FILE NUMBER"
	DERMAK	IER		;"INTERNAL ERROR"
	DERMAK	RPE		;"READ PAST END"
	DERMAK	FAO		;"FILE ALREADY OPEN"
	DERMAK	NMF		;"BAD FILE NAME"
	DERMAK	BRN		;"BAD RECORD NUMBER"
	DERMAK	FOV		;"FIELD OVERFLOW"
	DERMAK	TMF		;"TOO MANY FILES"
	DERMAK	FAE		;"FILE ALREADY EXISTS"
	ORG	$-1

	JMP	SHORT ERROR

DATSNE: MOV	BX,DATLIN	;GET DATA LINE
	MOV	CURLIN,BX	;MAKE IT CURRENT LINE

PUBLIC	$SNERR
$SNERR:

PUBLIC	SNERR
SNERR:	MOV	DL,LOW OFFSET ERRSN	;"SYNTAX ERROR"
	DB	271O	; SKIP  ;"LXI B," OVER THE NEXT 2
PUBLIC	DV0ERR
DV0ERR: MOV	DL,LOW OFFSET ERRDV0	;DIVISION BY ZERO
	DB	271O	; SKIP  ;"LXI B," OVER THE NEXT 2
PUBLIC	NFERR
NFERR:	MOV	DL,LOW OFFSET ERRNF	;"NEXT WITHOUT FOR" ERROR
	DB	271O	; SKIP  ;"LXI B," OVER THE NEXT TWO BYTES
PUBLIC	DDERR
DDERR:	MOV	DL,LOW OFFSET ERRDD	;"REDIMENSIONED VARIABLE"
	DB	271O	; SKIP  ;"LXI B," OVER THE NEXT 2 BYTES
PUBLIC	UFERR
UFERR:	MOV	DL,LOW OFFSET ERRUF	;"UNDEFINED FUNCTION" ERROR
	DB	271O	; SKIP  ;"LXI B," OVER THE NEXT TWO
REERR:	MOV	DL,LOW OFFSET ERRRE	;"RESUME WITHOUT ERROR"
	DB	271O	; SKIP  ;"LXI B," OVER THE NEXT TWO
PUBLIC	$OVERR
$OVERR:
PUBLIC	OVERR
OVERR:	MOV	DL,LOW OFFSET ERROV	;SET OVERFLOW ERROR CODE
	DB	271O	; SKIP  ;"LXI B," OVER NEXT TWO
PUBLIC	MOERR
MOERR:	MOV	DL,LOW OFFSET ERRMO	;MISSING OPERAND ERROR
	DB	271O	; SKIP  ;"LXI   B," OVER THE NEXT TWO
PUBLIC	$TMERR
$TMERR:
PUBLIC	TMERR
TMERR:	MOV	DL,LOW OFFSET ERRTM	;TYPE MISMATCH ERROR
PUBLIC	ERROR
ERROR:
	XOR	AL,AL
	MOV	BYTE PTR NLONLY,AL	;Clear Don't close files flag
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	INITFG:WORD
DSEG	ENDS
	EXTRN	CMDERR:NEAR
	MOV	AL,BYTE PTR INITFG
	OR	AL,AL		;0 implies initialization is incomplete
	JZ	SHORT ??L000
	JMP	INITOK		;Initialization has completed
??L000:
	JMP	CMDERR		;Execute command line error routine
				;which returns to the OS
INITOK:
	HLPEDT=PC8A
	MOV	BX,CURLIN	;GET CURRENT LINE NUMBER
	MOV	ERRLIN,BX	;SAVE IT FOR ERL VARIABLE
	XOR	AL,AL		;CLEAR CHAIN FLAG IN CASE OF ERROR
	MOV	BYTE PTR MRGFLG,AL	;ALSO MERGE FLAG
	MOV	BYTE PTR CHNFLG,AL	;SO IT DOESNT TRY TO CHAIN
	MOV	AL,BH		;ONLY SET UP DOT IF IT ISNT DIRECT
	AND	AL,BL
	INC	AL
	JZ	SHORT ERRESM
	MOV	DOT,BX		;SAVE IT FOR EDIT OR LIST
ERRESM: MOV	CX,OFFSET ERRMOR	;GET RETURN ADDRESS IN [B,C]
	EXTRN	STKERR:NEAR
PUBLIC	ERESET
ERESET: MOV	BX,SAVSTK	;GET A GOOD STACK BACK
	JMP	STKERR		;JUMP INTO STKINI
ERRMOR: POP	CX		;POP OFF FNDFOR STOPPER
	MOV	AL,DL		;[A]=ERROR NUMBER
	MOV	CL,DL		;ALSO SAVE IT FOR LATER RESTORE
	MOV	BYTE PTR ERRFLG,AL	;SAVE IT SO WE KNOW WHETHER TO CALL "EDIT"
	MOV	BX,SAVTXT	;GET SAVED TEXT POINTER
	MOV	ERRTXT,BX	;SAVE FOR RESUME.
	XCHG	BX,DX		;SAVE SAVTXT PTR
	MOV	BX,ERRLIN	;GET ERROR LINE #
	MOV	AL,BH		;TEST IF DIRECT LINE
	AND	AL,BL		;SET CC'S
	INC	AL		;SETS ZERO IF DIRECT LINE (65535)
	JZ	SHORT NTMDCN	;IF DIRECT, DONT MODIFY OLDTXT & OLDLIN
	MOV	OLDLIN,BX	;SET OLDLIN=ERRLIN.
	XCHG	BX,DX		;GET BACK SAVTXT
	MOV	OLDTXT,BX	;SAVE IN OLDTXT.
NTMDCN: MOV	BX,ONELIN	;SEE IF WE ARE TRAPPING ERRORS.
	OR	BX,BX		;BY CHECKING FOR LINE ZERO.
	XCHG	BX,DX		;PUT LINE TO GO TO IN [D,E]
	MOV	BX,OFFSET ONEFLG	;POINT TO ERROR FLAG
	JZ	SHORT NOTRAP	;SORRY, NO TRAPPING...
	AND	AL,BYTE PTR [BX]	;A IS NON-ZERO, SETZERO IF ONEFLG ZERO
	JNZ	SHORT NOTRAP	;IF FLAG ALREADY SET, FORCE ERROR
	DEC	BYTE PTR [BX]	;IF ALREADY IN ERROR ROUTINE, FORCE ERROR
	XCHG	BX,DX		;GET LINE POINTER IN [H,L]
	JMP	GONE4		;GO DIRECTLY TO NEWSTT CODE
NOTRAP: XOR	AL,AL		;A MUST BE ZERO FOR CONTRO
	MOV	BYTE PTR [BX],AL	;RESET ONEFLG
	MOV	DL,CL		;GET BACK ERROR CODE
	MOV	BYTE PTR CNTOFL,AL	;FORCE OUTPUT
	CALL	CRDONZ		;CRLF
	MOV	BX,OFFSET ERRTAB	;GET START OF ERROR TABLE
	MOV	AL,DL		;GET ERROR CODE
	CMP	AL,LOW OFFSET LSTERR	;IS IT PAST LAST ERROR?
	JAE	SHORT UPERR	;YES, TOO BIG TO PRINT
	CMP	AL,LOW OFFSET DSKERR+1	;DISK ERROR?
	JAE	SHORT NTDER2	;YES
	CMP	AL,LOW OFFSET NONDSK+1	;IS IT BETWEEN LAST NORMAL & FIRST DISK?
	JB	SHORT NTDERR	;YES, OK TO PRINT IT
UPERR:	MOV	AL,LOW OFFSET ERRUE1	;PRINT "UNPRINTABLE ERROR"
NTDER2: SUB	AL,LOW OFFSET DSKER1	;FIX OFFSET INTO TABLE OF MESSAGES
	MOV	DL,AL		;SAVE BACK ERROR CODE
NTDERR:
				;ON "SYNTAX ERROR"S
LEPSKP: INS86	56		;CODE SEGMENT FETCH
	MOV	AL,BYTE PTR [BX]
	INC	BX		;POINT TO NEXT CHARACTER
	OR	AL,AL
	JZ	SHORT ??L001
	JMP	LEPSKP
??L001:
	DEC	BX
	INC	BX		;SKIP OVER THIS ERROR MESSAGE
	DEC	DL		;DECREMENT ERROR COUNT
	JNZ	SHORT LEPSKP	;SKIP SOME MORE
	PUSH	BX		;SAVE TEXT POINTER
	MOV	BX,ERRLIN	;GET ERROR LINE NUMBER
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;GET BACK ERROR TEXT POINTER
PUBLIC	ERRFIN
ERRFIN:
	INS86	56		;CODE SEGMENT OVERRIDE FOR 8086 BASIC
	MOV	AL,BYTE PTR [BX]	;GET 1ST CHAR OF ERROR
	CMP	AL,LOW "?"      ;PADDED ERROR?
	JNZ	SHORT ERRFN1	;NO,PRINT
	POP	BX		;GET LINE # OFF STACK
	MOV	BX,OFFSET ERRTAB
	JMP	SHORT UPERR	;MAKE UNPRINTABLE ERROR

ERRFN1:
	CALL	STROUT		;PRINT MESSAGE
	POP	BX		;RESTORE LINE NUMBER
	MOV	DX,65534	;IS INIT EXECUTING?
	CMP	BX,DX
	JNZ	SHORT ??L002
	CALL	CRDO		;DO CRLF
??L002:
	EXTRN	SYSTME:NEAR
	JNZ	SHORT ??L003
	JMP	SYSTME		;SYSTEM error exit
??L003:
	MOV	AL,BH		;SEE IF IN DIRECT MODE
	AND	AL,BL
	INC	AL		;ZERO SAYS DIRECT MODE
	JZ	SHORT ??L004
	CALL	INPRT		;PRINT LINE NUMBER IN [H,L]
??L004:
	MOV	AL,LOW 377O
	CALL	OUTDO		;FLAG AS NOT USER INPUT
; NOW FALL INTO MAIN INTERPRETER LOOP
	PAGE

	SUBTTL STPRDY, READY, MAIN, CHEAD
;
; FOR "LIST" COMMAND STOPPING
; AND FOR RETURNING FROM A FAILED "CVER"
; AND TO CORRECT A DIRECT GOSUB WHICH DOES INPUT
;
	DB	260O	; SKIP  ;SKIP THE NEXT BYTE WITH "MVI A,0"
PUBLIC	STPRDY
STPRDY: POP	CX
PUBLIC	READY
READY:
	CALL	FINLPT		;PRINT ANY LEFT OVERS
	XOR	AL,AL
	MOV	BYTE PTR CNTOFL,AL	;FORCE OUTPUT
	CALL	PRGFIN		;FINISH OUTPUT OF A FILE
	CALL	CRDONZ		;IF NOT ALREADY AT LEFT, SEND CRLF
	MOV	BX,OFFSET REDDY ;"OK" CRLF
REPINI:
	CALL	STROUT
	MOV	AL,BYTE PTR ERRFLG	;SEE IF IT WAS A "SYNTAX ERROR"
	SUB	AL,LOW OFFSET ERRSN
	EXTRN	ERREDT:NEAR
	JNZ	SHORT ??L005
	CALL	ERREDT		;"EDIT" THE BAD LINE
??L005:
PUBLIC	MAIN
MAIN:
	MOV	BX,65535
	MOV	CURLIN,BX	;SETUP CURLIN FOR DIRECT MODE
	MOV	BX,OFFSET ENDPRG
	MOV	SAVTXT,BX	;SAVTXT POINTS AT FAKE END OF PROGRAM
	MOV	AL,BYTE PTR AUTFLG	;IN AN AUTO COMMAND?
	OR	AL,AL		;SET CC'S
	JZ	SHORT NTAUTO	;NO, REUGLAR MODE
	MOV	BX,AUTLIN	;GET CURRENT AUTO LINE
	PUSH	BX		;SAVE AWAY FOR LATER USE
	CALL	LINPRT		;PRINT THE LINE #
	POP	DX		;GET IT BACK
	PUSH	DX		;SAVE BACK AGAIN
	CALL	FNDLIN		;SEE IF IT EXISTS
	MOV	AL,LOW "*"      ;CHAR TO PRINT IF LINE ALREADY EXISTS
	JB	SHORT AUTELN	;DOESNT EXIST
	MOV	AL,LOW " "      ;PRINT SPACE
AUTELN: CALL	OUTDO		;PRINT CHAR
	MOV	BYTE PTR AUTFLG,AL	;SAVE WHETHER HAVE ASTERISK OR NOT
NTAUTO:
	EXTRN	PINLIN:NEAR
	CALL	PINLIN		;GET PROGRAM LINE INPUT
	JAE	SHORT NTSTOP
	XOR	AL,AL
	MOV	BYTE PTR AUTFLG,AL	;IN CASE OF AUTO, CLEAR IT
	JMP	MAIN
NTSTOP:
	CALL	CHRGTR		;GET THE FIRST
	INC	AL		;SEE IF 0 SAVING THE CARRY FLAG
	DEC	AL
	JZ	SHORT MAIN	;IF SO, A BLANK LINE WAS INPUT
	PUSHF			;SAVE STATUS INDICATOR FOR 1ST CHARACTER
	CALL	LINGET		;READ IN A LINE #
	JAE	SHORT MAINBX	;ANOTHER DIGIT AFTER LINE#?
	CALL	ISFLIO		;AND COMING FROM TERMINAL?
	JNZ	SHORT ??L006
	JMP	SNERR		;IF SO, BAD INPUT
??L006:
MAINBX:
	CALL	BAKSP		;BACK UP THE POINTER
	MOV	AL,BYTE PTR AUTFLG
	OR	AL,AL
	JZ	SHORT NTASTC	;NOT AUTO, DON'T CHECK FOR ASTERISK
	CMP	AL,LOW "*"
	JNZ	SHORT NTASTC	;AUTO DID NOT APPEND ASTERISK
	CMP	AL,BYTE PTR [BX]	;DO WE HAVE ASTERISK?
	JNZ	SHORT ??L007
	CALL	INXHRT		;YES, SKIP IT
??L007:
NTASTC:
	OR	DX,DX
	JNZ	SHORT ??L008
	JMP	EDENT		;BRIF no line number, don't skip space
??L008:
	MOV	AL,BYTE PTR [BX]	;GET THE CHAR
	CMP	AL,LOW " "      ;CHARACTER A SPACE?
	JNZ	SHORT ??L009
	CALL	INXHRT		;THEN EAT PAST IT
??L009:
				;ONE SPACE ALWAYS PRINTED AFTER LINE #
PUBLIC	EDENT
EDENT:
	PUSH	DX		;SAVE LINE #
	CALL	CRUNCH		;CRUNCH THE LINE DOWN
	POP	DX		;RESTORE LINE #
	POPF			;WAS THERE A LINE #?
	MOV	SAVTXT,BX	;FOR RESUMING A DIRECT STMT
	EXTRN	DIRDO:NEAR
	JNAE	SHORT ??L010
	JMP	DIRDO		;MAKE SURE WE'RE NOT READING A FILE
??L010:
	PUSH	DX
	PUSH	CX		;SAVE LINE # AND CHARACTER COUNT
	CALL	PROCHK		;DONT ALLOW ANY FUNNY BUSINESS WITH EXISTING PGM
	CALL	CHRGTR		;REMEMBER IF THIS LINE IS
	OR	AL,AL		;SET THE ZERO FLAG ON ZERO
				;LINES THAT START WITH ":" SHOULD NOT BE
				;IGNORED
	PUSHF			;BLANK SO WE DON'T INSERT IT
	MOV	DOT,DX		;SAVE THIS LINE # IN DOT
	MOV	BX,AUTINC	;GET INCREMENT
	ADD	BX,DX		;ADD INCREMENT TO THIS LINE
	JB	SHORT AUTRES	;CHECK FOR PATHETIC CASE
	PUSH	DX		;SAVE LINE NUMBER #
	MOV	DX,65530D	;CHECK FOR LINE # TOO BIG
	CMP	BX,DX
	POP	DX		;GET BACK LINE #
	JAE	SHORT AUTRES	;IF TOO BIG, QUIT
	MOV	AUTLIN,BX	;SAVE IN NEXT LINE
	JMP	SHORT AUTGOD
AUTRES: XOR	AL,AL
	MOV	BYTE PTR AUTFLG,AL	;LINE NUMBER TOO BIG, QUIT
AUTGOD:
	CALL	FNDLIN		;GET A POINTER TO THE LINE
	JB	SHORT LEXIST	;LINE EXISTS, DELETE IT
	POPF			;GET FLAG SAYS WHETHER LINE BLANK
	PUSHF			;SAVE BACK
	JZ	SHORT ??L011
	JMP	LXISTS		;Line exists - OK
??L011:
	MOV	AL,BYTE PTR AUTFLG
	OR	AL,AL		;If not AUTO mode then error.
	JNZ	SHORT ??L012
	JMP	USERR		;TRYING TO DELETE NON-EXISTANT LINE, ERROR
??L012:
	PUSH	CX		;Prepare to leave
	JMP	FINI
LXISTS: OR	AL,AL		;CLEAR FLAG THAT SAYS LINE EXISTS
	JMP	SHORT INONLY
LEXIST:			;SAVE THE POINTER
	POPF			;Don't erase line on null input when
	PUSHF			; in AUTO mode.
	JZ	SHORT ??L013
	JMP	ERAINS		;Line not null - go erase/insert
??L013:
	MOV	AL,BYTE PTR AUTFLG
	OR	AL,AL		;AUTO mode?
	JNZ	SHORT ??L014
	JMP	ERAINS		;No - go erase/insert
??L014:
	PUSH	CX		;Prepare to exit
	JMP	FINI
ERAINS: STC
INONLY:
	PUSH	CX
	PUSHF			;SAVE REGISTERS
	PUSH	BX		;SAVE [H,L]
	CALL	DEPTR		;GET RID OF PTRS IN PGM
	POP	BX		;GET BACK POINTER TO NEXT LINE
	POPF			;GET BACK PSW
	POP	CX		;RESTORE POINTER TO THIS LINE
	PUSH	CX		;SAVE BACK AGAIN
	JNB	SHORT ??L015
	CALL	DEL
??L015:
NODEL:	POP	DX		;POP POINTER AT PLACE TO INSERT
	POPF			;SEE IF THIS LINE HAD
				;ANYTHING ON IT
	PUSH	DX		;SAVE PLACE TO START FIXING LINKS
	JZ	SHORT FINI	;IF NOT DON'T INSERT
	POP	DX		;GET RID OF START OF LINK FIX
	MOV	AL,BYTE PTR CHNFLG	;ONLY CHANGET FRETOP IF NOT CHAINING
	OR	AL,AL
	JNZ	SHORT LEVFRE	;LEAVE FRETOP ALONE
	MOV	BX,MEMSIZ	;DELETE ALL STRINGS
	MOV	FRETOP,BX	;SO REASON DOESNT USE THEM
LEVFRE:
	MOV	BX,0		;Clear error trap before inserting
	MOV	ONELIN,BX	; to prevent OM error from being trapped
	MOV	BX,VARTAB	;CURRENT END
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;[H,L]=CHARACTER COUNT. VARTAB
				;ONTO THE STACK
	POP	CX		;[B,C]=OLD VARTAB
	PUSH	BX		;Save count of chars to move
	ADD	BX,CX
	PUSH	BX		;SAVE NEW VARTAB
	CALL	BLTU
	POP	BX		;POP OFF VARTAB
	MOV	VARTAB,BX	;UPDATE VARTAB
	XCHG	BX,DX
	MOV	BYTE PTR [BX],BH	;FOOL CHEAD WITH NON-ZERO LINK
	POP	CX		;Restore count of chars to move
	POP	DX		;GET LINE # OFF STACK
	PUSH	BX		;SAVE START OF PLACE TO FIX LINKS
	INC	BX		;SO IT DOESN'T THINK
				;THIS LINK IS THE
				;END OF THE PROGRAM
	INC	BX
	MOV	[BX],DX
	INC	BX
	INC	BX		;PUT DOWN LINE #
	MOV	DX,OFFSET KBUF	;MOVE LINE FRM KBUF TO PROGRAM AREA
	DEC	CX		;FIX UP COUNT OF CHARS TO MOVE
	DEC	CX		;(DONT INCLUDE LINE # & LINK)
	DEC	CX		;
	DEC	CX
MLOOPR: MOV	SI,DX
	MOV	AL,[SI]	;NOW TRANSFERING LINE
				;IN FROM BUF
	MOV	BYTE PTR [BX],AL
	INC	BX
	INC	DX
	DEC	CX		;DECREMENT CHAR COUNT BY 1
	MOV	AL,CL		;TEST FOR COUNT EXHAUSTED
	OR	AL,CH		;BY SEEING IF [B,C]=0
	JNZ	SHORT MLOOPR
PUBLIC	FINI
FINI:
EDTXIT: POP	DX		;GET START OF LINK FIXING AREA
	CALL	CHEAD		;FIX LINKS
	CALL	RUNC		;DO CLEAR & SET UP STACK 
	JMP	MAIN		;GO TO MAIN CODE
PUBLIC	LINKER
LINKER:
	MOV	BX,TXTTAB
	XCHG	BX,DX
;
; CHEAD GOES THROUGH PROGRAM STORAGE AND FIXES
; UP ALL THE LINKS. THE END OF EACH
; LINE IS FOUND BY SEARCHING FOR THE ZERO AT THE END.
; THE DOUBLE ZERO LINK IS USED TO DETECT THE END OF THE PROGRAM
;
PUBLIC	CHEAD
CHEAD:	MOV	BH,DH		;[H,L]=[D,E]
	MOV	BL,DL
	MOV	AL,BYTE PTR [BX]	;SEE IF END OF CHAIN
	INC	BX		;BUMP POINTER
	OR	AL,BYTE PTR [BX]	;2ND BYTE
	JNZ	SHORT $+3
	RET
	INC	BX		;FIX H TO START OF TEXT
	INC	BX
CZLOOP: INC	BX		;BUMP POINTER
	MOV	AL,BYTE PTR [BX]	;GET BYTE
CZLOO2: OR	AL,AL		;SET CC'S
	JZ	SHORT CZLIN	;END OF LINE, DONE.
	CMP	AL,LOW OFFSET DBLCON+1	;EMBEDDED CONSTANT?
	JAE	SHORT CZLOOP	;NO, GET NEXT
	CMP	AL,LOW 11	;IS IT LINEFEED OR BELOW?
	JB	SHORT CZLOOP	;THEN SKIP PAST
	CALL	CHRGT2		;GET CONSTANT
	CALL	CHRGTR		;GET OVER IT
	JMP	SHORT CZLOO2	;GO BACK FOR MORE
CZLIN:	INC	BX		;MAKE [H,L] POINT AFTER TEXT
	XCHG	BX,DX		;SWITCH TEMP
	MOV	[BX],DX	;STORE FIXUP
	JMP	SHORT CHEAD	;KEEP CHAINING TIL DONE
	PAGE

	SUBTTL SCNLIN, FNDLIN - SCAN LINE RANGE AND FIND LINE # IN PROGRAM
;
; SCNLIN SCANS A LINE RANGE OF
; THE FORM  #-# OR # OR #- OR -# OR BLANK
; AND THEN FINDS THE FIRST LINE IN THE RANGE
;
PUBLIC	SCNLIN
SCNLIN: MOV	DX,0		;ASSUME START LIST AT ZERO
	PUSH	DX		;SAVE INITIAL ASSUMPTION
	JZ	SHORT ALLLST	;IF FINISHED, LIST IT ALL
	CMP	AL,LOW 44D	;COMMA IS OK
	JZ	SHORT ALLLST	;Maybe list all to Gen Device.
	POP	DX		;WE ARE GOING TO GRAB A #
	CALL	LINSPC		;GET A LINE #. IF NONE, RETURNS ZERO
	PUSH	DX		;SAVE FIRST
	JZ	SHORT SNGLIN	;IF ONLY # THEN DONE.
	CMP	AL,LOW 44D	;COMMA IS OK
	JZ	SHORT SNGLIN	;Maybe only one to Gen Device.
	CALL	SYNCHR
	DW	OFFSET MINUTK	;MUST BE A DASH.
	JZ	SHORT ALLLST	;Brif EOS.
	CMP	AL,LOW 44D	; else must be comma or number.
ALLLST: MOV	DX,65530	;ASSUME MAX END OF RANGE
	JZ	SHORT ??L016
	CALL	LINSPC		;GET THE END OF RANGE
??L016:
	JZ	SHORT SNGLIN	;Brif EOS.
	CMP	AL,LOW 44D
	JZ	SHORT ??L017
	JMP	SNERR		;MUST BE TERMINATOR
??L017:
SNGLIN:
	MOV	TEMP,BX	; save Text pointer.
	XCHG	BX,DX		;[H,L] = FINAL
	POP	DX		;GET INITIAL IN [D,E]
FNDLN1: POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT MAX ON STACK, RETURN ADDR TO [H,L]
	PUSH	BX		;SAVE RETURN ADDRESS BACK
;
; FNDLIN SEARCHES THE PROGRAM TEXT FOR THE LINE
; WHOSE LINE # IS PASSED IN [D,E]. [D,E] IS PRESERVED.
; THERE ARE THREE POSSIBLE RETURNS:
;
;       1) ZERO FLAG SET. CARRY NOT SET.  LINE NOT FOUND.
;          NO LINE IN PROGRAM GREATER THAN ONE SOUGHT.
;          [B,C] POINTS TO TWO ZERO BYTES AT END OF PROGRAM.
;          [H,L]=[B,C]
;
;       2) ZERO, CARRY SET. 
;          [B,C] POINTS TO THE LINK FIELD IN THE LINE
;          WHICH IS THE LINE SEARCHED FOR.
;          [H,L] POINTS TO THE LINK FIELD IN THE NEXT LINE.
;
;       3) NON-ZERO, CARRY NOT SET.
;          LINE NOT FOUND, [B,C]  POINTS TO LINE IN PROGRAM
;          GREATER THAN ONE SEARCHED FOR.
;          [H,L] POINTS TO THE LINK FIELD IN THE NEXT LINE.
;
PUBLIC	FNDLIN
FNDLIN:
	MOV	BX,TXTTAB	;GET POINTER TO START OF TEXT
_LOOP:
	MOV	CX,BX		;IF EXITING BECAUSE OF END OF PROGRAM,
				;SET [B,C] TO POINT TO DOUBLE ZEROES.
	MOV	AL,BYTE PTR [BX]	;GET WORD POINTER TO
	INC	BX		;BUMP  POINTER
	OR	AL,BYTE PTR [BX]	;GET 2ND BYTE
	LAHF
	DEC	BX		;GO BACK
	SAHF
	JNZ	SHORT $+3
	RET			;IF ZERO THEN DONE
	INC	BX		;SKIP PAST AND GET THE LINE #
	INC	BX
	MOV	BX,[BX]	;INTO [H,L] FOR COMPARISON WITH
				;THE LINE # BEING SEARCHED FOR
				;WHICH IS IN [D,E]
	CMP	BX,DX		;SEE IF IT MATCHES OR IF WE'VE GONE TOO FAR
	MOV	BX,CX		;MAKE [H,L] POINT TO THE START OF THE
				;LINE BEYOND THIS ONE, BY PICKING
	MOV	BX,[BX]	;UP THE LINK THAT [B,C] POINTS AT
	CMC			;TURN CARRY ON
	JNZ	SHORT $+3
	RET			;EQUAL RETURN
	CMC			;MAKE CARRY ZERO
	JNAE	SHORT $+3
	RET			;NO MATCH RETURN (GREATER)
	JMP	SHORT _LOOP	;KEEP LOOPING
	PAGE

	SUBTTL PRE FAST CRUNCH - COMPACTIFICATION
	PAGE
	PAGE

	SUBTTL FAST CRUNCH - COMPACTIFICATION

;
; ALL "RESERVED" WORDS ARE TRANSLATED INTO SINGLE
; ONE OR TWO (IF TWO, FIRST IS ALWAYS 377 OCTAL)
; BYTES WITH THE MSB ON. THIS SAVES SPACE AND TIME
; BY ALLOWING FOR TABLE DISPATCH DURING EXECUTION.
; THEREFORE ALL STATEMENTS APPEAR TOGETHER IN THE
; RESERVED WORD LIST IN THE SAME
; ORDER THEY APPEAR IN IN STMDSP.
;
; NUMERIC CONSTANTS ARE ALSO CONVERTED TO THEIR INTERNAL
; BINARY REPRESENTATION TO IMPROVE EXECUTION SPEED
; LINE NUMBERS ARE ALSO PRECEEDED BY A SPECIAL TOKEN
; SO THAT LINE NUMBERS CAN BE CONVERTED TO POINTERS AT EXECUTION
; TIME.
;
PUBLIC	CRUNCH
CRUNCH:
	XOR	AL,AL		;SAY EXPECTING FLOATING NUMBERS
	MOV	BYTE PTR DONUM,AL	;SET FLAG ACORDINGLY
	MOV	BYTE PTR DORES,AL	;ALLOW CRUNCHING
	MOV	CX,OFFSET KBFLEN-3	;GET LENGTH OF KRUNCH BUFFER
				;MINUS THREE BECAUSE OF ZEROS AT END
	MOV	DX,OFFSET KBUF	;SETUP DESTINATION POINTER
KLOOP:	MOV	AL,BYTE PTR [BX]	;GET CHARACTER FROM BUF
	OR	AL,AL		;END OF LINE?
	JNZ	SHORT NCRDON	;NO, CONTINUE
CRDONE:
	MOV	BX,OFFSET KBFLEN+2	;GET OFFSET
	MOV	AL,BL		;GET COUNT TO SUBTRACT FROM
	SUB	AL,CL		;SUBTRACT
	MOV	CL,AL
	MOV	AL,BH
	SBB	AL,CH
	MOV	CH,AL		;BC:=# OF CHARS CRUNCHED
	MOV	BX,OFFSET KBUF-1	;GET POINTER TO CHAR BEFORE KBUF
				;AS "GONE" DOES A CHRGET
	XOR	AL,AL		;GET A ZERO
	MOV	DI,DX
	STOSB			;NEED THREE 0'S ON THE END
	INC	DX		;ONE FOR END-OF-LINE
	MOV	DI,DX
	STOSB			;AND 2 FOR A ZERO LINK
	INC	DX		;SINCE IF THIS IS A DIRECT STATEMENT
	MOV	DI,DX
	STOSB			;ITS END MUST LOOK LIKE THE END OF A PROGRAM
	RET			;END OF CRUNCHING
;
	PAGE
NCRDON: CMP	AL,LOW 34	;QUOTE SIGN? 
	JNZ	SHORT ??L018
	JMP	STRNG		;YES, GO TO SPECIAL STRING HANDLING
??L018:
	CMP	AL,LOW " "      ;SPACE?
	JZ	SHORT STUFFH	;JUST STUFF AWAY
	MOV	AL,BYTE PTR DORES	;IN DATA STATEMENT AND NO CRUNCH?
	OR	AL,AL
	MOV	AL,BYTE PTR [BX]	;GET THE CHARACTER AGAIN
	JZ	SHORT NTDATA	;IF NO CRUNCHING JUST STORE
				;THE CHARACTER
STUFFH: INC	BX		;ENTRY TO BUMP [H,L]
	PUSH	AX		;SAVE CHAR AS KRNSAV CLOBBERS
	CALL	KRNSAV		;SAVE CHAR IN KRUNCH BUFFER
	POP	AX		;RESTORE CHAR
	SUB	AL,LOW ":"      ;SEE IF IT IS A COLON
	JZ	SHORT COLIS	;IF SO ALLOW CRUNCHING AGAIN
	CMP	AL,LOW OFFSET $DATCO
	JNZ	SHORT NODATT	;SEE IF IT IS A DATA TOKEN
	MOV	AL,LOW 1	;SET LINE NUMBER ALLOWED FLAG
				;KLUDGE AS HAS TO BE NON-ZERO.
COLIS:	MOV	BYTE PTR DORES,AL	;SETUP FLAG
	MOV	BYTE PTR DONUM,AL	;SET NUMBER ALLOWED FLAG
NODATT: SUB	AL,LOW OFFSET $REMCO
	JNZ	SHORT KLOOP	;KEEP LOOPING
	PUSH	AX		;SAVE TERMINATOR ON STACK
STR1:	MOV	AL,BYTE PTR [BX]	;GET A CHAR
	OR	AL,AL		;SET CONDITION CODES
	POP	AX		;GET AL BACK WITHOUT AFFECTING PSW
	JZ	SHORT CRDONE	;IF END OF LINE THEN DONE
	CMP	AL,BYTE PTR [BX]	;COMPARE CHAR WITH THIS TERMINATOR
	JZ	SHORT STUFFH	;IF YES, DONE WITH STRING
STRNG:
	PUSH	AX		;SAVE TERMINATOR
	MOV	AL,BYTE PTR [BX]	;GET BACK LINE CHAR
STRNG2: INC	BX		;INCREMENT TEXT POINTER
	CALL	KRNSAV		;SAVE CHAR IN KRUNCH BUFFER
	JMP	SHORT STR1	;KEEP LOOPING
	PAGE
; NOW CHECK HGHBIT CHARS, ? FOR PRINT
NTDATA:
	INC	BX		;IF SO SKIP IT
	OR	AL,AL		;IS THIS A KANA CHARACTER IN A BAD PLACE?
	JNS	SHORT ??L019
	JMP	KLOOP		;MOVE TO THE NEXT CHARACTER
??L019:
	DEC	BX		;RESTORE THE TEXT POINTER
	CMP	AL,LOW "?"      ;A QMARK?
	MOV	AL,LOW OFFSET $PRINT
	PUSH	DX		;SAVE STORE POINTER
	PUSH	CX		;SAVE CHAR COUNT
	JNZ	SHORT ??L020
	JMP	NOTFN2		;THEN USE A "PRINT" TOKEN
??L020:
				;***5.11 DONT ALLOW FOLLOWING LINE #***
	MOV	DX,OFFSET SPCTAB	;ASSUME WE'LL SEARCH SPECIAL CHAR TABLE
	CALL	MAKUPL		;TRANSLATE THIS CHAR TO UPPER CASE
	CALL	ISLET2		;LETTER?
	JAE	SHORT ??L021
	JMP	TSTNUM		;NOT A LETTER, TEST FOR NUMBER
??L021:
	PUSH	BX		;SAVE TEXT POINTER
	PAGE
; ANSI SAYS YOU CAN USE "GO TO" AND "GO SUB" WITH ANY NUMBER OF SPACES
	MOV	DX,OFFSET GOSTEX	;CHECK FOR "GO "
	CALL	CHKRES		;THAT IT?
	JNZ	SHORT NOTGOS	;NOPE
	CALL	CHRGTR		;SKIP ANY NUMBER OF SPACES
	MOV	DX,OFFSET TOTEX ;IS IT TO?
	CALL	CHKRES		;CHECK
	MOV	AL,LOW OFFSET $GOTO	;ASSUME SO
	JNZ	SHORT ??L022
	JMP	GPUTRS		;USE IT
??L022:
	MOV	DX,OFFSET SUBTEX	;"GO SUB"
	CALL	CHKRES
	JNZ	SHORT NOTGOS	;NO
	MOV	AL,LOW OFFSET $GOSUB
GPUTRS: POP	CX		;POP OFF THE OLD TEXT POINTER
	JMP	NOTFN2		;STORE THE RESERVED WORD
; CHECK MEMORY POINTED TO BY TEXT POINTER WITH
; A SPECIFIED PARTIAL RESRWORD
CHKRES:
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	OR	AL,AL		;END OF MATCHED PARTIAL RESWORD?
	JNZ	SHORT $+3
	RET			;YES, DONE
	MOV	CL,AL		;SAVE CHAR
	CALL	MAKUPL		;GET CHAR FROM TEXT
	CMP	AL,CL		;CHARS THE SAME?
	JZ	SHORT $+3
	RET			;DONE
	INC	BX		;BUMP POINTER INTO TEXT
	INC	DX		;AND RESWORD TEXT
	JMP	SHORT CHKRES	;LOOP TILL DONE

GOSTEX DB"GO "
	DB	0

TOTEX	DB"TO"
	DB	0

SUBTEX DB"UB"
	DB	0

NOTGOS: POP	BX
	CALL	MAKUPL		;GET BACK THE CHARACTER
	PUSH	BX		;RESAVE THE TEXT POINTER
	PAGE
; NOW SEARCH ALPHA CHARACTER TABLES
; TAKE THE FIRST CHARACTER AND USE IT AS AN INDEX INTO THE
; TWENTY-SIX TABLES THAT CONTAIN THE RESERVED WORDS FOR EACH
; LETTER
;
	MOV	BX,OFFSET ALPTAB	;GET POINTER TO ALPHA DISPATCH TABLE
	SUB	AL,LOW "A"      ;SUBTRACT ALPHA OFFSET
	ADD	AL,AL		;MULTIPLY BY TWO
	MOV	CL,AL		;SAVE OFFSET IN [C] FOR DAD.
	MOV	CH,LOW 0	;MAKE HIGH PART OF OFFSET ZERO
	ADD	BX,CX		;ADD TO TABLE ADDRESS
	INS86	56
	MOV	DX,[BX]	;GET POINTER IN [D,E]
	POP	BX		;GET BACK SOURCE POINTER
	INC	BX		;POINT TO CHAR AFTER FIRST ALPHA
TRYAGA: PUSH	BX		;SAVE TXTPTR TO START OF SEARCH AREA
LOPPSI:
	CALL	MAKUPL		;TRANSLATE THIS CHAR TO UPPER CASE
	MOV	CL,AL		;SAVE CHAR IN [C]
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	AND	AL,LOW 127	;GET RID OF HIGH BIT
	JNZ	SHORT ??L023
	JMP	NOTRES		;IF=0 THEN END OF THIS CHARS RESLT
??L023:
	INC	BX		;BUMP SOURCE POINTER
	CMP	AL,CL		;COMPARE TO CHAR FROM SOURCE LINE
	JNZ	SHORT LOPSKP	;IF NO MATCH, SEARCH FOR NEXT RESWRD
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	INC	DX		;BUMP RESLST POINTER
	OR	AL,AL		;SET CC'S
	JS	SHORT ??L024
	JMP	LOPPSI		;SEE IF REST OF CHARS MATCH
??L024:
	MOV	AL,CL		;GET LAST CHAR OF RESWRD
	CMP	AL,LOW "("      ;IF TAB( OR SPC(, SPACE NEED NOT FOLLOW
	JZ	SHORT ISRESW	;IS A RESWORD
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	CMP	AL,LOW OFFSET $FN	;FUNCTION?
	JZ	SHORT ISRESW	;THEN NO SPACE NEED AFTERWARD
	CMP	AL,LOW OFFSET $USR	;OR USR DEFINITION?
	JZ	SHORT ISRESW
	CALL	MAKUPL		;GET NEXT CHAR IN LINE (MC 6/22/80)
	CMP	AL,LOW "."      ;IS IT A DOT
	JZ	SHORT ISVARS	;YES
	CALL	TSTANM		;IS IT A LETTER IMMEDIATELY FOLLOWING RESWRD
ISVARS: MOV	AL,LOW 0	;SET DONUM TO -1
	JNAE	SHORT ??L025
	JMP	NOTRES		;IF ALPHA, CANT BE RESERVED WORD
??L025:
ISRESW:
	POP	AX		;GET RID OF SAVED [H,L]
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	OR	AL,AL		;SET CC'S
	JNS	SHORT ??L026
	JMP	NOTFNT		;IF MINUS, WASNT FUNCTION TOKEN
??L026:
	POP	CX		;GET CHAR COUNT OFF STACK
	POP	DX		;GET DEPOSIT POINTER OFF STACK
	OR	AL,LOW 200O	;MAKE HIGH ORDER BIT ONE
	PUSH	AX		;SAVE FN CHAR
	MOV	AL,LOW 377O	;GET BYTE WHICH PRECEEDS FNS
PUBLIC	RENCRN
RENCRN:
	CALL	KRNSAV		;SAVE IN KRUNCH BUFFER
	XOR	AL,AL		;MAKE A ZERO
	MOV	BYTE PTR DONUM,AL	;TO RESET DONUM (FLOATINGS ALLOWED)
	POP	AX		;GET FUNCTION TOKEN
	CALL	KRNSAV		;STORE IT
	JMP	KLOOP		;KEEP KRUNCHING

LOPSKP: POP	BX		;RESTORE UNDEFILED TEXT POINTER
LOPSK2:
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	INC	DX		;BUMP RESLST POINTER
	OR	AL,AL		;SET CC'S
	JS	SHORT ??L027
	JMP	LOPSK2		;NOT END OF RESWRD, KEEP SKIPPING
??L027:
	INC	DX		;POINT AFTER TOKEN
	JMP	TRYAGA		;TRY ANOTHER RESWRD

	PAGE
; CHECK TO SEE IF RESERVED WORD MATCHES A LIST OF
; RESERVED WORDS THAT HAVE LINE NUMBERS FOLLOWING THEM INSTEAD
; OF FLOATING POINT NUMBERS. IF A MATCH IS FOUND, SET DONUM TO
; INDICATE THAT IF A NUMBER OCCURS, IT IS CRUNCHED AS A LINE NUMBER.
;
NOTFNT: DEC	BX		;FIX TEXT POINTER
NOTFN2: PUSH	AX		;SAVE CHAR TO BE SAVED IN KRUNCH BUFFER
	MOV	DX,OFFSET LINRES	;POINT TO RESERVED WORDS THAT HAVE LINE ARGS
	MOV	CL,AL		;SAVE CHARACTER TO MATCH IN [C]
NOTFN3:
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	OR	AL,AL		;END OF LIST?
	JZ	SHORT NOTFN4	;YES, DONE
	INC	DX		;POINT TO NEXT RESWORD
	CMP	AL,CL		;SAME AS ONE WERE LOOKING AT?
	JNZ	SHORT NOTFN3	;KEEP LOOKING
	JMP	SHORT NOTRS2	;DOESNT HAVE LINE # ARG

LINRES 	DW	OFFSET $RESTORE ;RESTORE CAN HAVE FOLLOWING LINE NUMBER
	DW	OFFSET $AUTO	;AUTO COMMAND
	DW	OFFSET $RENUM	;RENUMBER?
	DW	OFFSET $DELETE	;DELETE?
	DW	OFFSET $EDIT	;EDIT?
	DW	OFFSET $RESUME	;RESUME?
	DW	OFFSET $ERL	;ERROR LINE
				;SO THAT IF "ERL=...THEN"
				;WILL RESEQUENCE PROPERLY
				;THIS CAN MAKE STATEMENTS LIKE 
				;"PRINT ERL,1E20" DO STRANGE THINGS
	DW	OFFSET $ELSE	;IF ELSE CRUNCH FOLLOWING LINE #
	DW	OFFSET $RUN	;RUN?
	DW	OFFSET $LIST	;LIST?
	DW	OFFSET $LLIST	;LPT LIST?
	DW	OFFSET $GOTO	;IF GOTO, CRUNCH LINE #
	DW	OFFSET $RETURN	;NON LOCAL RETURN ALLOWS LINE # AFTER RETURN
	DW	OFFSET $THEN	;CRUNCH LINE #'S AFTER 'THEN'
	DW	OFFSET $GOSUB	;IF GOSUB, CRUNCH LINE #'S
	DW	0

NOTFN4: XOR	AL,AL		;GET A ZERO (EXPECT USUALL NUMBERS)
	JMP	SHORT NOTRS6
NOTRS2: MOV	AL,LOW 1	;SAY LINE #'S ALLOWED.
NOTRS6: MOV	BYTE PTR DONUM,AL	;SAVE IN FLAG
	POP	AX		;RESTORE CHARACTER TO SAVE IN KRUNCH BUFFER
	POP	CX		;GET BACK THE CHARACTER COUNT
	POP	DX		;GET STUFF POINTER BACK
	CMP	AL,LOW OFFSET $ELSE	;HAVE TO PUT A HIDDEN
				;COLON IN FRONT OF "ELSE"S
	PUSH	AX		;SAVE CURRENT CHAR ($ELSE)
	JNZ	SHORT ??L028
	CALL	KRNSVC		;SAVE ":" IN CRUNCH BUFFER
??L028:
	POP	AX		;GET BACK TOKEN
	CMP	AL,LOW OFFSET $WHILE	;SEE IF WHILE TO IN A PLUS TO AVOID
	JNZ	SHORT CKSNGQ	;Brif not
	CALL	KRNSAV		;Emit WHILE Token, then Plus (+)
	MOV	AL,LOW OFFSET PLUSTK	;PLUS SIGN IS OK AND AVOIDS CONSTANT
CKSNGQ: CMP	AL,LOW OFFSET SNGQTK	;SINGLE QUOATATION MARK?
	JZ	SHORT ??L029
	JMP	NTSNGT
??L029:
	PUSH	AX		;SAVE SNGQTK
	CALL	KRNSVC		;SAVE ":" IN CRUNCH BUFFER
	MOV	AL,LOW OFFSET $REM	;STORE ":$REM" IN FRONT FOR EXECUTION
	CALL	KRNSAV		;SAVE IT
	POP	AX		;GET SNGQTK BACK
	PUSH	BX		;save text pointer
	MOV	BX,0
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;Save terminator (0), restore Txt Ptr
	JMP	STRNG2		;STUFF THE REST OF THE LINE WITHOUT CRUNCHING
TSTNUM: MOV	AL,BYTE PTR [BX]	;GET CHAR
	CMP	AL,LOW "."      ;TEST FOR START OF FLOATING #
	JZ	SHORT NUMTRY	;TRY INPUTTING IT AS CONSTANT
	CMP	AL,LOW OFFSET "9"+1     ;IS IT A DIGIT?
	JNAE	SHORT ??L030
	JMP	SRCSPC		;NO, TRY OTHER THINGS
??L030:
	CMP	AL,LOW "0"      ;TRY LOWER END
	JAE	SHORT ??L031
	JMP	SRCSPC		;NO TRY OTHER POSSIBILITIES
??L031:
NUMTRY: MOV	AL,BYTE PTR DONUM	;TEST FOR NUMBERS ALLOWED
	OR	AL,AL		;SET CC'S
	MOV	AL,BYTE PTR [BX]	;GET CHAR IF GOING TO STUFFH
	POP	CX		;RESTORE CHAR COUNT
	POP	DX		;RESTORE DEP. POINTER
	JNS	SHORT ??L032
	JMP	STUFFH		;NO, JUST STUFF IT (!)
??L032:
	JZ	SHORT FLTGET	;IF DONUM=0 THEN FLOATING #'S ALLOWED
	CMP	AL,LOW "."      ;IS IT DOT?
	JNZ	SHORT ??L033
	JMP	STUFFH		;YES, STUFF IT FOR HEAVENS SAKE! (EDIT .)
??L033:
	MOV	AL,LOW OFFSET LINCON	;GET LINE # TOKEN
	CALL	KRNSAV		;SAVE IT
	PUSH	DX		;SAVE DEPOSIT POINTER
	CALL	LINGET		;GET THE LINE #.
	CALL	BAKSP		;BACK UP POINTER TO AFTER LAST DIGIT
SAVINT: POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;EXCHANGE CURRENT [H,L] WITH SAVED [D,E]
	XCHG	BX,DX		;GET SAVED [D,E] IN [D,E]
SAVI:	MOV	AL,BL		;GET LOW BYTE OF VALUE RETURNED BY LINGET
	CALL	KRNSAV		;SAVE THE LOW BYTE OF LINE #
	MOV	AL,BH		;GET HIGH BYTE
POPSTF: POP	BX		;RESTORE [H,L]
	CALL	KRNSAV		;SAVE IT TOO
	JMP	KLOOP		;EAT SOME MORE

FLTGET: PUSH	DX		;SAVE DEPOSIT POINTER
	PUSH	CX		;SAVE CHAR COUNT
	MOV	AL,BYTE PTR [BX]	;FIN ASSUMES CHAR IN [A]
	CALL	FIN		;READ THE #
	CALL	BAKSP		;BACK UP POINTER TO AFTER LAST DIGIT
	POP	CX		;RESTORE CHAR COUNT
	POP	DX		;RESTORE DEPOSIT POINTER
	PUSH	BX		;SAVE TEXT POINTER
	MOV	AL,BYTE PTR VALTYP	;GET VALUE TYPE
	CMP	AL,LOW 2	;INTEGER?
	JNZ	SHORT NTINTG	;NO
	MOV	BX,FACLO	;GET IT
	MOV	AL,BH		;GET HIGH PART
	OR	AL,AL		;IS IT ZERO?
	MOV	AL,LOW 2	;RESTORE INT VALTYP
	JNZ	SHORT NTINTG	;THEN ISNT SINGLE BYTE INT
	MOV	AL,BL		;GET LOW BYTE
	MOV	BH,BL		;GET LOW BYTE IN HIGH BYTE TO STORE
	MOV	BL,LOW OFFSET IN2CON	;GET CONSTANT FOR 1 BYTE INTS
	CMP	AL,LOW 10	;IS IT TOO BIG FOR A SINGLE BYTE CONSTANT?
	JAE	SHORT SAVI	;TOO BIG, USE SINGLE BYTE INT
	ADD	AL,LOW OFFSET ONECON	;MAKE SINGLE BYTE CONSTANT
	JMP	SHORT POPSTF	;POP H & STUFF AWAY CHAR
NTINTG: PUSH	AX		;SAVE FOR LATER
	ROR	AL,1		;DIVIDE BY TWO
	ADD	AL,LOW OFFSET INTCON-1	;ADD OFFSET TO GET TOKEN
	CALL	KRNSAV		;SAVE THE TOKEN
	MOV	BX,OFFSET FACLO ;GET START POINTER
	CALL	GETYPR		;SET CC'S ON VALTYPE
	JB	SHORT NTDBL	;IF NOT DOUBLE, START MOVING AT FACLO
	MOV	BX,OFFSET DFACLO	;DOUBLE, START MOVING AT DFACLO
NTDBL:	POP	AX
MOVCON: PUSH	AX		;SAVE BYTE MOVE COUNT
	MOV	AL,BYTE PTR [BX]	;GET A BYTE
	CALL	KRNSAV		;SAVE IT IN KRUNCH BUFFER
	POP	AX		;GET BACK COUNT
	INC	BX		;BUMP POINTER INTO FAC
	DEC	AL		;MOVE IT DOWN
	JNZ	SHORT MOVCON	;KEEP MOVING IT
	POP	BX		;GET BACK SAVED TEXT POINTER
	JMP	KLOOP		;KEEP LOOPING

SRCSPC: MOV	DX,OFFSET SPCTAB-1	;GET POINTER TO SPECIAL CHARACTER TABLE
SRCSP2: INC	DX		;MOVE POINTER AHEAD
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	AND	AL,LOW 177O	;MASK OFF HIGH BIT
	JNZ	SHORT ??L034
	JMP	NOTRS5		;IF END OF TABLE, STUFF AWAY, DONT CHANGE DONUM
??L034:
	INC	DX		;BUMP POINTER
	CMP	AL,BYTE PTR [BX]	;IS THIS SPECIAL CHAR SAME AS CURRENT TEXT CHAR?
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	JNZ	SHORT SRCSP2	;IF NO MATCH, KEEP LOOKING
	JMP	NOTRS1		;FOUND, SAVE AWAY AND SET DONUM=1.

NTSNGT:
	CMP	AL,LOW "&"      ;OCTAL CONSTANT?
	JZ	SHORT ??L035
	JMP	STUFFH		;JUST STUFF IT AWAY
??L035:
	PUSH	BX		;SAVE TEXT POINTER
	CALL	CHRGTR		;GET NEXT CHAR
	POP	BX		;RESTORE TEXT POINTER
	CALL	MAKUPS		;MAKE CHAR UPPER CASE
	CMP	AL,LOW "H"      ;HEX CONSTANT?
	MOV	AL,LOW OFFSET OCTCON	;ASSUME OCTAL CONSTANT
	JNZ	SHORT WUZOCT	;YES, IT WAS
	MOV	AL,LOW OFFSET HEXCON	;NO, WAS HEX
WUZOCT: CALL	KRNSAV		;SAVE IT
	PUSH	DX		;SAVE CURRENT DEPOSIT POINTER
	PUSH	CX		;SAVE COUNT
	CALL	OCTCNS		;GET THE VALUE
	POP	CX		;RESTORE [B,C]
	JMP	SAVINT		;SAVE THE INTEGER IN THE KRUNCH BUFFER

KRNSVC: MOV	AL,LOW ":"      ;GET COLON
KRNSAV:
	MOV	DI,DX
	STOSB			;SAVE BYTE IN KRUNCH BUFFER
	INC	DX		;BUMP POINTER
	DEC	CX		;DECREMENT COUNT OF BYTES LEFT IN BUFFER
	MOV	AL,CL		;TEST IF IT WENT TO ZERO
	OR	AL,CH		;BY SEEING IF DOUBLE BYTE ZERO.
	JZ	SHORT $+3
	RET			;ALL DONE IF STILL SPACE LEFT
PUBLIC	LBOERR
LBOERR: MOV	DL,LOW OFFSET ERRLBO	;GET ERROR CODE
	JMP	ERROR		;JUMP TO ERROR ROUTINE

NOTRES:
	EXTRN	CRUNCX:NEAR
	JMP	CRUNCX		;Go to extended CRUNCH code.
PUBLIC	NOTRFN
NOTRFN:
	POP	BX		;GET BACK POINTER TO ORIGINAL CHAR
	DEC	BX		;NOW POINT TO FIRST ALPHA CHAR
	DEC	AL		;SET A TO MINUS ONE
	MOV	BYTE PTR DONUM,AL	;FLAG WERE IN VARIABLE NAME
	POP	CX		;GET BACK CHAR COUNT
	POP	DX		;GET BACK DEPOSIT POINTER
	CALL	MAKUPL		;GET CHAR FROM LINE, MAKE UPPER CASE
KRNVAR: CALL	KRNSAV		;SAVE CHAR
	INC	BX		;INCRMENT SOURCE POINTER
	CALL	MAKUPL		;MAKE UPPER CASE (?)
	CALL	ISLET2		;IS IT A LETTER?
	JAE	SHORT KRNVAR	;YES, EAT
	CMP	AL,LOW OFFSET "9"+1     ;DIGIT?
	JAE	SHORT JKLOOP	;NO, TOO LARGE
	CMP	AL,LOW "0"
	JAE	SHORT KRNVAR	;YES, EAT
	CMP	AL,LOW "."      ;IS IT DOT
	JZ	SHORT KRNVAR	;YES, DOTS OK IN VAR NAMES
JKLOOP: JMP	KLOOP		;DONE LOOKING AT VARIABLE NAME
NOTRS5: MOV	AL,BYTE PTR [BX]	;GET CHAR FROM LINE
	CMP	AL,LOW 32	;SPACE OR HIGHER ?
	JAE	SHORT NOTRS1	;YES = SAVE IT
	CMP	AL,LOW 9	;TAB ?
	JZ	SHORT NOTRS1	;YES = THAT'S OK
	CMP	AL,LOW 10	;ALSO ALLOW...
	JZ	SHORT NOTRS1	;...LINE FEEDS
	MOV	AL,LOW 32	;FORCE REST TO SPACES
NOTRS1: PUSH	AX		;SAVE THIS CHAR
	MOV	AL,BYTE PTR DONUM	;GET NUMBER OK FLAG
	INC	AL		;SEE IF IN A VARIABLE NAME.
	JZ	SHORT JNTRS6	;IF SO & SPECIAL CHAR SEEN, RESET DONUM
	DEC	AL		;OTHERWISE LEAVE DONUM UNCHANGED.
JNTRS6: JMP	NOTRS6

; ROUTINE TO BACK UP POINTER AFTER # EATEN
BAKSP:	DEC	BX		;POINT TO PREVIOUS CHAR
	MOV	AL,BYTE PTR [BX]	;GET THE CHAR
	CMP	AL,LOW " "      ;A SPACE?
	JZ	SHORT BAKSP	;YES, KEEP BACKING UP
	CMP	AL,LOW 9	;TAB?
	JZ	SHORT BAKSP	;YES, BACK UP
	CMP	AL,LOW 10	;LF?
	JZ	SHORT BAKSP
	INC	BX		;POINT TO CHAR AFTER LAST NON-SPACE
	RET			;ALL DONE.

	SUBTTL THE NON-EXTENDED "LIST" COMMAND



	PAGE

	SUBTTL "FOR" STATEMENT
;
; A "FOR" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT:
;
; LOW ADDRESS
;       TOKEN ($FOR IN HIGH BYTE)  1 BYTE
;       A POINTER TO THE LOOP VARIABLE  2 BYTES
;       A BYTE REFLECTING THE SIGN OF THE INCREMENT 1 BYTE
;       THE STEP 4 BYTES
;       THE UPPER VALUE 4 BYTES
;       THE LINE # OF THE "FOR" STATEMENT 2 BYTES
;       A TEXT POINTER INTO THE "FOR" STATEMENT 2 BYTES
; HIGH ADDRESS
;
; TOTAL 16 BYTES
;
_FOR:	MOV	AL,LOW 100
	MOV	BYTE PTR SUBFLG,AL	;DONT RECOGNIZE SUBSCRIPTED VARIABLES
	CALL	PTRGET		;GET POINTER TO LOOP VARIABLE
	CALL	SYNCHR
	DW	OFFSET EQULTK	;SKIP OVER ASSIGNMENT "="
	PUSH	DX		;SAVE THE VARIABLE POINTER ON STACK
				;AND IN TEMP
	MOV	TEMP,DX	;FOR USE LATER ON
	MOV	AL,BYTE PTR VALTYP	;REMEMBER THE LOOP VARIABLE TYPE
	PUSH	AX
	CALL	FRMEVL		;GET THE START VALUE
	POP	AX		;REGET THE LOOP TYPE
	PUSH	BX		;SAVE THE TEXT POINTER
	CALL	DOCNVF		;FORCE CONVERSION TO LOOP TYPE
	MOV	BX,OFFSET FVALSV	;PLACE TO SAVE THE VALUE
	CALL	MOVMF		;STORE FOR USE IN "NEXT"
	POP	BX		;GET BACK THE TEXT POINTER
	POP	DX		;GET BACK THE VARIABLE POINTER
	POP	CX		;GET RID OF THE NEWSTT RETURN
	PUSH	BX		;SAVE THE TEXT POINTER
	CALL	DATA		;SET [H,L]=END OF STATEMENT
	MOV	ENDFOR,BX	;SAVE FOR COMPARISON
	MOV	BX,2		;SET UP POINTER INTO STACK
	ADD	BX,SP
LPFORM: CALL	LOOPER		;MUST HAVE VARIABLE POINTER IN [D,E]
	JNZ	SHORT NOTOL	;IF NO MATCHING ENTRY, DON'T
				;ELIMINATE ANYTHING
	ADD	BX,CX		;IN THE CASE OF "FOR"
				;WE ELIMINATE THE MATCHING ENTRY
				;AS WELL AS EVERYTHING AFTER IT
	PUSH	DX		;SAVE THE VARIABLE POINTER
	DEC	BX		;SEE IF END TEXT POINTER OF MATCHING ENTRY
	MOV	DH,BYTE PTR [BX]	;MATCHES THE FOR WE ARE HANDLING
	DEC	BX		;PICK UP THE END OF THE "FOR" TEXT POINTER
	MOV	DL,BYTE PTR [BX]	;FOR THE ENTRY ON THE STACK
	INC	BX		;WITHOUT CHANGING [H,L]
	INC	BX
	PUSH	BX		;SAVE THE STACK POINTER FOR THE COMPARISON
	MOV	BX,ENDFOR	;GET ENDING TEXT POINTER FOR THIS "FOR"
	CMP	BX,DX		;SEE IF THEY MATCH
	POP	BX		;GET BACK THE STACK POINTER
	POP	DX		;GET BACK THE VARIABLE POINTER
	JNZ	SHORT LPFORM	;KEEP SEARCHING IF NO MATCH
	POP	DX		;GET BACK THE TEXT POINTER
	MOV	SP,BX		;DO THE ELIMINATION
	MOV	SAVSTK,BX	;UPDATE SAVED STACK
				;SINCE A MATCHING ENTRY WAS FOUND
	DB	261O	; SKIP  ;MVI C,(POP D)
NOTOL:	POP	DX
	XCHG	BX,DX		;[H,L]=TEXT POINTER
	MOV	CL,LOW 8	;MAKE SURE 16 BYTES ARE AVAILABLE
				;OFF OF THE STACK
	CALL	GETSTK
	PUSH	BX		;REALLY SAVE THE TEXT POINTER
	MOV	BX,ENDFOR	;PICK UP POINTER AT END OF "FOR"
				;JUST BEYOND THE TERMINATOR
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT [H,L] POINTER TO TERMINATOR ON THE STACK
				;AND RESTORE [H,L] AS TEXT POINTER AT
				;VARIABLE NAME
	PUSH	BX		;PUSH THE TEXT POINTER ONTO THE STACK
	MOV	BX,CURLIN	;[H,L] GET THE CURRENT LINE #
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;NOW THE CURRENT LINE # IS ON THE STACK AND
				;[H,L] IS THE TEXT POINTER
	CALL	SYNCHR
	DW	OFFSET $TO	;"TO" IS NECESSARY
	CALL	GETYPR		;SEE WHAT TYPE THIS VALUE HAS
	JNZ	SHORT ??L036
	JMP	TMERR		;GIVE STRINGS A "TYPE MISMATCH"
??L036:
	JNAE	SHORT ??L037
	JMP	TMERR		;AS WELL AS DOUBLE-PRECISION
??L037:
	PUSHF			;SAVE THE INTEGER/FLOATING FLAG
	CALL	FRMEVL		;EVALUATE THE TARGET VALUE FORMULA
	POPF			;POP OFF THE FLAG
	PUSH	BX		;SAVE THE TEXT POINTER
	JS	SHORT ??L038
	JMP	SNGFOR		;POSITIVE MEANS SINGLE PRECISION "FOR"-LOOP
??L038:
	CALL	FRCINT		;COERCE THE FINAL VALUE
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE IT ON THE STACK AND REGET THE
				;TEXT POINTER
	MOV	DX,1		;DEFAULT THE STEP TO BE 1
	MOV	AL,BYTE PTR [BX]	;SEE WHAT CHARACTER IS NEXT
	CMP	AL,LOW OFFSET STEPTK	;IS THERE A "STEP" CLAUSE?
	JNZ	SHORT ??L039
	CALL	GETINT		;IF SO, READ THE STEP INTO [D,E]
??L039:
	PUSH	DX		;PUT THE STEP ONTO THE STACK
	PUSH	BX		;SAVE THE TEXT POINTER
	XCHG	BX,DX		;STEP INTO [H,L]
	CALL	ISIGN		;THE SIGN OF THE STEP INTO [A]
	JMP	SHORT STPSGN	;FINISH UP THE ENTRY
				;BY PUTTING THE SIGN OF THE STEP
				;AND THE DUMMY ENTRIES ON THE STACK
SNGFOR: CALL	FRCSNG
	CALL	MOVRF		;GET THE STUFF
	POP	BX		;REGAIN TEXT POINTER
	PUSH	CX		;OPPOSITE OF PUSHR
	PUSH	DX		;SAVE THE SIGN OF THE INCREMENT
	MOV	CX,OFFSET 201O*256
	MOV	DH,CL
	MOV	DL,DH		;GET 1.0 IN THE REGISTERS
	MOV	AL,BYTE PTR [BX]	;GET TERMINATING CHARACTER
	CMP	AL,LOW OFFSET STEPTK	;DO WE HAVE "STEP" ?
	MOV	AL,LOW 1	;SETUP DEFAULT SIGN
	JNZ	SHORT ONEON	;PUSH SOME CONSTANTS ON IF NOT
	CALL	FRMCHK		;DON'T NEED TO CHECK THE TYPE
	PUSH	BX
	CALL	FRCSNG
	CALL	MOVRF		;SET UP THE REGISTERS
	CALL	SIGN		;GET THE SIGN OF THE INCREMENT
STPSGN: POP	BX		;POP OFF THE TEXT POINTER
ONEON:	PUSH	CX		;PUT VALUE ON BACKWARDS
	PUSH	DX		;OPPOSITE OF PUSHR
;
; If a step of zero is specified, change the sign of the step from
; 0 to 2.  This will ensure an infinite loop which is what ANSI
; requires.  This works because the test NEXT uses for loop
; termination is SGN(current value-target value)-SGN(step)=0, which
; could never be true for SGN(step)=2.
; Prior to installation of this code, a FOR loop whose initial and
; target values were equal, and whose step was zero was not executed
; even once since the above test was met when NEXT was called to
; scan for the matching NEXT.
;

	OR	AL,AL		;Is the sign of the step zero?
	JNZ	SHORT NT0STP	;No, then the step is not zero.
	MOV	AL,LOW 2	;Yes, force an infinite loop by making
				;the sign of step a value such that
				;the loop termination test can never
				;be met.
NT0STP:
	MOV	CL,AL		;[C]=SIGN OF STEP
	CALL	GETYPR		;MUST PUT ON INTEGER/SINGLE-PRECISION FLAG
				;MINUS IS SET FOR INTEGER CASE
	MOV	CH,AL		;HIGH BYTE = INTEGER/SINGLE PRECISION FLAG
	PUSH	CX		;SAVE FLAG AND SIGN OF STEP BOTH
	DEC	BX		;MAKE SURE THE "FOR" ENDED PROPERLY
	CALL	CHRGTR
	JZ	SHORT ??L040
	JMP	SNERR
??L040:
	CALL	NXTSCN		;SCAN UNTIL THE MATCHING "NEXT" IS FOUND
	CALL	CHRGTR		;FETCH FIRST CHARACTER OF "NEXT"
	PUSH	BX		;MAKE THE NEXT TXTPTR PART OF THE ENTRY
	PUSH	BX
	MOV	BX,NXTLIN	;GET THE LINE NUMBER OF NEXT
	MOV	CURLIN,BX	;MAKE IT THE CURRENT LINE
	MOV	BX,TEMP	;GET THE POINTER TO THE VARIABLE BACK
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT THE POINTER TO THE VARIABLE
				;ONTO THE STACK AND RESTORE THE TEXT POINTER
	MOV	CH,LOW OFFSET $FOR	;FINISH UP "FOR"
	PUSH	CX
	LAHF			; PUSH PSW
	XCHG	AL,AH
	PUSH	AX
	XCHG	AL,AH		;SAVE THE CHARACTER
	LAHF			; PUSH PSW
	XCHG	AL,AH
	PUSH	AX
	XCHG	AL,AH		;MAKE A STACK ENTRY TO SUBSTITUTE FOR "NEWSTT"
	EXTRN	NEXTS:NEAR
	JMP	NEXTS		;GO EXECUTE "NEXT" WITH NXTFLG ZERO
PUBLIC	NXTCON
NXTCON: MOV	CH,LOW OFFSET $FOR	;PUT A 'FOR' TOKEN ONTO THE STACK
	PUSH	CX
;       JMP     NEWSTT          ;ALL DONE
	PAGE

	SUBTTL NEW STATEMENT FETCHER
;
; BACK HERE FOR NEW STATEMENT. CHARACTER POINTED TO BY [H,L]
; ":" OR END-OF-LINE. THE ADDRESS OF THIS LOCATION IS
; LEFT ON THE STACK WHEN A STATEMENT IS EXECUTED SO
; IT CAN MERELY DO A RETURN WHEN IT IS DONE.
;
	JMP	SHORT NEWSTT	;GO TO NEWSTT
GOPRGD: JMP	PRGEND		;FIX SYNTAX ERROR IN UNENDED ERROR ROUTINE
GOSNER: JMP	SNERR		;GIVE SYNTAX ERROR
GORET:	RET			;SO PEOPLE CAN BRANCH HERE
GONCHR: CALL	CHRCON		;REST OF CHRGET
	JMP	SHORT GONE0
GISMD$:
	EXTRN	NEWSTX:NEAR
	CALL	NEWSTX		;Call extended statement dispatcher.
	JMP	ISMID$		;TRY FOR LHS MID$ STATEMENT

GONLET: JMP	LET		;GOTO LET CODE

GONZER: OR	AL,AL
	JNZ	SHORT GOSNER	;MUST BE A ZERO
	INC	BX
GONE4:	MOV	AL,BYTE PTR [BX]	;CHECK POINTER TO SEE IF
				;IT IS ZERO, IF SO WE ARE AT THE
				;END OF THE PROGRAM
	INC	BX
	OR	AL,BYTE PTR [BX]	;OR IN HIGH PART
	JZ	SHORT GOPRGD	;FIX SYNTAX ERROR IN UNENDED ERROR ROUTINE
	INC	BX
	MOV	DX,[BX]
	INC	BX
	INS86	211,26,CURLIN	;MOV CURLIN,DX
				;SETUP CURLIN WITH THE CURRENT LINE #
	INS86	366,6,TRCFLG	;TRACING?
	DB	377O		;TESTBI TRCFLG,^O377
	JZ	SHORT GONE	;SKIP THIS PRINTING
	PUSH	BX		;SAVE THE TEXT POINTER
	MOV	AL,LOW "["      ;FORMAT THE LINE NUMBER
	CALL	OUTDO		;OUTPUT IT
	XCHG	BX,DX		;PUT LINE NUMBER TO PRINT IN [H,L]
	CALL	LINPRT		;PRINT THE LINE # IN [H,L]
	MOV	AL,LOW "]"      ;SOME MORE FORMATING
	CALL	OUTDO
	POP	BX		;[D,E]=TEXT POINTER
	JMP	SHORT GONE	;CONTINUE EXECUTION
PUBLIC	NEWSTT
NEWSTT:
	MOV	AL,BYTE PTR ONGSBF
	OR	AL,AL
	JZ	SHORT ??L041
EXTRN	GOTRP:NEAR
	CALL	GOTRP		;POSSIBLE ON GOSUB
??L041:
NWSTRT:			;ENTRY FOR "device ON" STATEMENT
NEWST1:
	INS86	211,46,SAVSTK	;MOV SAVSTK,SP
	MOV	SAVTXT,BX	;SAVE TEXT POINTER
	EXTRN	CHKINT:NEAR
	CALL	CHKINT		;get key from keyboard & check for CTL C
				;if CTL-C, control doesn't return here
GONGET: MOV	AL,BYTE PTR [BX]	;GET CURRENT CHARACTER
				;WHICH TERMINATED THE LAST STATEMENT
	CMP	AL,LOW ":"      ;IS IT A COLON?
	JNZ	SHORT GONZER	;SHOULD BE ZERO AT EOL
PUBLIC	GONE
GONE:	INC	BX		;DO PART OF CHRGETS WORK
	MOV	AL,BYTE PTR [BX]	;GET BYTE
	CMP	AL,LOW ":"      ;COLON?
	JB	SHORT GONCHR	;DO REST OF CHRGET
GONE0:	MOV	DX,OFFSET NEWSTT	;PUSH ON A RETURN ADDRESS OF NEWSTT
	PUSH	DX		;STATEMENT
GONE3:	JZ	SHORT GORET	;IF A TERMINATOR TRY AGAIN
				;"IF" COMES HERE
GONE2:
	SUB	AL,LOW OFFSET $END	;"ON ... GOTO" AND "ON ... GOSUB" COME HERE
	JB	SHORT GONLET	;MUST BE A LET
	CMP	AL,LOW OFFSET NUMCMD
	JAE	SHORT GISMD$	;SEE IF LHS MID$ CASE
	INS86	62,344		;XOR AH,AH
	ADD	AL,AL		;TURN BYTE INTO OFFSET
	INS86	213,360	;MOV SI,AX - GET OFFSET INTO [SI]
	INS86	56		;CODE SEGMENT OVERRIDE
	INS86	377,264,STMDSP	;PUSH STMDSP(SI) - PUSH ADDRESS
				;STATEMENT ON STACK
;
; NEWSTT FALLS INTO CHRGET. THIS FETCHES THE FIRST CHAR AFTER
; THE STATEMENT TOKEN AND THE CHRGET'S "RET" DISPATCHES TO STATEMENT
	PAGE

	SUBTTL CHRGET - THE NEXT CHARACTER SCAN ROUTINE
PUBLIC	CHRGTR
CHRGTR: INC	BX		;DUPLICATION OF CHRGET RST FOR SPEED
PUBLIC	CHRGT2
CHRGT2: MOV	AL,BYTE PTR [BX]	;SEE CHRGET RST FOR EXPLANATION
	CMP	AL,LOW ":"
	JB	SHORT CHRCON
	RET
;
; CHRCON IS THE CONTINUATION OF THE CHRGET RST
;
; IN EXTENDED, CHECK FOR INLINE CONSTANT AND IF ONE
; MOVE IT INTO THE FAC & SET VALTYP APPROPRIATELY
;
PUBLIC	OCTCON
	OCTCON=11		;EMBEDED OCTAL CONSTANT
PUBLIC	HEXCON
	HEXCON=12		;EMBEDED HEXA CONSTANT
	PTRCON=13		;A LINE REFERENCE CONSTANT
	LINCON=14		;A LINE NUMBER UNCONVERTED TO POINTER
	IN2CON=15		;SINGLE BYTE (TWO BYTE WITH TOKEN) INTEGER
PUBLIC	CONCN2
	CONCN2=16		;TOKEN RETURNED SECOND TYPE CONSTANT IS SCANNED.
PUBLIC	ONECON
	ONECON=17		;FIRST OF 10 (0-9) INTEGER SPECIAL TOKENS
	INTCON=28		;REGULAR 16 BIT TWO'S COMPLEMENT INT
	SNGCON=29		;SINGLE PREC (4 BYTE) CONSTANT
PUBLIC	CONCON
	CONCON=30		;TOKEN RETURNED BY CHRGET AFTER CONSTANT SCANNED
PUBLIC	DBLCON
	DBLCON=31		;DOUBLE PREC (8 BYTE) CONSTANT
PUBLIC	DBLCN1
	DBLCN1=DBLCON+1
PUBLIC	CHRCON
CHRCON: CMP	AL,LOW " "      ;MUST SKIP SPACES
	JZ	SHORT CHRGTR	;GET ANOTHER CHARACTER
	JB	SHORT LOWCHR	;SOME FUNNY THING
	CMP	AL,LOW "0"      ;ALL CHARACTERS GREATER THAN
				;"9" HAVE RETURNED, SO SEE IF NUMERIC
	CMC			;MAKE NUMERICS HAVE CARRY ON
	INC	AL		;SET ZERO IF [A]=0
	DEC	AL
	RET
LOWCHR:
	OR	AL,AL		;NULL AT EOL?
	JNZ	SHORT $+3
	RET			;YES, ALL DONE
	CMP	AL,LOW OFFSET OCTCON	;IS IT INLINE CONSTANT
	JB	SHORT NOTCON	;NO, SHOULD BE TAB OR LF
	CMP	AL,LOW OFFSET CONCON	;ARE WE TRYING TO RE-SCAN A CONSTANT?
	JNZ	SHORT NTRSCC	;NO.
	MOV	AL,BYTE PTR CONSAV	;GET THE SAVED CONSTANT TOKEN
	OR	AL,AL		;SET NON-ZERO, NON CARRY CC'S
	RET			;ALL DONE

NTRSCC: CMP	AL,LOW OFFSET CONCN2	;GOING TO SCAN PAST EMBEDDED CONSTANT?
	JZ	SHORT CONSCN	;YES SCAN AND GO ON
NTRSC2: PUSH	AX		;SAVE TOKEN TO RETURN
	INC	BX		;POINT TO NUMBER
	MOV	BYTE PTR CONSAV,AL	;SAVE CURRENT TOKEN
	SUB	AL,LOW OFFSET INTCON	;IS IT LESS THAN INTEGER CONSTANT?
	JAE	SHORT MAKTKN	;NO, NOT LINE NUMBER CONSTANT
	SUB	AL,LOW 365O	;<ONECON-INTCON>&^O377
				;LESS THAN EMBEDDED 1 BYTER
	JAE	SHORT ONEI	;WAS ONE BYTER
	CMP	AL,LOW OFFSET IN2CON-ONECON	;IS IT TWO BYTER?
	JNZ	SHORT FRCINC	;NOPE, NORMAL INT
	MOV	AL,BYTE PTR [BX]	;GET EMBEDED INT
	INC	BX		;POINT AFTER CONSTANT
ONEI:	MOV	CONTXT,BX	;SAVE TEXT POINTER
	MOV	BH,LOW 0	;GET UPPER BYTE OF ZERO
ONEI2:	MOV	BL,AL		;GET VALUE
	MOV	CONLO,BX	;SAVE CONSTANT VALUE
	MOV	AL,LOW 2	;GET VALTYPE
	MOV	BYTE PTR CONTYP,AL	;SET IT UP IN SAVE PLACE
	MOV	BX,OFFSET NUMCON	;POINT TO NUMBER RE-SCANNER
	POP	AX		;GET BACK TOKEN
	OR	AL,AL		;MAKE SURE NUMBER FLAG RE-SET
	RET			;RETURN TO CALLER

FRCINC: MOV	AL,BYTE PTR [BX]	;GET LOW BYTE OF CONSTANT
	INC	BX		;POINT PAST IT
	INC	BX		;TO NEXT THING
	MOV	CONTXT,BX	;SAVE POINTER PAST
	DEC	BX		;BACK TO HIGH BYTE
	MOV	BH,BYTE PTR [BX]	;GET HIGH BYTE
	JMP	SHORT ONEI2	;FINISH SCANNING

PUBLIC	CONFAC
CONFAC: CALL	CONFC1		;SCAN FLOATING CONSTANT
CONSCN: MOV	BX,CONTXT	;GET SAVED TEXT POINTER
	JMP	SHORT CHRGT2	;AND SCAN THING AFTER CONSTANT

MAKTKN: INC	AL		;CALCULATE VALTYPE
	ROL	AL,1		;*2 TO GET VALTYPE 0=2, 1=4, 3=8
	MOV	BYTE PTR CONTYP,AL	;CONTYPE NOW SETUP
	PUSH	DX		;SAVE SOME RGS
	PUSH	CX
	MOV	DX,OFFSET CONLO ;PLACE TO STORE SAVED CONSTANT
	XCHG	BX,DX		;GET TEXT POINTER IN [D,E]
	MOV	CH,AL		;SETUP COUNTER IN [B]
	CALL	MOVE1		;MOVE DATA IN
	XCHG	BX,DX		;GET TEXT POINTER BACK
	POP	CX		;RESTORE [B,C]
	POP	DX
FININ1: MOV	CONTXT,BX	;SAVE THE GOOD TEXT POINTER
	POP	AX		;RESTORE TOKEN
	MOV	BX,OFFSET NUMCON	;GET POINTER TO FAKE TEXT
	OR	AL,AL		;CLEAR CARRY SO OTHERS DONT THINK ITS A NUMBER
				;AND SET NON-ZERO SO NOT TERMINATOR
	RET			;ALL DONE
NOTCON:
	CMP	AL,LOW 9	;LINE FEED OR TAB?
	JNAE	SHORT ??L042
	JMP	CHRGTR		;YES, EAT.
??L042:
NOTLFT: CMP	AL,LOW "0"      ;ALL CHARACTERS GREATER THAN
				;"9" HAVE RETURNED, SO SEE IF NUMERIC
	CMC			;MAKE NUMERICS HAVE CARRY ON
	INC	AL		;SET ZERO IF [A]=0
	DEC	AL
	RET


; THIS ROUTINE MOVES THE SAVED CONSTANT INTO THE FAC
PUBLIC	CONFC1
CONFC1:
	MOV	AL,BYTE PTR CONSAV	;GET CONSTANT TOKEN
	CMP	AL,LOW OFFSET LINCON+1	;LINE# CONSTANT? (ERL=#)
	JAE	SHORT NTLINE	;NO
	CMP	AL,LOW OFFSET PTRCON	;LINE POINTER CONSTANT?
	JB	SHORT NTLINE	;NO
	MOV	BX,CONLO	;GET VALUE
	JNZ	SHORT FLTLIN	;MUST BE LINE NUMBER, NOT POINTER
	INC	BX		;POINT TO LINE #
	INC	BX
	INC	BX
	MOV	DL,BYTE PTR [BX]	;GET LINE # IN [D,E]
	INC	BX
	MOV	DH,BYTE PTR [BX]	;GET HIGH PART
	XCHG	BX,DX		;VALUE TO [H,L]
FLTLIN: JMP	INEG2		;FLOAT IT
NTLINE:
	MOV	AL,BYTE PTR CONTYP	;GET SAVED CONSTANT VALTYP
	MOV	BYTE PTR VALTYP,AL	;SAVE IN REAL VALTYP
	CMP	AL,LOW 8	;DOUBLE PRECISION
	JZ	SHORT CONFDB	;YES
	MOV	BX,CONLO	;GET LOW TWO BYTES OF FAC
	MOV	FACLO,BX	;SAVE THEM
	MOV	BX,CONLO+2	;GET NEXT TWO BYTES
	MOV	FACLO+2,BX	;SAVE THEM
	RET

CONFDB: MOV	BX,OFFSET CONLO ;GET POINTER TO SAVED CONSTANT AREA
	JMP	VMOVFM		;MOVE INTO FAC
	PAGE

	SUBTTL DEFSTR, DEFINT, DEFSNG, DEFDBL, INTIDX
DEFSTR: MOV	DL,LOW 3	;DEFAULT SOME LETTERS TO STRING
	DB	271O	; SKIP  ;"LXI B," OVER THE NEXT 2 BYTES
DEFINT: MOV	DL,LOW 2	;DEFAULT SOME LETTERS TO INTEGER
	DB	271O	; SKIP  ;"LXI B," OVER THE NEXT 2 BYTES
DEFREA: MOV	DL,LOW 4	;DEFAULT SOME LETTERS TO SINGLE PRECISION
	DB	271O	; SKIP  ;"LXI B," OVER THE NEXT 2 BYTES
DEFDBL: MOV	DL,LOW 8	;DEFAULT SOME LETTERS TO DOUBLE PRECISION
DEFCON: CALL	ISLET		;MAKE SURE THE ARGUMENT IS A LETTER
	MOV	CX,OFFSET SNERR ;PREPARE "SYNTAX ERROR" RETURN
	PUSH	CX
	JNB	SHORT $+3
	RET			;RETURN IF THERES NO LETTER
	SUB	AL,LOW "A"      ;MAKE AN OFFSET INTO DEFTBL
	MOV	CL,AL		;SAVE THE INITIAL OFFSET
	MOV	CH,AL		;ASSUME IT WILL BE THE FINAL OFFSET
	CALL	CHRGTR		;GET THE POSSIBLE DASH
	CMP	AL,LOW OFFSET MINUTK	;A RANGE ARGUMENT?
	JNZ	SHORT NOTRNG	;IF NOT, JUST ONE LETTER
	CALL	CHRGTR		;GET THE FINAL POSITION
	CALL	ISLET		;CHECK FOR A LETTER
	JNB	SHORT $+3
	RET			;GIVE A SYNTAX ERROR IF IMPROPER
	SUB	AL,LOW "A"      ;MAKE IT AN OFFSET
	MOV	CH,AL		;PUT THE FINAL IN [B]
	CALL	CHRGTR		;GET THE TERMINATOR
NOTRNG: MOV	AL,CH		;GET THE FINAL CHARACTER
	SUB	AL,CL		;SUBTRACT THE START
	JNB	SHORT $+3
	RET			;IF IT'S LESS THATS NONSENSE
	INC	AL		;SETUP THE COUNT RIGHT
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE THE TEXT POINTER AND GET RID
				;OF THE "SYNTAX ERROR" RETURN
	MOV	BX,OFFSET DEFTBL	;POINT TO THE TABLE OF DEFAULTS
	MOV	CH,LOW 0	;SETUP A TWO-BYTE STARTING OFFSET
	ADD	BX,CX		;MAKE [H,L] POINT TO THE FIRST ENTRY
				;TO BE MODIFIED
LPDCHG: MOV	BYTE PTR [BX],DL	;MODIFY THE DEFAULT TABLE
	INC	BX
	DEC	AL		;COUNT DOUNT THE NUMBER OF CHANGES TO MAKE
	JNZ	SHORT LPDCHG
	POP	BX		;GET BACK THE TEXT POINTER
	MOV	AL,BYTE PTR [BX]	;GET LAST CHARACTER
	CMP	AL,LOW 44	;IS IT A COMMA?
	JZ	SHORT $+3
	RET			;IF NOT STATEMENT SHOULD HAVE ENDED
	CALL	CHRGTR		;OTHERWISE SET UP TO SCAN NEW RANGE
	JMP	SHORT DEFCON
;
; INTIDX READS A FORMULA FROM THE CURRENT POSITION AND
; TURNS IT INTO A POSITIVE INTEGER
; LEAVING THE RESULT IN [D,E].  NEGATIVE ARGUMENTS
; ARE NOT ALLOWED. [H,L] POINTS TO THE TERMINATING
; CHARACTER OF THE FORMULA ON RETURN.
;
PUBLIC	INTIDX
INTIDX: CALL	CHRGTR
PUBLIC	INTID2
INTID2: CALL	GETIN2		;READ A FORMULA AND GET THE
				;RESULT AS AN INTEGER IN [D,E]
				;ALSO SET THE CONDITION CODES BASED ON
				;THE HIGH ORDER OF THE RESULT
	JS	SHORT $+3
	RET			;DON'T ALLOW NEGATIVE NUMBERS
PUBLIC	$FCERR
$FCERR:
PUBLIC	FCERR
FCERR:	MOV	DL,LOW OFFSET ERRFC	;TOO BIG. FUNCTION CALL ERROR
	JMP	ERROR
	PAGE

	SUBTTL LINSPC, LINGET
;
; LINSPC IS THE SAME AS LINGET EXCEPT IN ALLOWS THE
; CURRENT LINE (.) SPECIFIER
;
PUBLIC	LINSPC
LINSPC: MOV	AL,BYTE PTR [BX]	;GET CHAR FROM MEMORY
	CMP	AL,LOW "."      ;IS IT CURRENT LINE SPECIFIER
	MOV	DX,DOT		;GET CURRENT LINE #
	JNZ	SHORT ??L043
	JMP	CHRGTR		;ALL DONE.
??L043:
;
; LINGET READS A LINE # FROM THE CURRENT TEXT POSITION
;
; LINE NUMBERS RANGE FROM 0 TO 65529
;
; THE ANSWER IS RETURNED IN [D,E].
; [H,L] IS UPDATED TO POINT TO THE TERMINATING CHARACTER
; AND [A] CONTAINS THE TERMINATING CHARACTER WITH CONDITION
; CODES SET UP TO REFLECT ITS VALUE.
;
PUBLIC	LINGET
LINGET: DEC	BX		;BACKSPACE PTR
LINGT2: CALL	CHRGTR		;FETCH CHAR (GOBBLE LINE CONSTANTS)
	CMP	AL,LOW OFFSET LINCON	;EMBEDDED LINE CONSTANT?
	JZ	SHORT LINGT3	;YES, RETURN DOUBLE BYTE VALUE
	CMP	AL,LOW OFFSET PTRCON	;ALSO CHECK FOR POINTER
LINGT3: MOV	DX,CONLO	;GET EMBEDDED LINE #
	JNZ	SHORT ??L044
	JMP	CHRGTR		;EAT FOLLOWING CHAR
??L044:
	XOR	AL,AL		;SET FLAG THAT NO CONSTANT WAS SEEN SO
	MOV	BYTE PTR CONSAV,AL	;GOTO2 DOESN'T CHANGE LINCON TO PTRCON
	MOV	DX,0		;ZERO ACCUMULATED LINE #
	DEC	BX		;BACK UP POINTER
MORLIN:
	CALL	CHRGTR
	JNAE	SHORT $+3
	RET
	PUSH	BX
	LAHF
	PUSH	AX
	MOV	BX,6552	;SEE IF THE LINE # IS TOO BIG
	CMP	BX,DX
	JB	SHORT POPHSR	;YES, DON'T SCAN ANY MORE DIGITS IF SO
				;FORCE CALLER TO SEE DIGIT AND GIVE SYNTAX ERROR
				;CAN'T JUST GO TO SYNTAX ERROR BECAUSE OF NON-FAST
				;RENUM WHICH CAN'T TERMINATE
	MOV	BH,DH		;SAVE [D,E]
	MOV	BL,DL
	ADD	BX,DX
	ADD	BX,BX
	ADD	BX,DX
	ADD	BX,BX		;PUTTING [D,E]*10 INTO [H,L]
	POP	AX
	SAHF
	SUB	AL,LOW "0"
	MOV	DL,AL
	MOV	DH,LOW 0
	ADD	BX,DX		;ADD THE NEW DIGIT
	XCHG	BX,DX
	POP	BX		;GET BACK TEXT POINTER
	JMP	SHORT MORLIN

POPHSR: POP	AX
	SAHF			;GET OFF TERMINATING DIGIT
	POP	BX		;GET BACK OLD TEXT POINTER
	RET

	PAGE

	SUBTTL RUN, GOTO, GOSUB, RETURN, DATA, REM

RUN:	JNZ	SHORT ??L045
	JMP	RUNC		;NO LINE # ARGUMENT
??L045:
	CMP	AL,LOW OFFSET LINCON	;LINE NUMBER CONSTANT?
	JZ	SHORT CONRUN	;YES
	CMP	AL,LOW OFFSET PTRCON	;LINE POINTER (RATHER UNLIKELY)
	JZ	SHORT ??L046
	JMP	LRUN
??L046:
CONRUN:
				;CLEAN UP,SET [H,L]=[TXTTAB]-1 AND
				;RETURN TO NEWSTT
	CALL	CLEARC		;CLEAN UP -- RESET THE STACK
				;DATPTR,VARIABLES ...
				;[H,L] IS THE ONLY THING PRESERVED
	MOV	CX,OFFSET NEWSTT
	JMP	SHORT RUNC2	;PUT "NEWSTT" ON AND FALL INTO "GOTO"
;
; A "GOSUB" ENTRY ON THE STACK HAS THE FOLLOWING FORMAT
;
; LOW ADDRESS
;
;       A TOKEN EQUAL TO $GOSUB 1 BYTE (1 word on 8086/8)
;       Pointer to event flag if On Event Gosub - else 0000H
;       THE LINE # OF THE THE "GOSUB" STATEMENT 2 BYTES
;       A POINTER INTO THE TEXT OF THE "GOSUB" 2 BYTES
;
; HIGH ADDRESS
;
; TOTAL 5 BYTES
;
GOSUB:	MOV	CL,LOW 3	;"GOSUB" ENTRIES ARE 5 BYTES LONG
	CALL	GETSTK		;MAKE SURE THERE IS ROOM

	CALL	LINGET		;MUST SCAN LINE NUMBER NOW
	POP	CX		;POP OFF RETURN ADDRESS OF "NEWSTT"
	PUSH	BX		;REALLY PUSH THE TEXT POINTER
	PUSH	BX		;SAVE TEXT POINTER
	MOV	BX,CURLIN	;GET THE CURRENT LINE #
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT CURLIN ON THE STACK AND [H,L]=TEXT PTR

	MOV	CX,0		;so we know its not pointing to an
	PUSH	CX		; event flag (on event gosub ...)
	MOV	CX,OFFSET NEWSTT	;RESTORE [B,C] CORRECT VALUE
	MOV	AL,LOW OFFSET $GOSUB
	LAHF			; PUSH PSW
	XCHG	AL,AH
	PUSH	AX
	XCHG	AL,AH		;PUT GOSUB TOKEN ON THE STACK
	PUSH	CX		;SAVE NEWSTT ON STACK
	JMP	SHORT GOTO2	;HAVE NOW GRAB LINE # PROPERLY
;ENTRY POINT FOR GOSUB WITH DE=LINE POINTER(NOT LINE NUMBER)
PUBLIC	GOSUB2
GOSUB2:
	PUSH	BX		;PUT CURRENT TEXT POSN ON STACK
	PUSH	BX
	MOV	BX,CURLIN
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT CURLIN ON STACK
	PUSH	CX		;SAVE ADDRESS OF RETRUN MODIFY ADDRESS
	MOV	AL,LOW OFFSET $GOSUB
	LAHF			; PUSH PSW
	XCHG	AL,AH
	PUSH	AX
	XCHG	AL,AH		;PUT GOSUB ON STACK(FINAL GOSUB ENTRY)
	XCHG	BX,DX		;HL POINTS TO SUBROUTINE TEXT
	DEC	BX		;NEWSTT does INX H after loading SAVTXT
	MOV	SAVTXT,BX	;SAVE TXT PTR HERE, CURLIN LATER
	INC	BX
	JMP	GONE4		;CONTINUE WITH SUBROUTINE
RUNC2:	PUSH	CX		;RESTORE RETURN ADDRESS
				;OF "NEWSTT"
; AND SEARCH. IN THE 8K WE START WHERE WE
; ARE IF WE ARE  GOING TO A FORWARD LOCATION.
;
_GOTO:	CALL	LINGET		;PICK UP THE LINE #
				;AND PUT IT IN [D,E]
GOTO2:
	MOV	AL,BYTE PTR CONSAV	;GET TOKEN FOR LINE # BACK
	CMP	AL,LOW OFFSET PTRCON	;WAS IT A POINTER
	XCHG	BX,DX		;ASSUME SO
	JNZ	SHORT $+3
	RET			;IF IT WAS, GO BACK TO NEWSTT
				;WITH [H,L] AS TEXT PTR
	CMP	AL,LOW OFFSET LINCON	;MAKE SURE IT IS A LINE NUMBER CONSTANT
	JZ	SHORT ??L047
	JMP	SNERR		;IF NOT, BAD ARGUEMMENT PRESENT
??L047:
	XCHG	BX,DX		;FLIP BACK IF NOT
	PUSH	BX		;SAVE CURRENT TEXT PTR ON STACK
	MOV	BX,CONTXT	;GET POINTER TO RIGHT AFTER CONSTANT
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE ON STACK, RESTORE CURRENT TEXT PTR
	CALL	REM		;SKIP TO THE END OF THIS LINE
	INC	BX		;POINT AT THE LINK BEYOND IT
	PUSH	BX		;SAVE THE POINTER
	MOV	BX,CURLIN	;GET THE CURRENT LINE #
	CMP	BX,DX		;[D,E] CONTAINS WHERE WE ARE GOING
				;[H,L] CONTAINS THE CURRENT LINE #
				;SO COMPARING THEM TELLS US WHETHER TO
				;START SEARCHING FROM WHERE WE ARE OR
				;TO START SEARCHING FROM THE BEGINNING
				;OF TXTTAB
	POP	BX		;[H,L]=CURRENT POINTER
	JNB	SHORT ??L048
	CALL	_LOOP		;SEARCH FROM THIS POINT
??L048:
	JNAE	SHORT ??L049
	CALL	FNDLIN		;SEARCH FROM THE BEGINNING -- ACTUALLY
??L049:
				;SEARCH AGAIN IF ABOVE SEARCH FAILED
	JAE	SHORT USERR	;LINE NOT FOUND, DEATH
	DEC	CX		;POINT TO ZERO AT END OF PREVIOUS LINE
	MOV	AL,LOW OFFSET PTRCON	;POINTER CONSTANT
	MOV	BYTE PTR PTRFLG,AL	;SET PTRFLG
	POP	BX		;GET SAVED POINTER TO RIGHT AFTER CONSTANT
	CALL	CONCH2		;CHANGE LINE # TO PTR
	MOV	BX,CX		;[H,L]= POINTER TO THE START OF THE 
				;MATCHED LINE
				;NOW POINTING AT THE FIRST BYTE OF THE POINTER
				;TO THE START OF THE NEXT LINE
	RET			;GO TO NEWSTT
PUBLIC	USERR
USERR:	MOV	DL,LOW OFFSET ERRUS
	JMP	ERROR		;C=MATCH, SO IF NO MATCH WE
				;GIVE A "US" ERROR
;
; SEE "GOSUB" FOR THE FORMAT OF THE STACK ENTRY
; "RETURN" RESTORES THE LINE NUMBER AND TEXT POINTER ON THE STACK
; AFTER ELIMINATING ALL THE "FOR" ENTRIES IN FRONT OF THE "GOSUB"
; ENTRY
;
RETURN:
	MOV	TEMP,BX	;SAVE TEXT POINTER TO SEE IF LINE #
	MOV	DH,LOW 255	;MAKE SURE THIS VARIABLE POINTER
				;IN [D,E] NEVER GETS MATCHED
	CALL	FNDFOR		;GO PAST ALL THE "FOR" ENTRIES
	CMP	AL,LOW OFFSET $GOSUB	;see if matching GOSUB found
	JZ	SHORT RTRNOK	;branch if so
	DEC	BX		;else error, reset stack pointer
	DEC	BX
RTRNOK:
	MOV	SP,BX		;UPDATE THE STACK
	MOV	SAVSTK,BX	;UPDATE SAVED STACK
	CMP	AL,LOW OFFSET $GOSUB
	MOV	DL,LOW OFFSET ERRRG	;ERROR ERRRG IS "RETURN WITHOUT GOSUB"
	JZ	SHORT ??L050
	JMP	ERROR
??L050:
	F_TRPO=1		;AFTER A GOSUB WHICH WAS A TR AP WE AUTOMATICALLY
	F_TRPS=2		;STOP A REPEAT - THE RETURN RECLEARS THE STOP BIT
	POP	BX		;GET TRAP BITS REENABLE ADDRESS IF GOSUB
	OR	BX,BX		;see if [HL] is 0
	JZ	SHORT NOTEVT	;branch if not On Event Gosub
	MOV	AL,BYTE PTR [BX]	;WAS A TRAP ELSE JUST FAC ADDRESS
	AND	AL,LOW OFFSET F_TRPO	;IS TRAP ON?
	JZ	SHORT ??L051
EXTRN	RSTTRP:NEAR
	CALL	RSTTRP		;IF YES, RESET STOP
??L051:
NOTEVT:
	POP	CX		;GET LINE NUMBER OF GOSUB
	MOV	BX,OFFSET NEWSTT
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT RETURN ADDRESS OF "NEWSTT"
				;BACK ONTO THE STACK. GET TEXT POINTER
				;FROM "GOSUB"
	XCHG	BX,DX
	MOV	BX,TEMP	;GO BACK TO START
	LAHF
	DEC	BX
	SAHF
	CALL	CHRGTR
	JZ	SHORT ??L052
	JMP	_GOTO		;GO PROCESS RETURN [LINE #] 
??L052:
	MOV	BH,CH		;SET CURLIN FOR GOSUB
	MOV	BL,CL
	MOV	CURLIN,BX
	XCHG	BX,DX
				;SKIP OVER SOME CHARACTERS
				;SINCE WHEN "GOSUB" STUCK THE TEXT POINTER
				;ONTO THE STACK THE LINE # ARGUMENT HADN'T
				;BEEN READ IN YET.

	DW	260O	; SKIP  ;"MVI A," AROUND POP H.
DATAH:	POP	BX		;GET TEXT POINTER OFF STACK
PUBLIC	DATA
DATA	DW	261O	; SKIP  ;"LXI B," TO PICK UP ":" INTO C AND SKIP
	DB	":"	      ;"DATA" TERMINATES ON ":"
				;AND 0. ":" ONLY APPLIES IF
				;QUOTES HAVE MATCHED UP
; ON 8086, USE JMPR TO GO TO REMZER BECAUSE NOP IS NOT ZERO OPCODE
	JMP	SHORT REMZER
ELSES:				;EXECUTED "ELSE"S ARE SKIPPED
;
; NOTE: REM MUST PRESERVE [D,E] BECAUSE OF "GO TO" AND ERROR
;
REM	DW	261O	; SKIP  ;"MVI C,"   THE ONLY TERMINATOR IS ZERO
	DB	0	; SKIP  ;NO-OPERATION
				;"DATA" ACTUALLY EXECUTES THIS 0
REMZER: MOV	CH,LOW 0	;INSIDE QUOTES THE ONLY TERMINATOR IS ZERO
EXCHQT: MOV	AL,CL		;WHEN A QUOTE IS SEEN THE SECOND
	MOV	CL,CH		;TERMINATOR IS TRADED, SO IN "DATA"
	MOV	CH,AL		;COLONS INSIDE QUOTATIONS WILL HAVE NO EFFECT
REMER:
	DEC	BX		;NOP THE INX H IN CHRGET
REMER1: CALL	CHRGTR		;GET A CHAR
	OR	AL,AL		;ZERO IS ALWAYS A TERMINATOR
	JNZ	SHORT $+3
	RET
	CMP	AL,CH		;TEST FOR THE OTHER TERMINATOR
	JNZ	SHORT $+3
	RET
	INC	BX
	CMP	AL,LOW 34	;IS IT A QUOTE?
	JZ	SHORT EXCHQT	;IF SO TIME TO TRADE
;
; WHEN AN "IF" TAKES A FALSE BRANCH IT MUST FIND THE APPROPRIATE "ELSE"
; TO START EXECUTION AT. "DATA" COUNTS THE NUMBER OF "IF"S
; IT SEES SO THAT THE "ELSE" CODE CAN MATCH "ELSE"S WITH
; "IF"S. THE COUNT IS KEPT IN [D]
				;BECAUSE THEN S HAVE TNO COLON
				;MULTIPLE IFS CAN BE FOUND IN A SINGLE
				;STATEMENT SCAN
				;THIS CAUSES A PROBLEM FOR 8-BIT DATA
				;IN UNQUOTED STRING DATA BECAUSE $IF MIGHT
				;BE MATCHED. FIX IS TO HAVE FALSIF IGNORE CHANGES
				;IN [D] IF ITS A DATA STATEMENT
;
	INC	AL		;FUNCTION TOKEN?
	JZ	SHORT REMER1	;THEN IGNORE FOLLOWING FN NUMBER
	SUB	AL,LOW OFFSET $IF+1	;IS IT AN "IF"
	JNZ	SHORT REMER	;IF NOT, CONTINUE ON
	CMP	AL,CH		;SINCE "REM" CAN'T SMASH
				;[D,E] WE HAVE TO BE CAREFUL
				;SO ONLY IF B DOESN'T EQUAL
				;ZERO WE INCREMENT D. (THE "IF" COUNT)
	ADC	AL,DH		;CARRY ON IF [B] NOT ZERO
	MOV	DH,AL		;UPDATE [D]
	JMP	SHORT REMER
	PAGE

	SUBTTL "LET"

; LETCON IS LET ENTRY POINT WITH VALTYP-3 IN [A]
; BECAUSE GETYPR HAS BEEN CALLED
PUBLIC	LETCON
LETCON: POP	AX		;GET VALTYPE OFF STACK
	ADD	AL,LOW 3	;MAKE VALTYPE CORRECT
	JMP	SHORT LETCN2	;CONTINUE
LET:	CALL	PTRGET		;GET THE POINTER TO THE VARIABLE
				;NAMED IN TEXT AND PUT
				;IT INTO [D,E]
	CALL	SYNCHR
	DW	OFFSET EQULTK	;CHECK FOR "="
				;MUST SET UP TEMP FOR "FOR"
	MOV	TEMP,DX	;UP HERE SO WHEN USER-FUNCTIONS
REDINP: PUSH	DX
	MOV	AL,BYTE PTR VALTYP
	PUSH	AX
	CALL	FRMEVL		;GET THE VALUE OF THE FORMULA
	POP	AX		;GET THE VALTYP OF THE
				;VARIABLE INTO [A]
				;INTO FAC
LETCN2: POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;[H,L]=POINTER TO VARIABLE
				;TEXT POINTER TO ON TOP OF STACK
INPCOM: MOV	CH,AL		;SAVE VALTYP
	MOV	AL,BYTE PTR VALTYP	;GET PRESENT VALTYPE
	CMP	AL,CH		;COMPARE THE TWO
	MOV	AL,CH		;GET BACK CURRENT
	JZ	SHORT LETCN5	;VALTYPE ALREADY SET UP, GO!
	CALL	DOCNVF		;FORCE VALTPES TO BE [A]'S
PUBLIC	LETCN4
LETCN4: MOV	AL,BYTE PTR VALTYP	;GET VALTYPE
LETCN5: MOV	DX,OFFSET FACLO ;ASSUME THIS IS WHERE TO START MOVEING
	CMP	AL,LOW 5	;IS IT?
	JB	SHORT LETCN6	;YES
	MOV	DX,OFFSET DFACLO	;NO, USE D.P. FAC
LETCN6: PUSH	BX		;SAVE THE POINTER AT THE VALUE POSITION
	CMP	AL,LOW 3	;STRING?
	JNZ	SHORT COPNUM	;NUMERIC, SO FORCE IT AND COPY
; The following code makes a new copy of the string iff:
; - the string data resides in keyboard or File buffers (since data
;    in these buffers is temporary).
; - the string data resides in string space (each string var must have
;   its own copy of its string data)
; - the source string descriptor is not a temporary descriptor.
;
	MOV	BX,FACLO	;GET POINTER TO THE DESCRIPTOR OF THE RESULT
	PUSH	BX		;SAVE THE POINTER AT THE DESCRIPTOR
	INC	BX
	MOV	DX,[BX]
	MOV	BX,TXTTAB	;IF THE DATA IS IN BUF, OR IN DISK
	CMP	BX,DX		;SINCE BUF CHANGES ALL THE TIME
	JAE	SHORT INBUFC	;GO COPY, IF DATA REALLY IS IN BUF
	MOV	BX,STREND	;SEE IF IT POINTS INTO STRING SPACE
	CMP	BX,DX		;IF NOT DON'T COPY
	POP	DX		;GET BACK THE POINTER AT THE DESCRIPTOR
	JAE	SHORT DNTCPY	;DON'T COPY LITERALS
	MOV	BX,OFFSET DSCTMP-1
	CMP	BX,DX		;IS THE DESCRIPTOR A TEMP?
	JB	SHORT INBFC0	;NO, MUST POINT TO VARIABLE(COPY IT!)
	MOV	BX,OFFSET TEMPST-1
	CMP	BX,DX
	JB	SHORT DNTCPY	;YES, DON'T COPY
INBFC0:
	DB	260O	; SKIP  ;SKIP THE NEXT BYTE WITH A "MVI A,"
INBUFC: POP	DX		;GET THE POINTER TO THE DESCRIPTOR
				;IN [D,E]
	CALL	FRETMS		;FREE UP A TEMORARY POINTING INTO BUF
	XCHG	BX,DX		;STRCPY COPIES [H,L]
	CALL	STRCPY		;COPY VARIABLES IN STRING SPACE OR
				;STRINGS WITH DATA IN BUF
DNTCPY: CALL	FRETMS		;FREE UP THE TEMPORARY WITHOUT
				;FREEING UP ANY STRING SPACE
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;[H,L]=PLACE TO STORE THE DESCRIPTOR
				;LEAVE A NONSENSE ENTRY ON THE STACK,
				;SINCE THE "POP D" DOESN'T EVER
				;MATTER IN THIS CASE
COPNUM: CALL	VMOVE		;COPY A DESCRIPTOR OR A VALUE
	POP	DX		;FOR "FOR" POP OFF A POINTER
				;AT THE LOOP VARIABLE INTO [D,E]
	POP	BX		;GET THE TEXT POINTER BACK
	RET
	PAGE

	SUBTTL ON..GOTO, ON ERROR GOTO CODE

ONGOTO:
	CMP	AL,LOW OFFSET $ERROR	;"ON...ERROR"?
	JNZ	SHORT NTOERR	;NO.
	CALL	CHRGTR		;GET NEXT THING
	CALL	SYNCHR
	DW	OFFSET $GOTO	;MUST HAVE ...GOTO
	CALL	LINGET		;GET FOLLOWING LINE #
	OR	DX,DX		;IS LINE NUMBER ZERO?
	JZ	SHORT RESTRP	;IF ON ERROR GOTO 0, RESET TRAP
	CALL	FNDLN1		;SEE IF LINE EXISTS (SAVE [H,L] ON STACK)
	MOV	DH,CH		;GET POINTER TO LINE IN [D,E]
	MOV	DL,CL		;(LINK FIELD OF LINE)
	POP	BX		;RESTORE [H,L]
	JNAE	SHORT ??L053
	JMP	USERR		;ERROR IF LINE NOT FOUND
??L053:
RESTRP: MOV	ONELIN,DX	;SAVE POINTER TO LINE OR ZERO IF 0.
	JNB	SHORT $+3
	RET			;YOU WOULDN'T BELIEVE IT IF I TOLD YOU
	MOV	AL,BYTE PTR ONEFLG	;ARE WE IN AN "ON...ERROR" ROUTINE?
	OR	AL,AL		;SET CONDITION CODES
	MOV	AL,DL		;WANT AN EVEN STACK PTR. FOR 8086
	JNZ	SHORT $+3
	RET			;IF NOT, HAVE ALREADY DISABLED TRAPPING.
	MOV	AL,BYTE PTR ERRFLG	;GET ERROR CODE
	MOV	DL,AL		;INTO E.
	JMP	ERRESM		;FORCE THE ERROR TO HAPPEN
NTOERR:
	EXTRN	ONGOTP:NEAR
	CALL	ONGOTP		;CHECK FOR "ON event GOSUB ..."
	JB	SHORT NTONGS	;NOT AN event TRAP
	PUSH	CX		;SAVE START TRAP NUM FOR event(IN B)
				;AND NUMBER OF EVENTS POSSIBLE(IN C)
	CALL	CHRGTR		;SKIP OVER EVENT TOKEN
	CALL	SYNCHR
	DW	OFFSET $GOSUB	;Is ON event GOSUB nn,nn, ...
	XOR	AL,AL		;A = LINE NUMBER COUNT
ONGSB0: POP	CX
	PUSH	CX
	CMP	AL,CL		;WITHIN RANGE OF ALLOWBLE TRAPS?
	JNAE	SHORT ??L054
	JMP	SNERR
??L054:
	LAHF			; PUSH PSW
	XCHG	AL,AH
	PUSH	AX
	XCHG	AL,AH
	CALL	LINGET
	MOV	AL,DH
	OR	AL,DL		;LINE 0?
	JZ	SHORT RSTRAP	;YES, JUST RESET PORT TRAP
	CALL	FNDLN1		;LINE NUMBER EXIST?(SAVE HL ON STACK)
	MOV	DH,CH
	MOV	DL,CL
	POP	BX		;RESTORE TEXT POINTER
	JNAE	SHORT ??L055
	JMP	USERR		;ERROR IF LINE NOT FOUND
??L055:
RSTRAP: POP	AX		; POP PSW
	XCHG	AL,AH
	SAHF			;A = PORT NUMBER
	POP	CX
	LAHF			; PUSH PSW
	XCHG	AL,AH
	PUSH	AX
	XCHG	AL,AH
	ADD	AL,CH
	PUSH	CX
	CALL	SETGSB		;SET GOSUB ADDR FOR THIS AREA IN A
	LAHF
	DEC	BX
	SAHF
	CALL	CHRGTR
	POP	CX
	POP	DX
	JNZ	SHORT $+3
	RET
	PUSH	CX
	PUSH	DX
	CALL	SYNCHR
	DW	OFFSET 54O
	POP	AX		; POP PSW
	XCHG	AL,AH
	SAHF
	INC	AL		;NEXT AREA
	JMP	SHORT ONGSB0	;DO NEXT GOSUB ADDR
NTONGS:

	CALL	GETBYT		;GET VALUE INTO [E]
PUBLIC	NTONG1
NTONG1:			;jumped to by MENU statement
	MOV	AL,BYTE PTR [BX]	;GET THE TERMINATOR BACK
	MOV	CH,AL		;SAVE THIS CHARACTER FOR LATER
	CMP	AL,LOW OFFSET $GOSUB	;AN "ON ... GOSUB" PERHAPS?
	JZ	SHORT ISGOSU	;YES, SOME FEATURE USE
	CALL	SYNCHR
	DW	OFFSET $GOTO	;OTHERWISE MUST BE "GOTO"
	DEC	BX		;BACK UP CHARACTER POINTER
ISGOSU: MOV	CL,DL		;GET COUNT INTO  [C]
LOOPON: DEC	CL		;SEE IF ENOUGH SKIPS
	MOV	AL,CH		;PUT DISPATCH CHARACTER IN PLACE
	JNZ	SHORT ??L056
	JMP	GONE2		;IF DONE, GO OFF
??L056:
	CALL	LINGT2		;SKIP OVER A LINE #
	CMP	AL,LOW 44	;A COMMA
	JZ	SHORT $+3
	RET			;IF A COMMA DOESN'T DELIMIT THE END OF
				;THE CURRENT LINE # WE MUST BE THE END OF THE LINE
	JMP	SHORT LOOPON	;CONTINUE GOBBLING LINE #S

	PAGE

	SUBTTL RESUME, ERROR STATEMENT CODE
RESUME:
	MOV	AL,BYTE PTR ONEFLG	;Get flag
	OR	AL,AL		;Were we called by an ON ERROR?
	JNZ	SHORT ??L057
	JMP	REERR		;Not in an ON ERROR routine
??L057:
	XOR	AL,AL
	MOV	BYTE PTR ERRFLG,AL	;CLEAR ERROR FLAG SO ^C DOESN'T GIVE ERROR
	MOV	AL,BYTE PTR [BX]	;GET CURRENT CHAR BACK
	CMP	AL,LOW OFFSET $NEXT	;RESUME NEXT?
	JZ	SHORT RESNXT	;YUP.
	CALL	LINGET
	JZ	SHORT $+3
	RET			;SHOULD TERMINATE
	OR	DX,DX		;IS LINE NUMBER ZERO?
	JZ	SHORT RES0	;Yep, go set non-zero CC's
	CALL	GOTO2		;Go find line
	XOR	AL,AL		;Now zero flag (otherwise RESUME non-
				; existent line number would be trapped
				; by the ON ERROR routine and we would
				; loop infinitely).
	MOV	BYTE PTR ONEFLG,AL
	RET
;
RESNXT: CALL	CHRGTR		;MUST TERMINATE
	JZ	SHORT $+3
	RET			;BLOW HIM UP
	JMP	SHORT RESTXT
;
RES0:	XOR	AL,AL
	MOV	BYTE PTR ONEFLG,AL	;clear RESUME-TRAP flag
	INC	AL		;Set nonzero CC's
RESTXT: MOV	BX,ERRTXT	;GET POINTER INTO LINE.
	XCHG	BX,DX		;SAVE ERRTXT IN [D,E]
	MOV	BX,ERRLIN	;GET LINE #
	MOV	CURLIN,BX	;SAVE IN CURRENT LINE #
	XCHG	BX,DX
	JZ	SHORT $+3
	RET			;GO TO NEWSTT IF JUST "RESUME"
	MOV	AL,BYTE PTR [BX]	;GET ":" OR LINE HEADER
	OR	AL,AL		;SET CC
	JNZ	SHORT NOTBGL	;#0 MEANS MUST BE ":"
	INC	BX		;SKIP HEADER
	INC	BX
	INC	BX
	INC	BX
NOTBGL: INC	BX		;POINT TO START OF THIS STATEMENT
	XOR	AL,AL		;Now zero flag (otherwise RESUME non-
				; existent line number would be trapped
				; by the ON ERROR routine and we would
				; loop infinitely).
	MOV	BYTE PTR ONEFLG,AL
	JMP	DATA		;GET NEXT STMT

; THIS IS THE ERROR <CODE> STATEMENT WHICH FORCES
; AN ERROR OF TYPE <CODE> TO OCCUR
; <CODE> MUST BE .GE. 0 AND .LE. 255
ERRORS: CALL	GETBYT		;GET THE PARAM
	JZ	SHORT $+3
	RET			;SHOULD HAVE TERMINATED
	OR	AL,AL		;ERROR CODE 0?
	JNZ	SHORT ??L058
	JMP	FCERR		;YES, ERROR IN ITSELF
??L058:
GOERR:	JMP	ERROR		;FORCE AN ERROR
	PAGE

	SUBTTL AUTO COMMAND
; THE AUTO [BEGGINNING LINE[,[INCREMENT]]]
; COMMAND IS USED TO AUTOMATICALLY GENERATE LINE NUMBERS
; FOR LINES TO BE INSERTED. BEGINNING LINE IS
; USED TO SPECIFY THE INITAL LINE (10 IS ASSUMED IF OMMITED)
; AND THE INCREMENT IS USED TO SPECIFY THE INCREMENT USED
; TO GENERATE THE NEXT LINE #. IF ONLY A COMMA IS USED AFTER THE
; BEGGINING LINE, THE OLD INCREMENT IS USED.
AUTO:	MOV	DX,10		;ASSUME INITIAL LINE # OF 10
	PUSH	DX		;SAVE IT
	JZ	SHORT SNGAUT	;IF END OF COMMAND USE 10,10
	CALL	LINSPC		;GET LINE #, ALLOW USE OF . FOR CURRENT LINE
	XCHG	BX,DX		;GET TXT PTR IN [D,E]
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT INIT ON STACK, GET 10 IN [H,L]
	JZ	SHORT SNGAU1	;IF TERMINATOR, USE INC OF 10
	XCHG	BX,DX		;GET TEXT PTR BACK IN [H,L]
	CALL	SYNCHR
	DB	OFFSET 54O	;COMMA MUST FOLLOW
	MOV	DX,AUTINC	;GET PREVIOUS INC
	JZ	SHORT SNGAUT	;USE PREVIOUS INC IF TERMINATOR
	CALL	LINGET		;GET INC
	JZ	SHORT ??L059
	JMP	SNERR		;SHOULD HAVE FINISHED.
??L059:
SNGAUT: XCHG	BX,DX		;GET INC IN [H,L]
SNGAU1: MOV	AL,BH		;SEE IF ZERO
	OR	AL,BL
	JNZ	SHORT ??L060
	JMP	FCERR		;ZERO INC GIVES FCERR
??L060:
	MOV	AUTINC,BX	;SAVE INCREMENT
	MOV	BYTE PTR AUTFLG,AL	;SET FLAG TO USE AUTO IN MAIN CODE.
	POP	BX		;GET INITIAL LINE #
	MOV	AUTLIN,BX	;SAVE IN INTIAL LINE
	POP	CX		;GET RID OF NEWSTT ADDR
	JMP	MAIN		;JUMP INTO MAIN CODE (FOR REST SEE AFTER MAIN:)
	PAGE

	SUBTTL IF ... THEN CODE
IFS:	CALL	FRMEVL		;EVALUATE A FORMULA
	MOV	AL,BYTE PTR [BX]	;GET TERMINATING CHARACTER OF FORMULA
	CMP	AL,LOW 44
	JNZ	SHORT ??L061
	CALL	CHRGTR		;IF SO SKIP IT
??L061:
	CMP	AL,LOW OFFSET $GOTO	;ALLOW "GOTO" AS WELL
	JZ	SHORT OKGOTO
	CALL	SYNCHR
	DW	OFFSET THENTK	;MUST HAVE A THEN
	DEC	BX
OKGOTO:
	PUSH	BX		;SAVE THE TEXT POINTER
	CALL	VSIGN
	POP	BX		;GET BACK THE TEXT POINTER
	JZ	SHORT FALSIF	;HANDLE POSSIBLE "ELSE"
DOCOND: CALL	CHRGTR		;PICK UP THE FIRST LINE # CHARACTER
	JNZ	SHORT $+3
	RET			;RETURN FOR "THEN :" OR "ELSE :"
	CMP	AL,LOW OFFSET LINCON	;LINE NUMBER CONSTANT?
	JNZ	SHORT ??L062
	JMP	_GOTO		;DO A "GOTO"
??L062:
	CMP	AL,LOW OFFSET PTRCON	;POINTER CONSTANT
	JZ	SHORT ??L063
	JMP	GONE2		;EXECUTE STATEMENT, NOT GOTO
??L063:
	MOV	BX,CONLO	;GET TEXT POINTER
	RET			;FETCH NEW STATMENT
;
; "ELSE" HANDLER. HERE ON FALSE "IF" CONDITION
;
FALSIF: MOV	DH,LOW 1	;NUMBER OF "ELSE"S THAT MUST
				;BE SEEN. "DATA" INCREMENTS THIS
				;COUNT EVERY TIME AN "IF" IS SEEN
SKPMRF: CALL	DATA		;SKIP A STATEMENT
				;":" IS STUCK IN FRONT OF "ELSE"S
				;SO THAT "DATA" WILL STOP BEFORE "ELSE" CLAUSES
	OR	AL,AL		;END OF LINE?
	JNZ	SHORT $+3
	RET			;IF SO, NO "ELSE" CLAUSE
	CALL	CHRGTR		;SEE IF WE HIT AN "ELSE"
	CMP	AL,LOW OFFSET $ELSE
	JNZ	SHORT SKPMRF	;NO, STILL IN THE "THEN" CLAUSE
	DEC	DH		;DECREMENT THE NUMBER OF "ELSE"S THAT
				;MUST BE SEEN
	JNZ	SHORT SKPMRF	;SKIP MORE IF HAVEN'T SEEN
				;ENOUGH
	JMP	SHORT DOCOND	;FOUND THE RIGHT "ELSE" -- GO EXECUTE

	PAGE

	SUBTTL PRINT CODE

	EXTRN	LPRINT:NEAR,LPRINT:NEAR,FINPRT:NEAR

	SUBTTL LINE INPUT, INPUT AND READ CODE
LINE:
	EXTRN	GLINE:NEAR
	CMP	AL,LOW OFFSET $INPUT
	JZ	SHORT ??L064
	JMP	GLINE		;MUST BE GRAPHICS TYPE LINE
??L064:
	CALL	SYNCHR
	DW	OFFSET $INPUT
	CMP	AL,LOW "#"      ;SEE IF THERE IS A FILE NUMBER
	EXTRN	DLINE:NEAR
	JNZ	SHORT ??L065
	JMP	DLINE		;DO DISK INPUT LINE
??L065:
	CALL	SCNSEM		;SCAN SEMICOLON FOR NO-CR
	CALL	QTINP		;PRINT QUOTED STRING IF ONE
	CALL	PTRGET		;READ STRING TO STORE INTO
	CALL	CHKSTR		;MAKE SURE ITS A STRING
	PUSH	DX		;SAVE POINTER AT VARIABLE
	PUSH	BX		;SAVE TEXT POINTER
	EXTRN	SINLIN:NEAR
	CALL	SINLIN		;READ A LINE OF INPUT
	POP	DX		;GET TEXT POINTER
	POP	CX		;GET POINTER AT VARIABLE
	JAE	SHORT ??L066
	JMP	STPEND		;IF CONTROL-C, STOP
??L066:
RELINE: PUSH	CX		;SAVE BACK VARIABLE POINTER
	PUSH	DX		;SAVE TEXT POINTER
	MOV	CH,LOW 0	;SETUP ZERO AS ONLY TERMINATOR
	CALL	STRLT3		;LITERALIZE THE INPUT
	POP	BX		;RESTORE [H,L]=TEXT POINTER
	MOV	AL,LOW 3	;SET THREE FOR STRING
	JMP	LETCN2		;DO THE ASSIGNMENT

TRYAGN:
	DB"?Redo from start"
	ACRLF
	DB	0
;
; HERE WHEN PASSING OVER STRING LITERAL IN SUBSCRIPT OF VARIABLE IN INPUT LIST
; ON THE FIRST PASS OF INPUT CHECKING FOR TYPE MATCH AND NUMBER
;
SCNSTR: INC	BX		;LOOK AT THE NEXT CHARACTER
	MOV	AL,BYTE PTR [BX]	;FETCH IT
	OR	AL,AL		;END OF LINE?
	JNZ	SHORT ??L067
	JMP	SNERR		;ENDING IN STRING IN SUBSCRIPT IS BAD SYNTAX
??L067:
	CMP	AL,LOW 34	;ONLY OTHER TERMINATOR IS QUOTE
	JNZ	SHORT SCNSTR	;CONTINUE UNTIL QUOTE OR 0 IS FOUND
	JMP	SCNCON		;CONTINUE MATCHING PARENS SINCE STRING ENDED

INPBAK: POP	BX		;GET RID OF PASS1 DATA POINTER
	POP	BX		;GET RID OF PASS2 DATA POINTER
	JMP	SHORT RDOIN2	;GET RID OF PASS2 VARLST POINTER AND RETRY
;
; HERE WHEN THE DATA THAT WAS TYPED IN OR IN "DATA" STATEMENTS
; IS IMPROPERLY FORMATTED. FOR "INPUT" WE START AGAIN.
; FOR "READ" WE GIVE A SYNTAX ERROR AT THE DATA LINE
;
TRMNOK:
	MOV	AL,BYTE PTR FLGINP	;WAS IT READ OR INPUT?
	OR	AL,AL		;ZERO=INPUT
	JZ	SHORT ??L068
	JMP	DATSNE		;GIVE ERROR AT DATA LINE
??L068:
RDOIN2: POP	CX		;GET RID OF THE POINTER INTO THE VARIABLE LIST
RDOINP:
	MOV	BX,OFFSET TRYAGN
	CALL	STROUT		;PRINT "?REDO FROM START"
	MOV	BX,SAVTXT	;GET SAVED TEXT POINTER
	RET			;GO BACK TO NEWSTT
				;OF THE "INPUT" STATEMENT
FILSTI: CALL	FILINP
	PUSH	BX		;PUT THE TEXT POINTER ON THE STACK
	MOV	BX,OFFSET BUFMIN	;POINT AT A COMMA
	JMP	INPCN3
INPUT:

	CMP	AL,LOW "#"
	JZ	SHORT FILSTI
	CALL	SCNSEM		;SCAN SEMICOLON FOR NO-CR
	MOV	CX,OFFSET NOTQTI	;WHERE TO GO
	PUSH	CX		;WHEN DONE WITH QUOTED STRING
QTINP:	CMP	AL,LOW 34	;IS IT A QUOTE?
	MOV	AL,LOW 0	;BE TALKATIVE
	MOV	BYTE PTR CNTOFL,AL	;FORCE OUTPUT
	MOV	AL,LOW 255	;MAKE NON-ZERO VALUE
	MOV	BYTE PTR TEMPA+1,AL	;FLAG TO DO "? "
	JZ	SHORT $+3
	RET			;JUST RETURN
	CALL	STRLTI		;MAKE THE MESSAGE A STRING
	MOV	AL,BYTE PTR [BX]	;GET CHAR
	CMP	AL,LOW 54O	;COMMA?
	JNZ	SHORT NTICMA	;NO
	XOR	AL,AL		;FLAG NOT TO DO IT
	MOV	BYTE PTR TEMPA+1,AL
	CALL	CHRGTR		;FETCH NEXT CHAR
	JMP	SHORT INPCMA	;CONTINUE
NTICMA:
	CALL	SYNCHR
	DB	OFFSET 59	;MUST END WITH SEMI-COLON
INPCMA:
	PUSH	BX		;REMEMBER WHERE IT ENDED
	CALL	STRPRT		;PRINT IT OUT
	POP	BX		;GET BACK SAVED TEXT PTR
	RET			;ALL DONE
NOTQTI:
	PUSH	BX
GETAGN:
	MOV	AL,BYTE PTR TEMPA+1	;DO "? "
	OR	AL,AL
	JZ	SHORT SUPPRS	;THEN SUPPRESS "?"
	MOV	AL,LOW "?"      ;TYPE "?" AND INPUT A LINE OF TEXT
	CALL	OUTDO
	MOV	AL,LOW " "
	CALL	OUTDO
SUPPRS:
	CALL	SINLIN
	POP	CX		;TAKE OFF SINCE MAYBE LEAVING
	JAE	SHORT ??L069
	JMP	STPEND		;IF EMPTY LEAVE
??L069:
	PUSH	CX		;PUT BACK  SINCE DIDN'T LEAVE
;
; THIS IS THE FIRST PASS DICTATED BY ANSI REQUIRMENT THAN NO VALUES BE ASSIGNED 
; BEFORE CHECKING TYPE AND NUMBER. THE VARIABLE LIST IS SCANNED WITHOUT EVALUATING
; SUBSCRIPTS AND THE INPUT IS SCANNED TO GET ITS TYPE. NO ASSIGNMENT
; IS DONE
;
	XOR	AL,AL		;FLAG AS INPUT SO SCNVAL WILL WORK
	MOV	BYTE PTR FLGINP,AL	;WHEN SCANNING STRINGS WITH ":"
	MOV	BYTE PTR [BX],LOW 44	;PUT A COMMA IN FRONT OF BUF
	XCHG	BX,DX		;SAVE DATA POINTER IN [D,E]
	POP	BX		;GET THE VARLST POINTER INTO [H,L]
	PUSH	BX		;RESAVE THE VARLST POINTER
	PUSH	DX		;SAVE A COPY OF THE DATA POINTER FOR PASS2
	PUSH	DX		;SAVE THE DATA POINTER FOR PASS1
	DEC	BX		;READ THE FIRST VARIABLE NAME
VARLOP: MOV	AL,LOW 128	;DON'T ALLOW SUBSCRIPTS -- RETURN POINTING TO "("
	MOV	BYTE PTR SUBFLG,AL
	CALL	CHRGTR		;ADVANCE TEXT POINTER
	EXTRN	PTRGTN:NEAR
	CALL	PTRGTN		;SCAN NAME AND RETURN POINTER IN [D,E]
	MOV	AL,BYTE PTR [BX]	;SEE IF IT ENDED ON "("
	DEC	BX		;RESCAN THE TERMINATOR
	CMP	AL,LOW "["      ;allow brackets also
	JZ	SHORT SCNBKT
	CMP	AL,LOW "("      ;ARRAY OR NOT?
	JNZ	SHORT ENDSCN	;IF NOT, VARIABLE NAME IS DONE
SCNBKT: INC	BX		;NOW SCAN THE SUBSCRIPT EXPRESSION
	MOV	CH,LOW 0	;INITIALIZE THE PAREN COUNT
SCNOPN: INC	CH		;UP THE COUNT FOR EVERY "("
SCNCON: CALL	CHRGTR		;GET THE NEXT CHARACTER
	JNZ	SHORT ??L070
	JMP	SNERR		;SHOULDN'T END STATEMENT IN EXPRESSION
??L070:
	CMP	AL,LOW 34	;IS THERE A QUOTED STRING CONSTANT
	JNZ	SHORT ??L071
	JMP	SCNSTR		;GO SCAN THE ENDTIRE CONSTANT (MAY CONTAIN PARENS)
??L071:
	CMP	AL,LOW "("      ;ANOTHER LEVEL OF NESTING?
	JZ	SHORT SCNOPN	;INCREMENT COUTN AND KEEP SCANNING
	CMP	AL,LOW "["      ;left bracket?
	JZ	SHORT SCNCON	;yes, ok
	CMP	AL,LOW "]"      ;left bracket?
	JZ	SHORT LEFPRN	;yes
	CMP	AL,LOW ")"      ;ONE LESS LEVEL OF PARENS?
	JNZ	SHORT SCNCON	;NO, KEEP SCANNING
				;DECREMENT PAREN COUNT. OUT OF SUBSCRIPT?
LEFPRN: DEC	CH
	JNZ	SHORT SCNCON	;IF NOT AT ZERO LEVEL, KEEP SCANNING
ENDSCN: CALL	CHRGTR		;GET TERMINATING CHARACTER
	JZ	SHORT OKVLST	;LAST VARIABLE IN INPUT LIST
	CMP	AL,LOW 44	;OTHERWISE IT MUST BE A COMMA
	JZ	SHORT ??L072
	JMP	SNERR		;BADLY FORMED INPUT -- SYNTAX ERROR
??L072:
OKVLST: POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE THE VARLST POINTER 
				;GET THE DATA POINTER INTO [H,L]
	MOV	AL,BYTE PTR [BX]	;DATA SHOULD ALWAYS HAVE A LEADING COMMA
	CMP	AL,LOW 44	;IS IT PROPERLY FORMED?
	JZ	SHORT ??L073
	JMP	INPBAK		;NO, ASK FOR COMPLETE REINPUT
??L073:
	MOV	AL,LOW 1	;SET OVCSTR=1
	MOV	BYTE PTR OVCSTR,AL
	MOV	BYTE PTR FLGSCN,AL	;Flag to SCNVAL that call is from INPUT
	CALL	SCNVAL		;GO INTO PASS2 CODE AND SCAN A VALUE
	MOV	AL,BYTE PTR FLGSCN
	DEC	AL		;Restore flag
	MOV	BYTE PTR FLGSCN,AL
	MOV	AL,BYTE PTR OVCSTR	;SEE IF IT WAS TOO BIG
	DEC	AL
	JZ	SHORT ??L074
	JMP	INPBAK
??L074:
	PUSH	BX		;SAVE THE RETURNED DATA POINTER
	CALL	GETYPR		;RELEASE STRING
	JNZ	SHORT ??L075
	CALL	FREFAC
??L075:
	POP	BX
	DEC	BX		;SKIP OVER SPACES LEFT AFTER VALUE SCAN
	CALL	CHRGTR
;
; NOTE CHECK FOR OVERFLOW OF INPUT VALUE HERE
;
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE THE DATA POINTER
				;[H,L]=DATA LIST POINTER
	MOV	AL,BYTE PTR [BX]	;DID VARIABLE LIST CONTINUE?
	CMP	AL,LOW 44	;MUST HAVE HAD A COMMA
	JNZ	SHORT ??L076
	JMP	VARLOP		;GO CHECK ANOTHER
??L076:
	POP	BX		;GET FINAL DATA POINTER
	DEC	BX		;SKIP OVER ANY TRAILING SPACES
	CALL	CHRGTR
	OR	AL,AL		;IS IT A TRUE END?
	POP	BX		;GET THE START OF DATA POINTER FOR PASS2
	JZ	SHORT ??L077
	JMP	RDOIN2		;IF DATA ENDED BADLY ASK FOR REINPUT
??L077:
INPCN3:
	MOV	BYTE PTR [BX],LOW 44	;SETUP COMMA AT BUFMIN
	JMP	SHORT INPCON
READ:
	PUSH	BX		;SAVE THE TEXT POINTER
	MOV	BX,DATPTR	;GET LAST DATA LOCATION
	DB	15O	; SKIP  ;"ORI" TO SET [A] NON-ZERO
INPCON: XOR	AL,AL		;SET FLAG THAT THIS IS AN INPUT
	MOV	BYTE PTR FLGINP,AL	;STORE THE FLAG
;
; IN THE PROCESSING OF DATA AND READ STATEMENTS:
; ONE POINTER POINTS TO THE DATA (IE THE NUMBERS BEING FETCHED)
; AND ANOTHER POINTS TO THE LIST OF VARIABLES
;
; THE POINTER INTO THE DATA ALWAYS STARTS POINTING TO A
; TERMINATOR -- A , : OR END-OF-LINE
;
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;[H,L]=VARIABLE LIST POINTER
				;DATA POINTER GOES ON THE STACK
	JMP	SHORT LOPDAT
LOPDT2: CALL	SYNCHR
	DB	OFFSET 44	;MAKE SURE THERE IS A ","
LOPDAT: CALL	PTRGET		;READ THE VARIABLE LIST
				;AND GET THE POINTER TO A VARIABLE INTO [D,E]
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT THE VARIABLE LIST POINTER ONTO THE
				;STACK AND TAKE THE
				;DATA LIST POINTER OFF
;
; NOTE AT THIS POINT WE HAVE A VARIABLE WHICH WANTS DATA
; AND SO WE MUST GET DATA OR COMPLAIN
;
	PUSH	DX		;SAVE THE POINTER TO THE VARIABLE WE
				;ARE ABOUT TO SET UP WITH A VALUE
	MOV	AL,BYTE PTR [BX]	;SINCE THE DATA LIST POINTER ALWAYS POINTS
				;AT A TERMINATOR LETS READ THE
				;TERMINATOR INTO [A] AND SEE WHAT
				;IT IS
	CMP	AL,LOW 44
	JZ	SHORT DATBK	;A COMMA SO A VALUE MUST FOLLOW
	MOV	AL,BYTE PTR FLGINP	;SEE WHAT TYPE OF STATEMENT THIS WAS
	OR	AL,AL
				;SEARCH FOR ANOTHER DATA STATEMENT
	JZ	SHORT ??L078
	JMP	DATLOP
??L078:
DATBK:
	DB	15O	; SKIP  ;SET A NON-ZERO
SCNVAL: XOR	AL,AL		;SET ZERO FLAG IN [A]
	MOV	BYTE PTR INPPAS,AL	;STORE SO EARLY RETURN CHECK WORKS
EXTRN	ISFLIO:NEAR
	CALL	ISFLIO		;SEE IF A FILE READ
	JZ	SHORT ??L079
	JMP	FILIND		;IF SO, SPECIAL HANDLING
??L079:
	CALL	GETYPR		;IS IT A STRING?
	PUSH	AX		;SAVE THE TYPE INFORMATION
	JNZ	SHORT NUMINS	;IF NUMERIC, USE FIN TO GET IT
				;ONLY THE VARAIBLE TYPE IS
				;CHECKED SO AN UNQUOTED STRING
				;CAN BE ALL DIGITS
	CALL	CHRGTR
	MOV	DH,AL		;ASSUME QUOTED STRING
	MOV	CH,AL		;SETUP TERMINATORS
	CMP	AL,LOW 34	;QUOTE ?
	JZ	SHORT NOWGET	;TERMINATORS OK
	MOV	AL,BYTE PTR FLGINP	;INPUT SHOULDN'T TERMINATE ON ":"
	OR	AL,AL		;SEE IF READ OR INPUT
	MOV	DH,AL		;SET D TO ZERO FOR INPUT
	JZ	SHORT NCOLST
	MOV	DH,LOW ":"      ;UNQUOTED STRING TERMINATORS
NCOLST: MOV	CH,LOW 44	;ARE COLON AND COMMA
				;NOTE: ANSI USES [B]=44 AS A FLAG TO 
				;TRIGGER TRAILING SPACE SUPPRESSION
	DEC	BX		;BACKUP SINCE START CHARACTER MUST BE INCLUDED
				;IN THE QUOTED STRING CASE WE DON'T WANT TO
				;INCLUDE THE STARTING OR ENDING QUOTE
NOWGET: CALL	STRLT2		;MAKE A STRING DESCRIPTOR FOR THE VALUE
				;AND COPY IF NECESSARY
PUBLIC	DOASIG
DOASIG: POP	AX		;POP OFF THE TYPE INFORMATION
	ADD	AL,LOW 3	;MAKE VALTYPE CORRECT
	MOV	CL,AL		;SAVE VALUE TYPE IN [C]
	MOV	AL,BYTE PTR INPPAS	;SEE IF SCANNING VALUES FOR PASS1
	OR	AL,AL		;ZERO FOR PASS1
	JNZ	SHORT $+3
	RET			;GO BACK TO PASS1
	MOV	AL,CL		;RECOVER VALTYP
	XCHG	BX,DX		;[D,E]=TEXT POINTER
	MOV	BX,OFFSET STRDN2	;RETURN LOC
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;[H,L]=PLACE TO STORE VARIABLE VALUE
	PUSH	DX		;TEXT POINTER GOES ON
	JMP	INPCOM		;DO ASSIGNMENT
NUMINS: CALL	CHRGTR
	POP	AX		;GET BACK VALTYPE OF SOURCE
	PUSH	AX		;SAVE BACK
	CMP	AL,LOW 5	;REGEN CC'S
	MOV	CX,OFFSET DOASIG	;ASSIGNMENT IS COMPLICATED
				;EVEN FOR NUMERICS SO USE THE "LET" CODE
	PUSH	CX		;SAVE ON STACK
	JAE	SHORT ??L080
	JMP	FIN		;IF NOT DOUBLE, CALL USUAL # INPUTTER
??L080:
	JMP	FINDBL		;ELSE CALL SPECIAL ROUTINE WHICH EXPECTS DOUBLES
STRDN2:
	DEC	BX
	CALL	CHRGTR
	JZ	SHORT TRMOK
	CMP	AL,LOW 44
	JZ	SHORT ??L081
	JMP	TRMNOK		;ENDED PROPERLY?
??L081:
TRMOK:
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI
	DEC	BX		;LOOK AT TERMINATOR
	CALL	CHRGTR		;AND SET UP CONDITION CODES
	JZ	SHORT ??L082
	JMP	LOPDT2		;NOT ENDING, CHECK FOR COMMA
??L082:
				;AND GET ANOTHER VARIABLE
				;TO FILL WITH DATA

	POP	DX		;POP OFF THE POINTER INTO DATA
	MOV	AL,BYTE PTR FLGINP	;FETCH THE STATEMENT TYPE FLAG
	OR	AL,AL		;IF ZERO, INPUT STATEMENT
	XCHG	BX,DX
	JZ	SHORT ??L083
	JMP	RESFIN		;UPDATE DATPTR
??L083:
	PUSH	DX		;SAVE THE TEXT POINTER
FINPRG: POP	BX		;GET BACK THE TEXT POINTER
	JMP	FINPRT
;
; THE SEARCH FOR DATA STATMENTS IS MADE BY USING THE EXECUTION CODE
; FOR DATA TO SKIP OVER STATEMENTS. THE START WORD OF EACH STATEMENT
; IS COMPARED WITH $DATA. EACH NEW LINE NUMBER
; IS STORED IN DATLIN SO THAT IF AN ERROR OCCURS WHILE READING
; DATA THE ERROR MESSAGE WILL GIVE THE LINE NUMBER OF THE 
; ILL-FORMATTED DATA
;
DATLOP: CALL	DATA
DATFND: OR	AL,AL
	JNZ	SHORT NOWLIN
	INC	BX
	MOV	AL,BYTE PTR [BX]
	INC	BX
	OR	AL,BYTE PTR [BX]	;IFE XERPAG
	MOV	DL,LOW OFFSET ERROD	;NO DATA IS ERROR ERROD
	JNZ	SHORT ??L084
	JMP	ERROR		;IF SO COMPLAIN
??L084:
	INC	BX		;SKIP PAST LINE #
	MOV	DX,[BX]	;GET DATA LINE #
	INC	BX
	MOV	DATLIN,DX	;SAVE DATA LINE NUMBER
NOWLIN: CALL	CHRGTR		;GET THE STATEMENT TYPE
	CMP	AL,LOW OFFSET $DATA	;IS IS "DATA"?
	JNZ	SHORT DATLOP	;NOT DATA SO LOOK SOME MORE
	JMP	DATBK		;CONTINUE READING

	PAGE

	SUBTTL PEEK AND POKE
;
; NOTE: IN THE 8K PEEK ONLY ACCEPTS POSITIVE NUMBERS UP TO 32767
; POKE WILL ONLY TAKE AN ADDRESS UP TO 32767 , NO
; FUDGING ALLOWED. THE VALUE IS UNSIGNED.
; IN THE EXTENDED VERSION NEGATIVE NUMBERS CAN BE
; USED TO REFER TO LOCATIONS HIGHER THAN 32767.
; THE CORRESPONDENCE IS GIVEN BY SUBTRACTING 65536 FROM LOCATIONS
; HIGHER THAN 32767 OR BY SPECIFYING A POSITIVE NUMBER UP TO 65535.
;
PEEK:	CALL	FRQINT		;GET AN INTEGER IN [H,L]
	EXTRN	PRODIR:NEAR
	CALL	PRODIR		;DONT ALLOW DIRECT IF PROTECTED FILE
	EXTRN	PEKFLT:NEAR	;PEEK filter
	INS86	6		;PUSH   ES
	INS86	216,6,SAVSEG	;MOV    ES,SAVSEG
	CALL	PEKFLT		;Filter the PEEK
	JNZ	SHORT ??L085
	JMP	PEKVAL		;Filter returned the appropriate value
??L085:
	INS86	46		;$ES
	MOV	AL,BYTE PTR [BX]	;Fetch the PEEK value
PEKVAL: INS86	7		;POP    ES
	JMP	SNGFLT		;AND FLOAT IT
POKE:	CALL	FRMQNT		;READ INTEGER FORMULA INTO [D,E]
	PUSH	DX		;SAVE VALUE FOR LATER
	CALL	PRODIR		;DONT ALLOW DIRECT IF PROTECTED FILE
	CALL	SYNCHR
	DB	OFFSET 44	;CHECK FOR A COMMA
	CALL	GETBYT
	POP	DX		;GET THE ADDRESS BACK
	INS86	6		;PUSH ES
	INS86	216,6,SAVSEG	;MOV  ES,SAVSEG
	EXTRN	POKFLT:NEAR
	CALL	POKFLT		;Filter POKEs for "special" addresses
	JNZ	SHORT ??L086
	JMP	POKEX		;Do not perform the POKE
??L086:
	MOV	DI,DX
	STOSB			;STORE IT AWAY
POKEX:
	INS86	7		;POP  ES
	RET			;SCANNED EVERYTHING
PUBLIC	FRMQNT
FRMQNT: CALL	FRMEVL		;READ FORMULA
	PUSH	BX		;SAVE TEXT POINTER
	CALL	FRQINT		;GET VALUE IN RANGE -32769-65535
	XCHG	BX,DX		;VALUE TO [D,E]
	POP	BX		;RESTORE TEXT POINTER
	RET

PUBLIC	FRQINT
FRQINT: MOV	CX,OFFSET FRCINT	;RETURN HERE
	PUSH	CX		;SAVE ADDR
	CALL	GETYPR		;SET THE CC'S ON VALTYPE
	JNS	SHORT $+3
	RET			;RETURN IF ALREADY INTEGER.
	MOV	AL,BYTE PTR FAC ;GET EXPONENT
	CMP	AL,LOW 220O	;IS MAGNITUDE .GT. 32767
	JZ	SHORT $+3
	RET			;NO, FORCE INTEGER
	CALL	SIGN		;GET SIGN OF NUMBER
				;IS IT NEGATIVE, ONLY ALLOWABLE # IS -32768
	JNS	SHORT $+3
	RET			;ASSUME THATS WHAT IT IS, ELSE GIVE OVERFLOW
	CALL	FRCSNG		;MAKE NUMBER A SINGLE
	MOVRI	221O,200O,0,0	;GET -65536.
	JMP	_FADD		;SUBTRACT IT, AND THEN FORCE INTEGER

;PAGE
	SUBTTL RENUMBER
; THE RESEQ(UENCE) COMMAND TAKE UP TO THREE ARGUMENTS
; RESEQ [NN[,MM[,INC]]]
; WHERE NN IS THE FIRST DESTINATION LINE OF THE
; LINES BEING RESEQUENCED, LINES LESS THAN MM ARE
; NOT RESEQUENCED, AND INC IS THE INCREMENT.
RESEQ:
	MOV	CX,10		;ASSUME INC=10
	PUSH	CX		;SAVE ON STACK
	MOV	DH,CH		;RESEQ ALL LINES BY SETTING [D,E]=0
	MOV	DL,CH
	JZ	SHORT RESNN	;IF JUST 'RESEQ' RESEQ 10 BY 10
	CMP	AL,LOW 54O	;COMMA
	JZ	SHORT EATCOM	;DONT USE STARTING # OF ZERO
	PUSH	DX		;SAVE [D,E]
	CALL	LINSPC		;GET NEW NN
	MOV	CH,DH		;GET IN IN [B,C] WHERE IT BELONGS
	MOV	CL,DL
	POP	DX		;GET BACK [D,E]
	JZ	SHORT RESNN	;IF EOS, DONE
EATCOM: CALL	SYNCHR
	DB	OFFSET 54O	;EXPECT COMMA
	CALL	LINSPC		;GET NEW MM
	JZ	SHORT RESNN	;IF EOS, DONE
	POP	AX		;GET RID OF OLD INC
	CALL	SYNCHR
	DB	OFFSET 54O	;EXPECT COMMA
	PUSH	DX		;SAVE MM
	CALL	LINGET		;GET NEW INC
	JZ	SHORT ??L087
	JMP	SNERR		;SHOULD HAVE TERMINATED.
??L087:
	OR	DX,DX		;SEE IF INC=0 (ILLEGAL)
	JNZ	SHORT ??L088
	JMP	FCERR		;YES, BLOW HIM UP NOW
??L088:
	XCHG	BX,DX		;FLIP NEW INC & [H,L]
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;NEW INC ONTO STACK
	XCHG	BX,DX		;GET [H,L] BACK, ORIG [D,E] BACK
RESNN:	PUSH	CX		;SAVE NN ON STACK
	CALL	FNDLIN		;FIND MM LINE
	POP	DX		;GET NN OFF STACK
	PUSH	DX		;SAVE NN BACK
	PUSH	CX		;SAVE POINTER TO MM LINE
	CALL	FNDLIN		;FIND FIRST LINE TO RESEQ.
	MOV	BX,CX		;GET PTR TO THIS LINE IN [H,L]
	POP	DX		;GET LINE PTD TO BY MM
	CMP	BX,DX		;COMPARE TO FIRST LINE RESEQED
	XCHG	BX,DX		;GET PTR TO MM LINE IN [H,L]
	JAE	SHORT ??L089
	JMP	FCERR		;CANT ALLOW PROGRAM TO BE RESEQUED
??L089:
				;ON TOP OF ITSELF
	POP	DX		;GET NN BACK
	POP	CX		;GET INC IN [B,C]
	POP	AX		;GET RID OF NEWSTT
	PUSH	BX		;SAVE PTR TO FIRST LINE TO RESEQ.
	PUSH	DX		;SAVE NN ON STACK
	JMP	SHORT NXTRSL
NXTRSC: ADD	BX,CX		;ADD INCREMENT INTO
	JAE	SHORT ??L090
	JMP	FCERR		;UH OH, HIS INC WAS TOO LARGE.
??L090:
	XCHG	BX,DX		;FLIP LINK FIELD, ACCUM.
	PUSH	BX		;SAVE LINK FIELD
	MOV	BX,65529	;TEST FOR TOO LARGE LINE
	CMP	BX,DX		;COMPARE TO CURRENT #
	POP	BX		;RESTORE LINK FIELD
	JAE	SHORT ??L091
	JMP	FCERR		;UH OH, HIS INC WAS TOO LARGE.
??L091:
NXTRSL: PUSH	DX		;SAVE CURRENT LINE ACCUM
	MOV	DX,[BX]	;GET LINK FIELD INTO [D,E]
	OR	DX,DX		;SET CC'S ON LINK FIELD
	XCHG	BX,DX		;SEE IF NEXT LINK ZERO
	POP	DX		;GET BACK ACCUM LINE #
	JZ	SHORT RESSD1	;ZERO, DONE
	MOV	AL,BYTE PTR [BX]	;GET FIRST BYTE OF LINK
	INC	BX		;INC POINTER
	OR	AL,BYTE PTR [BX]	;SET CC'S
	LAHF
	DEC	BX		;MOVE POINTER BACK
	SAHF
	XCHG	BX,DX		;BACK IN [D,E]
	JNZ	SHORT NXTRSC	;INC COUNT

RESSD1: PUSH	CX		;SAVE INC
	CALL	SCCLIN		;SCAN PROGRAM CONVERTING LINES TO PTRS.
	POP	CX		;GET BACK INC
	POP	DX		;GET NN
	POP	BX		;GET PTR TO FIRST LINE TO RESEQ

RESNX1: PUSH	DX		;SAVE CURRENT LINE
	MOV	DX,[BX]	;PREPARE FOR ZERO LINK FIELD TEST
	INC	BX
	OR	DX,DX		;END?
	JZ	SHORT SCCALL	;STOP RESEQING WHEN SEE END OF PGM
	XCHG	BX,DX		;FLIP LINE PTR, LINK FIELD
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;PUT LINK ON STACK, GET NEW LINE # OFF
	XCHG	BX,DX		;PUT NEW LINE # IN [D,E], THIS LINE
				;PTR IN [H,L]
	INC	BX		;POINT TO LINE # FIELD.
	MOV	[BX],DX	;CHANGE TO NEW LINE #
	XCHG	BX,DX		;GET THIS LINE # IN [H,L]
	ADD	BX,CX		;ADD INC
	XCHG	BX,DX		;GET NEW LINE # BACK IN [D,E]
	POP	BX		;GET PTR TO NEXT LINE
	JMP	SHORT RESNX1	;KEEP RESEQING
SCCALL: MOV	CX,OFFSET STPRDY	;WHERE TO GO WHEN DONE
	PUSH	CX		;SAVE ON STACK
	DB	74O	; SKIP  ;"CPI AL," CALL SCCPTR
; THE SUBROUTINES SCCLIN AND SCCPTR CONVERT ALL
; LINE #'S TO POINTERS AND VICE-VERSA.
; THE ONLY SPECIAL CASE IS "ON ERROR GOTO 0" WHERE THE "0"
; IS LEFT AS A LINE NUMBER TOKEN SO IT WONT BE CHANGED BY RESEQUENCE.
SCCLIN  DW	15O	; SKIP  ;"ORI AX," OVER NEXT BYTE
PUBLIC	SCCPTR
SCCPTR: XOR	AL,AL		;SET A=0
	MOV	BYTE PTR PTRFLG,AL	;SET TO SAY WHETER LINES OR PTRS EXTANT
SCNPGM: MOV	BX,TXTTAB	;GET PTR TO START OF PGM
	DEC	BX		;NOP NEXT INX.
SCNPLN: INC	BX		;POINT TO BYTE AFTER ZERO AT END OF LINE
	MOV	AL,BYTE PTR [BX]	;GET LINK FIELD INTO [D,E]
	INC	BX		;BUMP PTR
	OR	AL,BYTE PTR [BX]	;SET CC'S
	JNZ	SHORT $+3
	RET			;RETURN IF ALL DONE.
	INC	BX		;POINT PAST LINE #
	MOV	DX,[BX]	;GET LOW BYTE OF LINE #
	INC	BX
PUBLIC	SCNEXT
SCNEXT: CALL	CHRGTR		;GET NEXT CHAR FROM LINE
SCNEX2: OR	AL,AL		;END OF LINE
	JZ	SHORT SCNPLN	;SCAN NEXT LINE
	MOV	CL,AL		;SAVE [A]
	MOV	AL,BYTE PTR PTRFLG	;CHANGE LINE TOKENS WHICH WAY?
	OR	AL,AL		;SET CC'S
	MOV	AL,CL		;GET BACK CURRENT CHAR
	JZ	SHORT SCNPT2	;CHANGING POINTERS TO #'S
	CMP	AL,LOW OFFSET $ERROR	;IS IT ERROR TOKEN?
	JNZ	SHORT NTERRG	;NO.
	CALL	CHRGTR		;SCAN NEXT CHAR
	CMP	AL,LOW OFFSET $GOTO	;ERROR GOTO?
	JNZ	SHORT SCNEX2	;GET NEXT ONE
	CALL	CHRGTR		;GET NEXT CHAR
	CMP	AL,LOW OFFSET LINCON	;LINE # CONSTANT?
	JNZ	SHORT SCNEX2	;NO, IGNORE.
	PUSH	DX		;SAVE [D,E]
	CALL	LINGT3		;GET IT
	OR	DX,DX		;IS IT LINE # ZERO?
	JNZ	SHORT CHGPTR	;CHANGE IT TO A POINTER
	JMP	SHORT SCNEX3	;YES, DONT CHANGE IT
NTERRG: CMP	AL,LOW OFFSET LINCON	;LINE # CONSTANT?
	JNZ	SHORT SCNEXT	;NOT, KEEP SCANNING
	PUSH	DX		;SAVE CURRENT LINE # FOR POSSIBLE ERROR MSG
	CALL	LINGT3		;GET LINE # OF LINE CONSTANT INTO [D,E]
CHGPTR:
	PUSH	BX		;SAVE TEXT POINTER JUST AT END OF LINCON 3 BYTES
	CALL	FNDLIN		;TRY TO FIND LINE IN PGM.
	LAHF
	DEC	CX		;POINT TO ZERO AT END OF PREVIOUS LINE
	SAHF
	MOV	AL,LOW OFFSET PTRCON	;CHANGE LINE # TO PTR
	JB	SHORT MAKPTR	;IF LINE FOUND CHANGE # TO PTR
	CALL	CRDONZ		;PRINT CRLF IF REQUIRED
	MOV	BX,OFFSET LINM	;PRINT "UNDEFINED LINE" MESSAGE
	PUSH	DX		;SAVE LINE #
	CALL	STROUT		;PRINT IT
	POP	BX		;GET LINE # IN [H,L]
	CALL	LINPRT		;PRINT IT
	POP	CX		;GET TEXT PTR OFF STACK
	POP	BX		;GET CURRENT LINE #
	PUSH	BX		;SAVE BACK
	PUSH	CX		;SAVE BACK TEXT PTR
	CALL	INPRT		;PRINT IT
SCNPOP: POP	BX		;POP OFF CURRENT TEXT POINTER
SCNEX3: POP	DX		;GET BACK CURRENT LINE #
	DEC	BX		;BACKUP POINTER
JSCNXT: JMP	SHORT SCNEXT	;KEEP SCANNING

LINM 	DB"Undefined line "
	DB	0

SCNPT2: CMP	AL,LOW OFFSET PTRCON	;POINTER
	JNZ	SHORT JSCNXT	;NO, KEEP SCANNING
	PUSH	DX		;SAVE CURRENT LINE #
	CALL	LINGT3		;GET #
	PUSH	BX		;SAVE TEXT POINTER
	XCHG	BX,DX		;FLIP CURRENT TEXT PTR & PTR
	INC	BX		;BUMP POINTER
	INC	BX		;POINT TO LINE # FIELD
	INC	BX
	MOV	CL,BYTE PTR [BX]	;PICK UP LINE #
	INC	BX		;POINT TO HIGH PART
	MOV	CH,BYTE PTR [BX]
	MOV	AL,LOW OFFSET LINCON	;CHANGE TO LINE CONSTANT
MAKPTR: MOV	BX,OFFSET SCNPOP	;PLACE TO RETURN TO AFTER CHANGING CONSTANT
	PUSH	BX		;SAVE ON STACK
CONCHG: MOV	BX,CONTXT	;GET TXT PTR AFTER CONSTANT IN [H,L]
CONCH2: PUSH	BX		;SAVE PTR TO END OF CONSTANT
	DEC	BX
	MOV	BYTE PTR [BX],CH
	DEC	BX
	MOV	BYTE PTR [BX],CL	;CHANGE TO VALUE IN [B,C]
	DEC	BX		;POINT TO CONSTANT TOKEN
	MOV	BYTE PTR [BX],AL	;CHANGE TO VALUE IN [A]
	POP	BX		;RESTORE POINTER TO AFTER CONSTANT
	RET

PUBLIC	DEPTR
DEPTR:	MOV	AL,BYTE PTR PTRFLG	;DO LINE POINTERS EXIST IN PGM?
	OR	AL,AL		;SET CC'S
	JNZ	SHORT $+3
	RET			;NO, JUST RETURN
	JMP	SCCPTR		;CONVERT THEN TO LINE #'S




	SUBTTL ANSI - THE ROUTINES TO HANDLE ANSI FEATURES
	DATAS=DATA
_OPTION: CALL	SYNCHR
	DB	OFFSET "B"
	CALL	SYNCHR
	DB	OFFSET "A"
	CALL	SYNCHR
	DB	OFFSET "S"
	CALL	SYNCHR
	DB	OFFSET "E"
	MOV	AL,BYTE PTR [BX]	;GET THE BASE NUMBER
	SUB	AL,LOW "0"
	JAE	SHORT ??L092
	JMP	SNERR
??L092:
	CMP	AL,LOW 2	;ONLY 0 AND 1 ARE LEGAL
	JNAE	SHORT ??L093
	JMP	SNERR
??L093:
	MOV	CH,AL
	MOV	AL,BYTE PTR OPTVAL
	CMP	AL,CH
	JZ	SHORT OLDOPT	;BRIF OLD OPTION BASE VALUE
	MOV	AL,BYTE PTR OPTFLG
	OR	AL,AL		;HAVE WE SEEN OPTION BASE BEFORE
	JZ	SHORT ??L094
	JMP	DDERR		;IF SO "DOUBLE DIMENSION ERROR"
??L094:
	PUSH	BX		;SAVE THE TEXT POINTER
	MOV	BX,ARYTAB	;SEE IF WE HAVE ANY ARRAYS YET
	XCHG	BX,DX
	MOV	BX,STREND
	CMP	BX,DX		;IF THESE ARE EQUAL WE HAVE NOT
	JZ	SHORT ??L095
	JMP	DDERR
??L095:
	POP	BX
	MOV	AL,CH
	MOV	BYTE PTR OPTVAL,AL	;SAVE IF FOR DIM AND PTRGET
	INC	AL		;MAKE SURE [A] IS NON ZERO
	MOV	BYTE PTR OPTFLG,AL	;FLAG THAT WE HAVE SEEN "OPTION BASE"
OLDOPT: CALL	CHRGTR		;FETCH THE TERMINATOR
	RET

; THIS ROUTINE IS CALLED BY THE MATH PACKAGE
; TO PRINT ERROR MESSAGES WITHOUT DISTURBING PTRFIL, ETC.
PUBLIC	$STPRN
$STPRN:
STRPRN:
	INS86	56		;FETCH FROM CODE SEGMENT
STRPN1: MOV	AL,BYTE PTR [BX]	;GET BYTE FROM MESSAGE
	OR	AL,AL		;END OF MESSAGE
	JNZ	SHORT $+3
	RET			;YES, DONE
	CALL	CALTTY		;PRINT CHAR
	INC	BX		;INCREMENT POINTER
	JMP	STRPRN		;PRINT NEXT CHAR
	EXTRN	CALTTY:NEAR,$CATTY:NEAR
RANDOM: JZ	SHORT INPRG	;IF NO ARGUMENT ASK FROM TERMINAL
	CALL	FRMEVL		;FETCH THE FORMULA ARGUMENT
	PUSH	BX
	CALL	FRCINT		;ALLOW NORMAL INTEGERS
	JMP	SHORT STRNDS	;STORE THE NEW RANDOM SEED
INPRG:	PUSH	BX
INPRAG:
	MOV	BX,OFFSET RANMES	;ASK FOR SOME RANDOM INPUT
	CALL	STROUT
	CALL	QINLIN
	POP	DX		;get back text pointer
	JAE	SHORT ??L096
	JMP	STPEND		;go away if control c
??L096:
	PUSH	DX		;resave text pointer
	INC	BX		;MOVE PAST BUFMIN TO BUF
	MOV	AL,BYTE PTR [BX]	;GET FIRST CHAR OF TYPEIN (FIN EXPECTS IT)
	CALL	FIN		;READ A NUMBER
	MOV	AL,BYTE PTR [BX]	;GET THE TERMINATOR
	OR	AL,AL
	JNZ	SHORT INPRAG	;DON'T ALLOW BAD FORMAT
	CALL	FRCINT		;ALLOW NORMAL INTEGERS
STRNDS:
	MOV	RNDX+1,BX
	EXTRN	RNDMN2:NEAR
	CALL	RNDMN2
	POP	BX		;GET BACK THE TEXT POINTER
	RET
RANMES  DB"Random number seed (-32768 to 32767)"
	DB	0

;
; THIS CODE SCANS AHEAD TO FIND THE "NEXT" THAT MATCHES A "FOR"
; IN ORDER TO 1) HANDLE EMPTY LOOPS AND 2) MAKE SURE LOOPS
; MATCH UP PROPERLY.
;
PUBLIC	WNDSCN
WNDSCN: MOV	CL,LOW OFFSET ERRWH	;SCAN FOR MATCHING WEND THIS IS ERROR IF FAIL
	JMP	SHORT SCNCNT
NXTSCN: MOV	CL,LOW OFFSET ERRFN
SCNCNT:
	MOV	CH,LOW 0	;SET UP THE COUNT OF "FOR"S SEEN
	XCHG	BX,DX		;INITIALIZE NXTLIN FOR NEXT ON SAME LINE
	MOV	BX,CURLIN
	MOV	NXTLIN,BX
	XCHG	BX,DX		;RESTORE THE TEXT POINTER TO [H,L]
FORINC: INC	CH		;INCREMENT THE COUNT WHENEVER "FOR" IS SEEN
FNLOP:	DEC	BX		;** FIX HERE FOR 5.03 CAN'T CALL DATA
SCANWF: CALL	CHRGTR		;TO SKIP TO STATEMENT BECAUSE COULD
	JZ	SHORT FORTRM	;HAVE STATEMENT AFTER "THEN"
	CMP	AL,LOW 34D	;CHECK FOR QUOTE WHICH MAY HAVE
	JNZ	SHORT NTQTSC	;EIGHT BIT LITERAL DATA SAME AS $THEN
				;OR $WHILE OR $WEND OR $FOR OR $NEXT
QTLOPF: CALL	CHRGTR		;IN IT. SCAN THROUGH STRING.
	OR	AL,AL
	JZ	SHORT FORTRM	;TERMINATE ONLY ON ZERO NOT COLON
	CMP	AL,LOW 34D
	JNZ	SHORT QTLOPF
NTQTSC:
	CMP	AL,LOW OFFSET $ELSE	;ELSE STATMENT
	JZ	SHORT FNNWST	;THEN ALLOW NEXT OR WEND AFTER IT
	CMP	AL,LOW OFFSET $THEN	;SO SCAN USING CHRGET WAITING FOR END
	JNZ	SHORT SCANWF	;OF STATEMENT OR $THEN
FORTRM: OR	AL,AL		;SEE HOW IT ENDED
	JNZ	SHORT FNNWST	;JUST NEW STATEMENT -- EXAMINE IT
				;OR COULD BE COLON IN STRING BUT NO HARM
				;IN NON KANABS (HGHBIT) VERSION SINCE NO RESERVED
				;WORDS WILL MATCH THE NEXT CHARACTER
	INC	BX
	MOV	AL,BYTE PTR [BX]	;SCAN THE LINK AT THE START OF THE NEXT LINE
	INC	BX
	OR	AL,BYTE PTR [BX]	;TO SEE IF ITS ZERO (END OF PROGRAM)
	MOV	DL,CL		;SET UP ERROR NUMBER
	JNZ	SHORT ??L097
	JMP	ERROR
??L097:
	INC	BX		;PICK UP THE NEW LINE NUMBER
	MOV	DX,[BX]
	INC	BX
	MOV	NXTLIN,DX	;SAVE AS "NEXT" LINE NUMBER
FNNWST: CALL	CHRGTR		;GET THE TYPE OF THE NEXT STATEMENT
	CMP	AL,LOW OFFSET $REM	;REM STATEMENTS SINCE THEY HAVE COLONS
	JNZ	SHORT NTREMR	;IN THE MIDDLE WHICH MAY BE VIEWED AS
	PUSH	CX
	CALL	REM		;STATEMENT TERMINATORS AND THE NEXT CHAR
	POP	CX
	JMP	SHORT FORTRM	;MIGHT BE AN EIGTH BIT LITERAL THAT
NTREMR: CMP	AL,LOW OFFSET $DATA	;ACCIDENTALLY MATCHES THE SEARCH
	JNZ	SHORT NTDATR	;SO WE CALL REM AND DATA TO DO THE SKIPPING
	PUSH	CX
	CALL	DATA
	POP	CX
	JMP	SHORT FORTRM
NTDATR:
	MOV	AL,CL		;GET THE ERROR NUMBER TO SEE WHAT WE ARE
	CMP	AL,LOW OFFSET ERRFN	;SCANNING FOR
	MOV	AL,BYTE PTR [BX]	;GET BACK THE CHARACTER
	JZ	SHORT NXTLOK	;FOR/NEXT SEARCHING
	CMP	AL,LOW OFFSET $WHILE	;ANOTHER WHILE/WEND NEST?
	JZ	SHORT FORINC
	CMP	AL,LOW OFFSET $WEND
	JNZ	SHORT FNLOP
	DEC	CH
	JNZ	SHORT FNLOP
	RET
NXTLOK:
	CMP	AL,LOW OFFSET $FOR	;ANOTHER "FOR"?
	JZ	SHORT FORINC	;INCREMENT THE FOR COUNT
	CMP	AL,LOW OFFSET $NEXT	;END WITH NEXT?
	JNZ	SHORT FNLOP	;SKIP OVER THIS STATEMENT
DECNXT: DEC	CH		;DECREMENT THE LOOP COUNT
	JNZ	SHORT $+3
	RET			;RETURN WITH [H,L] ABOUT TO GET FIRST CHARACTER OF "NEXT" VARIABLE

;
; SCAN  THE VARIABLES LISTED IN A "NEXT" STATEMENT
;
	CALL	CHRGTR		;SEE IF THERE IS A NAME
	JZ	SHORT FORTRM	;ONLY ONE SO SCAN MORE STATEMENTS
	XCHG	BX,DX		;SAVE TEXT POINTER IN [D,E]
	MOV	BX,CURLIN	;SAVE THE CURRENT LINE NUMBER
	PUSH	BX
	MOV	BX,NXTLIN	;MAKE ERROR COME FROM "NEXT"
	MOV	CURLIN,BX
	XCHG	BX,DX		;[H,L]= TEXT POINTER
	PUSH	CX		;SAVE THE "FOR" COUNT
	CALL	PTRGET		;SKIP OVER THE VARIABLE NAME
	POP	CX		;GET BACK THE "FOR" COUNT
	DEC	BX		;CHECK TERMINATOR
	CALL	CHRGTR
	MOV	DX,OFFSET FORTRM	;PLACE TO GO TO
	JZ	SHORT TRMNXT	;END OF "NEXT"
	CALL	SYNCHR
	DB	OFFSET 44	;SHOULD HAVE COMMAS IN BETWEEN
	DEC	BX		;RESCAN FIRST CHARACTER
	MOV	DX,OFFSET DECNXT	;PLACE TO GO BACK TO
TRMNXT: POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE THE TEXT POINTER ON THE STACK
	MOV	CURLIN,BX
	POP	BX
	PUSH	DX		;GO OFF TO ADDRESS IN [B,C]
	RET
;
; THIS ROUTINE CLEARS FLGOVC TO RESET TO NORMAL OVERFLOW MODE.
; IN NORMAL MODE, OVERR ALWAYS PRINTS OVERFLOW BECAUSE FLGOVC=0
; FUNCTION DISPATCH, FIN (&FINDBL), AND EXPONENTIATION SET UP AN OVERFLOW
; MODE WHERE FLGOVC=1 AND AFTER ONE OVERFLOW FLGOVC=2 AND NO MORE
; OVERFLOW MESSAGES ARE PRINTED. FIN (&FINDBL) ALSO STORE FLGOVC IN OVCSTR
; BEFORE RESETTING FLGOVC SO A CALLER CAN DETECT OVERFLOW OCCURANCE.
;
PUBLIC	$FLGOC
$FLGOC:
PUBLIC	FINOVC
FINOVC: LAHF
	PUSH	AX
	MOV	AL,BYTE PTR FLGOVC	;STORE OVERFLOW FLAG TO INDICATE
	MOV	BYTE PTR OVCSTR,AL	;WHETHER AN OVERFLOW OCCURED
	POP	AX
	SAHF
PUBLIC	$CLROV
$CLROV:
PUBLIC	CLROVC
CLROVC: LAHF
	PUSH	AX		;SAVE EVERYTHING
	XOR	AL,AL		;NORMAL OVERFLOW MODE
	MOV	BYTE PTR FLGOVC,AL
	POP	AX
	SAHF
	RET


;
; The reserve word tables have dispatch address the could be external.
; ASM86 can only output external declarations during pass 1, so we
; have to construct a chain of possible externals and check each one.
; The following macro runs through the chain and declares any undefined
; addresses as external :NEAR.  For more information, see the file
; PS1:<BASIC.ASM86>BINTRP.H
;
	DO_EXT
;
CSEG	ENDS
	END