www.pudn.com > tp60src.zip > TDINFO.ASM


	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