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

	model	large compiler_text,pascal 
	include	compiler.inc 
 
	.code	compiler_text 
 
	public	StatementPart 
 
StatementPart	proc	near 
	Loc	EntryGoal,word,1 
	Loc	BeginLineNumber,word,1 
	Loc	BodyGoal,word,1 
	Loc	ExitGoal,word,1 
	Loc	EndLineNumber,word,1 
	Entry 
	push	Dictionary.Offs 
	mov	InStmtPart,1 
	mov	ax,2 
	mov	LastGoal,ax 
	Invoke	GetStmtMem 
	mov	ax,LocalsSize 
	mov	TempLocalsSize,ax 
	xor	ax,ax 
	mov	ExitChain,ax 
	mov	FailChain,ax 
	mov	LabelChain,ax 
	mov	di,FileStackPtr 
	mov	ax,[di].fsLineNumber 
	mov	FirstLineNumber,ax 
	mov	LastLineNumber,ax 
	Invoke	GetLineNumber 
	mov	BeginLineNumber,ax 
	push	GlobalOptions 
	mov	es,Dictionary.Segm 
	mov	di,CurProc 
	or	di,di 
	jz	@@1 
	test	es:[di].psFlags,pfAssembler 
	jz	@@1 
	Invoke	AsmClause 
	jmp	short @@2 
@@1:	Invoke	CompoundStmt 
@@2:	mov	BodyGoal,ax 
	pop	CompilerOptions 
	Invoke	GetLineNumber 
	mov	EndLineNumber,ax 
	call	ResolveLabels 
	and	LocalsSize,0fffeh 
	mov	es,Dictionary.Segm 
	mov	di,CurProc 
	or	di,di 
	jnz	@@3 
	call	ProgramEntry 
	push	ax 
	call	ProgramExit 
	pop	dx 
	jmp	short @@5 
@@3:	test	es:[di].psFlags,pfInterrupt 
	jz	@@4 
	and	CompilerOptions,not coStackChk 
	call	InterruptEntry 
	push	ax 
	call	InterruptExit 
	pop	dx 
	jmp	short @@5 
@@4:	call	ProcEntry 
	push	ax 
	call	ProcExit 
	pop	dx 
@@5:	mov	EntryGoal,dx 
	mov	ExitGoal,ax 
	mov	ax,BeginLineNumber 
	Invoke	PutLineNumber 
	mov	ax,EntryGoal 
	Invoke	UseGoal 
	mov	ax,BodyGoal 
	Invoke	UseGoal 
	cmp	FailChain,0 
	je	@@6 
	mov	al,cdAlways 
	lea	bx,ExitChain 
	Invoke	PutJmp 
	lea	bx,FailChain 
	Invoke	PutLabel 
	mov	es,Dictionary.Segm 
	mov	di,CurProc 
	mov	di,es:[di].psScope 
	mov	dx,es:[di].otVMTOffset 
	mov	al,lvDI 
	Invoke	LoadWord 
	mov	ax,_Destruct 
	Invoke	PutSystemCall 
@@6:	lea	bx,ExitChain 
	Invoke	PutLabel 
	mov	ax,EndLineNumber 
	Invoke	PutLineNumber 
	mov	ax,ExitGoal 
	Invoke	UseGoal 
	mov	ax,CompiledCode.Offs 
	sub	ax,CodeSectStart 
	push	ax 
	Invoke	RearrangeCode 
	xor	ax,ax 
	mov	StmtPart.Offs,ax 
	mov	LastGoal,ax 
	mov	InStmtPart,al 
	pop	ax Dictionary.Offs 
	Exit 
StatementPart	endp 
 
ProgramEntry	proc	near 
	cmp	ProgramSection,0 
	jge	@@8 
	mov	ax,_InitTurbo 
	Invoke	PutSystemCall 
	mov	ax,FirstUnit 
@@1:	mov	es,ax 
	test	es:uhFlags,uf8087 
	jnz	@@2 
	mov	ax,es:uhNext 
	or	ax,ax 
	jnz	@@1 
	jmp	short @@4 
@@2:	mov	ax,_InitEM86 
	test	GlobalOptions,coEmulation 
	jnz	@@3 
	mov	ax,_InitEM87 
@@3:	Invoke	PutSystemCall 
@@4:	xor	cx,cx 
	mov	es,FirstUnit 
	jmp	short @@6 
@@5:	mov	es,ax 
	mov	bx,es:uhProcMap 
	cmp	es:[bx].pmCodeMap,-1 
	je	@@6 
	inc	cx 
	push	es 
@@6:	mov	ax,es:uhNext 
	or	ax,ax 
	jnz	@@5 
	jcxz	@@8 
@@7:	mov	al,9ah			; call 
	Invoke	PutByte 
	pop	ax 
	xor	bx,bx 
	xor	dx,dx 
	push	cx 
	mov	cx,ffPtr 
	Invoke	PutFixup 
	pop	cx 
	loop	@@7 
@@8:	call	StackEntry 
	Chain	DoneGoal 
ProgramEntry	endp 
 
ProgramExit	proc	near 
	call	StackExit 
	cmp	ProgramSection,0 
	jl	@@1 
	mov	al,0cbh			; ret 
	Invoke	PutByte 
	Chain	DoneGoal 
@@1:	mov	ax,0c031h		; xor	ax,ax 
	Invoke	PutWord 
	mov	ax,_HaltTurbo 
	Invoke	PutSystemCall 
	Chain	DoneGoal 
ProgramExit	endp 
 
ProcEntry	proc	near 
	Loc	ParamOffset,word,1 
	Loc	CopyOffset,word,1 
	Entry 
	mov	es,Dictionary.Segm 
	mov	di,CurProc 
	test	es:[di].psFlags,pfAssembler 
	jz	@@1 
	mov	ax,ParamsSize 
	or	ax,LocalsSize 
	jz	@@2 
@@1:	call	StackEntry 
@@2:	mov	cx,es:[di].psType.ptParamCount 
	jcxz	@@4 
	test	es:[di].psFlags,pfAssembler 
	jnz	@@4 
	mov	ax,ParamsBottom 
	mov	ParamOffset,ax 
	mov	ax,ProcResult 
	mov	CopyOffset,ax 
	push	di 
	add	di,psType.ptParams 
@@3:	push	cx di es 
	mov	al,es:[di].ppFlags 
	mov	bx,es:[di].ppType.Segm 
	mov	di,es:[di].ppType.Offs 
	mov	es,es:[bx] 
	call	ProcessParam 
	pop	es di cx 
	add	di,size TProcParam 
	loop	@@3 
	pop	di 
@@4:	test	es:[di].psFlags,pfConstructor 
	jz	@@5 
	mov	si,es:[di].psScope 
	mov	dx,es:[si].otVMTOffset 
	mov	al,lvDI 
	Invoke	LoadWord 
	mov	ax,_Construct 
	Invoke	PutSystemCall 
	mov	al,cdEqual 
	lea	bx,ExitChain 
	Invoke	PutJmp 
@@5:	Invoke	DoneGoal 
	Exit 
 
ProcessParam	proc	near 
	xor	ah,ah 
	Invoke	ParamSize 
	sub	ParamOffset,cx 
	sub	CopyOffset,dx 
	cmp	dx,1 
	jbe	@@1 
	test	GlobalOptions,coWordAlign 
	jz	@@1 
	and	CopyOffset,0fffeh 
@@1:	test	al,vfAddress 
	jnz	@@3 
	cmp	es:[di].tdType,ttObject 
	jne	@@3 
	cmp	es:[di].otVMTSize,0 
	je	@@3 
	push	dx 
	mov	ax,ParamOffset 
	or	dx,dx 
	jz	@@2 
	mov	ax,CopyOffset 
@@2:	add	ax,es:[di].otVMTOffset 
	mov	dx,6c7h			; mov	[bp- 
	Invoke	AddOffset 
	mov	ax,es 
	mov	bx,es:[di].otVMTAddr 
	mov	cx,ffOffs+ffConst 
	xor	dx,dx 
	Invoke	PutFixup 
	pop	dx 
@@3:	or	dx,dx 
	jnz	@@4 
	ret 
@@4:	mov	ax,ParamOffset 
	mov	dx,3ec4h		; les	di,[bp+ 
	Invoke	AddOffset 
	mov	ax,5706h		; push	es	push	di 
	Invoke	PutWord 
	mov	ax,CopyOffset 
	mov	dx,3e8dh		; lea	di,[bp- 
	Invoke	AddOffset 
	mov	ax,5716h		; push	ss	push	di 
	Invoke	PutWord 
	mov	al,es:[di].tdType 
	cmp	al,ttString 
	jne	@@5 
	mov	ax,es:[di].tdSizeOf 
	dec	ax 
	Invoke	PushWord 
	mov	ax,_SStore 
	jmp	short @@8 
@@5:	cmp	al,ttSet 
	jne	@@6 
	mov	bx,di 
	Invoke	PushSetAddr 
	mov	ax,_ZStore 
	jmp	short @@8 
@@6:	cmp	al,ttObject 
	jne	@@7 
	cmp	es:[di].otVMTSize,0 
	je	@@7 
	mov	ax,es:[di].otVMTOffset 
	Invoke	PushWord 
	mov	ax,_CopyObject 
	jmp	short @@8 
@@7:	mov	ax,es:[di].tdSizeOf 
	Invoke	PushWord 
	mov	ax,_BlockMove 
@@8:	Chain	PutSystemCall 
ProcessParam	endp 
 
ProcEntry	endp 
 
ProcExit	proc	near 
	mov	es,Dictionary.Segm 
	mov	di,CurProc 
	test	es:[di].psFlags,pfConstructor 
	jz	@@1 
	mov	ax,46c4h		; les	ax,[bp+6] 
	Invoke	PutWord 
	mov	al,6 
	Invoke	PutByte 
	mov	ax,0c28ch		; mov	dx,es 
	Invoke	PutWord 
	jmp	short @@2 
@@1:	test	es:[di].psFlags,pfDestructor 
	jz	@@2 
	mov	si,es:[di].psScope 
	mov	dx,es:[si].otVMTOffset 
	mov	al,lvDI 
	Invoke	LoadWord 
	mov	ax,_Destruct 
	Invoke	PutSystemCall 
@@2:	mov	bx,es:[di].psType.ptResult.Segm 
	or	bx,bx 
	jz	@@6 
	test	es:[di].psFlags,pfAssembler 
	jnz	@@6 
	push	es di 
	mov	di,es:[di].psType.ptResult.Offs 
	mov	es,es:[bx] 
	mov	al,es:[di].tdType 
	cmp	al,ttInteger 
	jae	@@4 
	cmp	al,ttPointer 
	je	@@4 
	cmp	al,ttReal 
	je	@@4 
	cmp	al,tt8087 
	jne	@@5 
	mov	dx,6d9h			; fld	[bp- 
	or	dl,es:[di].tdModifier 
	test	dl,2 
	jz	@@3 
	mov	dh,2eh 
@@3:	mov	ax,ProcResult 
	Invoke	FloatAddOffset 
	Invoke	PutFwait 
	jmp	short @@5 
@@4:	mov	cx,ProcResult 
	mov	dx,es:[di].tdSizeOf 
	call	LoadResult 
@@5:	pop	di es 
@@6:	test	es:[di].psFlags,pfAssembler 
	jz	@@7 
	mov	ax,ParamsSize 
	or	ax,LocalsSize 
	jz	@@8 
@@7:	call	StackExit 
@@8:	mov	al,0c3h			; retn 
	test	es:[di].psFlags,pfFar 
	jz	@@9 
	mov	al,0cbh			; retf 
@@9:	mov	cx,ParamsSize 
	jcxz	@@10 
	dec	al 
	Invoke	PutByte 
	mov	ax,cx 
	Invoke	PutWord 
	Chain	DoneGoal 
@@10:	Invoke	PutByte 
	Chain	DoneGoal 
ProcExit	endp 
 
LoadResult	proc	near 
	mov	ax,468ah		; mov	al,[bp- 
	dec	dx 
	jz	@@2 
	inc	ax 
	dec	dx 
	jz	@@2 
	call	@@2 
	dec	dx 
	dec	dx 
	jz	@@1 
	mov	ax,5e8bh		; mov	bx,[bp- 
	call	@@2 
@@1:	mov	ax,568bh		; mov	dx,[bp- 
@@2:	Invoke	PutWord 
	mov	al,cl 
	inc	cx 
	inc	cx 
	Chain	PutByte 
LoadResult	endp 
 
InterruptEntry	proc	near 
	mov	ax,5350h		; push	ax	push	bx 
	Invoke	PutWord 
	mov	ax,5251h		; push	cx	push	dx 
	Invoke	PutWord 
	mov	ax,5756h		; push	si	push	di 
	Invoke	PutWord 
	mov	ax,61eh			; push	ds	push	es 
	Invoke	PutWord 
	call	StackEntry 
	mov	al,0b8h			; mov	ax, 
	Invoke	PutByte 
	mov	ax,Dictionary.Segm 
	xor	bx,bx 
	mov	cx,ffSegm+ffData 
	xor	dx,dx 
	Invoke	PutFixup 
	mov	ax,0d88eh		; mov	ds,ax 
	Invoke	PutWord 
	Chain	DoneGoal 
InterruptEntry	endp 
 
InterruptExit	proc	near 
	call	StackExit 
	mov	ax,1f07h		; pop	es	pop	ds 
	Invoke	PutWord 
	mov	ax,5e5fh		; pop	di	pop	si 
	Invoke	PutWord 
	mov	ax,595ah		; pop	dx	pop	cx 
	Invoke	PutWord 
	mov	ax,585bh		; pop	bx	pop	ax 
	Invoke	PutWord 
	mov	al,0cfh			; iret 
	Invoke	PutByte 
	Chain	DoneGoal 
InterruptExit	endp 
 
StackEntry	proc	near 
	test	CompilerOptions,co286Code 
	jz	@@1 
	cmp	LocalsSize,0 
	je	@@1 
	test	CompilerOptions,coStackChk 
	jnz	@@1 
	mov	al,0c8h			; enter 
	Invoke	PutByte 
	mov	ax,LocalsSize 
	neg	ax 
	Invoke	PutWord 
	mov	al,0 
	Chain	PutByte 
@@1:	mov	al,55h			; push	bp 
	Invoke	PutByte 
	mov	ax,0e589h		; mov	bp,sp 
	Invoke	PutWord 
	test	CompilerOptions,coStackChk 
	jz	@@2 
	mov	dx,LocalsBottom 
	sub	dx,LocalsSize 
	mov	al,0 
	Invoke	LoadWord 
	mov	ax,_StackCheck 
	Invoke	PutSystemCall 
@@2:	mov	ax,LocalsBottom 
	sub	ax,LocalsSize 
	jz	@@3 
	mov	dl,0ech			; sub	sp, 
	Chain	PutArOpImm 
@@3:	ret 
StackEntry	endp 
 
StackExit	proc	near 
	test	CompilerOptions,co286Code 
	jz	@@1 
	mov	al,0c9h			; leave 
	Chain	PutByte 
@@1:	cmp	LocalsSize,0 
	je	@@2 
	mov	ax,0ec89h		; mov	sp,bp 
	Invoke	PutWord 
@@2:	mov	al,5dh			; pop	bp 
	Chain	PutByte 
StackExit	endp 
 
ResolveLabels	proc	near 
	push	ds 
	mov	si,LabelChain 
	mov	es,Dictionary.Segm 
	mov	ds,StmtPart.Segm 
	jmp	short @@2 
@@1:	mov	di,[si+2] 
	mov	bl,es:[di].seName 
	mov	bh,0 
	mov	ax,es:[di+size TSymbol+bx].lsLink 
	or	ax,ax 
	jz	@@3 
	mov	[si+2],ax 
	mov	si,[si+4] 
@@2:	or	si,si 
	jnz	@@1 
	pop	ds 
	ret 
@@3:	pop	ds 
	mov	ax,82 
	add	di,seName 
	Chain	ParamError 
ResolveLabels	endp 
 
	end