	model large tdinfo_text,pascal
	include	compiler.inc

PasStr	macro	Name,String
	local	N,C
	N = 0
	irpc	C,<String>
	N = N + 1
	endm
	.data
Name	db	N,'&String&'
	.code	TDInfo_Text
	endm

PS	macro	String
	local	N
	PasStr	N,<String>
	lea	bx,N
	endm

	extrn	FileCreate:far
	extrn	FileClose:far
	extrn	FileWrite:far
	extrn	GetFlatMem:far
	extrn	FlatMemAvail:far
	extrn	Error:far

	.data

Power10	dw	10000,1000,100,10,1
Hex	db	'0123456789ABCDEF'

	.data?

Buffer		dd	?
TextBuffer	dd	?
TextBufferLimit	dw	?
PublicCount	dw	?
Collect		db	?

	.code	tdinfo_text

	public	LinkMap
LinkMap	proc	far
	Entry	far
	test	CompilerFlags.B1,cfLinkMap
	jnz	@@1
	jmp	@@7
@@1:	mov	al,CompilerFlags.B1
	and	al,cfLinkMap
	cmp	al,cfPublicsMap
	jb	@@3
	mov	PublicCount,0
	mov	Collect,0
	call	ProcessPublics
	mov	cx,PublicCount
	mov	ax,8
	cwd
	mul	cx
	or	dx,dx
	jz	@@2
	mov	ax,1
	jmp	Error
@@2:	call	GetFlatMem
	mov	Buffer.Offs,8
	mov	Buffer.Segm,bx
	mov	Collect,1
	call	ProcessPublics
	call	SortPublics
@@3:	mov	ax,feMap+feForceExt+(fdOutputDir+fdNoEditor)*256
	call	FileCreate
	call	FlatMemAvail
	or	dx,dx
	jz	@@4
	mov	ax,0fff0h
@@4:	mov	TextBufferLimit,ax
	call	GetFlatMem
	mov	TextBuffer.Offs,0
	mov	TextBuffer.Segm,bx
	sub	TextBufferLimit,8
	call	WriteSegments
	mov	al,CompilerFlags.B1
	and	al,cfLinkMap
	cmp	al,cfPublicsMap
	jb	@@6
	call	WritePublics
	mov	al,CompilerFlags.B1
	and	al,cfLinkMap
	cmp	al,cfDetailedMap
	jb	@@5
	call	WriteLines
@@5:	call	WriteEntryPoint
@@6:	call	WriteLn
	call	Flush
	call	FileClose
@@7:	Exit
LinkMap	endp

ProcessSymbol	proc	near
	cmp	al,t_Var
	jne	@@6
	mov	dx,es
@@1:	mov	ah,es:[di].vsFlags
	mov	al,ah
	and	al,vfType+vfAddress+vfField
	cmp	al,vfConst
	ja	@@5
	test	ah,vfAlias
	jz	@@2
	mov	bp,es:[di].vsLink.Segm
	mov	di,es:[di].vsLink.Offs
	mov	es,es:[bp]
	jmp	@@1
@@2:	cmp	al,vfConst
	je	@@3
	mov	bp,es:uhDataMap
	jmp	short @@4
@@3:	mov	bp,es:uhConstMap
@@4:	add	bp,es:[di].vsMap
	mov	ax,es:[bp].smAddr
	cmp	ax,-1
	je	@@5
	add	ax,es:[di].vsOffset
	mov	es,dx
	mov	dx,DataStart
	jmp	short @@7
@@5:	mov	es,dx
	jmp	short @@8
@@6:	mov	al,es:[di].psFlags
	test	al,pfInline
	jnz	@@8
	mov	bp,es:uhProcMap
	add	bp,es:[di].psProcMap
	mov	di,es:uhCodeMap
	add	di,es:[bp].pmCodeMap
	mov	ax,es:[di].smAddr
	cmp	ax,-1
	je	@@8
	add	ax,es:[bp].pmEntryPoint
	mov	dx,es:uhCodeStart
@@7:	mov	di,Buffer.Offs
	mov	bp,es
	mov	es,Buffer.Segm
	stosw
	mov	ax,dx
	stosw
	mov	ax,si
	stosw
	mov	ax,bp
	stosw
	mov	Buffer.Offs,di
	mov	es,bp
@@8:	ret
ProcessSymbol	endp

ProcessMain	proc	near
	mov	bx,es:uhProcMap
	mov	di,es:[bx].pmCodeMap
	cmp	di,-1
	jne	@@1
	ret
@@1:	mov	ax,es:[bx].pmEntryPoint
	mov	bx,es:uhCodeMap
	add	ax,es:[bx+di].smAddr
	mov	dx,es:uhCodeStart
	mov	di,Buffer.Offs
	mov	bp,es
	mov	es,Buffer.Segm
	stosw
	mov	ax,dx
	stosw
	lea	ax,@At
	stosw
	mov	ax,ds
	stosw
	mov	Buffer.Offs,di
	mov	es,bp
	ret
ProcessMain	endp

ProcessPublics	proc	near
	push	bp
	mov	bx,FirstUnit
@@1:	mov	es,bx
	inc	PublicCount
	cmp	Collect,0
	je	@@2
	call	ProcessMain
@@2:	mov	bx,es:uhInterface
	mov	cx,es:[bx]
	shr	cx,1
	inc	cx
@@3:	inc	bx
	inc	bx
	mov	si,es:[bx]
	or	si,si
	jz	@@6
@@4:	mov	al,es:[si].seType
	cmp	al,t_Var
	jb	@@5
	cmp	al,t_Proc
	ja	@@5
	inc	PublicCount
	cmp	Collect,0
	je	@@5
	add	si,seName
	mov	dl,es:[si]
	xor	dh,dh
	mov	di,si
	add	di,dx
	inc	di
	call	ProcessSymbol
	sub	si,seName
@@5:	mov	si,es:[si].sePrev
	or	si,si
	jnz	@@4
@@6:	loop	@@3
	mov	bx,es:uhNext
	or	bx,bx
	jnz	@@1
	pop	bp
	ret
ProcessPublics	endp

SortPublics	proc	near
	push	ds
	lds	di,Buffer
	mov	si,8
	cmp	si,di
	je	@@1
	sub	di,8
	call	Sort
@@1:	pop	ds
	ret
SortPublics	endp

Sort	proc	near
	push	bp
	mov	bp,sp
	push	si di
	xor	dx,dx
	mov	bx,di
	add	bx,si
	adc	dx,0
	shr	dx,1
	rcr	bx,1
	and	bx,0fff8h
	mov	ax,[bx]
	mov	dx,[bx+2]
@@1:	cmp	[si+2],dx
	ja	@@3
	jb	@@2
	cmp	[si],ax
	jae	@@3
@@2:	add	si,8
	jmp	@@1
@@3:	cmp	[di+2],dx
	jb	@@5
	ja	@@4
	cmp	[di],ax
	jbe	@@5
@@4:	sub	di,8
	jmp	@@3
@@5:	cmp	si,di
	ja	@@7
	mov	cx,4
@@6:	mov	bx,[si]
	xchg	bx,[di]
	mov	[si],bx
	add	si,2
	add	di,2
	loop	@@6
	sub	di,16
	cmp	si,di
	jbe	@@1
@@7:	cmp	[bp-2],di
	jae	@@8
	xchg	si,[bp-2]
	call	Sort
	mov	si,[bp-2]
@@8:	cmp	[bp-4],si
	jbe	@@9
	mov	di,[bp-4]
	call	Sort
@@9:	mov	sp,bp
	pop	bp
	ret
Sort	endp

WriteSegments	proc	near
	call	WriteLn
	push	ds
	pop	es
	PS	< Start  Stop   Length Name               Class>
	call	WriteString
	call	WriteLn
	call	WriteLn
	mov	ax,FirstUnit
@@1:	mov	es,ax
	mov	di,es:uhCodeStart
	mov	cx,es:uhCodeLength
	mov	bx,es:uhName
	add	bx,seName
	PasStr	CodeText,<CODE>
	lea	dx,CodeText
	push	es
	call	WriteSegment
	pop	es
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@1
	push	ds
	pop	es
	mov	di,DataStart
	mov	cx,DataSize
	PS	<DATA>
	mov	dx,bx
	call	WriteSegment
	mov	di,StackStart
	mov	cx,StackSize
	PS	<STACK>
	mov	dx,bx
	call	WriteSegment
	mov	ax,StackSize
	add	ax,15
	mov	cl,4
	shr	ax,cl
	add	ax,StackStart
	mov	di,ax
	xor	cx,cx
	PS	<HEAP>
	mov	dx,bx
	call	WriteSegment
	ret
WriteSegments	endp

WriteSegment	proc	near
	mov	al,' '
	call	WriteChar
	mov	ax,di
	call	WriteHexNumber
	push	es bx ds
	pop	es
	PS	<0H >
	call	WriteString
	xor	bx,bx
	jcxz	@@1
	mov	bx,cx
	dec	bx
@@1:	mov	ax,bx
	shr	ax,1
	shr	ax,1
	shr	ax,1
	shr	ax,1
	add	ax,di
	call	WriteHexNumber
	mov	ax,bx
	call	WriteHexDigit
	PS	<H 0>
	call	WriteString
	mov	ax,cx
	call	WriteHexNumber
	PS	<H >
	call	WriteString
	pop	bx es
	mov	cl,es:[bx]
	xor	ch,ch
	call	WriteString
	mov	al,' '
	call	WriteChar
	sub	cx,18
	jnc	@@3
	neg	cx
@@2:	mov	al,' '
	call	WriteChar
	loop	@@2
@@3:	push	ds
	pop	es
	mov	bx,dx
	call	WriteString
	call	WriteLn
	ret
WriteSegment	endp

WritePublics	proc	near
	call	WriteLn
	push	ds
	pop	es
	PS	<  Address         Publics by Value>
	call	WriteString
	call	WriteLn
	mov	es,Buffer.Segm
	mov	si,8
@@1:	call	WriteLn
	mov	al,' '
	call	WriteChar
	seges	lodsw
	mov	dx,ax
	seges	lodsw
	call	WriteHexNumber
	mov	al,':'
	call	WriteChar
	mov	ax,dx
	call	WriteHexNumber
	mov	cx,7
@@2:	mov	al,' '
	call	WriteChar
	loop	@@2
	seges	lodsw
	mov	bx,ax
	seges	lodsw
	push	es
	mov	es,ax
	call	WriteString
	pop	es
	cmp	si,Buffer.Offs
	jb	@@1
	ret
WritePublics	endp

WriteLines	proc	near
	mov	ax,FirstUnit
@@1:	mov	es,ax
	mov	cx,-1
	mov	dx,es:uhTrace
	mov	di,es:uhCodeMap
	jmp	short @@7
@@2:	mov	si,es:[di].smTrace
	cmp	si,-1
	je	@@6
	add	si,dx
	mov	bx,es:[di].smAddr
	cmp	bx,-1
	je	@@6
	mov	ax,es:[si].trSource
	cmp	ax,cx
	je	@@3
	mov	cx,ax
	call	WriteLineHeader
@@3:	push	cx
	push	dx
	mov	cx,es:[si].trLineCount
	jcxz	@@5
	add	bx,es:[si].trDataBytes
	mov	dx,es:[si].trLineNumber
	add	si,size TTraceTable
@@4:	call	WriteLineNumber
	loop	@@4
@@5:	pop	dx cx
@@6:	add	di,size TSegMap
@@7:	cmp	di,es:uhConstMap
	jne	@@2
	mov	ax,es:uhNext
	or	ax,ax
	jnz	@@1
	ret
WriteLines	endp

WriteLineHeader	proc	near
	call	WriteLn
	call	WriteLn
	push	bx cx es ds
	pop	es
	PS	<Line numbers for >
	call	WriteString
	pop	es
	mov	bx,es:uhName
	add	bx,seName
	call	WriteString
	mov	al,'('
	call	WriteChar
	pop	bx
	push	bx
	add	bx,es:uhSources
	add	bx,size TSourceList-1
	call	WriteString
	push	es ds
	pop	es
	PS	<) segment >
	call	WriteString
	pop	es
	mov	bx,es:uhName
	add	bx,seName
	call	WriteString
	call	WriteLn
	pop	cx bx
	xor	bp,bp
	ret
WriteLineHeader	endp

WriteLineNumber	proc	near
	mov	al,es:[si]
	inc	si
	or	al,al
	js	@@1
	or	al,al
	jz	@@4
	cbw
	jmp	short @@2
@@1:	and	al,7fh
	mov	ah,al
	mov	al,es:[si]
	inc	si
@@2:	push	ax
	or	bp,bp
	jnz	@@3
	call	WriteLn
@@3:	mov	ax,dx
	push	dx
	mov	dx,6
	call	WriteDecNumber
	pop	dx
	mov	al,' '
	call	WriteChar
	mov	ax,es:uhCodeStart
	call	WriteHexNumber
	mov	al,':'
	call	WriteChar
	mov	ax,bx
	call	WriteHexNumber
	inc	bp
	and	bp,3
	pop	ax
	add	bx,ax
@@4:	inc	dx
	ret
WriteLineNumber	endp

WriteEntryPoint	proc	near
	call	WriteLn
	call	WriteLn
	push	ds
	pop	es
	PS	<Program entry point at 0000:>
	call	WriteString
	mov	es,FirstUnit
	mov	di,es:uhProcMap
	mov	si,es:uhCodeMap
	add	si,es:[di].pmCodeMap
	mov	ax,es:[si].smAddr
	add	ax,es:[di].pmEntryPoint
	call	WriteHexNumber
	ret
WriteEntryPoint	endp

WriteString	proc	near
	push	bx cx
	mov	cl,es:[bx]
	or	cl,cl
	jmp	short @@2
@@1:	inc	bx
	mov	al,es:[bx]
	call	WriteChar
	dec	cl
@@2:	jnz	@@1
	pop	cx bx
	ret
WriteString	endp

WriteHexNumber	proc	near
	push	es di bx cx dx
	lea	bx,Hex
	mov	cx,404h
	mov	dx,ax
	les	di,TextBuffer
@@1:	rol	dx,cl
	mov	al,dl
	and	al,0fh
	xlat
	stosb
	dec	ch
	jnz	@@1
	mov	TextBuffer.Offs,di
	pop	dx cx bx di es
	ret
WriteHexNumber	endp

WriteDecNumber	proc	near
	push	bx cx dx si
	mov	bx,ax
	mov	cx,5
	lea	si,Power10
@@1:	cmp	bx,[si]
	jae	@@2
	add	si,2
	loop	@@1
@@2:	sub	dx,cx
	jbe	@@4
	xchg	cx,dx
@@3:	mov	al,' '
	call	WriteChar
	loop	@@3
	xchg	cx,dx
@@4:	mov	al,'0'-1
@@5:	inc	al
	sub	bx,[si]
	jnc	@@5
	add	bx,[si]
	add	si,2
	call	WriteChar
	loop	@@4
	pop	si dx cx bx
	ret
WriteDecNumber	endp

WriteHexDigit	proc	near
	push	bx
	lea	bx,Hex
	and	al,0fh
	xlat
	pop	bx
	jmp	short WriteChar
WriteHexDigit	endp

WriteLn	proc	near
	mov	al,0dh
	call	WriteChar
	mov	al,0ah
WriteChar	label	near
	push	es di
	les	di,TextBuffer
	stosb
	mov	TextBuffer.Offs,di
	cmp	di,TextBufferLimit
	pop	di es
	jae	Flush
	ret
WriteLn	endp

Flush	proc	near
	push	ax bx cx dx
	mov	cx,TextBuffer.Offs
	jcxz	@@1
	mov	TextBuffer.Offs,0
	mov	dx,TextBuffer.Segm
	xor	ax,ax
	mov	bx,FileHandle
	call	FileWrite
@@1:	pop	dx cx bx ax
	ret
Flush	endp

	PasStr	@At,<@>

	end
