IBMRES.ASM

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

	.RADIX  8		; To be safe

CSEG	SEGMENT PUBLIC 'CODESG' 
	ASSUME  CS:CSEG

INCLUDE	IBMRES.H 

	SUBTTL  Equates and External Declarations
	TITLE   IBMRES - IBM compatible reserved words / MLC
COMMENT	*

--------- --- ---- -- ---------
COPYRIGHT (C) 1982 BY MICROSOFT
--------- --- ---- -- ---------

This module is used to create GW-BASICs with IBM PC compatible
reserved word tokens.  The reserved word tables were created by
cleaning up a copy of the tables from BINTRP.  The code and tables
to handle the extended reserved words was taken from L2RESS.MAC and
modified as necessary.
	*

GWLEV2=0			;GW BASIC version 2.0 features

	.SALL
	.RADIX	10


	PUBLIC	$KEY2B,$COM2B,$PEN2B,$STR2B
	EXTRN	CHRGTR:NEAR
	EXTRN	DATEF:NEAR
	EXTRN	LABBCK:NEAR
	EXTRN	MAKUPL:NEAR
	EXTRN	NOTRFN:NEAR
	EXTRN	PARCHK:NEAR,PENS:NEAR,PLOOP2:NEAR,PPSWRT:NEAR
	EXTRN	RENCRN:NEAR
	EXTRN	STRIGS:NEAR
	EXTRN	TIMEF:NEAR,TSTANM:NEAR

DSEG	SEGMENT PUBLIC 'DATASG'
	ASSUME DS:DSEG
	EXTRN	FLGOVC:WORD,TEMPA:WORD
DSEG	ENDS



;
; THESE MACRO CALLS DEFINE THE RESWRD VALUES
; AND THE TABLE DISPATCH FOR STATEMENTS AND FUNCTIONS
;
; STATEMENTS:
;

PUBLIC	STMDSP
STMDSP:				;MARKS START OF STATEMENT LIST
	QQ=128
	R2	END,ENDST
	R	FOR
	R	NEXT
	R2	DATA,DATAS
	R	INPUT
	R	DIM
	R	READ
	R	LET
	R	GOTO
	R	RUN
	R2	IF,IFS
	R	RESTORE
	R	GOSUB
	R	RETURN
	R	REM
	R	STOP
	R	PRINT
	R	CLEAR
	R	LIST
	R2	NEW,SCRATH
	R2	ON,ONGOTO
	R2	WAIT,FNWAIT
	R	DEF
	R	POKE
	R	CONT
	R2	DUMMY,SNERR	;padding
	R2	DUMMY,SNERR	;padding
	R2	OUT,FNOUT
	R	LPRINT
	R	LLIST
	R2	DUMMY,SNERR	;padding
	R2	WIDTH,WIDTHS
	R2	ELSE,ELSES
	R2	TRON,TON
	R2	TROFF,TOFF
	R	SWAP
	R	ERASE
	R	EDIT
	R2	ERROR,ERRORS
	R	RESUME
	R	DELETE
	R	AUTO
	R2	RENUM,RESEQ
	R	DEFSTR
	R	DEFINT
	R2	DEFSNG,DEFREA
	R	DEFDBL
	R	LINE
	R	WHILE
	R	WEND
	R2	CALL,CALLS
	R2	DUMMY,SNERR	;padding
	R2	DUMMY,SNERR	;padding
	R2	DUMMY,SNERR	;padding
	R	WRITE
	R	OPTION
	R2	RANDOMIZE,RANDOM
	R	OPEN
	R	CLOSE
	R	LOAD
	R	MERGE
	R	SAVE
	R	COLOR
	R	CLS
	R	MOTOR
	R	BSAVE
	R	BLOAD
	R2	SOUND,SOUNDS
	R2	BEEP,BEEPS
	R	PSET
	R	PRESET
	R	SCREEN
	R2	KEY,KEYS
	$KEY2B=0+QQ		;value of KEY 2-byte token
	R	LOCATE

PUBLIC	NUMCMD
	NUMCMD=QQ-$END+1

;
; TOKENS
;

;
;QQ MUST BE SET SO TOKENS START AT RIGHT PLACE
;

	QQ=QQ+1

	T	TO
	T	THEN
PUBLIC	THENTK
	THENTK=QQ
	T	TAB
PUBLIC	TABTK
	TABTK=QQ
	T	STEP
PUBLIC	STEPTK
	STEPTK=QQ
	T	USR
PUBLIC	USRTK
	USRTK=QQ
	T	FN
PUBLIC	FNTK
	FNTK=QQ
	T	SPC
PUBLIC	SPCTK
	SPCTK=QQ
	T	NOT
PUBLIC	NOTTK
	NOTTK=QQ
	T	ERL
PUBLIC	ERLTK
	ERLTK=QQ
	T	ERR
PUBLIC	ERCTK
	ERCTK=QQ
	T	STRING$
	T	USING
PUBLIC	USINTK
	USINTK=QQ
	T	INSTRC
PUBLIC	INSRTK
	INSRTK=QQ
	T	DUMMY
PUBLIC	SNGQTK
	SNGQTK=QQ
	T	VARPTR
	T	CSRLIN
PUBLIC	CLINTK
	CLINTK=QQ
	T	POINT
	T	OFF
	T	INKEY$

;
; OPERATORS
;

	QQ=QQ+7

	T	DUMMY
PUBLIC	GREATK
	GREATK=QQ
	T	DUMMY
PUBLIC	EQULTK
	EQULTK=QQ
	T	DUMMY
PUBLIC	LESSTK
	LESSTK=QQ
	T	DUMMY
PUBLIC	PLUSTK
	PLUSTK=QQ
	T	DUMMY
PUBLIC	MINUTK
	MINUTK=QQ
	T	DUMMY
PUBLIC	MULTK
	MULTK=QQ
	T	DUMMY
PUBLIC	DIVTK
	DIVTK=QQ
	T	DUMMY
PUBLIC	EXPTK
	EXPTK=QQ
	T	AND
	T	OR
	T	XOR
	T	EQV
	T	IMP
	T	MOD
	T	DUMMY
PUBLIC	IDIVTK
	IDIVTK=QQ
PUBLIC	LSTOPK
	LSTOPK=QQ+1-PLUSTK

;
; FUNCTIONS - 2 byte tokens, the 1st byte is FF
;

	QQ=128
PUBLIC	FUNDSP
FUNDSP:
	R	LEFT$
PUBLIC	ONEFUN
	ONEFUN=QQ
	R	RIGHT$
	R	MID$
PUBLIC	MIDTK
	MIDTK=QQ
	R	SGN
	R2	INT,VINT
	R2	ABS,ABSFN
	R	SQR
PUBLIC	SQRTK
	SQRTK=QQ
	R	RND
	R	SIN
	R	LOG
	R	EXP
	R	COS
	R	TAN
	R	ATN
PUBLIC	ATNTK
	ATNTK=QQ
	R	FRE
	R2	INP,FNINP
	R	POS
	R	LEN
	R	STR$
	R	VAL
	R	ASC
	R	CHR$
	R	PEEK
	R	SPACE$
	R2	OCT$,STRO$
	R2	HEX$,STRH$
	R	LPOS
PUBLIC	LASNUM
	LASNUM=QQ
	R2	CINT,FRCINT
	R2	CSNG,FRCSNG
	R2	CDBL,FRCDBL
	R2	DUMMY,FIXER
PUBLIC	$FIX
	$FIX=QQ
	R2	PEN,PENF
	$PEN2B=0+(400O*377O)+QQ	;value of PEN 2-byte token
	R2	STICK,STICKF
	R2	STRIG,STRIGF
	$STR2B=0+(400O*377O)+QQ	;value of STRIG 2-byte token
	R	EOF
	R	LOC
	R	LOF

;
; THE FOLLOWING TABLES ARE THE ALPHABETIC DISPATCH TABLE
; FOLLOWED BY THE RESERVED WORD TABLE ITSELF
;
PUBLIC	ALPTAB
ALPTAB:

	DW	OFFSET ATAB
	DW	OFFSET BTAB
	DW	OFFSET CTAB
	DW	OFFSET DTAB
	DW	OFFSET ETAB
	DW	OFFSET FTAB
	DW	OFFSET GTAB
	DW	OFFSET HTAB
	DW	OFFSET ITAB
	DW	OFFSET JTAB
	DW	OFFSET KTAB
	DW	OFFSET LTAB
	DW	OFFSET MTAB
	DW	OFFSET NTAB
	DW	OFFSET OTAB
	DW	OFFSET PTAB
	DW	OFFSET QTAB
	DW	OFFSET RTAB
	DW	OFFSET STAB
	DW	OFFSET TTAB
	DW	OFFSET UTAB
	DW	OFFSET VTAB
	DW	OFFSET WTAB
	DW	OFFSET XTAB
	DW	OFFSET YTAB
	DW	OFFSET ZTAB


PUBLIC	RESLST
RESLST:

ATAB:
	Q	AUTO
	Q	AND
	QF	ABS
	QF	ATN
	QF	ASC
	DB	0
BTAB:
	Q	BSAVE
	Q	BLOAD
	Q	BEEP
	DB	0
CTAB:
	Q	COLOR
	Q	CLOSE
	Q	CONT
	Q	CLEAR
	Q	CSRLIN
	QF	CINT
	QF	CSNG
	QF	CDBL
	QF	COS
	QF	CHR$
	Q	CALL
	Q	CLS
	DB	0
DTAB:
	Q	DELETE
	Q	DATA
	Q	DIM
	Q	DEFSTR
	Q	DEFINT
	Q	DEFSNG
	Q	DEFDBL
	Q	DEF
	DB	0
ETAB:
	Q	ELSE
	Q	END
	Q	ERASE
	Q	EDIT
	Q	ERROR
	Q	ERL
	Q	ERR
	QF	EXP
	QF	EOF
	Q	EQV
	DB	0
FTAB:
	Q	FOR
	Q	FN
	QF	FRE
	QF	FIX
	DB	0
GTAB:
	Q	GOTO
	DB	"O"
	DB	" "
	DB	"T"
	DB	"O"+128D
	DB	OFFSET $GOTO
	Q	GOSUB
	DB	0
HTAB:
	QF	HEX$
	DB	0
ITAB:
	Q	INPUT
	Q	IF
	Q	INSTRC
	QF	INT
	QF	INP
	Q	IMP
	Q	INKEY$
	DB	0
JTAB:
	DB	0
KTAB:
	Q	KEY
	DB	0
LTAB:
	Q	LOCATE
	Q	LPRINT
	Q	LLIST
	QF	LPOS
	Q	LET
	Q	LINE
	Q	LOAD
	Q	LIST
	QF	LOG
	QF	LOC
	QF	LEN
	QF	LEFT$
	QF	LOF
	DB	0
MTAB:
	Q	MOTOR
	Q	MERGE
	Q	MOD
	QF	MID$
	DB	0
NTAB:
	Q	NEXT
	Q	NEW
	Q	NOT
	DB	0
OTAB:
	Q	OPEN
	Q	OUT
	Q	ON
	Q	OR
	QF	OCT$
	Q	OPTION
	Q	OFF
	DB	0
PTAB:
	Q	PRINT
	Q	POKE
	QF	POS
	QF	PEEK
	Q	PSET
	Q	PRESET
	Q	POINT
	QF	PEN
	DB	0
QTAB:
	DB	0
RTAB:
	Q	RUN
	Q	RETURN
	Q	READ
	Q	RESTORE
	Q	REM
	Q	RESUME
	QF	RIGHT$
	QF	RND
	Q	RENUM
	Q	RANDOMIZE
	DB	0
STAB:
	Q	SCREEN
	Q	STOP
	Q	SWAP
	Q	SAVE
	DB	"P"
	DB	"C"
	DB	"("+128D
	DB	OFFSET SPCTK
	Q	STEP
	QF	SGN
	QF	SQR
	QF	SIN
	QF	STR$
	Q	STRING$
	QF	SPACE$
	Q	SOUND
	QF	STICK
	QF	STRIG
	DB	0
TTAB:
	Q	THEN
	Q	TRON
	Q	TROFF
	DB	"A"
	DB	"B"
	DB	"("+128D
	DB	OFFSET TABTK
	Q	TO
	QF	TAN
	DB	0
UTAB:
	Q	USING
	Q	USR
	DB	0
VTAB:
	QF	VAL
	Q	VARPTR
	DB	0
WTAB:
	Q	WIDTH
	Q	WAIT
	Q	WHILE
	Q	WEND
	Q	WRITE
	DB	0
XTAB:
	Q	XOR
	DB	0
YTAB:
	DB	0
ZTAB:
	DB	0

PUBLIC	SPCTAB
SPCTAB:
	DB	"+"+128D
	DB	OFFSET PLUSTK
	DB	"-"+128D
	DB	OFFSET MINUTK
	DB	"*"+128D
	DB	OFFSET MULTK
	DB	"/"+128D
	DB	OFFSET DIVTK
	DB	"^"+128D
	DB	OFFSET EXPTK
	DB	"\"+128D
	DB	OFFSET IDIVTK
	DB	"'"+128D
	DB	OFFSET SNGQTK
	DB	62+128D
	DB	OFFSET GREATK
	DB	"="+128D
	DB	OFFSET EQULTK
	DB	60+128D
	DB	OFFSET LESSTK
	DB	0

	SUBTTL  Extended reserved words
;The following are 2 byte tokens, the 1st byte is FE

	QQ=128D
STMDSX:
	R	FILES
	R	FIELD
	R	SYSTEM
	R	NAME
	R	LSET
	R	RSET
	R	KILL
	R	PUT
	R	GET
	R	RESET
	R	COMMON
	R	CHAIN
	R2	DATE$,DATES
	R2	TIME$,TIMES
	R	PAINT
	R2	COM,COMS
	$COM2B=0+(400O*376O)+QQ	;value of COM 2-byte token
	R	CIRCLE
	R	DRAW
	R2	PLAY,PLAYS
	R	TIMER
	R	ERDEV
	R	IOCTL
	R	CHDIR
	R	MKDIR
	R	RMDIR
	R	SHELL
	R	ENVIRON
	R	VIEW
	R	WINDOW
	R	PMAP
	R2	PALETTE,PALETE
	R2	LCOPY,LCOPYS
	R2	CALLS,CALLSL
;*************************************************************************
;*** The DEBUG entry should be the last entry in the FE Dispatch table ***
;*************************************************************************


	PAGE	
;The following are 2 byte tokens, the 1st byte is FD

	QQ=128D
FUNDSX:
	R	CVI
	R	CVS
	R	CVD
	R	MKI$
	R	MKS$
	R	MKD$
	R2	KTN,KTNFN
	R2	JIS,JISFN
	R2	KPOS,KPOSFN
	R2	KLEN,KLENFN

	PAGE	
PUBLIC	ALPTAX
ALPTAX:
	ADR	ATABX
	ADR	BTABX
	ADR	CTABX
	ADR	DTABX
	ADR	ETABX
	ADR	FTABX
	ADR	GTABX
	ADR	HTABX
	ADR	ITABX
	ADR	JTABX
	ADR	KTABX
	ADR	LTABX
	ADR	MTABX
	ADR	NTABX
	ADR	OTABX
	ADR	PTABX
	ADR	QTABX
	ADR	RTABX
	ADR	STABX
	ADR	TTABX
	ADR	UTABX
	ADR	VTABX
	ADR	WTABX
	ADR	XTABX
	ADR	YTABX
	ADR	ZTABX

	PAGE	
RESLSX:

ATABX:
	DB	0
BTABX:
	DB	0
CTABX:
	Q	CHAIN
	QF	CVI
	QF	CVS
	QF	CVD
	Q	COMMON
	Q	COM
	Q	CIRCLE
	Q	CALLS
	DB	0
DTABX:
	Q	DATE$
	Q	DRAW
	DB	0
ETABX:
	DB	0
FTABX:
	Q	FIELD
	Q	FILES
	DB	0
GTABX:
	Q	GET
	DB	0
HTABX:
	DB	0
ITABX:
	Q	IOCTL
	DB	0
JTABX:
	DB	0
KTABX:
	Q	KILL
	DB	0
LTABX:
	Q	LSET
	Q	LCOPY
	DB	0
MTABX:
	QF	MKI$
	QF	MKS$
	QF	MKD$
	DB	0
NTABX:
	Q	NAME
	DB	0
OTABX:
	DB	0
PTABX:
	Q	PUT
	Q	PAINT
	Q	PLAY
	DB	0
QTABX:
	DB	0
RTABX:
	Q	RSET
	Q	RESET
	DB	0
STABX:
	Q	SYSTEM
	DB	0
TTABX:
	Q	TIME$
	DB	0
UTABX:
	DB	0
VTABX:
	DB	0
WTABX:
	DB	0
XTABX:
	DB	0
YTABX:
	DB	0
ZTABX:
	DB	0

	PUBLIC	NUMGFN,BOTCON,TOPCON,$RNDFN,$DATCO,$REMCO,NMREL
	PUBLIC	$CHRFN,$CSNGF,$CDBLF
	NUMGFN=(2*MIDTK)-(2*ONEFUN)+1
	BOTCON=(SQRTK-ONEFUN)*2
	TOPCON=(ATNTK-ONEFUN)*2+1
	$RNDFN=$RND-ONEFUN
	$DATCO=$DATA-":"
	$REMCO=$REM-":"
	NMREL=LESSTK-GREATK+1
	$CHRFN=$CHR$-ONEFUN
	$CSNGF=$CSNG-ONEFUN
	$CDBLF=$CDBL-ONEFUN


	SUBTTL  CRUNCH code to handle extended reserved words

PUBLIC	CRUNCX
CRUNCX:	POP	BX		;GET BACK SOURCE POINTER
	PUSH	BX		;TO TRY AGAIN
	DEC	BX		;POINT AT CHARACTER
	CALL	MAKUPL		;CONVERT TO UPPER CASE
	MOV	BX,OFFSET ALPTAX	;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
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 ??L000
	JMP	NOTRFN		;IF=0 THEN END OF THIS CHARS RESLT
??L000:
	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 ??L001
	JMP	LOPPSI		;SEE IF REST OF CHARS MATCH
??L001:
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	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 ??L002
	JMP	NOTRFN		;IF ALPHA, CANT BE RESERVED WORD
??L002:
	POP	AX		;GET RID OF SAVED [H,L]
	INS86	213,362,56,254	;FETCH FROM CODE SEGMENT
	OR	AL,AL		;SET CC'S
	POP	CX		;GET CHAR COUNT OFF STACK
	POP	DX		;GET DEPOSIT POINTER OFF STACK
	JNS	SHORT ??L003
	JMP	NOTFNT		;IF MINUS, WASNT FUNCTION TOKEN
??L003:
	OR	AL,LOW 200O	;MAKE HIGH ORDER BIT ONE
	STC			;AND FORCE LEADER BYTE TO BE 375
NOTFNT:	PUSH	AX		;SAVE FN CHAR
	MOV	AL,LOW 376O	;GET BYTE WHICH PRECEEDS FNS
	SBB	AL,LOW 0	;MAKE FUNCTION LEADER 375
	JMP	RENCRN		;REENTER CRUNCH WITH NEW RESERVED WORD

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 ??L004
	JMP	LOPSK2		;NOT END OF RESWRD, KEEP SKIPPING
??L004:
	INC	DX		;POINT AFTER TOKEN
	JMP	TRYAGA		;TRY ANOTHER RESWRD

	SUBTTL  LIST code for extended reserved words

BUFRET:	RET	

NEWFUN:	MOV	AL,BYTE PTR [BX]	;GET FUNCTION NUMBER
	AND	AL,LOW 177O	;TAKE OFF HIGH BIT
	JMP	SHORT BUFCON

PUBLIC	LISTX
LISTX:	CMP	AL,LOW 375O	;IS IT A NEW FUNCTION
	JZ	SHORT NEWFUN
	CMP	AL,LOW 376O	;IS IT A NEW STATEMENT
	JNZ	SHORT BUFRET	;NO, JUST CONTINUE NORMAL PATH
	MOV	AL,BYTE PTR [BX]	;GET NUMBER OF STATEMENT
BUFCON:	POP	BX		;Get rid of the return address.
	MOV	BX,OFFSET RESLSX-1	;GET PTR TO START OF RESERVED WORD LIST
	MOV	CH,AL		;SAVE THIS CHAR IN [B]
	MOV	CL,LOW OFFSET "A"-1	;INIT LEADING CHAR VALUE
RESSR3:	INC	CL		;BUMP LEADING CHAR VALUE.
RESSR1:	INC	BX		;BUMP POINTER INTO RESLST
RESSRC:	MOV	DH,BH		;SAVE PTR TO START OF THIS RESWRD
	MOV	DL,BL
RESSR2:
	INS86	56		;FETCH FROM CODE SEGMENT
	MOV	AL,BYTE PTR [BX]	;GET CHAR FROM RESLST
	OR	AL,AL		;SET CC'S
	JZ	SHORT RESSR3	;IF END OF THIS CHARS TABLE,
				;GO BACK & BUMP C
	LAHF
	INC	BX		;BUMP SOURCE PTR
	SAHF
	JS	SHORT ??L005
	JMP	RESSR2		;IF NOT END OF THIS RESWRD,
??L005:
				;THEN KEEP LOOKING
	INS86	56		;FETCH FROM CODE SEGMENT
	MOV	AL,BYTE PTR [BX]	;GET PTR TO RESERVED WORD VALUE
	CMP	AL,CH		;SAME AS THE ONE WE SEARCH FOR?
	JNZ	SHORT RESSR1	;NO, KEEP LOOKING.
	XCHG	BX,DX		;SAVE FOUND PTR IN [H,L]
	MOV	AL,CL		;GET LEADING CHAR
	POP	DX		;RESTORE LINE CHAR COUNT
	POP	CX		;RESTORE DEPOSIT PTR
	MOV	DL,AL		;SAVE LEADING CHAR IN [E]
;
; CODE BELOW NOT NEEDED SINCE NO SPECIAL REVERVED WORDS IN HOOK TABLE
;
;       CPI     "Z"+1           ;WAS IT A SPECIAL CHAR?
;       JRNZ    NTSPCH          ;NON-SPECIAL CHAR
;       XRA     A               ;SET NON-SPECIAL
;       STA     TEMPA
;       JMPR    MORPUR          ;PRINT IT
NTSPCH:	MOV	AL,BYTE PTR TEMPA	;WHAT DID WE DO LAST?
	OR	AL,AL		;SPECIAL?
	MOV	AL,LOW 255	;FLAG IN RESERVED WORD
	MOV	BYTE PTR TEMPA,AL	;CLEAR FLAG
MORLNZ:	JZ	SHORT MORLN0	;GET CHAR AND PROCEED
	MOV	AL,LOW " "	;PUT SPACE IN BUFFER
	MOV	DI,CX
	STOSB
	INC	CX
	DEC	DH		;ANY SPACE LEFT IN BUFFER
	JNZ	SHORT ??L006
	JMP	PPSWRT		;NO, RETURN
??L006:
MORLN0:	MOV	AL,DL
	JMP	SHORT MORLN1	;CONTINUE
MORPUR:
	INS86	56		;FETCH FROM CODE SEGMENT
	MOV	AL,BYTE PTR [BX]	;GET BYTE FROM RESWRD
	INC	BX		;BUMP POINTER
MORLNP:	MOV	DL,AL		;SAVE CHAR
MORLN1:	AND	AL,LOW 177O	;AND OFF HIGH ORDER BIT FOR DISK & EDIT
	MOV	DI,CX
	STOSB			;STORE THIS CHAR
	INC	CX		;BUMP PTR
	DEC	DH		;BUMP DOWN REMAINING CHAR COUNT
	JNZ	SHORT ??L007
	JMP	PPSWRT		;IF END OF LINE, JUST RETURN
??L007:
	OR	AL,DL		;SET CC'S
	JS	SHORT ??L008
	JMP	MORPUR		;END OF RESWRD?
??L008:
	POP	BX		;RESTORE SOURCE PTR.
	INC	BX		;SKIP OVER RESERVED WORD
	JMP	PLOOP2		;GET NEXT CHAR FROM LINE

	SUBTTL  Extended Statement Dispatching

SNERRS:	JMP	SNERR

PUBLIC	NEWSTX
NEWSTX:	CMP	AL,LOW OFFSET 376O-201O	;CHECK FOR NEW STATEMENT PREFIX
	JZ	SHORT GONE4	;IF SO, DISPATCH
	CMP	AL,LOW OFFSET 377O-201O	;FUNCTION?
	JNZ	SHORT GIIRET
	POP	CX		;Put return address into B.
	INC	BX
	MOV	AL,BYTE PTR [BX]
	CMP	AL,LOW OFFSET $PEN	; PEN as stmt?
	JNZ	SHORT ??L009
	JMP	PENV		; Brif so.
??L009:
	CMP	AL,LOW OFFSET $STRIG	;STRIG as stmt?
	JNZ	SHORT ??L010
	JMP	STRIGV		; Brif so.
??L010:
	DEC	BX
	MOV	AL,LOW OFFSET 377O-201O
	PUSH	CX		;Put the return address back on.
GIIRET:	RET			;MID$ OR SYNTAX ERROR

PENV:	CALL	CHRGTR
	JMP	PENS
STRIGV:	CALL	CHRGTR
	JMP	STRIGS


GONE4:	POP	CX		;Get rid of the return address.
	INC	BX		;LOOK AT NEXT CHAR
	MOV	AL,BYTE PTR [BX]	;FETCH IT
	SUB	AL,LOW 201O	;GET RELATIVE POSITION IN STMDSX
	JB	SHORT SNERRS	;IF TOO SMALL, SYNTAX ERROR
	ADD	AL,AL		;TURN BYTE INTO OFFSET
	INS86	62,344		;XOR AH,AH
	INS86	213,360		;MOV SI,AX - GET OFFSET INTO [SI]
	INS86	56		;CODE SEGMENT OVERRIDE
	INS86	377,264,STMDSX	;PUSH STMDSP(SI) - PUSH ADDRESS
	JMP	CHRGTR		;START STATEMENT

	SUBTTL  EVAL code for extended functions

PUBLIC	EVALX
EVALX:	CMP	AL,LOW 376O
	JZ	SHORT EVALNS	;Brif possible stmt as function
	CMP	AL,LOW 375O
	JZ	SHORT EVALNF	;NEW FUNCTION IF 375 IN FRONT
	RET	

EVALNS:	INC	BX
	MOV	AL,BYTE PTR [BX]
	CMP	AL,LOW OFFSET $DATE$
	JZ	SHORT DATEV	;Brif DATE$
	CMP	AL,LOW OFFSET $TIME$
	JZ	SHORT TIMEV	;Brif TIME$
	DEC	BX
	MOV	AL,BYTE PTR [BX]
	RET	

DATEV:	POP	CX		;Get rid of the hook return address.
	JMP	DATEF		;Do DATE function.

TIMEV:	POP	CX		;Get rid of the hook return address.
	JMP	TIMEF		;Do TIME$ function.

EVALNF:	POP	CX		;Get rid of the return address.
	INC	BX
	MOV	AL,BYTE PTR [BX]
	SUB	AL,LOW 201O
	MOV	CH,LOW 0
	ROL	AL,1
	MOV	CL,AL
	PUSH	CX
	CALL	CHRGTR
	CALL	PARCHK
	POP	SI		;XTHL
	XCHG	SI,BX
	PUSH	SI
	MOV	DX,OFFSET LABBCK
	PUSH	DX
	MOV	AL,LOW 1
	MOV	BYTE PTR FLGOVC,AL
	INS86	213,363		;MOV SI,BX (GET FUNCTION OFFSET IN SI)
	INS86	56
	INS86	377,264,FUNDSX
	RET	


CSEG	ENDS
	END