www.pudn.com > tp60src.zip > DECLARE.ASM

	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, 
	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, 
	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, 
	Loc	UpperBound,byte, 
	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, 
	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, 
	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, 
	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, 
	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