link.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	extrn	DebugInfo:far
	extrn	LinkMap:far

uhRefCount	equ	(word ptr uhReserved)
uhCodeRelocs	equ	(word ptr uhReserved+2)
uhConstRelocs	equ	(word ptr uhReserved+4)

	.data

OverlayHeader	db	'FBOV'
OverlaySize	dd	0

	.data?

CurSegment	dw	?
ExeFileSize	dd	?
CodeBuffer	dw	?
RelocPtr	dw	?
Relocations	dw	?
RelocCount	dw	?
ConstSize	dw	?
OverlayLink	dw	?
MaxOverlaySize	dw	?
CurrentUnit	dw	?
CurrentFixup	dw	?
CurrentTarget	dd	?
CurrentSource	dw	?

	.code	compiler_text

	public	LinkProgram

LinkProgram	proc	near
	test	CompilerFlags.B0,cfDisk
	jz	@@1
	jmp	@@4
@@1:	call	ResolveUnits
	call	ReadUnits
	call	MemCalcSizes
	mov	ax,CompMemPtr
	mov	DataStart,ax
	call	MemFormData
	call	CalcDataSeg
	mov	ax,FirstUnit
@@2:	mov	es,ax
	call	ResolveCode
	call	ResolveConst
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@2
	mov	ax,FirstUnit
	mov	bx,DebuggerPSP
	add	bx,10h
@@3:	mov	es,ax
	sub	es:uhCodeStart,bx
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@3
	sub	DataStart,bx
	sub	StackStart,bx
	ret

MemCalcSizes	proc	near
	xor	ax,ax
	mov	CodeSize.W0,ax
	mov	CodeSize.W2,ax
	mov	ax,FirstUnit
@@1:	mov	es,ax
	mov	di,es:uhCodeMap
	mov	dx,es:uhConstMap
	xor	ax,ax
	mov	es:uhOverlayLength,ax
	jmp	short @@3
@@2:	mov	es:[di].smAddr,ax
	add	ax,es:[di].smLength
	add	di,size TSegMap
@@3:	cmp	di,dx
	jne	@@2
	mov	ax,es:uhCodeSeg
	mov	es:uhCodeStart,ax
	mov	ax,es:uhCodeSize
	mov	es:uhCodeLength,ax
	add	ax,15
	and	al,0f0h
	add	CodeSize.W0,ax
	adc	CodeSize.W2,0
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@1
	ret
MemCalcSizes	endp

MemFormData	proc	near
	mov	bx,2
	mov	si,uhConstMap
	call	MemFormMap
	mov	si,uhDataMap
	call	MemFormMap
	mov	DataSize,bx
	cmp	bx,0fff0h
	ja	Err1
	ret
MemFormData	endp

MemFormMap	proc	near
	mov	ax,FirstUnit
@@1:	mov	es,ax
	mov	di,es:[si]
	mov	dx,es:[si+2]
	jmp	short @@3
@@2:	mov	es:[di].smAddr,bx
	add	bx,es:[di].smLength
	jc	Err1
	add	di,size TSegMap
@@3:	cmp	di,dx
	jnz	@@2
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@1
	ret
MemFormMap	endp

Err1:	mov	ax,49
	Chain	CompileError

@@4:	call	ResolveUnits
	test	CompilerFlags.B1,cfDiskBuffer
	jnz	@@5
	call	ReadUnits
@@5:	call	InitSmartLinker
	xor	ax,ax
	mov	es,FirstUnit
	mov	es:uhOverlayLength,ax
	mov	es,SystemUnit
	mov	es:uhOverlayLength,ax
@@6:	mov	ax,FirstUnit
	xor	cx,cx
@@7:	mov	es,ax
	cmp	es:uhRefCount,0
	je	@@8
	push	cx
	Invoke	MarkMem
	push	bx
	mov	di,1
	Invoke	ReadUnit
	call	SmartLink
	pop	bx
	Invoke	ReleaseMem
	pop	cx
	inc	cx
@@8:	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@7
	or	cx,cx
	jnz	@@6
	xor	ax,ax
	mov	CurSegment,ax
	mov	MaxOverlaySize,ax
	mov	RelocCount,1ch
	call	CountSizes
	mov	ax,CurSegment
	mov	DataStart,ax
	call	FormData
	call	CalcDataSeg
	call	CreateExe
	cmp	MaxOverlaySize,0
	je	@@9
	mov	ax,feOvr+feForceExt+(fdOutputDir+fdNoEditor)*256
	Invoke	CreateFile
	mov	ax,8
	xor	dx,dx
	xor	cx,cx
	mov	bx,FileHandle
	Invoke	SeekHandle
@@9:	xor	ax,ax
	mov	OverlayLink,ax
	mov	OverlaySize.W0,8
	mov	OverlaySize.W2,ax
	mov	RelocPtr,1ch
	mov	ax,FirstUnit
@@10:	mov	es,ax
	Invoke	MarkMem
	push	bx
	xor	di,di
	Invoke	ReadUnit
	mov	ax,es:uhCodeLength
	cmp	ax,es:uhOverlayLength
	jae	@@11
	mov	ax,es:uhOverlayLength
@@11:	Invoke	GetMemOnBottom
	mov	CodeBuffer,bx
	call	ResolveCode
	call	SqueezeCode
	cmp	es:uhOverlayLength,0
	jne	@@12
	call	CodeRelocs
	jmp	short @@13
@@12:	call	SaveOvrCode
	call	OvrCodeReloc
	call	SaveOvrRelocs
	call	FormOvrSeg
@@13:	call	SaveCode
	call	ResolveConst
	call	SqueezeConst
	call	ConstRelocs
	pop	bx
	Invoke	ReleaseMem
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@10
	call	FormExe
	cmp	MaxOverlaySize,0
	je	@@14
	xor	ax,ax
	xor	dx,dx
	xor	cx,cx
	mov	bx,FileHandle
	Invoke	SeekHandle
	sub	OverlaySize.W0,8
	sbb	OverlaySize.W2,0
	lea	ax,OverlayHeader
	mov	dx,ds
	mov	cx,8
	mov	bx,FileHandle
	Invoke	WriteHandle
	Invoke	CloseFile
@@14:	Invoke	DiscardUnits
	test	CompilerFlags.B1,cfExtDebugger
	jz	@@15
	mov	ax,ExeFileSize.W0
	mov	dx,ExeFileSize.W2
	xor	cx,cx
	mov	bx,ExeHandle
	Invoke	SeekHandle
	Invoke	MarkMem
	push	bx
	call	DebugInfo
	pop	bx
	Invoke	ReleaseMem
@@15:	xor	bx,bx
	xchg	bx,ExeHandle
	Invoke	CloseHandle
	test	CompilerFlags.B1,cfLinkMap
	jz	@@16
	Invoke	MarkMem
	push	bx
	call	LinkMap
	pop	bx
	Invoke	ReleaseMem
@@16:	ret
LinkProgram	endp

ResolveUnits	proc	near
	mov	ax,FirstUnit
@@1:	mov	es,ax
	mov	bx,es:uhUnits
	jmp	short @@5
@@2:	push	ds
	mov	ax,FirstUnit
@@3:	mov	ds,ax
	mov	si,ds:uhName
	add	si,seName
	lea	di,[bx].ulName
	mov	cl,[si]
	mov	ch,0
	inc	cx
	repe	cmpsb
	je	@@4
	mov	ax,ds:uhNext
	or	ax,ax
	jnz	@@3
	pop	ds
	mov	ax,136
	Chain	CompileError
@@4:	pop	ds
	mov	es:[bx].ulSegment,ax
	mov	bx,di
@@5:	cmp	bx,es:uhSources
	jne	@@2
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@1
	ret
ResolveUnits	endp

ReadUnits	proc	near
	mov	ax,FirstUnit
@@1:	mov	es,ax
	xor	di,di
	Invoke	ReadUnit
	mov	es:uhTpuName,0
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@1
	ret
ReadUnits	endp

InitSmartLinker	proc	near
	mov	ax,FirstUnit
@@1:	mov	es,ax
	xor	ax,ax
	mov	es:uhRefCount,ax
	mov	es:uhCodeRelocs,ax
	mov	es:uhConstRelocs,ax
	mov	di,es:uhProcMap
	mov	dx,es:uhCodeMap
	jmp	short @@3
@@2:	stosw
	add	di,size TProcMap-2
@@3:	cmp	di,dx
	jne	@@2
	dec	ax
	mov	di,es:uhCodeMap
	mov	dx,es:uhEndMaps
	jmp	short @@5
@@4:	stosw
	add	di,size TSegMap-2
@@5:	cmp	di,dx
	jne	@@4
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@1
	mov	es,Dictionary.segm
	mov	di,es:uhProcMap
	mov	di,es:[di].pmCodeMap
	add	di,es:uhCodeMap
	inc	es:[di].smAddr
	inc	es:uhRefCount
	ret
InitSmartLinker	endp

SmartLink	proc	near
	mov	CurrentUnit,es
@@1:	mov	ax,es:uhCodeFixupSeg
	mov	di,es:uhCodeMap
	mov	dx,es:uhConstMap
	call	ProcessSegment
	add	es:uhCodeRelocs,ax
	mov	ax,es:uhConstFixupSeg
	mov	di,es:uhConstMap
	mov	dx,es:uhDataMap
	call	ProcessSegment
	add	es:uhConstRelocs,ax
	cmp	es:uhRefCount,0
	jne	@@1
	ret
SmartLink	endp

ProcessSegment	proc	near
	mov	CurrentFixup,ax
	xor	ax,ax
	xor	si,si
	jmp	short @@3
@@1:	cmp	es:[di].smAddr,0
	jne	@@2
	inc	es:[di].smAddr
	dec	es:uhRefCount
	push	dx si di es
	call	ProcessMap
	pop	es di si dx
@@2:	add	si,es:[di].smFixupLength
	add	di,size TSegMap
@@3:	cmp	di,dx
	jne	@@1
	ret
ProcessSegment	endp

ProcessMap	proc	near
	mov	dx,es:[di].smFixupLength
	add	dx,si
	jmp	short @@9
@@1:	mov	es,CurrentFixup
	mov	cx,es:[si].fiUnit
	mov	di,es:[si].fiMap
	mov	es,CurrentUnit
	mov	bx,cx
	and	bx,0fffh
	add	bx,es:uhUnits
	mov	es,es:[bx].ulSegment
	test	cx,ffSegm
	jz	@@2
	inc	ax
@@2:	test	cx,ffData
	jz	@@4
	test	cx,ffOffs
	jz	@@8
	test	cx,ffCode
	jnz	@@3
	add	di,es:uhDataMap
	mov	es:[di].smAddr,1
	jmp	short @@8
@@3:	add	di,es:uhConstMap
	jmp	short @@7
@@4:	test	cx,ffCode
	jnz	@@6
	add	di,es:uhProcMap
	test	cx,ffOffs+ffSegm
	jz	@@5
	mov	es:[di].smAddr,1
@@5:	mov	di,es:[di].smFixupLength
@@6:	add	di,es:uhCodeMap
@@7:	cmp	es:[di].smAddr,-1
	jne	@@8
	inc	es:[di].smAddr
	inc	es:uhRefCount
@@8:	add	si,size TSegMap
@@9:	cmp	si,dx
	jne	@@1
	ret
ProcessMap	endp

CountSizes	proc	near
	mov	ax,FirstUnit
@@1:	mov	es,ax
	mov	ax,CurSegment
	mov	es:uhCodeStart,ax
	xor	ax,ax
	mov	di,es:uhCodeMap
	mov	dx,es:uhConstMap
	jmp	short @@4
@@2:	cmp	es:[di].smAddr,-1
	je	@@3
	mov	es:[di].smAddr,ax
	add	ax,es:[di].smLength
@@3:	add	di,size TSegMap
@@4:	cmp	di,dx
	jne	@@2
	mov	bx,es:uhCodeRelocs
	cmp	es:uhOverlayLength,0
	je	@@9
	mov	es:uhOverlayLength,ax
	add	ax,15
	mov	cl,4
	shr	ax,cl
	add	bx,7
	mov	cl,3
	shr	bx,cl
	add	ax,bx
	cmp	ax,MaxOverlaySize
	jbe	@@5
	mov	MaxOverlaySize,ax
@@5:	mov	ax,ovRecSize
	mov	di,es:uhProcMap
	mov	dx,es:uhCodeMap
	jmp	short @@8
@@6:	cmp	es:[di].pmStub,0
	je	@@7
	mov	es:[di].pmStub,ax
	add	ax,5
@@7:	add	di,size TProcMap
@@8:	cmp	di,dx
	jne	@@6
	xor	bx,bx
@@9:	mov	es:uhCodeLength,ax
	add	ax,15
	mov	cl,4
	shr	ax,cl
	add	CurSegment,ax
	add	bx,es:uhConstRelocs
	shl	bx,1
	shl	bx,1
	add	RelocCount,bx
	jc	@@11
	cmp	RelocCount,0fff0h
	ja	@@11
	mov	ax,es:uhNext
	or	ax,ax
	jz	@@10
	jmp	@@1
@@10:	mov	ax,CurSegment
	mov	cl,4
	rol	ax,cl
	mov	dx,ax
	and	al,0f0h
	and	dx,0fh