www.pudn.com > tp60src.zip > DEBUGGER.ASM
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,
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,
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
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,
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,
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