	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
	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
