stmtpart.asm

Turbo Pascal 6.0编译器源码

	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