put.asm

Turbo Pascal 6.0编译器源码

	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