asmlex.inc

Turbo Pascal 6.0编译器源码

NeedToken	proc	near
	cmp	al,dh
	je	GetToken
	jmp	SyntaxErr
NeedToken	endp

CheckToken	proc	near
	cmp	al,dh
	je	GetToken
	xor	ax,ax
	ret
CheckToken	endp

GetToken	proc	near
	mov	dh,';'
	cmp	Len,0
	jbe	@@3
	push	si di bx
	call	GetIdent
	cmp	InOpcode,1
	jne	@@1
	call	CheckOpcode
	jnz	@@2
@@1:	call	CheckOper
	jnz	@@2
	call	CheckResWord
	jnz	@@2
	call	CheckNumber
	jnz	@@2
	cmp	InOpcode,1
	je	@@2
	call	CheckSymbol
@@2:	pop	bx di si
@@3:	sub	dh,1
	adc	dh,1
	ret
GetToken	endp

GetChar	proc	near
	inc	TextPtr.Offs
	dec	Len
GetLastChar	label	near
	xor	ax,ax
	cmp	Len,ax
	jbe	@@1
	les	bx,TextPtr
	add	al,es:[bx]
	jz	@@1
	ret
@@1:	mov	Len,ax
	ret
GetChar	endp

_FilterChar	proc	near
@@1:	inc	TextPtr.Offs
	dec	Len
FilterChar	label	near
	call	GetLastChar
	jz	@@2
	cmp	al,' '
	jbe	@@1
	cmp	al,7fh
	jae	@@1
@@2:	ret
_FilterChar	endp

GetIdent	proc	near
	xor	ax,ax
	mov	word ptr IdentBuf[0],ax
	mov	word ptr UpCaseIdent[0],ax
	mov	HashValue,al
	call	FilterChar
	mov	SaveTextPtr,bx
	jz	@@6
	call	CheckLegal
	jnc	@@5
@@1:	mov	si,word ptr IdentBuf[0]
	and	si,0ffh
	cmp	si,' '
	je	@@3
	inc	IdentBuf[0]
	inc	UpCaseIdent[0]
	mov	word ptr IdentBuf[si+1],ax
	cmp	al,'a'
	jb	@@2
	and	al,5fh
@@2:	mov	word ptr UpCaseIdent[si+1],ax
	dec	ax
	add	HashValue,al
@@3:	call	GetChar
	jz	@@4
	call	CheckLegal
	jc	@@1
@@4:	mov	Mode,1
	cmp	word ptr UpCaseIdent[0],'E'*256+3
	jne	@@7
	cmp	word ptr UpCaseIdent[2],'DN'
	je	@@6
	jmp	short @@7
@@5:	mov	Mode,2
	call	CheckStrConst
	jz	@@7
	mov	Mode,0
	inc	IdentBuf[0]
	mov	word ptr IdentBuf[1],ax
	cmp	al,';'
	je	@@6
	cmp	al,'{'
	je	@@6
	xchg	ax,dx
	call	GetChar
	mov	ah,dl
	cmp	ax,'(*'
	jne	@@7
@@6:	mov	Mode,0
	mov	word ptr IdentBuf[0],';'*256+1
	mov	Len,0
	mov	ax,SaveTextPtr
	mov	TextPtr.Offs,ax
@@7:	ret
GetIdent	endp

CheckStrConst	proc	near
	mov	cl,al
	cmp	al,''''
	je	@@1
	cmp	al,'"'
	je	@@1
	ret
@@1:	mov	StringBuf[0],0
	jmp	short @@4
@@2:	mov	si,word ptr StringBuf[0]
	and	si,0ffh
	cmp	si,127
	jne	@@3
	jmp	StringConstErr
@@3:	inc	StringBuf[0]
	mov	StringBuf[si+1],al
@@4:	call	GetChar
	jnz	@@5
	jmp	StringConstErr
@@5:	cmp	al,cl
	jne	@@2
	call	GetChar
	cmp	al,cl
	je	@@2
	xor	ax,ax
	ret
CheckStrConst	endp

CheckLegal	proc	near
	call	CheckLetter
	jnc	CheckDigit
	ret
CheckLegal	endp

CheckDigit	proc	near
	push	ax
	sub	al,'0'+10
	add	al,10
	pop	ax
	ret
CheckDigit	endp

CheckLetter	proc	near
	call	CheckAlpha
	jc	@@1
	cmp	al,'_'
	je	@@1
	cmp	al,'$'
	je	@@1
	cmp	al,'@'
	je	@@1
	cmp	al,'&'
	je	@@1
	cmp	al,'?'
	je	@@1
	clc
	ret
@@1:	stc
	ret
CheckLetter	endp

CheckAlpha	proc	near
	push	ax
	sub	al,'Z'+1
	add	al,'Z'-'A'+1
	jc	@@1
	sub	al,'z'+1-'A'
	add	al,'z'+1-'a'
@@1:	pop	ax
	ret
CheckAlpha	endp

CheckSymbol	proc	near
	lea	bx,IdentBuf
	mov	ax,[bx]
	cmp	ah,'&'
	jne	@@2
	inc	bx
	dec	al
	jnz	@@1
	jmp	SyntaxErr
@@1:	mov	[bx],al
@@2:	push	ss bx
	lea	bx,Symbol
	push	ss bx
	mov	ax,Symbol.sParent.Offs
	mov	Symbol.sScope.Offs,ax
	mov	ax,Symbol.sParent.Segm
	mov	Symbol.sScope.Segm,ax
	call	GetAsmSymbol
	or	ax,ax
	jz	@@3
	jmp	Error
@@3:	mov	ax,Symbol.sScope.Offs
	mov	Symbol.sParent.Offs,ax
	mov	ax,Symbol.sScope.Segm
	mov	Symbol.sParent.Segm,ax
	mov	dh,tSYM
	ret
CheckSymbol	endp

CheckOper	proc	near
	cmp	Mode,0
	jne	@@1
	mov	dx,word ptr IdentBuf
	cmp	dl,1
	je	@@2
@@1:	xor	dx,dx
@@2:	or	dh,dh
	ret
CheckOper	endp

CheckNumber	proc	near
	cmp	Mode,1
	je	@@4
	ja	@@2
@@1:	xor	ax,ax
	ret
@@2:	lea	si,StringBuf
	xor	ax,ax
	xor	di,di
	cwd
	cld
	lodsb
	xchg	ax,cx
	jcxz	@@8
@@3:	and	di,0ffh
	call	@@16
	call	@@16
	lodsb
	mov	dl,al
	loop	@@3
	jmp	short @@8
@@4:	mov	StringBuf[0],0
	xor	cx,cx
	mov	cl,UpCaseIdent[0]
	mov	ax,word ptr UpCaseIdent[1]
	mov	si,1
	cmp	al,'$'
	je	@@5
	dec	si
	call	CheckDigit
	jnc	@@1
	mov	di,cx
	mov	al,UpCaseIdent[di]
	call	CheckDigit
	lea	bx,@@11
	jc	@@6
	dec	cx
	cmp	al,'D'
	je	@@6
	lea	bx,@@9
	cmp	al,'B'
	je	@@6
	lea	bx,@@10
	cmp	al,'O'
	je	@@6
	cmp	al,'H'
	jne	@@20
@@5:	sub	cx,si
	lea	bx,@@12
@@6:	xor	di,di
	xor	dx,dx
@@7:	jcxz	@@8
	dec	cx
	inc	si
	xor	ax,ax
	mov	al,UpCaseIdent[si]
	call	bx
	jmp	@@7
@@8:	mov	Value.W0,dx
	mov	Value.W2,di
	mov	dh,tNUMBER
	or	dh,dh
	ret
@@9:	call	@@19
	sub	al,'2'
	add	al,2
	jmp	short @@14
@@10:	call	@@17
	sub	al,'8'
	add	al,8
	jmp	short @@14
@@11:	call	@@15
	sub	al,'9'+1
	add	al,10
	jmp	short @@14
@@12:	call	@@16
	cmp	al,'9'+1
	jb	@@13
	sub	al,'A'-'9'-1
@@13:	sub	al,'A'-1
	add	al,16
@@14:	jnc	@@20
	add	dx,ax
	adc	di,0
	jc	@@21
	ret
@@15:	push	ax
	call	@@19
	push	di dx
	call	@@18
	pop	ax
	add	dx,ax
	pop	ax
	add	di,ax
	jc	@@21
	pop	ax
	ret
@@16:	call	@@19
@@17:	call	@@19
@@18:	call	@@19
@@19:	add	dx,dx
	adc	di,di
	jc	@@21
	ret
@@20:	jmp	IntConstErr
@@21:	jmp	OutOfRangeErr
CheckNumber	endp

CheckOpcode	proc	near
	call	OpcodeTable
	call	SearchTable
	jz	@@1
	mov	OpcodePtr,di
	mov	dh,tOPCODE
@@1:	ret
CheckOpcode	endp

CheckResWord	proc	near
	call	ResWordTable
	call	SearchTable
	jz	@@1
	mov	dh,cs:[di]
	inc	di
	mov	ax,cs:[di]
	mov	RegNum,ax
	mov	Value.W0,ax
	add	ax,ax
	sbb	ax,ax
	mov	Value.W2,ax
	dec	ax
@@1:	ret
CheckResWord	endp

SearchTable	proc	near
	cmp	Mode,1
	jne	@@2
	cld
	push	cs
	pop	es
	mov	bl,HashValue
	add	bl,bl
	and	bx,es:[di]
	mov	bx,es:[bx+di+2]
	or	bx,bx
	jz	@@2
	lea	ax,UpCaseIdent
	mov	dl,UpCaseIdent[0]
	mov	dh,0
	inc	dx
@@1:	lea	di,[bx+2]
	mov	si,ax
	mov	cx,dx
	repe	cmpsb
	je	@@3
	mov	bx,es:[bx]
	or	bx,bx
	jnz	@@1
@@2:	xor	di,di
@@3:	or	di,di
	ret
SearchTable	endp

LongMul	proc	near
	push	si di
	mov	si,ax
	mov	di,dx
	mul	cx
	push	ax dx
	mov	ax,si
	mul	bx
	xchg	ax,bx
	xchg	ax,di
	mul	cx
	pop	dx
	add	dx,bx
	add	dx,ax
	pop	ax di si
	ret
LongMul	endp

LongDiv	proc	near
	push	si di bp
	mov	si,cx
	or	si,bx
	jnz	@@1
	jmp	ZeroDivErr
@@1:	or	bx,bx
	pushf
	jns	@@2
	neg	cx
	adc	bx,0
	neg	bx
@@2:	or	dx,dx
	pushf
	jns	@@3
	neg	ax
	adc	dx,0
	neg	dx
@@3:	mov	si,cx
	mov	di,bx
	xor	cx,cx
	xor	bx,bx
	mov	bp,33
@@4:	rcl	cx,1
	rcl	bx,1
	sub	cx,si
	sbb	bx,di
	jnc	@@5
	add	cx,si
	adc	bx,di
@@5:	cmc
	rcl	ax,1
	rcl	dx,1
	dec	bp
	jnz	@@4
	popf
	jns	@@6
	neg	cx
	adc	bx,0
	neg	bx
	popf
	jns	@@7
	jmp	short @@8
@@6:	popf
	jns	@@8
@@7:	neg	ax
	adc	dx,0
	neg	dx
@@8:	pop	bp di si
	ret
LongDiv	endp