asm.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	extrn	Assemble:far

	.data

	db	44,62,159,155,7,8,76,158,157,12,31,156,155,1,5
ErrorCodes	label	byte

	.data?

SaveDictionary	dw	?

	.code	compiler_text

	public	AsmClause
	public	GetAsmSymbol
	public	GetAsmLabel
	public	EmitByte
	public	EmitFixup
	public	EmitJump
	public	EmitFloat

AsmClause	proc	near
	cmp	CurrentToken,tAsm
	je	@@1
	mov	ax,162
	Chain	CompileError
@@1:	mov	ax,Dictionary.Offs
	mov	SaveDictionary,ax
	mov	ax,4
	Invoke	CreateHashTable
	push	Dictionary.Offs
@@2:	Invoke	UpdateCompInfo
	Invoke	GetRawToken
	mov	TextPos,si
	lodsb
	cmp	al,';'
	je	@@6
	and	al,0dfh
	cmp	al,'E'
	jne	@@3
	lodsw
	and	ax,0dfdfh
	cmp	ax,'DN'
	jne	@@3
	mov	al,[si]
	cmp	al,'0'
	jb	@@9
	cmp	al,'9'+1
	jb	@@3
	and	al,0dfh
	cmp	al,'A'
	jb	@@9
	cmp	al,'Z'+1
	jb	@@3
	cmp	al,'_'
	jne	@@9
@@3:	Invoke	GetLineNumber
	Invoke	PutLineNumber
	push	ds TextPos
	mov	ax,sp
	push	ss ax
	mov	ax,128
	push	ax
	xor	ax,ax
	test	GlobalOptions,co286Code
	jz	@@4
	inc	ax
@@4:	mov	di,CurProc
	or	di,di
	jz	@@5
	mov	es,Dictionary.Segm
	test	es:[di].psFlags,pfFar
	jz	@@5
	or	ax,100h
@@5:	push	ax
	call	Assemble
	pop	si di
	or	ax,ax
	jnz	@@7
@@6:	mov	di,FileStackPtr
	mov	[di],si
	jmp	@@2
@@7:	jg	@@8
	xchg	ax,bx
	mov	al,ErrorCodes[bx]
	xor	ah,ah
@@8:	mov	TextPos,si
	Chain	CompileError
@@9:	mov	di,FileStackPtr
	mov	[di].fsTextPos,si
	Invoke	GetToken
	pop	ax
	cmp	ax,Dictionary.Offs
	jne	@@10
	mov	ax,SaveDictionary
	mov	Dictionary.Offs,ax
@@10:	Chain	DoneGoal
AsmClause	endp

GetAsmSymbol	proc	far _Name:dword,Symbol:dword
	cld
	les	di,_Name
	Invoke	CalcHash
	les	di,Symbol
	les	di,es:[di]
	call	AsmIdent
	jnz	@@2
	mov	CurrentHash,bx
	xor	ah,ah
	shl	ax,1
	xchg	ax,si
	xor	ax,ax
	mov	dx,ax
	mov	cx,-1
	mov	bx,cx
	call	cs:@@3[si-t_Label*2]
	jc	@@1
	push	ax es di
	les	di,Symbol
	pop	ax
	stosw
	pop	ax
	stosw
	xchg	ax,cx
	stosw
	xchg	ax,bx
	stosw
	pop	ax
	stosw
	xchg	ax,dx
	stosw
	xchg	ax,si
	stosw
	cmp	ax,-3
	sbb	ax,ax
	inc	ax
	stosw
	xor	ax,ax
@@1:	ret
@@2:	mov	ax,3
	jmp	@@1
@@3	dw	AsmLabel
	dw	AsmConst
	dw	AsmType
	dw	AsmVar
	dw	AsmProc
	dw	AsmError
	dw	AsmError
	dw	AsmError
	dw	AsmError
	dw	AsmError
	dw	AsmUnit
	dw	AsmSeg
	dw	AsmLoc
GetAsmSymbol	endp

AsmLabel	proc	near
	Invoke	GetHash
	mov	cx,CurrentHash
	cmp	cx,si
	jb	@@1
	mov	bx,ffCode
	call	AsmUseUnit
	mov	si,-3
	xor	di,di
	mov	es,di
	ret
@@1:	mov	ax,80
	stc
	ret
AsmLabel	endp

AsmType	proc	near
	mov	si,es:[di].tsType.Segm
	mov	di,es:[di].tsType.Offs
	mov	es,es:[si]
_AsmType	label	near
	mov	si,es:[di].tdSizeOf
	cmp	es:[di].tdType,ttRecord
	je	@@1
	cmp	es:[di].tdType,ttObject
	je	@@1
	xor	di,di
	mov	es,di
@@1:	ret
AsmType	endp

AsmVar	proc	near
@@1:	mov	al,es:[di].vsFlags
	test	al,vfAlias
	jz	@@2
	mov	si,es:[di].vsLink.Segm
	mov	di,es:[di].vsLink.Offs
	mov	es,es:[si]
	jmp	@@1
@@2:	test	al,vfField
	jnz	@@4
	dec	cx
	and	al,vfType
	cmp	al,vfAbsolute
	je	@@5
	dec	cx
	cmp	al,vfLocal
	je	@@4
	mov	cx,es:[di].vsMap
	mov	bx,ffData
	cmp	al,vfVar
	je	@@3
	mov	bx,ffConst
@@3:	call	AsmUseUnit
@@4:	mov	ax,es:[di].vsOffset
	cwd
	jmp	short @@6
@@5:	mov	ax,es:[di].vsAddress.Offs
	mov	dx,es:[di].vsAddress.Segm
@@6:	test	es:[di].vsFlags,vfAddress
	jnz	@@7
	mov	si,es:[di].vsType.Segm
	mov	di,es:[di].vsType.Offs
	mov	es,es:[si]
	jmp	_AsmType
@@7:	mov	si,4
	xor	di,di
	mov	es,di
	ret
AsmVar	endp

AsmUnit	proc	near
	xor	si,si
	mov	es,es:[di].usAddress
	xor	di,di
	ret
AsmUnit	endp

AsmSeg	proc	near
	xor	cx,cx
	mov	bx,es:[di]
	mov	es,Dictionary.Segm
	call	AsmUseUnit
	mov	si,0fff0h
	xor	di,di
	mov	es,di
	ret
AsmSeg	endp

AsmConst	proc	near
	push	es di
	mov	si,es:[di].csType.Segm
	mov	di,es:[di].csType.Offs
	mov	es,es:[si]
	mov	al,es:[di].tdType
	pop	di es
	cmp	al,ttInteger
	jae	@@1
	cmp	al,ttPointer
	jne	AsmError
@@1:	mov	ax,es:[di].csValue.W0
	mov	dx,es:[di].csValue.W2
	xor	si,si
	xor	di,di
	mov	es,di
	ret
AsmConst	endp

AsmProc	proc	near
	test	es:[di].psFlags,pfInline
	jnz	AsmError
	mov	cx,es:[di].psProcMap
	xor	bx,bx
	call	AsmUseUnit
	mov	si,-1
	test	es:[di].psFlags,pfFar
	jz	@@1
	dec	si
@@1:	xor	di,di
	mov	es,di
	ret
AsmProc	endp

AsmError	proc	near
	mov	ax,160
	stc
	ret
AsmError	endp

AsmLoc	proc	near
	mov	al,es:[di]
	mov	es,Dictionary.Segm
	mov	di,CurProc
	or	di,di
	jz	AsmError
	cmp	al,1
	jb	@@2
	je	@@3
	mov	bx,es:[di].psType.ptResult.Offs
	or	bx,bx
	jz	AsmError
	mov	cl,es:[di].psFlags
	mov	di,es:[di].psType.ptResult.Segm
	mov	es,es:[di]
	mov	ax,ParamsBottom
	mov	si,4
	cmp	es:[bx].tdType,ttString
	je	@@1
	test	cl,pfAssembler
	jnz	AsmError
	mov	ax,ProcResult
	mov	si,es:[bx].tdSizeOf
@@1:	mov	cx,-3
	mov	bx,-1
	jmp	short @@5
@@2:	mov	ax,LocalsSize
	and	ax,0fffeh
	neg	ax
	jmp	short @@4
@@3:	mov	ax,ParamsSize
@@4:	xor	si,si
@@5:	cwd
	xor	di,di
	mov	es,di
	ret
AsmLoc	endp

AsmIdent	proc	near
	cmp	IdentBuf[1],'@'
	je	@@3
	mov	ax,es
	or	ax,di
	jz	@@2
	or	di,di
	jz	@@1
	mov	si,di
	Invoke	SearchField
	jnz	@@2
	ret
@@1:	mov	di,es:uhInterface
	Invoke	SearchHash
	jz	@@4
@@2:	Chain	SearchSymbol
@@3:	lea	di,@@5
	push	cs
	pop	es
	Invoke	SearchHash
	jz	@@4
	mov	es,Dictionary.Segm
	mov	di,SaveDictionary
	Invoke	SearchHash
	jz	@@4
	mov	ax,2
	mov	si,SaveDictionary
	Invoke	AddIdent
	mov	al,t_Label
	mov	es:[bx].seType,al
	cmp	al,al
@@4:	ret
@@5	label	word
	hash	1
	hent	@CODE,t_@Seg
	dw	ffCode
	hent	@DATA,t_@Seg
	dw	ffData
	hent	@LOCALS,t_@Loc
	db	0
	hent	@PARAMS,t_@Loc
	db	1
	hent	@RESULT,t_@Loc
	db	2
	hend
AsmIdent	endp

AsmUseUnit	proc	near
	push	ax
	mov	ax,es
	push	es di bx
	Invoke	PutUseUnit
	pop	bx di es
	or	bx,ax
	pop	ax
	ret
AsmUseUnit	endp

GetAsmLabel	proc	far
	cld
	mov	bx,sp
	les	di,ss:[bx+4]
	Invoke	CalcHash
	xor	di,di
	mov	es,di
	call	AsmIdent
	jnz	@@2
	cmp	al,t_Label
	jne	@@2
	Invoke	GetHash
	cmp	di,si
	jb	@@3
	cmp	es:[di].lsLink,0
	jne	@@4
	push	es di
	mov	ax,3
	Invoke	GetStmtMem
	mov	al,12
	stosb
	pop	bx es
	mov	es:[bx],di
	xor	ax,ax
@@1:	ret	4
@@2:	mov	ax,3
	jmp	@@1
@@3:	mov	ax,80
	jmp	@@1
@@4:	mov	ax,81
	jmp	@@1
GetAsmLabel	endp

EmitByte	proc	far
	cld
	mov	ax,2
	Invoke	GetStmtMem
	mov	bx,sp
	mov	al,4
	mov	ah,ss:[bx+4]
	stosw
	xor	ax,ax
	ret	2
EmitByte	endp

EmitFixup	proc	far
	cld
	mov	ax,7
	Invoke	GetStmtMem
	mov	bx,sp
	mov	dx,ss:[bx+10]
	mov	ch,ss:[bx+12]
	mov	cl,4
	shl	ch,cl
	or	dh,ch
	mov	cx,ss:[bx+8]
	mov	ax,dx
	and	ax,ffCode or ffData or ffConst
	cmp	ax,ffCode
	mov	al,14
	jne	@@1
	jcxz	@@1
	mov	al,16
@@1:	stosb
	xchg	ax,dx
	stosw
	xchg	ax,cx
	stosw
	mov	ax,ss:[bx+4]
	stosw
	xor	ax,ax
	ret	10
EmitFixup	endp

EmitJump	proc	far
	cld
	mov	ax,8
	Invoke	GetStmtMem
	mov	bx,sp
	mov	ax,ss:[bx+6]
	and	ax,ffCode or ffData or ffConst
	cmp	ax,ffCode
	jne	@@2
	push	di
	mov	al,8
	mov	ah,ss:[bx+8]
	stosw
	mov	ax,ss:[bx+4]
	stosw
	pop	ax
	xchg	ax,LabelChain
	stosw
	xor	ax,ax
@@1:	ret	6
@@2:	mov	ax,160
	jmp	@@1
EmitJump	endp

EmitFloat	proc	far
	cld
	mov	bx,sp
	mov	al,ss:[bx+8]
	mov	ah,ss:[bx+6]
	cmp	byte ptr ss:[bx+4],0
	jne	@@2
	cmp	al,9bh
	je	@@1
	or	ah,ah
	jz	@@5
	xchg	al,ah
	jmp	short @@3
@@1:	Invoke	PutFwait
	jmp	short @@6
@@2:	push	ax
	Invoke	PutEmulInt
	pop	ax
	or	ah,ah
	jz	@@4
	sub	ah,26h
	mov	cl,3
	shl	ah,cl
	xor	ah,al
	mov	al,3ch
@@3:	Invoke	PutWord
	jmp	short @@6
@@4:	sub	al,0a4h
@@5:	Invoke	PutByte
@@6:	xor	ax,ax
	ret	6
EmitFloat	endp

	end