tdinfo.asm

Turbo Pascal 6.0编译器源码

	model	large tdinfo_text,pascal
	include	compiler.inc

uhNumber	equ	uhReserved+18

	extrn	FileWrite:far
	extrn	GetFlatMem:far
	extrn	GetProcStackSize:far
	extrn	FlatMemAvail:far
	extrn	Error:far

	.data?

Counts	struc
	SymbolCount	dw	?
	SegmentCount	dw	?
	SourceFileCount	dw	?
	LineNumberCount	dw	?
			dw	?
	ScopeCount	dw	?
	XPEHCount	dw	?
	CorrelCount	dw	?
	TypeCount	dw	?
	MemberCount	dw	?
	ClassCount	dw	?
	ParentCount	dw	?
			dw	?
			dw	?
	DataCount	dw	?
	NameCount	dw	?
	ends

Cnt	Counts	<>
NamePoolSize	dd	?
d3caa	dw	?
Phase	dw	?
OverlaysPresent	db	?
	db	?
LastUnit	dw	?
d3cb2	dw	?
HashIterFunc	dw	?
d3cb6	dw	?
d3cb8	dw	?
BufPtr	dd	?
d3cbe	db	?
	db	?
d3cc0	dw	?
AvailMem	dw	?
ProcInfo	dw	?
ProcInfoSize	dw	?
d3cc8	dw	?
d3cca	dw	?
CurName	dd	?
CurSymbol	dd	?
CurType	dd	?
d3cd8	dd	?
d3cdc	dw	?
d3cde	dd	?
d3ce2	dw	?
d3ce4	dw	?
d3ce6	dw	?
d3ce8	dw	?
d3cea	dw	?
d3cec	db	?
d3ced	db	?
d3cee	db	?
d3cef	db	?
d3cf0	dw	?
d3cf2	dw	?
d3cf4	dw	?
d3cf6	dw	?

	.code	tdinfo_text

	public	DebugInfo

OutOfMemory	proc	near
	mov	ax,1
	jmp	Error
OutOfMemory	endp

MemoryAvail	proc	near
	call	FlatMemAvail
	or	dx,dx
	jnz	@@1
	or	ax,ax
	jz	OutOfMemory
	ret
@@1:	mov	ax,0fff0h
	ret
MemoryAvail	endp

GetMem	proc	near
	cmp	ax,AvailMem
	ja	OutOfMemory
	push	ax
	add	ax,BufPtr.Offs
	jc	@@1
	cmp	ax,AvailMem
	jbe	@@2
	cmp	BufPtr.Offs,0
	je	OutOfMemory
@@1:	call	Flush
@@2:	pop	ax
	ret
GetMem	endp

DebugInfo	proc	far
	Entry	far
	call	Init
	call	l01cc
	call	l00a3
	call	MemoryAvail
	mov	AvailMem,ax
	sub	AvailMem,9
	jc	OutOfMemory
	call	GetFlatMem
	mov	BufPtr.Segm,bx
	mov	BufPtr.Offs,0
	call	l187f
	call	Flush
	Exit
DebugInfo	endp

Init	proc	near
	xor	ax,ax
	mov	OverlaysPresent,al
	mov	ProcInfoSize,2
	mov	DebugInfoSize.W0,ax
	mov	DebugInfoSize.W2,ax
	lea	ax,l0751
	mov	HashIterFunc,ax
	call	ClearHeader
	xor	ax,ax
	mov	NamePoolSize.W0,ax
	mov	NamePoolSize.W2,ax
	call	CountUnits
	mov	Cnt.ScopeCount,cx
	inc	Cnt.ScopeCount
	mov	ax,ProcInfoSize
	call	GetFlatMem
	mov	ProcInfo,bx
	ret
Init	endp

l00a3	proc	near
	mov	d3caa,-1
	mov	Phase,0
	mov	ax,Cnt.NameCount
	mov	d3cc0,ax
	mov	si,FirstUnit
@@1:	mov	es,si
	mov	d3cb2,si
	call	ClearCustom
	mov	ax,es
	cmp	ax,LastUnit
	je	@@2
	call	StoreUnit
	mov	ax,Cnt.ScopeCount
	dec	ax
	mov	es:[46h],ax
@@2:	push	Cnt.SymbolCount Cnt.ClassCount
	call	l03a2
	pop	ax
	sub	ax,Cnt.ClassCount
	neg	ax
	mov	es:[48h],ax
	pop	ax
	sub	ax,Cnt.SymbolCount
	neg	ax
	mov	es:[42h],ax
	push	Cnt.SymbolCount Cnt.ClassCount
	call	l03d4
	pop	ax
	sub	ax,Cnt.ClassCount
	neg	ax
	mov	es:[4ch],ax
	pop	ax
	sub	ax,Cnt.SymbolCount
	neg	ax
	mov	es:[4ah],ax
	push	Cnt.ScopeCount
	lea	ax,l051a
	call	TraceIterator
	pop	ax
	sub	ax,Cnt.ScopeCount
	neg	ax
	mov	es:[40h],ax
	mov	ax,Cnt.NameCount
	sub	ax,d3cc0
	mov	es:[44h],ax
	call	StoreUnitName
	push	Cnt.SourceFileCount
	call	l0603
	pop	ax
	sub	ax,Cnt.SourceFileCount
	neg	ax
	mov	es:[3ch],ax
	push	Cnt.CorrelCount
	call	l063e
	pop	ax
	sub	ax,Cnt.CorrelCount
	neg	ax
	mov	es:[3eh],ax
	mov	ax,Cnt.NameCount
	mov	d3cc0,ax
	mov	si,es:uhNext
	or	si,si
	jz	@@3
	jmp	@@1
@@3:	ret
l00a3	endp

Flush	proc	near
	push	es di si bx cx
	mov	cx,BufPtr.Offs
	add	DebugInfoSize.W0,cx
	adc	DebugInfoSize.W2,0
	mov	dx,BufPtr.Segm
	xor	ax,ax
	mov	bx,ExeHandle
	call	FileWrite
	pop	cx bx si di es
	mov	BufPtr.Offs,0
	ret
Flush	endp

CountUnits	proc	near
	xor	cx,cx
	xor	dx,dx
	mov	bx,FirstUnit
@@1:	mov	es,bx
	cmp	es:uhOverlayLength,0
	je	@@2
	mov	OverlaysPresent,1
@@2:	inc	cx
	mov	es:uhNumber,cx
	call	CountProcInfoSize
	mov	bx,es:uhNext
	or	bx,bx
	jnz	@@1
	mov	LastUnit,es
	ret
CountUnits	endp

l01cc	proc	near
	mov	d3cbe,-1
	mov	bx,FirstUnit
@@1:	mov	es,bx
	mov	d3cb2,bx
	call	l05ba
	mov	bx,es:uhNext
	or	bx,bx
	jnz	@@1
	mov	d3cbe,0
	ret
l01cc	endp

ClearHeader	proc	near
	mov	ax,ds
	mov	es,ax
	mov	ax,1
	lea	di,Cnt
	mov	cx,size Cnt shr 1
	cld
	rep	stosw
	mov	Cnt.TypeCount,21h
	ret
ClearHeader	endp

ClearCustom	proc	near
	mov	cx,4eh
	mov	di,3ch
	sub	cx,di
	shr	cx,1
	cld
	xor	ax,ax
	rep	stosw
	ret
ClearCustom	endp

StartBuf	proc	near
	les	di,BufPtr
	cld
	ret
StartBuf	endp

StopBuf	proc	near
	mov	BufPtr.Offs,di
	ret
StopBuf	endp

CountProcInfoSize	proc	near
	push	HashIterFunc
	lea	ax,DoCountProcInfoSize
	mov	HashIterFunc,ax
	mov	bx,es:uhDebugHash
	call	HashIterator
	pop	HashIterFunc
	ret
CountProcInfoSize	endp

ProcessSwitch	dw	ProcessVoid
		dw	ProcessArray
		dw	ProcessRecord
		dw	ProcessObject
		dw	ProcessFile
		dw	ProcessVoid
		dw	ProcessProcType
		dw	ProcessSet
		dw	ProcessPointer
		dw	ProcessString
		dw	ProcessVoid
		dw	ProcessVoid
		dw	ProcessOrdinal
		dw	ProcessOrdinal
		dw	ProcessOrdinal
		dw	ProcessEnum
MarkSwitch	dw	MarkVoid
		dw	MarkArray
		dw	MarkRecord
		dw	MarkObject
		dw	MarkPointer
		dw	MarkVoid
		dw	MarkProc
		dw	MarkPointer
		dw	MarkPointer
		dw	MarkVoid
		dw	MarkVoid
		dw	MarkVoid
		dw	MarkVoid
		dw	MarkVoid
		dw	MarkVoid
		dw	MarkVoid
TypeSwitch	db	4,5
		db	t_Const
		dw	ProcessConst,MarkProc
		db	t_Type
		dw	ProcessType,MarkType
		db	t_Var
		dw	ProcessVar,MarkVar
		db	t_Proc
		dw	ProcessProc,MarkProc
l028c	db	0,0,2,1,0,0,3
l0293	db	4,3
	db	0
	dw	l0b54
	db	2
	dw	l0b59
	db	1
	dw	l0b67
	db	3
	dw	l0b6c
l02a1	db	8,'MEMAVAIL'
l02aa	db	8,'MAXAVAIL'
l02b3	db	23h,0,0,4,0,5,6,0

	include	tdinfo1.inc
	include	tdinfo2.inc
	include	tdinfo3.inc
	include	tdinfo4.inc
	include	tdinfo5.inc
	include	tdinfo6.inc
	include	tdinfo7.inc

	end