GWEVAL.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   GWEVAL Copied from BINTRP.MAC

	.RADIX	10

	.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,FININL:NEAR
	EXTRN	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,DIM:NEAR

	EXTRN	DCOMPR:NEAR,SYNCHR:NEAR

	EXTRN	SIGN:NEAR

	EXTRN	PRGFIN:NEAR,FILIND:NEAR

	EXTRN	FILINP:NEAR,CLSALL:NEAR,INDSKC:NEAR


	EXTRN	LRUN:NEAR

	EXTRN	FILGET:NEAR


	EXTRN	INXHRT:NEAR
	EXTRN	SGN:NEAR,ABSFN:NEAR,SQR:NEAR,_FDIV:NEAR,_FSUB:NEAR
	EXTRN	FMULT:NEAR,RND:NEAR	;MATHPK INTERNALS
	EXTRN	ZERO:NEAR,MOVE:NEAR,FOUT:NEAR,FIN:NEAR,_FCOMP:NEAR
	EXTRN	_FADD:NEAR,_PUSHF:NEAR,_INT:NEAR
	EXTRN	MOVFR:NEAR,MOVRF:NEAR,MOVRM:NEAR,INPRT:NEAR,LINPRT:NEAR
	EXTRN	FDIVT:NEAR
	EXTRN	MOVFM:NEAR,MOVMF:NEAR,FADDS:NEAR
	EXTRN	INRART:NEAR,_NEG:NEAR
	EXTRN	BSERR:NEAR
	EXTRN	CAT:NEAR,FREFAC:NEAR,FRESTR:NEAR,FRETMP:NEAR,FRETMS:NEAR
	EXTRN	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	GARBA2:NEAR	;We have our own G. C.


	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	CONSIH:NEAR,VMOVFA:NEAR,VMOVAF:NEAR,ISIGN:NEAR,CONIA:NEAR
	EXTRN	VSIGN:NEAR,VDFACS:NEAR
	EXTRN	VMOVMF:NEAR,VMOVFM:NEAR,FRCINT:NEAR,FRCSNG:NEAR,FRCDBL:NEAR
	EXTRN	VNEG:NEAR,PUFOUT:NEAR,DCXBRT:NEAR,IADD:NEAR
	EXTRN	ISUB:NEAR,IMULT:NEAR,ICOMP:NEAR,INEG:NEAR,DADD:NEAR
	EXTRN	DSUB:NEAR,DMULT:NEAR,DDIV:NEAR,DCOMP:NEAR,VINT:NEAR
	EXTRN	FINDBL:NEAR,INEG2:NEAR
	EXTRN	_IDIV:NEAR,IMOD: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
;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,PARM2:WORD,PRMLEN:WORD
	EXTRN	PRMSTK:WORD,PARM1:WORD
	EXTRN	FUNACT:WORD,NOFUNS:WORD,OPTVAL:WORD,OPTFLG:WORD,RNDX:WORD
DSEG	ENDS

	EXTRN	OPTAB:NEAR,OPCNT:NEAR,INTDSP:NEAR,SNGDSP:NEAR,DBLDSP:NEAR
	EXTRN	FRCTBL:NEAR,PRMSIZ: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,ERRUE:NEAR
	EXTRN	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,ERRID:NEAR
	EXTRN	ERRFN:NEAR
	EXTRN	ERRUE1:NEAR	;ERRUE+DSKERR-NONDSK
	EXTRN	DSKER1:NEAR	;DSKERR-NONDSK

;The following externs are defined in GWMAIN.MAC
;
	EXTRN	TMERR:NEAR,SNERR:NEAR,CHRGTR:NEAR,MOERR:NEAR,OVERR:NEAR
	EXTRN	FCERR:NEAR,ERROR:NEAR
	EXTRN	CONFAC:NEAR,FRMQNT:NEAR,DATA:NEAR,LETCN4:NEAR,$STPRN:NEAR
	EXTRN	ONECON:NEAR,DBLCON:NEAR
	EXTRN	FRQINT:NEAR,LINGET:NEAR,UFERR:NEAR




;
; 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	CLINTK:NEAR
	EXTRN	EQULTK:NEAR,ERCTK:NEAR,ERLTK:NEAR
	EXTRN	FNTK:NEAR,FUNDSP:NEAR
	EXTRN	GREATK:NEAR
	EXTRN	INSRTK:NEAR
	EXTRN	LESSTK:NEAR,LSTOPK:NEAR
	EXTRN	MIDTK:NEAR,MINUTK:NEAR
	EXTRN	NMREL:NEAR,NOTTK:NEAR
	EXTRN	ONEFUN:NEAR
	EXTRN	PLUSTK:NEAR
	EXTRN	USRTK:NEAR
	EXTRN	$INKEY$:NEAR,$INPUT:NEAR
	EXTRN	$POINT:NEAR
	EXTRN	$SCREEN:NEAR,$STRING$:NEAR
	EXTRN	$VARPTR:NEAR
;
; Since the dispatch table is also no longer in BINTRP many
; addresses need to be declared internal.
;
	PUBLIC	DEF
	PUBLIC	FNINP,FNOUT,FNWAIT
	PUBLIC	LABBCK

	SUBTTL FORMULA EVALUATION CODE

;
; THE FORMULA EVALUATOR STARTS WITH
; [H,L] POINTING TO THE FIRST CHARACTER OF THE FORMULA.
; AT THE END [H,L] POINTS TO THE TERMINATOR.
; THE RESULT IS LEFT IN THE FAC.
; ON RETURN [A] DOES NOT REFLECT THE TERMINATING CHARACTER
;
; THE FORMULA EVALUATOR USES THE OPERATOR TABLE (OPTAB)
; TO DETERMINE PRECEDENCE AND DISPATCH ADDRESSES FOR
; EACH OPERATOR.
; A TEMPORARY RESULT ON THE STACK HAS THE FOLLOWING FORMAT
;
; THE ADDRESS OF 'RETAOP' -- THE PLACE TO RETURN ON COMPLETION
; OF OPERATOR APPLICATION
;
; THE FLOATING POINT TEMPORARY RESULT
;
; THE ADDRESS OF THE OPERATOR ROUNTINE
;
; THE PRECEDENCE OF THE OPERATOR
;
; TOTAL 10 BYTES
;
PUBLIC	FRMEQL
FRMEQL:	CALL	SYNCHR
	DW	OFFSET EQULTK	;CHECK FOR EQUAL SIGN
	JMP	FRMEVL
PUBLIC	FRMPRN
FRMPRN:	CALL	SYNCHR
	DB	OFFSET "("	;GET PAREN BEFORE FORMULA
PUBLIC	FRMEVL
FRMEVL:	DEC	BX		;BACK UP CHARACTER POINTER
PUBLIC	FRMCHK
FRMCHK:	MOV	DH,LOW 0	;INITIAL DUMMY PRECEDENCE IS 0
LPOPER:	PUSH	DX		;SAVE PRECEDENCE
	MOV	CL,LOW 1	;EXTRA SPACE NEEDED FOR RETURN ADDRESS
	CALL	GETSTK		;MAKE SURE THERE IS ROOM FOR RECURSIVE CALLS
	CALL	EVAL		;EVALUATE SOMETHING
				;RESET OVERFLOW PRINTING BACK TO NORMAL
	XOR	AL,AL		;(SET TO 1 AT FUNDSP TO SUPPRESS
	MOV	BYTE PTR FLGOVC,AL	;MULTIPLE OVERFLOW MESSAGES)
PUBLIC	TSTOP
TSTOP:	MOV	TEMP2,BX	;SAVE TEXT POINTER
RETAOP:	MOV	BX,TEMP2	;RESTORE TEXT PTR
	POP	CX		;POP OFF THE PRECEDENCE OF OLDOP
NOTSTV:	MOV	AL,BYTE PTR [BX]	;GET NEXT CHARACTER
	MOV	TEMP3,BX	;SAVE UPDATED CHARACTER POINTER
	CMP	AL,LOW OFFSET GREATK	;IS IT AN OPERATOR?
	JNB	SHORT $+3
	RET			;NO, ALL DONE (THIS CAN RESULT IN OPERATOR
				;APPLICATION OR ACTUAL RETURN)
	CMP	AL,LOW OFFSET LESSTK+1	;SOME KIND OF RELATIONAL?
	JB	SHORT DORELS	;YES, DO IT
	SUB	AL,LOW OFFSET PLUSTK	;SUBTRACT OFFSET FOR FIRST ARITHMETIC
	MOV	DL,AL		;MUST MULTIPLY BY 3 SINCE
				;OPTAB ENTRIES ARE 3 LONG
	JNZ	SHORT NTPLUS	;NOT ADDITION OP
	MOV	AL,BYTE PTR VALTYP	;SEE IF LEFT PART IS STRING
	CMP	AL,LOW 3	;SEE IF ITS A STRING
	MOV	AL,DL		;REFETCH OP-VALUE
	JNZ	SHORT ??L000
	JMP	CAT		;MUST BE CAT
??L000:
NTPLUS:
	CMP	AL,LOW OFFSET LSTOPK	;HIGHER THAN THE LAST OP?
	JNAE	SHORT $+3
	RET			;YES, MUST BE TERMINATOR
	MOV	BX,OFFSET OPTAB	;CREATE INDEX INTO OPTAB
	MOV	DH,LOW 0	;MAKE HIGH BYTE OF OFFSET=0
	ADD	BX,DX		;ADD IN CALCULATED OFFSET
	MOV	AL,CH		;[A] GETS OLD PRECEDENCE
	INS86	56		;CODE SEGMENT FETCH
	MOV	DH,BYTE PTR [BX]	;REMEMBER NEW PRECEDENCE
	CMP	AL,DH		;OLD-NEW
	JNAE	SHORT $+3
	RET			;MUST APPLY OLD OP
				;IF HAS GREATER OR = PRECEDENCE
				;NEW OPERATOR

	PUSH	CX		;SAVE THE OLD PRECEDENCE
	MOV	CX,OFFSET RETAOP	;PUT ON THE ADDRESS OF THE
	PUSH	CX		;PLACE TO RETURN TO AFTER OPERATOR APPLICATION
	MOV	AL,DH		;SEE IF THE OPERATOR IS EXPONENTIATION
	CMP	AL,LOW 127	;WHICH HAS PRECEDENCE 127
	JZ	SHORT EXPSTK	;IF SO, "FRCSNG" AND MAKE A SPECIAL STACK ENTRY
	CMP	AL,LOW 81	;SEE IF THE OPERATOR IS "AND" OR "OR"
	JB	SHORT ANDORD	;AND IF SO "FRCINT" AND
				;MAKE A SPECIAL STACK ENTRY
	AND	AL,LOW 254	;MAKE 123 AND 122 BOTH MAP TO 122
	CMP	AL,LOW 122	;MAKE A SPECIAL CHECK FOR "MOD" AND "IDIV"
	JZ	SHORT ANDORD	;IF SO, COERCE ARGUMENTS TO INTEGER
; THIS CODE PUSHES THE CURRENT VALUE IN THE FAC
; ONTO THE STACK, EXCEPT IN THE CASE OF STRINGS IN WHICH IT CALLS
; TYPE MISMATCH ERROR. [D] AND [E] ARE PRESERVED.
;
NUMREL:
	MOV	AL,BYTE PTR VALTYP	;FIND OUT WHAT TYPE OF VALUE WE ARE SAVING
	SUB	AL,LOW 3	;SETUP THE CONDITION CODES
				;SET ZERO FOR STRINGS
	JNZ	SHORT ??L001
	JMP	TMERR
??L001:
	INS86	377,66,FACLO	;PUSH FACLO
	JNS	SHORT ??L002
	JMP	VPUSHD		;ALL DONE IF THE DATA WAS AN INTEGER
??L002:
	INS86	377,66,FACLO+2	;PUSH FAC-1,0 ON THE STACK
	JP	SHORT ??L003
	JMP	VPUSHD		;ALL DONE IF WE HAD A SNG
??L003:
	INS86	377,66,DFACLO	;PUSH ON LOW BYTES OF DP FAC
	INS86	377,66,DFACLO+2	;PUSH ON NEXT TWO BYES OF DP FAC
VPUSHD:
	ADD	AL,LOW 3	;FIX [A] TO BE THE VALTYP OF THE NUMBER
				;JUST PUSHED ON THE STACK
	MOV	CL,DL		;[C]=OPERATOR NUMBER
	MOV	CH,AL		;[B]=TYPE OF VALUE ON THE STACK
	PUSH	CX		;SAVE THESE THINGS FOR APPLOP
	MOV	CX,OFFSET APPLOP	;GENERAL OPERATOR APPLICATION
				;ROUTINE -- DOES TYPE CONVERSIONS
FINTMP:	PUSH	CX		;SAVE PLACE TO GO
	MOV	BX,TEMP3	;REGET THE TEXT POINTER
	JMP	LPOPER
DORELS:	MOV	DH,LOW 0	;ASSUME NO RELATION OPS
				;ALSO SETUP THE HIGH ORDER OF THE INDEX INTO OPTAB
LOPREL:	SUB	AL,LOW OFFSET GREATK	;IS THIS ONE RELATION?
	JB	SHORT FINREL	;RELATIONS ALL THROUGH
	CMP	AL,LOW OFFSET NMREL	;IS IT REALLY RELATIONAL?
	JAE	SHORT FINREL	;NO JUST BIG
	CMP	AL,LOW 1	;SET UP BITS BY MAPPING
	RCL	AL,1		;0 TO 1 1 TO 2 AND 2 TO 4
	XOR	AL,DH		;BRING IN THE OLD BITS
	CMP	AL,DH		;MAKE SURE RESULT IS BIGGER
	MOV	DH,AL		;SAVE THE MASK
	JAE	SHORT ??L004
	JMP	SNERR		;DON'T ALLOW TWO OF THE SAME
??L004:
	MOV	TEMP3,BX	;SAVE CHARACTER POINTER
	CALL	CHRGTR		;GET THE NEXT CANDIDATE
	JMP	SHORT LOPREL
;
; FOR EXPONENTIATION WE WANT TO FORCE THE CURRENT VALUE IN THE FAC
; TO BE SINGLE PRECISION. WHEN APPLICATION TIME COMES WE FORCE
; THE RIGHT HAND OPERAND TO SINGLE PRECISION AS WELL
;
	EXTRN	FPWRQ:NEAR
EXPSTK:	CALL	FRCSNG		;COERCE LEFT HAND OPERAND
	CALL	_PUSHF		;PUT IT ON THE STACK
	MOV	CX,OFFSET FPWRQ	;PLACE TO COERCE RIGHT HAND
				;OPERAND AND DO EXPONENTIATION
	MOV	DH,LOW 127	;RESTORE THE PRECEDENCE
	JMP	SHORT FINTMP	;FINISH ENTRY AND EVALUATE MORE FORMULA
;
; FOR "AND" AND "OR" AND "\" AND "MOD" WE WANT TO FORCE THE CURRENT VALUE
; IN THE FAC TO BE AN INTEGER, AND AT APPLICATION TIME FORCE THE RIGHT
; HAND OPERAND TO BE AN INTEGER
;
ANDORD:	PUSH	DX		;SAVE THE PRECEDENCE
	CALL	FRCINT
	POP	DX		;[D]=PRECEDENCE
	PUSH	BX		;PUSH THE LEFT HAND OPERAND
	MOV	CX,OFFSET DANDOR	;"AND" AND "OR" DOER
	JMP	SHORT FINTMP	;PUSH ON THIS ADDRESS,PRECEDENCE
				;AND CONTINUE EVALUATION
;
; HERE TO BUILD AN ENTRY FOR A RELATIONAL OPERATOR
; STRINGS ARE TREATED SPECIALLY. NUMERIC COMPARES ARE DIFFERENT
; FROM MOST OPERATOR ENTRIES ONLY IN THE FACT THAT AT THE
; BOTTOM INSTEAD OF HAVING RETAOP, DOCMP AND THE RELATIONAL
; BITS ARE STORED. STRINGS HAVE STRCMP,THE POINTER AT THE STRING DESCRIPTOR,
; DOCMP AND THE RELATIONAL BITS.
;
FINREL:	MOV	AL,CH		;[A]=OLD PRECEDENCE
	CMP	AL,LOW 100	;RELATIONALS HAVE PRECEDENCE 100
	JNAE	SHORT $+3
	RET			;APPLY EARLIER OPERATOR IF IT HAS
				;HIGHER PRECEDENCE
	PUSH	CX		;SAVE THE OLD PRECEDENCE
	PUSH	DX		;SAVE [D]=RELATIONAL BITS
	MOV	DX,OFFSET 256*100+OPCNT	;[D]=PRECEDENCE=100
				;[E]=DISPATCH OFFSET FOR
				;COMPARES IN APPLOP=4
				;IN CASE THIS IS A NUMERIC COMPARE
	MOV	BX,OFFSET DOCMP	;ROUTINE TO TAKE COMPARE ROUTINE RESULT
				;AND RELATIONAL BITS AND RETURN THE ANSWER
	PUSH	BX		;DOES A JMP TO RETAOP WHEN DONE
	CALL	GETYPR		;SEE IF WE HAVE A NUMERIC COMPARE
	JZ	SHORT ??L005
	JMP	NUMREL		;YES, BUILD AN APPLOP ENTRY
??L005:
	MOV	BX,FACLO	;GET THE POINTER AT THE STRING DESCRIPTOR
	PUSH	BX		;SAVE IT FOR STRCMP
	MOV	CX,OFFSET STRCMP	;STRING COMPARE ROUTINE
	JMP	SHORT FINTMP	;PUSH THE ADDRESS, REGET THE TEXT POINTER
				;SAVE THE PRECEDENCE AND SCAN
				;MORE OF THE FORMULA
;
; APPLOP IS RETURNED TO WHEN IT IS TIME TO APPLY AN ARITHMETIC
; OR NUMERIC COMPARISON OPERATION.
; THE STACK HAS A DOUBLE BYTE ENTRY WITH THE OPERATOR
; NUMBER AND THE VALTYP OF THE VALUE ON THE STACK.
; APPLOP DECIDES WHAT VALUE LEVEL THE OPERATION
; WILL OCCUR AT, AND CONVERTS THE ARGUMENTS. APPLOP
; USES DIFFERENT CALLING CONVENTIONS FOR EACH VALUE TYPE.
; INTEGERS: LEFT IN [D,E] RIGHT IN [H,L]
; SINGLES:  LEFT IN [B,C,D,E] RIGHT IN THE FAC
; DOUBLES:  LEFT IN FAC   RIGHT IN ARG
;
APPLOP:	POP	CX		;[B]=STACK OPERAND VALUE TYPE
				;[C]=OPERATOR OFFSET
	MOV	AL,CL		;SAVE IN MEMORY SINCE THE STACK WILL BE BUSY
	MOV	BYTE PTR OPRTYP,AL	;A RAM LOCATION
	MOV	AL,BYTE PTR VALTYP	;GET VALTYP OF FAC
	CMP	AL,CH		;ARE VALTYPES THE SAME?
	JNZ	SHORT VALNSM	;NO
	CMP	AL,LOW 2	;INTEGER?
	JZ	SHORT INTDPC	;YES, DISPATCH!!
	CMP	AL,LOW 4	;SINGLE?
	JNZ	SHORT ??L006
	JMP	SNGDPC		;YES, DISPATCH!!
??L006:
	JAE	SHORT DBLDPC	;MUST BE DOUBLE, DISPATCH!!
VALNSM:	MOV	DH,AL		;SAVE IN [D]
	MOV	AL,CH		;CHECK FOR DOUBLE
	CMP	AL,LOW 8	;PRECISION ENTRY ON THE STACK
	JZ	SHORT STKDBL	;FORCE FAC TO DOUBLE
	MOV	AL,DH		;GET VALTYPE OF FAC
	CMP	AL,LOW 8	;AND IF SO, CONVERT THE STACK OPERAND
	JZ	SHORT FACDBL	;TO DOUBLE PRECISION
	MOV	AL,CH		;SEE IF THE STACK ENTRY IS SINGLE
	CMP	AL,LOW 4	;PRECISION AND IF SO, CONVERT
	JZ	SHORT STKSNG	;THE FAC TO SINGLE PRECISION
	MOV	AL,DH		;SEE IF THE FAC IS SINGLE PRECISION
	CMP	AL,LOW 3	;AND IF SO CONVERT THE STACK TO SINGLE
	JNZ	SHORT ??L007
	JMP	TMERR		;BLOW UP ON RIGHT HAND STRING OPERAND
??L007:
	JAE	SHORT FACSNG	;PRECISION
				;NOTE: THE STACK MUST BE INTEGER AT THIS POINT
INTDPC:	MOV	BX,OFFSET INTDSP	;INTEGER INTEGER CASE
	MOV	CH,LOW 0	;SPECIAL DISPATCH FOR SPEED
	ADD	BX,CX		;[H,L] POINTS TO THE ADDRESS TO GO TO 
	ADD	BX,CX
	INS86	56		;FETCH FROM CODE SEGMENT
	MOV	CL,BYTE PTR [BX]	;[B,C]=ROUTINE ADDRESS
	INC	BX
	INS86	56		;FETCH FROM CODE SEGMENT
	MOV	CH,BYTE PTR [BX]
	POP	DX		;[D,E]=LEFT HAND OPERAND
	MOV	BX,FACLO	;[H,L]=RIGHT HAND OPERAND
	PUSH	CX		;DISPATCH
	RET	
;
; THE STACK OPERAND IS DOUBLE PRECISION, SO
; THE FAC MUST BE FORCED TO DOUBLE PRECISION, MOVED INTO ARG
; AND THE STACK VALUE POPED INTO THE FAC
;
STKDBL:	CALL	FRCDBL		;MAKE THE FAC DOUBLE PRECISION
DBLDPC:	CALL	VMOVAF		;MOVE THE FAC INTO ARG
	POP	BX		;POP OFF THE STACK OPERAND INTO THE FAC
	MOV	DFACLO+2,BX
	POP	BX
	MOV	DFACLO,BX	;STORE LOW BYTES AWAY
SNGDBL:	POPR			;POP OFF A FOUR BYTE VALUE
	CALL	MOVFR		;INTO THE FAC
SETDBL:	CALL	FRCDBL		;MAKE SURE THE LEFT OPERAND IS
				;DOUBLE PRECISION
	MOV	BX,OFFSET DBLDSP	;DISPATCH TO A DOUBLE PRECISION ROUTINE
DODSP:	MOV	AL,BYTE PTR OPRTYP	;RECALL WHICH OPERAND IT WAS
	ROL	AL,1		;CREATE A DISPATCH OFFSET, SINCE
				;TABLE ADDRESSES ARE TWO BYTES
	ADD	AL,BL		;ADD LOW BYTE OF ADDRESS
	MOV	BL,AL		;SAVE BACK
	ADC	AL,BH		;ADD HIGH BYTE
	SUB	AL,BL		;SUBTRACT LOW
	MOV	BH,AL		;RESULT BACK
	INS86	56		;FETCH FROM CODE SEGMENT
	MOV	BX,[BX]		;FETCH THE ADDRESS
	JMP	BX		;AND PERFORM THE OPERATION, RETURNING
				;TO RETAOP, EXCEPT FOR COMPARES WHICH
				;RETURN TO DOCMP
;
; THE FAC IS DOUBLE PRECISION AND THE STACK IS EITHER
; INTEGER OR SINGLE PRECISION AND MUST BE CONVERTED
; 
FACDBL:	MOV	AL,CH		;GET THE VALUE TYPE INTO [A]
	PUSH	AX		;SAVE THE STACK VALUE TYPE
	CALL	VMOVAF		;MOVE THE FAC INTO ARG
	POP	AX		;POP THE STACK VALUE TYPE INTO [A]
	MOV	BYTE PTR VALTYP,AL	;PUT IT IN VALTYP FOR THE FORCE
				;ROUTINE
	CMP	AL,LOW 4	;SEE IF ITS SINGLE, SO WE KNOW
				;HOW TO POP THE VALUE OFF
	JZ	SHORT SNGDBL	;IT'S SINGLE PRECISION
				;SO DO A POPR / CALL MOVFR
	POP	BX		;POP OFF THE INTEGER VALUE
	MOV	FACLO,BX	;SAVE IT FOR CONVERSION
	JMP	SHORT SETDBL	;SET IT UP
;
; THIS IS THE CASE WHERE THE STACK IS SINGLE PRECISION
; AND THE FAC IS EITHER SINGLE PRECISION OR INTEGER
;
STKSNG:	CALL	FRCSNG		;CONVERT THE FAC IF NECESSARY
SNGDPC:	POPR			;PUT THE LEFT HAND OPERAND IN THE REGISTERS
SNGDO:	MOV	BX,OFFSET SNGDSP	;SETUP THE DISPATCH ADDRESS
				;FOR THE SINGLE PRECISION OPERATOR ROUTINES
	JMP	SHORT DODSP	;DISPATCH
;
; THIS IS THE CASE WHERE THE FAC IS SINGLE PRECISION AND THE STACK
; IS AN INTEGER. 
;
FACSNG:	POP	BX		;POP OFF THE INTEGER ON THE STACK
	CALL	_PUSHF		;SAVE THE FAC ON THE STACK
	CALL	CONSIH		;CONVERT [H,L] TO A SINGLE PRECISION
				;NUMBER IN THE FAC
	CALL	MOVRF		;PUT THE LEFT HAND OPERAND IN THE REGISTERS
	POP	BX		;RESTORE THE FAC
	MOV	FAC-1,BX	;FROM THE STACK
	POP	BX
	MOV	FACLO,BX
	JMP	SHORT SNGDO	;PERFORM THE OPERATION
;
; HERE TO DO INTEGER DIVISION. SINCE WE WANT 1/3 TO BE
; .333333 AND NOT ZERO WE HAVE TO FORCE BOTH ARGUMENTS
; TO BE SINGLE-PRECISION FLOATING POINT NUMBERS
; AND USE FDIV
;
PUBLIC	INTDIV
INTDIV:	PUSH	BX		;SAVE THE RIGHT HAND ARGUMENT
	XCHG	BX,DX		;[H,L]=LEFT HAND ARGUMENT
	CALL	CONSIH		;CONVERT [H,L] TO A SINGLE-PRECISION
				;NUMBER IN THE FAC
	POP	BX		;GET BACK THE RIGHT HAND ARGUMENT
	CALL	_PUSHF		;PUSH THE CONVERTED LEFT HAND ARGUMENT
				;ONTO THE STACK
	CALL	CONSIH		;CONVERT THE RIGHT HAND ARGUMENT TO A
				;SINGLE PRECISION NUMBER IN THE FAC
	JMP	FDIVT
				;REGISTERS THE LEFT HAND ARGUMENT

	PAGE	

	SUBTTL EVAL - EVALUATE VARIABLE, CONSTANT, FUNCTION CALL
PUBLIC	EVAL
EVAL:
	CALL	CHRGTR
	JNZ	SHORT ??L008
	JMP	MOERR		;TEST FOR MISSING OPERAND - IF NONE GIVE ERROR
??L008:
	JAE	SHORT ??L009
	JMP	FIN		;IF NUMERIC, INTERPRET CONSTANT
??L009:
	CALL	ISLET2		;VARIABLE NAME?
	JNAE	SHORT ??L010
	JMP	ISVAR		;AN ALPHABETIC CHARACTER MEANS YES
??L010:
	CMP	AL,LOW OFFSET DBLCON+1	;IS IT AN EMBEDED CONSTANT
	JAE	SHORT ??L011
	JMP	CONFAC		;RESCAN THE TOKEN & RESTORE OLD TEXT PTR
??L011:
	EXTRN	EVALX:NEAR
	CALL	EVALX		;Handle extended functions.
	INC	AL		;IS IT A FUNCTION CALL (PRECEDED BY 377)
	JNZ	SHORT ??L012
	JMP	ISFUN		;YES, DO IT
??L012:
	DEC	AL		;FIX A BACK
	CMP	AL,LOW OFFSET PLUSTK	;IGNORE "+"
	JZ	SHORT EVAL
	CMP	AL,LOW OFFSET MINUTK	;NEGATION?
	JNZ	SHORT ??L013
	JMP	DOMIN
??L013:
	CMP	AL,LOW 34	;STRING CONSTANT?
	JNZ	SHORT ??L014
	JMP	STRLTI		;IF SO BUILD A DESCRIPTOR IN A TEMPORARY
??L014:
				;DESCRIPTOR LOCATION AND PUT A POINTER TO THE
				;DESCRIPTOR IN FACLO.
	CMP	AL,LOW OFFSET NOTTK	;CHECK FOR "NOT" OPERATOR
	JNZ	SHORT ??L015
	JMP	NOTER
??L015:
	CMP	AL,LOW "&"	;OCTAL CONSTANT?
	JNZ	SHORT ??L016
	JMP	OCTCNS
??L016:
	CMP	AL,LOW OFFSET ERCTK
	JNZ	SHORT NTERC	;NO, TRY OTHER POSSIBILITIES
	CALL	CHRGTR		;GRAB FOLLOWING CHAR
	MOV	AL,BYTE PTR ERRFLG	;GET THE ERROR CODE.
NTDERC:	PUSH	BX		;SAVE TEXT POINTER
	CALL	SNGFLT		;RETURN THE VALUE
	POP	BX		;RESTORE TEXT POINTER
	RET			;ALL DONE.

NTERC:	CMP	AL,LOW OFFSET ERLTK	;ERROR LINE NUMBER VARIABLE.
	JNZ	SHORT NTERL	;NO, TRY MORE THINGS.
	CALL	CHRGTR		;GET FOLLOWING CHARACTER
	PUSH	BX		;SAVE TEXT POINTER
	MOV	BX,ERRLIN	;GET THE OFFENDING LINE #
	CALL	INEG2		;FLOAT 2 BYTE UNSINGED INT
	POP	BX		;RESTORE TEXT POINTER
	RET			;RETURN
NTERL:
	CMP	AL,LOW OFFSET $VARPTR	;VARPTR CALL?
	JNZ	SHORT NTVARP	;NO
	CALL	CHRGTR		;EAT CHAR AFTER
	EXTRN	VARPT2:NEAR
	CMP	AL,LOW "$"
	JNZ	SHORT ??L017
	JMP	VARPT2		;branch if VARPTR$(x)
??L017:
	CALL	SYNCHR
	DB	OFFSET "("	;EAT LEFT PAREN
	EXTRN	GETPTR:NEAR
	CMP	AL,LOW "#"	;WANT POINTER TO FILE?
	JNZ	SHORT NVRFIL	;NO, MUST BE VARIABLE
	CALL	GTBYTC		;READ FILE #
	PUSH	BX		;SAVE TEXT PTR
	CALL	GETPTR		;GET PTR TO FILE
	POP	BX		;RESTORE TEXT PTR
	JMP	VARRET
NVRFIL:
	EXTRN	PTRGTN:NEAR
	CALL	PTRGTN		;GET ADDRESS OF VARIABLE
VARRET:	CALL	SYNCHR
	DB	OFFSET ")"	;EAT RIGHT PAREN
	PUSH	BX		;SAVE TEXT POINTER
	XCHG	BX,DX		;GET VALUE TO RETURN IN [H,L]
	OR	BX,BX		;MAKE SURE NOT UNDEFINED VAR
				;SET CC'S. ZERO IF UNDEF
	JNZ	SHORT ??L018
	JMP	FCERR		;ALL OVER IF UNDEF (DONT WANT
??L018:
				;USER POKING INTO ZERO IF HE'S
				;TOO LAZY TO CHECK
	CALL	MAKINT		;MAKE IT AN INT
	POP	BX		;RESTORE TEXT POINTER
	RET	
NTVARP:
	CMP	AL,LOW OFFSET USRTK	;USER ASSEMBLY LANGUAGE ROUTINE??
	JNZ	SHORT ??L019
	JMP	USRFN		;GO HANDLE IT
??L019:
	CMP	AL,LOW OFFSET INSRTK	;IS IT THE INSTR FUNCTION??
	JNZ	SHORT ??L020
	JMP	_INSTR		;DISPATCH
??L020:
	CMP	AL,LOW OFFSET $SCREEN
	JNZ	SHORT ??L021
EXTRN	SCRENF:NEAR
	JMP	SCRENF
??L021:
	CMP	AL,LOW OFFSET $POINT
	JNZ	SHORT ??L022
EXTRN	POINT:NEAR
	JMP	POINT
??L022:
	EXTRN	INKEY:NEAR
	CMP	AL,LOW OFFSET $INKEY$	;INKEY$ FUNCTION?
	JNZ	SHORT ??L023
	JMP	INKEY
??L023:
	CMP	AL,LOW OFFSET $STRING$	;STRING FUNCTION?
	JNZ	SHORT ??L024
	JMP	STRNG$		;YES, GO DO IT
??L024:
	EXTRN	FIXINP:NEAR
	CMP	AL,LOW OFFSET $INPUT	;FIXED LENGTH INPUT?
	JNZ	SHORT ??L025
	JMP	FIXINP		;YES
??L025:
	CMP	AL,LOW OFFSET CLINTK	;WANT TO KNOW CURRENT LINE ON SCREEN?
	JNZ	SHORT ??L026
EXTRN	GETLIN:NEAR
	JMP	GETLIN		;YES
??L026:
	CMP	AL,LOW OFFSET FNTK	;USER-DEFINED FUNCTION?
	JNZ	SHORT ??L027
	JMP	FNDOER
??L027:
;
; ONLY POSSIBILITY LEFT IS A FORMULA IN PARENTHESES
;
PUBLIC	PARCHK
PARCHK:	CALL	FRMPRN		;RECURSIVELY EVALUATE THE FORMULA
	CALL	SYNCHR
	DB	OFFSET ")"
	RET	
DOMIN:
	MOV	DH,LOW 125	;A PRECEDENCE BELOW ^
				;BUT ABOVE ALL ELSE
	CALL	LPOPER		;SO ^ GREATER THAN UNARY MINUS
	MOV	BX,TEMP2	;GET TEXT POINTER
	PUSH	BX
	CALL	VNEG
LABBCK:				;FUNCTIONS THAT DON'T RETURN
				;STRING VALUES COME BACK HERE
	POP	BX
	RET	
PUBLIC	ISVAR
ISVAR:	CALL	PTRGET		;GET A POINTER TO THE
				;VARIABLE IN [D,E]
PUBLIC	RETVAR
RETVAR:	PUSH	BX		;SAVE THE TEXT POINTER
	XCHG	BX,DX		;PUT THE POINTER TO THE VARIABLE VALUE
				;INTO [H,L]. IN THE CASE OF A STRING
				;THIS IS A POINTER TO A DESCRIPTOR AND NOT
				;AN ACTUAL VALUE
	MOV	FACLO,BX	;IN CASE IT'S STRING STORE THE POINTER
				;TO THE DESCRIPTOR IN FACLO.
	CALL	GETYPR		;FOR STRINGS WE JUST LEAVE
	JZ	SHORT ??L028
	CALL	VMOVFM		;A POINTER IN THE FAC
??L028:
				;THE FAC USING [H,L] AS THE POINTER.
	POP	BX		;RESTORE THE TEXT POINTER
	RET	
PUBLIC	MAKUPL
MAKUPL:	MOV	AL,BYTE PTR [BX]	;GET CHAR FROM MEMORY
PUBLIC	MAKUPS
MAKUPS:	CMP	AL,LOW OFFSET "A"+40O	;IS IT LOWER CASE RANGE
	JNB	SHORT $+3
	RET			;LESS
	CMP	AL,LOW OFFSET "Z"+41O	;GREATER
	JNAE	SHORT $+3
	RET			;TEST
	AND	AL,LOW 137O	;MAKE UPPER CASE
	RET			;DONE
PUBLIC	CNSGET
CNSGET:
	CMP	AL,LOW "&"	;OCTAL PERHAPS?
	JZ	SHORT ??L029
	JMP	LINGET
??L029:
PUBLIC	$OHCNS
$OHCNS:
PUBLIC	OCTCNS
OCTCNS:	MOV	DX,0		;INITIALIZE TO ZERO AND IGNORE OVERFLOW
	CALL	CHRGTR		;GET FIRST CHAR
	CALL	MAKUPS		;MAKE UPPER IF NESC.
	CMP	AL,LOW "O"	;OCTAL?
	JZ	SHORT LOPOCT	;IF SO, DO IT
	CMP	AL,LOW "H"	;HEX?
	JNZ	SHORT LOPOC2	;THEN DO IT
	MOV	CH,LOW 5	;INIT DIGIT COUNT
LOPHEX:	INC	BX		;BUMP POINTER
	MOV	AL,BYTE PTR [BX]	;GET CHAR
	CALL	MAKUPS		;MAKE UPPER CASE
	CALL	ISLET2		;FETCH CHAR, SEE IF ALPHA
	XCHG	BX,DX		;SAVE [H,L]
	JAE	SHORT ALPTST	;YES, MAKE SURE LEGAL HEC
	CMP	AL,LOW OFFSET "9"+1	;IS IT BIGGER THAN LARGEST DIGIT?
	JAE	SHORT OCTFIN	;YES, BE FORGIVING & RETURN
	SUB	AL,LOW "0"	;CONVERT DIGIT, MAKE BINARY
	JB	SHORT OCTFIN	;BE FORGIVING IF NOT HEX DIGIT
	JMP	SHORT NXTHEX	;ADD IN OFFSET
ALPTST:	CMP	AL,LOW OFFSET "F"+1	;IS IT LEGAL HEX?
	JAE	SHORT HEXFIN	;YES, TERMINATE
	SUB	AL,LOW OFFSET "A"-10	;MAKE BINARY VALUE
NXTHEX:	ADD	BX,BX		;SHIFT RIGHT FOUR BITS
	ADD	BX,BX
	ADD	BX,BX
	ADD	BX,BX
	OR	AL,BL		;OR ON NEW DIGIT
	MOV	BL,AL		;SAVE BACK
	XCHG	BX,DX		;GET TEXT POINTER BACK IN [H,L]
	DEC	CH
	JNZ	SHORT LOPHEX	;KEEP EATING IF NOT TOO MANY DIGITS
;IF NOT INPUT STATEMENT GOTO OVFLW ERROR FROM HERE, ELSE PASS BACK ERROR
CKOVER:	MOV	AL,BYTE PTR FLGSCN
	OR	AL,AL
	JNZ	SHORT ??L030
	JMP	OVERR		;IF NOT INPUT STATEMENT, THIS IS ERROR
??L030:
	PUSH	BX
	MOV	BX,OFFSET $OVMSG
	CALL	$STPRN		;PRINT OVERFLOW MESSAGE
	CALL	CRDO
	POP	BX
CONER2:	MOV	AL,BYTE PTR FLGOVC
	INC	AL
	MOV	BYTE PTR FLGOVC,AL	;TELL INPUT CODE THAT ERROR OCCURED
	RET	
CONERR:	MOV	AL,BYTE PTR FLGSCN
	OR	AL,AL
	JZ	SHORT ??L031
	JMP	CONER2		;IF INPUT CODE ERROR, RETURN ERROR CODE
??L031:
	JMP	SNERR		;ELSE GOTO ERROR FROM HERE
LOPOC2:	DEC	BX		;REGET LAST CHARACTER
LOPOCT:	CALL	CHRGTR		;READ A DIGIT
	XCHG	BX,DX		;RESULT INTO [H,L]
	JAE	SHORT OCTFIN	;OUT OF DIGITS MEANS DONE
	CMP	AL,LOW "8"	;IS THIS AN OCTAL DIGIT
	JNAE	SHORT ??L032
	JMP	CONERR		;NO, TOO BAD YOU WILL LOSE
??L032:
	MOV	CX,OFFSET CKOVER	;WHERE TO GO ON OVERFLOW ERROR
	PUSH	CX		;SAVE ADDR ON STACK
	ADD	BX,BX		;MULTIPLY BY EIGHT
	JNB	SHORT $+3
	RET			;OVERFLOW ERROR
	ADD	BX,BX
	JNB	SHORT $+3
	RET			;OVERFLOW ERROR
	ADD	BX,BX
	JNB	SHORT $+3
	RET			;OVERFLOW ERROR
	POP	CX		;GET RID OF OVERR ADDR
	MOV	CH,LOW 0	;SETUP TO ADD [B,C]
	SUB	AL,LOW "0"
	MOV	CL,AL
	ADD	BX,CX		;ADD IN THE DIGIT
	XCHG	BX,DX		;PUT TEXT POINTER BACK IN [H,L]
	JMP	SHORT LOPOCT	;SCAN MORE DIGITS
HEXFIN:
OCTFIN:

PUBLIC	HOCFIN
HOCFIN:
	CALL	MAKINT		;SAVE AS AN INTEGER
	XCHG	BX,DX		;[H,L]-TEXT POINTER
	RET	
ISFUN:
	INC	BX		;BUMP SOURCE TEXT POINTER
	MOV	AL,BYTE PTR [BX]	;GET THE ACTUAL TOKEN FOR FN
	SUB	AL,LOW OFFSET ONEFUN	;MAKE INTO OFFSET
	EXTRN	RNDMON:NEAR
	EXTRN	$RNDFN:NEAR
	CMP	AL,LOW OFFSET $RNDFN	;IS IT RND?
	JNZ	SHORT NTMRND	;IF NOT NO NEED TO CHECK MONADIC
	PUSH	BX		;SAVE TEXT POINTER
	CALL	CHRGTR		;SEE IF NEXT CHAR IS "("
	CMP	AL,LOW "("
	POP	BX		;GET BACK THE OLD TEXT POINTER
	JZ	SHORT ??L033
	JMP	RNDMON		;HANDLE MONADIC CASE
??L033:
	MOV	AL,LOW OFFSET $RNDFN
NTMRND:
	MOV	CH,LOW 0
	ROL	AL,1		;MULTIPLY BY 2
	MOV	CL,AL
	PUSH	CX		;SAVE THE FUNCTION # ON THE STACK
	CALL	CHRGTR
	MOV	AL,CL		;LOOK AT FUNCTION #
	EXTRN	NUMGFN:NEAR
	CMP	AL,LOW OFFSET NUMGFN	;IS IT PAST LASNUM?
	JAE	SHORT OKNORM	;NO, MUST BE A NORMAL FUNCTION
;
; MOST FUNCTIONS TAKE A SINGLE ARGUMENT.
; THE RETURN ADDRESS OF THESE FUNCTIONS IS A SMALL ROUTINE
; THAT CHECKS TO MAKE SURE VALTYP IS 0 (NUMERIC) AND POPS OFF
; THE TEXT POINTER. SO NORMAL FUNCTIONS THAT RETURN STRING RESULTS (I.E. CHR$)
; MUST POP OFF THE RETURN ADDRESS OF LABBCK, AND POP OFF THE
; TEXT POINTER AND THEN RETURN TO FRMEVL.
;
; THE SO CALLED "FUNNY" FUNCTIONS CAN TAKE MORE THAN ONE ARGUMENT.
; THE FIRST OF WHICH MUST BE STRING AND THE SECOND OF WHICH
; MUST BE A NUMBER BETWEEN 0 AND 256. THE TEXT POINTER IS
; PASSED TO THESE FUNCTIONS SO ADDITIONAL ARGUMENTS
; CAN BE READ. THE TEXT POINTER IS PASSED IN [D,E].
; THE CLOSE PARENTHESIS MUST BE CHECKED AND RETURN IS DIRECTLY
; TO FRMEVL WITH [H,L] SETUP AS THE TEXT POINTER POINTING BEYOND THE ")".
; THE POINTER TO THE DESCRIPTOR OF THE STRING ARGUMENT
; IS STORED ON THE STACK UNDERNEATH THE VALUE OF THE INTEGER
; ARGUMENT (2 BYTES)
;
; FIRST ARGUMENT ALWAYS STRING -- SECOND INTEGER
;
	CALL	FRMPRN		;EAT OPEN PAREN AND FIRST ARG
	CALL	SYNCHR
	DB	OFFSET 44	;TWO ARGS SO COMMA MUST DELIMIT
	CALL	CHKSTR		;MAKE SURE THE FIRST ONE WAS STRING
	XCHG	BX,DX		;[D,E]=TXTPTR
	MOV	BX,FACLO	;GET PTR AT STRING DESCRIPTOR
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;GET FUNCTION #
				;SAVE THE STRING PTR
	PUSH	BX		;PUT THE FUNCTION # ON
	XCHG	BX,DX		;[H,L]=TXTPTR
	CALL	GETBYT		;[E]=VALUE OF FORMULA
	XCHG	BX,DX		;TEXT POINTER INTO [D,E]
				;[H,L]=INT VALUE OF SECOND ARGUMENT
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE INT VALUE OF SECOND ARG
				;[H,L]=FUNCTION NUMBER
	JMP	SHORT FINGO	;DISPATCH TO FUNCTION
OKNORM:
	CALL	PARCHK		;CHECK OUT THE ARGUMENT
				;AND MAKE SURE ITS FOLLOWED BY ")"
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;[H,L]=FUNCTION # AND SAVE TEXT POINTER
;
; CHECK IF SPECIAL COERCION MUST BE DONE FOR ONE OF THE TRANSCENDENTAL
; FUNCTIONS (RND, SQR, COS, SIN, TAN, ATN, LOG, AND EXP)
; THESE FUNCTIONS DO NOT LOOK AT VALTYP, BUT RATHER ASSUME THE
; ARGUMENT PASSED IN THE FAC IS SINGLE PRECISION, SO FRCSNG
; MUST BE CALLED BEFORE DISPATCHING TO THEM.
;
	MOV	AL,BL		;[A]=FUNCTION NUMBER
	EXTRN	BOTCON:NEAR,TOPCON:NEAR
	CMP	AL,LOW OFFSET BOTCON	;LESS THAN SQUARE ROOT?
	JB	SHORT NOTFRF	;DON'T FORCE THE ARGUMENT
	CMP	AL,LOW OFFSET TOPCON	;BIGGER THAN ARC-TANGENT?
	PUSH	BX		;SAVE THE FUNCTION NUMBER
	JNB	SHORT ??L034
	CALL	FRCSNG		;IF NOT, FORCE FAC TO SINGLE-PRECISION
??L034:
	POP	BX		;RESTORE THE FUNCTION NUMBER
NOTFRF:
	MOV	DX,OFFSET LABBCK	;RETURN ADDRESS
	PUSH	DX		;MAKE THEM REALLY COME BACK
	MOV	AL,LOW 1	;FUNCTION SHOULD ONLY PRINT OVERFLOW ONCE
	MOV	BYTE PTR FLGOVC,AL
FINGO:
	MOV	CX,OFFSET FUNDSP	;FUNCTION DISPATCH TABLE
DISPAT:	ADD	BX,CX		;ADD ON THE OFFSET

	INS86	56		;FETCH FROM CODE SEGMENT
	INS86	377,047		;JMPI   0(.BX)
; THE FOLOWING ROUTINE IS CALLED FROM FIN IN F4
; TO SCAN LEADING SIGNS FOR NUMBERS. IT WAS MOVED
; TO F3 TO ELIMINATE BYTE EXTERNALS
PUBLIC	MINPLS
MINPLS:
	DEC	DH		;SET SIGN OF EXPONENT FLAG
	CMP	AL,LOW OFFSET MINUTK	;NEGATIVE EXPONENT?
	JNZ	SHORT $+3
	RET
	CMP	AL,LOW "-"
	JNZ	SHORT $+3
	RET
	INC	DH		;NO, RESET FLAG
	CMP	AL,LOW "+"
	JNZ	SHORT $+3
	RET
	CMP	AL,LOW OFFSET PLUSTK	;IGNORE "+"
	JNZ	SHORT $+3
	RET
	LAHF
	DEC	BX		;CHECK IF LAST CHARACTER WAS A DIGIT
	SAHF
	RET			;RETURN WITH NON-ZERO SET
	PAGE	

	SUBTTL MORE FORMULA EVALUATION - LOGICAL, RELATIONAL OPS
DOCMP:	INC	AL		;SETUP BITS
	ADC	AL,AL		;4=LESS 2=EQUAL 1=GREATER
	POP	CX		;WHAT DID HE WANT?
	AND	AL,CH		;ANY BITS MATCH?
	ADD	AL,LOW 255	;MAP 0 TO 0
	SBB	AL,AL		;AND ALL OTHERS TO 377
	CALL	CONIA		;CONVERT [A] TO AN INTEGER SIGNED
	JMP	SHORT RETAPG	;RETURN FROM OPERATOR APPLICATION
NOTER:	MOV	DH,LOW 90	;"NOT" HAS PRECEDENCE 90, SO
	CALL	LPOPER		;FORMULA EVALUATION IS ENTERED WITH A DUMMY
				;ENTRY OF 90 ON THE STACK
	CALL	FRCINT		;COERCE THE ARGUMENT TO INTEGER
	INS86	367,323		;NOT [H,L]
	MOV	FACLO,BX	;UPDATE THE FAC
	POP	CX		;FRMEVL, AFTER SEEING THE PRECEDENCE
				;OF 90 THINKS IT IS APPLYING AN OPERATOR
				;SO IT HAS THE TEXT POINTER IN TEMP2 SO

RETAPG:	JMP	RETAOP		;RETURN TO REFETCH IT
PUBLIC	GETYPR
GETYPR:	MOV	AL,BYTE PTR VALTYP	;REPLACEMENT FOR "GETYPE" RST
	CMP	AL,LOW 8
;
; CONTINUATION OF GETYPE RST
;
CGETYP:	DEC	AL		;SET THE OTHER CONDITION CODES CORRECTLY
	DEC	AL		; WITHOUT AFFECTING CARRY
	DEC	AL
	RET	


;
; DANDOR APPLIES THE "AND" AND "OR" OPERATORS
; AND SHOULD BE USED TO IMPLEMENT ALL LOGICAL OPERATORS.
; WHENEVER AN OPERATOR IS APPLIED, ITS PRECEDENCE IS IN [B].
; THIS FACT IS USED TO DISTINGUISH BETWEEN "AND" AND "OR".
; THE RIGHT HAND ARGUMENT IS COERCED TO INTEGER, JUST AS
; THE LEFT HAND ONE WAS WHEN IT WAS PUSHED ON THE STACK.
;
DANDOR:
	MOV	AL,CH		;GET THE PRECEDENCE
	PUSH	AX		;SAVE THE PRECEDENCE "OR"=70
	CALL	FRCINT		;COERCE RIGHT HAND ARGUMENT TO INTEGER
	POP	AX		;GET BACK THE PRECEDENCE TO DISTINGUISH
				;"AND" AND "OR"
	POP	DX		;POP OFF THE LEFT HAND ARGUMENT
	CMP	AL,LOW 122	;IS THE OPERATOR "MOD"?
	JNZ	SHORT ??L035
	JMP	IMOD		;IF SO, USE MONTE'S SPECIAL ROUTINE
??L035:
	CMP	AL,LOW 123	;IS THE OPERATOR "IDIV"?
	JNZ	SHORT ??L036
	JMP	_IDIV		;LET MONTE HANDLE IT
??L036:
	MOV	CX,OFFSET MAKINT	;PLACE TO RETURN WHEN DONE
	PUSH	CX		;SAVE ON STACK
	CMP	AL,LOW 70	;SET ZERO FOR "OR"
	JNZ	SHORT NOTOR
	INS86	13,332		;OR BX,BX
	RET			;RETURN THE INTEGER [A,L]
NOTOR:
	CMP	AL,LOW 80	;AND?
	JNZ	SHORT NOTAND
	INS86	43,332		;AND BX,DX
	RET			;RETURN THE INTEGER [A,L]

NOTAND:	CMP	AL,LOW 60	;XOR?
	JNZ	SHORT NOTXOR	;NO
	INS86	63,332		;XOR BX,DX
	RET	

NOTXOR:	CMP	AL,LOW 50	;EQV?
	JNZ	SHORT NOTEQV	;NO
	INS86	63,332		;XOR BX,DX
	INS86	367,323		;NOT BX
	RET	
;FOR "IMP" USE A IMP B = NOT(A AND NOT(B))
NOTEQV:
	INS86	367,323		;NOT BX
	INS86	43,332		;AND BX,DX
	INS86	367,323		;NOT BX
	RET	
	PAGE	
;
; THIS ROUTINE SUBTRACTS [D,E] FROM [H,L]
; AND FLOATS THE RESULT LEAVING IT IN FAC.
;
PUBLIC	GIVDBL
GIVDBL:	SUB	BX,DX		;[H,L]=[H,L]-[D,E]
	JMP	INEG2		;FLOAT 2 BYTE UNSIGNED INT
PUBLIC	SNGFLT
SNGFLT:	MOV	BL,AL		;MAKE [A] AN UNSIGNED INTEGER
	XOR	AL,AL
PUBLIC	GIVINT
GIVINT:	MOV	BH,AL
	JMP	MAKINT
	PAGE	

	SUBTTL USER DEFINED (USR) ASSEMBLY LANGUAGE FUNCTION CODE

USRFN:
	EXTRN	PRODIR:NEAR
	CALL	PRODIR		;Don't allow in direct mode in
				; protected environment
	CALL	SCNUSR		;SCAN THE USR#
	PUSH	DX		;SAVE POINTER
	CALL	PARCHK		;EAT LEFT PAREN AND FORMULA
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE TEXT POINTER & GET INDEX INTO USRTAB
	MOV	DX,[BX]		;GET DISPATCH ADDRESS
	INS86	203,372		;CMPI DX,
	DB	377O		; 0FFFFH
	JNZ	SHORT ??L037
	JMP	FCERR		;GIVE HIM AN ERROR IF HE CALLS A SUBROUTINE
??L037:
				;AT FFFF, SINCE CANT INITIALIZE TABLE
				;TO "FCERR" SINCE IT MAY NOT EXIST IN
				;THE DESTINATION SEGMENT
	INS86	16		;PUSH CS - PUSH BASIC'S CODE SEGMENT
	MOV	BX,OFFSET POPHRT	;GET ADDRESS OF POP H RET
	PUSH	BX		;PUSH IT ON
	INS86	377,66,SAVSEG	;PUSH ON SEGMENT ADDRESS OF SUBROUTINE
	PUSH	DX		;SAVE ADDRESS OF USR ROUTINE
	MOV	AL,BYTE PTR VALTYP	;GET ARGUMENT TYPE IN [A]
	PUSH	AX		;SAVE VALTYP
	CMP	AL,LOW 3	;STRING??
	JNZ	SHORT ??L038
	CALL	FREFAC		;FREE IT UP
??L038:
	POP	AX		;GET BACK VALTYP
	XCHG	BX,DX		;MOVE POSSIBLE DESC. POINTER TO [D,E]
	MOV	BX,OFFSET FACLO	;POINTER TO FAC IN [H,L]
	INS86	313		;INTER SEGMENT RETURN
SCNUSR:	CALL	CHRGTR		;GET A CHAR
	MOV	CX,0		;ASSUME USR0
	CMP	AL,LOW OFFSET ONECON+10	;SINGLE BYTE INT EXPECTED
	JAE	SHORT NOARGU	;NO, MUST BE DEFAULTING TO USR0
	CMP	AL,LOW OFFSET ONECON	;IS IT SMALLER THAN ONECON
	JB	SHORT NOARGU	;YES, ASSUME TRYING TO DEFAULT TO USR0
USERCN:	CALL	CHRGTR		;SCAN PAST NEXT CHAR
	MOV	AL,BYTE PTR CONLO	;GET VALUE OF 1 BYTER
	OR	AL,AL		;MAKE SURE CARRY IS OFF
	RCL	AL,1		;MULTIPLY BY 2
	MOV	CL,AL		;SAVE OFFSET IN [C]
NOARGU:	XCHG	BX,DX		;SAVE TEXT POINTER IN [D,E]
	MOV	BX,OFFSET USRTAB	;GET START OF TABLE
	ADD	BX,CX		;ADD ON OFFSET
	XCHG	BX,DX		;RESTORE TEXT POINTER, ADDRESS TO [D,E]
	RET			;RETURN FROM SCAN ROUTINE

DEFUSR:	CALL	SCNUSR		;SCAN THE USR NAME
	PUSH	DX		;SAVE POINTER TO USRTAB ENTRY
	CALL	SYNCHR
	DW	OFFSET EQULTK	;MUST HAVE EQUAL SIGN
	CALL	FRMQNT		;GET THE ADDRESS
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;TEXT POINTER TO STACK, GET ADDRESS
	MOV	[BX],DX		;SAVE USR CALL ADDRESS
	POP	BX		;RESTORE TEXT POINTER
	RET			;RETURN TO NEWSTT

	PAGE	

	SUBTTL SIMPLE-USER-DEFINED-FUNCTION CODE
;
; IN THE 8K VERSION (SEE LATER COMMENT FOR EXTENDED)
; NOTE ONLY SINGLE ARGUMENTS ARE ALLOWED TO FUNCTIONS
; AND FUNCTIONS MUST BE OF THE SINGLE LINE FORM:
; DEF FNA(X)=X^2+X-2
; NO STRINGS CAN BE INVOLVED WITH THESE FUNCTIONS
;
; IDEA: CREATE A FUNNY SIMPLE VARIABLE ENTRY
; WHOSE FIRST CHARACTER (SECOND WORD IN MEMORY)
; HAS THE 200 BIT SET.
; THE VALUE WILL BE:
;
;       A TXTPTR TO THE FORMULA
;       THE NAME OF THE PARAMETER VARIABLE
;
; FUNCTION NAMES CAN BE LIKE "FNA4"
;

DEF:
	CMP	AL,LOW OFFSET USRTK	;DEFINING THE CALL ADDRESS OF USR ROUTINE?
	JZ	SHORT DEFUSR	;YES, DO IT
	CMP	AL,LOW OFFSET FNTK	; "FN"?
	JZ	SHORT DEFNC3	;THEN GO DO FUNCTION NAME
	CALL	SYNCHR
	DB	OFFSET "S"	;Else must be "SEG" or error.
	CALL	SYNCHR
	DB	OFFSET "E"
	CALL	SYNCHR
	DB	OFFSET "G"
	INS86	214,332		; MOV DX,DS
	JZ	SHORT DEFNC2	;NO ASSIGNMENT, USE CURRENT [DS].
	CALL	SYNCHR
	DW	OFFSET EQULTK	; ELSE MUST HAVE EQUAL SIGN
	CALL	FRMQNT		;GET SEGMENT IN DX
DEFNC2:	MOV	SAVSEG,DX	;STORE FOR PEEK/POKE/CALL/BLOAD/BSAVE
	RET			;RETURN TO NEWSTT
DEFNC3:
	CALL	GETFNM		;GET A POINTER TO THE FUNCTION NAME
	CALL	ERRDIR		;DEF IS "ILLEGAL DIRECT"
	XCHG	BX,DX		;[D,E] = THE TEXT POINTER AFTER THE FUNCTION
				;NAME AND [H,L] = POINTER AT PLACE TO STORE
				;VALUE OF THE FUNCTION VARIABLE
	MOV	[BX],DX		;SAVE THE TEXT POINTER AS THE VALUE
	XCHG	BX,DX		;RESTORE THE TEXT POINTER TO [H,L]
	MOV	AL,BYTE PTR [BX]	;GET NEXT CHAR
	CMP	AL,LOW "("	;DOES THIS FUNCTION HAVE ARGS?
	JZ	SHORT ??L039
	JMP	DATA		;NO
??L039:
	CALL	CHRGTR
SCNLIS:	CALL	PTRGET		;GET POINTER TO DUMMY VAR(CREATE VAR)
	MOV	AL,BYTE PTR [BX]	;GET TERMINATOR
	CMP	AL,LOW ")"	;END OF ARG LIST?
	JNZ	SHORT ??L040
	JMP	DATA		;YES
??L040:
	CALL	SYNCHR
	DB	OFFSET 44	;"," MUST FOLLOW THEN
	JMP	SHORT SCNLIS

FNDOER:	CALL	GETFNM		;GET A POINTER TO
	MOV	AL,BYTE PTR VALTYP	;FIND OUT WHAT KIND OF FUNCTION IT IS
	OR	AL,AL		;PUSH THIS [A] ON WITH A PSW WITH CARRY OFF
				;SO THAT WHEN VALUES ARE BEING POPPED OFF
				;AND RESTORED TO PARAMETERS WE WILL KNOW
				;WHEN TO STOP
				;WHEN A VALTYP IS POPPED OFF WITH
				;CARRY OFF
	PUSH	AX		;SAVE SO THAT THE FINAL RESULT WILL
				;BE COERCED TO THE FUNCTION TYPE
	MOV	TEMP2,BX	;SAVE THE TEXT POINTER THAT POINTS PAST
				;THE FUNCTION NAME IN THE CALL
	XCHG	BX,DX		;[H,L]=A POINTER TO THE VALUE OF FUNCTION
	MOV	BX,[BX]		;[H,L]=VALUE OF THE FUNCTION
				;WHICH IS A TEXT POINTER AT THE FORMAL
				;PARAMETER LIST IN THE DEFINITION
	OR	BX,BX		;A ZERO TEXT POINTER MEANS THE FUNCTION
				;WAS NEVER DEFINED
	JNZ	SHORT ??L041
	JMP	UFERR		;IF SO, GIVEN AN "UNDEFINED FUNCTION" ERROR
??L041:
	MOV	AL,BYTE PTR [BX]	;SEE IF THERE ARE ANY PARAMETERS
	CMP	AL,LOW "("	;PARAMETER LIST STARTS WITH "(""
	JZ	SHORT ??L042
	JMP	FINVLS		;SKIP OVER PARAMETER SETUP
??L042:
	CALL	CHRGTR		;GO PAST THE "("
	MOV	TEMP3,BX	;SAVE THE TEXT POINTER TO THE START OF THE
	XCHG	BX,DX		;PARAMETER LIST.
	MOV	BX,TEMP2	;NOW GET THE TEXT-POINTER FROM THE CALL
				;WHICH IS POINTING JUST PAST THE
				;FUNCTION NAME AT THE ARGUMENT LIST
	CALL	SYNCHR
	DB	OFFSET "("	;MAKE SURE THE ARGUMENT LIST IS THERE
	XOR	AL,AL		;INDICATE END OF VALUES TO ASSIGN
	PUSH	AX
	PUSH	BX		;SAVE THE CALLERS TEXT POINTER
	XCHG	BX,DX		;GET THE POINTER TO THE BEGINNING OF THE
				;PARAMETER LIST
ASGMOR:	MOV	AL,LOW 128	;OUTLAW ARRAYS WHEN SCANNING
	MOV	BYTE PTR SUBFLG,AL	;PARAMETERS
	CALL	PTRGET		;READ A PARAMETER
	XCHG	BX,DX		;[D,E]=PARAMETER LIST TEXT,[H,L]=VARIABLE POINTER
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE THE VARIABLES POSITION AND
				;GET THE POINTER AT THE ARG LIST
	MOV	AL,BYTE PTR VALTYP	;AND ITS TYPE (FOR COERCION)
	PUSH	AX
	PUSH	DX		;SAVE THE TEXT POINTER INTO THE PARAMETER
	CALL	FRMEVL		;EVALUATE THE ARGUMENT
	MOV	TEMP2,BX	;SAVE THE ARGUMENT LIST POINTER
	POP	BX		;AND THE PARAMETER LIST POINTER
	MOV	TEMP3,BX
	POP	AX		;GET THE VALUE TYPE
	CALL	DOCNVF		;COERCE THE ARGUMENT
	MOV	CL,LOW 4	;MAKE SURE THERE IS ROOM FOR THE VALUE
	CALL	GETSTK
	MOV	BX,OFFSET 0-8	;SAVE EIGHT PLACES
	ADD	BX,SP
	MOV	SP,BX
	CALL	VMOVMF		;PUT VALUE INTO RESERVED PLACE IN STACK
	MOV	AL,BYTE PTR VALTYP	;SAVE TYPE FOR ASSIGNMENT
	PUSH	AX
	MOV	BX,TEMP2	;REGET THE ARGUMENT LIST POINTER
	MOV	AL,BYTE PTR [BX]	;SEE WHAT COMES AFTER THE ARGUMENT FORMULA
	CMP	AL,LOW ")"	;IS THE ARGUMENT LIST ENDING?
	JZ	SHORT POPASG	;MAKE SURE THE ARGUMENT LIST ALSO ENDED
	CALL	SYNCHR
	DB	OFFSET 54O	;SKIP OVER ARGUMENT COMMA
	PUSH	BX		;SAVE THE ARGUMENT LIST TEXT POINTER
	MOV	BX,TEMP3	;GET THE TEXT POINTER INTO THE DEFINTION'S
				;PARAMETER LIST
	CALL	SYNCHR
	DB	OFFSET 54O	;SKIP OVER THE PARAMETER LIST COMMA
	JMP	SHORT ASGMOR	;AND BIND THE REST OF THE PARAMETERS
POPAS2:	POP	AX		;IF ASSIGNMENT IS SUCESSFUL UPDATE PRMLN2
	MOV	BYTE PTR PRMLN2,AL	;INDICATE NEW VARIABLE IS IN PLACE
POPASG:	POP	AX		;GET THE VALUE TYPE
	OR	AL,AL
	JZ	SHORT FINASG	;ZERO MEANS NO MORE LEFT TO POP AND ASSIGN
	MOV	BYTE PTR VALTYP,AL
	MOV	BX,0		;POINT INTO STACK
	ADD	BX,SP		;TO GET SAVED VALUE
	CALL	VMOVFM		;PUT VALUE INTO FAC
	MOV	BX,8		;FREE UP STACK AREA
	ADD	BX,SP
	MOV	SP,BX
	POP	DX		;GET PLACE TO STORE TO
	MOV	BL,LOW 3	;CALCULATE THE SIZE OF THE LOOKS (NAME)
LPSIZL:	INC	BL		;INCREMENT SIZE
	DEC	DX		;POINT AT PREVIOUS CHARACTER
	MOV	SI,DX
	MOV	AL,[SI]		;SEE IF IT IS THE LENGTH OR ANOTHER CHARACTER
	OR	AL,AL
	JNS	SHORT ??L043
	JMP	LPSIZL		;HIGH BIT INDICATES STILL PART OF NAME
??L043:
	DEC	DX		;BACK UP OVER LOOKS
	DEC	DX
	DEC	DX
	MOV	AL,BYTE PTR VALTYP	;GET SIZE OF VALUE
	ADD	AL,BL		;ADD ON SIZE OF NAME
	MOV	CH,AL		;SAVE TOTAL LENGTH IN [B]
	MOV	AL,BYTE PTR PRMLN2	;GET CURRENT SIZE OF BLOCK
	MOV	CL,AL		;SAVE IN [C]
	ADD	AL,CH		;GET POTENTIAL NEW SIZE
	CMP	AL,LOW OFFSET PRMSIZ	;CAN'T EXCEED ALLOCATED STORAGE
	JNAE	SHORT ??L044
	JMP	FCERR
??L044:
	PUSH	AX		;SAVE NEW SIZE
	MOV	AL,BL		;[A]=SIZE OF NAME
	MOV	CH,LOW 0	;[B,C]=SIZE OF PARM2
	MOV	BX,OFFSET PARM2	;BASE OF PLACE TO STORE INTO
	ADD	BX,CX		;[H,L]=PLACE TO START THE NEW VARIABLE
	MOV	CL,AL		;[B,C]=LENGTH OF NAME OF VARIABLE
	CALL	BCTRAN		;PUT IN THE NEW NAME
	MOV	CX,OFFSET POPAS2	;PLACE TO RETURN AFTER ASSIGNMENT
	PUSH	CX
	PUSH	CX		;SAVE EXTRA ENTRY ON STACK
	JMP	LETCN4		;PERFORM ASSIGNMENT ON [H,L] (EXTRA POP D)
FINASG:	MOV	BX,TEMP2	;GET ARGUMENT LIST POINTER
	CALL	CHRGTR		;SKIP OVER THE CLOSING PARENTHESIS
	PUSH	BX		;SAVE THE ARGUMENT TEXT POINTER
	MOV	BX,TEMP3	;GET THE PARAMETER LIST TEXT POINTER
	CALL	SYNCHR
	DB	OFFSET ")"	;MAKE SURE THE PARAMETER LIST
				;ENDED AT THE SAME TIME
	DB	260O	; SKIP	;SKIP THE NEXT BYTE WITH "MVI AL,"
FINVLS:	PUSH	DX		;HERE WHEN THERE WERE NO ARGUMENTS
				;OR PARAMETERS
				;SAVE THE TEXT POINTER OF THE CALLER
	MOV	TEMP3,BX	;SAVE THE TEXT POINTER OF THE FUNCTION
	MOV	AL,BYTE PTR PRMLEN	;PUSH PARM1 STUFF ONTO THE STACK
	ADD	AL,LOW 4	;WITH PRMLEN AND PRMSTK (4 BYTES EXTRA)
	PUSH	AX		;SAVE THE NUMBER OF BYTES
	ROR	AL,1		;NUMBER OF TWO BYTE ENTRIES IN [A]
	MOV	CL,AL
	CALL	GETSTK		;IS THERE ROOM ON THE STACK?
	POP	AX		;[A]=AMOUNT TO PUT ONTO STACK
	MOV	CL,AL
	NOT	AL		;COMPLEMENT [A]
	INC	AL
	MOV	BL,AL
	MOV	BH,LOW 255
	ADD	BX,SP
	MOV	SP,BX		;SET UP NEW STACK
	PUSH	BX		;SAVE THE NEW VALUE FOR PRMSTK
	MOV	DX,OFFSET PRMSTK	;FETCH DATA FROM HERE
	CALL	BCTRAN
	POP	BX
	MOV	PRMSTK,BX	;LINK PARAMETER BLOCK FOR GARBAGE COLLECTION
	MOV	BX,PRMLN2	;NOW PUT PARM2 INTO PARM1
	MOV	PRMLEN,BX	;SET UP LENGTH
	MOV	CX,BX		;[B,C]=TRANSFER COUNT
	MOV	BX,OFFSET PARM1
	MOV	DX,OFFSET PARM2
	CALL	BCTRAN
	MOV	BH,AL		;CLEAR OUT PARM2
	MOV	BL,AL
	MOV	PRMLN2,BX
	MOV	BX,FUNACT	;INCREMENT FUNCTION COUNT
	INC	BX
	MOV	FUNACT,BX
	MOV	AL,BH
	OR	AL,BL		;SET UP ACTIVE FLAG NON-ZERO
	MOV	BYTE PTR NOFUNS,AL
	MOV	BX,TEMP3	;GET BACK THE FUNCTION DEFINITION TEXT POINTER
;       DCX     H               ;DETECT A MULTI-LINE FUNCTION
;       CHRGET                  ;IF THE DEFINITION ENDS NOW
;       JZ      MULFUN          ;IF ENDS, ITS A MULTI-LINE FUNCTION
				;SKIP OVER THE "=" IN THE DEFINITION
	CALL	FRMEQL		;AND EVALUATE THE DEFINITION FORMULA
				;CAN HAVE RECURSION AT THIS POINT
	DEC	BX
	CALL	CHRGTR		;SEE IF THE STATEMENT ENDED RIGHT
	JZ	SHORT ??L045
	JMP	SNERR		;THIS IS A CHEAT, SINCE THE LINE
??L045:
				;NUMBER OF THE ERROR WILL BE THE CALLERS
				;LINE # INSTEAD OF THE DEFINITIONS LINE #
	CALL	GETYPR		;SEE IT THE RESULT IS A STRING
	JNZ	SHORT NOCPRS	;WHOSE DESCRIPTOR IS ABOUT TO BE WIPED OUT
				;BECAUSE IT IS SITTING IN PARM1 (THIS
				; HAPPENS IT THE FUNCTION IS A PROJECTION
				; FUNCTION ON A STRING ARGUMENT)
	MOV	DX,OFFSET DSCTMP	;DSCTMP IS PAST ALL THE TEMP AREA
	MOV	BX,FACLO	;GET THE ADDRESS OF THE DESCRIPTOR
	CMP	BX,DX
	JB	SHORT NOCPRS	;RESULT IS A TEMP - NO COPY NESC
	CALL	STRCPY		;MAKE A COPY IN DSCTMP
	CALL	PUTTMP		;PUT RESULT IN A TEMP AND MAKE FACLO POINT AT IT
NOCPRS:	MOV	BX,PRMSTK	;GET PLACE TO RESTORE PARM1 FROM STACK
	MOV	DH,BH
	MOV	DL,BL
	INC	BX		;POINT AT LENGTH
	INC	BX
	MOV	CL,BYTE PTR [BX]	;[B,C]=LENGTH
	INC	BX
	MOV	CH,BYTE PTR [BX]
	INC	CX		;INCLUDE EXTRA BYTES
	INC	CX
	INC	CX
	INC	CX
	MOV	BX,OFFSET PRMSTK	;PLACE TO STORE INTO
	CALL	BCTRAN
	XCHG	BX,DX		;[D,E]=PLACE TO RESTORE STACK TO
	MOV	SP,BX
	MOV	BX,FUNACT	;DECREASE ACTIVE FUNCTION COUNT
	DEC	BX
	MOV	FUNACT,BX
	MOV	AL,BH
	OR	AL,BL		;SET UP FUNCTION FLAG
	MOV	BYTE PTR NOFUNS,AL
	POP	BX		;GET BACK THE CALLERS TEXT POINTER
	POP	AX		;GET BACK THE TYPE OF THE FUNCTION
PUBLIC	DOCNVF
DOCNVF:	PUSH	BX		;SAVE THE TEXT POINTER
	AND	AL,LOW 7	;SETUP DISPATCH TO FORCE
				;FORMULA TYPE TO CONFORM
				;TO THE VARIABLE ITS BEING ASSIGNED TO
	MOV	BX,OFFSET FRCTBL	;TABLE OF FORCE ROUTINES
	MOV	CL,AL		;[B,C]=TWO BYTE OFFSET
	MOV	CH,LOW 0
	ADD	BX,CX
	CALL	DISPAT		;DISPATCH
	POP	BX		;GET BACK THE TEXT POINTER
	RET	
;
; BLOCK TRANSFER ROUTINE WITH SOURCE IN [D,E] DESTINATION IN [H,L]
; AND COUNT IN [B,C]. TRANSFER IS FORWARD.
;
BCTRAL:	MOV	SI,DX
	MOV	AL,[SI]
	MOV	BYTE PTR [BX],AL
	INC	BX
	INC	DX
	DEC	CX
BCTRAN:	MOV	AL,CH
	OR	AL,CL
	JNZ	SHORT BCTRAL
	RET	
;
; SUBROUTINE TO SEE IF WE ARE IN DIRECT MODE AND
; COMPLAIN IF SO
;
ERRDIR:	PUSH	BX		;SAVE THEIR [H,L]
	MOV	BX,CURLIN	;SEE WHAT THE CURRENT LINE IS
	INC	BX		;DIRECT IS 65,535 SO NOW 0
	OR	BX,BX		;IS IT ZERO NOW?
	POP	BX
	JZ	SHORT $+3
	RET			;RETURN IF NOT
	MOV	DL,LOW OFFSET ERRID	;"ILLEGAL DIRECT" ERROR
	JMP	ERROR
;
;
; SUBROUTINE TO GET A POINTER TO A FUNCTION NAME
;
GETFNM:	CALL	SYNCHR
	DW	OFFSET FNTK	;MUST START WITH "FN"
	MOV	AL,LOW 128	;DONT ALLOW AN ARRAY
	MOV	BYTE PTR SUBFLG,AL	;DON'T RECOGNIZE THE "(" AS
				;THE START OF AN ARRAY REFEREENCE
	OR	AL,BYTE PTR [BX]	;PUT FUNCTION BIT ON
	MOV	CL,AL		;GET FIRST CHARACTER INTO [C]
	JMP	PTRGT2
	PAGE	

	SUBTTL STRING FUNCTIONS - LEFT HAND SIDE MID$

PUBLIC	ISMID$
ISMID$:	CMP	AL,LOW 126D	;FUNCTION? (FF - $END)
	JZ	SHORT ??L046
	JMP	SNERR		;NO, ERROR.
??L046:
	INC	BX		;POINT TO NEXT CHAR
	MOV	AL,BYTE PTR [BX]	;GET FN DESCRIPTOR
	INC	BX		;POINT TO CHAR AFTER
	CMP	AL,LOW OFFSET MIDTK	;IS IT MID?
	EXTRN	LHSMID:NEAR	;CODE IS IN BISTRS.MAC
	JNZ	SHORT ??L047
	JMP	LHSMID
??L047:
	JMP	SNERR

	PAGE	

	SUBTTL INP, OUT, WAIT, CONSOLE, WIDTH
;
; THE FOLLOWING FUNCTIONS ALLOW THE 
; USER FULL ACCESS TO THE 8080/Z80  I/O PORTS
; INP(CHANNEL#) RETURNS AN INTEGER WHICH IS THE STATUS
; OF THE CHANNEL. OUT CHANNEL#,VALUE PUTS OUT THE INTEGER
; VALUE ON CHANNEL #. IT IS A STATEMENT, NOT A FUNCTION.
;
FNINP:
	CALL	FRQINT		;MAKE ARGUMENT AN INTEGER CHANNEL NUMBER
	XCHG	BX,DX
	INS86	354		;READ BYTE INTO AL FROM DX=[D,E] FOR 8086
	JMP	SNGFLT
SETIO:
	CALL	FRMQNT		;READ A 16-BIT PORT FOR Z80 AND 8086
	PUSH	DX		;SAVE FOR USE BY WAIT AND FNOUT
	CALL	SYNCHR
	DB	OFFSET 44D
	CALL	GETBYT		;READ THE DATA BYTE TO [A] AND [E]
	POP	DX		;RETURN PORT IN [D,E]=DX FOR 8086
	RET	
FNOUT:	CALL	SETIO		;GET PORT IN [B,C] AND DATA IN [A] & [E]
	INS86	356		;OUTPUT TO PORT DX=[D,E] FROM [A]
	RET	
;
; THE WAIT CHANNEL#,MASK,MASK2 WAITS UNTIL THE STATUS
; RETURNED BY CHANNEL# IS NON ZERO WHEN XORED WITH MASK2
; AND THEN ANDED WITH MASK. IF MASK2 IS NOT PRESENT IT IS ASSUMED
; TO BE ZERO.
;
FNWAIT:	CALL	SETIO		;SET UP FOR WAIT
	PUSH	DX		;SAVE THE I/O PORT
	PUSH	AX		;SAVE THE MASK
	MOV	DL,LOW 0	;DEFAULT MASK2 TO ZERO
	DEC	BX
	CALL	CHRGTR		;SEE IF THE STATEMENT ENDED
	JZ	SHORT NOTTHR	;IF NO THIRD ARGUMENT SKIP THIS
	CALL	SYNCHR
	DB	OFFSET 44	;MAKE SURE THERE IS A ","
	CALL	GETBYT
NOTTHR:	POP	AX		;REGET THE "AND" MASK
	MOV	DH,AL		;KEEP AND MASK IN [D]
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;GET BACK THE PORT NUMBER FOR 8086
LOPINP:
EXTRN	POLKEY:NEAR
	CALL	POLKEY		;Exit if User CTRL-C'd.
	XCHG	BX,DX		;GET READY TO READ PORT IN [D,E]
	INS86	354		;READ BYTE INTO [A]
	XCHG	BX,DX
	XOR	AL,DL		;XOR WITH MASK2
	AND	AL,DH		;AND WITH MASK
	JZ	SHORT LOPINP	;LOOP UNTIL RESULT IS NON-ZERO
				;NOTE: THIS LOOP CANNOT BE CONTROL-C'ED
LOPINX:	POP	BX		;Restore the Text pointer.
	RET	
CONSOL:	JMP	SNERR
	EXTRN	WIDTHS:NEAR
PUBLIC	GETINT
GETINT:	CALL	CHRGTR
PUBLIC	GETIN2
GETIN2:	CALL	FRMEVL		;EVALUATE A FORMULA
PUBLIC	INTFR2
INTFR2:	PUSH	BX		;SAVE THE TEXT POINTER
	CALL	FRCINT		;CONVERT THE FORMULA TO AN INTEGER IN [H,L]
	XCHG	BX,DX		;PUT THE INTEGER INTO [D,E]
	POP	BX		;RESTORE THE TEXT POINTER
	MOV	AL,DH		;SET THE CONDITION CODES ON THE HIGH ORDER
	OR	AL,AL
	RET	
PUBLIC	GTBYTC
GTBYTC:	CALL	CHRGTR
PUBLIC	GETBYT
GETBYT:	CALL	FRMEVL		;EVALUATE A FORMULA
PUBLIC	CONINT
CONINT:	CALL	INTFR2		;CONVERT THE FAC TO AN INTEGER IN [D,E]
				;AND SET THE CONDITION CODES BASED
				;ON THE HIGH ORDER
	JZ	SHORT ??L048
	JMP	FCERR		;WASN'T ERROR
??L048:
	DEC	BX		;ACTUALLY FUNCTIONS CAN GET HERE
				;WITH BAD [H,L] BUT NOT SERIOUS
				;SET CONDITION CODES ON TERMINATOR
	CALL	CHRGTR
	MOV	AL,DL		;RETURN THE RESULT IN [A] AND [E]
	RET	

	PAGE	

	SUBTTL EXECUTE BASIC PROGRAM ON PROM



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