units.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	.code	compiler_text

	public	SaveState
	public	RestoreState
	public	Add2TpuList
	public	FormUnit
	public	WriteUnit
	public	ReadUnit
	public	DiscardUnits
	public	ReadLibrary

SaveState	proc	near
	Invoke	SaveHeap
	mov	cx,CompMemPtr
	mov	dx,CompMemTop
	call	UpdateLinks
	lea	si,CompilerFlags
	lea	ax,FileNameBuf
	sub	ax,si
	push	ax
	add	ax,15
	mov	cl,4
	shr	ax,cl
	sub	CompMemTop,ax
	pop	cx
	xor	di,di
	mov	es,CompMemTop
	rep	movsb
	ret
SaveState	endp

RestoreState	proc	near
	lea	di,CompilerFlags
	lea	ax,FileNameBuf
	sub	ax,di
	mov	cx,ax
	xor	si,si
	push	ds
	pop	es
	mov	ds,CompMemTop
	rep	movsb
	push	es
	pop	ds
	add	ax,15
	mov	cl,4
	shr	ax,cl
	add	CompMemTop,ax
	push	CompMemPtr CompMemTop
	Invoke	RestoreHeap
	pop	cx dx
UpdateLinks	label	near
	xor	bx,bx
	lea	di,FirstUnit
	call	_UpdateLinks
	lea	di,UsedUnit
	call	_UpdateLinks
	mov	es,UnitList.Segm
	xor	di,di
	jmp	short @@3
@@1:	cmp	es:[di].ulSegment,cx
	jne	@@2
	mov	es:[di].ulSegment,dx
@@2:	mov	bl,es:[di].ulName.B0
	lea	di,[di+size TUnitList+bx]
@@3:	cmp	di,UnitList.Offs
	jne	@@1
	ret
RestoreState	endp

_UpdateLinks	proc	near
	mov	ax,[di]
	cmp	ax,cx
	jne	@@4
	mov	ax,dx
	mov	[di],ax
	jmp	short @@4
@@1:	mov	es,ax
	mov	di,es:uhName
@@2:	mov	bl,es:[di].seName.B0
	cmp	es:[di+size TSymbol+bx].usAddress,cx
	jne	@@3
	mov	es:[di+size TSymbol+bx].usAddress,dx
@@3:	mov	di,es:[di+size TSymbol+bx].usNext
	or	di,di
	jnz	@@2
	mov	ax,es:uhNext
	cmp	ax,cx
	jne	@@4
	mov	ax,dx
	mov	es:uhNext,ax
@@4:	or	ax,ax
	jnz	@@1
	ret
_UpdateLinks	endp

Add2TpuList	proc	near
	mov	ax,CompiledCode.Segm
	mov	CompMemPtr,ax
	mov	di,TpuListPtr
	cmp	di,offset TpuList[4016]
	ja	@@1
	mov	es,FirstUnit
	mov	es:uhTpuName,di
	Invoke	CopyDSCStr
	mov	TpuListPtr,di
	ret
@@1:	mov	ax,18
	Chain	CompileError
Add2TpuList	endp

FormUnit	proc	near
	lea	si,Dictionary
	xor	ax,ax
@@1:	add	ax,[si].hrAddress.Offs
	jc	@@2
	add	si,size THeapRecord
	cmp	si,offset TempDict
	jne	@@1
	cmp	ax,0fff0h
	jbe	@@3
@@2:	mov	ax,123
	Chain	CompileError
@@3:	les	ax,Dictionary
	mov	di,uhProcMap
	lea	si,ProcMap
@@4:	stosw
	xchg	ax,di
	push	ds si
	lds	cx,[si].hrAddress
	xor	si,si
	Invoke	MoveBlock
	pop	si ds
	xchg	ax,di
	add	si,size THeapRecord
	cmp	si,offset TempDict
	jne	@@4
	mov	Dictionary.Offs,ax
	stosw
	mov	ax,CompiledCode.Offs
	stosw
	mov	ax,CompiledConst.Offs
	stosw
	mov	ax,CodeFixups.Offs
	stosw
	mov	ax,ConstFixups.Offs
	stosw
	mov	ax,VarsSize
	stosw
	mov	di,Dictionary.Offs
	call	Normalize
	lea	si,CompiledCode
@@5:	push	ds si
	lds	cx,[si].hrAddress
	xor	si,si
	xor	di,di
	Invoke	MoveBlock
	call	Normalize
	pop	si
	pop	ds
	mov	[si].hrAddress.Segm,ax
	add	si,size THeapRecord
	cmp	si,offset StmtPart
	jne	@@5
	mov	CompMemPtr,es
	ret
FormUnit	endp

Normalize	proc	near
	mov	cx,di
	neg	cx
	and	cx,0fh
	xor	ax,ax
	rep	stosb
	mov	cl,4
	shr	di,cl
	mov	ax,es
	add	di,ax
	mov	es,di
	ret
Normalize	endp

WriteUnit	proc	near
	mov	dx,Dictionary.Segm
@@1:	mov	ax,CompMemPtr
	sub	ax,dx
	jz	@@3
	cmp	ax,1000h
	jb	@@2
	mov	ax,0fffh
@@2:	push	ax dx
	mov	cl,4
	shl	ax,cl
	mov	cx,ax
	xor	ax,ax
	mov	bx,FileHandle
	Invoke	WriteHandle
	pop	dx ax
	add	dx,ax
	jmp	@@1
@@3:	ret
WriteUnit	endp

ReadUnit	proc	near
	mov	dx,es:uhTpuName
	or	dx,dx
	jz	@@2
	Invoke	OpenHandle
	mov	bx,ax
	mov	ax,es:uhEndTrace
	add	ax,15
	and	ax,0fff0h
	xor	dx,dx
	or	di,di
	jz	@@1
	mov	cx,es:uhCodeSize
	call	AddLong
	mov	cx,es:uhConstSize
	call	AddLong
@@1:	xor	cx,cx
	push	bx
	Invoke	SeekHandle
	pop	bx
	push	es
	Invoke	ReadFile
	Invoke	CloseHandle
	mov	bx,es
	pop	es
	mov	es:uhCodeSeg,bx
	mov	ax,es:uhCodeSize
	call	CondAddPara
	mov	es:uhConstSeg,bx
	mov	ax,es:uhConstSize
	call	CondAddPara
	mov	es:uhCodeFixupSeg,bx
	mov	ax,es:uhCodeFixupSize
	call	AddPara
	mov	es:uhConstFixupSeg,bx
@@2:	Chain	UpdateCompInfo
ReadUnit	endp

AddLong	proc	near
	add	cx,15
	and	cx,0fff0h
	add	ax,cx
	adc	dx,0
	ret
AddLong	endp

CondAddPara	proc	near
	or	di,di
	jnz	@@1
AddPara	label	near
	add	ax,15
	mov	cl,4
	shr	ax,cl
	add	bx,ax
@@1:	ret
CondAddPara	endp

DiscardUnits	proc	near
	mov	es,FirstUnit
	mov	ax,es:uhCodeSeg
	mov	CompMemPtr,ax
	ret
DiscardUnits	endp

ReadLibrary	proc	near
	cld
	lea	ax,@@4
	Invoke	SetErrHandler
	xor	ax,ax
	mov	LibraryUnits,ax
	mov	dx,UnitName
	or	dx,dx
	jz	@@2
	Invoke	OpenHandle
	mov	bx,ax
	Invoke	ReadFile
	Invoke	CloseHandle
@@1:	cmp	es:uhSignature.W0,'PT'
	jne	@@3
	cmp	es:uhSignature.W2,'9U'
	jne	@@3
	mov	bx,es
	call	CalcSegs
	mov	ax,LibraryUnits
	mov	es:uhLink,ax
	mov	LibraryUnits,es
	mov	es,bx
	cmp	bx,CompMemPtr
	jne	@@1
@@2:	ret
@@3:	mov	ax,72
	mov	dx,UnitName
	Chain	ParamError2
@@4:	xor	ax,ax
	mov	LibraryUnits,ax
	ret
ReadLibrary	endp

CalcSegs	proc	near
	mov	ax,es:uhEndTrace
	call	@@1
	mov	es:uhCodeSeg,bx
	mov	ax,es:uhCodeSize
	call	@@1
	mov	es:uhConstSeg,bx
	mov	ax,es:uhConstSize
	call	@@1
	mov	es:uhCodeFixupSeg,bx
	mov	ax,es:uhCodeFixupSize
	call	@@1
	mov	es:uhConstFixupSeg,bx
	mov	ax,es:uhDataFixupSize
@@1:	add	ax,15
	mov	cl,4
	shr	ax,cl
	add	bx,ax
	ret
CalcSegs	endp

	end