object.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	.data

EmulNames	db	'FIDRQQ'
		dw	5c32h
		db	'FIARQQ'
		dw	0fe32h
		db	'FICRQQ'
		dw	0e32h
		db	'FIERQQ'
		dw	1632h
		db	'FISRQQ'
		dw	632h
		db	'FIWRQQ'
		dw	0a23dh
		db	'FJARQQ'
		dw	4000h
		db	'FJCRQQ'
		dw	0c000h
		db	'FJSRQQ'
		dw	8000h

KnownSegments	db	4,'CODE',0
		db	4,'CSEG',0
		db	5,'_TEXT',0
		db	5,'CONST',1
		db	5,'_DATA',1
		db	4,'DATA',2
		db	4,'DSEG',2
		db	4,'_BSS',2

	.data?

BufPtr		dw	?
CurSegIndex	db	?
CodeSegIndex	db	?
ConstSegIndex	db	?
DataSegIndex	db	?
DataUnit	dw	?
DataOffset	dw	?
DataSource	dw	?
DataTarget	dw	?
LastData	dw	?
RecEnd		dw	?
Name0		dw	?
Name1		dw	?
Name2		dw	?

	.code	compiler_text

	public	LinkObjects

LinkObjects	proc	near
	mov	es,SourceList.Segm
	xor	di,di
@@1:	cmp	di,SourceList.Offs
	je	@@3
	cmp	es:[di].slFileType,fdObjectDir
	jne	@@2
	push	di
	Invoke	ReadObjectFile
	call	ProcessObjFile
	Invoke	CloseObjectFile
	Invoke	FlushCodeMap
	Invoke	FlushConstMap
	Invoke	FlushDataMap
	pop	di
	mov	es,SourceList.Segm
@@2:	mov	bl,es:[di].slName.B0
	mov	bh,0
	lea	di,[di+size TSourceList+bx]
	jmp	@@1
@@3:	ret
LinkObjects	endp

ObjectError	proc	near
	lea	dx,FileNameBuf
	Chain	ParamError2
ObjectError	endp

ProcessObjFile	proc	near
	xor	ax,ax
	mov	CurSegIndex,al
	mov	CodeSegIndex,al
	mov	ConstSegIndex,al
	mov	DataSegIndex,al
	mov	LastData,ax
	mov	BufPtr,offset SourceBuffer
	mov	ax,Dictionary.Segm
	Invoke	PutUseUnit
	mov	DataUnit,ax
	xor	si,si
	mov	es,ObjectFileSeg
@@1:	cmp	si,ObjectFileSize
	jae	@@2
	seges	lodsb
	test	al,1
	jnz	@@2
	sub	al,80h
	jc	@@2
	cmp	al,22h
	ja	@@2
	mov	bl,al
	xor	bh,bh
	seges	lodsw
	add	ax,si
	dec	ax
	mov	RecEnd,ax
	call	word ptr cs:@@3[bx]
	mov	si,RecEnd
	inc	si
	jmp	@@1
@@2:	mov	ax,47
	jmp	ObjectError
@@3	dw	SkipRecord	; THEADR
	dw	SkipRecord	; LHEADR
	dw	SkipRecord
	dw	SkipRecord
	dw	SkipRecord	; COMENT
	dw	ModEnd		; MODEND
	dw	ExtDef		; EXTDEF
	dw	SkipRecord	; TYPDEF
	dw	PubDef		; PUBDEF
	dw	SkipRecord	; LOCSYM
	dw	SkipRecord	; LINNUM
	dw	SkipRecord	; LNAMES
	dw	SegDef		; SEGDEF
	dw	SkipRecord	; GRPDEF
	dw	FixUpp		; FIXUPP
	dw	SkipRecord
	dw	LeData		; LEDATA
	dw	LiData		; LIDATA
ProcessObjFile	endp

ModEnd	proc	near
	pop	ax
SkipRecord	label	near
	ret
ModEnd	endp

SegDef	proc	near
@@1:	inc	CurSegIndex
	inc	si
	seges	lodsw
	push	ax
	seges	lodsb
	inc	si
	inc	si
	call	WhichSegment
	pop	dx
	jnz	@@5
	cmp	al,1
	mov	al,CurSegIndex
	jb	@@3
	je	@@2
	cmp	DataSegIndex,0
	jne	@@5
	mov	DataSegIndex,al
	add	VarsSize,dx
	jnc	@@5
	mov	ax,49
	jmp	ObjectError
@@2:	cmp	ConstSegIndex,0
	jne	@@5
	mov	ConstSegIndex,al
	lea	bx,CompiledConst
	jmp	short @@4
@@3:	cmp	CodeSegIndex,0
	jne	@@5
	mov	CodeSegIndex,al
	lea	bx,CompiledCode
@@4:	xchg	ax,dx
	mov	cx,ax
	Invoke	GetMemory
	xor	ax,ax
	rep	stosb
	mov	es,ObjectFileSeg
@@5:	cmp	si,RecEnd
	jb	@@1
	ret
SegDef	endp

WhichSegment	proc	near
	push	si
	xor	ah,ah
	mov	cx,ax
	xor	si,si
@@1:	seges	lodsb
	xchg	ax,dx
	seges	lodsw
	xchg	ax,dx
	add	dx,si
	cmp	al,96h	; LNAMES
	jne	@@3
	dec	dx
@@2:	seges	lodsb
	dec	cx
	jz	@@4
	add	si,ax
	cmp	si,dx
	jne	@@2
	inc	dx
@@3:	mov	si,dx
	jmp	@@1
@@4:	mov	bx,si
	mov	dx,ax
	lea	si,KnownSegments
@@5:	lodsb
	cmp	al,1
	jb	@@9
	mov	cx,ax
	mov	di,bx
	cmp	cx,dx
	je	@@6
	ja	@@7
	cmp	byte ptr [si],'_'
	jne	@@7
	add	di,dx
	sub	di,cx
@@6:	repe	cmpsb
	je	@@8
@@7:	add	si,cx
	inc	si
	jmp	@@5
@@8:	lodsb
@@9:	pop	si
	ret
WhichSegment	endp

PubDef	proc	near
	seges	lodsb
	or	al,al
	jnz	@@4
	seges	lodsb
	cmp	al,CodeSegIndex
	jne	@@4
@@1:	call	GetName
	seges	lodsw
	push	es si ax
	call	ConvertName
	jz	@@2
	Invoke	LocalSearch
	jnz	@@5
	cmp	al,t_Type
	jne	@@5
	mov	si,es:[di].tsType.Offs
	mov	di,es:[di].tsType.Segm
	mov	es,es:[di]
	cmp	es:[si].tdType,ttObject
	jne	@@5
	call	ConvertName
	Invoke	SearchField
	jnz	@@5
	jmp	short @@3
@@2:	Invoke	LocalSearch
	jz	@@3
	call	AddPublic
@@3:	cmp	al,t_Proc
	jne	@@5
	test	es:[di].psFlags,pfExternal
	jz	@@5
	mov	di,es:[di].psProcMap
	mov	es,ProcMap.Segm
	mov	ax,CodeMap.Offs
	xchg	ax,es:[di].pmCodeMap
	inc	ax
	jnz	@@5
	pop	ax
	mov	es:[di].pmEntryPoint,ax
	pop	si es
	inc	si
	cmp	si,RecEnd
	jb	@@1
	ret
@@4:	mov	ax,51
	jmp	ObjectError
@@5:	mov	ax,51
	mov	di,Name0
	mov	es,ObjectFileSeg
	Chain	ParamError
PubDef	endp

AddPublic	proc	near
	mov	ax,size TProcStub+size TProcType
	Invoke	LocalAddIdent
	Invoke	FlushProcMap
	mov	al,t_Proc
	mov	es:[bx].seType,al
	mov	es:[di].psFlags,pfExternal
	mov	es:[di].psType.tdType,ttProc
	mov	es:[di].psType.tdModifier,emLongint
	mov	es:[di].psType.tdSizeOf,4
	ret
AddPublic	endp

ExtDef	proc	near
@@1:	call	GetName
	push	es si
	call	ConvertName
	jz	@@3
	Invoke	SearchSymbol
	jnz	@@2
	cmp	al,t_Type
	jne	@@2
	mov	si,es:[di].tsType.Offs
	mov	di,es:[di].tsType.Segm
	mov	es,es:[di]
	cmp	es:[si].tdType,ttObject
	jne	@@2
	call	ConvertName
	Invoke	SearchField
	jnz	@@2
	cmp	al,t_Proc
	je	@@8
@@2:	mov	ax,52
	mov	di,Name0
	mov	es,ObjectFileSeg
	Chain	ParamError
@@3:	call	EmulFixup
	jnc	@@9
	Invoke	SearchSymbol
	jz	@@4
	call	AddPublic
@@4:	cmp	al,t_Proc
	je	@@8
	cmp	al,t_Var
	jne	@@2
@@5:	test	es:[di].vsFlags,vfAlias
	jz	@@6
	mov	bx,es:[di].vsLink.Segm
	mov	di,es:[di].vsLink.Offs
	mov	es,es:[bx]
	jmp	@@5
@@6:	mov	al,es:[di].vsFlags
	and	al,vfType
	mov	cx,ffData
	cmp	al,vfVar
	je	@@7
	mov	cx,ffConst
	cmp	al,vfConst
	jne	@@2
@@7:	push	es di
	mov	ax,es
	Invoke	PutUseUnit
	pop	di es
	or	ax,cx
	mov	bx,es:[di].vsMap
	mov	dx,es:[di].vsOffset
	jmp	short @@9
@@8:	test	es:[di].psFlags,pfInline
	jnz	@@2
	push	es di
	mov	ax,es
	Invoke	PutUseUnit
	pop	di es
	mov	bx,es:[di].psProcMap
	xor	dx,dx
@@9:	mov	di,BufPtr
	cmp	di,offset SourceBuffer+256*6
	je	@@11
	mov	[di],ax
	mov	[di+2],bx
	mov	[di+4],dx
	add	BufPtr,6
	pop	si es
	inc	si
	cmp	si,RecEnd
	jae	@@10
	jmp	@@1
@@10:	ret
@@11:	mov	ax,53
	jmp	ObjectError
ExtDef	endp

EmulFixup	proc	near
	cmp	IdentBuf[0],6
	jne	@@2
	lea	si,EmulNames
	push	ds
	pop	es
@@1:	lea	di,IdentBuf[1]
	mov	bx,si
	mov	cx,6
	repe	cmpsb
	je	@@3
	lea	si,[bx+8]
	cmp	si,offset KnownSegments
	jne	@@1
@@2:	stc
	ret
@@3:	lodsw
	mov	dx,ax
	mov	ax,-1
	mov	bx,ax
	ret
EmulFixup	endp

LeData	proc	near
	call	DataHeader
	jnz	@@1
	mov	LastData,bx
	mov	cx,RecEnd
	sub	cx,si
	push	ds es
	mov	es,DataTarget
	pop	ds
	rep	movsb
	push	ds
	pop	es ds
@@1:	ret
LeData	endp

DataHeader	proc	near
	xor	ax,ax
	mov	LastData,ax
	seges	lodsb
	mov	di,CodeSectStart
	mov	dx,CompiledCode.Segm
	lea	bx,CodeFixups
	cmp	al,CodeSegIndex
	je	@@1
	mov	di,ConstSectStart
	mov	dx,CompiledConst.Segm
	lea	bx,ConstFixups
	cmp	al,ConstSegIndex
	jne	@@2
@@1:	seges	lodsw
	mov	DataOffset,ax
	mov	DataSource,di
	mov	DataTarget,dx
	add	di,ax
	xor	ax,ax
@@2:	ret
DataHeader	endp

LiData	proc	near
	call	DataHeader
	jnz	@@2
@@1:	call	ProcessLiData
	cmp	si,RecEnd
	jb	@@1
@@2:	ret
LiData	endp

ProcessLiData	proc	near
	seges	lodsw
@@1:	push	ax si
	seges	lodsw
	or	ax,ax
	jz	@@3
@@2:	push	ax
	call	ProcessLiData
	pop	ax
	dec	ax
	jnz	@@2
	jmp	short @@4
@@3:	seges	lodsb
	mov	cl,al
	xor	ch,ch
	push	ds es
	mov	es,DataTarget
	pop	ds
	rep	movsb
	push	ds
	pop	es ds
@@4:	mov	dx,si
	pop	si ax
	dec	ax
	jnz	@@1
	mov	si,dx
	ret
ProcessLiData	endp

FixUpp	proc	near
	cmp	LastData,0
	je	@@6
@@1:	seges	lodsb
	mov	ah,al
	and	al,0fch
	xor	dx,dx
	cmp	al,84h
	je	@@2
	mov	dx,ffOffs
	cmp	al,0c4h
	je	@@2
	mov	dx,ffSegm
	cmp	al,0c8h
	je	@@2
	mov	dx,ffPtr
	cmp	al,0cch
	jne	@@6
@@2:	seges	lodsb
	and	ax,3ffh
	add	ax,DataOffset
	mov	di,ax
	seges	lodsb
	mov	cl,al
	test	cl,88h
	jnz	@@6
	test	cl,40h
	jnz	@@3
	seges	lodsb
	or	al,al
	jns	@@3
	inc	si
@@3:	seges	lodsb
	xor	ah,ah
	or	al,al
	jns	@@4
	and	al,7fh
	mov	ah,al
	seges	lodsb
@@4:	mov	bx,ax
	xor	ax,ax
	test	cl,4
	jnz	@@5
	seges	lodsw
@@5:	push	di ds
	add	di,DataSource
	mov	ds,DataTarget
	add	ax,[di]
	pop	ds di
	xchg	ax,dx
	call	ProcessFixup
	cmp	si,RecEnd
	jb	@@1
	ret
@@6:	mov	ax,56
	jmp	ObjectError
FixUpp	endp

ProcessFixup	proc	near
	test	cl,2
	jnz	@@4
	test	cl,1
	jnz	@@3
	cmp	bl,CodeSegIndex
	jne	@@1
	or	ax,ffCode
	mov	bx,CodeMap.Offs
	jmp	short @@5
@@1:	cmp	bl,ConstSegIndex
	jne	@@2
	or	ax,ffConst
	mov	bx,ConstMap.Offs
	jmp	short @@5
@@2:	cmp	bl,DataSegIndex
	jne	@@7
@@3:	or	ax,ffData
	mov	bx,DataMap.Offs
	jmp	short @@5
@@4:	shl	bx,1
	mov	cx,bx
	shl	bx,1
	add	bx,cx
	or	ax,SourceBuffer[bx-6]
	add	dx,SourceBuffer[bx-2]
	mov	bx,SourceBuffer[bx-4]
	cmp	ax,-1
	jne	@@6
	push	ds
	add	di,DataSource
	mov	ds,DataTarget
	mov	[di],dx
	pop	ds
	ret
@@5:	or	ax,DataUnit
@@6:	push	di bx ax
	mov	ax,size TSegMap
	mov	bx,LastData
	Invoke	GetMemory
	pop	ax
	stosw
	pop	ax
	stosw
	mov	ax,dx
	stosw
	pop	ax
	stosw
	mov	es,ObjectFileSeg
	ret
@@7:	mov	ax,56
	jmp	ObjectError
ProcessFixup	endp

GetName	proc	near
	mov	Name0,si
	seges	lodsb
	mov	Name1,si
	xor	ah,ah
	add	si,ax
	mov	Name2,si
	ret
GetName	endp

ConvertName	proc	near
	push	di es
	xor	bx,bx
	xor	cx,cx
	mov	dx,Name2
	mov	di,Name1
	mov	es,ObjectFileSeg
@@1:	cmp	di,dx
	je	@@3
	mov	al,es:[di]
	inc	di
	cmp	al,'@'
	je	@@3
	cmp	al,'a'
	jb	@@2
	cmp	al,'z'
	ja	@@2
	sub	al,'a'-'A'
@@2:	inc	bx
	mov	IdentBuf[bx],al
	dec	al
	add	cl,al
	jmp	@@1
@@3:	add	cl,cl
	mov	IdentBuf[0],bl
	mov	SymbolHash,cl
	mov	Name1,di
	cmp	di,dx
	pop	es di
	ret
ConvertName	endp

	end