	model	large compiler_text,pascal
	include	compiler.inc

	.data
SelfStr		db	4,'SELF'
PrivateStr	db	7,'PRIVATE'
FirstOnConst	db	0
FirstOnData	db	0

	.data?

ForwardTypes	dw	?
NameListPtr	dw	?
PrevField	dw	?
ConstPtr	dw	?
DummyCount	dw	?
FirstVar	dw	?
VarCount	dw	?
VarSize		dw	?
TempStub	TVarStub	<>

	.code	compiler_text

	public	DeclarationPart
	public	CheckUndefs
	public	Number2Ident
	public	StackRequired
	public	ParamSize
	public	FlushProcMap
	public	FlushCodeMap
	public	FlushConstMap
	public	FlushDataMap
	public	GetTypeName
	public	SearchUnit
	public	GetConstExpr
	public	GetIntConstExpr
	public	FitConstType
	public	IntExtension

DeclarationPart	proc	near
@@1:	mov	ax,GlobalOptions
	mov	CompilerOptions,ax
	lea	bx,@@4
	Invoke	ChooseToken
	jz	@@2
	cmp	ProgramSection,psInterface
	je	@@3
	lea	bx,@@5
	Invoke	ChooseToken
	jnz	@@3
@@2:	call	word ptr cs:[bx+1]
	jmp	@@1
@@3:	ret
@@4	db	5,3
	db	tConst
	dw	ConstDecl
	db	tType
	dw	TypeDecl
	db	tVar
	dw	VarDecl
	db	tProcedure
	dw	ProcDecl
	db	tFunction
	dw	ProcDecl
@@5	db	3,3
	db	tLabel
	dw	LabelDecl
	db	tConstructor
	dw	ProcDecl
	db	tDestructor
	dw	ProcDecl
DeclarationPart	endp

CheckUndefs	proc	near
	mov	di,size TProcMap
CheckLocUndefs	label	near
	les	dx,ProcMap
	mov	ax,-1
	jmp	short @@2
@@1:	cmp	ax,es:[di].pmCodeMap
	je	@@3
	add	di,size TProcMap
@@2:	cmp	di,dx
	jne	@@1
	ret
@@3:	mov	di,es:[di].pmEntryPoint
	mov	es,Dictionary.Segm
	lea	si,IdentBuf
	mov	bl,es:[di].seName.B0
	mov	bh,0
	mov	dl,es:[di+size TSymbol+bx].psFlags
	test	dl,pfMethod
	jz	@@4
	push	di
	mov	di,es:[di+size TSymbol+bx].psScope
	mov	di,es:[di].otName
	add	di,seName
	Invoke	Pas2C
	mov	byte ptr [si-1],'.'
	pop	di
@@4:	add	di,seName
	Invoke	Pas2C
	mov	ax,59
	test	dl,pfExternal
	jz	@@5
	mov	ax,46
@@5:	lea	dx,IdentBuf
	Chain	ParamError2
CheckUndefs	endp

Number2Ident	proc	near
	cmp	CurrentToken,t_Constant
	jne	@@2
	cmp	SymbolType.Offs,_Longint
	jne	@@2
	mov	ax,SymbolValue.W0
	mov	dx,SymbolValue.W2
	or	dx,dx
	jnz	@@2
	or	ax,ax
	jl	@@2
	cmp	ax,9999
	jg	@@2
	mov	bx,4
	xor	cx,cx
	mov	di,10
	mov	IdentBuf[0],bl
@@1:	cwd
	div	di
	add	dl,'0'
	mov	IdentBuf[bx],dl
	dec	dl
	add	cl,dl
	dec	bx
	jnz	@@1
	shl	cl,1
	mov	SymbolHash,cl
	mov	CurrentToken,t_Ident
@@2:	ret
Number2Ident	endp

LabelDecl	proc	near
	Invoke	GetToken
@@1:	call	Number2Ident
	mov	ax,size TLabelStub
	Invoke	AddIdent2Dict
	mov	es:[bx].seType,t_Label
	mov	al,tComma
	Invoke	CheckToken
	jz	@@1
	mov	al,tSemicolon
	Chain	NeedToken
LabelDecl	endp

ConstDecl	proc	near
	Loc	Temp,byte,<size TExpr>
	Entry
	Invoke	GetToken
@@1:	xor	ax,ax
	Invoke	AddIdent2Dict
	mov	al,tColon
	Invoke	CheckToken
	jnz	@@3
	push	bx
	mov	ax,size TVarStub
	Invoke	GetDictMem
	push	es di
	mov	EqualToken,tConstEqual
	call	GetTypeNoForw
	mov	EqualToken,tEqual
	test	GlobalOptions,coWordAlign
	jz	@@2
	cmp	es:[di].tdSizeOf,1
	je	@@2
	Invoke	WordAlignConst
@@2:	mov	FirstOnConst,1
	mov	TempStub.vsFlags,vfConst
	mov	ax,CompiledConst.Offs
	sub	ax,ConstSectStart
	mov	TempStub.vsOffset,ax
	mov	ax,ConstMap.Offs
	mov	TempStub.vsMap,ax
	call	_SearchUnit
	mov	TempStub.vsType.Offs,ax
	mov	TempStub.vsType.Segm,dx
	mov	al,tConstEqual
	Invoke	NeedToken
	call	GetInitializer
	pop	di es bx
	mov	es:[bx].seType,t_Var
	lea	si,TempStub
	mov	cx,size TVarStub
	rep	movsb
	jmp	short @@5
@@3:	push	es bx
	mov	al,tEqual
	Invoke	NeedToken
	lea	di,Temp
	call	GetConstExpr
	pop	bx es
	mov	es:[bx].seType,t_Const
	lea	si,[di].exValue
	les	di,[di].exType
	mov	al,es:[di].tdType
	mov	cx,4
	cmp	al,ttInteger
	jae	@@4
	cmp	al,ttPointer
	je	@@4
	mov	cl,10
	cmp	al,tt8087
	je	@@4
	mov	si,[si].Offs
	mov	cl,32
	cmp	al,ttSet
	je	@@4
	mov	cl,[si]
	inc	cx
@@4:	call	_SearchUnit
	push	dx ax
	mov	ax,size TConstStub
	add	ax,cx
	Invoke	GetDictMem
	pop	ax
	stosw
	pop	ax
	stosw
	rep	movsb
@@5:	mov	al,tSemicolon
	Invoke	NeedToken
	cmp	CurrentToken,t_Ident
	jne	@@6
	jmp	@@1
@@6:	call	FlushConstMap
	Exit
ConstDecl	endp

TypeDecl	proc	near
	Invoke	GetToken
	mov	ForwardTypes,0
@@1:	mov	ax,size TTypeStub
	Invoke	AddIdent2Dict
	push	bx di es
	mov	al,tEqual
	Invoke	NeedToken
	call	GetStdType
	call	GetType
	call	_SearchUnit
	pop	es di bx
	mov	es:[bx].seType,t_Type
	stosw
	mov	ax,dx
	stosw
	mov	al,tSemicolon
	Invoke	NeedToken
	cmp	CurrentToken,t_Ident
	je	@@1
ResolveForward	label	near
@@2:	mov	di,ForwardTypes
	or	di,di
	jz	@@3
	mov	es,Dictionary.Segm
	mov	di,es:[di].ptBase.Segm
	mov	es,TempDict.Segm
	Invoke	CalcHash
	Invoke	SearchSymbol
	jnz	@@4
	cmp	al,t_Type
	jne	@@4
	mov	bx,es:[di].tsType.Segm
	mov	di,es:[di].tsType.Offs
	mov	es,es:[bx]
	call	_SearchUnit
	mov	di,ForwardTypes
	mov	es,Dictionary.Segm
	xchg	ax,es:[di].ptBase.Offs
	mov	es:[di].ptBase.Segm,dx
	mov	ForwardTypes,ax
	jmp	@@2
@@3:	ret
@@4:	mov	ax,19
	Chain	IdentError
TypeDecl	endp

GetStdType	proc	near
	mov	al,CurrentToken
	cmp	al,tObject
	je	@@1
	cmp	al,tProcedure
	je	@@1
	cmp	al,tFunction
	je	@@1
	ret
@@1:	mov	es:[bx].seType,t_StdType
	push	es di
	les	di,Dictionary
	call	_SearchUnit
	pop	di es
	stosw
	mov	ax,dx
	stosw
	ret
GetStdType	endp

VarDecl	proc	near
	Invoke	GetToken
@@1:	call	GetVarList
	mov	al,tColon
	Invoke	NeedToken
	call	GetVarType
	mov	al,tAbsolute
	Invoke	CheckDirective
	jnz	@@3
	Invoke	GetSymbol
	mov	al,t_Var
	Invoke	CheckToken
	jnz	@@2
	les	di,CurrentSymbol
	call	_SearchUnit
	mov	TempStub.vsLink.Offs,ax
	mov	TempStub.vsLink.Segm,dx
	mov	al,vfAlias
	jmp	short @@5
@@2:	call	GetIntConstExpr
	mov	TempStub.vsAddress.Segm,ax
	mov	al,tColon
	Invoke	NeedToken
	call	GetIntConstExpr
	mov	TempStub.vsAddress.Offs,ax
	mov	al,vfAbsolute
	jmp	short @@5
@@3:	mov	ax,CurScope
	or	ax,ax
	jz	@@4
	mov	TempStub.vsScope,ax
	mov	al,vfLocal
	jmp	short @@5
@@4:	mov	FirstOnData,1
	mov	ax,DataMap.offs
	mov	TempStub.vsMap,ax
	mov	al,vfVar
@@5:	mov	TempStub.vsFlags,al
	call	FillVarTypes
	mov	al,tSemicolon
	Invoke	NeedToken
	cmp	CurrentToken,t_Ident
	je	@@1
	jmp	FlushDataMap
VarDecl	endp

GetVarList	proc	near
	mov	ax,Dictionary.Offs
	mov	FirstVar,ax
	xor	ax,ax
	mov	VarCount,ax
@@1:	mov	ax,size TVarStub
	Invoke	AddIdent2Dict
	inc	VarCount
	mov	al,tComma
	Invoke	CheckToken
	jz	@@1
	ret
GetVarList	endp

GetVarType	proc near
	call	GetTypeNoForw
	mov	ax,es:[di].tdSizeOf
	mov	VarSize,ax
	call	_SearchUnit
	mov	TempStub.vsType.Offs,ax
	mov	TempStub.vsType.Segm,dx
	ret
GetVarType	endp

FillVarTypes	proc	near
	mov	dx,VarSize
	mov	di,FirstVar
	mov	es,Dictionary.Segm
@@1:	mov	si,di
	mov	al,PrivateFlag
	or	al,t_Var
	mov	es:[di].seType,al
	mov	bl,es:[di].seName.B0
	mov	bh,0
	lea	di,[di+size TSymbol+bx]
	mov	al,TempStub.vsFlags
	cmp	al,vfVar
	jne	@@3
	mov	ax,VarsSize
	test	GlobalOptions,coWordAlign
	jz	@@2
	cmp	dx,1
	je	@@2
	inc	ax
	jz	@@5
	and	ax,0fffeh
@@2:	add	ax,dx
	jc	@@5
	mov	VarsSize,ax
	sub	ax,dx
	sub	ax,DataSectStart
	jmp	short @@7
@@3:	cmp	al,vfLocal
	jne	@@6
	mov	ax,LocalsSize
	dec	ax
	sub	ax,dx
	inc	ax
	jc	@@5
	test	GlobalOptions,coWordAlign
	jz	@@4
	cmp	dx,1
	je	@@4
	and	ax,0fffeh
@@4:	mov	LocalsSize,ax
	jmp	short @@7
@@5:	mov	ax,96
	Chain	CompileError
@@6:	cmp	al,vfField
	jne	@@8
	mov	bx,PrevField
	mov	es:[bx],si
	lea	ax,[di].vsNext
	mov	PrevField,ax
	mov	bx,CurOwner
	mov	ax,es:[bx].tdSizeOf
	add	es:[bx].tdSizeOf,dx
	jnc	@@7
	mov	ax,22
	Chain	CompileError
@@7:	mov	TempStub.vsOffset,ax
@@8:	lea	si,TempStub
	mov	cx,size TVarStub
	rep	movsb
	dec	VarCount
	jz	@@9
	jmp	@@1
@@9:	ret
FillVarTypes	endp

ProcDecl	proc	near
	push	ax
	Invoke	GetToken
	Invoke	NeedIdent
	Invoke	LocalSearch
	mov	cl,al
	pop	ax
	jnz	@@7
	cmp	ProgramSection,psInterface
	je	@@4
	cmp	cl,t_Proc
	je	@@1
	cmp	cl,t_Type
	jne	@@3
	mov	bx,es:[di].tsType.Segm
	mov	di,es:[di].tsType.Offs
	mov	es,es:[bx]
	cmp	es:[di].tdType,ttObject
	jne	@@3
	push	ax
	Invoke	GetToken
	mov	al,tPoint
	Invoke	NeedToken
	Invoke	NeedIdent
	mov	di,es:[di].rtHash
	Invoke	SearchHash
	jnz	@@6
	cmp	al,t_Proc
	jne	@@6
	pop	ax
	jmp	short @@2
@@1:	test	es:[di].psFlags,pfMethod
	jnz	@@4
@@2:	push	es
	mov	si,es:[di].psProcMap
	mov	es,ProcMap.Segm
	cmp	es:[si].pmCodeMap,-1
	pop	es
	jne	@@4
	Invoke	GetToken
	call	MatchForward
	jmp	@@15
@@3:	cmp	al,tConstructor
	je	@@5
	cmp	al,tDestructor
	je	@@5
@@4:	mov	ax,4
	Chain	CompileError
@@5:	mov	ax,147
	Chain	CompileError
@@6:	mov	ax,150
	Chain	CompileError
@@7:	cmp	al,tConstructor
	je	@@5
	cmp	al,tDestructor
	je	@@5
	push	ax
	mov	ax,size TProcStub
	Invoke	LocalAddIdent
	mov	es:[bx].seType,t_Proc
	Invoke	GetToken
	pop	ax
	push	TempDict.Offs bx es di
	call	GetProcHeader
	pop	di es bx dx
	mov	al,tSemicolon
	Invoke	NeedToken
	mov	al,tInline
	Invoke	CheckToken
	jnz	@@8
	push	es di
	Invoke	ProcessInline
	pop	di es
	or	es:[di].psFlags,pfInline
	mov	es:[di].psInlineLen,cx
	mov	al,tSemicolon
	Chain	NeedToken
@@8:	mov	es:[di].psHash,dx
	call	FlushProcMap
	mov	ax,CurScope
	mov	es:[di].psScope,ax
	or	ax,ax
	jnz	@@9
	mov	al,tInterrupt
	Invoke	CheckDirective
	jnz	@@9
	or	es:[di].psFlags,pfInterrupt
	mov	al,tSemicolon
	Invoke	NeedToken
	jmp	short @@13
@@9:	cmp	ProgramSection,psInterface
	je	@@12
	mov	al,tNear
	Invoke	CheckDirective
	jz	@@10
	mov	al,tFar
	Invoke	CheckDirective
	jnz	@@11
	or	es:[di].psFlags,pfFar
@@10:	mov	al,tSemicolon
	Invoke	NeedToken
	jmp	short @@13
@@11:	test	CompilerOptions,coForceFarCalls
	jz	@@13
@@12:	or	es:[di].psFlags,pfFar
@@13:	cmp	ProgramSection,psInterface
	je	@@14
	mov	al,tForward
	Invoke	CheckDirective
	jnz	@@15
	mov	al,tSemicolon
	Chain	NeedToken
@@14:	ret
@@15:	cmp	CurScope,0
	jne	@@16
	mov	al,tExternal
	Invoke	CheckDirective
	jnz	@@16
	or	es:[di].psFlags,pfExternal
	mov	es:[di].psHash,0
	jmp	@@18
@@16:	mov	al,tAssembler
	Invoke	CheckDirective
	jnz	@@17
	or	es:[di].psFlags,pfAssembler
	mov	al,tSemicolon
	Invoke	NeedToken
@@17:	push	ParamsSize ParamsBottom ProcResult LocalsSize LocalsBottom
	push	CurProc CurScope
	push	ProcMap.Offs
	mov	CurScope,bx
	mov	CurProc,di
	mov	ax,es:[di].psHash
	mov	NameListPtr,ax
	mov	ax,Dictionary.offs
	mov	es:[di].psHash,ax
	mov	di,es:[di].psProcMap
	mov	es,ProcMap.segm
	mov	es:[di].pmCodeMap,-2
	mov	ax,4
	Invoke	CreateHashTable
	call	CreateProcDict
	call	DeclarationPart
	Invoke	StatementPart
	mov	es,Dictionary.segm
	mov	di,CurProc
	mov	di,es:[di].psProcMap
	mov	es,ProcMap.segm
	mov	es:[di].psHash,ax
	mov	ax,CodeMap.offs
	mov	es:[di].psScope,ax
	call	FlushCodeMap
	call	FlushConstMap
	pop	di
	call	CheckLocUndefs
	mov	es,Dictionary.segm
	mov	di,CurProc
	pop	CurScope CurProc
	pop	LocalsBottom LocalsSize ProcResult ParamsBottom ParamsSize
	mov	ax,GlobalOptions
	and	ax,coDebugInfo+coLocalSymbols
	cmp	ax,coDebugInfo+coLocalSymbols
	je	@@18
	xor	ax,ax
	xchg	ax,es:[di].psHash
	mov	Dictionary.offs,ax
@@18:	mov	al,tSemicolon
	Chain	NeedToken
ProcDecl	endp

MatchForward	proc	near
	mov	ah,tFunction
	cmp	es:[di].psType.ptResult.Offs,0
	jne	@@1
	mov	ah,tConstructor
	test	es:[di].psFlags,pfConstructor
	jnz	@@1
	mov	ah,tDestructor
	test	es:[di].psFlags,pfDestructor
	jnz	@@1
	mov	ah,tProcedure
@@1:	cmp	al,ah
	jne	@@4
	cmp	CurrentToken,tOParen
	je	@@2
	cmp	CurrentToken,tColon
	jne	@@3
@@2:	push	TempDict.Offs
	push	es di bx
	call	GetProcHeader
	mov	si,di
	pop	bx di es
	push	di ds
	mov	cx,Dictionary.Offs
	mov	Dictionary.Offs,si
	sub	cx,si
	add	di,psType
	push	es
	pop	ds
	mov	ax,[di].tdNext
	mov	[si].tdNext,ax
	repe	cmpsb
	pop	ds di
	pop	si
	jne	@@4
	push	di ds es
	mov	cx,TempDict.Offs
	mov	TempDict.Offs,si
	sub	cx,si
	mov	di,es:[di].psHash
	mov	es,TempDict.Segm
	push	es
	pop	ds
	repe	cmpsb
	pop	es ds di
	jne	@@4
@@3:	mov	al,tSemicolon
	Chain	NeedToken
@@4:	mov	ax,131
	Chain	CompileError
MatchForward	endp

CreateProcDict	proc	near
	Loc	ParamOffset,word,1
	Loc	AsmFlag,byte,2
	Entry
	mov	es,Dictionary.Segm
	mov	di,CurProc
	mov	al,es:[di].psFlags
	and	al,pfAssembler
	mov	AsmFlag,al
	call	StackRequired
	mov	ParamsSize,ax
	mov	ParamsBottom,dx
	mov	ParamOffset,dx
	call	LocalSize
	mov	ProcResult,ax
	mov	LocalsSize,ax
	mov	LocalsBottom,dx
	push	NameListPtr
	mov	cx,es:[di].psType.ptParamCount
	add	di,psType.ptParams
	jcxz	@@4
@@1:	push	cx es di
	mov	al,es:[di].ppFlags
	mov	ah,AsmFlag
	mov	bx,es:[di].ppType.Segm
	mov	di,es:[di].ppType.Offs
	mov	es,es:[bx]
	call	ParamSize
	or	al,vfParam
	mov	TempStub.vsFlags,al
	mov	bx,dx
	call	_SearchUnit
	mov	TempStub.vsType.Offs,ax
	mov	TempStub.vsType.Segm,dx
	sub	ParamOffset,cx
	mov	ax,ParamOffset
	or	bx,bx
	jz	@@3
	mov	ax,LocalsSize
	sub	ax,bx
	test	GlobalOptions,coWordAlign
	jz	@@2
	cmp	bx,1
	je	@@2
	and	ax,0fffeh
@@2:	mov	LocalsSize,ax
@@3:	mov	TempStub.vsOffset,ax
	mov	ax,CurScope
	mov	TempStub.vsScope,ax
	mov	di,NameListPtr
	mov	es,TempDict.Segm
	Invoke	CalcHash
	mov	NameListPtr,di
	mov	ax,size TVarStub
	Invoke	AddNewIdent
	mov	es:[bx].seType,t_Var
	lea	si,TempStub
	mov	cx,size TVarStub
	rep	movsb
	pop	di es cx
	add	di,size TProcParam
	loop	@@1
@@4:	mov	di,CurProc
	test	es:[di].psFlags,pfMethod
	jz	@@5
	mov	TempStub.vsFlags,vfLocal+vfAddress
	mov	TempStub.vsOffset,6
	mov	ax,CurScope
	mov	TempStub.vsScope,ax
	mov	di,es:[di].psScope
	call	_SearchUnit
	mov	TempStub.vsType.Offs,ax
	mov	TempStub.vsType.Segm,dx
	lea	di,SelfStr
	push	ds
	pop	es
	Invoke	CalcHash
	mov	ax,size TVarStub
	Invoke	AddNewIdent
	mov	es:[bx].seType,t_Var
	lea	si,TempStub
	mov	cx,size TVarStub
	rep	movsb
@@5:	mov	ax,NameListPtr
	cmp	ax,TempDict.Offs
	pop	ax
	jne	@@6
	mov	TempDict.Offs,ax
@@6:	Exit
CreateProcDict	endp

StackRequired	proc	near
	xor	ax,ax
	cmp	es:[di].psScope,0
	je	@@1
	mov	al,2
	test	es:[di].psFlags,pfMethod
	jz	@@1
	mov	al,4
	test	es:[di].psFlags,pfConstructor+pfDestructor
	jz	@@1
	mov	al,6
@@1:	mov	cx,es:[di].psType.ptParamCount
	jcxz	@@3
	push	di
	add	di,psType.ptParams
@@2:	push	cx
	push	ax es di
	mov	al,es:[di].ppFlags
	xor	ah,ah
	mov	bx,es:[di].ppType.Segm
	mov	di,es:[di].ppType.Offs
	mov	es,es:[bx]
	call	ParamSize
	pop	di es ax
	add	ax,cx
	pop	cx
	add	di,size TProcParam
	loop	@@2
	pop	di
@@3:	mov	dx,ax
	test	es:[di].psFlags,pfInterrupt
	jnz	@@4
	add	dx,4
	test	es:[di].psFlags,pfFar
	jz	@@4
	inc	dx
	inc	dx
@@4:	ret
StackRequired	endp

ParamSize	proc	near
	xor	dx,dx
	test	al,vfAddress
	jnz	@@3
	mov	bl,es:[di].tdType
	mov	cx,es:[di].tdSizeOf
	cmp	bl,tt8087
	jae	@@1
	cmp	bl,ttString
	je	@@2
	cmp	bl,ttPointer
	je	@@1
	cmp	bl,ttSet
	je	@@2
	cmp	cx,1
	je	@@1
	cmp	cx,2
	je	@@1
	cmp	cx,4
	jne	@@2
@@1:	inc	cx
	and	cx,0fffeh
	ret
@@2:	or	ah,ah
	jnz	@@4
	mov	dx,cx
@@3:	mov	cx,4
	ret
@@4:	or	al,vfAddress
	cmp	bl,ttSet
	jne	@@3
	mov	bx,es:[di].stBase.Segm
	mov	di,es:[di].stBase.Offs
	mov	es,es:[bx]
	mov	bx,es:[di].itBase.Segm
	mov	di,es:[di].itBase.Offs
	mov	es,es:[bx]
	add	di,size TOrdinalType
	jmp	@@3
ParamSize	endp

LocalSize	proc	near
	xor	ax,ax
	mov	dx,ax
	mov	bx,es:[di].psType.ptResult.Segm
	or	bx,bx
	jz	@@2
	test	es:[di].psFlags,pfAssembler
	jnz	@@2
	push	es di
	mov	di,es:[di].psType.ptResult.Offs
	mov	es,es:[bx]
	cmp	es:[di].tdType,ttString
	je	@@1
	sub	ax,es:[di].tdSizeOf
@@1:	pop	di es
@@2:	ret
LocalSize	endp

FlushProcMap	proc	near
	push	es di bx
	mov	ax,size TProcMap
	lea	bx,ProcMap
	Invoke	GetMemory
	pop	bx
	mov	dx,di
	xor	ax,ax
	stosw
	stosw
	dec	ax
	stosw
	mov	ax,bx
	stosw
	pop	di es
	mov	es:[di].psProcMap,dx
	ret
FlushProcMap	endp

FlushCodeMap	proc	near
	mov	ax,size TSegMap
	lea	bx,CodeMap
	Invoke	GetMemory
	xor	ax,ax
	stosw
	mov	ax,CompiledCode.Offs
	sub	ax,CodeSectStart
	stosw
	mov	ax,CodeFixups.Offs
	sub	ax,LastCodeFixup
	stosw
	mov	ax,LastTraceTable
	cmp	ax,TraceTable.Offs
	jne	@@1
	mov	ax,-1
@@1:	stosw
	mov	ax,CompiledCode.offs
	mov	CodeSectStart,ax
	mov	ax,CodeFixups.Offs
	mov	LastCodeFixup,ax
	mov	ax,TraceTable.Offs
	mov	LastTraceTable,ax
	ret
FlushCodeMap	endp

FlushConstMap		 proc near
	Invoke	WordAlignConst
	mov	ax,CompiledConst.Offs
	sub	ax,ConstSectStart
	jnz	@@1
	cmp	FirstOnConst,0
	je	@@2
@@1:	mov	FirstOnConst,0
	push	ax
	mov	ax,size TSegMap
	lea	bx,ConstMap
	Invoke	GetMemory
	xor	ax,ax
	stosw
	pop	ax
	stosw
	mov	ax,ConstFixups.Offs
	sub	ax,LastConstFixup
	stosw
	mov	ax,CurOwner
	stosw
	mov	ax,CompiledConst.Offs
	mov	ConstSectStart,ax
	mov	ConstSectStart2,ax
	mov	ax,ConstFixups.Offs
	mov	LastConstFixup,ax
@@2:	ret
FlushConstMap	endp

FlushDataMap		 proc near
	mov	ax,VarsSize
	inc	ax
	jz	@@3
	and	ax,0fffeh
	mov	VarsSize,ax
	sub	ax,DataSectStart
	jnz	@@1
	cmp	FirstOnData,0
	je	@@2
@@1:	mov	FirstOnData,0
	push	ax
	mov	ax,size TSegMap
	lea	bx,DataMap
	Invoke	GetMemory
	xor	ax,ax
	stosw
	pop	ax
	stosw
	xor	ax,ax
	stosw
	stosw
	mov	ax,VarsSize
	mov	DataSectStart,ax
@@2:	ret
@@3:	mov	ax,96
	Chain	CompileError
FlushDataMap	endp

GetTypeNoForw	proc	near
	mov	ForwardTypes,0
	call	GetTypeNoObj
	push	es di
	Invoke	GetDirective
	call	ResolveForward
	pop	di es
	ret
GetTypeNoForw	endp

GetType	proc	near
	cmp	CurrentToken,tObject
	jne	GetTypeNoObj
	jmp	ObjectType
GetType	endp

GetTypeNoObj	proc	near
	mov	al,tPacked
	Invoke	CheckToken
	Invoke	GetSymbol
	lea	bx,@@2
	Invoke	ChooseToken
	jnz	@@1
	jmp	word ptr cs:[bx+1]
@@1:	mov	ax,21
	Chain	CompileError
@@2	db	16,3
	db	t_Type
	dw	TypeName
	db	tArray
	dw	ArrayType
	db	tRecord
	dw	RecordType
	db	tCaret
	dw	PointerType
	db	tString
	dw	StringType
	db	tFile
	dw	FileType
	db	tSet
	dw	SetType
	db	tOParen
	dw	EnumType
	db	tProcedure
	dw	ProcedureType
	db	tFunction
	dw	ProcedureType
	db	t_Constant
	dw	RangeType
	db	t_Const
	dw	RangeType
	db	tMinus
	dw	RangeType
	db	tPlus
	dw	RangeType
	db	t_StdFun
	dw	RangeType
	db	tNot
	dw	RangeType
GetTypeNoObj	endp

_GetTypeName	proc	near
	Invoke	GetSymbol
	cmp	CurrentToken,t_StdType
	je	TypeName
GetTypeName	label	near
	mov	al,CurrentToken
	mov	di,_String
	cmp	al,tString
	je	@@1
	mov	di,_File
	cmp	al,tFile
	jne	@@2
@@1:	mov	es,SystemUnit
	Chain	GetToken
@@2:	Invoke	GetSymbol
	cmp	CurrentToken,t_Type
	je	TypeName
	mov	ax,12
	Chain	CompileError
_GetTypeName	endp

TypeName	proc	near
	les	di,CurrentSymbol
	mov	bx,es:[di].tsType.Segm
	mov	di,es:[di].tsType.Offs
	mov	es,es:[bx]
	Chain	GetToken
TypeName	endp

ArrayType	proc	near
	Invoke	GetToken
	mov	al,tOBracket
	Invoke	NeedToken
	xor	cx,cx
@@1:	push	cx
	call	GetBound
	pop	cx
	push	es di
	inc	cx
	mov	al,tComma
	Invoke	CheckToken
	jz	@@1
	push	cx
	mov	al,tCBracket
	Invoke	NeedToken
	mov	al,tOf
	Invoke	NeedToken
	call	GetTypeNoObj
	pop	cx
@@2:	call	_SearchUnit
	mov	bx,es:[di].tdSizeOf
	pop	di es
	push	cx dx ax
	mov	ax,es:[di].itUpperBound.W0
	sub	ax,es:[di].itLowerBound.W0
	inc	ax
	jz	@@3
	mul	bx
	jc	@@3
	mov	bx,ax
	call	_SearchUnit
	push	dx ax
	mov	ax,size TArrayType
	mov	cx,ttArray
	call	PutTypePrefix
	pop	es:[di].atBounds
	pop	es:[di].atBase
	pop	cx
	loop	@@2
	ret
@@3:	mov	ax,22
	Chain	CompileError
ArrayType	endp

RecordType	proc	near
	push	ForwardTypes PrevField FirstVar VarCount
	mov	ax,size TRecordType
	xor	bx,bx
	mov	cx,ttRecord
	call	PutTypePrefix
	mov	CurOwner,di
	mov	ax,Dictionary.Offs
	mov	es:[di].rtHash,ax
	mov	es:[di].rtFirst,0
	lea	ax,[di].rtFirst
	mov	PrevField,ax
	push	es di
	mov	ax,4
	Invoke	CreateHashTable
	mov	ax,tRecord+tEnd*256
	call	RecordSection
	pop	di es
	xor	ax,ax
	mov	CurOwner,ax
	pop	VarCount FirstVar PrevField ForwardTypes
	ret
RecordType	endp

RecordSection	proc	near
	Loc	EndingToken,byte,2
	Loc	Temp,byte,<size TExpr>
	Entry
	mov	EndingToken,ah
	Invoke	NeedToken
@@1:	mov	al,CurrentToken
	cmp	al,EndingToken
	je	@@8
	mov	al,tCase
	Invoke	CheckToken
	jz	@@2
	call	RecordGroup
	mov	al,tSemicolon
	Invoke	CheckToken
	jz	@@1
	jmp	short @@8
@@2:	Invoke	NeedIdent
	Invoke	SearchSymbol
	jnz	@@3
	cmp	al,t_Type
	jnz	@@3
	Invoke	GetToken
	jmp	short @@4
@@3:	call	RecordGroup
@@4:	mov	al,tOf
	Invoke	NeedToken
	mov	es,Dictionary.Segm
	mov	di,CurOwner
	mov	dx,es:[di].tdSizeOf
@@5:	mov	ax,dx
	xchg	ax,es:[di].tdSizeOf
	push	ax dx es di
@@6:	lea	di,Temp
	call	GetConstExpr
	mov	al,tComma
	Invoke	CheckToken
	jz	@@6
	mov	al,tColon
	Invoke	NeedToken
	mov	ax,tOParen+tCParen*256
	call	RecordSection
	pop	di es dx ax
	cmp	ax,es:[di].tdSizeOf
	jbe	@@7
	mov	es:[di].tdSizeOf,ax
@@7:	mov	al,tSemicolon
	Invoke	CheckToken
	jnz	@@8
	mov	al,CurrentToken
	cmp	al,EndingToken
	jne	@@5
@@8:	mov	al,EndingToken
	Invoke	NeedToken
	Exit
RecordSection	endp

RecordGroup	proc	near
	call	GetVarList
	mov	al,tColon
	Invoke	NeedToken
	push	CurOwner
	xor	ax,ax
	mov	CurOwner,ax
	call	GetVarType
	pop	CurOwner
	mov	TempStub.vsFlags,vfField
	xor	ax,ax
	mov	TempStub.vsScope,ax
	jmp	FillVarTypes
@@1:	mov	ax,22
	Chain	CompileError
RecordGroup	endp

ObjectType	proc	near
	push	ForwardTypes
	cmp	CurScope,0
	jne	@@1
	Invoke	GetToken
	push	bx
	mov	ax,size TObjectType
	xor	bx,bx
	mov	cx,ttObject
	call	PutTypePrefix
	pop	es:[di].otName
	mov	es:[di].otReserved3.Offs,ax
	mov	es:[di].otReserved3.Segm,ax
	mov	CurOwner,di
	mov	al,tOParen
	Invoke	CheckToken
	jnz	@@3
	call	GetTypeName
	cmp	es:[di].tdType,ttObject
	jne	@@2
	mov	al,tCParen
	Invoke	NeedToken
	push	es:[di].otReserved2
	push	es:[di].otVMTOffset
	push	es:[di].otVMTSize
	push	es:[di].tdSizeOf
	call	_SearchUnit
	jmp	short @@4
@@1:	mov	ax,148
	Chain	CompileError
@@2:	mov	ax,147
	Chain	CompileError
@@3:	xor	ax,ax
	xor	dx,dx
	push	ax
	dec	ax
	push	ax
	inc	ax
	push	ax ax
@@4:	mov	es,Dictionary.Segm
	mov	di,CurOwner
	pop	es:[di].tdSizeOf
	pop	es:[di].otVMTSize
	pop	es:[di].otVMTOffset
	pop	es:[di].otReserved2
	mov	es:[di].otParent.Offs,ax
	mov	es:[di].otParent.Segm,dx
	xor	ax,ax
	mov	es:[di].rtFirst,ax
	mov	es:[di].otReserved3.Offs,ax
	mov	es:[di].otReserved3.Segm,ax
	dec	ax
	mov	es:[di].otVMTAddr,ax
	mov	es:[di].otReserved,ax
	mov	ax,Dictionary.Offs
	mov	es:[di].rtHash,ax
	lea	ax,[di].rtFirst
	mov	PrevField,ax
	xor	ax,ax
	mov	DummyCount,ax
	push	es di
	mov	ax,4
	Invoke	CreateHashTable
	call	ObjectGroup
	mov	al,tPrivate
	Invoke	CheckToken
	jnz	@@5
	mov	PrivateFlag,t_Private
	call	ObjectGroup
	mov	PrivateFlag,0
@@5:	mov	al,tEnd
	Invoke	NeedToken
	pop	di es
	call	PutVMT
	xor	ax,ax
	mov	CurOwner,ax
	pop	ForwardTypes
	ret
ObjectType	endp

	HValue	PRIVATE,128

ObjectGroup	proc	near
@@1:	xor	cx,cx
@@2:	mov	al,@HS
	lea	di,PrivateStr
	Invoke	CompareSymbol
	jnz	@@3
	mov	CurrentToken,tPrivate
@@3:	mov	al,CurrentToken
	cmp	al,tProcedure
	je	@@5
	cmp	al,tFunction
	je	@@5
	cmp	al,tConstructor
	je	@@4
	cmp	al,tDestructor
	je	@@4
	or	cx,cx
	jnz	@@6
	cmp	al,tPrivate
	je	@@6
	cmp	al,tEnd
	je	@@6
	call	RecordGroup
	mov	al,tSemicolon
	Invoke	NeedToken
	jmp	@@1
@@4:	call	InitVMT
@@5:	call	Method
	mov	cx,-1
	jmp	@@2
@@6:	ret
ObjectGroup	endp

InitVMT	proc	near
	mov	es,Dictionary.Segm
	mov	di,CurOwner
	cmp	es:[di].otVMTSize,0
	jne	@@1
	mov	es:[di].otVMTSize,4
@@1:	ret
InitVMT	endp

Method	proc	near
	Loc	CurMethod,dword,1
	Loc	OldMethod,dword,1
	Entry
	push	ax
	Invoke	GetToken
	Invoke	NeedIdent
	Invoke	LocalSearch
	jnz	@@2
	cmp	al,t_Proc
	jne	@@1
	mov	ax,es
	cmp	ax,Dictionary.Segm
	jne	@@3
	mov	ax,es:[di].psScope
	cmp	ax,CurOwner
	jne	@@3
@@1:	mov	ax,4
	Chain	CompileError
@@2:	xor	di,di
	mov	es,di
@@3:	mov	OldMethod.Offs,di
	mov	OldMethod.Segm,es
	mov	ax,size TProcStub
	Invoke	LocalAddIdent
	Invoke	GetToken
	mov	CurMethod.Offs,di
	mov	CurMethod.Segm,es
	mov	al,PrivateFlag
	or	al,t_Proc
	mov	es:[bx].seType,al
	mov	ax,CurOwner
	mov	es:[di].psScope,ax
	mov	ax,TempDict.Offs
	mov	es:[di].psHash,ax
	mov	si,PrevField
	mov	es:[si],bx
	lea	si,[di].psType.tdNext
	mov	PrevField,si
	call	FlushProcMap
	pop	ax
	mov	ah,pfFar+pfMethod+pfConstructor
	cmp	al,tConstructor
	je	@@4
	mov	ah,pfFar+pfMethod+pfDestructor
	cmp	al,tDestructor
	je	@@4
	mov	ah,pfFar+pfMethod
@@4:	mov	es:[di].psFlags,ah
	call	GetProcHeader
	mov	al,tSemicolon
	Invoke	NeedToken
	les	di,OldMethod
	or	di,di
	jz	@@5
	cmp	es:[di].psOwner,0
	je	@@5
	call	Override
	jmp	short @@6
@@5:	call	NewMethod
@@6:	les	di,CurMethod
	mov	es:[di].psOwner,ax
	Exit

Override	proc	near
	mov	al,tVirtual
	Invoke	CheckDirective
	jnz	@@1
	les	di,OldMethod
	mov	al,es:[di].psFlags
	les	di,CurMethod
	xor	al,es:[di].psFlags
	and	al,pfConstructor+pfDestructor
	jnz	@@2
	lea	di,CurMethod
	lea	si,OldMethod
	add	[di].Offs,psType
	add	[si].Offs,psType
	Invoke	ProcCompat
	jnz	@@2
	sub	[di].Offs,psType
	sub	[si].Offs,psType
	mov	al,tSemicolon
	Invoke	NeedToken
	les	di,OldMethod
	mov	ax,es:[di].psOwner
	ret
@@1:	mov	ax,149
	Chain	CompileError
@@2:	mov	ax,131
	Chain	CompileError
Override	endp

NewMethod	proc	near
	mov	al,tVirtual
	Invoke	CheckDirective
	mov	ax,0
	jnz	@@1
	les	di,CurMethod
	test	es:[di].psFlags,pfConstructor
	jnz	@@2
	mov	al,tSemicolon
	Invoke	NeedToken
	call	InitVMT
	mov	ax,es:[di].otVMTSize
	add	es:[di].otVMTSize,4
@@1:	ret
@@2:	mov	ax,151
	Chain	CompileError
NewMethod	endp

Method	endp

PutVMT	proc	near
	mov	ax,es:[di].otVMTSize
	or	ax,ax
	jnz	@@1
	ret
@@1:	mov	dx,es:[di].tdSizeOf
	cmp	es:[di].otVMTOffset,-1
	jne	@@2
	mov	es:[di].otVMTOffset,dx
	inc	dx
	inc	dx
	mov	es:[di].tdSizeOf,dx
@@2:	push	es di
	mov	cx,ax
	lea	bx,CompiledConst
	Invoke	GetMemory
	mov	ConstPtr,di
	mov	ax,dx
	stosw
	neg	ax
	stosw
	sub	cx,4
	mov	al,-1
	rep	stosb
	pop	di es
	mov	ax,ConstMap.Offs
	mov	es:[di].otVMTAddr,ax
	push	es di
@@3:	push	di
	mov	di,es:[di].rtFirst
	jmp	short @@8
@@4:	mov	al,es:[di].seType
	mov	bl,es:[di].seName.B0
	xor	bh,bh
	lea	di,[di+size TSymbol+bx]
	and	al,not t_Private
	cmp	al,t_Var
	jne	@@5
	mov	di,es:[di].vsNext
	jmp	short @@8
@@5:	mov	si,es:[di].psOwner
	or	si,si
	jz	@@7
	mov	ax,es
	mov	bx,es:[di].psProcMap
	mov	cx,ffProc+ffPtr
	xor	dx,dx
	add	si,ConstPtr
	push	es
	mov	es,CompiledConst.Segm
	cmp	dx,es:[si].Offs
	je	@@6
	mov	es:[si].Offs,dx
	mov	es:[si].Segm,dx
	Invoke	PutConstFixup
@@6:	pop	es
@@7:	mov	di,es:[di].psType.tdNext
@@8:	or	di,di
	jnz	@@4
	pop	di
	mov	bx,es:[di].otParent.Segm
	or	bx,bx
	jz	@@9
	mov	di,es:[di].otParent.Offs
	mov	es,es:[bx]
	jmp	@@3
@@9:	call	FlushConstMap
	pop	di es
	ret
PutVMT	endp

ProcedureType	proc	near
	Invoke	GetToken
	push	TempDict.Offs
	call	GetProcHeader
	pop	TempDict.Offs
	ret
ProcedureType	endp

GetProcHeader	proc	near
	push	ax
	mov	ax,size TProcType
	mov	bx,4
	mov	cx,ttProc+emLongint*256
	call	PutTypePrefix
	xor	ax,ax
	mov	es:[di].ptResult.Offs,ax
	mov	es:[di].ptResult.Segm,ax
	mov	es:[di].ptParamCount,ax
	mov	al,tOParen
	Invoke	CheckToken
	jnz	@@1
	push	es di
	call	GetParamList
	pop	di es
	mov	es:[di].ptParamCount,cx
	mov	al,tCParen
	Invoke	NeedToken
@@1:	pop	ax
	cmp	al,tFunction
	jne	@@2
	mov	al,tColon
	Invoke	NeedToken
	push	es di
	call	GetTypeName
	cmp	es:[di].tdType,ttPointer
	jb	@@3
	call	_SearchUnit
	pop	di es
	mov	es:[di].ptResult.Offs,ax
	mov	es:[di].ptResult.Segm,dx
@@2:	ret
@@3:	mov	ax,34
	Chain	CompileError
GetProcHeader	endp

GetParamList	proc	near
	Loc	Flags,byte,2
	Loc	CurCount,word,1
	Loc	TotalCount,word,1
	Entry
	mov	TotalCount,0
@@1:	mov	CurCount,0
	mov	al,tVar
	Invoke	CheckToken
	mov	al,vfLocal+vfAddress
	jz	@@2
	mov	al,vfLocal
@@2:	mov	Flags,al
@@3:	call	GetIdent
	inc	CurCount
	mov	al,tComma
	Invoke	CheckToken
	jz	@@3
	test	Flags,vfAddress
	jz	@@4
	mov	es,SystemUnit
	mov	di,_Void
	cmp	CurrentToken,tColon
	jne	@@5
@@4:	mov	al,tColon
	Invoke	NeedToken
	call	_GetTypeName
	test	Flags,vfAddress
	jnz	@@5
	cmp	es:[di].tdType,ttFile
	je	@@8
	cmp	es:[di].tdType,ttText
	je	@@8
@@5:	call	_SearchUnit
	push	dx ax
	mov	ax,size TProcParam
	mul	CurCount
	Invoke	GetDictMem
	pop	ax dx
	mov	bl,Flags
	mov	cx,CurCount
@@6:	mov	es:[di].ppType.Offs,ax
	mov	es:[di].ppType.Segm,dx
	mov	es:[di].ppFlags,bl
	add	di,size TProcParam
	loop	@@6
	mov	ax,CurCount
	add	TotalCount,ax
	mov	al,tSemicolon
	Invoke	CheckToken
	jnz	@@7
	jmp	@@1
@@7:	mov	cx,TotalCount
	Exit
@@8:	mov	ax,126
	Chain	CompileError
GetParamList	endp

GetIdent	proc	near
	Invoke	NeedIdent
	lea	si,IdentBuf
	mov	al,[si]
	mov	ah,0
	inc	ax
	mov	cx,ax
	lea	bx,TempDict
	Invoke	GetMemory
	rep	movsb
	Chain	GetToken
GetIdent	endp

SetType	proc	near
	Invoke	GetToken
	mov	al,tOf
	Invoke	NeedToken
	call	GetBound
	mov	ax,es:[di].itLowerBound.W0
	mov	bx,es:[di].itUpperBound.W0
	or	ah,bh
	jnz	@@1
	mov	cl,3
	shr	ax,cl
	shr	bx,cl
	sub	bx,ax
	inc	bx
	call	_SearchUnit
	push	dx ax
	mov	ax,size TSetType
	mov	cx,ttSet
	call	PutTypePrefix
	pop	es:[di].stBase
	ret
@@1:	mov	ax,23
	Chain	CompileError
SetType	endp

PointerType	proc	near
	Invoke	GetToken
	mov	al,CurrentToken
	mov	di,_String
	cmp	al,tString
	je	@@1
	mov	di,_File
	cmp	al,tFile
	je	@@1
	push	TempDict.Offs
	call	GetIdent
	mov	ax,size TPointerType
	mov	bx,4
	mov	cx,ttPointer+emLongint*256
	call	PutTypePrefix
	mov	ax,ForwardTypes
	mov	es:[di].ptBase.Offs,ax
	pop	es:[di].ptBase.Segm
	mov	ForwardTypes,di
	ret
@@1:	mov	es,SystemUnit
	call	_SearchUnit
	push	dx ax
	mov	ax,size TPointerType
	mov	bx,4
	mov	cx,ttPointer+emLongint*256
	call	PutTypePrefix
	pop	es:[di].ptBase
	Chain	GetToken
PointerType	endp

FileType	proc	near
	Invoke	GetToken
	mov	al,tOf
	Invoke	CheckToken
	jnz	@@1
	call	GetTypeNoObj
	mov	al,es:[di].tdType
	cmp	al,ttObject
	je	@@2
	cmp	al,ttFile
	je	@@2
	cmp	al,ttText
	je	@@2
	call	_SearchUnit
	push	dx ax
	mov	ax,size TFileType
	mov	bx,128
	mov	cx,4
	call	PutTypePrefix
	pop	es:[di].ftBase
	ret
@@1:	mov	es,SystemUnit
	mov	di,_File
	ret
@@2:	mov	ax,24
	Chain	CompileError
FileType	endp

StringType	proc	near
	Invoke	GetToken
	mov	al,tOBracket
	Invoke	CheckToken
	jz	@@2
	mov	es,SystemUnit
	mov	di,_String
	ret
@@1:	mov	ax,25
	Chain	CompileError
@@2:	call	GetIntConstExpr
	or	dx,dx
	jnz	@@1
	or	ah,ah
	jnz	@@1
	or	al,al
	jz	@@1
	push	ax
	mov	di,_Longint
	mov	es,SystemUnit
	call	_SearchUnit
	push	dx ax
	mov	ax,size TOrdinalType
	mov	bx,1
	mov	cx,ttInteger+emByte*256
	call	PutTypePrefix
	pop	es:[di].itBase
	pop	bx
	xor	ax,ax
	mov	es:[di].itLowerBound.W0,ax
	mov	es:[di].itLowerBound.W2,ax
	mov	es:[di].itUpperBound.W0,bx
	mov	es:[di].itUpperBound.W2,ax
	inc	bx
	call	_SearchUnit
	push	dx ax
	mov	di,_Char
	mov	es,SystemUnit
	call	_SearchUnit
	push	dx ax
	mov	ax,size TArrayType
	mov	cx,ttString
	call	PutTypePrefix
	pop	es:[di].atBase
	pop	es:[di].atBounds
	mov	al,tCBracket
	Chain	NeedToken
StringType	endp

EnumType	proc	near
	Invoke	GetToken
	mov	ax,size TOrdinalType
	xor	bx,bx
	mov	cx,ttEnum
	call	PutTypePrefix
	push	es di
	call	_SearchUnit
	mov	es:[di].itBase.Offs,ax
	mov	es:[di].itBase.Segm,dx
	push	dx ax
	mov	ax,size TSetType+2
	mov	bx,32
	mov	cx,ttSet
	call	PutTypePrefix
	pop	bx dx
	mov	es:[di].stBase.Offs,bx
	mov	es:[di].stBase.Segm,dx
	mov	cx,-1
@@1:	inc	cx
	push	bx cx dx
	mov	ax,size TConstStub+4
	Invoke	AddIdent2Dict
	mov	es:[bx].seType,t_Const
	pop	dx cx bx
	mov	ax,bx
	stosw
	mov	ax,dx
	stosw
	mov	ax,cx
	stosw
	xor	ax,ax
	stosw
	mov	al,tComma
	Invoke	CheckToken
	jz	@@1
	mov	al,tCParen
	Invoke	NeedToken
	mov	ax,cx
	xor	dx,dx
	call	FitConstType
	mov	bx,1
	test	al,emX
	jz	@@2
	inc	bx
@@2:	pop	di es
	mov	es:[di].tdModifier,al
	mov	es:[di].tdSizeOf,bx
	xor	ax,ax
	mov	es:[di].itLowerBound.W0,ax
	mov	es:[di].itLowerBound.W2,ax
	mov	es:[di].itUpperBound.W0,cx
	mov	es:[di].itUpperBound.W2,ax
	mov	es:[di].etReserved,ax
	ret
EnumType	endp

RangeType	proc	near
	Loc	LowerBound,byte,<size TExpr>
	Loc	UpperBound,byte,<size TExpr>
	Entry
	lea	di,LowerBound
	call	GetConstExpr
	cmp	es:[bx].tdType,ttInteger
	jae	@@1
	mov	ax,27
	Chain	CompileError
@@1:	mov	al,tRange
	Invoke	NeedToken
	lea	di,UpperBound
	call	GetConstExpr
	cmp	bx,LowerBound.exType.Offs
	jne	@@2
	mov	ax,es
	cmp	ax,LowerBound.exType.Segm
	je	@@3
@@2:	mov	ax,26
	Chain	CompileError
@@3:	mov	ax,UpperBound.exValue.W0
	mov	dx,UpperBound.exValue.W2
	sub	ax,LowerBound.exValue.W0
	sbb	dx,LowerBound.exValue.W2
	jge	@@4
	mov	ax,28
	Chain	CompileError
@@4:	mov	ax,LowerBound.exValue.W0
	mov	dx,LowerBound.exValue.W2
	call	FitConstType
	mov	cl,al
	mov	ax,UpperBound.exValue.W0
	mov	dx,UpperBound.exValue.W2
	call	FitConstType
	mov	ah,cl
	call	IntExtension
	mov	bx,1
	test	al,emX
	jz	@@5
	inc	bx
	test	al,emXX
	jz	@@5
	inc	bx
	inc	bx
@@5:	les	di,LowerBound.exType
	mov	cl,es:[di].tdType
	mov	ch,al
	call	_SearchUnit
	push	dx ax
	mov	ax,size TOrdinalType
	call	PutTypePrefix
	mov	ax,LowerBound.exValue.W0
	mov	es:[di].itLowerBound.W0,ax
	mov	ax,LowerBound.exValue.W2
	mov	es:[di].itLowerBound.W2,ax
	mov	ax,UpperBound.exValue.W0
	mov	es:[di].itUpperBound.W0,ax
	mov	ax,UpperBound.exValue.W2
	mov	es:[di].itUpperBound.W2,ax
	pop	es:[di].itBase
	Exit
RangeType	endp

GetBound	proc	near
	Invoke	ProcessCaret
	call	GetTypeNoObj
	cmp	es:[di].tdType,ttInteger
	jb	@@1
	cmp	es:[di].tdSizeOf,2
	ja	@@1
	ret
@@1:	mov	ax,29
	Chain	CompileError
GetBound	endp

PutTypePrefix	proc	near
	push	bx
	Invoke	GetDictMem
	pop	bx
	mov	word ptr es:[di].tdType,cx
	mov	es:[di].tdSizeOf,bx
	mov	es:[di].tdNext,0
	ret
PutTypePrefix	endp

_SearchUnit	proc	near
	mov	ax,di
	mov	dx,es
SearchUnit	label	near
	push	bx di ds
	mov	ds,Dictionary.Segm
	mov	di,ds:uhName
	xor	bx,bx
	jmp	short @@2
@@1:	mov	di,[di+size TSymbol+bx].usNext
	or	di,di
	jz	@@3
@@2:	mov	bl,[di].seName.B0
	cmp	dx,[di+size TSymbol+bx].usAddress
	jne	@@1
	lea	dx,[di+size TSymbol+bx]
	pop	ds di bx
	ret
@@3:	pop	ds
	mov	ax,136
	Chain	CompileError
_SearchUnit	endp

GetInitializer	proc	near
	push	es di
	mov	ax,es:[di].tdSizeOf
	lea	bx,CompiledConst
	mov	cx,ax
	Invoke	GetMemory
	mov	ConstPtr,di
	xor	al,al
	rep	stosb
	mov	ConstSectStart2,di
	pop	di es
	call	_GetInit
	mov	ax,ConstSectStart
	mov	ConstSectStart2,ax
	ret
GetInitializer	endp

_GetInit	proc	near
	mov	bl,es:[di]
	xor	bh,bh
	shl	bx,1
	jmp	cs:@@1[bx]
@@1	dw	InitError
	dw	InitArray
	dw	InitRecord
	dw	InitRecord
	dw	InitError
	dw	InitError
	dw	InitNumber
	dw	InitSet
	dw	InitNumber
	dw	InitString
	dw	InitNumber
	dw	InitNumber
	dw	InitNumber
	dw	InitNumber
	dw	InitNumber
	dw	InitNumber
_GetInit	endp

InitError	proc	near
	mov	ax,99
	Chain	CompileError
InitError	endp

InitArray	proc	near
	Loc	_Type,dword,1
	Entry
	mov	_Type.Offs,di
	mov	_Type.Segm,es
	lea	di,_Type
	Invoke	CheckPackedChar
	jnz	@@2
	cmp	CurrentToken,tOParen
	je	@@2
	call	GetStrConstExpr
	mov	cl,[bx]
	xor	ch,ch
	inc	bx
	les	di,_Type
	mov	ax,es:[di].tdSizeOf
	cmp	cx,ax
	jne	@@1
	call	PutConst
	jmp	short @@5
@@1:	mov	ax,100
	Chain	CompileError
@@2:	mov	al,tOParen
	Invoke	NeedToken
	les	di,_Type
	mov	bx,es:[di].atBounds.Segm
	mov	di,es:[di].atBounds.Offs
	mov	es,es:[bx]
	mov	cx,es:[di].itUpperBound.W0
	sub	cx,es:[di].itLowerBound.W0
	les	di,_Type
	mov	bx,es:[di].atBase.Segm
	mov	di,es:[di].atBase.Offs
	mov	es,es:[bx]
@@3:	push	cx es di
	call	_GetInit
	pop	di es cx
	dec	cx
	js	@@4
	mov	al,tComma
	Invoke	NeedToken
	jmp	@@3
@@4:	mov	al,tCParen
	Invoke	NeedToken
@@5:	Exit
InitArray	endp

InitRecord	proc	near
	Loc	_Type,dword,1
	Loc	SaveConstPtr,word,1
	Loc	VMTOffset,word,1
	Entry
	mov	_Type.Offs,di
	mov	_Type.Segm,es
	mov	ax,ConstPtr
	mov	SaveConstPtr,ax
	mov	ax,-1
	cmp	es:[di].tdType,ttObject
	jne	@@1
	cmp	es:[di].otVMTSize,0
	je	@@1
	mov	ax,es
	mov	bx,es:[di].otVMTAddr
	mov	cx,ffConst+ffOffs
	xor	dx,dx
	mov	si,ConstPtr
	add	si,es:[di].otVMTOffset
	Invoke	PutConstFixup
	mov	ax,es:[di].otVMTOffset
@@1:	mov	VMTOffset,ax
	mov	al,tOParen
	Invoke	NeedToken
	cmp	CurrentToken,tCParen
	je	@@4
@@2:	mov	ax,ConstPtr
	sub	ax,SaveConstPtr
	cmp	ax,VMTOffset
	jne	@@3
	add	ConstPtr,2
@@3:	les	si,_Type
	Invoke	SearchField
	jnz	@@5
	cmp	al,t_Var
	jne	@@5
	Invoke	GetToken
	mov	ax,ConstPtr
	sub	ax,SaveConstPtr
	cmp	ax,es:[di].vsOffset
	jne	@@6
	mov	al,tColon
	Invoke	NeedToken
	mov	bx,es:[di].vsType.Segm
	mov	di,es:[di].vsType.Offs
	mov	es,es:[bx]
	call	_GetInit
	mov	al,tSemicolon
	Invoke	CheckToken
	jz	@@2
@@4:	mov	al,tCParen
	Invoke	NeedToken
	les	di,_Type
	mov	ax,SaveConstPtr
	add	ax,es:[di].tdSizeOf
	mov	ConstPtr,ax
	Exit
@@5:	mov	ax,44
	Chain	CompileError
@@6:	mov	ax,101
	Chain	CompileError
InitRecord	endp

InitSet	proc	near
	Loc	Temp,byte,<size TExpr>
	Entry
	push	es di
	lea	di,Temp
	call	GetConstExpr
	mov	si,sp
	Invoke	TypeCompat
	pop	bx es
	Invoke	SetBaseAndSize
	mov	bl,ah
	xor	bh,bh
	add	bx,Temp.exOffset
	xor	ah,ah
	mov	cx,ax
	call	PutConst
	Exit
InitSet	endp

InitString	proc	near
	push	es:[di].tdSizeOf
	call	GetStrConstExpr
	pop	ax
	dec	ax
	mov	cl,[bx]
	xor	ch,ch
	cmp	cx,ax
	jbe	@@1
	mov	cx,ax
	mov	[bx],cl
@@1:	inc	ax
	inc	cx
	jmp	PutConst
InitString	endp

InitNumber	proc	near
	Loc	Temp,byte,<size TExpr>
	Entry
	push	StmtPart.Offs es di
	lea	di,Temp
	mov	si,sp
	Invoke	GetExpression
	mov	si,sp
	Invoke	AssignmentCast
	Invoke	TypeCompat
	Invoke	CastOrdinal
	pop	di es ax
	cmp	ax,StmtPart.Offs
	jne	@@8
	cmp	es:[di].tdType,tt8087
	jne	@@1
	mov	al,es:[di].tdModifier
	lea	bx,Temp.exValue
	Invoke	Extended2Float
@@1:	mov	ax,es:[di].tdSizeOf
	cmp	Temp.exLocation,elAddress
	je	@@2
	lea	bx,Temp.exValue
	mov	cx,ax
	call	PutConst
	jmp	short @@7
@@2:	test	Temp.exMisc,efSS+efES+efBP+efDI
	jnz	@@8
	push	ax
	mov	ax,Temp.exSegment
	mov	bx,Temp.exMap
	mov	dx,Temp.exOffset
	test	Temp.exMisc,efDS
	jnz	@@3
	xor	cx,cx
	test	Temp.exMisc,efCS
	jz	@@4
	mov	cx,ffCode
	jmp	short @@4
@@3:	mov	cx,ffData
	test	Temp.exMisc,efConst
	jz	@@4
	mov	cx,ffConst
@@4:	test	Temp.exMisc,efSeg
	jnz	@@5
	or	cx,ffOffs
	test	Temp.exModifier,emXX
	jz	@@6
@@5:	or	cx,ffSegm
@@6:	mov	si,ConstPtr
	Invoke	PutConstFixup
	pop	ax
	add	ConstPtr,ax
@@7:	Exit
@@8:	mov	ax,133
	Chain	CompileError
InitNumber	endp

PutConst	proc	near
	mov	si,bx
	mov	di,ConstPtr
	mov	es,CompiledConst.Segm
	rep	movsb
	add	ConstPtr,ax
	ret
PutConst	endp

GetConstExpr	proc	near
	push	StmtPart.Offs
	Invoke	GetExpr
	pop	ax
	cmp	ax,StmtPart.Offs
	jne	@@2
	cmp	[di].exLocation,elImmediate
	jne	@@2
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttInteger
	jb	@@1
	mov	si,es:[bx].itBase.Segm
	mov	bx,es:[bx].itBase.Offs
	mov	es,es:[si]
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
@@1:	ret
@@2:	mov	ax,133
	Chain	CompileError
GetConstExpr	endp

GetIntConstExpr	proc	near
	Loc	Temp,byte,<size TExpr>
	Entry
	lea	di,Temp
	call	GetConstExpr
	cmp	es:[bx].tdType,ttInteger
	jne	@@1
	mov	ax,[di].exValue.W0
	mov	dx,[di].exValue.W2
	Exit
@@1:	mov	ax,30
	Chain	CompileError
GetIntConstExpr	endp

GetStrConstExpr	proc	near
	Loc	Temp,byte,<size TExpr>
	Entry
	lea	di,Temp
	call	GetConstExpr
	Invoke	ConvChar2String
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttString
	jne	@@1
	mov	bx,[di].exOffset
	Exit
@@1:	mov	ax,102
	Chain	CompileError
GetStrConstExpr	endp

FitConstType	proc	near
	or	dx,dx
	js	@@5
	jnz	@@4
	or	ah,ah
	js	@@3
	jnz	@@2
	or	al,al
	js	@@1
	xor	al,al
	ret
@@1:	mov	al,emByte
	ret
@@2:	mov	al,emX
	ret
@@3:	mov	al,emWord
	ret
@@4:	mov	al,emX+emXX
	ret
@@5:	cmp	dx,-1
	jne	@@7
	cmp	ah,-1
	jne	@@6
	or	al,al
	jns	@@6
	mov	al,emShortint
	ret
@@6:	or	ah,ah
	jns	@@7
	mov	al,emInteger
	ret
@@7:	mov	al,emLongint
	ret
FitConstType	endp

IntExtension	proc	near
	cmp	al,ah
	jae	@@1
	xchg	al,ah
@@1:	test	ah,emSigned
	jz	@@3
	test	al,emUnsigned
	jz	@@2
	shl	al,1
@@2:	or	al,emSigned
@@3:	ret
IntExtension	endp

	end
