BIMISC.ASM

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

	.RADIX  8		; To be safe

CSEG	SEGMENT PUBLIC 'CODESG' 
	ASSUME  CS:CSEG

INCLUDE	OEM.H

	TITLE   BIMISC  BASIC Interpreter miscellaneous routines/WHG/PGA etc.


	.RADIX	10
PC8A=0
	LABEL=PC8A
TRSHHC=0
NECPPC=0
NNECBS=0
ALPS=0
ALPCPM=0
OKI=0
HAL=0
TSHIBA=0
CAN8=0
	LTRACE=ALPCPM		;trace output selectable

DSEG	SEGMENT PUBLIC 'DATASG'		; Data Segment
	ASSUME DS:DSEG
	EXTRN	ARYTAB:WORD,CURLIN:WORD,DATPTR:WORD,FRETOP:WORD,MEMSIZ:WORD
	EXTRN	OLDLIN:WORD,OLDTXT:WORD,STREND:WORD
	EXTRN	SUBFLG:WORD,SAVTXT:WORD,TEMPPT:WORD,TEMPST:WORD,TXTTAB:WORD
	EXTRN	VALTYP:WORD,VARTAB:WORD,TEMP:WORD
	EXTRN	TOPMEM:WORD
	EXTRN	PRMLEN:WORD,PRMLN2:WORD,PRMSTK:WORD,FUNACT:WORD,NOFUNS:WORD
DSEG	ENDS			; End of data segment externals

				; Code Segment ( terminated by END at bottom of file )

	EXTRN	BRKTXT:NEAR,CRDO:NEAR,CRDONZ:NEAR,ERROR:NEAR,FADDS:NEAR
	EXTRN	FCERR:NEAR,FCOMP:NEAR,FNDFOR:NEAR,FNDLIN:NEAR,FRMEVL:NEAR
	EXTRN	INLIN:NEAR,LINGET:NEAR
	EXTRN	MOVFM:NEAR,MOVMF:NEAR,MOVRM:NEAR,NEWSTT:NEAR,OVERR:NEAR
	EXTRN	PTRGET:NEAR
	EXTRN	SNERR:NEAR,OUTDO:NEAR,CHRCON:NEAR
	EXTRN	TMERR:NEAR,USERR:NEAR
	EXTRN	ERRCN:NEAR,ERRFIN:NEAR,ERROM:NEAR,GETBYT:NEAR,STPRDY:NEAR
	EXTRN	NFERR:NEAR,INTID2:NEAR,NXTCON:NEAR


	EXTRN	CHRGTR:NEAR
	EXTRN	GETYPR:NEAR
	EXTRN	VMOVE:NEAR,FRQINT:NEAR,IADD:NEAR,ICOMP:NEAR
	EXTRN	FRMQNT:NEAR,FRESTR:NEAR
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	DEFTBL:WORD
DSEG	ENDS
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	OPTFLG:WORD,OPTVAL:WORD
DSEG	ENDS
	PUBLIC	STOPRG
	PUBLIC	TON,TOFF
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	TRCFLG:WORD
DSEG	ENDS
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	ONEFLG:WORD,ONELIN:WORD,SAVSTK:WORD
DSEG	ENDS
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	NXTFLG:WORD
DSEG	ENDS

	PUBLIC	CLEARC,STOP,ISLET,ISLET2,STKINI,GETSTK
	PUBLIC	SCRATH,SCRTCH
	PUBLIC	STPEND,CONT,ENDST,GTMPRT,RUNC,STPEND,ENDCON,RESTORE
	PUBLIC	STOP,RESFIN,STKERR,REASON,OMERR,OMERRR

	EXTRN	LINKER:NEAR

	PAGE	
;
; THIS ROUTINE IS USED TO MAKE SURE A CERTAIN NUMBER
; OF LOCATIONS REMAIN AVAILABLE FOR THE
; STACK. THE CALL IS :
;       MVI     C,NUMBER OF 2 BYTE ENTRIES NECESSARY
;       CALL    GETSTK
;
; THIS ROUTINE MUST BE CALLED BY ANY ROUTINE WHICH PUTS
; AN ARBITRARY AMOUNT OF STUFF ON THE STACK
; (I.E. ANY RECURSIVE ROUTINE LIKE FRMEVL)
; IT IS ALSO CALLED BY ROUTINES SUCH AS "GOSUB" AND "FOR"
; WHICH MAKE PERMANENT ENTRIES ON THE STACK
; ROUTINES WHICH MERELY USE AND FREE UP THE GUARANTEED
; NUMLEV STACK LOCATIONS NEED NOT CALL THIS
;
GETSTK:	PUSH	BX		;SAVE [H,L]
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	STKLOW:WORD
DSEG	ENDS
	MOV	BX,STKLOW	;in GIO86, stack can grow down to STKLOW
	MOV	CH,LOW 0
	ADD	BX,CX
	ADD	BX,CX		;SEE IF WE CAN HAVE THIS MANY
;
; [H,L]= SOME ADDRESS
; [H,L] IS EXAMINED TO MAKE SURE AT LEAST NUMLEV
; LOCATIONS REMAIN BETWEEN IT AND THE TOP OF THE STACK
;
	CONS1=256-(2*NUMLEV)
	MOV	AL,LOW OFFSET CONS1	;SET [H,L]=-[H,L]-2*NUMLEV
	SUB	AL,BL
	MOV	BL,AL
	MOV	AL,LOW 255
	SBB	AL,BH
	MOV	BH,AL
	JB	SHORT OMERR	;IN CASE [H,L] WAS TOO BIG(MBM 3/18**)
				;NOW SEE IF SP IS LARGER
	ADD	BX,SP		;IF SO, CARRY WILL BE SET
	POP	BX		;GET BACK ORIGINAL [H,L]
	JNB	SHORT $+3
	RET			;WAS OK?

;OMERR fixes program links (starting at TXTTAB), resets SAVSTK to TOPMEM-2
; and issues an Out-of-Memory error message
;
OMERR:
	CALL	LINKER		;Fix links incase OMERR was called after
				;deleting a program line because user
				;was attempting to replace it.
				;ONLY IMPORTANT IN VERSIONS WHERE
				;STACK CONTEXT SURVIVES OTHER ERRORS
	MOV	BX,TOPMEM
				;ELIMINATE ALL STACK CONTEXT TO FREE
	DEC	BX		; UP SOME MEMORY SPACE
	DEC	BX		;MAKE SURE THE FNDFOR STOPPER IS SAVED
	MOV	SAVSTK,BX	;PLACE STACK IS RESTORED FROM
OMERRR:
	MOV	DX,OFFSET ERROM	;"OUT OF MEMORY"
	JMP	ERROR
	EXTRN	GARBA2:NEAR
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	CHNFLG:WORD
DSEG	ENDS
REASON:
	INS86	71,36,FRETOP	;CMP FRETOP,BX
	JNAE	SHORT $+3
	RET			;YES
	MOV	AL,BYTE PTR CHNFLG
	OR	AL,AL		;can't garbage collect if CHAINING
	JNZ	SHORT OMERR
	PUSH	CX		;SAVE ALL REGS
	PUSH	DX
	PUSH	BX
	CALL	GARBA2		;DO A GARBAGE COLLECTION
	POP	BX		;RESTORE ALL REGS
	POP	DX
	POP	CX
	INS86	71,36,FRETOP	;CMP FRETOP,BX
	JNAE	SHORT $+3
	RET			;YES
	JMP	SHORT OMERR	;NO, GIVE "OUT OF MEMORY BUT DONT TOUCH STACK
;
;PAGE

	SUBTTL NODSKS, SCRATCH (NEW), RUNC, CLEARC, STKINI, QINLIN

	PUBLIC	NODSKS
NODSKS:

	XOR	AL,AL
;
; THE "NEW" COMMAND CLEARS THE PROGRAM TEXT AS WELL
; AS VARIABLE SPACE
;
SCRATH:	JZ	SHORT $+3
	RET			;MAKE SURE THERE IS A TERMINATOR
SCRTCH:
	MOV	BX,TXTTAB	;GET POINTER TO START OF TEXT
	CALL	TOFF		;TURN OFF TRACE. SET [A]=0.
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	PROFLG:WORD
DSEG	ENDS
	MOV	BYTE PTR PROFLG,AL	;NO LONGER A PROTECTED FILE
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	AUTFLG:WORD
DSEG	ENDS
	MOV	BYTE PTR AUTFLG,AL	;CLEAR AUTO MODE
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	PTRFLG:WORD
DSEG	ENDS
	MOV	BYTE PTR PTRFLG,AL	;SAY NO POINTERS EXIST
	MOV	BYTE PTR [BX],AL	;SAVE AT END OFF TEXT
	INC	BX		;BUMP POINTER
	MOV	BYTE PTR [BX],AL	;SAVE ZERO
	INC	BX		;BUMP POINTER
	MOV	VARTAB,BX	;NEW START OF VARIABLES
RUNC:
	MOV	BX,TXTTAB	;POINT AT THE START OF TEXT
	DEC	BX
;
; CLEARC IS A SUBROUTINE WHICH INITIALIZES THE VARIABLE AND
; ARRAY SPACE BY RESETING ARYTAB [THE END OF SIMPLE VARIABLE SPACE]
; AND STREND [THE END OF ARRAY STORAGE]. IT FALLS INTO STKINI
; WHICH RESETS THE STACK. [H,L] IS PRESERVED.
;
CLEARC:
	MOV	TEMP,BX		;SAVE [H,L] IN TEMP
	CALL	INITRP		;INIT TRAP TABLE
	EXTRN	GRPRST:NEAR
	CALL	GRPRST		;Reset graphics
	CALL	INITRP		;Initialize trapping
	EXTRN	SNDINI:NEAR
	CALL	SNDINI		;Initialize SOUND & PLAY
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	MRGFLG:WORD
DSEG	ENDS
	MOV	AL,BYTE PTR MRGFLG	;DOING A CHAIN MERGE?
	OR	AL,AL		;TEST
	JNZ	SHORT LEVDTB	;LEAVE DEFAULT TABLE ALONE
	XOR	AL,AL
	MOV	BYTE PTR OPTFLG,AL	;INDICATE NO "OPTION" HAS BEEN SEEN
	MOV	BYTE PTR OPTVAL,AL	;DEFAULT TO "OPTION BASE 0"
	MOV	CH,LOW 26	;INITIALIZE THE DEFAULT VALTYPE TABLE
	MOV	BX,OFFSET DEFTBL	;POINT AT THE FIRST ENTRY
LOPDFT:
	MOV	BYTE PTR [BX],LOW 4	;LOOP 26 TIMES STORING A DEFAULT VALTYP
	INC	BX		;FOR SINGLE PRECISION
				;COUNT OFF THE LETTERS
	DEC	CH
	JNZ	SHORT LOPDFT	;LOOP BACK, AND SETUP THE REST OF THE TABLE
LEVDTB:
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	RNDCOP:WORD,RNDX:WORD
DSEG	ENDS
	EXTRN	MOVE:NEAR
	MOV	DX,OFFSET RNDCOP	;RESET THE RANDOM NUMBER GENERATOR
	MOV	BX,OFFSET RNDX	;SEED IN RNDX
	CALL	MOVE
	XOR	AL,AL
	MOV	BYTE PTR ONEFLG,AL	;RESET ON ERROR FLAG FOR RUNS
	MOV	BL,AL		;RESET ERROR LINE NUMBER
	MOV	BH,AL		;BY SETTING ONELIN=0.
	MOV	ONELIN,BX
	MOV	OLDTXT,BX	;MAKE CONTINUING IMPOSSIBLE
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	ERRLIN:WORD
DSEG	ENDS
	MOV	ERRLIN,BX	;Clear error line number
	MOV	BX,MEMSIZ
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	CHNFLG:WORD
DSEG	ENDS
	MOV	AL,BYTE PTR CHNFLG	;ARE WE CHAINING?
	OR	AL,AL		;TEST
	JNZ	SHORT GODFRE	;FRETOP IS GOOD, LEAVE IT ALONE
	MOV	FRETOP,BX	;FREE UP STRING SPACE
GODFRE:	XOR	AL,AL		;MAKE SURE [A] IS ZERO, CC'S SET
	CALL	RESTORE		;RESTORE DATA
	MOV	BX,VARTAB	;GET START OF VARIABLE SPACE
	MOV	ARYTAB,BX	;SAVE IN START OF ARRAY SPACE
	MOV	STREND,BX	;AND END OF VARIABLE STORAGE
	EXTRN	CLSALL:NEAR
	MOV	AL,BYTE PTR MRGFLG	;DOING CHAIN MERGE?
	OR	AL,AL
	JNZ	SHORT ??L000
	CALL	CLSALL		;IF SO, DONT CLOSE FILES...
??L000:
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	NLONLY:WORD
DSEG	ENDS
	MOV	AL,BYTE PTR NLONLY	;GET LOAD FLAGS
	AND	AL,LOW 1	;CURRENTLY LOADING?
	JNZ	SHORT CLRDS1	;YES, LEAVE OTHERS OPEN
	MOV	BYTE PTR NLONLY,AL	;ENABLE CLOSE ALL
CLRDS1:
;
; STKINI RESETS THE STACK POINTER ELIMINATING
; GOSUB & FOR CONTEXT.  STRING TEMPORARIES ARE FREED
; UP, SUBFLG IS RESET, CONTINUING IS DISALLOWED,
; AND A DUMMY ENTRY IS PUT ON THE STACK. THIS IS SO
; FNDFOR WILL ALWAYS FIND A NON-"FOR" ENTRY AT THE BOTTOM
; OF THE STACK. [A]=0 AND [D,E] IS PRESERVED.
;
STKINI:	POP	CX		;GET RETURN ADDRESS HERE
	MOV	BX,TOPMEM
	DEC	BX		;TAKE INTO ACCOUNT FNDFOR STOPPER
	DEC	BX
	MOV	SAVSTK,BX	;MAKE SURE SAVSTK OK JUST IN CASE.
	INC	BX		;INCREMENT BACK FOR SPHL
	INC	BX
STKERR:
	MOV	SP,BX		;INITIALIZE STACK
	MOV	BX,OFFSET TEMPST
	MOV	TEMPPT,BX	;INITIALIZE STRING TEMPORARIES
	EXTRN	CLROVC:NEAR
	CALL	CLROVC		;BACK TO NORMAL OVERFLOW PRINT MODE
	EXTRN	FINPRT:NEAR
	CALL	FINPRT		;CLEAR PTRFIL, OTHER I/O FLAGS
	XOR	AL,AL		;ZERO OUT A
	MOV	BH,AL		;ZERO OUT H
	MOV	BL,AL		;ZERO OUT L
	MOV	PRMLEN,BX	;FLAG NO ACTIVE PARAMETERS
	MOV	BYTE PTR NOFUNS,AL	;INDICATE NO USER FUNCTIONS ACTIVE
	MOV	PRMLN2,BX	;NO PARAMETERS BEING BUILT
	MOV	FUNACT,BX	;SET NUMBER OF FUNCTIONS ACTIVE TO 0
	MOV	PRMSTK,BX	;AND NO PARAMETER BLOCKS ON THE STACK
	MOV	BYTE PTR SUBFLG,AL	;ALLOW SUBSCRIPTS
	PUSH	BX		;PUT ZERO (NON $FOR,$GOSUB)
				;ON THE STACK
	PUSH	CX		;PUT RETURN ADDRESS BACK ON
GTMPRT:	MOV	BX,TEMP		;GET SAVED [H,L]
	RET	

;PAGE

	SUBTTL DCOMPR, SYNCHR - REPLACEMENTS FOR COMPAR & SYNCHK IN RSTLES VERSION
	PUBLIC	DCOMPR
DCOMPR:
	CMP	BX,DX
	RET	

	PUBLIC	SYNCHR
SYNCHR:
	INS86	136		;POP SI
	INS86	213,373		;MOV DI,BX
	INS86	374		;CLD
	INS86	56		;BYTE COMPARED TO IS IN CODE SEGMENT
	INS86	246		;CMPC-IS CHAR THE RIGHT ONE?
	INS86	126		;PUSH SI
	INS86	213,337		;MOV BX,DI
	JNZ	SHORT SYNERR	;GIVE ERROR IF CHARS DONT MATCH
	MOV	AL,BYTE PTR [BX]	;GET IT
	CMP	AL,LOW ":"	;IS IT END OF STATMENT OR BIGGER
	JB	SHORT SYNCON	;GO TO CHRCON
	RET			;DONE
SYNCON:	JMP	CHRCON		;REST OF CHRGET
SYNERR:	JMP	SNERR		;IFE CYB

	SUBTTL TRAP ROUTINES - ON, OFF, STOP, INIT, REQUEST, FREE, RESET
;
;Trap flag bit definitions(Routines shift bits - don't change)
;
PUBLIC	T_ON
	T_ON=1			;Trap on
PUBLIC	T_STOP
	T_STOP=2		;Trap stop
PUBLIC	T_REQ
	T_REQ=4			;Trap request

;TURN TRAP ON
;
PUBLIC	ONTRP
ONTRP:	CLI
	MOV	AL,BYTE PTR [BX]
	AND	AL,LOW OFFSET T_REQ	;LEAVE REQUEST BIT
	OR	AL,LOW OFFSET T_ON	;ADD ON BIT
	CMP	AL,BYTE PTR [BX]
	MOV	BYTE PTR [BX],AL
	JZ	SHORT ONTRP0	;NO CHANGE IN STATUS
	AND	AL,LOW OFFSET T_REQ
	JNZ	SHORT SETTP2	;DELAYED TRAP REQUEST
ONTRP0:	STI
	RET	

;TURN TRAP OFF
;
PUBLIC	OFFTRP
OFFTRP:	CLI
	MOV	AL,BYTE PTR [BX]
	MOV	BYTE PTR [BX],LOW 0
	JMP	SHORT FRECHK	;FREE OUTSTANDING REQUEST

;STOP TRAP
;
PUBLIC	STPTRP
STPTRP:	CLI
	MOV	AL,BYTE PTR [BX]
	LAHF			; PUSH PSW
	XCHG	AL,AH
	PUSH	AX
	XCHG	AL,AH
	OR	AL,LOW OFFSET T_STOP
	MOV	BYTE PTR [BX],AL
	POP	AX		; POP PSW
	XCHG	AL,AH
	SAHF
FRECHK:	XOR	AL,LOW OFFSET T_ON+T_REQ	;STOP OR OFF ACTIVE REQUEST?
	JZ	SHORT FRETP2	;YES, FREE ACTIVE REQUEST COUNT
	STI
	RET	

;RESET STOP ON TRAP
;
PUBLIC	RSTTRP
RSTTRP:	CLI
	MOV	AL,BYTE PTR [BX]
	AND	AL,LOW OFFSET T_ON+T_REQ
	CMP	AL,BYTE PTR [BX]
	MOV	BYTE PTR [BX],AL
	JNZ	SHORT SETCHK	;IF NEW STATUS, CHECK FOR SETTRP
	STI
	RET	
;
;REQUEST TRAP
;
PUBLIC	REQTRP
REQTRP:	CLI
	MOV	AL,BYTE PTR [BX]
	AND	AL,LOW OFFSET T_ON
	JZ	SHORT REQTPX	;TRAP NOT ON
	MOV	AL,BYTE PTR [BX]
	OR	AL,LOW OFFSET T_REQ
	CMP	AL,BYTE PTR [BX]
	JZ	SHORT REQTPX	;NO CHANGE
	MOV	BYTE PTR [BX],AL
SETCHK:	XOR	AL,LOW OFFSET T_ON+T_REQ
	JZ	SHORT SETTP2	;GO SET TRAP GLOBAL FLAG
REQTPX:	STI
	RET	

;SET TRAP GLOBAL FLAG
;
PUBLIC	SETTRP
SETTRP:	CLI
SETTP2:	MOV	AL,BYTE PTR ONGSBF
	INC	AL
	MOV	BYTE PTR ONGSBF,AL
	STI
	RET	

;FREE TRAP
;
PUBLIC	FRETRP
FRETRP:	CLI
	MOV	AL,BYTE PTR [BX]
	AND	AL,LOW OFFSET T_ON+T_STOP
	CMP	AL,BYTE PTR [BX]
	MOV	BYTE PTR [BX],AL
	JNZ	SHORT FRETP2	;DECR GLOBAL FLAG ALSO
FRETP1:	STI
	RET	
FRETP2:	MOV	AL,BYTE PTR ONGSBF
	SUB	AL,LOW 1
	JB	SHORT FRETP1
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	ONGSBF:WORD
DSEG	ENDS
	MOV	BYTE PTR ONGSBF,AL
	STI
	RET	

;INITIALIZE TRAP TABLE
;
PUBLIC	INITRP
INITRP:
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	TRPTBL:WORD
DSEG	ENDS
	MOV	BX,OFFSET TRPTBL	;HL=TRAP TABLE ADDRESS
	MOV	CH,LOW OFFSET NUMTRP	;B=NUMBER OF TRAPS
	XOR	AL,AL
INITP0:	MOV	BYTE PTR [BX],AL	;TRAP OFF
	INC	BX
	MOV	BYTE PTR [BX],AL
	INC	BX
	MOV	BYTE PTR [BX],AL	;CLEAR GOSUB ADDR TOO!
	INC	BX
	DEC	CH
	JNZ	SHORT INITP0
	MOV	BYTE PTR ONGSBF,AL
	RET	

;GO TO TRAP IF ANY ENABLED AND REQUESTED
;
PUBLIC	GOTRP
GOTRP:
	MOV	AL,BYTE PTR ONEFLG
	OR	AL,AL
	JZ	SHORT $+3
	RET			;CAN'T TRAP FROM ERROR TRAP
	PUSH	BX		;SAVE TESXT POINTER
	MOV	BX,CURLIN
	MOV	AL,BH
	AND	AL,BL
	INC	AL
	JZ	SHORT GOTRPX	;CAN'T TRAP FROM DIRECT STATEMENT

;CHECK FOR ENABLED REQUESTS
	MOV	BX,OFFSET TRPTBL
	MOV	CH,LOW OFFSET NUMTRP	;HL=TRAP TABLE ADDRESS, B= # OF TRAPS
GOTRPL:	MOV	AL,BYTE PTR [BX]
	CMP	AL,LOW OFFSET T_ON+T_REQ
	JZ	SHORT GOTRP2	;ENABLED AND REQUESTED
GOTRP1:	LAHF
	INC	BX		;NEXT ENTRY
	SAHF
	LAHF
	INC	BX		;
	SAHF
	LAHF
	INC	BX		;
	SAHF
	DEC	CH
	JNZ	SHORT GOTRPL
GOTRPX:	POP	BX		;RESTORE TEXT POINTER
	RET	
;
;TRAP REQUEST FOUND
;
GOTRP2:
	PUSH	CX		;SAVE STATE IN CASE ADDR IS ZERO
	LAHF
	INC	BX
	SAHF
	MOV	DL,BYTE PTR [BX]
	LAHF
	INC	BX
	SAHF
	MOV	DH,BYTE PTR [BX]	;DE=TRAP GOSUB ADDR
	LAHF
	DEC	BX
	SAHF
	LAHF
	DEC	BX		;HL:=TRAP FLAG
	SAHF
	MOV	AL,DH
	OR	AL,DL
	POP	CX		;RESTORE COUNTER
	JZ	SHORT GOTRP1	;GOSUB ADDR NOT SPECIFIED,TRY NEXT RTRAP
	PUSH	DX		;PUT GOSUB ADDR ON STACK
	PUSH	BX		;PUT FLAG ADDR ON STACK
	CALL	FRETRP		;FREE TRAP REQUEST
	CALL	STPTRP		;PUT STOP ON TRAP
	MOV	CL,LOW 3
	CALL	GETSTK		;MAKE SURE ROOM IN STACK
	POP	CX		;BC=TRAP FLAG ADDRESS
	POP	DX		;DE=GOUSUB ROUTINE ADDR
	POP	BX		;REMOVE RETURN AND HL=TEXT POINTER
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI
	POP	BX
EXTRN	GOSUB2:NEAR
	JMP	GOSUB2		;GOSUB TO ADDR IN DE, FLAG ADDR IN BC
				; AND TEXT PTR IN HL

	SUBTTL RESTORE, STOP, END
RESTORE:	XCHG	BX,DX	;SAVE [H,L] IN [D,E]
	MOV	BX,TXTTAB
	JZ	SHORT BGNRST	;RESTORE DATA POINTER TO BEGINNING OF PROGRAM
	XCHG	BX,DX		;TEXT POINTER BACK TO [H,L]
	CALL	LINGET		;GET THE FOLLOWING LINE NUMBER
	PUSH	BX		;SAVE TEXT POINTER
	CALL	FNDLIN		;FIND THE LINE NUMBER
	MOV	BX,CX		;GET POINTER TO LINE IN [H,L]
	POP	DX		;TEXT POINTER BACK TO [D,E]
	JNAE	SHORT ??L001
	JMP	USERR		;SHOULD HAVE FOUND LINE
??L001:
BGNRST:
	DEC	BX		;INITIALIZE DATPTR TO [TXTTAB]-1
RESFIN:	MOV	DATPTR,BX	;READ FINISHES COME TO RESFIN
	XCHG	BX,DX		;GET THE TEXT POINTER BACK
	RET	


STOP:	JZ	SHORT $+3
	RET			;RETURN IF NOT CONTROL-C AND MAKE
				;SURE "STOP" STATEMENTS HAVE A TERMINATOR
STOPRG:
	HLPEDT=PC8A
	INC	AL
	JMP	SHORT CONSTP
ENDST:	JZ	SHORT $+3
	RET			;MAKE SURE "END" STATEMENTS HAVE A TERMINATOR
	XOR	AL,AL		;clear ONEFLG to indicate that we aren't
	MOV	BYTE PTR ONEFLG,AL	;within an error-trapping routine
ENDS1:
	PUSHF			;PRESERVE CONDITION CODES OVER CALL TO CLSALL
	JNZ	SHORT ??L002
	CALL	CLSALL
??L002:
	POPF			;RESTORE CONDITION CODES
CONSTP:
	MOV	SAVTXT,BX	;SAVE FOR "CONTINUE"
	MOV	BX,OFFSET TEMPST	;RESET STRING TEMP POINTER
	MOV	TEMPPT,BX	;SAVE IN CASE ^C PRINT USING
	DB	273O	; SKIP	;"LXI H," OVER NEXT TWO
STPEND:	OR	AL,LOW 377O	;SET NON-ZERO TO FORCE PRINTING OF BREAK MESSAGE
	POP	CX		;POP OFF NEWSTT ADDRESS
ENDCON:	MOV	BX,CURLIN	;SAVE CURLIN
	PUSH	BX		;SAVE LINE TO PRINT
	PUSHF			;SAVE THE MESSAGE FLAG
				;ZERO MEANS DON'T PRINT "BREAK"
	MOV	AL,BL
	AND	AL,BH		;SEE IF IT WAS DIRECT
	INC	AL
	JZ	SHORT DIRIS	;IF NOT SET UP FOR CONTINUE
	MOV	OLDLIN,BX	;SAVE OLD LINE #
	MOV	BX,SAVTXT	;GET POINTER TO START OF STATEMENT
	MOV	OLDTXT,BX	;SAVE IT
DIRIS:
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	CNTOFL:WORD
DSEG	ENDS
	XOR	AL,AL
	MOV	BYTE PTR CNTOFL,AL	;FORCE OUTPUT
	EXTRN	FINLPT:NEAR
	CALL	FINLPT
	CALL	CRDONZ		;PRINT CR IF TTYPOS .NE. 0
	POPF			;GET BACK ^C FLAG
	MOV	BX,OFFSET BRKTXT	;"BREAK"
	JZ	SHORT ??L003
	JMP	ERRFIN		;CALL STROUT AND FALL INTO READY
??L003:
	JMP	STPRDY		;POP OFF LINE NUMBER & FALL INTO READY
;PAGE

	SUBTTL CTRLPT, DDT, CONT, NULL, TRON, TROFF

PUBLIC	CTROPT
CTROPT:	MOV	AL,LOW OFFSET CONTO	;PRINT AN ^O.
PUBLIC	CTRLPT
CTRLPT:	PUSH	AX		;SAVE CURRENT CHAR
	SUB	AL,LOW 3	;CONTROL-C?
	JNZ	SHORT NTCTCT	;NO
	MOV	BYTE PTR CNTOFL,AL	;RESET ^O FLAG
NTCTCT:
	MOV	AL,LOW "^"	;PRINT UP-ARROW.
	CALL	OUTDO		;SEND IT
	POP	AX		;GET BACK CONTROL CHAR.
	ADD	AL,LOW 100O	;MAKE PRINTABLE
	CALL	OUTDO		;SEND IT
	MOV	AL,LOW 377O	;MARK LINE AS NOT FOR INPUT
	CALL	OUTDO
	JMP	CRDO		;AND THEN SEND CRLF.



CONT:	MOV	BX,OLDTXT	;A STORED TEXT POINTER OF
				;ZERO IS SETUP BY STKINI
				;AND INDICATES THERE IS NOTHING
				;TO CONTINUE
	OR	BX,BX		;"STOP","END",TYPING CRLF
				;TO "INPUT" AND ^C SETUP OLDTXT
RESERR:	MOV	DX,OFFSET ERRCN	;"CAN'T CONTINUE"
	JNZ	SHORT ??L004
	JMP	ERROR
??L004:
	MOV	DX,OLDLIN
	MOV	CURLIN,DX	;SET UP OLD LINE # AS CURRENT LINE #
	RET	

DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	NULCNT:WORD
DSEG	ENDS
	PUBLIC	NULL
NULL:	CALL	GETBYT
	JZ	SHORT $+3
	RET			;MAKE SURE THERE IS A TERMINATOR
	INC	AL		;CODE AT CRDO EXPECTS AT LEAST 1
	MOV	BYTE PTR NULCNT,AL	;CHANGE NUMBER OF NULLS
	RET	

TON:	DB	270O	; SKIP	;"MVI A," NON-ZERO QUANTITY
TOFF:	XOR	AL,AL		;MAKE [A]=0 FOR NO TRACE
	MOV	BYTE PTR TRCFLG,AL	;UPDATE THE TRACE FLAG
	RET	
;PAGE

	SUBTTL SWAP, ERASE
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	SWPTMP:WORD
DSEG	ENDS
	PUBLIC	SWAP
SWAP:	CALL	PTRGET		;[D,E]=POINTER AT VALUE #1
	PUSH	DX		;SAVE THE POINTER AT VALUE #1
	PUSH	BX		;SAVE THE TEXT POINTER
	MOV	BX,OFFSET SWPTMP	;TEMPORARY STORE LOCATION
	CALL	VMOVE		;SWPTMP=VALUE #1
	MOV	BX,ARYTAB	;GET ARYTAB SO CHANGE CAN BE NOTED
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;GET THE TEXT POINTER BACK
				;AND SAVE CURRENT [ARYTAB]
	CALL	GETYPR
	PUSH	AX		;SAVE THE TYPE OF VALUE #1
	CALL	SYNCHR
	DB	OFFSET 44	;MAKE SURE THE VARIABLES ARE
				;DELIMITED BY A COMMA
	CALL	PTRGET		;[D,E]=POINTER AT VALUE #2
	POP	AX
	MOV	CH,AL		;[B]=TYPE OF VALUE #1
	CALL	GETYPR		;[A]=TYPE OF VALUE #2
	CMP	AL,CH		;MAKE SURE THEY ARE THE SAME
	JZ	SHORT ??L005
	JMP	TMERR		;IF NOT, "TYPE MISMATCH" ERROR
??L005:
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;[H,L]=OLD [ARYTAB] SAVE THE TEXT POINTER
	XCHG	BX,DX		;[D,E]=OLD [ARYTAB]
	PUSH	BX		;SAVE THE POINTER AT VALUE #2
	MOV	BX,ARYTAB	;GET NEW [ARYTAB]
	CMP	BX,DX
	JNZ	SHORT GFCERR	;IF ITS CHANGED, ERROR
	POP	DX		;[D,E]=POINTER AT VALUE #2
	POP	BX		;[H,L]=TEXT POINTER
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE THE TEXT POINTER ON THE STACK
				;[H,L]=POINTER AT VALUE #1
	PUSH	DX		;SAVE THE POINTER AT VALUE #2
	CALL	VMOVE		;TRANSFER VALUE #2 INTO VALUE #1'S OLD
				;POSITION
	POP	BX		;[H,L]=POINTER AT VALUE #2
	MOV	DX,OFFSET SWPTMP	;LOCATION OF VALUE #1
	CALL	VMOVE		;TRANSFER SWPTMP=VALUE #1 INTO VALUE #2'S
				;OLD POSITION
	POP	BX		;GET THE TEXT POINTER BACK
	RET	

GFCERR:	JMP	FCERR		;GIVE A FUNCTION CALL ERROR

	PUBLIC	ERASE
ERASE:
	MOV	AL,LOW 1
	MOV	BYTE PTR SUBFLG,AL	;THAT THIS IS "ERASE" CALLING PTRGET
	CALL	PTRGET		;GO FIND OUT WHERE TO ERASE
	JNZ	SHORT GFCERR	;PTRGET DID NOT FIND VARIABLE!
	PUSH	BX		;SAVE THE TEXT POINTER
	MOV	BYTE PTR SUBFLG,AL	;ZERO OUT SUBFLG TO RESET "ERASE" FLAG
	MOV	BH,CH		;[B,C]=START OF ARRAY TO ERASE
	MOV	BL,CL
	DEC	CX		;BACK UP TO THE FRONT
	DEC	CX		;NO VALUE TYPE WITHOUT LENGTH=2
	DEC	CX		;BACK UP ONE MORE
LPBKNM:	MOV	SI,CX
	MOV	AL,[SI]		;GET A CHARACTER. ONLY THE COUNT HAS HIGH BIT=0
	DEC	CX		;SO LOOP UNTIL WE SKIP OVER THE COUNT
	OR	AL,AL		;SKIP ALL THE EXTRA CHARACTERS
	JNS	SHORT ??L006
	JMP	LPBKNM
??L006:
	DEC	CX
	DEC	CX
	ADD	BX,DX		;[H,L]=THE END OF THIS ARRAY ENTRY
	XCHG	BX,DX		;[D,E]=END OF THIS ARRAY
	MOV	BX,STREND	;[H,L]=LAST LOCATION TO MOVE UP
ERSLOP:	CMP	BX,DX		;SEE IF THE LAST LOCATION IS GOING TO BE MOVED
	MOV	SI,DX
	MOV	AL,[SI]		;DO THE MOVE
	MOV	DI,CX
	STOSB
	LAHF
	INC	DX		;UPDATE THE POINTERS
	SAHF
	LAHF
	INC	CX
	SAHF
	JNZ	SHORT ERSLOP	;MOVE THE REST
	DEC	CX
	MOV	BX,CX		;SETUP THE NEW STORAGE END POINTER
	MOV	STREND,BX
	POP	BX		;GET BACK THE TEXT POINTER
	MOV	AL,BYTE PTR [BX]	;SEE IF MORE ERASURES NEEDED
	CMP	AL,LOW 54O	;ADDITIONAL VARIABLES DELIMITED BY COMMA
	JZ	SHORT $+3
	RET			;ALL DONE IF NOT
	CALL	CHRGTR
	JMP	SHORT ERASE


CASDON:
	PUBLIC	POPAHT
POPAHT:	POP	AX		; POP PSW
	XCHG	AL,AH
	SAHF
	POP	BX		;GET THE TEXT POINTER
	RET	
	PAGE	
;
;TEST FOR A LETTER / CARRY ON=NOT A LETTER
;                    CARRY OFF=A LETTER
;
ISLET:	MOV	AL,BYTE PTR [BX]
ISLET2:	CMP	AL,LOW "A"
	JNB	SHORT $+3
	RET			;IF LESS THAN "A", RETURN EARLY
	CMP	AL,LOW OFFSET "Z"+1
	CMC	
	RET	

;PAGE

	SUBTTL CLEAR
	PUBLIC	CLEAR

GCLERC:	JMP	CLEARC		;IFE LABEL  GO TO CLEARC

;Syntax: CLEAR [[a][,b [,c]]]
;
; a is a relic of pre-fiveo memory management and is ignored
; b is the highest memory location available to BASIC-80
; b is the the number of bytes in the data segment for BASIC-86
; c is the number of bytes to be used as stack space by BASIC
;
CLEAR:
	LAHF			; PUSH PSW
	XCHG	AL,AH
	PUSH	AX
	XCHG	AL,AH
	XOR	AL,AL		;Since FILTAB is reset below,
	MOV	BYTE PTR NLONLY,AL	; close all files - even file 0,
	CALL	CLSALL		; because of DYNAMIC FDB's
	POP	AX		; POP PSW
	XCHG	AL,AH
	SAHF
	JZ	SHORT GCLERC	;IF NO FORMULA JUST CLEAR
	CMP	AL,LOW 54O	;ALLOW NO STRING SPACE
	JZ	SHORT CSKPCM
	CALL	INTID2		;Get Dummy Integer Parameter into [D,E]
	DEC	BX
	CALL	CHRGTR		;SEE IF ITS THE END
	JZ	SHORT GCLERC
CSKPCM:	CALL	SYNCHR
	DB	OFFSET 54O
	JZ	SHORT GCLERC
	MOV	DX,TOPMEM	;Use current top of memory as default
	CMP	AL,LOW 54O
	JZ	SHORT CLEARS	;SHOULD FINISH THERE
	CALL	GETMPM		;GET MEMORY SIZE PARAMETER
	PUSH	BX		;save text pointer
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	MAXMEM:WORD
DSEG	ENDS
	MOV	BX,MAXMEM	;[HL]=highest byte available to BASIC
	CMP	BX,DX
	JAE	SHORT ??L007
	JMP	FCERR		;branch if user tried to get more
??L007:
	POP	BX		;restore text pointer
CLEARS:	DEC	BX		;BACK UP
	CALL	CHRGTR		;GET CHAR
	PUSH	DX		;SAVE NEW HIGH MEM
	JZ	SHORT CDFSTK	;USE SAME STACK SIZE
	CALL	SYNCHR
	DB	OFFSET 54O
	JZ	SHORT CDFSTK
	CALL	GETMPM		;GET STACK SIZE PARAMETER
	DEC	BX
	CALL	CHRGTR
	JZ	SHORT ??L008
	JMP	SNERR
??L008:
CLEART:	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI		;SAVE TEXT POINTER
	PUSH	BX		;SAVE CANDIDATE FOR TOPMEM
	MOV	BX,OFFSET (2*NUMLEV)+20	;CHECK STACK SIZE IS REASONABLE
	CMP	BX,DX
	JAE	SHORT GOMERR
	POP	BX		;[HL]=candidate for TOPMEM
	CALL	SUBDE		;DE=HL-DE=High Ram - Stack Size=new stack bottom
	JB	SHORT GOMERR	;WANTED MORE THAN TOTAL!
	PUSH	BX		;SAVE STACK BOTTOM
	MOV	BX,VARTAB	;TOP LOCATION IN USE
	MOV	CX,20		;LEAVE BREATHING ROOM
	ADD	BX,CX
	CMP	BX,DX		;ROOM?
	JAE	SHORT GOMERR	;NO, DON'T EVEN CLEAR
	XCHG	BX,DX		;NEW STACK BASE IN [H,L]
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	FILTAB:WORD,STKLOW:WORD
DSEG	ENDS
	MOV	STKLOW,BX	;set bottom of stack limit
	MOV	FILTAB,BX	;set FDB chain base (No files are open)
	DEC	BX
	MOV	BYTE PTR [BX],LOW 0	;set string terminator so VAL$ will always work
	DEC	BX
	MOV	MEMSIZ,BX	;SET UP NEW STACK BOTTOM
	POP	BX		;HL=Highest Ram available to BASIC
	MOV	TOPMEM,BX	;SAVE IT, IT MUST BE OK
	POP	BX		;REGAIN THE TEXT POINTER
	JMP	GCLERC		;GO CLEAR

GETMPM:	CALL	FRMQNT		;EVALUATE FORMULA
	OR	DX,DX		;Memory size =0?
	JNZ	SHORT ??L009
	JMP	FCERR		;Yes, error
??L009:
	RET	

GOMERR:	JMP	OMERR		;GIVE OM ERROR

;CLEAR Default Stack Size to current stack size
;
CDFSTK:
	MOV	DX,TOPMEM	;FIGURE OUT CURRENT STACK SIZE
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	STKLOW:WORD
DSEG	ENDS
	INS86	53,26,STKLOW	;SUB DX,STKLOW
	JMP	SHORT CLEART

	PAGE	
; [D,E]=[H,L]-[D,E]
	PUBLIC	SUBDE
SUBDE:
	INS86	213,303		;MOV AX,BX
	INS86	53,302		;SUB AX,DX
	INS86	213,320		;MOV DX,AX
	RET	
;PAGE


	PAGE	

	PUBLIC	ISFLIO
DSEG	SEGMENT PUBLIC 'DATASG'
	EXTRN	PTRFIL:WORD
DSEG	ENDS
ISFLIO:
	PUSH	BX		;SAVE [H,L]
	MOV	BX,PTRFIL	;GET FILE POINTER
	OR	BX,BX		;NO ZERO?
	POP	BX		;RESTORE [H,L]
	RET	

;EXTERNAL DECLARATIONS REQUIRED FOR LABELSTUFF
; INTERNAL DECLARATIONS REQUIRED
;
;ALL THIS STUFF HAS BEEN ADDED FOR LABELS
;IF LABELS ARE REQUIRED  LABEL SWITCH SHLOULD BE ON
;;;
;
;
;CHKLBL ROUTINE CHECKS WHETHER THE LABEL IS ALREADY PRESENT IN THE SYMBOL TABLE
;HL=POINTER TO LABEL
;B=LABEL LENGTH
;DE IS SET TO THE WORD WHICH CONTAINS THE POINTER TO THE STMNT IN CASE THERE IS MATCH
;Z IS SET INCASE MATCH
;HL AND B ARE PRESERVED
CSEG	ENDS
	END