compile.asm

Turbo Pascal 6.0编译器源码

	add	di,seName
@@3:	mov	es,UsedUnit
	mov	ax,FirstUnit
	xchg	ax,es:uhNext
	mov	UsedUnit,ax
	mov	FirstUnit,es
	dec	CurDepth
	mov	ax,SavedDepth2
	cmp	ax,CurDepth
	jne	@@4
	push	di
	Invoke	RestoreState
	pop	di
@@4:	mov	es,FirstUnit
	or	di,di
	ret
UseUnit	endp

LoadUnit	proc	near
	Loc	SourceTime,dword,1
	Loc	UnitTime,dword,1
	Loc	NameLen,word,1
	Loc	UName,byte,64
	Loc	SourceName,byte,80
	Loc	TpuName,byte,80
	Entry
	lea	si,UName
	Invoke	CopyPasStr
	mov	ax,FirstUnit
	mov	bx,uhNext
	lea	si,UName
	call	SearchUnitName
	jz	@@1
	mov	ax,UsedUnit
	mov	bx,uhNext
	lea	si,UName
	call	SearchUnitName
	jnz	@@2
	mov	di,es:uhName
	mov	bl,es:[di].seName.B0
	mov	bh,0
	cmp	es:[di+size TSymbol+bx].usChecksum,0
	je	@@3
@@1:	jmp	@@15
@@2:	mov	ax,LibraryUnits
	mov	bx,uhLink
	lea	si,UName
	call	SearchUnitName
	jnz	@@6
	mov	ax,FirstUnit
	mov	es:uhNext,ax
	mov	FirstUnit,es
	call	UseUnit
	jnz	@@4
	jmp	@@14
@@3:	mov	ax,68
	jmp	short @@5
@@4:	mov	ax,70
@@5:	lea	di,UName
	push	ds
	pop	es
	Chain	ParamError
@@6:	mov	ax,SavedDepth
	cmp	ax,CurDepth
	je	@@7
	Invoke	SaveState
	or	CompilerFlags.B0,cfUseUnits+cfDisk+cfForceUnit
	mov	ax,CurDepth
	xchg	ax,SavedDepth
	mov	SavedDepth2,ax
@@7:	call	PutHeader
	lea	si,UName
	lea	di,SourceName
	Invoke	DSPas2C
	xor	ax,ax
	mov	dx,ax
	test	CompilerFlags.B0,cfBuild
	jz	@@8
	mov	ax,fePas+fdUnitDir*256
	lea	dx,SourceName
	call	ConvertName
	mov	NameLen,ax
	lea	dx,SourceName
	Invoke	FileTime
	add	ax,1
	adc	dx,0
@@8:	mov	SourceTime.W0,ax
	mov	SourceTime.W2,dx
	or	ax,dx
	jnz	@@10
	lea	si,SourceName
	lea	di,TpuName
	Invoke	CopyDSCStr
	mov	ax,feTpu+feForceExt+(fdOutputDir+fdNoEditor)*256
	lea	dx,TpuName
	call	ConvertName
	lea	dx,TpuName
	Invoke	FileTime
	and	ax,dx
	inc	ax
	jnz	@@9
	lea	si,SourceName
	lea	di,TpuName
	Invoke	CopyDSCStr
	mov	ax,feTpu+feForceExt+fdUnitDir*256
	lea	dx,TpuName
	call	ConvertName
@@9:	lea	dx,TpuName
	call	ReadUnit
	lea	si,UName
	call	MatchName
	call	UseUnit
	mov	al,0
	jz	@@13
	jmp	@@4
@@10:	lea	si,SourceName
	lea	di,TpuName
	Invoke	CopyDSCStr
	mov	ax,feTpu+feForceExt+(fdOutputDir+fdNoEditor)*256
	lea	dx,TpuName
	call	ConvertName
	test	CompilerFlags.B0,cfMake
	jz	@@12
	lea	dx,TpuName
	Invoke	FileTime
	add	ax,1
	adc	dx,0
	mov	UnitTime.W0,ax
	mov	UnitTime.W2,dx
	sub	ax,SourceTime.W0
	sbb	dx,SourceTime.W2
	jc	@@12
	lea	dx,TpuName
	call	ReadUnit
	lea	si,UName
	call	MatchName
	mov	ax,UnitTime.W0
	mov	dx,UnitTime.W2
	call	CheckSources
	jc	@@11
	call	UseUnit
	mov	al,0
	jz	@@13
@@11:	call	ZeroHeader
@@12:	lea	ax,SourceName
	mov	UnitName,ax
	mov	ax,NameLen
	mov	UnitNameLen,ax
	call	CompileFile
	lea	si,UName
	call	MatchName
	mov	al,-1
@@13:	lea	si,TpuName
	Invoke	Add2TpuList
@@14:	mov	es,FirstUnit
	xor	ax,ax
	mov	es:uhOverlayLength,ax
@@15:	Invoke	UpdateCompInfo
	Exit
LoadUnit	endp

ReadUnit	proc	near
	push	dx
	Invoke	OpenHandle
	mov	bx,ax
	mov	es,Dictionary.Segm
	xor	ax,ax
	mov	dx,es
	mov	cx,size TUnitHeader
	push	bx
	push	es:uhNext
	Invoke	ReadHandle
	pop	es:uhNext
	pop	bx dx
	cmp	ax,size TUnitHeader
	jne	@@1
	cmp	es:uhSignature.W0,'PT'
	jne	@@1
	cmp	es:uhSignature.W2,'9U'
	jne	@@1
	mov	ax,es:uhEndTrace
	sub	ax,size TUnitHeader
	mov	cx,ax
	push	bx
	inc	ExactAlloc
	Invoke	GetDictMem
	dec	ExactAlloc
	pop	bx
	mov	ax,di
	mov	dx,es
	push	bx
	Invoke	ReadHandle
	pop	bx
	Chain	CloseHandle
@@1:	mov	ax,72
	Chain	ParamError2
ReadUnit	endp

SearchUnitName	proc	near
@@1:	or	ax,ax
	jz	@@2
	mov	es,ax
	mov	di,es:uhName
	add	di,seName
	mov	cl,[si]
	xor	ch,ch
	inc	cx
	mov	dx,si
	repe	cmpsb
	mov	si,dx
	je	@@3
	mov	ax,es:[bx]
	jmp	@@1
@@2:	dec	ax
@@3:	ret
SearchUnitName	endp

MatchName	proc	near
	mov	es,FirstUnit
	mov	di,es:uhName
	add	di,seName
	mov	cl,[si]
	xor	ch,ch
	inc	cx
	push	si
	repe	cmpsb
	pop	si
	jne	@@1
	ret
@@1:	mov	ax,69
	mov	di,si
	push	ds
	pop	es
	Chain	ParamError
MatchName	endp

CheckSources	proc	near
	Loc	Time,dword,1
	Loc	UName,byte,80
	Entry
	mov	Time.W0,ax
	mov	Time.W2,dx
	mov	es,FirstUnit
	mov	di,es:uhSources
@@1:	mov	bl,es:[di].slName.B0
	mov	bh,0
	lea	di,[di+size TSourceList+bx]
	cmp	di,es:uhTrace
	je	@@3
	push	es di
	add	di,slName
	lea	si,UName
	Invoke	Pas2C
	pop	di es
	mov	ah,es:[di]
	mov	al,0
	lea	dx,UName
	call	ConvertName
	lea	dx,UName
	Invoke	FileTime
	add	ax,1
	adc	dx,0
	cmp	dx,Time.W2
	jb	@@1
	ja	@@2
	cmp	ax,Time.W0
	jbe	@@1
@@2:	stc
@@3:	Exit
CheckSources	endp

CreateFile	proc	near
	mov	si,UnitName
	lea	di,FileNameBuf
	push	ax
	Invoke	CopyDSCStr
	pop	ax
	lea	dx,FileNameBuf
	call	ConvertName
	lea	dx,FileNameBuf
	Invoke	CreateHandle
	mov	FileHandle,ax
	ret
CreateFile	endp

CloseFile	proc	near
	xor	bx,bx
	xchg	bx,FileHandle
	Chain	CloseHandle
CloseFile	endp

ReadObjectFile	proc	near
	mov	al,0
	mov	ah,es:[di]
	push	ax
	add	di,7
	lea	si,FileNameBuf
	Invoke	Pas2C
	pop	ax
	lea	dx,FileNameBuf
	call	ConvertName
	lea	dx,FileNameBuf
	Invoke	OpenHandle
	mov	bx,ax
	push	bx
	call	GetFileSize
	or	dx,dx
	jnz	@@1
	cmp	ax,0fff0h
	ja	@@1
	mov	ObjectFileSize,ax
	Invoke	GetMemOnTop
	mov	ObjectFileSeg,bx
	xor	ax,ax
	mov	dx,bx
	mov	cx,ObjectFileSize
	pop	bx
	push	bx
	Invoke	ReadHandle
	pop	bx
	Chain	CloseHandle
@@1:	mov	ax,45
	lea	dx,FileNameBuf
	Chain	ParamError2
ReadObjectFile	endp

CloseObjectFile	proc	near
	mov	ax,ObjectFileSize
	mov	bx,ObjectFileSeg
	Chain	FreeMemOnTop
CloseObjectFile	endp

BigWrite	proc	near
	push	cx di es
	mov	es,dx
	mov	di,cx
	neg	cx
	and	cx,0fh
	xor	ax,ax
	rep	stosb
	pop	es di cx
	add	cx,0fh
	and	cx,0fff0h
	Chain	WriteHandle
BigWrite	endp

GetFileSize	proc	near
	xor	ax,ax
	xor	dx,dx
	mov	cx,2
	push	bx
	Invoke	SeekHandle
	pop	bx
	push	dx ax
	xor	ax,ax
	xor	dx,dx
	xor	cx,cx
	Invoke	SeekHandle
	pop	ax dx
	ret
GetFileSize	endp

ConvertName	proc	near
	Loc	UName,word,1
	Loc	Temp,byte,224
	Entry
	push	si di es
	mov	UName,dx
	mov	dx,ax
	push	ds
	pop	es
	or	dl,dl
	jz	@@8
	mov	si,UName
@@1:	xor	bx,bx
@@2:	lodsb
	or	al,al
	jz	@@3
	cmp	al,'\'
	je	@@1
	cmp	al,'.'
	jne	@@2
	mov	bx,si
	jmp	@@2
@@3:	or	bx,bx
	jz	@@4
	test	dl,feForceExt
	jz	@@8
	mov	si,bx
@@4:	mov	di,si
	dec	di
	mov	al,'.'
	stosb
	lea	si,Extensions
	and	dl,0fh
@@5:	dec	dl
	jz	@@7
@@6:	lodsb
	or	al,al
	jnz	@@6
	jmp	@@5
@@7:	lodsb
	stosb
	or	al,al
	jnz	@@7
@@8:	mov	bl,dh
	and	bl,0fh
	jnz	@@10
@@9:	xor	dx,dx
	jmp	@@26
@@10:	mov	bh,0
	shl	bx,1
	mov	si,Directories[bx-2]
	cmp	byte ptr [si],0
	je	@@9
	test	dh,fdNoEditor
	jnz	@@17
	mov	dx,UName
	Invoke	FileTime
	and	ax,dx
	inc	ax
	jnz	@@9
@@11:	cmp	byte ptr [si],0
	je	@@9
	lea	di,Temp
	xor	dx,dx
	xor	ah,ah
@@12:	mov	ah,al
	lodsb
	or	al,al
	jz	@@13
	cmp	al,';'
	je	@@14
	stosb
	inc	dx
	jmp	@@12
@@13:	dec	si
@@14:	cmp	ah,':'
	je	@@15
	cmp	ah,'\'
	je	@@15
	mov	al,'\'
	stosb
	inc	dx
@@15:	push	si
	mov	si,UName
@@16:	lodsb
	stosb
	or	al,al
	jnz	@@16
	pop	si
	push	dx
	lea	dx,Temp
	Invoke	FileTime
	and	ax,dx
	inc	ax
	pop	dx
	jz	@@11
	jmp	short @@23
@@17:	lea	di,Temp
	xor	dx,dx
	xor	ah,ah
@@18:	mov	ah,al
	lodsb
	or	al,al
	jz	@@19
	stosb
	inc	dx
	jmp	@@18
@@19:	cmp	ah,':'
	je	@@20
	cmp	ah,'\'
	je	@@20
	mov	al,'\'
	stosb
	inc	dx
@@20:	mov	bx,di
	mov	si,UName
@@21:	lodsb
	stosb
	or	al,al
	jz	@@23
	cmp	al,':'
	je	@@22
	cmp	al,'\'
	jne	@@21
@@22:	mov	di,bx
	jmp	@@21
@@23:	lea	si,Temp
	mov	di,UName
	mov	cx,79
@@24:	lodsb
	or	al,al
	jz	@@25
	stosb
	loop	@@24
@@25:	xor	al,al
	stosb
@@26:	mov	ax,dx
	pop	es di si
	Exit
ConvertName	endp

FileCreate	proc	far
	Entry	far
	call	CreateFile
	Exit
FileCreate	endp

FileClose	proc	far
	Entry	far
	call	CloseFile
	Exit
FileClose	endp

FileWrite	proc	far
	Entry	far
	Invoke	WriteHandle
	Exit
FileWrite	endp

WriteBig	proc	far
	Entry	far
	call	BigWrite
	Exit
WriteBig	endp

GetFlatMem	proc	far
	Entry	far
	Invoke	GetMemOnBottom
	Exit
GetFlatMem	endp

GetProcStackSize	proc	far
	Entry	far
	Invoke	StackRequired
	Exit
GetProcStackSize	endp

FlatMemAvail	proc	far
	Entry	far
	Invoke	GetMemAvail
	Exit
FlatMemAvail	endp

	end