lex.asm

Turbo Pascal 6.0编译器源码

	mov	ax,cs:DirValues[bx]
	or	ax,ax
	jz	@@4
	mov	dx,ax
	and	ax,not coGlobal
	cmp	byte ptr [si],'+'
	jne	@@2
	or	GlobalOptions,ax
	jmp	short @@3
@@2:	cmp	byte ptr [si],'-'
	jne	@@4
	not	ax
	and	GlobalOptions,ax
@@3:	and	dx,coGlobal
	and	dx,GlobalOptions
	jnz	DirError
	inc	si
	cmp	byte ptr [si],','
	je	@@1
	jmp	SkipComment
@@4:	jmp	cs:DirProcs[bx]
ProcessComment	endp

DirError	proc	near
	mov	ax,17
	Chain	CompileError
DirError	endp

DefineDir	proc	near
	call	GetOneWord
	call	AddDefine
	jmp	SkipComment
DefineDir	endp

ElseDir	proc	near
	mov	di,FileStackPtr
	cmp	[di].fsNestLevel,0
	je	@@2
	push	di
	call	SkipComment
	call	SkipIfDef
	pop	di
	jz	@@1
	dec	[di].fsNestLevel
@@1:	ret
@@2:	mov	ax,128
	Chain	CompileError
ElseDir	endp

EndIfDir	proc	near
	mov	di,FileStackPtr
	cmp	[di].fsNestLevel,0
	je	@@1
	dec	[di].fsNestLevel
	jmp	SkipComment
@@1:	mov	ax,128
	Chain	CompileError
EndIfDir	endp

IDir	proc	near
	call	GetFileName
	call	SkipComment
	mov	di,FileStackPtr
	mov	[di].fsTextPos,si
	mov	TextPos,si
	mov	ax,fePas
	lea	dx,FileNameBuf
	Invoke	ConvertName
	mov	al,fdIncludeDir
	lea	dx,FileNameBuf
	call	AddToSourceList
	push	ax
	mov	ax,fdIncludeDir*256
	lea	dx,FileNameBuf
	Invoke	ConvertName
	pop	ax
	lea	dx,FileNameBuf
	call	AddToFileStack
	call	MarkFileTime
	mov	di,FileStackPtr
	mov	si,[di].fsTextPos
	ret
IDir	endp

IfDefDir	proc	near
	call	GetOneWord
	call	SearchDefine
_IfDef	label	near
	push	ax
	call	SkipComment
	pop	ax
	mov	di,FileStackPtr
	inc	[di].fsNestLevel
	or	ax,ax
	jnz	@@1
	push	di
	call	SkipIfDef
	pop	di
	jz	@@1
	dec	[di].fsNestLevel
@@1:	ret
IfDefDir	endp

IfNDefDir	proc	near
	call	GetOneWord
	call	SearchDefine
	not	ax
	jmp	_IfDef
IfNDefDir	endp

IfOptDir	proc	near
	call	ParseString
	call	SearchDirective
	jc	@@2
	mov	ax,cs:DirValues[bx]
	or	ax,ax
	jz	@@2
	and	ax,not coGlobal
	mov	dx,GlobalOptions
	cmp	byte ptr [si],'+'
	je	@@1
	cmp	byte ptr [si],'-'
	jne	@@2
	not	dx
@@1:	and	ax,dx
	jmp	_IfDef
@@2:	jmp	DirError
IfOptDir	endp

LDir	proc	near
	call	GetFileName
	mov	ax,feObj
	lea	dx,FileNameBuf
	Invoke	ConvertName
	mov	al,fdObjectDir
	lea	dx,FileNameBuf
	push	si
	call	AddToSourceList
	pop	si
	jmp	SkipComment
LDir	endp

MDir	proc	near
	call	GetInt
	jc	@@1
	or	dx,dx
	jnz	@@1
	cmp	ax,1024
	jb	@@1
	cmp	ax,65520
	ja	@@1
	mov	StackSize,ax
	call	GetPara
	jc	@@1
	cmp	ax,40960
	ja	@@1
	mov	MinHeapSize,ax
	call	GetPara
	jc	@@1
	cmp	ax,MinHeapSize
	jb	@@1
	cmp	ax,40960
	ja	@@1
	mov	MaxHeapSize,ax
	jmp	SkipComment
@@1:	jmp	DirError
MDir	endp

ODir	proc	near
	cmp	ProgramSection,0
	jge	@@1
	test	CompilerFlags.B0,cfDisk
	jz	@@2
	call	GetOneWord
	push	si
	lea	bx,FileNameBuf
	call	_FindUnitName
	jnz	@@3
	test	es:uhFlags,ufOverlay
	jz	@@4
	mov	es:uhOverlayLength,-1
	pop	si
	jmp	SkipComment
@@1:	mov	ax,17
	Chain	CompileError
@@2:	mov	ax,141
	Chain	CompileError
@@3:	mov	ax,3
	Chain	CompileError
@@4:	mov	ax,144
	Chain	CompileError
ODir	endp

UndefDir	proc	near
	call	GetOneWord
	call	DeleteDefine
	jmp	SkipComment
UndefDir	endp

AddDefine	proc	near
	call	SearchDefine
	or	ax,ax
	jnz	@@1
	push	si
	lea	si,FileNameBuf
	mov	cl,[si]
	xor	ch,ch
	inc	cx
	mov	ax,DefinesPtr
	mov	di,ax
	add	ax,cx
	cmp	ax,offset DefinesBuf+1024
	ja	@@2
	mov	DefinesPtr,ax
	rep	movsb
	pop	si
@@1:	ret
@@2:	mov	ax,127
	Chain	CompileError
AddDefine	endp

DeleteDefine	proc	near
	call	SearchDefine
	or	ax,ax
	jz	@@1
	push	si
	mov	si,di
	lodsb
	xor	ah,ah
	add	si,ax
	mov	cx,DefinesPtr
	sub	cx,si
	rep	movsb
	mov	DefinesPtr,di
	pop	si
@@1:	ret
DeleteDefine	endp

SearchDefine	proc	near
	push	si
	mov	di,SaveDefinesPtr
	push	ds
	pop	es
	xor	ax,ax
@@1:	cmp	di,DefinesPtr
	je	@@3
	mov	cl,[di]
	xor	ch,ch
	inc	cx
	push	cx di
	lea	si,FileNameBuf
	repe	cmpsb
	pop	di cx
	jz	@@2
	add	di,cx
	jmp	@@1
@@2:	dec	ax
@@3:	pop	si
	ret
SearchDefine	endp

SkipComment	proc	near
	cmp	StartToken,'{'
	jne	@@3
@@1:	lodsb
	or	al,al
	jz	@@2
	cmp	al,'}'
	jne	@@1
	ret
@@2:	call	GetChar
	jnz	@@1
	jmp	short @@6
@@3:	xor	ah,ah
@@4:	mov	ah,al
	lodsb
	or	al,al
	jz	@@5
	cmp	ax,'*)'
	jne	@@4
	ret
@@5:	call	GetChar
	jnz	@@3
@@6:	mov	ax,10
	Chain	CompileError
SkipComment	endp

SkipIfDef	proc	near
	xor	dl,dl
@@1:	xor	dh,dh
@@2:	mov	ax,[si]
	or	al,al
	jz	@@4
	cmp	al,''''
	je	@@5
	or	dh,dh
	jnz	@@3
	cmp	al,'{'
	je	@@7
	cmp	ax,'*('
	je	@@6
@@3:	inc	si
	jmp	@@2
@@4:	push	dx
	call	GetChar
	pop	dx
	jnz	@@1
	mov	ax,129
	Chain	CompileError
@@5:	not	dh
	jmp	@@3
@@6:	inc	si
@@7:	inc	si
	mov	StartToken,al
	cmp	byte ptr [si],'$'
	jne	@@8
	inc	si
	push	dx
	call	SearchDirective
	pop	dx
	jc	@@8
	mov	al,bl
	mov	cx,100h
	cmp	al,6*2			; $ELSE
	nop
	nop
	je	@@9
	mov	cx,1ffh
	cmp	al,7*2			; $ENDIF
	nop
	nop
	je	@@9
	mov	cx,1
	cmp	al,11*2			; $IFDEF
	nop
	nop
	je	@@9
	cmp	al,12*2			; $IFNDEF
	nop
	nop
	je	@@9
	cmp	al,13*2			; $IFOPT
	nop
	nop
	je	@@9
@@8:	xor	cx,cx
@@9:	push	cx dx
	call	SkipComment
	pop	dx cx
	or	ch,ch
	jz	@@10
	or	dl,dl
	jz	@@11
@@10:	add	dl,cl
	jmp	@@1
@@11:	or	cl,cl
	ret
SkipIfDef	endp

SearchDirective	proc	near
	lea	di,Directives
	mov	TextPos,si
	call	GetWord
	push	cs
	pop	es
	xor	bx,bx
@@1:	mov	cl,es:[di]
	xor	ch,ch
	jcxz	@@2
	inc	cx
	push	si
	lea	si,FileNameBuf
	repe	cmpsb
	pop	si
	je	@@3
	add	di,cx
	inc	bx
	inc	bx
	jmp	@@1
@@2:	stc
@@3:	ret
SearchDirective	endp

GetOneWord	proc	near
	call	ParseString
	mov	TextPos,si
	call	GetWord
	cmp	FileNameBuf[0],0
	je	@@1
	ret
@@1:	mov	ax,2
	Chain	CompileError
GetOneWord	endp

GetWord	proc	near
	xor	bx,bx
	mov	al,[si]
@@1:	cmp	al,'_'
	je	@@2
	and	al,0dfh
	cmp	al,'A'
	jb	@@3
	cmp	al,'Z'
	ja	@@3
@@2:	inc	si
	inc	bx
	mov	FileNameBuf[bx],al
	cmp	bx,63
	jz	@@3
	mov	al,[si]
	cmp	al,'0'
	jb	@@3
	cmp	al,'9'
	jbe	@@2
	jmp	@@1
@@3:	mov	FileNameBuf[0],bl
	ret
GetWord	endp

GetFileName	proc	near
	call	ParseString
	mov	TextPos,si
	xor	bx,bx
@@1:	mov	al,[si]
	cmp	al,' '
	jbe	@@3
	cmp	al,'*'
	je	@@3
	cmp	al,'}'
	je	@@3
	cmp	al,'a'
	jb	@@2
	cmp	al,'z'
	ja	@@2
	sub	al,'a'-'A'
@@2:	mov	FileNameBuf[bx],al
	inc	si
	inc	bx
	cmp	bx,79
	jne	@@1
@@3:	mov	FileNameBuf[bx],0
	ret
GetFileName	endp

GetPara	proc	near
	call	GetInt
	jc	@@2
	add	ax,15
	adc	dx,0
	jc	@@2
	mov	cx,4
@@1:	shr	dx,1
	rcr	ax,1
	loop	@@1
	or	dx,dx
	jz	@@2
	stc
@@2:	ret
GetPara	endp

GetInt	proc	near
	call	ParseString
	mov	TextPos,si
	Chain	Str2Long
GetInt	endp

ParseString	proc	near
@@1:	mov	al,[si]
	or	al,al
	jz	@@3
	cmp	al,' '
	jbe	@@2
	cmp	al,','
	je	@@2
	cmp	al,';'
	jne	@@3
@@2:	inc	si
	jmp	@@1
@@3:	ret
ParseString	endp

Directives	db	1,'A'
		db	1,'B'
		db	4,'CODE'
		db	1,'D'
		db	6,'DEFINE'
		db	1,'E'
		db	4,'ELSE'
		db	5,'ENDIF'
		db	1,'F'
		db	1,'G'
		db	1,'I'
		db	5,'IFDEF'
		db	6,'IFNDEF'
		db	5,'IFOPT'
		db	1,'L'
		db	1,'M'
		db	1,'N'
		db	1,'O'
		db	1,'R'
		db	1,'S'
		db	5,'UNDEF'
		db	1,'V'
		db	1,'W'
		db	1,'X'
		db	0

DirValues	dw	coWordAlign+coGlobal	; $A
		dw	coBooleanEval		; $B
		dw	0
		dw	coDebugInfo+coGlobal	; $D
		dw	0
		dw	coEmulation+coGlobal	; $E
		dw	0
		dw	0
		dw	coForceFarCalls		; $F
		dw	co286Code		; $G
		dw	coIOChk			; $I
		dw	0
		dw	0
		dw	0
		dw	coLocalSymbols+coGlobal	; $L
		dw	0
		dw	co8087+coGlobal		; $N
		dw	coOverlayCode+coGlobal	; $O
		dw	coRangeChk		; $R
		dw	coStackChk		; $S
		dw	0
		dw	coVarStringChk		; $V
		dw	coWinFrame		; $W
		dw	coExtSyntax+coGlobal	; $X

DirProcs	dw	DirError
		dw	DirError
		dw	SkipComment		; $CODE
		dw	DirError
		dw	DefineDir		; $DEFINE
		dw	DirError
		dw	ElseDir			; $ELSE
		dw	EndIfDir		; $ENDIF
		dw	DirError
		dw	DirError
		dw	IDir			; $I
		dw	IfDefDir		; $IFDEF
		dw	IfNDefDir		; $IFNDEF
		dw	IfOptDir		; $IFOPT
		dw	LDir			; $L
		dw	MDir			; $M
		dw	DirError
		dw	ODir			; $O
		dw	SkipComment		; $R
		dw	DirError
		dw	UndefDir		; $UNDEF
		dw	DirError
		dw	DirError
		dw	DirError

GetChar	proc	near
	mov	bx,FileStackPtr
	mov	ax,[bx].fsLineLength
	cwd
	add	[bx].fsFilePos.W0,ax
	adc	[bx].fsFilePos.W2,dx
	mov	cx,128
	xor	dx,dx
	mov	si,SourceBufPtr
	lea	di,[bx].fsCurrentLine
	push	ds
	pop	es
	mov	bx,SourceBufEnd
@@1:	cmp	si,bx
	je	@@5
@@2:	lodsb
	inc	dx
	cmp	al,' '
	jb	@@4
@@3:	stosb
	loop	@@1
	dec	di
	call	@@6
	dec	di
	mov	TextPos,di
	mov	ax,11
	Chain	CompileError
@@4:	cmp	al,0dh
	je	@@1
	cmp	al,0ah
	je	@@6
	or	al,al
	jz	@@1
	cmp	al,1ah
	jne	@@3
	dec	si
	dec	dx
	jmp	short @@6
@@5:	push	cx dx
	lea	ax,SourceBuffer
	mov	dx,ds
	lea	cx,SourceBuffer[1024]
	sub	cx,ax
	mov	bx,FileStackPtr
	mov	bx,[bx].fsFileHandle
	Invoke	ReadHandle
	pop	dx cx
	lea	si,SourceBuffer
	mov	bx,si
	add	bx,ax
	mov	SourceBufEnd,bx
	or	ax,ax
	jnz	@@2
@@6:	xor	al,al
	stosb
	mov	bx,FileStackPtr
	mov	[bx].fsLineLength,dx
	or	dx,dx
	jz	@@7
	inc	[bx].fsLineNumber
	add	TotalLines.W0,1
	adc	TotalLines.W2,0
@@7:	mov	SourceBufPtr,si
	lea	si,[bx].fsCurrentLine
	mov	TextPos,si
	or	dx,dx
	ret
GetChar	endp

AddToFileStack	proc	near
	cmp	InStmtPart,0
	jne	@@1
	mov	di,FileStackPtr
	cmp	di,offset FileStack
	je	@@2
	sub	di,size TFileStack
	mov	[di].fsNameEntry,ax
	push	di
	mov	si,dx
	lea	di,[di].fsName
	call	CopyDSCStr
	pop	di
	Invoke	OpenHandle
	mov	[di].fsFileHandle,ax
	lea	ax,[di].fsName
	mov	[di].fsFileName,ax
	lea	ax,[di].fsCurrentLine
	mov	[di].fsTextPos,ax
	mov	TextPos,ax
	xor	ax,ax
	mov	[di].fsLineNumber,ax
	mov	[di].fsFilePos.W0,ax
	mov	[di].fsFilePos.W2,ax
	mov	[di].fsLineLength,ax
	mov	[di].fsCurrentLine[0],al
	mov	[di].fsNestLevel,ax
	mov	SourceBufPtr,ax
	mov	SourceBufEnd,ax
	mov	FileStackPtr,di
	Chain	StartFileInfo
@@1:	mov	ax,118
	Chain	CompileError
@@2:	mov	ax,9
	Chain	CompileError
AddToFileStack	endp

MarkFileTime	proc	near
	mov	di,FileStackPtr
	mov	bx,[di].fsFileHandle
	Invoke	HandleTime
	mov	bx,[di].fsNameEntry
	mov	es,SourceList.Segm
	mov	es:[bx].slTimeStamp.W0,ax
	mov	es:[bx].slTimeStamp.W2,dx
	ret
MarkFileTime	endp

PopFileStack	proc	near
	cmp	InStmtPart,0
	jne	@@2
	mov	di,FileStackPtr
	cmp	di,SaveFileStack
	je	@@2
	cmp	[di].fsNestLevel,0
	jne	@@3
	Invoke	EndFileInfo
	mov	bx,[di].fsFileHandle
	Invoke	CloseHandle
	add	di,size TFileStack
	mov	FileStackPtr,di
	cmp	di,offset FileStack[15*size TFileStack]
	je	@@1
	mov	ax,[di].fsTextPos
	mov	TextPos,ax
	mov	ax,[di].fsFilePos.W0
	mov	dx,[di].fsFilePos.W2
	add	ax,[di].fsLineLength
	adc	dx,0
	xor	cx,cx
	mov	bx,[di].fsFileHandle
	Invoke	SeekHandle
	xor	ax,ax
	mov	SourceBufPtr,ax
	mov	SourceBufEnd,ax
	Chain	StartFileInfo
@@1:	ret
@@2:	mov	ax,10
	Chain	CompileError
@@3:	mov	ax,129
	Chain	CompileError
PopFileStack	endp

UpperCase	proc	near
	cmp	al,'a'
	jb	@@1
	cmp	al,'z'
	ja	@@1
	sub	al,'a'-'A'
@@1:	ret
UpperCase	endp

CopyPasStr	proc	near
	call	Swap
	call	_CopyPasStr
Swap	label	near
	xchg	si,di
	push	ds es
	pop	ds es
	ret
CopyPasStr	endp

CopyDSPasStr	proc	near
	push	ds
	pop	es
_CopyPasStr	label	near
	lodsb
	stosb
	mov	cl,al
	xor	ch,ch
	rep	movsb
	ret
CopyDSPasStr	endp

CopyCStr	proc	near
	call	Swap
	call	_CopyCStr
	jmp	Swap
CopyCStr	endp

CopyDSCStr	proc	near
	push	ds
	pop	es
_CopyCStr	label	near
@@1:	lodsb
	stosb
	or	al,al
	jnz	@@1
	ret
CopyDSCStr	endp

Pas2C	proc	near
	call	Swap
	call	_Pas2C
	jmp	Swap
Pas2C	endp

DSPas2C	proc	near
	push	ds
	pop	es
_Pas2C	label	near
	lodsb
	mov	cl,al
	xor	ch,ch
	rep	movsb
	xor	al,al
	stosb
	ret
DSPas2C	endp

CompareStrings	proc	near
	lodsb
	mov	ah,es:[di]
	inc	di
	mov	cl,al
	cmp	cl,ah
	jbe	@@1
	mov	cl,ah
@@1:	xor	ch,ch
	jcxz	@@2
	repe	cmpsb
	jne	@@3
@@2:	cmp	al,ah
@@3:	ret
CompareStrings	endp

MoveBlock	proc	near
	shr	cx,1
	rep	movsw
	jnc	@@1
	movsb
@@1:	ret
MoveBlock	endp

MoveBlockRev	proc	near
	std
	add	si,cx
	add	di,cx
	dec	si
	dec	di
	shr	cx,1
	jnc	@@1
	movsb
@@1:	dec	si
	dec	di
	rep	movsw
	cld
	ret
MoveBlockRev	endp

AllocTempBuf	proc	near
	mov	bx,TempBufPtr
	add	ax,bx
	cmp	ax,offset TempBuffer[1024]
	jbe	@@1
	sub	ax,bx
	lea	bx,TempBuffer
	add	ax,bx
@@1:	mov	TempBufPtr,ax
	ret
AllocTempBuf	endp

AddToSourceList	proc	near
	push	ax
	mov	si,dx
@@1:	lodsb
	or	al,al
	jnz	@@1
	mov	cx,si
	sub	cx,dx
	mov	ax,cx
	add	ax,size TSourceList-1
	lea	bx,SourceList
	Invoke	GetMemory
	pop	ax
	push	di
	stosb
	xor	ax,ax
	stosw
	stosw
	stosw
	dec	cx
	mov	al,cl
	stosb
	mov	si,dx
	rep	movsb
	pop	ax
	ret
AddToSourceList	endp

KeyWords	label	word
	hash	16
	hent	PACKED,tPacked
	hent	PROGRAM,tProgram
	hent	IMPLEMENTATION,tImplementation
	hent	INTERFACE,tInterface
	hent	UNIT,tUnit
	hent	USES,tUses
	hent	LABEL,tLabel
	hent	GOTO,tGoto
	hent	ASM,tAsm
	hent	INLINE,tInline
	hent	DESTRUCTOR,tDestructor
	hent	CONSTRUCTOR,tConstructor
	hent	OBJECT,tObject
	hent	SET,tSet
	hent	FILE,tFile
	hent	IN,tIn
	hent	XOR,tXor
       	hent	SHR,tShr
	hent	SHL,tShl
	hent	MOD,tMod
	hent	DIV,tDiv
	hent	NIL,tNil
	hent	NOT,tNot
	hent	OR,tOr
	hent	AND,tAnd
	hent	WITH,tWith
	hent	CASE,tCase
	hent	STRING,tString
	hent	RECORD,tRecord
	hent	OF,tOf
	hent	ARRAY,tArray
	hent	CONST,tConst
	hent	TYPE,tType
	hent	VAR,tVar
	hent	DOWNTO,tDownto
	hent	ELSE,tElse
	hent	UNTIL,tUntil
	hent	REPEAT,tRepeat
	hent	DO,tDo
	hent	WHILE,tWhile
	hent	TO,tTo
	hent	FOR,tFor
	hent	THEN,tThen
	hent	IF,tIf
	hent	FUNCTION,tFunction
	hent	PROCEDURE,tProcedure
	hent	END,tEnd
	hent	BEGIN,tBegin
	hend

ProcDirs	label	word
	hash	4
	hent	ABSOLUTE,tAbsolute
	hent	ASSEMBLER,tAssembler
	hent	EXTERNAL,tExternal
	hent	FAR,tFar
	hent	FORWARD,tForward
	hent	INTERRUPT,tInterrupt
	hent	NEAR,tNear
	hent	VIRTUAL,tVirtual
	hend

RegVars	label	word
	hash	4
	hent	AL,t_Reg
	db	rAX+rByte
	hent	AH,t_Reg
	db	rAX+1+rByte
	hent	BL,t_Reg
	db	rBX+rByte
	hent	BH,t_Reg
	db	rBX+1+rByte
	hent	CL,t_Reg
	db	rCX+rByte
	hent	CH,t_Reg
	db	rCX+1+rByte
	hent	DL,t_Reg
	db	rDX+rByte
	hent	DH,t_Reg
	db	rDX+1+rByte
	hent	AX,t_Reg
	db	rAX
	hent	BX,t_Reg
	db	rBX
	hent	CX,t_Reg
	db	rCX
	hent	DX,t_Reg
	db	rDX
	hent	BP,t_Reg
	db	rBP
	hent	SI,t_Reg
	db	rSI
	hent	DI,t_Reg
	db	rDI
	hent	DS,t_Reg
	db	rDS
	hent	ES,t_Reg
	db	rES
	hent	IP,t_Reg
	db	rIP
	hent	CS,t_Reg
	db	rCS
	hent	FL,t_Reg
	db	rFL
	hent	SP,t_Reg
	db	rSP
	hent	SS,t_Reg
	db	rSS
	hend

	end