	model	large compiler_text,pascal
	include	compiler.inc

	.data

Defines	db	5,'VER60'
	db	5,'MSDOS'
	db	5,'CPU86'
DefL1	equ	$-Defines
	db	5,'CPU87'
DefL2	equ	$-Defines

	.data?

StartToken	db	?
SymbolToken	db	?
SymbolTextPos	dw	?

	.code	compiler_text

	public	CreateHashTable
	public	AddIdent2Dict
	public	AddNewIdent
	public	LocalAddIdent
	public	AddIdent
	public	GetHash
	public	NeedIdent
	public	CompareSymbol
	public	CalcHash
	public	GetSymbol
	public	SearchSymbol
	public	SearchField
	public	LocalSearch
	public	SearchHash
	public	ChooseToken
	public	GetPlusMinus
	public	GetDirective
	public	CheckDirective
	public	CheckToken
	public	NeedToken
	public	GetToken
	public	ProcessCaret
	public	StandardDefines
	public	GetRawToken
	public	AddToFileStack
	public	MarkFileTime
	public	PopFileStack
	public	UpperCase
	public	CopyPasStr
	public	CopyDSCStr
	public	Pas2C
	public	DSPas2C
	public	CompareStrings
	public	MoveBlock
	public	MoveBlockRev
	public	AllocTempBuf
	public	AddToSourceList

CreateHashTable	proc	near
	mov	cx,ax
	shl	ax,1
	add	ax,2
	Invoke	GetDictMem
	mov	ax,cx
	dec	ax
	shl	ax,1
	stosw
	xor	ax,ax
	rep	stosw
	ret
CreateHashTable	endp

AddIdent2Dict	proc	near
	call	NeedIdent
	call	AddNewIdent
	jmp	GetToken
AddIdent2Dict	endp

AddNewIdent	proc	near
	push	ax
	call	LocalSearch
	pop	ax
	jnz	LocalAddIdent
	mov	ax,4
	Chain	IdentError
AddNewIdent	endp

LocalAddIdent	proc	near
	call	GetHash
AddIdent	label	near
	push	ax
	mov	cl,IdentBuf[0]
	mov	ch,0
	inc	cx
	add	ax,size TSymbol-1
	add	ax,cx
	Invoke	GetDictMem
	mov	bl,SymbolHash
	and	bx,es:[si]
	lea	bx,[bx+si+2]
	mov	ax,es:[bx]
	mov	es:[bx],di
	mov	bx,di
	stosw
	xor	ax,ax
	stosb
	lea	si,IdentBuf
	rep	movsb
	pop	cx
	push	di
	rep	stosb
	pop	di
	ret
LocalAddIdent	endp

GetHash	proc	near
	mov	es,Dictionary.Segm
	mov	si,CurOwner
	or	si,si
	jnz	@@1
	mov	si,CurProc
	or	si,si
	jnz	@@2
	mov	si,es:uhInterface
	ret
@@1:	mov	si,es:[si].rtHash
	ret
@@2:	mov	si,es:[si].psHash
	ret
GetHash	endp

NeedIdent	proc	near
	cmp	CurrentToken,t_Ident
	jne	@@1
	ret
@@1:	mov	ax,2
	Chain	CompileError
NeedIdent	endp

CompareSymbol	proc	near
	cmp	CurrentToken,t_Ident
	jne	@@1
	cmp	al,SymbolHash
	jne	@@1
	push	cx
	lea	si,IdentBuf
	push	ds
	pop	es
	mov	cl,[si]
	xor	ch,ch
	inc	cx
	repe	cmpsb
	pop	cx
@@1:	ret
CompareSymbol	endp

CalcHash	proc	near
	lea	si,IdentBuf
	mov	ah,es:[di]
	mov	[si],ah
	inc	di
	inc	si
	xor	bl,bl
@@1:	mov	al,es:[di]
	cmp	al,'a'
	jb	@@2
	cmp	al,'z'
	ja	@@2
	sub	al,'a'-'A'
@@2:	mov	[si],al
	inc	di
	inc	si
	dec	al
	add	bl,al
	dec	ah
	jnz	@@1
	add	bl,bl
	mov	SymbolHash,bl
	ret
CalcHash	endp

GetSymbol	proc	near
	cmp	CurrentToken,t_Ident
	jne	@@2
	test	CompilerFlags.B0,cfDebugging
	jnz	@@4
	push	si di
	call	SearchSymbol
	jnz	@@3
	cmp	al,t_Unit
	jne	@@1
	call	GetToken
	mov	al,tPoint
	call	NeedToken
	call	NeedIdent
	mov	es,es:[di]
	mov	di,es:uhInterface
	call	SearchHash
	jnz	@@3
@@1:	mov	CurrentToken,al
	mov	CurrentHash,bx
	mov	CurrentSymbol.Offs,di
	mov	CurrentSymbol.Segm,es
	pop	di si
@@2:	ret
@@3:	mov	ax,3
	Chain	CompileError
@@4:	push	si di
	call	FindUnitName
	jz	@@7
	call	SearchSymbol
	jz	@@7
	mov	ax,FirstUnit
@@5:	mov	es,ax
	call	DebuggingSearch
	jz	@@7
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@5
@@6:	mov	ax,3
	Chain	CompileError
@@7:	call	GiveSymbol
	cmp	al,t_Unit
	jne	@@8
	call	NeedField
	jnz	@@11
	call	DebuggingSearch
	jnz	@@6
	call	GiveSymbol
@@8:	cmp	al,t_Type
	jne	@@9
	mov	si,es:[di].tsType.Offs
	mov	di,es:[di].tsType.Segm
	mov	es,es:[di]
	cmp	es:[si].tdType,ttObject
	jne	@@11
	call	NeedField
	jnz	@@11
	call	SearchField
	jnz	@@6
	call	GetToken
	cmp	al,t_Proc
	jne	@@11
	jmp	short @@10
@@9:	cmp	al,t_Proc
	jne	@@11
	test	es:[di].psFlags,pfInline+pfMethod
	jnz	@@11
@@10:	call	NeedField
	jnz	@@11
	mov	di,es:[di].psHash
	call	SearchHash
	jnz	@@6
	call	GiveSymbol
	jmp	@@9
@@11:	mov	ax,SymbolTextPos
	mov	bx,FileStackPtr
	mov	[bx],ax
	call	GetToken
	mov	al,SymbolToken
	mov	CurrentToken,al
	pop	di si
	ret
GetSymbol	endp

DebuggingSearch	proc	near
	mov	di,es:uhDebugHash
	call	SearchHash
	jz	@@1
	mov	ax,es
	cmp	ax,SystemUnit
	jne	@@1
	lea	di,RegVars
	push	cs
	pop	es
	call	SearchHash
	jz	@@1
	mov	es,SystemUnit
@@1:	ret
DebuggingSearch	endp

GiveSymbol	proc	near
	mov	SymbolToken,al
	mov	CurrentHash,bx
	mov	CurrentSymbol.offs,di
	mov	CurrentSymbol.segm,es
	mov	bx,TextPos
	mov	SymbolTextPos,bx
	jmp	GetToken
GiveSymbol	endp

NeedField	proc	near
	cmp	CurrentToken,tPoint
	jne	@@1
	call	GetToken
	jmp	NeedIdent
@@1:	ret
NeedField	endp

SearchSymbol	proc	near
	mov	si,WithChain
	jmp	short @@2
@@1:	les	si,[si].wcOwner
	call	SearchField
	jz	@@8
	mov	si,CurrentWith
	mov	si,[si].wcNext
@@2:	mov	CurrentWith,si
	or	si,si
	jnz	@@1
	mov	es,Dictionary.Segm
	mov	si,CurScope
	jmp	short @@4
@@3:	mov	bl,es:[si].seName.B0
	mov	bh,0
	lea	si,[si+size TSymbol+bx]
	push	si
	call	SearchLocal
	pop	si
	jz	@@7
	mov	es,Dictionary.Segm
	test	es:[si].psFlags,pfMethod
	jnz	@@5
	mov	si,es:[si].psScope
@@4:	or	si,si
	jnz	@@3
@@5:	mov	si,es:uhName
@@6:	mov	bl,es:[si].seName.B0
	mov	bh,0
	lea	si,[si+size TSymbol+bx]
	mov	es,es:[si]
	mov	di,es:uhInterface
	push	si
	call	SearchHash
	pop	si
	jz	@@7
	mov	es,Dictionary.Segm
	mov	si,es:[si].usPrev
	or	si,si
	jnz	@@6
	dec	si
	ret
@@7:	xor	si,si
@@8:	ret
SearchSymbol	endp

SearchLocal	proc	near
	mov	di,es:[si].psHash
	push	si
	call	SearchHash
	pop	si
	jz	@@1
	test	es:[si].psFlags,pfMethod
	jnz	@@2
	or	si,si
@@1:	ret
@@2:	mov	si,es:[si].psScope
SearchField	label	near
	mov	CurrentOwner.Offs,si
	mov	CurrentOwner.Segm,es
@@3:	mov	di,es:[si].rtHash
	push	si
	call	SearchHash
	pop	si
	jz	@@5
	cmp	es:[si].tdType,ttObject
	jne	@@5
	mov	bx,es:[si].otParent.Segm
	or	bx,bx
	jz	@@4
	mov	si,es:[si].otParent.Offs
	mov	es,es:[bx]
	jmp	@@3
@@4:	dec	bx
@@5:	ret
SearchLocal	endp

LocalSearch	proc	near
	mov	es,Dictionary.Segm
	mov	si,CurOwner
	or	si,si
	jnz	SearchField
	mov	si,CurProc
	or	si,si
	jnz	SearchLocal
	mov	di,es:uhInterface
SearchHash	label	near
	mov	bl,SymbolHash
	and	bx,es:[di]
	mov	bx,es:[bx+di+2]
	or	bx,bx
	jz	@@3
	lea	ax,IdentBuf
	mov	dl,IdentBuf[0]
	mov	dh,0
	inc	dx
@@1:	lea	di,[bx].seName
	mov	si,ax
	mov	cx,dx
	repe	cmpsb
	je	@@4
@@2:	mov	bx,es:[bx]
	or	bx,bx
	jnz	@@1
@@3:	dec	bx
	ret
@@4:	mov	al,es:[bx].seType
	test	al,t_Private
	jnz	@@5
	ret
@@5:	and	al,not t_Private
	mov	cx,es
	cmp	cx,Dictionary.Segm
	jne	@@2
	ret
LocalSearch	endp

FindUnitName	proc	near
	lea	bx,IdentBuf
_FindUnitName	label	near
	mov	ax,FirstUnit
	mov	dl,[bx]
	mov	dh,0
	inc	dx
@@1:	mov	es,ax
	mov	di,es:uhName
	add	di,seName
	mov	cx,dx
	mov	si,bx
	repe	cmpsb
	je	@@2
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@1
	dec	ax
	ret
@@2:	mov	al,t_Unit
	mov	bx,es:uhName
	ret
FindUnitName	endp

ChooseToken	proc	near
	mov	cl,cs:[bx]
	xor	ch,ch
	inc	bx
	mov	dl,cs:[bx]
	xor	dh,dh
	inc	bx
	mov	al,CurrentToken
@@1:	cmp	al,cs:[bx]
	je	@@2
	add	bx,dx
	loop	@@1
	dec	cx
@@2:	ret
ChooseToken	endp

GetPlusMinus	proc	near
	mov	al,CurrentToken
	cmp	al,tMinus
	je	@@1
	cmp	al,tPlus
	je	@@1
	xor	al,al
	ret
@@1:	jmp	GetToken
GetPlusMinus	endp

GetDirective	proc	near
	cmp	CurrentToken,t_Ident
	jne	@@2
	push	es di si dx cx bx ax
	lea	di,ProcDirs
	push	cs
	pop	es
	call	SearchHash
	jnz	@@1
	mov	CurrentToken,al
@@1:	pop	ax bx cx dx si di es
@@2:	ret
GetDirective	endp

CheckDirective	proc	near
	call	GetDirective
CheckToken	label	near
	cmp	al,CurrentToken
	je	@@1
	ret
@@1:	jmp	GetToken
CheckDirective	endp

Codes	db	t_Ident,2
	db	t_Label,35
	db	tBegin,36
	db	tEnd,37
	db	tDo,50
	db	tOf,54
	db	tInterface,55
	db	tThen,57
	db	tImplementation,73
	db	tUnit,84
	db	tSemicolon,85
	db	tColon,86
	db	tComma,87
	db	tOParen,88
	db	tCParen,89
	db	tEqual,90
	db	tConstEqual,90
	db	tAssign,91
	db	tOBracket,92
	db	tCBracket,93
	db	tPoint,94
	db	tRange,95
	db	tNil,120
CodesS	equ	($-Codes) shr 1

NeedToken	proc	near
	cmp	al,CurrentToken
	jne	@@1
	jmp	GetToken
@@1:	lea	bx,Codes
	mov	cx,CodesS
@@2:	mov	dx,cs:[bx]
	cmp	al,dl
	je	@@3
	inc	bx
	inc	bx
	loop	@@2
	mov	dh,5
@@3:	mov	al,dh
	xor	ah,ah
	Chain	CompileError
NeedToken	endp

GetToken	proc	near
	push	ax bx cx dx si di es
	test	CompilerFlags.B0,cfDebugging
	jnz	@@1
	Invoke	UpdateCompInfo
@@1:	call	GetRawToken
	mov	TextPos,si
	mov	ax,[si]
	or	al,al
	jz	@@4
	cmp	al,'0'
	jb	@@7
	cmp	al,'9'
	jbe	@@3
	cmp	al,'A'
	jb	@@6
	cmp	al,'Z'
	jbe	@@2
	cmp	al,'a'
	jb	@@5
	cmp	al,'z'
	ja	@@10
@@2:	call	Ident
	jmp	short @@8
@@3:	call	Number
	jmp	short @@8
@@4:	mov	al,0
	jmp	short @@8
@@5:	sub	al,'Z'-'A'+1
@@6:	sub	al,'9'-'0'+1
@@7:	sub	al,' '+1
	mov	bl,al
	xor	bh,bh
	add	bx,bx
	call	cs:@@11[bx]
@@8:	mov	CurrentToken,al
	mov	di,FileStackPtr
	mov	[di],si
	xor	ax,ax
	pop	es di si dx cx bx
@@9:	pop	ax
	ret
@@10:	mov	ax,5
	Chain	CompileError
@@11	dw	@@10			; !
	dw	@@10			; "
	dw	String			; #
	dw	IntNumber		; $
	dw	@@10			; %
	dw	@@10			; &
	dw	String			; '
	dw	OParen			; (
	dw	CParen			; )
	dw	Times			; *
	dw	Plus			; +
	dw	Comma			; ,
	dw	Minus			; -
	dw	Point			; .
	dw	Slash			; /
	dw	Colon			; :
	dw	Semicolon		; ;
	dw	Less			; <
	dw	Equal			; =
	dw	Greater			; >
	dw	@@10			; ?
	dw	At			; @
	dw	OBracket		; [
	dw	@@10			; \
	dw	CBracket		; ]
	dw	Caret			; ^
	dw	Ident			; _
	dw	@@10			; `
GetToken	endp

Ident	proc	near
	lea	di,IdentBuf
	xor	cx,cx
@@1:	mov	al,[si]
	cmp	al,'0'
	jb	@@3
	cmp	al,'9'
	jbe	@@2
	cmp	al,'_'
	je	@@2
	and	al,0dfh
	cmp	al,'A'
	jb	@@3
	cmp	al,'Z'
	ja	@@3
@@2:	inc	si
	cmp	cl,63
	je	@@1
	inc	di
	inc	cl
	mov	[di],al
	dec	al
	add	ch,al
	jmp	@@1
@@3:	mov	IdentBuf[0],cl
	add	ch,ch
	mov	SymbolHash,ch
	lea	di,KeyWords
	push	cs
	pop	es
	push	si
	call	SearchHash
	pop	si
	jz	@@4
	mov	al,t_Ident
@@4:	ret
Ident	endp

Number	proc	near
	mov	bx,si
@@1:	inc	bx
	mov	ax,[bx]
	cmp	al,'0'
	jb	@@2
	cmp	al,'9'
	jbe	@@1
@@2:	call	UpperCase
	cmp	al,'E'
	je	@@3
	cmp	al,'.'
	jne	IntNumber
	cmp	ah,'.'
	je	IntNumber
	cmp	ah,')'
	je	IntNumber
@@3:	lea	bx,SymbolValue
	Invoke	Str2Extended
	jc	@@4
	mov	ax,_Extended
	jmp	GiveConst
@@4:	mov	TextPos,si
	mov	ax,6
	Chain	CompileError
Number	endp

IntNumber	proc	near
	Invoke	Str2Long
	jc	@@1
	mov	SymbolValue.W0,ax
	mov	SymbolValue.W2,dx
	mov	ax,_Longint
	jmp	GiveConst
@@1:	mov	TextPos,si
	mov	ax,7
	Chain	CompileError
IntNumber	endp

String	proc	near
	mov	ax,128
	call	AllocTempBuf
	mov	SymbolValue.W0,bx
	inc	bx
	xor	cx,cx
@@1:	mov	al,[si]
	cmp	al,''''
	jne	@@5
@@2:	inc	si
	mov	al,[si]
	or	al,al
	jz	@@4
	cmp	al,''''
	jne	@@3
	inc	si
	mov	al,[si]
	cmp	al,''''
	jne	@@1
@@3:	mov	[bx],al
	inc	bx
	inc	cx
	jmp	@@2
@@4:	mov	TextPos,si
	mov	ax,8
	Chain	CompileError
@@5:	cmp	al,'^'
	jne	@@7
	inc	si
	mov	al,[si]
	call	UpperCase
	or	al,al
	jz	@@4
	inc	si
	xor	al,40h
@@6:	mov	[bx],al
	inc	bx
	inc	cx
	jmp	@@1
@@7:	cmp	al,'#'
	jne	@@8
	inc	si
	push	bx cx
	Invoke	Str2Long
	pop	cx bx
	jnc	@@6
	mov	TextPos,si
	mov	ax,7
	Chain	CompileError
@@8:	mov	byte ptr [bx],0
	inc	bx
	mov	TempBufPtr,bx
	mov	bx,SymbolValue.W0
	mov	[bx],cl
	mov	ax,_String
	dec	cx
	jnz	GiveConst
	mov	al,[bx+1]
	xor	ah,ah
	cwd
	mov	SymbolValue.W0,ax
	mov	SymbolValue.W2,dx
	mov	ax,_Char
GiveConst	label	near
	mov	SymbolType.offs,ax
	mov	ax,SystemUnit
	mov	SymbolType.segm,ax
	mov	al,t_Constant
	ret
String	endp

OParen	proc	near
	mov	al,tOParen
	cmp	ah,'.'
	jne	@@1
	mov	al,tOBracket
	inc	si
@@1:	inc	si
	ret
OParen	endp

CParen	proc	near
	mov	al,tCParen
	inc	si
	ret
CParen	endp

Times	proc	near
	mov	al,tTimes
	inc	si
	ret
Times	endp

Plus	proc	near
	mov	al,tPlus
	inc	si
	ret
Plus	endp

Comma	proc	near
	mov	al,tComma
	inc	si
	ret
Comma	endp

Minus	proc	near
	mov	al,tMinus
	inc	si
	ret
Minus	endp

Point	proc	near
	mov	al,tRange
	cmp	ah,'.'
	je	@@1
	mov	al,tPoint
	cmp	ah,')'
	jne	@@2
	mov	al,tCBracket
@@1:	inc	si
@@2:	inc	si
	ret
Point	endp

Slash	proc	near
	mov	al,SlashToken
	inc	si
	ret
Slash	endp

Colon	proc	near
	mov	al,tColon
	cmp	ah,'='
	jne	@@1
	mov	al,tAssign
	inc	si
@@1:	inc	si
	ret
Colon	endp

Semicolon	proc	near
	mov	al,tSemicolon
	inc	si
	ret
Semicolon	endp

Less	proc	near
	mov	al,tNotEqual
	cmp	ah,'>'
	je	@@1
	mov	al,tLess
	cmp	ah,'='
	jne	@@2
	mov	al,tLEq
@@1:	inc	si
@@2:	inc	si
	ret
Less	endp

Equal	proc	near
	mov	al,EqualToken
	inc	si
	ret
Equal	endp

Greater	proc	near
	mov	al,tGreater
	cmp	ah,'='
	jne	@@1
	mov	al,tGEq
	inc	si
@@1:	inc	si
	ret
Greater	endp

At	proc	near
	mov	al,tAt
	inc	si
	ret
At	endp

OBracket	proc	near
	mov	al,tOBracket
	inc	si
	ret
OBracket	endp

CBracket	proc	near
	mov	al,tCBracket
	inc	si
	ret
CBracket	endp

Caret	proc	near
	mov	al,tCaret
	inc	si
	ret
Caret	endp

ProcessCaret	proc	near
	cmp	CurrentToken,tCaret
	jne	@@1
	push	si di
	mov	di,FileStackPtr
	mov	si,[di].fsTextPos
	dec	si
	call	String
	mov	CurrentToken,al
	mov	di,FileStackPtr
	mov	[di],si
	pop	di si
@@1:	ret
ProcessCaret	endp

StandardDefines	proc	near
	mov	cx,DefL1
	Invoke	CheckFpu
	jnz	@@1
	mov	cx,DefL2
@@1:	lea	si,Defines
	mov	ax,DefinesPtr
	mov	di,ax
	add	ax,cx
	cmp	ax,offset DefinesBuf+1024
	ja	@@4
	mov	DefinesPtr,ax
	push	ds
	pop	es
	rep	movsb
	mov	si,InitDefines
@@2:	call	ParseString
	cmp	byte ptr [si],0
	je	@@3
	call	GetWord
	cmp	FileNameBuf[0],0
	je	@@5
	call	AddDefine
	jmp	@@2
@@3:	ret
@@4:	mov	ax,127
	Chain	CompileError
@@5:	mov	ax,130
	Chain	CompileError
StandardDefines	endp

GetRawToken	proc	near
@@1:	mov	di,FileStackPtr
	mov	si,[di].fsTextPos
@@2:	lodsb
	or	al,al
	jz	@@4
	cmp	al,' '
	jbe	@@2
	dec	si
	test	CompilerFlags.B0,cfDebugging
	jnz	@@6
	mov	ax,[si]
	cmp	al,'{'
	je	@@3
	cmp	ax,'*('
	jne	@@6
	inc	si
@@3:	inc	si
	call	ProcessComment
	jmp	@@2
@@4:	test	CompilerFlags.B0,cfDebugging
	jnz	@@5
	call	GetChar
	jnz	@@2
	mov	di,FileStackPtr
	mov	[di].fsTextPos,si
	call	PopFileStack
	jmp	@@1
@@5:	dec	si
@@6:	ret
GetRawToken	endp

ProcessComment	proc	near
	mov	StartToken,al
	cmp	byte ptr [si],'$'
	je	@@1
	jmp	SkipComment
@@1:	inc	si
	call	SearchDirective
	jc	DirError
	mov	ax,cs:DirValues[bx]
	or	ax,ax
	jz	@@4
	mov	dx,ax
	and	ax,not coGlobal
	cmp	byte ptr [si],'+'
	jne	@@2
	or	GlobalOptions,ax
	jmp	short @@3
@@2:	cmp	byte ptr [si],'-'
	jne	@@4
	not	ax
	and	GlobalOptions,ax
@@3:	and	dx,coGlobal
	and	dx,GlobalOptions
	jnz	DirError
	inc	si
	cmp	byte ptr [si],','
	je	@@1
	jmp	SkipComment
@@4:	jmp	cs:DirProcs[bx]
ProcessComment	endp

DirError	proc	near
	mov	ax,17
	Chain	CompileError
DirError	endp

DefineDir	proc	near
	call	GetOneWord
	call	AddDefine
	jmp	SkipComment
DefineDir	endp

ElseDir	proc	near
	mov	di,FileStackPtr
	cmp	[di].fsNestLevel,0
	je	@@2
	push	di
	call	SkipComment
	call	SkipIfDef
	pop	di
	jz	@@1
	dec	[di].fsNestLevel
@@1:	ret
@@2:	mov	ax,128
	Chain	CompileError
ElseDir	endp

EndIfDir	proc	near
	mov	di,FileStackPtr
	cmp	[di].fsNestLevel,0
	je	@@1
	dec	[di].fsNestLevel
	jmp	SkipComment
@@1:	mov	ax,128
	Chain	CompileError
EndIfDir	endp

IDir	proc	near
	call	GetFileName
	call	SkipComment
	mov	di,FileStackPtr
	mov	[di].fsTextPos,si
	mov	TextPos,si
	mov	ax,fePas
	lea	dx,FileNameBuf
	Invoke	ConvertName
	mov	al,fdIncludeDir
	lea	dx,FileNameBuf
	call	AddToSourceList
	push	ax
	mov	ax,fdIncludeDir*256
	lea	dx,FileNameBuf
	Invoke	ConvertName
	pop	ax
	lea	dx,FileNameBuf
	call	AddToFileStack
	call	MarkFileTime
	mov	di,FileStackPtr
	mov	si,[di].fsTextPos
	ret
IDir	endp

IfDefDir	proc	near
	call	GetOneWord
	call	SearchDefine
_IfDef	label	near
	push	ax
	call	SkipComment
	pop	ax
	mov	di,FileStackPtr
	inc	[di].fsNestLevel
	or	ax,ax
	jnz	@@1
	push	di
	call	SkipIfDef
	pop	di
	jz	@@1
	dec	[di].fsNestLevel
@@1:	ret
IfDefDir	endp

IfNDefDir	proc	near
	call	GetOneWord
	call	SearchDefine
	not	ax
	jmp	_IfDef
IfNDefDir	endp

IfOptDir	proc	near
	call	ParseString
	call	SearchDirective
	jc	@@2
	mov	ax,cs:DirValues[bx]
	or	ax,ax
	jz	@@2
	and	ax,not coGlobal
	mov	dx,GlobalOptions
	cmp	byte ptr [si],'+'
	je	@@1
	cmp	byte ptr [si],'-'
	jne	@@2
	not	dx
@@1:	and	ax,dx
	jmp	_IfDef
@@2:	jmp	DirError
IfOptDir	endp

LDir	proc	near
	call	GetFileName
	mov	ax,feObj
	lea	dx,FileNameBuf
	Invoke	ConvertName
	mov	al,fdObjectDir
	lea	dx,FileNameBuf
	push	si
	call	AddToSourceList
	pop	si
	jmp	SkipComment
LDir	endp

MDir	proc	near
	call	GetInt
	jc	@@1
	or	dx,dx
	jnz	@@1
	cmp	ax,1024
	jb	@@1
	cmp	ax,65520
	ja	@@1
	mov	StackSize,ax
	call	GetPara
	jc	@@1
	cmp	ax,40960
	ja	@@1
	mov	MinHeapSize,ax
	call	GetPara
	jc	@@1
	cmp	ax,MinHeapSize
	jb	@@1
	cmp	ax,40960
	ja	@@1
	mov	MaxHeapSize,ax
	jmp	SkipComment
@@1:	jmp	DirError
MDir	endp

ODir	proc	near
	cmp	ProgramSection,0
	jge	@@1
	test	CompilerFlags.B0,cfDisk
	jz	@@2
	call	GetOneWord
	push	si
	lea	bx,FileNameBuf
	call	_FindUnitName
	jnz	@@3
	test	es:uhFlags,ufOverlay
	jz	@@4
	mov	es:uhOverlayLength,-1
	pop	si
	jmp	SkipComment
@@1:	mov	ax,17
	Chain	CompileError
@@2:	mov	ax,141
	Chain	CompileError
@@3:	mov	ax,3
	Chain	CompileError
@@4:	mov	ax,144
	Chain	CompileError
ODir	endp

UndefDir	proc	near
	call	GetOneWord
	call	DeleteDefine
	jmp	SkipComment
UndefDir	endp

AddDefine	proc	near
	call	SearchDefine
	or	ax,ax
	jnz	@@1
	push	si
	lea	si,FileNameBuf
	mov	cl,[si]
	xor	ch,ch
	inc	cx
	mov	ax,DefinesPtr
	mov	di,ax
	add	ax,cx
	cmp	ax,offset DefinesBuf+1024
	ja	@@2
	mov	DefinesPtr,ax
	rep	movsb
	pop	si
@@1:	ret
@@2:	mov	ax,127
	Chain	CompileError
AddDefine	endp

DeleteDefine	proc	near
	call	SearchDefine
	or	ax,ax
	jz	@@1
	push	si
	mov	si,di
	lodsb
	xor	ah,ah
	add	si,ax
	mov	cx,DefinesPtr
	sub	cx,si
	rep	movsb
	mov	DefinesPtr,di
	pop	si
@@1:	ret
DeleteDefine	endp

SearchDefine	proc	near
	push	si
	mov	di,SaveDefinesPtr
	push	ds
	pop	es
	xor	ax,ax
@@1:	cmp	di,DefinesPtr
	je	@@3
	mov	cl,[di]
	xor	ch,ch
	inc	cx
	push	cx di
	lea	si,FileNameBuf
	repe	cmpsb
	pop	di cx
	jz	@@2
	add	di,cx
	jmp	@@1
@@2:	dec	ax
@@3:	pop	si
	ret
SearchDefine	endp

SkipComment	proc	near
	cmp	StartToken,'{'
	jne	@@3
@@1:	lodsb
	or	al,al
	jz	@@2
	cmp	al,'}'
	jne	@@1
	ret
@@2:	call	GetChar
	jnz	@@1
	jmp	short @@6
@@3:	xor	ah,ah
@@4:	mov	ah,al
	lodsb
	or	al,al
	jz	@@5
	cmp	ax,'*)'
	jne	@@4
	ret
@@5:	call	GetChar
	jnz	@@3
@@6:	mov	ax,10
	Chain	CompileError
SkipComment	endp

SkipIfDef	proc	near
	xor	dl,dl
@@1:	xor	dh,dh
@@2:	mov	ax,[si]
	or	al,al
	jz	@@4
	cmp	al,''''
	je	@@5
	or	dh,dh
	jnz	@@3
	cmp	al,'{'
	je	@@7
	cmp	ax,'*('
	je	@@6
@@3:	inc	si
	jmp	@@2
@@4:	push	dx
	call	GetChar
	pop	dx
	jnz	@@1
	mov	ax,129
	Chain	CompileError
@@5:	not	dh
	jmp	@@3
@@6:	inc	si
@@7:	inc	si
	mov	StartToken,al
	cmp	byte ptr [si],'$'
	jne	@@8
	inc	si
	push	dx
	call	SearchDirective
	pop	dx
	jc	@@8
	mov	al,bl
	mov	cx,100h
	cmp	al,6*2			; $ELSE
	nop
	nop
	je	@@9
	mov	cx,1ffh
	cmp	al,7*2			; $ENDIF
	nop
	nop
	je	@@9
	mov	cx,1
	cmp	al,11*2			; $IFDEF
	nop
	nop
	je	@@9
	cmp	al,12*2			; $IFNDEF
	nop
	nop
	je	@@9
	cmp	al,13*2			; $IFOPT
	nop
	nop
	je	@@9
@@8:	xor	cx,cx
@@9:	push	cx dx
	call	SkipComment
	pop	dx cx
	or	ch,ch
	jz	@@10
	or	dl,dl
	jz	@@11
@@10:	add	dl,cl
	jmp	@@1
@@11:	or	cl,cl
	ret
SkipIfDef	endp

SearchDirective	proc	near
	lea	di,Directives
	mov	TextPos,si
	call	GetWord
	push	cs
	pop	es
	xor	bx,bx
@@1:	mov	cl,es:[di]
	xor	ch,ch
	jcxz	@@2
	inc	cx
	push	si
	lea	si,FileNameBuf
	repe	cmpsb
	pop	si
	je	@@3
	add	di,cx
	inc	bx
	inc	bx
	jmp	@@1
@@2:	stc
@@3:	ret
SearchDirective	endp

GetOneWord	proc	near
	call	ParseString
	mov	TextPos,si
	call	GetWord
	cmp	FileNameBuf[0],0
	je	@@1
	ret
@@1:	mov	ax,2
	Chain	CompileError
GetOneWord	endp

GetWord	proc	near
	xor	bx,bx
	mov	al,[si]
@@1:	cmp	al,'_'
	je	@@2
	and	al,0dfh
	cmp	al,'A'
	jb	@@3
	cmp	al,'Z'
	ja	@@3
@@2:	inc	si
	inc	bx
	mov	FileNameBuf[bx],al
	cmp	bx,63
	jz	@@3
	mov	al,[si]
	cmp	al,'0'
	jb	@@3
	cmp	al,'9'
	jbe	@@2
	jmp	@@1
@@3:	mov	FileNameBuf[0],bl
	ret
GetWord	endp

GetFileName	proc	near
	call	ParseString
	mov	TextPos,si
	xor	bx,bx
@@1:	mov	al,[si]
	cmp	al,' '
	jbe	@@3
	cmp	al,'*'
	je	@@3
	cmp	al,'}'
	je	@@3
	cmp	al,'a'
	jb	@@2
	cmp	al,'z'
	ja	@@2
	sub	al,'a'-'A'
@@2:	mov	FileNameBuf[bx],al
	inc	si
	inc	bx
	cmp	bx,79
	jne	@@1
@@3:	mov	FileNameBuf[bx],0
	ret
GetFileName	endp

GetPara	proc	near
	call	GetInt
	jc	@@2
	add	ax,15
	adc	dx,0
	jc	@@2
	mov	cx,4
@@1:	shr	dx,1
	rcr	ax,1
	loop	@@1
	or	dx,dx
	jz	@@2
	stc
@@2:	ret
GetPara	endp

GetInt	proc	near
	call	ParseString
	mov	TextPos,si
	Chain	Str2Long
GetInt	endp

ParseString	proc	near
@@1:	mov	al,[si]
	or	al,al
	jz	@@3
	cmp	al,' '
	jbe	@@2
	cmp	al,','
	je	@@2
	cmp	al,';'
	jne	@@3
@@2:	inc	si
	jmp	@@1
@@3:	ret
ParseString	endp

Directives	db	1,'A'
		db	1,'B'
		db	4,'CODE'
		db	1,'D'
		db	6,'DEFINE'
		db	1,'E'
		db	4,'ELSE'
		db	5,'ENDIF'
		db	1,'F'
		db	1,'G'
		db	1,'I'
		db	5,'IFDEF'
		db	6,'IFNDEF'
		db	5,'IFOPT'
		db	1,'L'
		db	1,'M'
		db	1,'N'
		db	1,'O'
		db	1,'R'
		db	1,'S'
		db	5,'UNDEF'
		db	1,'V'
		db	1,'W'
		db	1,'X'
		db	0

DirValues	dw	coWordAlign+coGlobal	; $A
		dw	coBooleanEval		; $B
		dw	0
		dw	coDebugInfo+coGlobal	; $D
		dw	0
		dw	coEmulation+coGlobal	; $E
		dw	0
		dw	0
		dw	coForceFarCalls		; $F
		dw	co286Code		; $G
		dw	coIOChk			; $I
		dw	0
		dw	0
		dw	0
		dw	coLocalSymbols+coGlobal	; $L
		dw	0
		dw	co8087+coGlobal		; $N
		dw	coOverlayCode+coGlobal	; $O
		dw	coRangeChk		; $R
		dw	coStackChk		; $S
		dw	0
		dw	coVarStringChk		; $V
		dw	coWinFrame		; $W
		dw	coExtSyntax+coGlobal	; $X

DirProcs	dw	DirError
		dw	DirError
		dw	SkipComment		; $CODE
		dw	DirError
		dw	DefineDir		; $DEFINE
		dw	DirError
		dw	ElseDir			; $ELSE
		dw	EndIfDir		; $ENDIF
		dw	DirError
		dw	DirError
		dw	IDir			; $I
		dw	IfDefDir		; $IFDEF
		dw	IfNDefDir		; $IFNDEF
		dw	IfOptDir		; $IFOPT
		dw	LDir			; $L
		dw	MDir			; $M
		dw	DirError
		dw	ODir			; $O
		dw	SkipComment		; $R
		dw	DirError
		dw	UndefDir		; $UNDEF
		dw	DirError
		dw	DirError
		dw	DirError

GetChar	proc	near
	mov	bx,FileStackPtr
	mov	ax,[bx].fsLineLength
	cwd
	add	[bx].fsFilePos.W0,ax
	adc	[bx].fsFilePos.W2,dx
	mov	cx,128
	xor	dx,dx
	mov	si,SourceBufPtr
	lea	di,[bx].fsCurrentLine
	push	ds
	pop	es
	mov	bx,SourceBufEnd
@@1:	cmp	si,bx
	je	@@5
@@2:	lodsb
	inc	dx
	cmp	al,' '
	jb	@@4
@@3:	stosb
	loop	@@1
	dec	di
	call	@@6
	dec	di
	mov	TextPos,di
	mov	ax,11
	Chain	CompileError
@@4:	cmp	al,0dh
	je	@@1
	cmp	al,0ah
	je	@@6
	or	al,al
	jz	@@1
	cmp	al,1ah
	jne	@@3
	dec	si
	dec	dx
	jmp	short @@6
@@5:	push	cx dx
	lea	ax,SourceBuffer
	mov	dx,ds
	lea	cx,SourceBuffer[1024]
	sub	cx,ax
	mov	bx,FileStackPtr
	mov	bx,[bx].fsFileHandle
	Invoke	ReadHandle
	pop	dx cx
	lea	si,SourceBuffer
	mov	bx,si
	add	bx,ax
	mov	SourceBufEnd,bx
	or	ax,ax
	jnz	@@2
@@6:	xor	al,al
	stosb
	mov	bx,FileStackPtr
	mov	[bx].fsLineLength,dx
	or	dx,dx
	jz	@@7
	inc	[bx].fsLineNumber
	add	TotalLines.W0,1
	adc	TotalLines.W2,0
@@7:	mov	SourceBufPtr,si
	lea	si,[bx].fsCurrentLine
	mov	TextPos,si
	or	dx,dx
	ret
GetChar	endp

AddToFileStack	proc	near
	cmp	InStmtPart,0
	jne	@@1
	mov	di,FileStackPtr
	cmp	di,offset FileStack
	je	@@2
	sub	di,size TFileStack
	mov	[di].fsNameEntry,ax
	push	di
	mov	si,dx
	lea	di,[di].fsName
	call	CopyDSCStr
	pop	di
	Invoke	OpenHandle
	mov	[di].fsFileHandle,ax
	lea	ax,[di].fsName
	mov	[di].fsFileName,ax
	lea	ax,[di].fsCurrentLine
	mov	[di].fsTextPos,ax
	mov	TextPos,ax
	xor	ax,ax
	mov	[di].fsLineNumber,ax
	mov	[di].fsFilePos.W0,ax
	mov	[di].fsFilePos.W2,ax
	mov	[di].fsLineLength,ax
	mov	[di].fsCurrentLine[0],al
	mov	[di].fsNestLevel,ax
	mov	SourceBufPtr,ax
	mov	SourceBufEnd,ax
	mov	FileStackPtr,di
	Chain	StartFileInfo
@@1:	mov	ax,118
	Chain	CompileError
@@2:	mov	ax,9
	Chain	CompileError
AddToFileStack	endp

MarkFileTime	proc	near
	mov	di,FileStackPtr
	mov	bx,[di].fsFileHandle
	Invoke	HandleTime
	mov	bx,[di].fsNameEntry
	mov	es,SourceList.Segm
	mov	es:[bx].slTimeStamp.W0,ax
	mov	es:[bx].slTimeStamp.W2,dx
	ret
MarkFileTime	endp

PopFileStack	proc	near
	cmp	InStmtPart,0
	jne	@@2
	mov	di,FileStackPtr
	cmp	di,SaveFileStack
	je	@@2
	cmp	[di].fsNestLevel,0
	jne	@@3
	Invoke	EndFileInfo
	mov	bx,[di].fsFileHandle
	Invoke	CloseHandle
	add	di,size TFileStack
	mov	FileStackPtr,di
	cmp	di,offset FileStack[15*size TFileStack]
	je	@@1
	mov	ax,[di].fsTextPos
	mov	TextPos,ax
	mov	ax,[di].fsFilePos.W0
	mov	dx,[di].fsFilePos.W2
	add	ax,[di].fsLineLength
	adc	dx,0
	xor	cx,cx
	mov	bx,[di].fsFileHandle
	Invoke	SeekHandle
	xor	ax,ax
	mov	SourceBufPtr,ax
	mov	SourceBufEnd,ax
	Chain	StartFileInfo
@@1:	ret
@@2:	mov	ax,10
	Chain	CompileError
@@3:	mov	ax,129
	Chain	CompileError
PopFileStack	endp

UpperCase	proc	near
	cmp	al,'a'
	jb	@@1
	cmp	al,'z'
	ja	@@1
	sub	al,'a'-'A'
@@1:	ret
UpperCase	endp

CopyPasStr	proc	near
	call	Swap
	call	_CopyPasStr
Swap	label	near
	xchg	si,di
	push	ds es
	pop	ds es
	ret
CopyPasStr	endp

CopyDSPasStr	proc	near
	push	ds
	pop	es
_CopyPasStr	label	near
	lodsb
	stosb
	mov	cl,al
	xor	ch,ch
	rep	movsb
	ret
CopyDSPasStr	endp

CopyCStr	proc	near
	call	Swap
	call	_CopyCStr
	jmp	Swap
CopyCStr	endp

CopyDSCStr	proc	near
	push	ds
	pop	es
_CopyCStr	label	near
@@1:	lodsb
	stosb
	or	al,al
	jnz	@@1
	ret
CopyDSCStr	endp

Pas2C	proc	near
	call	Swap
	call	_Pas2C
	jmp	Swap
Pas2C	endp

DSPas2C	proc	near
	push	ds
	pop	es
_Pas2C	label	near
	lodsb
	mov	cl,al
	xor	ch,ch
	rep	movsb
	xor	al,al
	stosb
	ret
DSPas2C	endp

CompareStrings	proc	near
	lodsb
	mov	ah,es:[di]
	inc	di
	mov	cl,al
	cmp	cl,ah
	jbe	@@1
	mov	cl,ah
@@1:	xor	ch,ch
	jcxz	@@2
	repe	cmpsb
	jne	@@3
@@2:	cmp	al,ah
@@3:	ret
CompareStrings	endp

MoveBlock	proc	near
	shr	cx,1
	rep	movsw
	jnc	@@1
	movsb
@@1:	ret
MoveBlock	endp

MoveBlockRev	proc	near
	std
	add	si,cx
	add	di,cx
	dec	si
	dec	di
	shr	cx,1
	jnc	@@1
	movsb
@@1:	dec	si
	dec	di
	rep	movsw
	cld
	ret
MoveBlockRev	endp

AllocTempBuf	proc	near
	mov	bx,TempBufPtr
	add	ax,bx
	cmp	ax,offset TempBuffer[1024]
	jbe	@@1
	sub	ax,bx
	lea	bx,TempBuffer
	add	ax,bx
@@1:	mov	TempBufPtr,ax
	ret
AllocTempBuf	endp

AddToSourceList	proc	near
	push	ax
	mov	si,dx
@@1:	lodsb
	or	al,al
	jnz	@@1
	mov	cx,si
	sub	cx,dx
	mov	ax,cx
	add	ax,size TSourceList-1
	lea	bx,SourceList
	Invoke	GetMemory
	pop	ax
	push	di
	stosb
	xor	ax,ax
	stosw
	stosw
	stosw
	dec	cx
	mov	al,cl
	stosb
	mov	si,dx
	rep	movsb
	pop	ax
	ret
AddToSourceList	endp

KeyWords	label	word
	hash	16
	hent	PACKED,tPacked
	hent	PROGRAM,tProgram
	hent	IMPLEMENTATION,tImplementation
	hent	INTERFACE,tInterface
	hent	UNIT,tUnit
	hent	USES,tUses
	hent	LABEL,tLabel
	hent	GOTO,tGoto
	hent	ASM,tAsm
	hent	INLINE,tInline
	hent	DESTRUCTOR,tDestructor
	hent	CONSTRUCTOR,tConstructor
	hent	OBJECT,tObject
	hent	SET,tSet
	hent	FILE,tFile
	hent	IN,tIn
	hent	XOR,tXor
       	hent	SHR,tShr
	hent	SHL,tShl
	hent	MOD,tMod
	hent	DIV,tDiv
	hent	NIL,tNil
	hent	NOT,tNot
	hent	OR,tOr
	hent	AND,tAnd
	hent	WITH,tWith
	hent	CASE,tCase
	hent	STRING,tString
	hent	RECORD,tRecord
	hent	OF,tOf
	hent	ARRAY,tArray
	hent	CONST,tConst
	hent	TYPE,tType
	hent	VAR,tVar
	hent	DOWNTO,tDownto
	hent	ELSE,tElse
	hent	UNTIL,tUntil
	hent	REPEAT,tRepeat
	hent	DO,tDo
	hent	WHILE,tWhile
	hent	TO,tTo
	hent	FOR,tFor
	hent	THEN,tThen
	hent	IF,tIf
	hent	FUNCTION,tFunction
	hent	PROCEDURE,tProcedure
	hent	END,tEnd
	hent	BEGIN,tBegin
	hend

ProcDirs	label	word
	hash	4
	hent	ABSOLUTE,tAbsolute
	hent	ASSEMBLER,tAssembler
	hent	EXTERNAL,tExternal
	hent	FAR,tFar
	hent	FORWARD,tForward
	hent	INTERRUPT,tInterrupt
	hent	NEAR,tNear
	hent	VIRTUAL,tVirtual
	hend

RegVars	label	word
	hash	4
	hent	AL,t_Reg
	db	rAX+rByte
	hent	AH,t_Reg
	db	rAX+1+rByte
	hent	BL,t_Reg
	db	rBX+rByte
	hent	BH,t_Reg
	db	rBX+1+rByte
	hent	CL,t_Reg
	db	rCX+rByte
	hent	CH,t_Reg
	db	rCX+1+rByte
	hent	DL,t_Reg
	db	rDX+rByte
	hent	DH,t_Reg
	db	rDX+1+rByte
	hent	AX,t_Reg
	db	rAX
	hent	BX,t_Reg
	db	rBX
	hent	CX,t_Reg
	db	rCX
	hent	DX,t_Reg
	db	rDX
	hent	BP,t_Reg
	db	rBP
	hent	SI,t_Reg
	db	rSI
	hent	DI,t_Reg
	db	rDI
	hent	DS,t_Reg
	db	rDS
	hent	ES,t_Reg
	db	rES
	hent	IP,t_Reg
	db	rIP
	hent	CS,t_Reg
	db	rCS
	hent	FL,t_Reg
	db	rFL
	hent	SP,t_Reg
	db	rSP
	hent	SS,t_Reg
	db	rSS
	hend

	end
