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

	model	large compiler_text,pascal 
	include	compiler.inc 
 
	.data? 
 
CodeSz		dw	? 
FixupSz		dw	? 
JumpChain	dw	? 
CurLine		dw	? 
CurCode		dw	? 
 
	.code	compiler_text 
 
	public	AddGoal 
	public	FlushGoals 
	public	Use2Exprs 
	public	UseExpr 
	public	UseGoal 
	public	DoneExpr 
	public	DoneGoal 
	public	PutLineNumber 
	public	GetLineNumber 
	public	PutByte 
	public	PutWord 
	public	PutJmp 
	public	AddToChain 
	public	PutLabel 
	public	PutSystemCall 
	public	PutFixup 
	public	PutUseUnit 
	public	PutCodeConst 
	public	PutConst 
	public	WordAlignConst 
	public	PutConstFixup 
	public	RearrangeCode 
 
AddGoal	proc	near 
	cmp	word ptr [bx],62 
	je	@@1 
	add	word ptr [bx],2 
	add	bx,[bx] 
	mov	[bx],ax 
	ret 
@@1:	push	bx ax 
	call	FlushGoals 
	pop	ax 
	call	UseGoal 
	call	DoneGoal 
	pop	bx 
	mov	word ptr [bx],2 
	mov	[bx+2],ax 
	ret 
AddGoal	endp 
 
FlushGoals	proc	near 
	mov	cx,[bx] 
	shr	cx,1 
	jz	@@2 
@@1:	add	bx,2 
	mov	ax,[bx] 
	push	bx 
	call	UseGoal 
	pop	bx 
	loop	@@1 
@@2:	ret 
FlushGoals	endp 
 
Use2Exprs	proc	near 
	call	UseExpr 
	xchg	si,di 
	call	UseExpr 
	xchg	si,di 
	ret 
Use2Exprs	endp 
 
UseExpr	proc	near 
	xor	ax,ax 
	xchg	ax,[di].exCode 
UseGoal	label	near 
	or	ax,ax 
	jz	@@1 
	push	es di ax 
	mov	ax,3 
	Invoke	GetStmtMem 
	mov	al,0 
	stosb 
	pop	ax 
	stosw 
	pop	di 
	pop	es 
@@1:	ret 
UseExpr	endp 
 
DoneExpr	proc	near 
	call	DoneGoal 
	mov	[di].exCode,ax 
	ret 
DoneExpr	endp 
 
DoneGoal	proc	near 
	mov	ax,LastGoal 
	sub	ax,StmtPart.Offs 
	jz	@@1 
	push	es di 
	mov	ax,1 
	Invoke	GetStmtMem 
	mov	al,2 
	stosb 
	mov	ax,di 
	xchg	ax,LastGoal 
	pop	di es 
@@1:	ret 
DoneGoal	endp 
 
PutLineNumber	proc	near 
	or	ax,ax 
	jz	@@1 
	push	es di ax 
	mov	ax,3 
	Invoke	GetStmtMem 
	mov	al,18 
	stosb 
	pop	ax 
	stosw 
	pop	di es 
@@1:	ret 
PutLineNumber	endp 
 
GetLineNumber	proc	near 
	test	GlobalOptions,coDebugInfo 
	jz	@@1 
	mov	di,FileStackPtr 
	mov	ax,[di].fsLineNumber 
	cmp	ax,LastLineNumber 
	je	@@1 
	mov	LastLineNumber,ax 
	ret 
@@1:	xor	ax,ax 
	ret 
GetLineNumber	endp 
 
PutByte	proc	near 
	push	es di ax 
	mov	ax,2 
	Invoke	GetStmtMem 
	mov	al,4 
	stosb 
	pop	ax 
	stosb 
	pop	di es 
	ret 
PutByte	endp 
 
PutWord	proc	near 
	push	es di ax 
	mov	ax,3 
	Invoke	GetStmtMem 
	mov	al,6 
	stosb 
	pop	ax 
	stosw 
	pop	di es 
	ret 
PutWord	endp 
 
PutJmp	proc	near 
	mov	dx,StmtPart.Offs 
	xchg	dx,[bx] 
	push	es di ax 
	mov	ax,8 
	Invoke	GetStmtMem 
	mov	al,8 
	stosb 
	pop	ax 
	stosb 
	mov	ax,dx 
	stosw 
	pop	di es 
	ret 
PutJmp	endp 
 
AddToChain	proc	near 
	mov	dx,[bx] 
	or	dx,dx 
	jnz	@@1 
	mov	[bx],ax 
	ret 
@@1:	push	ds 
	mov	ds,StmtPart.segm 
@@2:	mov	bx,dx 
	mov	dx,[bx+2] 
	or	dx,dx 
	jnz	@@2 
	mov	[bx+2],ax 
	pop	ds 
	ret 
AddToChain	endp 
 
PutLabel	proc	near 
	mov	ax,[bx] 
	sub	[bx],ax 
	or	ax,ax 
	jnz	@@1 
	ret 
@@1:	push	es di ax 
	mov	ax,3 
	Invoke	GetStmtMem 
	mov	al,12 
	stosb 
	pop	ax 
@@2:	mov	bx,ax 
	mov	ax,es:[bx+2] 
	mov	es:[bx+2],di 
	or	ax,ax 
	jnz	@@2 
	pop	di es 
	ret 
PutLabel	endp 
 
PutSystemCall	proc	near 
	shl	ax,1 
	jnc	@@1 
	Invoke	Need8087 
@@1:	push	ax 
	mov	al,9ah			; call	far ptr ... 
	call	PutByte 
	pop	bx 
	mov	ax,SystemUnit 
	mov	cx,ffProc+ffPtr 
	xor	dx,dx 
PutFixup	label	near 
	push	es di bx 
	call	PutUseUnit 
	or	cx,ax 
	mov	ax,7 
	Invoke	GetStmtMem 
	mov	al,14 
	stosb 
	mov	ax,cx 
	stosw 
	pop	ax 
	stosw 
	mov	ax,dx 
	stosw 
	pop	di es 
	ret 
PutSystemCall	endp 
 
PutUseUnit	proc	near 
	mov	es,UnitList.Segm 
	xor	di,di 
	xor	bx,bx 
	jmp	short @@2 
@@1:	cmp	ax,es:[di].ulSegment 
	je	@@3 
	mov	bl,es:[di].ulName.B0 
	lea	di,[di+size TUnitList+bx] 
@@2:	cmp	di,UnitList.Offs 
	jne	@@1 
	push	cx si ds ax 
	mov	es,ax 
	mov	si,es:uhName 
	add	si,seName 
	mov	al,es:[si].B0 
	mov	ah,0 
	inc	ax 
	mov	cx,ax 
	add	ax,size TUnitList-1 
	lea	bx,UnitList 
	Invoke	GetMemory 
	pop	ax 
	push	di 
	stosw 
	mov	ds,ax 
	rep	movsb 
	pop	di ds si cx 
@@3:	mov	ax,di 
	ret 
PutUseUnit	endp 
 
PutCodeConst	proc	near 
	push	di si 
	lea	si,CompiledCode 
	mov	di,CodeSectStart 
	call	CheckDupes 
	mov	bx,CodeMap.Offs 
	sub	dx,CodeSectStart 
	pop	si di 
	ret 
PutCodeConst	endp 
 
PutConst	proc	near 
	push	di si 
	lea	si,CompiledConst 
	mov	di,ConstSectStart2 
	call	CheckDupes 
	mov	bx,ConstMap.Offs 
	sub	dx,ConstSectStart 
	pop	si di 
	ret 
PutConst	endp 
 
CheckDupes	proc	near 
	push	es 
	xchg	ax,dx 
	xchg	bx,si 
	les	cx,[bx] 
	sub	cx,di 
	sub	cx,dx 
	jc	@@4 
	inc	cx 
	lodsb 
@@1:	repne	scasb 
	jne	@@3 
	push	cx 
	mov	cx,dx 
	dec	cx 
	jz	@@2 
	push	di si 
	repe	cmpsb 
	pop	si di 
@@2:	pop	cx 
	jz	@@5 
	or	cx,cx 
	jnz	@@1 
@@3:	dec	si 
@@4:	mov	ax,dx 
	Invoke	GetMemory 
	push	di 
	mov	cx,dx 
	rep	movsb 
	pop	di 
	inc	di 
@@5:	dec	di 
	mov	dx,di 
	mov	ax,Dictionary.segm 
	pop	es 
	ret 
CheckDupes	endp 
 
WordAlignConst	proc	near 
	mov	ax,1 
	test	CompiledConst.Offs,ax 
	jz	@@1 
	push	di es 
	lea	bx,CompiledConst 
	Invoke	GetMemory 
	xor	al,al 
	stosb 
	pop	es di 
@@1:	ret 
WordAlignConst	endp 
 
PutConstFixup	proc	near 
	push	es di bx 
	call	PutUseUnit 
	or	cx,ax 
	mov	ax,size TFixup 
	lea	bx,ConstFixups 
	Invoke	GetMemory 
	mov	ax,cx 
	stosw 
	pop	ax 
	stosw 
	mov	ax,dx 
	stosw 
	mov	ax,si 
	sub	ax,ConstSectStart 
	stosw 
	pop	di es 
	ret 
PutConstFixup	endp 
 
RearrangeCode	proc	near 
	test	GlobalOptions,coDebugInfo 
	jz	@@1 
	mov	ax,3 
	Invoke	GetStmtMem 
	mov	al,18 
	stosb 
	mov	ax,LastLineNumber 
	inc	ax 
	stosw 
@@1:	mov	ax,1 
	Invoke	GetStmtMem 
	mov	al,20 
	stosb 
@@2:	call	ScanCode 
	call	OptimizeJumps 
	jnz	@@2 
	jmp	Rearrange 
RearrangeCode	endp 
 
ScanCode	proc	near 
	xor	cx,cx 
	xor	dx,dx 
	mov	di,CompiledCode.offs 
	mov	si,LastGoal 
	mov	ds,StmtPart.segm 
@@1:	lodsb 
	mov	bl,al 
	xor	bh,bh 
	jmp	cs:@@2[bx] 
@@2	dw	@@Use 
	dw	@@Done 
	dw	@@Byte 
	dw	@@Word 
	dw	@@Jmp 
	dw	@@Jmps 
	dw	@@Lbl 
	dw	@@Fixp 
	dw	@@Fixp 
	dw	@@Line 
	dw	@@End 
@@Use:	lodsw 
	push	si 
	mov	si,ax 
	jmp	@@1 
@@Done:	pop	si 
	jmp	@@1 
@@Byte:	inc	si 
	inc	di 
	jmp	@@1 
@@Word:	inc	si 
	inc	si 
	inc	di 
	inc	di 
	jmp	@@1 
@@Jmp:	mov	[si+3],di 
	mov	[si+5],dx 
	mov	dx,si 
	lodsb 
	add	si,6 
	add	di,3 
	cmp	al,80h 
	jae	@@1 
	inc	di 
	inc	di 
	jmp	@@1 
@@Jmps:	add	si,7 
	inc	di 
	inc	di 
	jmp	@@1 
@@Lbl:	mov	[si],di 
	inc	si 
	inc	si 
	jmp	@@1 
@@Fixp:	lodsw 
	add	si,4 
	add	cx,8 
	inc	di 
	inc	di 
	and	ax,ffPtr 
	cmp	ax,ffPtr 
	jne	@@1 
	inc	di 
	inc	di 
	jmp	@@1 
@@Line:	inc	si 
	inc	si 
	jmp	@@1 
@@End:	push	ss 
	pop	ds 
	mov	FixupSz,cx 
	mov	JumpChain,dx 
	sub	di,CompiledCode.Offs 
	mov	CodeSz,di 
	ret 
ScanCode	endp 
 
OptimizeJumps	proc	near 
	xor	cx,cx 
	mov	si,JumpChain 
	mov	ds,StmtPart.Segm 
	jmp	short @@3 
@@1:	mov	bx,[si+1] 
	mov	ax,[bx] 
	sub	ax,[si+3] 
	cmp	ax,129 
	jg	@@2 
	cmp	ax,-126 
	jl	@@2 
	mov	byte ptr [si-1],0ah 
	inc	cx 
@@2:	mov	si,[si+5] 
@@3:	or	si,si 
	jnz	@@1 
	push	ss 
	pop	ds 
	or	cx,cx 
	ret 
OptimizeJumps	endp 
 
Rearrange	proc	near 
	test	GlobalOptions,coDebugInfo 
	jz	@@3 
	mov	es,Dictionary.segm 
	mov	di,CurProc 
	mov	cl,es:[di] 
	mov	ax,LastLineNumber 
	sub	ax,FirstLineNumber 
	shl	ax,1 
	add	ax,size TTraceTable+2 
	lea	bx,TraceTable 
	Invoke	GetMemory 
	xor	ax,ax 
	test	GlobalOptions,coLocalSymbols 
	jz	@@2 
	test	cl,pfAssembler 
	jz	@@1 
	mov	ax,ParamsSize 
	or	ax,LocalsSize 
	jz	@@2 
@@1:	mov	ax,CurScope 
@@2:	stosw 
	mov	bx,FileStackPtr 
	mov	ax,[bx].fsNameEntry 
	stosw 
	mov	ax,CompiledCode.Offs 
	mov	CurCode,ax 
	sub	ax,CodeSectStart 
	stosw 
	mov	ax,FirstLineNumber 
	mov	CurLine,ax 
	stosw 
	mov	ax,LastLineNumber 
	sub	ax,FirstLineNumber 
	inc	ax 
	stosw 
	mov	TraceTable.Offs,di 
@@3:	mov	ax,FixupSz 
	lea	bx,CodeFixups 
	Invoke	GetMemory 
	mov	CodeFixups.Offs,di 
	mov	ax,CodeSz 
	lea	bx,CompiledCode 
	Invoke	GetMemory 
	mov	si,LastGoal 
	mov	ds,StmtPart.Segm 
	assume	ds:nothing 
@@4:	lodsb 
	mov	bl,al 
	xor	bh,bh 
	jmp	cs:@@5[bx] 
@@5	dw	@@Use 
	dw	@@Done 
	dw	@@Byte 
	dw	@@Word 
	dw	@@Jmp 
	dw	@@Jmps 
	dw	@@Lbl 
	dw	@@Fixp 
	dw	@@Fixa 
	dw	@@Line 
	dw	@@End 
@@Use:	lodsw 
	push	si 
	mov	si,ax 
	jmp	@@4 
@@Done:	pop	si 
	jmp	@@4 
@@Byte:	movsb 
	jmp	@@4 
@@Word:	movsw 
	jmp	@@4 
@@Jmp:	lodsb 
	cmp	al,cdAlways 
	je	@@6 
	cmp	al,80h 
	jae	@@7 
	xor	al,1 
	mov	ah,3 
	stosw 
@@6:	mov	al,0e9h 
	stosb 
	lodsw 
	mov	bx,ax 
	mov	ax,[bx] 
	sub	ax,di 
	dec	ax 
	dec	ax 
	stosw 
	add	si,4 
	jmp	@@4 
@@7:	push	ss 
	pop	ds 
	mov	ax,161 
	Chain	CompileError 
@@Jmps:	movsb 
	lodsw 
	mov	bx,ax 
	mov	ax,[bx] 
	sub	ax,di 
	dec	ax 
	stosb 
	add	si,4 
	jmp	@@4 
@@Lbl:	inc	si 
	inc	si 
	jmp	@@4 
@@Fixp:	mov	cx,di 
	les	di,CodeFixups 
	lodsw 
	stosw 
	mov	dx,ax 
	movsw 
	movsw 
@@8:	mov	ax,cx 
	sub	ax,CodeSectStart 
	stosw 
	mov	CodeFixups.offs,di 
	mov	di,cx 
	mov	es,CompiledCode.segm 
	xor	ax,ax 
	stosw 
	and	dx,ffPtr 
	cmp	dx,ffPtr 
	jne	@@9 
	stosw 
@@9:	jmp	@@4 
@@Fixa:	mov	cx,di 
	lodsw 
	xchg	ax,di 
	lodsw 
	xchg	ax,di 
	mov	es,Dictionary.Segm 
	mov	bl,es:[di].seName.B0 
	mov	bh,0 
	mov	bx,es:[di+size TSymbol+bx] 
	or	bx,bx 
	jz	@@10 
	les	di,CodeFixups 
	stosw 
	mov	dx,ax 
	mov	ax,CodeMap.Offs 
	stosw 
	lodsw 
	add	ax,[bx] 
	sub	ax,CodeSectStart 
	stosw 
	jmp	@@8 
@@10:	push	ss 
	pop	ds 
	mov	ax,82 
	add	di,seName 
	Chain	ParamError 
@@Line:	lodsw 
	mov	cx,ax 
	sub	cx,CurLine 
	jbe	@@12 
	mov	CurLine,ax 
	mov	ax,di 
	sub	ax,CurCode 
	mov	CurCode,di 
	mov	dx,di 
	mov	bx,es 
	les	di,TraceTable 
	cmp	ax,80h 
	jb	@@11 
	xchg	al,ah 
	or	al,80h 
	stosb 
	xchg	al,ah 
@@11:	stosb 
	xor	al,al 
	dec	cx 
	rep	stosb 
	mov	TraceTable.Offs,di 
	mov	di,dx 
	mov	es,bx 
@@12:	jmp	@@4 
@@End:	push	ss 
	pop	ds 
	ret 
Rearrange	endp 
 
	end