TP3/Resources/turbopascal3source/TP3/TPSRC10

	CALL	upcase	;UpCase
	OR.B	AL,AL	;0 ?
	CALL	perrz	;yes:
	B	$37	;55:String constant exceeds line
	XOR	AL,#$40	;make it a control char
	INC	DI	;next char
icssto2	MOV.B	[BX],AL	;store in buffer
	INC	BX
	INC.B	CH	;count length
	JMP	icsloop	;'get next element
icsnum	INC	DI	;read #char
	PUSH	BX	;save dest ptr, counter
	PUSH	CX
	MOV	BX,DI	;pos of number
	CALL	asccard	;read integer
	MOV	DI,BX	;set new position
	POP	CX	;restore
	POP	BX
	CALL	perrb	;error:
	B	$38	;56:Error in int constant
	JMP	icssto2	;'store it, continue
icsend	MOV	CL,#$08	;string
	CMP.B	CH,#$01	;length = 1 ?
	JNZ	icend	;:no
	MOV.B	BL,wordbuf	;get char
	XOR.B	BH,BH	;clear high byte
	MOV	CL,#$0C	;char
icend	JMP	skipdi	;'get next word
icnum	MOV	BX,DI	;numeric constant: beg pos
	CMP	AL,#$24	;$ ?
	JZ	icnint	;yes: integer constant
	CALL	number	;char in 0..9 ?
	JNB	icnscan	;:yes
	XOR	AX,AX	;set flag: invalid
	DEC	AX
	RET		;'
icnscan	INC	DI	;next char
	MOV.B	AL,[DI]	;get it
	CALL	number	;in 0..9 ?
	JNB	icnscan	;yes: loop
	CALL	upcase	;UpCase
	CMP	AL,#$45	;E ?
	JZ	icnreal	;yes: real constant
	CMP	AL,#$2E	;. ?
	JNZ	icnint	;no: integer constant
	INC	DI	;test next char: .. ?
	MOV.B	AL,[DI]
	CMP	AL,#$2E	;. ?
	JZ	icnint	;:yes, integer constant
	CMP	AL,#$29	;) ? (.) = ])
	JZ	icnint	;yes: integer constant
icnreal	MOV	DI,#creal1	;dest buffer
	CALL	ascreal2	;read real number
	MOV	DI,BX	;set new position
	CALL	perrb	;error:
	B	$39	;57:Error in real const
	MOV	CL,#$09	;real
	JMP	icend	;'end it
icnint	CALL	asccard	;read integer const
	MOV	DI,BX	;set new pos
	MOV	BX,AX	;get result
	CALL	perrb	;ok ? no:
	B	$38	;56:Error in integer constant
	MOV	CL,#$0A	;integer
	JMP	icend	;"end it
ecode	PUSH	AX	;Emit inline code
	PUSH	BP	;(stored as inline string)
	MOV	BP,SP	;stack frame
	XCHG	BX,[BP]$04	;get return addr
	CS:	
	MOV.B	AH,[BX]	;get length
	INC	BX	;next byte
ecodelp	CS:		;get byte
	MOV.B	AL,[BX]
	CALL	ebyte	;emit it
	INC	BX	;next one
	DEC.B	AH
	JNZ	ecodelp	;:another
	XCHG	BX,[BP]$04	;restore ret, BX
	POP	BP	;restore
	POP	AX
	RET		;"
estring	MOV.B	AL,CH	;Emit string, CH=length
	CALL	ebyte	;emit length
estr2	MOV	BX,#wordbuf	;buffer ptr
estrlp	OR.B	CH,CH	;test length
	JZ	estrret	;:null string
	MOV.B	AL,[BX]	;get char
	CALL	ebyte	;emit it
	INC	BX	;next one
	DEC.B	CH
	JMP	estrlp	;'
estrret	RET		;"
epushax	CALL	ecode	;* PUSH AX
	B	$01,$50
	RET		;"
epopax	CALL	ecode	;* POP AX
	B	$01,$58
	RET		;"
epushdi	CALL	ecode	;* PUSH DI
	B	$01,$57
	RET		;"
emovaxi	CALL	ecode	;* MOV AX,#..
	B	$01,$B8
	JMP.b	eword	;"emit immediate value in AX
	CALL	ecode	;* MOV BX,#..
	B	$01,$BB
	JMP.b	eword	;"emit immediate
emovcxi	CALL	ecode	;* MOV CX,#..
	B	$01,$B9
	JMP.b	eword	;"emit immediate
emovdxi	CALL	ecode	;* MOV DX,#..
	B	$01,$BA
	JMP.b	eword	;"emit immediate
emovdii	CALL	ecode	;* MOV DI,#..
	B	$01,$BF
	JMP.b	eword	;"emit immediate
ecall	CALL	ecode	;* CALL ..
	B	$01,$E8
	JMP.b	ejmp2	;'emit offset
ejump	CALL	ecode	;* JMP ..
	B	$01,$E9
ejmp2	SUB	AX,pc	;dest-PC-2 -> offset
	DEC	AX
	DEC	AX
	JMP.b	eword	;"emit offset word
emitdx	MOV	AX,DX	;emit DX
eword	CALL	ebyte	;emit AX
	PUSH	AX	;save it
	MOV.B	AL,AH	;emit high byte
	CALL	ebyte	;emit byte
	POP	AX	;restore
	RET		;"
ebyte	CMP.B	flgpshax,#$00	;Emit byte in AL
	JZ	ebes	;:no PUSH AX
	PUSH	AX	;save
	MOV	AL,#$50	;* PUSH AX
	CALL	ebemit
	POP	AX
	MOV.B	flgpshax,#$00	;reset flag
ebes	CMP.B	flgpshes,#$00	;emit PUSH ES ?
	JZ	ebdi	;:no
	PUSH	AX	;save
	MOV	AL,#$06	;* PUSH ES
	CALL	ebemit
	POP	AX	;restore
	MOV.B	flgpshes,#$00	;reset flag
ebdi	CMP.B	flgpshdi,#$00	;emit PUSH DI ?
	JZ	ebemit	;:no
	PUSH	AX	;save
	MOV	AL,#$57	;* PUSH DI
	CALL	ebemit
	POP	AX	;restore
	MOV.B	flgpshdi,#$00	;reset flag
ebemit	PUSH	BX	;save
	CMP.B	cpmode,#$01	;find runtime error ?
	JZ	ebfind	;:yes
	MOV	BX,cdptr	;code ptr-code pos of buffer
	SUB	BX,cdbufpt
	ADD	BX,cdbegpt	;+ beg of code buffer
	MOV	ES,destseg	;dest segment
	ES:	
	MOV.B	[BX],AL	;store byte
	JMP.b	ebend	;'
ebfind	MOV	BX,pc	;PC = error pos ?
	CMP	BX,errpos2
	JZ	ebfound	;:yes - found !
ebend	INC	cdptr	;inc code pointers
	INC	pc
	MOV	BX,pc	;get PC
	INC.B	BH	;overflow ?
	JZ	eberr	;:yes
	OR.B	BL,BL	;256 bytes done ?
	JNZ	ebnochk	;:no
	CALL	chkovrfl	;test for overflow
ebnochk	POP	BX	;restore BX
	RET		;'
eberr	CALL	err	;98:Memory overflow
	B	$62	;'
ebfound	CALL	err	;C8:Error position found
	B	$C8	;"
codflush	CMP.B	cpmode,#$02	;Flush code buffer
	JB	cfret	;not to file:ret
	MOV	CX,cdptr	;code pointer
	SUB	CX,cdbufpt	;= code pos of buffer ?
	STC	
	JZ	cfret	;yes: nothing to flush
	MOV	AH,#$40	;write byte block
	MOV	BX,dstfile	;dest file handle
	MOV	DX,cdbegpt	;beginning of code buffer
	PUSH	DS	;save DS
	MOV	DS,destseg	;dest segment
	CALL	dos	;write buffer
	POP	DS	;restore DS
	JB	cferr	;:error
	CMP	AX,CX	;length = expected ?
	JZ	cfok	;:yes
cferr	CALL	err	;C9:File error
	B	$C9	;'
cfok	MOV	AX,cdptr	;code ptr -> code pos of buffer
	MOV	cdbufpt,AX
cfret	RET		;"
ptcjmppc	MOV	AX,pc	;Patch jump address
ptcjmp	SUB	AX,BX	;dest (AX)-src (BX)-2
	DEC	AX
	DEC	AX
ptcjmp2	PUSH	BX	;save dest
	SUB	BX,pc	;dest-PC+code ptr
	ADD	BX,cdptr
	CALL	patch	;patch it
	POP	BX	;restore
	RET		;"
patch	CMP.B	cpmode,#$01	;Patch word AX at pos BX
	JZ	ptret	;find error:ret
	CMP	BX,cdbufpt	;>= code pos of buffer ?
	JB	ptlist	;no: put it into patch list
	PUSH	BX	;save pos
	SUB	BX,cdbufpt	;-code pos of buffer
	ADD	BX,cdbegpt	;+beg of code buffer
	MOV	ES,destseg	;dest segment
	ES:	
	MOV	[BX],AX	;patch it in memory
	POP	BX	;restore
ptret	RET		;'
ptlist	PUSH	CX	;save regs
	PUSH	DI	;patch list is sorted to
	PUSH	SI	;minimize disk accesses
	PUSH	SS	;SS -> ES
	POP	ES
	MOV	SI,ptcbeg	;start of patch list
	MOV	DI,ptctop	;top of patch list
ptsearch	CMP	SI,DI	;at the end ?
	JZ	ptstore	;yes: put it there
	SS:	
	CMP	BX,[SI]	;put it here ?
	JB	ptins	;:yes
	ADD	SI,#$04	;go to next entry
	JMP	ptsearch	;'continue searching
ptins	MOV	CX,DI	;calculate count to shift
	SUB	CX,SI
	MOV	SI,DI	;end position
	ADD	DI,#$04	;-> end pos+4
	DEC	DI
	DEC	SI
	PUSH	DS	;save DS
	PUSH	SS	;SS -> DS
	POP	DS
	STD		;make space for new entry
	REPZ	
	MOVS.B	
	POP	DS	;restore DS
	INC	SI	;point to dest pos
ptstore	SS:		;store in patch list:
	MOV	[SI],BX	;address
	SS:	
	MOV	[SI]$02,AX	;value to be patched
	ADD	ptctop,#$04	;add 4 to patch top
	MOV	CX,ptctop	;patch list top = end of
	CMP	CX,ptcend	;patch list space ?
	JNZ	ptnofl	;:no
	CALL	ptcflush	;flush patch list
ptnofl	POP	SI	;restore registers
	POP	DI
	POP	CX
	RET		;"
ptcflush	CMP.B	cpmode,#$02	;Patch code in file
	JB	ptfret	;no file - ret
	PUSH	AX	;save regs
	PUSH	BX
	PUSH	CX
	PUSH	DX
	PUSH	BP
	MOV	AX,#$4201	;seek relative
	MOV	BX,dstfile	;dest file handle
	XOR	CX,CX	;get current pos in file
	XOR	DX,DX
	CALL	dos
	PUSH	AX	;save it
	PUSH	DX
	MOV	BP,ptcbeg	;start of patch list
ptflp	CMP	BP,ptctop	;end reached ?
	JZ	ptfend	;:yes
	MOV	AX,#$4200	;seek absolute
	MOV	BX,dstfile	;dest file handle
	MOV	DX,cdfoff	;file offset
	MOV	CX,cdfoff1
	ADD	DX,[BP]$00	;+ patch addr
	ADC	CX,#$00	;carry
	CALL	dos	;do seek
	MOV	AX,[BP]$02	;get value to patch
	MOV	ptcbuf1,AX	;store in buffer
	MOV	AH,#$40	;write patch value
	MOV	BX,dstfile	;dest file handle
	MOV	CX,#$0002	;2 bytes
	MOV	DX,#ptcbuf1	;buffer ofs
	CALL	dos
	CALL	errb
	B	$C9	;C):File error
	ADD	BP,#$04	;next patch list entry
	JMP	ptflp	;'
ptfend	MOV	AX,ptcbeg	;clear patch list:
	MOV	ptctop,AX	;beg -> top
	MOV	AX,#$4200	;seek absolute
	MOV	BX,dstfile	;dest file handle
	POP	CX	;restore current pos
	POP	DX
	CALL	dos	;set it again
	POP	BP	;restore regs
	POP	DX
	POP	CX
	POP	BX
	POP	AX
ptfret	RET		;"
pushe2	MOV	SI,#parm2	;save entry 2 on stack
	JMP.b	pshe1	;'
pushe1	MOV	SI,#indflg	;save entry 1 on stack
pshe1	POP	retbuf	;ret addr
	MOV	cxbuf,CX	;save CX
	MOV	CX,SS	;SS -> ES
	MOV	ES,CX
	MOV	CX,#$000F	;15 bytes
	SUB	SP,CX	;make space on stack
	MOV	DI,SP	;dest: stack
	CLD	
	REPZ	
	MOVS.B		;move it
psheend	MOV	CX,cxbuf	;restore CX
	JMP	[retbuf]	;"return
pope2	MOV	DI,#parm2	;restore entry 2 from stack
	JMP.b	pope	;'
pope1	MOV	DI,#indflg	;restore entry 1 from stack
pope	POP	retbuf	;ret addr
	MOV	cxbuf,CX	;save CX
	MOV	SI,SP	;SP -> source
	MOV	CX,DS	;DS -> ES
	MOV	ES,CX
	MOV	CX,SS	;SS -> DS
	MOV	DS,CX
	MOV	CX,#$000F	;15 bytes
	CLD	
	REPZ	
	MOVS.B		;move it
	MOV	CX,ES	;restore DS
	MOV	DS,CX
	MOV	SP,SI	;remove entry from stack
	JMP	psheend	;"return
copye2	MOV	DI,#parm2	;copy entry 2 from stack
	JMP.b	cpe	;'
	MOV	DI,#indflg	;copy entry 1 from stack
cpe	PUSH	CX	;save CX
	MOV	SI,SP	;source: on stack
	ADD	SI,#$04	;skip ret addr, CX
	MOV	CX,DS	;DS -> ES
	MOV	ES,CX
	MOV	CX,SS	;SS -> DS
	MOV	DS,CX
	MOV	CX,#$000F	;15 bytes
	CLD	
	REPZ	
	MOVS.B		;copy it
	MOV	CX,ES	;restore DS
	MOV	DS,CX
	POP	CX	;restore CX
	RET		;"
symbyte	MOV	BP,symtop	;store AL in symtab
	DEC	BP	;down one byte
	MOV.B	[BP]$00,AL	;store it
	MOV	symtop,BP	;set new symtab top
	RET		;"
symword	MOV	BP,symtop	;store AX in symtab
	DEC	BP	;down two bytes
	DEC	BP
	MOV	[BP]$00,AX	;store it
	MOV	symtop,BP	;set new symtab top
	RET		;"
symoffs	MOV	AX,symtop2	;Write symtab offset
	SUB	AX,symtop	;last entry-current+2
	ADD	AX,#$0002
	CALL	symword	;store offset
	MOV	AX,symtop	;symtab top ->
	MOV	symtop2,AX	;symtab top at beg of definition
	JMP	chkovrfl	;"test size
stotype	MOV	AX,#$0800	;store type
	CALL	symword	;store tag: subtype
	MOV	AX,symtop	;symtab top
	MOV	vartp,AX	;-> type ptr
	MOV	BX,#parm1end	;source buffer
	MOV	BP,symtop	;destination
stotlp	DEC	BX	;go down
	DEC	BX	;write size, upper bound,
	DEC	BP	;lower bound, component type
	DEC	BP
	MOV	AX,[BX]	;get word
	MOV	[BP]$00,AX	;store it
	CMP	BX,#varctp	;end ?
	JNZ	stotlp	;:not yet
	MOV	symtop,BP	;set new top
	CALL	symoffs	;write offset
	XOR	AX,AX	;ok
	RET		;"
getparm	MOV	BX,#maxsize	;Get var parms -> entry 2
	JMP.b	gvp2	;'
getvprm	MOV	AX,[BP]-$06	;Get var parms
	MOV	indptflg,AX	;var segment
	MOV	AX,[BP]-$04	;var offset
	MOV	varofs,AX
	MOV	BP,[BP]-$02	;type pointer
getvprm2	MOV	BX,#parm1end	;to entry 1
gvp2	PUSH	CX	;save
	MOV	CX,#$0004	;8 bytes
gvplp	DEC	BP	;go down
	DEC	BP	;copy size, upper & lower bound,
	DEC	BX	;component type
	DEC	BX
	MOV	AX,[BP]$00	;copy entry -> buffer
	MOV	[BX],AX
	LOOP	gvplp	;:another
	POP	CX	;restore
	RET		;"
rdsymnew	MOV	AX,#$0100	;'Read symbol
	JMP.b	rsy1	;'no numbers, verify in symtab
rdsym0	MOV	AX,#$0001	;numbers allowed
	JMP.b	rsy1	;'
rdsym	XOR	AX,AX	;no numbers
rsy1	PUSH	AX	;save flag
	CALL	rdword	;read word
	POP	AX	;restore flag
	OR.B	AL,AL	;numbers allowed ?
	MOV	AL,wrdbuf1	;first char ?
	JZ	rsynonum	;:no
	CALL	number	;0..9 ?
	JNB	rsynum	;yes: ok
rsynonum	CALL	alpha	;valid char ?
	CALL	errb	;no:
	B	$3A	;58:Illegal char in ID
rsynum	OR.B	AH,AH	;verify in symbol table ?
	JNZ	rsynotst	;:no
	CALL	dupvar	;test if duplicate
rsynotst	CALL	dupkey	;test if keyword
	MOV	BP,symtop	;destination
	MOV.B	BL,wordbuf	;word length
	XOR.B	BH,BH	;-> count
	DEC	BP	;go down
	MOV.B	[BP]$00,BL	;store length
rsysto	DEC	BP	;go down
	MOV.B	AL,[BX]wordbuf	;get char from buffer
	MOV.B	[BP]$00,AL	;store in symtab
	DEC	BX	;go back
	JNZ	rsysto	;:another char
	MOV	symtop,BP	;set new symtab top
rsynext	MOV	DI,wrdend	;go to end of word
	JMP	skipdi	;"get next word
rdword	CMP.B	wordflg,#$FF	;read word: word available ?
	JNZ	rdwret	;yes: ret
	XOR	BX,BX
	MOV	DI,chptr	;char ptr: source
	MOV.B	AL,[DI]	;get char
	CALL	alphanum	;char in alphanum ?
	JB	rdwother	;:no
rdwlp	CMP.B	BL,#$7F	;end of buffer ?
	JZ	rdwfull	;:yes - don't store
	CMP	AL,#$61	;do UpCase
	JB	rdwupper	;:no
	SUB	AL,#$20
rdwupper	INC	BX	;go to next pos
	MOV.B	[BX]wordbuf,AL	;store char in buffer
rdwfull	INC	DI	;next char from source
	MOV.B	AL,[DI]	;get it
	CALL	alphanum	;in alphanum ?
	JNB	rdwlp	;yes: loop back
	JMP.b	rdwend	;'no: end
rdwother	INC	DI	;go to next pos
	INC	BX
	MOV.B	[BX]wordbuf,AL	;store char
	MOV.B	AL,[DI]	;next char
	CMP	AL,#$2E	;. ?
	JZ	rdwchar2	;:yes
	CMP	AL,#$3D	;= ?
	JZ	rdwchar2	;:yes
	CMP	AL,#$3E	;> ?
	JNZ	rdwend	;:no
rdwchar2	INC	DI	;store that char
	INC	BX
	MOV.B	[BX]wordbuf,AL
rdwend	MOV.B	wordbuf,BL	;store word length
	MOV	wrdend,DI	;store end addr of word
	MOV.B	wordflg,#$FE	;word available
rdwret	RET		;"
search	CALL	srchall	;search whole symbol table
	JNZ	rdwret	;not found:ret
	JMP	skipdi	;"get next word
srchvar	MOV	BX,fence	;current var fence
	JMP.b	src1	;'(BX=search limit)
srchall	MOV	BX,ptcbeg	;start of symtab
src1	MOV	DX,CX	;type wanted
	CMP.B	DL,wordflg	;= type of current word ?
	JZ	srcsame	;:yes
	PUSH	BX	;save fence
	CALL	rdword	;read word
	POP	BX	;restore
	MOV.B	wordflg,DL	;store type wanted
	CALL	srchsym	;search in symbol table
	JB	srcnofnd	;:not found
	MOV	typept,AL	;store type returned
	MOV	sympos,BP	;store pos in symbol table
srcsame	MOV	BP,sympos	;get symtab pos
	MOV	DI,wrdend	;get end pos of word
	MOV	CX,DX	;type -> CX
	CMP.B	CH,typept	;compare type
	RET		;'
srcnofnd	XOR	AX,AX	;type returned: none
	MOV	typept,AL
	DEC	AX	;not found
	RET		;"
srchsym	MOV.B	CL,wordbuf	;word length
	XOR.B	CH,CH	;-> count
	MOV	BP,symtop2	;symtab position
	PUSH	SS	;SS -> ES
	POP	ES
	CLD		;forward search
srchloop	CMP	BP,BX	;fence reached ?
	JZ	srsynf	;yes: not found
	ADD	BP,[BP]$00	;add offset
	MOV.B	AL,[BP]-$01	;get tag byte
	OR.B	AL,AL	;0 ?
	JZ	srchloop	;yes: invisible entry
	CMP	AL,#$08	;subtype ?
	JZ	srchloop	;yes: invisible
	MOV	AX,[BP]-$03	;string length
	CMP.B	AL,CL	;= searched ?
	JNZ	srchloop	;:no
	CMP.B	AH,DL	;= wanted type ?
	JNZ	srchloop	;:no
	MOV	DI,BP	;calculate string position
	SUB	DI,#$03
	SUB	DI,CX	;- count
	MOV	SI,#wrdbuf1	;word ptr
	MOV	AX,CX	;save count
	REPZ		;do comparison
	CMPS.B	
	XCHG	AX,CX	;restore count
	JNZ	srchloop	;not the same: continue
	MOV.B	AL,[BP]-$01	;get type
	SUB	BP,#$03	;set ptr to beg of string
	SUB	BP,CX	;= beg of entry
	CLC		;found !
	RET		;'
srsynf	STC		;not found
	RET		;"
ckey	CALL	rdword	;check keyword: read word
	POP	BX	;return addr
	CS:	
	MOV.B	DL,[BX]	;get offset between words
	CS:	
	MOV	DI,[BX]$01	;get pointer
	ADD	BX,#$03	;skip inline parms
	PUSH	BX	;restore ret addr
ckey2	XOR.B	DH,DH	;distance between keywords
	MOV	BX,#wordbuf	;word ptr
	PUSH	CS	;CS -> ES
	POP	ES
	CLD		;forward search
ckloop	CS:	
	MOV.B	CL,[DI]	;get length
	XOR.B	CH,CH
	JCXZ	cknf	;nothing - end of list
	INC	CX	;-> count
	MOV	SI,BX	;source
	REPZ	
	CMPS.B		;compare words
	JZ	ckfound	;:equal
	ADD	DI,CX	;add remaining count
	ADD	DI,DX	;add offset
	JMP	ckloop	;'try next keyword
cknf	DEC	CX	;flag: not found
	RET		;'
ckfound	MOV	BX,DI	;position in keyword table
	CALL	rsynext	;get next word
	CS:	
	MOV	AX,[BX]	;get word from keyword table
ckret	RET		;"
ctoken	CALL	rdword	;Check keyword: read word
	POP	BX	;return address
	CS:	
	MOV	DI,[BX]	;inline parm: pointer
	INC	BX	;skip inline parm
	INC	BX
	PUSH	BX	;restore ret
	MOV	SI,#wordbuf	;word ptr
	MOV.B	CL,[SI]	;get length of keyword
	XOR.B	CH,CH	;-> count
	INC	CX
	PUSH	CS	;CS -> ES
	POP	ES
	CLD		;compare words
	REPZ	
	CMPS.B	
	JNZ	ckret	;:not the same - ret
	JMP	rsynext	;"ok, get next word
dupkey	MOV	BX,#keytable	;new ID = keyword ?
dkloop	CS:		;pointer: list of keyword areas
	MOV.B	DL,[BX]	;get offset
	CMP.B	DL,#$FF	;end of table ?
	JZ	dkret	;:yes
	PUSH	BX	;save pointer
	CS:	
	MOV	DI,[BX]$01	;get pointer into table
	CALL	ckey2	;check it
	POP	BX	;restore pointer
	CALL	errz	;yes:
	B	$35	;53:Reserved word
	INC	BX	;next entry
	INC	BX
	INC	BX
	JMP	dkloop	;'do next one
dkret	RET		;"
dupvar	MOV	BX,fence	;Duplicate ID ?
	MOV.B	DL,recnum	;expected type
	CALL	srchsym	;search in symbol table
	JB	dkret	;:ret
	CALL	err	;43:Duplicate ID or label
	B	$2B	;"
csqr1	MOV	DI,chptr	;Check [, (.
	CMP.B	[DI],#$5B	;[ ?
	JZ	chkskip	;yes: skip it
	CMP.B	[DI],#$28	;( ?
	JNZ	chkret	;no: ret
	INC	DI	;next char
	CMP.B	[DI],#$2E	;. ?
	JMP.b	chkcskip	;'check it
csqr2	MOV	DI,chptr	;Check ], .)
	CMP.B	[DI],#$5D	;] ?
	JZ	chkskip	;yes: skip it
	CMP.B	[DI],#$2E	;. ?
	JNZ	chkret	;no: ret
	INC	DI	;next char
	CMP.B	[DI],#$29	;) ?
	JMP.b	chkcskip	;'check it
ccolon	MOV	AL,#$3A	;: ?
	JMP.b	chkal	;'check it
csemi	MOV	AL,#$3B	;semicolon ?
	JMP.b	chkal	;'check it
ccomma	MOV	AL,#$2C	;, ?
	JMP.b	chkal	;'check it
cdot	MOV	AL,#$2E	;. ?
	JMP.b	chkal	;'check it
cbrack1	MOV	AL,#$28	;( ?
	JMP.b	chkal	;'check it
cbrack2	MOV	AL,#$29	;) ?
	JMP.b	chkal	;'check it
cequal	MOV	AL,#$3D	;= ?
	JMP.b	chkal	;'check it
cptr	MOV	AL,#$5E	;^ ?
chkal	MOV	DI,chptr	;current char = AL ?
	CMP.B	AL,[DI]	;compare
chkcskip	JNZ	chkret	;no: ret
chkskip	INC	DI	;skip it
	JMP.b	skipdi	;'read next word
	NOP	
chkret	RET		;"
esqr1	CALL	csqr1	;expect [: check [
	CALL	errnz	;no:
	B	$08	;8:[ expected
	RET		;"
esqr2	CALL	csqr2	;expect ]: check ]
	CALL	errnz	;no:
	B	$09	;9:] expected
	RET		;"
ecolon	CALL	ccolon	;expect :
	CALL	errnz	;no:
	B	$02	;2:':' expected
ecolret	RET		;"
esemi	CALL	csemi	;expect semicolon
	JZ	ecolret	;yes: ret
esemierr	CALL	err	;1:Semicolon expected
	B	$01	;'
esemi2	CALL	csemi	;expect semicolon
	JZ	ecolret	;yes: ret
	CMP.B	semiflg,#$00	;flag set ?
	JZ	esemierr	;yes: error 1
	CALL	err	;41:Unknown ID or syntax error
	B	$29	;"
ecomma	CALL	ccomma	;expect ,
	CALL	errnz	;no:
	B	$03	;3:',' expected
	RET		;"
ebrack1	CALL	cbrack1	;expect (
	CALL	errnz	;no:
	B	$04	;4:'(' expected
	RET		;"
ebrack2	CALL	cbrack2	;expect )
	CALL	errnz	;no:
	B	$05	;5:')' expected
	RET		;"
eequal	CALL	cequal	;expect =
	CALL	errnz	;no:
	B	$06	;6:'=' expected
	RET		;"
eassign	CALL	ctoken	;expect :=
	W	tkassign	;check token
	CALL	errnz	;no:
	B	$07	;7:':=' expected
	RET		;"
expof	CALL	ctoken	;expect OF
	W	tkof	;check token
	CALL	errnz	;no:
	B	$0F	;15:OF expected
	RET		;"
	;This routine skips spaces until next word is reached.
skip	MOV	DI,chptr	;get next word: get char ptr
skipdi	MOV.B	semiflg,#$00	;flag for semicolon error
	MOV.B	wordflg,#$FF	;search flag
skloop	MOV	AX,[DI]	;get char (two, actually)
	CMP	AL,#$20	;space, control ?
	JBE	skspace	;yes: skip spaces
	CMP	AL,#$7B	; '{' ?
	JZ	skcom2	;yes: comment
	CMP	AX,#$2A28	; '(*' ?
	JZ	skcom	;yes: comment
	MOV	chptr,DI	;set char pointer
	XOR	AX,AX	;ok
	RET		;'
skspace	CALL	getchar	;skip spaces: get char
	JMP	skloop	;'loop back
skcom	CALL	getchar	;Comment: get char
skcom2	PUSH	DX	;save
	MOV.B	DL,[DI]	;comment type
	CMP.B	[DI]$01,#$24	;$ ?
	JZ	cdirec	;yes: compiler directive
skcomlp	CALL	getchar	;get char
skcom3	MOV	AX,[DI]	;test two chars
	CMP.B	DL,#$2A	; '(*' ?
	JNZ	skcomcur	;:no
	CMP	AX,#$292A	;now '*)' ?
	JNZ	skcomlp	;no: loop back
	CALL	getchar	;end of comment - get char
	JMP.b	skcomend	;'continue scanning
skcomcur	CMP	AL,#$7D	; '}' ?
	JNZ	skcomlp	;no: loop back
skcomend	POP	DX	;restore
	JMP	skspace	;"continue scanning
cdirec	PUSH	BX	;Compiler directive: save regs
	PUSH	CX
	PUSH	DX
	CALL	getchar	;get char
cdlop	CALL	getchar	;get char
	MOV.B	AL,[DI]	;get directive
	CALL	upcase	;UpCase
	CMP	AL,#$49	;I ? I/O-error handling, Include
	MOV	DX,#$0001	;flag
	JZ	cdplus	;:yes +-
	CMP	AL,#$52	;R ? Range checking
	MOV	DX,#$0002
	JZ	cdplus	;:yes +-
	CMP	AL,#$42	;B ? I/O-mode (CON or TRM)
	MOV	DX,#$0004
	JZ	cdplus	;:yes +-
	CMP	AL,#$43	;C ? Control C and S
	MOV	DX,#$0008
	JZ	cdplus	;:yes +-
	CMP	AL,#$55	;U ? User Interrupt
	MOV	DX,#$0010
	JZ	cdplus	;:yes +-
	CMP	AL,#$4B	;K ? Stack check
	MOV	DX,#$0020
	JZ	cdplus	;:yes +-
	CMP	AL,#$56	;V ? Type checking
	MOV	DX,#$0040
	JZ	cdplus	;:yes +-
	CMP	AL,#$44	;D ? Device checking
	MOV	DX,#$0080
	JZ	cdplus	;:yes +-
	CMP	AL,#$47	;G ? Input file buffer size
	MOV	BX,#cinpsize	;dest var: buffer size
	JZ	cdnum	;:yes #
	CMP	AL,#$50	;P ? Output file buffer size
	MOV	BX,#coutsize	;dest var: buffer size
	JZ	cdnum	;:yes #
	CMP	AL,#$46	;F ? Max number open files
	MOV	BX,#cmaxfil	;dest var: max files
	JZ	cdnum	;:yes #
	XOR	DX,DX	;no flag
	CMP	AL,#$41	;A ? Absolute code
	JZ	cdplus	;:yes +-
	CMP	AL,#$57	;W ? WITH nesting
	JZ	cdignore	;:yes #
	CMP	AL,#$58	;X ? Array optimization
	JZ	cdplus	;:yes +-
	CMP	AL,#$4F	;O ?
	JZ	cdignore	;:yes #
cderr	CALL	perr	;remember pos
	B	$5D	;'93:Invalid compiler directive
cdend	POP	DX	;restore regs
	POP	CX
	POP	BX
	JMP	skcom3	;'continue scanning comment
cdplus	CALL	getchar	;+/- directive: get char
	MOV.B	AL,[DI]	;read it
	XOR	CX,CX	;clear flag
	CMP	AL,#$2B	; '+' ?
	JZ	cdset	;:yes
	DEC	CX	;set flag
	CMP	AL,#$2D	; '-' ?
	JZ	cdset	;:yes
	CMP	DX,#$01	;include ?
	JZ	cdinclsk	;yes: do it
	JMP	cderr	;'Invalid compiler directive
cdset	MOV	AX,direct	;old directives
	XOR	AX,CX	;invert if reset bit
	OR	AX,DX	;set / reset bit
	XOR	AX,CX	;invert if reset bit
	MOV	direct,AX	;set new directive
	CALL	getchar	;get char
cdnext	MOV.B	AL,[DI]	; ',' ?
	CMP	AL,#$2C
	JNZ	cdend	;no: end directive
	JMP	cdlop	;'yes: loop back
cdignore	CALL	getchar	;Ignore directive: get char
	MOV.B	AL,[DI]
	CALL	alphanum	;valid char ?
	JNB	cdignore	;yes: continue
	JMP	cdnext	;'another directive ?
cdnum	CALL	getchar	;Get number: get char
	PUSH	BX	;save dest ptr
	MOV	BX,DI	;position
	CALL	asccard	;read integer
	MOV	DI,BX	;new position
	POP	BX	;dest ptr
	JB	cderr	;:error
	OR	AX,AX	;0 ?
	JZ	cderr	;yes: error
	MOV	[BX],AX	;store result
	JMP	cdnext	;'another directive ?
cdinclsk	CMP.B	[DI],#$20	;Set include file: space ?
	JNZ	cdincl	;no: do it
	CALL	getchar	;get char
	JMP	cdinclsk	;'skip spaces
cdincl	CMP.B	inclflg,#$00	;include file active ?
	CALL	errnz	;yes:
	B	$60	;96:Illegal nesting of include files
	MOV	BX,DI	;position
	CALL	kpasext	;parse filename, default .PAS
	PUSH	BX	;save pos
	MOV	DI,#inclpn	;copy path name
	CALL	fnscdi	;-> include filename buffer
	POP	DI	;restore pos
	MOV	AX,#$3D00	;open file
	MOV	DX,#inclpn	;name ptr
	PUSH	DS	;DS -> ES
	POP	ES
	CALL	dos	;open it
	CALL	errb	;90:File not found
	B	$5A
	MOV	incfile,AX	;store file handle
	MOV	AX,direct	;save compiler directives
	MOV	direcin,AX
	XOR	AX,AX	;clear vars:
	MOV	bufpt,AX	;buffer ptr
	MOV	bufend,AX	;buffer end
	MOV	frelpos,AX	;relative pos in file
	MOV.B	inclflg,#$FF	;set include flag
	CALL	disline	;display line number
	JMP	cdend	;"restore regs, continue scanning
getchar	MOV.B	AL,[DI]	;Get char
	INC	DI	;go to next one
	OR.B	AL,AL	;end of line ?
	JZ	getln	;:yes
	RET		;'
getln	PUSH	BX	;save regs
	PUSH	CX
	PUSH	DX
	CMP.B	srcend,#$00	;last line ?
	CALL	perrnz	;yes:
	B	$5B	;91:Unexpected end of source
	INC	lincnt	;count lines
	MOV	DI,#pnbuf	;destination: line buffer
	MOV	CX,#$007F	;up to 127 chars
	CMP.B	inclflg,#$00	;from include file ?
	JNZ	fileline	;:yes
	MOV	BX,srcptr	;pointer into text
	MOV	srclnbeg,BX	;-> beginning of source line
memline	MOV.B	AL,[BX]	;get char
	CMP	AL,#$1A	;^Z ?
	JZ	memeof	;yes: mark end of source
	INC	BX	;next char
	CMP	AL,#$0D	;CR ?
	JZ	memlf	;yes: end of line
	MOV.B	[DI],AL	;store in buffer
	INC	DI	;next pos
	LOOP	memline	;:another char
	JMP.b	memsto	;'end it
memlf	CMP.B	[BX],#$0A	;LF ?
	JNZ	memsto	;no: forget it
	INC	BX	;yes: skip it
	JMP.b	memsto	;'set new pos
memeof	MOV	srcend,AL	;set flag: end of source
memsto	MOV	srcptr,BX	;store new pos in buffer
	JMP.b	filesto	;'mark end of line
fileline	MOV	BX,bufpt	;buffer pointer
	MOV	AX,frelpos	;relative pos in file
	ADD	AX,BX	;+ buffer offset
	SUB	AX,bufend	;- buffer end
	MOV	srclnbg,AX	;-> pos of line begin
fileloop	CALL	getincl	;get char from include file
	CMP	AL,#$1A	;^Z ?
	JZ	fileeof	;:yes, close include
	INC	BX	;next char
	CMP	AL,#$0D	;CR ?
	JZ	filelf	;yes: end of line
	MOV.B	[DI],AL	;store char in buffer
	INC	DI	;next pos
	LOOP	fileloop	;:another char
	JMP.b	filelf2	;'end it
filelf	CALL	getincl	;get char from include file
	CMP	AL,#$0A	;LF ?
	JNZ	filelf2	;no: forget it
	INC	BX	;skip
filelf2	MOV	bufpt,BX	;store buffer ptr
	JMP.b	filesto	;'mark end of line
fileeof	MOV.B	inclflg,#$00	;clear include flag
	MOV	AX,direcin	;restore directives to
	MOV	direct,AX	;state before include
	MOV	AH,#$3E	;close
	MOV	BX,incfile	;file handle
	CALL	dos
filesto	MOV.B	[DI],#$00	;store a 0 at the end
	MOV	DI,#pnbuf	;go to beg of buffer
	CALL	disline1	;display line number
	POP	DX	;restore regs
	POP	CX
	POP	BX
	RET		;"
getincl	CMP	BX,bufend	;Get char from include file
	JB	ginend	;:not yet end of buffer
	PUSH	CX	;save
	MOV	AH,#$3F	;read byte block
	MOV	BX,incfile	;file handle
	MOV	CX,#$0080	;128 bytes
	MOV	DX,#inclbuf	;buffer ptr
	MOV	SI,#$0080	;?
	CALL	dos	;read buffer
	POP	CX	;restore
	JNB	ginok	;:ok
	XOR	AX,AX	;nothing read
ginok	MOV	BX,#inclbuf	;start of buffer
	OR	AX,AX	;anything read ?
	JNZ	ginnoeof	;:yes
	MOV.B	[BX],#$1A	;store ^Z
	INC	AX	;1 char
ginnoeof	ADD	frelpos,AX	;relative pos in file
	ADD	AX,BX	;pos of buffer end
	MOV	bufend,AX
ginend	MOV.B	AL,[BX]	;get char
	RET		;"
disline1	TEST.B	lincnt,#$0F	;Display line number
	JZ	disline	;:once every 16 lines
	RET		;'
disline	PUSH	AX	;save regs
	PUSH	BX
	PUSH	CX
	PUSH	DX
	MOV	AL,#$0D	;write CR
	CALL	conput
	CMP.B	inclflg,#$00	;include ?
	JZ	dismem	;:no
	MOV	AL,#$49	;I
	JMP.b	disincl	;'
dismem	MOV	AL,#$20	;space
disincl	CALL	conput	;write it
	MOV	AL,#$20	;write space
	CALL	conput
	MOV	AX,lincnt	;get line number
	CALL	knum1	;display it
	CALL	xkeypres	;Keypressed
	OR.B	AL,AL	;test flag
	JZ	disret	;:no
	CALL	prints	;write string
	B	"   *** Abort compilation",$00
	CALL	yorn	;Y or N ?
	JZ	disok	;no: continue
	CALL	err	;CA:Compilation aborted
	B	$CA	;'
disok	MOV	CX,#$0020	;clear 32 bytes
disera	CALL	prints	;write BS space BS
	B	$08," ",$08,$00
	LOOP	disera	;:another
disret	POP	DX	;restore regs
	POP	CX
	POP	BX
	POP	AX
	RET		;"
	;*** Start of Tables ***
	;Standard definitions
	W	$000E,$02FC
	B	"INTEGER",$07,$00,$03
	W	$000B,$0308
	B	"CHAR",$04,$00,$03
	W	$000B,$0314
	B	"REAL",$04,$00,$03
	W	$000E,$0320
	B	"BOOLEAN",$07,$00,$03
	W	$000B,$0338
	B	"BYTE",$04,$00,$03
	W	$000C,$0001
	B	$0B,"TRUE",$04,$00,$02
	W	$000D,$0000
	B	$0B,"FALSE",$05,$00,$02
	W	$000E,$7FFF
	B	$0A,"MAXINT",$06,$00,$02
	W	$000D,$0000
	B	$0A,"BLACK",$05,$00,$02
	W	$000C,$0001
	B	$0A,"BLUE",$04,$00,$02
	B	$0D,$00,$02,$00
	B	$0A,"GREEN",$05,$00,$02
	W	$000C,$0003
	B	$0A,"CYAN",$04,$00,$02
	W	$000B,$0004
	B	$0A,"RED",$03,$00,$02
	W	$000F,$0005
	B	$0A,"MAGENTA",$07,$00,$02
	W	$000D,$0006
	B	$0A,"BROWN",$05,$00,$02
	W	$0011,$0007
	B	$0A,"LIGHTGRAY",$09,$00,$02
	W	$0010,$0008
	B	$0A,"DARKGRAY",$08,$00,$02
	W	$0011,$0009
	B	$0A,"LIGHTBLUE",$09,$00,$02
	W	$0012,$000A
	B	$0A,"LIGHTGREEN",$0A,$00,$02
	W	$0011,$000B
	B	$0A,"LIGHTCYAN",$09,$00,$02
	W	$0010,$000C
	B	$0A,"LIGHTRED",$08,$00,$02
	W	$0014,$000D
	B	$0A,"LIGHTMAGENTA",$0C,$00,$02
	W	$000E,$000E
	B	$0A,"YELLOW",$06,$00,$02
	W	$000D,$000F
	B	$0A,"WHITE",$05,$00,$02
	W	$000D,$0010
	B	$0A,"BLINK",$05,$00,$02
	W	$000C,$0000
	B	$0A,"BW40",$04,$00,$02
	W	$000C,$0002
	B	$0A,"BW80",$04,$00,$02
	W	$000B,$0001
	B	$0A,"C40",$03,$00,$02
	W	$000B,$0003
	B	$0A,"C80",$03,$00,$02
	W	$000E
	W	$2182,$DAA2,$490F	; 3.1415926536E+00
	B	$09,"PI",$02,$00,$02
	W	$0011,$FF00
	W	conbufln
	W	$0338
	B	"BUFLEN",$06,$00,$04
	W	$0012,$FF00
	W	hptop
	W	$0344
	B	"HEAPPTR",$07,$00,$04
	W	$0011,$FF00
	W	stdout
	W	$032C
	B	"OUTPUT",$06,$00,$04
	W	$0010,$FF00
	W	stdin
	W	$032C
	B	"INPUT",$05,$00,$04
	W	$000E,$FF00
	W	filcon
	W	$032C
	B	"CON",$03,$00,$04
	W	$000E,$FF00
	W	filcon
	W	$032C
	B	"TRM",$03,$00,$04
	W	$000E,$FF00
	W	filkbd
	W	$032C
	B	"KBD",$03,$00,$04
	W	$000E,$FF00
	W	fillst
	W	$032C
	B	"LST",$03,$00,$04
	W	$000E,$FF00
	W	filaux
	W	$032C
	B	"AUX",$03,$00,$04
	W	$000E,$FF00
	W	filusr
	W	$032C
	B	"USR",$03,$00,$04
	W	$0011,$FF00
	W	cbreak
	W	$0320
	B	"CBREAK",$06,$00,$04
	W	$0013,$FF00
	W	vkbdstat
	W	$02FC
	B	"CONSTPTR",$08,$00,$04
	W	$0013,$FF00
	W	vkbdget
	W	$02FC
	B	"CONINPTR",$08,$00,$04
	W	$0014,$FF00
	W	vconput
	W	$02FC
	B	"CONOUTPTR",$09,$00,$04
	W	$0014,$FF00
	W	vprnput
	W	$02FC
	B	"LSTOUTPTR",$09,$00,$04
	W	$0014,$FF00
	W	vauxput
	W	$02FC
	B	"AUXOUTPTR",$09,$00,$04
	W	$0013,$FF00
	W	vauxget
	W	$02FC
	B	"AUXINPTR",$08,$00,$04
	W	$0014,$FF00
	W	vusrput
	W	$02FC
	B	"USROUTPTR",$09,$00,$04
	W	$0013,$FF00
	W	vusrget
	W	$02FC
	B	"USRINPTR",$08,$00,$04
	W	$0013,$FF00
	W	verror
	W	$02FC
	B	"ERRORPTR",$08,$00,$04	;"
	; Standard types
	; link  type  lower upper size  tag: invisible
	B	$0C,$00,$0A,$00,$00,$80,$FF,$7F,$02,$00,$00,$00	;integer
	B	$0C,$00,$0C,$00,$00,$00,$FF,$00,$01,$00,$00,$00	;char
	B	$0C,$00,$09,$00,$00,$00,$00,$00,$06,$00,$00,$00	;real
	B	$0C,$00,$0B,$00,$00,$00,$01,$00,$01,$00,$00,$00	;boolean
	B	$0C,$00,$06,$00,$00,$00,$00,$00,$CC,$00,$00,$00	;text file
	B	$0C,$00,$0A,$00,$00,$00,$FF,$00,$01,$00,$00,$00	;byte
	B	$0C,$00,$04,$00,$00,$00,$00,$00,$04,$00,$00,$00	;pointer
	B	$0C,$00,$08,$00,$00,$00,$00,$00,$09,$00,$00,$00	;string
	B	$0C,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00	;untyped file
	B	$0C,$00,$07,$00,$00,$00,$00,$00,$4C,$00,$00,$00	;"typed file
	;Patch table to patch in pointers to type entries
	;Offsets relative to 9277
varpatch	W	$0002,$0010,$001B,$0026,$0034,$01A0,$01B1,$01C3,$01D4
	W	$01E4,$01F2,$0200,$020E,$021C,$022A,$0249,$025C,$026F
	W	$0283,$0297,$02AB,$02BE,$02D2,$02E5,$0238
	;"
keytable	B	$00	;Pointers into keyword table
	W	tkprog	;(offset between entries, pointer)
	B	$01
	W	tklabel
	B	$02
	W	tkbegin
	B	$04
	W	tkto
	B	$05
	W	tkmul2
	B	$05
	W	tkadd2
	B	$02
	W	tkcmp2
	B	$FF	;"end of table
tkprog	B	$07,"PROGRAM"	;Keyword table
tkend	B	$03,"END"
tkforwrd	B	$07,"FORWARD"
tkext	B	$08,"EXTERNAL"
tkpacked	B	$06,"PACKED"
tkarray	B	$05,"ARRAY"
tkfile	B	$04,"FILE"
tkset	B	$03,"SET"
tkrec	B	$06,"RECORD"
tkstr	B	$06,"STRING"
tkof	B	$02,"OF"
tkabs	B	$08,"ABSOLUTE"
tkthen	B	$04,"THEN"
tkelse	B	$04,"ELSE"
tkdo	B	$02,"DO"
tkuntil	B	$05,"UNTIL"
tknot	B	$03,"NOT"
tknil	B	$03,"NIL",$00	;'
tktext	B	$04,"TEXT"	;other reserved words
tk2dot	B	$02,".."
tkassign	B	$02,":="	;'
tklabel	B	$05,"LABEL",$01	;definition part
	B	$05,"CONST",$02	;byte at the end = token
	B	$04,"TYPE",$03
tkvar	B	$03,"VAR",$04
	B	$05,"BEGIN",$08
tkover	B	$07,"OVERLAY",$07
tkproc	B	$09,"PROCEDURE",$05
	B	$08,"FUNCTION",$06,$00	;'
tkbegin	B	$05,"BEGIN"	;program part
	W	block	;word = vector to compiler routine
	B	$02,"IF"
	W	if
	B	$05,"WHILE"
	W	while
	B	$06,"REPEAT"
	W	repeat
	B	$03,"FOR"
	W	for
tkcase	B	$04,"CASE"
	W	case
	B	$04,"GOTO"
	W	goto
	B	$04,"WITH"
	W	with
	B	$06,"INLINE"
	W	inline
	B	$00	;'
tkto	B	$02,"TO"	;keywords used with FOR
	B	$7D,$41,$49,$00	;JGE / INC CX / DEC CX
	B	$06,"DOWNTO"
	B	$7E,$49,$41,$08	;JNG / DEC CX / INC CX
	B	$00	;'
tkmem	B	$03,"MEM",$01	;special arrays
	B	$04,"MEMW",$02	;(not reserved)
	B	$00	;'
	;Code descriptors: parameters for the code generator
	;+0:operation #
	;+1:opcode immediate form
	;+2:standard opcode
	;+4:option bits
	;    1:XCHG CX,AX needed
	;    2:no immediate form available
	;    4:no var form available
	;    8:CWD needed
	;"   10:XCHG DX,AX needed at end
tkmul	B	$01,"*"	;Multiplication ops
	B	$00,$00,$F7,$E9,$02	;no imme, IMUL CX
	B	$01,"/"
	B	$01,$00,$00,$00,$00	;real only !
tkmul2	B	$03,"AND"	;AND AX,CX
	B	$02,$25,$23,$C1,$00
	B	$03,"MOD"	;IDIV CX
	B	$03,$00,$F7,$F9,$1B	;no imme, both XCHG, CWD
	B	$03,"DIV"	;IDIV CX
	B	$04,$00,$F7,$F9,$0B	;no imme, XCHG CX,AX, CWD
	B	$03,"SHL"	;SHL AX,CL
	B	$05,$00,$D3,$E0,$07	;no imme, no var, XCHG CX,AX
	B	$03,"SHR"	;SHR AX,CL
	B	$06,$00,$D3,$E8,$07	;no imme, no var, XCHG CX,AX
	B	$00	;'
tkadd	B	$01,"+"	;Addition ops
	B	$00,$05,$03,$C1,$00	;ADD AX,CX
	B	$01,"-"	;SUB AX,CX
	B	$01,$2D,$2B,$C1,$01	;XCHG CX,AX
tkadd2	B	$02,"OR"	;OR AX,CX
	B	$02,$0D,$0B,$C1,$00
	B	$03,"XOR"	;XOR AX,CX
	B	$03,$35,$33,$C1,$00
	B	$00	;'
tkcmp	B	$01,"="	;Comparison ops
	B	$00,$74	;table offset, branch op: JZ
	B	$02,"<>"
	B	$08,$75	;JNZ
	B	$02,">="
	B	$10,$7D	;JGE
	B	$02,"<="
	B	$18,$7E	;JNG
	B	$01,">"
	B	$20,$7F	;JG
	B	$01,"<"
	B	$28,$7C	;JL
tkcmp2	B	$02,"IN"
	B	$FF,$00	;special
	B	$00	;'
cmpcode	B	$00,$3D,$3B,$C1,$01	;"CMP AX,CX; XCHG CX,AX
stdprocs	B	$07,"WRITELN"	;Standard procedures
	W	pwriteln	;vector to COMPILER routine
	B	$05,"WRITE"
	W	pwrite
	B	$06,"READLN"
	W	preadln
	B	$04,"READ"
	W	pread
	B	$06,"DELETE"
	W	pdelete
	B	$06,"INSERT"
	W	pinsert
	B	$06,"GOTOXY"
	W	pgotoxy
	B	$06,"ASSIGN"
	W	passign
	B	$05,"RESET"
	W	preset
	B	$07,"REWRITE"
	W	prewrite
	B	$06,"APPEND"
	W	pappend
	B	$05,"CLOSE"
	W	pclose
	B	$05,"ERASE"
	W	perase
	B	$06,"RENAME"
	W	prename
	B	$04,"SEEK"
	W	pseek
	B	$08,"LONGSEEK"
	W	pseek
	B	$03,"NEW"
	W	pnew
	B	$04,"MARK"
	W	pmark
	B	$07,"RELEASE"
	W	prelease
	B	$06,"GETMEM"
	W	pgetmem
	B	$07,"DISPOSE"
	W	pdispose
	B	$07,"FREEMEM"
	W	pfreemem
	B	$03,"STR"
	W	pstr
	B	$03,"VAL"
	W	pval
	B	$09,"BLOCKREAD"
	W	pblockrd
	B	$0A,"BLOCKWRITE"
	W	pblockwr
	B	$05,"CHDIR"
	W	pchdir
	B	$05,"MKDIR"
	W	pmkdir
	B	$05,"RMDIR"
	W	prmdir
	B	$06,"GETDIR"
	W	pgetdir
	B	$07,"OVRPATH"
	W	povrpath
	B	$09,"RANDOMIZE"
	W	prndmize
	B	$04,"MOVE"
	W	pmove
	B	$08,"FILLCHAR"
	W	pfillchr
	B	$04,"EXIT"
	W	pexit
	B	$04,"HALT"
	W	phalt
	B	$05,"PORTW"
	W	pportw
	B	$04,"PORT"
	W	pport
	B	$05,"FLUSH"
	W	pflush
	B	$08,"TRUNCATE"
	W	ptruncat
	B	$07,"EXECUTE"
	W	pexecute
	B	$05,"CHAIN"
	W	pchain
	B	$04,"INTR"
	W	pintr
	B	$05,"MSDOS"
	W	pmsdos
	B	$07,"CRTINIT"
	W	pcrtinit
	B	$07,"CRTEXIT"
	W	pcrtexit
	B	$06,"CLRSCR"
	W	pclrscr
	B	$06,"CLREOL"
	W	pclreol
	B	$09,"HIGHVIDEO"
	W	pnrmvid
	B	$09,"NORMVIDEO"
	W	pnrmvid
	B	$08,"LOWVIDEO"
	W	plowvid
	B	$07,"INSLINE"
	W	pinsline
	B	$07,"DELLINE"
	W	pdelline
	B	$05,"DELAY"
	W	pdelay
	B	$06,"WINDOW"
	W	pwindow
	B	$09,"TEXTCOLOR"
	W	ptextcol
	B	$0E,"TEXTBACKGROUND"
	W	ptextbg
	B	$0E,"GRAPHCOLORMODE"
	W	pgrcolmd
	B	$09,"GRAPHMODE"
	W	pgrmode
	B	$05,"HIRES"
	W	phires
	B	$08,"TEXTMODE"
	W	ptxtmode
	B	$0F,"GRAPHBACKGROUND"
	W	pgraphbg
	B	$07,"PALETTE"
	W	ppalette
	B	$0A,"HIRESCOLOR"
	W	phirscol
	B	$0B,"GRAPHWINDOW"
	W	pgrwind
	B	$04,"PLOT"
	W	pplot
	B	$04,"DRAW"
	W	pdraw
	B	$05,"SOUND"
	W	psound
	B	$07,"NOSOUND"
	W	pnosound
	B	$00	;"
stdfuncs	B	$03,"CHR"	;Standard functions
	W	fchr	;vector to COMPILER routine
	B	$03,"ORD"
	W	ford
	B	$04,"COPY"
	W	fcopy
	B	$06,"LENGTH"
	W	flength
	B	$03,"POS"
	W	fpos
	B	$06,"CONCAT"
	W	fconcat
	B	$04,"SUCC"
	W	fsucc
	B	$04,"PRED"
	W	fpred
	B	$06,"UPCASE"
	W	fupcase
	B	$05,"TRUNC"
	W	ftrunc
	B	$05,"ROUND"
	W	fround
	B	$03,"ODD"
	W	fodd
	B	$03,"ABS"
	W	fabs
	B	$03,"SQR"
	W	fsqr
	B	$04,"SQRT"
	W	fsqrt
	B	$03,"SIN"
	W	fsin
	B	$03,"COS"
	W	fcos
	B	$06,"ARCTAN"
	W	farctan
	B	$02,"LN"
	W	fln
	B	$03,"EXP"
	W	fexp
	B	$06,"RANDOM"
	W	frandom
	B	$03,"INT"
	W	fint2
	B	$04,"FRAC"
	W	ffrac
	B	$0A,"PARAMCOUNT"
	W	fparmcnt
	B	$08,"PARAMSTR"
	W	fparmstr
	B	$02,"LO"
	W	flo
	B	$02,"HI"
	W	fhi
	B	$04,"SWAP"
	W	fswap
	B	$08,"IORESULT"
	W	fiores
	B	$03,"EOF"
	W	feof
	B	$04,"EOLN"
	W	feoln
	B	$07,"SEEKEOF"
	W	fseekeof
	B	$08,"SEEKEOLN"
	W	fseekeol
	B	$08,"FILESIZE"
	W	ffilsize
	B	$0C,"LONGFILESIZE"
	W	flfilsiz
	B	$07,"FILEPOS"
	W	ffilpos
	B	$0B,"LONGFILEPOS"
	W	flfilpos
	B	$0A,"KEYPRESSED"
	W	fkeypres
	B	$08,"MAXAVAIL"
	W	fmaxavl
	B	$08,"MEMAVAIL"
	W	fmemavl
	B	$05,"PORTW"
	W	fportw
	B	$04,"PORT"
	W	fport
	B	$04,"ADDR"
	W	faddr
	B	$03,"PTR"
	W	fptr
	B	$03,"OFS"
	W	fofs
	B	$03,"SEG"
	W	fseg
	B	$06,"SIZEOF"
	W	fsizeof
tkdseg	B	$04,"DSEG"
	W	fdseg
tkcseg	B	$04,"CSEG"
	W	fcseg
	B	$04,"SSEG"
	W	fsseg
	B	$06,"WHEREX"
	W	fwherex
	B	$06,"WHEREY"
	W	fwherey	;"
	;*** End of Turbo 3.0 ***
	B	$00