debugger.asm

Turbo Pascal 6.0编译器源码

	mov	ax,[di].exValue.Offs
	mov	dx,[di].exValue.Segm
	sub	dx,ProgramSegment
	call	FindLine
	jmp	short @@2
@@1:	xor	ax,ax
	mov	dx,ax
@@2:	pop	di si
	Exit
FindProc	endp

InitEvaluator	proc	near
	lea	si,TempTextBuf
	mov	FormatBuf,si
	mov	TextPos,si
	Invoke	Pas2C
	cmp	FirstUnit,0
	je	@@1
	Chain	GetToken
@@1:	mov	ax,138
	Chain	CompileError
InitEvaluator	endp

GetModifier	proc	near
	mov	Format,0
	mov	RepeatCount,0
	mov	FloatPrecision,11
	cmp	CurrentToken,tComma
	jne	@@1
	call	ProcessModifier
	Invoke	GetToken
@@1:	ret
GetModifier	endp

CheckEnd	proc	near
	cmp	CurrentToken,0
	jne	@@1
	ret
@@1:	mov	ax,134
	Chain	CompileError
CheckEnd	endp

ProcessModifier	proc	near
	mov	si,FormatBuf
	call	GetChar
	mov	al,[si]
	cmp	al,'0'
	jb	@@1
	cmp	al,'9'
	ja	@@1
	Invoke	Str2DecLong
	jc	@@6
	neg	dx
	jc	@@6
	mov	RepeatCount,ax
	call	GetChar
	mov	al,[si]
	or	al,al
	jz	@@5
@@1:	Invoke	UpperCase
	lea	bx,Formats
	mov	cx,FormatCount
@@2:	cmp	al,[bx]
	je	@@3
	inc	bx
	inc	bx
	loop	@@2
	cmp	al,'F'
	jne	@@6
	inc	si
	call	GetChar
	Invoke	Str2DecLong
	jc	@@6
	neg	dx
	jc	@@6
	cmp	ax,2
	jb	@@6
	cmp	ax,18
	ja	@@6
	mov	FloatPrecision,ax
	jmp	short @@4
@@3:	mov	al,[bx+1]
	or	Format,al
	inc	si
@@4:	call	GetChar
	mov	al,[si]
	or	al,al
	jnz	@@1
@@5:	mov	FormatBuf,si
	ret
@@6:	mov	TextPos,si
	mov	ax,135
	Chain	CompileError
ProcessModifier	endp

GetChar	proc	near
@@1:	lodsb
	or	al,al
	jz	@@2
	cmp	al,' '
	jbe	@@1
@@2:	dec	si
	ret
GetChar	endp

CopyValue	proc	near
	les	bx,[di].exType
	mov	al,es:[bx].tdType
	cmp	al,ttInteger
	jae	@@3
	cmp	al,ttPointer
	je	@@3
	cmp	al,ttReal
	je	@@3
	cmp	al,tt8087
	jne	@@1
	mov	al,[di].exModifier
	lea	bx,[si].exValue
	Invoke	Extended2Float
	jmp	short @@3
@@1:	cmp	al,ttString
	jne	@@2
	mov	ax,es:[bx].tdSizeOf
	mov	bx,[si].exOffset
	mov	cl,[bx]
	xor	ch,ch
	inc	cx
	cmp	cx,ax
	jbe	@@4
	mov	cx,ax
	dec	ax
	mov	[bx],al
	jmp	short @@4
@@2:	Invoke	SetBaseAndSize
	mov	bx,[si].exOffset
	mov	cl,al
	xor	ch,ch
	mov	al,ah
	xor	ah,ah
	add	bx,ax
	jmp	short @@4
@@3:	les	bx,[di].exType
	mov	cx,es:[bx].tdSizeOf
	lea	bx,[si].exValue
@@4:	push	si di
	mov	si,bx
	les	di,dword ptr [di].exValue
	rep	movsb
	pop	di si
	ret
CopyValue	endp

GetCallStackSize	proc	far
	mov	ax,CallStackSize
	ret
GetCallStackSize	endp

GetCallStackEntry	proc	far
	Argm	N,word,1
	Argm	S,dword,1
	Entry	far
	push	si di
	cld
	mov	Format,0
	mov	FloatPrecision,11
	mov	di,N
	mov	cl,3
	shl	di,cl
	add	di,offset CallStack-size TCallStack
	les	bx,S
	Invoke	FormatCall
	pop	di si
	Exit
GetCallStackEntry	endp

GetCallStackPos	proc	far
	Argm	N,word,1
	Entry	far
	push	si di
	mov	di,N
	mov	cl,3
	shl	di,cl
	add	di,offset CallStack-size TCallStack
	mov	dx,[di].csSegment
	les	bx,[di].csTrace
	mov	bx,es:[bx].trSource
	add	bx,es:uhSources
	mov	ax,es:[bx].slNumber
	pop	di si
	Exit
GetCallStackPos	endp

FormatCall	proc	near
	Loc	P,word,1
	Loc	Temp,byte,<size TExpr>
	Entry
	lea	ax,@@8
	call	InitFormatter
	mov	ax,[di].csFrame
	mov	P,ax
	les	di,[di].csTrace
	mov	di,es:[di].trSymbol
	or	di,di
	jnz	@@1
	mov	di,es:uhName
	lea	bx,[di+3]
	call	WriteName
	jmp	@@8
@@1:	mov	bl,es:[di].seName.B0
	mov	bh,0
	test	es:[di+size TSymbol+bx].psFlags,pfMethod
	jz	@@2
	mov	bx,es:[di+size TSymbol+bx].psScope
	mov	bx,es:[bx].otName
	add	bx,3
	call	WriteName
	mov	al,'.'
	call	WriteChar
@@2:	lea	bx,[di].seName
	call	WriteName
	mov	bl,es:[di].seName.B0
	mov	bh,0
	lea	di,[di+size TSymbol+bx]
	Invoke	StackRequired
	add	P,dx
	mov	cx,es:[di].psType.ptParamCount
	jcxz	@@8
	mov	al,'('
	call	WriteChar
	add	di,psType.ptParams
@@3:	push	cx di es
	mov	al,es:[di].ppFlags
	mov	ah,-1
	mov	bx,es:[di].ppType.Segm
	mov	di,es:[di].ppType.Offs
	mov	es,es:[bx]
	Invoke	ParamSize
	mov	Temp.exType.Offs,di
	mov	Temp.exType.Segm,es
	sub	P,cx
	mov	bx,P
	mov	es,StackFrame.Segm
	test	al,vfAddress
	jz	@@4
	les	bx,es:[bx]
@@4:	lea	di,Temp
	mov	[di].exValue.Offs,bx
	mov	[di].exValue.Segm,es
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttArray
	je	@@5
	mov	[di].exLocation,elMemory
	mov	al,es:[bx].tdModifier
	mov	[di].exModifier,al
	call	PrintExpr
	jmp	short @@6
@@5:	lea	bx,sAndSoOn
	call	WriteString
@@6:	pop	es di cx
	dec	cx
	jz	@@7
	mov	al,','
	call	WriteChar
	add	di,size TProcParam
	jmp	@@3
@@7:	mov	al,')'
	call	WriteChar
@@8:	call	DoneFormatter
	Exit
FormatCall	endp

FormatValue	proc	near
	Loc	Temp,byte,<size TExpr>
	Entry
	push	di
	lea	ax,@@3
	call	InitFormatter
	mov	si,di
	lea	di,Temp
	push	ds
	pop	es
	mov	cx,size TExpr shr 1
	rep	movsw
	lea	di,Temp
	cmp	[di].exLocation,elMemory
	jne	@@2
	test	Format,fsMemory
	jz	@@1
	call	PrintMemory
	jmp	short @@3
@@1:	mov	cx,RepeatCount
	jcxz	@@2
	call	RepeatPrint
	jmp	short @@3
@@2:	call	PrintExpr
@@3:	call	DoneFormatter
	pop	di
	Exit
FormatValue	endp

InitFormatter	proc	near
	mov	ErrorReturn,ax
	inc	bx
	mov	ResultString.Offs,bx
	mov	ResultString.Segm,es
	mov	ResultFree,255
	pop	ax
	mov	SaveSP,sp
	mov	SaveBP,bp
	jmp	ax
InitFormatter	endp

DoneFormatter	proc	near
	les	bx,ResultString
	mov	ax,255
	sub	ax,ResultFree
	sub	bx,ax
	mov	es:[bx-1],al
	ret
DoneFormatter	endp

PrintExpr	proc	near
	les	bx,[di].exType
	mov	bl,es:[bx].tdType
	xor	bh,bh
	shl	bx,1
	jmp	cs:@@1[bx]
@@1	dw	PrintVoid
	dw	PrintArray
	dw	PrintRecord
	dw	PrintRecord
	dw	PrintFile
	dw	PrintFile
	dw	PrintProc
	dw	PrintSet
	dw	PrintPointer
	dw	PrintString
	dw	PrintFloat
	dw	PrintFloat
	dw	PrintOrdinal
	dw	PrintBoolean
	dw	PrintChar
	dw	PrintEnum
PrintExpr	endp

PrintMemory	proc	near
	mov	cx,RepeatCount
	or	cx,cx
	jnz	@@1
	les	bx,[di].exType
	mov	cx,es:[bx].tdSizeOf
@@1:	les	bx,dword ptr [di].exValue
	test	Format,fsChar+fsString
	jz	@@3
	jmp	_FormatString
@@2:	inc	bx
	mov	al,' '
	call	WriteChar
@@3:	push	bx cx
	mov	al,es:[bx]
	test	Format,fsDecimal+fsHex
	jz	@@4
	xor	ah,ah
	cwd
	call	WriteDefaultHex
	jmp	short @@5
@@4:	xor	cx,cx
	call	WriteByte
@@5:	pop	cx bx
	loop	@@2
	ret
PrintMemory	endp

PrintArray	proc	near
	les	bx,[di].exType
	mov	si,es:[bx].atBounds.Offs
	mov	bx,es:[bx].atBounds.Segm
	mov	es,es:[bx]
	mov	cx,es:[si].itUpperBound.W0
	sub	cx,es:[si].itLowerBound.W0
	inc	cx
	les	bx,[di].exType
	mov	si,es:[bx].atBase.Offs
	mov	bx,es:[bx].atBase.Segm
	mov	es,es:[bx]
	mov	[di].exType.Offs,si
	mov	[di].exType.Segm,es
	mov	al,es:[si].tdModifier
	mov	[di].exModifier,al
	mov	al,'('
	call	WriteChar
	call	RepeatPrint
	mov	al,')'
	jmp	WriteChar
PrintArray	endp

RepeatPrint	proc	near
@@1:	push	cx
	push	dword ptr [di].exValue
	push	word ptr [di].exLocation
	push	[di].exType
	call	PrintExpr
	pop	[di].exType
	pop	word ptr [di].exLocation
	pop	dword ptr [di].exValue
	pop	cx
	dec	cx
	jcxz	@@2
	mov	al,','
	call	WriteChar
	les	bx,[di].exType
	mov	ax,es:[bx].tdSizeOf
	add	[di].exValue.Offs,ax
	jmp	@@1
@@2:	ret
RepeatPrint	endp

PrintRecord	proc	near
	mov	al,'('
	call	WriteChar
	xor	cx,cx
	les	si,[di].exType
@@1:	push	es
	push	es:[si].rtFirst
	inc	cx
	cmp	es:[si].tdType,ttObject
	jne	@@2
	mov	bx,es:[si].otParent.Segm
	or	bx,bx
	jz	@@2
	mov	si,es:[si].otParent.Offs
	mov	es,es:[bx]
	jmp	@@1
@@2:	mov	ax,[di].exValue.Offs
	mov	dx,[di].exValue.Segm
	xor	bx,bx
@@3:	pop	si es
@@4:	or	si,si
	jz	@@5
	cmp	es:[si].seType,t_Var
	jne	@@5
	Invoke	PrintField
	jmp	@@4
@@5:	loop	@@3
	mov	al,')'
	jmp	WriteChar
PrintRecord	endp

PrintField	proc	near
	push	cx bx ax
	or	bx,bx
	jz	@@2
	mov	al,','
	test	Format,fsRecord
	jz	@@1
	mov	al,';'
@@1:	call	WriteChar
@@2:	test	Format,fsRecord
	jz	@@3
	lea	bx,[si].seName
	call	WriteName
	mov	al,':'
	call	WriteChar
@@3:	pop	ax
	mov	bl,es:[si].seName.B0
	mov	bh,0
	lea	si,[si+size TSymbol+bx]
	push	ax dx si es
	add	ax,es:[si].vsOffset
	mov	[di].exValue.Offs,ax
	mov	[di].exValue.Segm,dx
	mov	bx,es:[si].vsType.Offs
	mov	si,es:[si].vsType.Segm
	mov	es,es:[si]
	mov	[di].exType.Offs,bx
	mov	[di].exType.Segm,es
	mov	al,es:[bx].tdModifier
	mov	[di].exModifier,al
	mov	[di].exLocation,elMemory
	Invoke	PrintExpr
	pop	es si dx ax bx cx
	mov	si,es:[si].vsNext
	inc	bx
	ret
PrintField	endp

PrintFile	proc	near
	mov	al,'('
	call	WriteChar
	les	bx,dword ptr [di].exValue
	mov	ax,es:[bx].tdSizeOf
	lea	bx,sClosed
	sub	ax,fmClosed
	jz	@@1
	lea	bx,sInput
	dec	ax
	jz	@@1
	lea	bx,sOutput
	dec	ax
	jz	@@1
	lea	bx,sOpen
	dec	ax
	jz	@@1
	lea	bx,sClosed
	call	WriteString
	jmp	short @@4
@@1:	call	WriteString
	mov	al,','
	call	WriteChar
	mov	al,27h
	call	WriteChar
	les	bx,dword ptr [di].exValue
@@2:	mov	al,es:[bx].fName
	or	al,al
	jz	@@3
	call	WriteChar
	inc	bx
	jmp	@@2
@@3:	mov	al,27h
	call	WriteChar
@@4:	mov	al,')'
	jmp	WriteChar
PrintFile	endp

PrintSet	proc	near
	Invoke	GetVarValue
	mov	al,'['
	call	WriteChar
	les	bx,[di].exType
	mov	si,es:[bx].stBase.Offs
	mov	bx,es:[bx].stBase.Segm
	mov	es,es:[bx]
	mov	bx,[di].exOffset
	mov	[di].exType.Offs,si
	mov	[di].exType.Segm,es
	mov	[di].exLocation,elImmediate
	mov	[di].exModifier,emByte
	mov	[di].exValue.W2,0
	xor	ax,ax
	xor	dx,dx
	mov	ch,1
@@1:	test	[bx],ch
	jz	@@2
	call	PrintSetRange
	jmp	short @@3
@@2:	inc	ax
	rol	ch,1
	adc	bx,0
@@3:	or	al,al
	jnz	@@1
	mov	al,']'
	jmp	WriteChar
PrintSet	endp

PrintSetRange	proc	near
	or	dx,dx
	jz	@@1
	push	ax
	mov	al,','
	call	WriteChar
	pop	ax
@@1:	mov	[di].exValue.W0,ax
	call	PrintSetElem
	inc	ax
	rol	ch,1
	adc	bx,0
	or	al,al
	jz	@@5
	test	[bx],ch
	jz	@@5
	mov	si,ax
@@2:	inc	ax
	rol	ch,1
	adc	bx,0
	or	al,al
	jz	@@3
	test	[bx],ch
	jnz	@@2
@@3:	push	ax
	dec	ax
	mov	[di].exValue.W0,ax
	cmp	ax,si
	mov	al,','
	je	@@4
	mov	al,'.'
	call	WriteChar
	mov	al,'.'
@@4:	call	WriteChar
	call	PrintSetElem
	pop	ax
@@5:	inc	dx
	ret
PrintSetRange		 endp

PrintSetElem	proc	near
	push	ax bx cx dx
	push	word ptr [di].exLocation
	call	PrintExpr
	pop	word ptr [di].exLocation
	pop	dx cx bx ax
	ret
PrintSetElem	endp

PrintVoid	proc	near
	mov	byte ptr [di+6],2
PrintProc	label	near
	Invoke	CastPointer
PrintPointer	label	near
	Invoke	GetVarValue
	test	Format,fsPointer
	jnz	@@5
	mov	ax,[di].exValue.Offs
	or	ax,[di].exValue.Segm
	jz	@@4
	lea	bx,sPtr
	call	WriteString
	mov	ax,[di].exValue.Segm
	cmp	ProgramStatus,psRunning
	jne	@@1
	les	si,CurRegs
	lea	bx,sCSeg
	cmp	ax,es:[si].rCS
	je	@@2
	lea	bx,sDSeg
	cmp	ax,es:[si].rDS
	je	@@2
	lea	bx,sSSeg
	cmp	ax,es:[si].rSS
	je	@@2
@@1:	xor	dx,dx
	call	WriteDefaultHex
	jmp	short @@3
@@2:	call	WriteString
@@3:	mov	al,','
	call	WriteChar
	mov	ax,[di].exValue.Offs
	xor	dx,dx
	call	WriteDefaultHex
	mov	al,')'
	jmp	WriteChar
@@4:	lea	bx,sNil
	jmp	WriteString
@@5:	mov	ax,[di].exValue.Segm
	xor	cx,cx
	call	WriteWord
	mov	al,':'
	call	WriteChar
	mov	ax,[di].exValue.Offs
	xor	cx,cx
	jmp	WriteWord
PrintVoid	endp

PrintString	proc	near
	Invoke	GetVarValue
	mov	bx,[di].exValue.Offs
	mov	cl,[bx]
	xor	ch,ch
	inc	bx
	jmp	FormatString
PrintString	endp

PrintFloat	proc	near
	Invoke	GetVarValue
	mov	ax,FloatPrecision
	cmp	ax,2
	jb	@@1
	cmp	ax,18
	jbe	@@2
@@1:	mov	ax,11
@@2:	lea	bx,[di].exValue
	lea	si,SymbolValue
	Invoke	Extended2Str
	mov	cx,ax
	or	dx,dx
	jz	@@3
	mov	al,'-'
	call	WriteChar
@@3:	xor	dx,dx
	cmp	cx,-3
	jl	@@4
	cmp	cx,FloatPrecision
	jle	@@5
@@4:	xchg	cx,dx
	inc	cx
	dec	dx
@@5:	or	cx,cx
	jg	@@7
	mov	al,'0'
	call	WriteChar
	mov	al,'.'
	call	WriteChar
@@6:	jcxz	@@8
	mov	al,'0'
	call	WriteChar
	inc	cx
	jmp	@@6
@@7:	call	WriteDigit
	loop	@@7
	mov	al,'.'
	call	WriteChar
@@8:	call	WriteDigit
	cmp	byte ptr [si],0
	jne	@@8
	or	dx,dx
	jnz	@@9
	ret
@@9:	mov	al,'E'
	call	WriteChar
	mov	ax,dx
	cwd
	jmp	WriteDec
PrintFloat	endp

WriteDigit	proc	near
	lodsb
	or	al,al
	jnz	@@1
	dec	si
	mov	al,'0'
@@1:	jmp	WriteChar
WriteDigit	endp

PrintOrdinal	proc	near
	Invoke	GetVarValue
	mov	ax,[di+0ah]
	mov	dx,[di+0ch]
	jmp	WriteDefaultDec
PrintOrdinal	endp

PrintBoolean	proc	near
	Invoke	GetVarValue
	lea	bx,sFalse
	cmp	[di].exValue.B0,0
	je	@@1
	lea	bx,sTrue
@@1:	jmp	WriteString
PrintBoolean	endp

PrintChar	proc	near
	Invoke	GetVarValue
	lea	bx,[di].exValue
	mov	cx,1
	jmp	FormatString
PrintChar	endp

PrintEnum	proc	near
	Invoke	GetVarValue
	mov	ax,[di].exValue.W0
	mov	dx,[di].exValue.W2
	les	bx,[di].exType
	mov	si,es:[bx].itBase.Offs
	mov	bx,es:[bx].itBase.Segm
	mov	es,es:[bx]
	or	dx,dx
	jnz	@@3
	cmp	ax,es:[si].itUpperBound.W0
	ja	@@3
	mov	cx,ax
	add	si,size TEnumType
	jcxz	@@2
	mov	bh,0
@@1:	mov	bl,es:[si].seName.B0
	lea	si,[si+size TSymbol+bx+size TConstStub+4]
	loop	@@1
@@2:	lea	bx,[si].seName
	jmp	WriteName
@@3:	jmp	WriteDec
PrintEnum	endp

WriteString	proc	near
	push	ds
	pop	es
WriteName	label	near
	mov	cl,es:[bx]
	xor	ch,ch
@@1:	inc	bx
	mov	al,es:[bx]
	call	WriteChar
	loop	@@1
	ret
WriteString	endp

FormatString	proc	near
	push	ds
	pop	es
_FormatString	label	near
	jcxz	@@7
	xor	dx,dx
@@1:	mov	al,es:[bx]
	test	Format,fsChar
	jnz	@@3
	cmp	al,' '
	jae	@@3
	or	dx,dx
	jz	@@2
	call	@@8
@@2:	push	bx cx dx ax
	mov	al,'#'
	call	WriteChar
	pop	ax
	xor	ah,ah
	cwd
	call	WriteDefaultDec
	pop	dx cx bx
	jmp	short @@6
@@3:	or	dx,dx
	jnz	@@4
	call	@@8
@@4:	or	al,al
	jnz	@@5
	mov	al,' '
@@5:	call	WriteChar
	cmp	al,27h
	jne	@@6
	call	WriteChar
@@6:	inc	bx
	loop	@@1
	or	dx,dx
	jnz	@@8
	ret
@@7:	call	@@8
@@8:	push	ax
	mov	al,27h
	call	WriteChar
	pop	ax
	not	dx
	ret
FormatString	endp

WriteDefaultDec	proc	near
	test	Format,fsHex
	jnz	WriteHex
WriteDec	label	near
	mov	bx,ax
	or	dx,dx
	jge	@@1
	not	bx
	not	dx
	add	bx,1
	adc	dx,0
	mov	al,'-'
	call	WriteChar
@@1:	lea	si,Power10
	mov	cx,9
@@2:	cmp	dx,[si].W2
	jb	@@3
	ja	@@4
	cmp	bx,[si].W0
	jae	@@4
@@3:	add	si,4
	loop	@@2
@@4:	inc	cx
@@5:	mov	al,'0'-1
@@6:	inc	al
	sub	bx,[si].W0
	sbb	dx,[si].W2
	jnc	@@6
	add	bx,[si].W0
	adc	dx,[si].W2
	add	si,4
	call	WriteChar
	loop	@@5
	ret
WriteDefaultDec	endp

WriteDefaultHex	proc	near
	test	Format,fsDecimal
	jnz	WriteDec
WriteHex	label	near
	push	ax
	mov	al,'$'
	call	WriteChar
	pop	ax
	mov	cx,7
	xchg	ax,dx
	call	WriteWord
	xchg	ax,dx
WriteWord	label	near
	xchg	al,ah
	call	WriteByte
	xchg	al,ah
WriteByte	label	near
	push	ax
	shr	al,1
	shr	al,1
	shr	al,1
	shr	al,1
	call	@@1
	pop	ax
	and	al,0fh
@@1:	jcxz	@@3
	or	al,al
	jnz	@@2
	dec	cx
	ret
@@2:	xor	cx,cx
@@3:	add	al,'0'
	cmp	al,'0'+10
	jb	@@4
	add	al,'A'-'0'-10
WriteChar	label	near
@@4:	push	es di
	les	di,ResultString
	stosb
	mov	ResultString.Offs,di
	dec	ResultFree
	jz	@@5
	pop	di es
	ret
@@5:	mov	sp,SaveSP
	mov	bp,SaveBP
	jmp	ErrorReturn
WriteDefaultHex	endp

	end