debugger.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	extrn	OvrDebugHook:far
	extrn	LoadProgram:far
	extrn	EmulateLoad:far
	extrn	InitProgram:far
	extrn	ExitProgram:far
	extrn	FExpand:far

TCallStack	struc
	csTrace		dd	?
	csSegment	dw	?
	csFrame		dw	?
	ends

fsChar		equ	1
fsDecimal	equ	2
fsMemory	equ	4
fsPointer	equ	8
fsRecord	equ	10h
fsString	equ	20h
fsHex		equ	40h

	.data

Formats	db	'C',fsChar
	db	'D',fsDecimal
	db	'H',fsHex
	db	'M',fsMemory
	db	'P',fsPointer
	db	'R',fsRecord
	db	'S',fsString
	db	'X',fsHex
	db	'$',fsHex
FormatCount	equ	($-Formats)/2

Power10	dd	1000000000
	dd	100000000
	dd	10000000
	dd	1000000
	dd	100000
	dd	10000
	dd	1000
	dd	100
	dd	10
	dd	1

EmptyString	db	0

sClosed	db	6,'CLOSED'
sInput	db	5,'INPUT'
sOutput	db	6,'OUTPUT'
sOpen	db	4,'OPEN'
sNil	db	3,'NIL'
sPtr	db	4,'PTR('
sCSeg	db	4,'CSEG'
sDSeg	db	4,'DSEG'
sSSeg	db	4,'SSEG'
sFalse	db	5,'FALSE'
sTrue	db	4,'TRUE'
sAndSoOn	db	5,'(...)'

	extrn	ProgramStatus:word
	extrn	ProgErrorCode:word
	extrn	ProgErrorAddr:dword
	extrn	CurRegs:dword
	extrn	PrefixSeg:word

	.data?

DummyStack	label	byte
FormatBuf	dw	?
StackFrame	dd	?
CallStackSize	dw	?
ResultString	dd	?
ResultFree	dw	?
ErrorReturn	dw	?
SaveSP		dw	?
SaveBP		dw	?
Format		db	?
		db	?
RepeatCount	dw	?
FloatPrecision	dw	?
TempExpr	TExpr	<>

TempTextBuf	equ	(byte ptr CompMemPtr-256)
CallStack	equ	(word ptr TempTextBuf-128*size TCallStack)
SourceIndex	equ	(word ptr CallStack-512)

	.code	compiler_text

	public	StartProgram
	public	StopProgram
	public	FindError
	public	GetSourceCount
	public	GetSourceName
	public	ChangeSourceName
	public	FindSourceName
	public	FindCode
	public	FindSrcLine
	public	FindUnit
	public	FindStubSeg
	public	InitDebugger
	public	GetStackFrame
	public	Evaluate
	public	Modify
	public	CheckCondition
	public	FindProc
	public	GetCallStackSize
	public	GetCallStackEntry
	public	GetCallStackPos

StartProgram	proc	far
	Entry	far
	cld
	cmp	ProgramStatus,psNoProgram
	jne	@@1
	mov	ax,-1
	mov	dx,-7
	jmp	@@10
@@1:	call	EnumSources
	cmp	ProgramLocation,plMemory
	je	@@3
	mov	bx,CompMemPtr
	call	ShrinkMemory
	lea	ax,ExeName
	push	ds ax
	call	LoadProgram
	or	ax,ax
	jnz	@@2
	jmp	@@9
@@2:	push	ax
	call	ExpandMemory
	pop	dx
	mov	ax,-1
	jmp	@@10
@@3:	test	GlobalOptions,co8087
	jz	@@4
	mov	Use8087,1
@@4:	mov	bx,StackSize
	add	bx,15
	mov	cl,4
	shr	bx,cl
	add	bx,StackStart
	add	bx,DebuggerPSP
	add	bx,10h
	mov	ax,CompMemTop
	sub	ax,bx
	jc	@@5
	cmp	ax,MinHeapSize
	jae	@@6
@@5:	mov	ax,-1
	mov	dx,-4
	jmp	@@10
@@6:	cmp	ax,MaxHeapSize
	jbe	@@7
	mov	ax,MaxHeapSize
@@7:	add	bx,ax
	push	bx
	call	ShrinkMemory
	push	ds
	mov	ax,DataStart
	add	ax,DebuggerPSP
	add	ax,10h
	mov	es,ax
	xor	di,di
	xor	ax,ax
	stosw
	mov	ax,FirstUnit
@@8:	mov	ds,ax
	mov	ax,ds:uhNext
	xor	si,si
	mov	cx,ds:uhConstSize
	mov	ds,ds:uhConstSeg
	rep	movsb
	or	ax,ax
	jnz	@@8
	pop	ds bx
	push	DebuggerPSP bx
	mov	es,FirstUnit
	mov	ax,es:uhCodeStart
	add	ax,DebuggerPSP
	add	ax,10h
	push	ax
	mov	di,es:uhProcMap
	mov	ax,es:[di].pmEntryPoint
	mov	di,es:[di].pmCodeMap
	add	di,es:uhCodeMap
	add	ax,es:[di].smAddr
	push	ax
	mov	ax,StackStart
	add	ax,DebuggerPSP
	add	ax,10h
	push	ax StackSize
	call	EmulateLoad
@@9:	mov	ProgramStatus,psRunning
	call	InitProgram
	mov	ProgramSegment,ax
	add	ax,DataStart
	mov	DataSegment.segm,ax
	les	bx,DataSegment
	mov	es:[bx]._OvrDebugPtr.Offs,offset OvrDebugHook
	mov	es:[bx]._OvrDebugPtr.Segm,seg OvrDebugHook
	mov	es,FirstUnit
	xor	di,di
	call	GetEntryPoint
@@10:	Exit
StartProgram	endp

StopProgram	proc	far
	cmp	ProgramStatus,psRunning
	jne	@@2
	call	ExitProgram
	les	bx,DataSegment
	mov	ax,es:[bx]._ExitCode
	mov	ProgErrorCode,ax
	mov	ax,es:[bx]._ErrorAddr.Offs
	mov	ProgErrorAddr.Offs,ax
	mov	ax,es:[bx]._ErrorAddr.Segm
	mov	ProgErrorAddr.Segm,ax
	mov	dx,es:[bx]._OvrEmsHandle
	or	dx,dx
	jz	@@1
	mov	ah,45h
	int	67h
@@1:	call	ExpandMemory
	mov	ProgramStatus,psTerminated
@@2:	ret
StopProgram	endp

ExpandMemory	proc	near
	mov	bx,CompMemTop
ShrinkMemory	label	near
	mov	ax,PrefixSeg
	sub	bx,ax
	mov	es,ax
	mov	ah,4ah
	int	21h
	cld
	ret
ExpandMemory	endp

FindError	proc	far
	Argm	Address,dword,1
	Entry	far
	cld
	call	EnumSources
	mov	ax,Address.Offs
	mov	dx,Address.Segm
	or	ax,ax
	jz	@@1
	dec	ax
@@1:	call	FindLine
	Exit
FindError	endp

GetSourceCount	proc	far
	mov	ax,SourceCount
	ret
GetSourceCount	endp

GetSourceName	proc	far
	mov	bx,sp
	mov	bx,ss:[bx+4]
	shl	bx,1
	mov	ax,SourceIndex[bx-2]
	or	ax,ax
	jnz	@@1
	lea	ax,EmptyString
@@1:	mov	dx,ds
	ret	2
GetSourceName	endp

ChangeSourceName	proc	far
	Argm	N,word,1
	Argm	_Name,dword,1
	Entry	far
	push	si di
	cld
	mov	bx,N
	call	DeleteName
	les	di,_Name
	cmp	byte ptr es:[di],0
	je	@@1
	mov	bx,N
	call	InsertName
@@1:	pop	di si
	Exit
ChangeSourceName	endp

FindSourceName	proc	far
	Argm	_Name,dword,1
	Entry	far
	push	si di
	cld
	mov	bx,1
@@1:	cmp	bx,SourceCount
	ja	@@3
	shl	bx,1
	mov	si,SourceIndex[bx-2]
	shr	bx,1
	les	di,_Name
	lodsb
	scasb
	jne	@@2
	mov	cl,al
	xor	ch,ch
	repe	cmpsb
	je	@@4
@@2:	inc	bx
	jmp	@@1
@@3:	xor	bx,bx
@@4:	mov	ax,bx
	pop	di si
	Exit
FindSourceName	endp

EnumSources	proc	near
	cmp	SourceCount,0
	jne	@@7
	mov	ax,FirstUnit
	jmp	short @@6
@@1:	mov	es,ax
	mov	di,es:uhSources
	xor	ax,ax
	xor	bx,bx
@@2:	mov	es:[di].slNumber,ax
	mov	bl,es:[di].slName.B0
	lea	di,[di+size TSourceList+bx]
	cmp	di,es:uhTrace
	jne	@@2
	mov	di,es:uhCodeMap
	jmp	short @@5
@@3:	cmp	es:[di].smAddr,-1
	je	@@4
	mov	si,es:[di].smTrace
	add	si,es:uhTrace
	jc	@@4
	mov	bx,es:[si].trSource
	add	bx,es:uhSources
	cmp	es:[bx].slNumber,0
	jne	@@4
	push	si di es
	call	AddName
	pop	es di si
@@4:	add	di,size TSegMap
@@5:	cmp	di,es:uhConstMap
	jne	@@3
	mov	ax,es:uhNext
@@6:	or	ax,ax
	jnz	@@1
@@7:	ret
EnumSources	endp

AddName	proc	near
	Loc	N,byte,80
	Entry
	inc	SourceCount
	mov	ax,SourceCount
	mov	es:[bx].slNumber,ax
	mov	ah,es:[bx].slFileType
	mov	al,0
	push	ax
	lea	di,[bx].slName
	lea	si,N
	Invoke	Pas2C
	pop	ax
	lea	dx,N
	Invoke	ConvertName
	lea	si,N
	mov	di,si
	Invoke	C2Pas
	lea	si,N
	push	ds si ds si
	call	FExpand
	cld
	mov	bx,SourceCount
	lea	di,N
	push	ds
	pop	es
	call	InsertName
	Exit
AddName	endp

InsertName	proc	near
	xor	ax,ax
	mov	si,TpuListPtr
	mov	cl,es:[di]
	xor	ch,ch
	inc	cx
	add	cx,si
	cmp	cx,offset SourceIndex
	ja	@@1
	mov	TpuListPtr,cx
	push	si
	Invoke	CopyPasStr
	pop	ax
@@1:	shl	bx,1
	mov	SourceIndex[bx-2],ax
	ret
InsertName	endp

DeleteName	proc	near
	shl	bx,1
	xor	si,si
	xchg	si,SourceIndex[bx-2]
	or	si,si
	jz	@@3
	mov	di,si
	lodsb
	xor	ah,ah
	add	si,ax
	inc	ax
	mov	dx,di
	mov	cx,TpuListPtr
	sub	cx,si
	push	ds
	pop	es
	rep	movsb
	mov	TpuListPtr,di
	lea	bx,SourceIndex
	mov	cx,SourceCount
@@1:	cmp	dx,[bx]
	ja	@@2
	sub	[bx],ax
@@2:	inc	bx
	inc	bx
	loop	@@1
@@3:	ret
DeleteName	endp

FindCode	proc	far
	Argm	Line,dword,1
	Argm	Address,dword,1
	Argm	Len,dword,1
	Entry	far
	push	si di
	cld
	mov	ax,Line.Offs
	mov	dx,Line.Segm
	call	_FindCode
	jc	@@2
	add	dx,ProgramSegment
	les	di,Address
	mov	es:[di].Offs,ax
	mov	es:[di].Segm,dx
	les	di,Len
	mov	es:[di],cx
	mov	ax,1
@@1:	pop	di si
	Exit
@@2:	xor	ax,ax
	jmp	@@1
FindCode	endp

FindSrcLine	proc	far
	Argm	Address,dword,1
	Argm	Copy,dword,1
	Entry	far
	push	si di
	cld
	mov	ax,Address.Offs
	mov	dx,Address.segm
	les	di,Copy
	mov	es:[di].Offs,ax
	mov	es:[di].Segm,dx
	sub	dx,ProgramSegment
	call	FindLine
	jc	@@1
	mov	bx,ax
	shl	bx,1
	cmp	SourceIndex[bx-2],0
	jne	@@1
	xor	ax,ax
	mov	dx,ax
@@1:	pop	di si
	Exit
FindSrcLine	endp

FindUnit	proc	far
	mov	bx,sp
	mov	bx,ss:[bx+4]
	sub	bx,ProgramSegment
	mov	ax,FirstUnit
@@1:	or	ax,ax
	jz	@@3
	mov	es,ax
	cmp	bx,es:uhCodeStart
	je	@@2
	mov	ax,es:uhNext
	jmp	@@1
@@2:	mov	ax,1
@@3:	ret	2
FindUnit	endp

FindStubSeg	proc	far
	mov	bx,sp
	mov	es,ss:[bx+4]
	xor	ax,ax
	cmp	es:ovSignature,3fcdh
	je	@@3
	mov	ax,es
	les	bx,DataSegment
	mov	cx,es:[bx]._OvrLoadList
@@1:	jcxz	@@3
	mov	es,cx
	cmp	ax,es:ovSegment
	je	@@2
	mov	cx,es:ovNext
	jmp	@@1
@@2:	mov	ax,es
@@3:	ret	2
FindStubSeg	endp

_FindCode	proc	near
	mov	bx,FirstUnit
	jmp	short @@3
@@1:	mov	es,bx
	xor	bx,bx
	mov	di,es:uhSources
	mov	cx,es:uhTrace
@@2:	cmp	ax,es:[di].slNumber
	je	@@4
	mov	bl,es:[di].slName.B0
	lea	di,[di+size TSourceList+bx]
	cmp	di,cx
	jne	@@2
	mov	bx,es:uhNext
@@3:	or	bx,bx
	jnz	@@1
	stc
	ret
@@4:	mov	ax,di
	sub	ax,es:uhSources
	mov	di,es:uhCodeMap
	mov	bx,es:uhConstMap
@@5:	cmp	es:[di].smAddr,-1
	je	@@6
	mov	si,es:[di].smTrace
	add	si,es:uhTrace
	jc	@@6
	cmp	ax,es:[si].trSource
	jne	@@6
	mov	cx,dx
	sub	cx,es:[si].trLineNumber
	jc	@@6
	cmp	cx,es:[si].trLineCount
	jb	@@7
@@6:	add	di,size TSegMap
	cmp	di,bx
	jne	@@5
	stc
	ret
@@7:	mov	bx,es:[di].smAddr
	add	bx,es:[si].trDataBytes
	add	si,size TTraceTable
	jcxz	@@9
@@8:	call	GetByteCount
	add	bx,ax
	loop	@@8
@@9:	call	GetByteCount
	mov	cx,ax
	jcxz	@@9
	mov	ax,bx
	mov	dx,es:uhCodeStart
	clc
	ret
_FindCode	endp

FindLine	proc	near
	mov	bx,FirstUnit
	jmp	short @@3
@@1:	mov	es,bx
	cmp	dx,es:uhCodeStart
	jne	@@2
	cmp	ax,es:uhOverlayLength
	jb	@@5
	cmp	ax,es:uhCodeLength
	jb	@@5
@@2:	mov	bx,es:uhNext
@@3:	or	bx,bx
	jnz	@@1
@@4:	xor	ax,ax
	mov	dx,ax
	stc
	ret
@@5:	mov	di,es:uhCodeMap
@@6:	cmp	es:[di].smAddr,-1
	je	@@7
	sub	ax,es:[di].smLength
	jc	@@8
@@7:	add	di,size TSegMap
	jmp	@@6
@@8:	add	ax,es:[di].smLength
	mov	si,es:[di].smTrace
	add	si,es:uhTrace
	jc	@@4
	sub	ax,es:[si].trDataBytes
	jc	@@4
	push	si
	mov	dx,es:[si].trLineNumber
	add	si,size TTraceTable
	mov	cx,ax
@@9:	call	GetByteCount
	inc	dx
	sub	cx,ax
	jnc	@@9
	dec	dx
	pop	si
	mov	bx,es:[si].trSource
	add	bx,es:uhSources
	mov	ax,es:[bx].slNumber
	ret
FindLine	endp

GetEntryPoint	proc	near
	add	di,es:uhProcMap
	mov	bx,es:[di].pmCodeMap
	add	bx,es:uhCodeMap
	jc	@@1
	cmp	es:[bx].smAddr,-1
	je	@@1
	mov	bx,es:[bx].smTrace
	add	bx,es:uhTrace
	jc	@@1
	mov	si,es:[bx].trSource
	add	si,es:uhSources
	mov	ax,es:[si].slNumber
	mov	dx,es:[bx].trLineNumber
	ret
@@1:	xor	ax,ax
	mov	dx,ax
	ret
GetEntryPoint	endp

GetByteCount	proc	near
	seges	lodsb
	or	al,al
	js	@@1
	cbw
	ret
@@1:	and	al,7fh
	mov	ah,al
	seges	lodsb
	ret
GetByteCount	endp

InitDebugger	proc	far
	Entry	far
	push	si di
	cld
	mov	CompilerFlags.B0,cfDebugging
	mov	CompilerOptions,co8087
	mov	SlashToken,tSlash
	mov	EqualToken,tEqual
	mov	TempBufPtr,offset TempBuffer
	mov	FileStackPtr,offset DummyStack
	xor	ax,ax
	mov	IndexModifier,al
	mov	CallStackSize,ax
	mov	WithChain,ax
	cmp	ProgramStatus,psRunning
	jne	@@1
	call	GetCurStackFrame
	jc	@@1
	mov	di,es:[si].trSymbol
	push	es di
	call	TrackCallStack
	pop	di es
	jmp	short @@2
@@1:	mov	es,FirstUnit
	xor	di,di
@@2:	mov	Dictionary.Segm,es
	mov	CurScope,di
	pop	di si
	Exit
InitDebugger	endp

GetCurStackFrame	proc	near
	les	di,CurRegs
	mov	ax,es:[di].rIP
	mov	dx,es:[di].rCS
	call	GetOvrAddr
	sub	dx,ProgramSegment
	call	FindLine
	jc	@@2
	push	ax es
	mov	ax,es:[di].smAddr
	add	ax,es:[si].trDataBytes
	les	di,CurRegs
	cmp	ax,es:[di].rIP
	mov	ax,es:[di].rBP
	mov	bx,es:[di].rSP
	mov	es,es:[di].rSS
	jne	@@1
	dec	bx
	dec	bx
	mov	es:[bx],ax
	mov	ax,bx
@@1:	mov	StackFrame.Offs,ax
	mov	StackFrame.Segm,es
	pop	es ax
	clc
@@2:	ret
GetCurStackFrame	endp

GetOvrAddr	proc	near
	les	bx,DataSegment
	mov	cx,es:[bx]._OvrCodeList
@@1:	jcxz	@@4
	add	cx,ProgramSegment
	mov	es,cx
	cmp	dx,cx
	je	@@2
	cmp	dx,es:ovSegment
	je	@@3
	mov	cx,es:ovLink
	jmp	@@1
@@2:	or	ax,ax
	jnz	@@4
	mov	ax,es:ovSaveReturn
	jmp	short @@4
@@3:	mov	dx,es
@@4:	ret
GetOvrAddr	endp

TrackCallStack	proc	near
	Loc	CurSeg,word,1
	Loc	CurFrame,word,1
	Entry	near
	mov	ax,es:uhCodeStart
	add	ax,ProgramSegment
	mov	CurSeg,ax
	mov	ax,StackFrame.Offs
	mov	CurFrame,ax
@@1:	mov	ax,CurFrame
	mov	di,CallStackSize
	mov	cl,3
	shl	di,cl
	mov	CallStack[di].csTrace.Offs,si
	mov	CallStack[di].csTrace.Segm,es
	mov	CallStack[di].csSegment,dx
	mov	CallStack[di].csFrame,ax
	inc	CallStackSize
	cmp	CallStackSize,128
	je	@@3
	mov	di,es:[si].trSymbol
	or	di,di
	jz	@@3
	mov	bl,es:[di].seName.B0
	mov	bh,0
	mov	cl,es:[di+size TSymbol+bx].psFlags
	mov	bx,CurFrame
	mov	es,StackFrame.Segm
	mov	ax,es:[bx]
	mov	CurFrame,ax
	mov	ax,es:[bx+2]
	mov	dx,CurSeg
	test	cl,pfFar
	jz	@@2
	mov	dx,es:[bx+4]
	call	GetOvrAddr
	mov	CurSeg,dx
@@2:	dec	ax
	sub	dx,ProgramSegment
	call	FindLine
	jnc	@@1
@@3:	Exit
TrackCallStack	endp

GetStackFrame	proc	near
	mov	bx,es:[si].psProcMap
	add	bx,es:uhProcMap
	mov	bx,es:[bx].pmCodeMap
	add	bx,es:uhCodeMap
	mov	ax,es:[bx].smTrace
	add	ax,es:uhTrace
	mov	dx,es
	lea	si,CallStack
	mov	cx,CallStackSize
	jcxz	@@3
@@1:	cmp	ax,[si].csTrace.Offs
	jne	@@2
	cmp	dx,[si].csTrace.Segm
	jne	@@2
	mov	bx,[si].csFrame
	mov	es,StackFrame.Segm
	ret
@@2:	add	si,size TCallStack
	loop	@@1
@@3:	mov	ax,139
	Chain	CompileError
GetStackFrame	endp

Fool	proc	far
	ret
Fool	endp

Evaluate	proc	far
	Argm	Expr,dword,1
	Argm	Result,dword,1
	Argm	CanModify,dword,1
	Entry	far
	push	si di
	cld
	lea	ax,@@2
	Invoke	SetErrHandler
	les	di,Expr
	call	InitEvaluator
	lea	di,TempExpr
	Invoke	GetExpr
	call	GetModifier
	call	CheckEnd
	les	bx,Result
	call	FormatValue
	xor	ax,ax
	cmp	ProgramStatus,psRunning
	jne	@@1
	cmp	[di].exLocation,elMemory
	jne	@@1
	test	[di].exMisc,efReadOnly
	jnz	@@1
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttSet
	jb	@@1
	test	Format,fsMemory
	jnz	@@1
	cmp	RepeatCount,0
	jne	@@1
	inc	ax
@@1:	les	bx,CanModify
	mov	es:[bx],al
	xor	ax,ax
	mov	dx,ax
	jmp	short @@3
@@2:	mov	ax,ErrorNum
	mov	dx,TextPos
	sub	dx,offset TempTextBuf-1
@@3:	pop	di si
	Exit
Evaluate	endp

Modify	proc	far
	Argm	Expr,dword,1
	Argm	NewValue,dword,1
	Loc	Temp,byte,<size TExpr>
	Entry	far
	push	si di
	cld
	lea	ax,@@1
	Invoke	SetErrHandler
	les	di,Expr
	call	InitEvaluator
	lea	di,Temp
	Invoke	GetExpr
	call	CheckEnd
	les	bx,NewValue
	call	FormatValue
	Invoke	GetVarValue
	lea	si,TempExpr
	Invoke	AssignmentCast
	Invoke	TypeCompat
	Invoke	CastOrdinal
	xchg	si,di
	call	CopyValue
	xor	ax,ax
	mov	dx,ax
	jmp	short @@2
@@1:	mov	ax,ErrorNum
	mov	dx,TextPos
	sub	dx,offset TempTextBuf-1
@@2:	pop	di si
	Exit
Modify	endp

CheckCondition	proc	far
	Argm	Expr,dword,1
	Entry	far
	push	si di
	cld
	lea	ax,@@1
	Invoke	SetErrHandler
	les	di,Expr
	call	InitEvaluator
	lea	di,TempExpr
	Invoke	GetBooleanExpr
	call	CheckEnd
	mov	ax,[di].exValue.W0
	neg	ax
	sbb	ax,ax
	sbb	dx,dx
	jmp	short @@2
@@1:	mov	ax,ErrorNum
	mov	dx,TextPos
	sub	dx,offset TempTextBuf-1
@@2:	pop	di si
	Exit
CheckCondition	endp

FindProc	proc	far
	Argm	Expr,dword,1
	Loc	Temp,byte,<size TExpr>
	Entry	far
	push	si di
	cld
	lea	ax,@@1
	Invoke	SetErrHandler
	les	di,Expr
	call	InitEvaluator
	lea	di,Temp
	Invoke	GetExpr
	call	CheckEnd
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttPointer
	jne	@@1
	Invoke	GetVarValue