www.pudn.com > tp60src.zip > UNITS.ASM

	model	large compiler_text,pascal 
	include	compiler.inc 
 
	.code	compiler_text 
 
	public	SaveState 
	public	RestoreState 
	public	Add2TpuList 
	public	FormUnit 
	public	WriteUnit 
	public	ReadUnit 
	public	DiscardUnits 
	public	ReadLibrary 
 
SaveState	proc	near 
	Invoke	SaveHeap 
	mov	cx,CompMemPtr 
	mov	dx,CompMemTop 
	call	UpdateLinks 
	lea	si,CompilerFlags 
	lea	ax,FileNameBuf 
	sub	ax,si 
	push	ax 
	add	ax,15 
	mov	cl,4 
	shr	ax,cl 
	sub	CompMemTop,ax 
	pop	cx 
	xor	di,di 
	mov	es,CompMemTop 
	rep	movsb 
	ret 
SaveState	endp 
 
RestoreState	proc	near 
	lea	di,CompilerFlags 
	lea	ax,FileNameBuf 
	sub	ax,di 
	mov	cx,ax 
	xor	si,si 
	push	ds 
	pop	es 
	mov	ds,CompMemTop 
	rep	movsb 
	push	es 
	pop	ds 
	add	ax,15 
	mov	cl,4 
	shr	ax,cl 
	add	CompMemTop,ax 
	push	CompMemPtr CompMemTop 
	Invoke	RestoreHeap 
	pop	cx dx 
UpdateLinks	label	near 
	xor	bx,bx 
	lea	di,FirstUnit 
	call	_UpdateLinks 
	lea	di,UsedUnit 
	call	_UpdateLinks 
	mov	es,UnitList.Segm 
	xor	di,di 
	jmp	short @@3 
@@1:	cmp	es:[di].ulSegment,cx 
	jne	@@2 
	mov	es:[di].ulSegment,dx 
@@2:	mov	bl,es:[di].ulName.B0 
	lea	di,[di+size TUnitList+bx] 
@@3:	cmp	di,UnitList.Offs 
	jne	@@1 
	ret 
RestoreState	endp 
 
_UpdateLinks	proc	near 
	mov	ax,[di] 
	cmp	ax,cx 
	jne	@@4 
	mov	ax,dx 
	mov	[di],ax 
	jmp	short @@4 
@@1:	mov	es,ax 
	mov	di,es:uhName 
@@2:	mov	bl,es:[di].seName.B0 
	cmp	es:[di+size TSymbol+bx].usAddress,cx 
	jne	@@3 
	mov	es:[di+size TSymbol+bx].usAddress,dx 
@@3:	mov	di,es:[di+size TSymbol+bx].usNext 
	or	di,di 
	jnz	@@2 
	mov	ax,es:uhNext 
	cmp	ax,cx 
	jne	@@4 
	mov	ax,dx 
	mov	es:uhNext,ax 
@@4:	or	ax,ax 
	jnz	@@1 
	ret 
_UpdateLinks	endp 
 
Add2TpuList	proc	near 
	mov	ax,CompiledCode.Segm 
	mov	CompMemPtr,ax 
	mov	di,TpuListPtr 
	cmp	di,offset TpuList[4016] 
	ja	@@1 
	mov	es,FirstUnit 
	mov	es:uhTpuName,di 
	Invoke	CopyDSCStr 
	mov	TpuListPtr,di 
	ret 
@@1:	mov	ax,18 
	Chain	CompileError 
Add2TpuList	endp 
 
FormUnit	proc	near 
	lea	si,Dictionary 
	xor	ax,ax 
@@1:	add	ax,[si].hrAddress.Offs 
	jc	@@2 
	add	si,size THeapRecord 
	cmp	si,offset TempDict 
	jne	@@1 
	cmp	ax,0fff0h 
	jbe	@@3 
@@2:	mov	ax,123 
	Chain	CompileError 
@@3:	les	ax,Dictionary 
	mov	di,uhProcMap 
	lea	si,ProcMap 
@@4:	stosw 
	xchg	ax,di 
	push	ds si 
	lds	cx,[si].hrAddress 
	xor	si,si 
	Invoke	MoveBlock 
	pop	si ds 
	xchg	ax,di 
	add	si,size THeapRecord 
	cmp	si,offset TempDict 
	jne	@@4 
	mov	Dictionary.Offs,ax 
	stosw 
	mov	ax,CompiledCode.Offs 
	stosw 
	mov	ax,CompiledConst.Offs 
	stosw 
	mov	ax,CodeFixups.Offs 
	stosw 
	mov	ax,ConstFixups.Offs 
	stosw 
	mov	ax,VarsSize 
	stosw 
	mov	di,Dictionary.Offs 
	call	Normalize 
	lea	si,CompiledCode 
@@5:	push	ds si 
	lds	cx,[si].hrAddress 
	xor	si,si 
	xor	di,di 
	Invoke	MoveBlock 
	call	Normalize 
	pop	si 
	pop	ds 
	mov	[si].hrAddress.Segm,ax 
	add	si,size THeapRecord 
	cmp	si,offset StmtPart 
	jne	@@5 
	mov	CompMemPtr,es 
	ret 
FormUnit	endp 
 
Normalize	proc	near 
	mov	cx,di 
	neg	cx 
	and	cx,0fh 
	xor	ax,ax 
	rep	stosb 
	mov	cl,4 
	shr	di,cl 
	mov	ax,es 
	add	di,ax 
	mov	es,di 
	ret 
Normalize	endp 
 
WriteUnit	proc	near 
	mov	dx,Dictionary.Segm 
@@1:	mov	ax,CompMemPtr 
	sub	ax,dx 
	jz	@@3 
	cmp	ax,1000h 
	jb	@@2 
	mov	ax,0fffh 
@@2:	push	ax dx 
	mov	cl,4 
	shl	ax,cl 
	mov	cx,ax 
	xor	ax,ax 
	mov	bx,FileHandle 
	Invoke	WriteHandle 
	pop	dx ax 
	add	dx,ax 
	jmp	@@1 
@@3:	ret 
WriteUnit	endp 
 
ReadUnit	proc	near 
	mov	dx,es:uhTpuName 
	or	dx,dx 
	jz	@@2 
	Invoke	OpenHandle 
	mov	bx,ax 
	mov	ax,es:uhEndTrace 
	add	ax,15 
	and	ax,0fff0h 
	xor	dx,dx 
	or	di,di 
	jz	@@1 
	mov	cx,es:uhCodeSize 
	call	AddLong 
	mov	cx,es:uhConstSize 
	call	AddLong 
@@1:	xor	cx,cx 
	push	bx 
	Invoke	SeekHandle 
	pop	bx 
	push	es 
	Invoke	ReadFile 
	Invoke	CloseHandle 
	mov	bx,es 
	pop	es 
	mov	es:uhCodeSeg,bx 
	mov	ax,es:uhCodeSize 
	call	CondAddPara 
	mov	es:uhConstSeg,bx 
	mov	ax,es:uhConstSize 
	call	CondAddPara 
	mov	es:uhCodeFixupSeg,bx 
	mov	ax,es:uhCodeFixupSize 
	call	AddPara 
	mov	es:uhConstFixupSeg,bx 
@@2:	Chain	UpdateCompInfo 
ReadUnit	endp 
 
AddLong	proc	near 
	add	cx,15 
	and	cx,0fff0h 
	add	ax,cx 
	adc	dx,0 
	ret 
AddLong	endp 
 
CondAddPara	proc	near 
	or	di,di 
	jnz	@@1 
AddPara	label	near 
	add	ax,15 
	mov	cl,4 
	shr	ax,cl 
	add	bx,ax 
@@1:	ret 
CondAddPara	endp 
 
DiscardUnits	proc	near 
	mov	es,FirstUnit 
	mov	ax,es:uhCodeSeg 
	mov	CompMemPtr,ax 
	ret 
DiscardUnits	endp 
 
ReadLibrary	proc	near 
	cld 
	lea	ax,@@4 
	Invoke	SetErrHandler 
	xor	ax,ax 
	mov	LibraryUnits,ax 
	mov	dx,UnitName 
	or	dx,dx 
	jz	@@2 
	Invoke	OpenHandle 
	mov	bx,ax 
	Invoke	ReadFile 
	Invoke	CloseHandle 
@@1:	cmp	es:uhSignature.W0,'PT' 
	jne	@@3 
	cmp	es:uhSignature.W2,'9U' 
	jne	@@3 
	mov	bx,es 
	call	CalcSegs 
	mov	ax,LibraryUnits 
	mov	es:uhLink,ax 
	mov	LibraryUnits,es 
	mov	es,bx 
	cmp	bx,CompMemPtr 
	jne	@@1 
@@2:	ret 
@@3:	mov	ax,72 
	mov	dx,UnitName 
	Chain	ParamError2 
@@4:	xor	ax,ax 
	mov	LibraryUnits,ax 
	ret 
ReadLibrary	endp 
 
CalcSegs	proc	near 
	mov	ax,es:uhEndTrace 
	call	@@1 
	mov	es:uhCodeSeg,bx 
	mov	ax,es:uhCodeSize 
	call	@@1 
	mov	es:uhConstSeg,bx 
	mov	ax,es:uhConstSize 
	call	@@1 
	mov	es:uhCodeFixupSeg,bx 
	mov	ax,es:uhCodeFixupSize 
	call	@@1 
	mov	es:uhConstFixupSeg,bx 
	mov	ax,es:uhDataFixupSize 
@@1:	add	ax,15 
	mov	cl,4 
	shr	ax,cl 
	add	bx,ax 
	ret 
CalcSegs	endp 
 
	end