stdproc.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	.code	compiler_text

	public	StdProcedure
	public	_New

StdProcedure	proc	near
	Invoke	GetToken
	les	bx,CurrentSymbol
	mov	bx,es:[bx]
	and	bx,not(fnNeed8087+fnImmediate)
	mov	ax,cs:@@1[bx+2]
	jmp	cs:@@1[bx]
@@1	dw	_NewProc,0
	dw	_Write,_WriteEnd
	dw	_Write,_WriteLine
	dw	_Read,_ReadEnd
	dw	_Read,_ReadLine
	dw	_Dispose,0
	dw	_Mark,_MarkPtr
	dw	_Mark,_ReleasePtr
	dw	_Insert,0
	dw	_Delete,0
	dw	_Assign,0
	dw	_Reset,_ResetFile
	dw	_Reset,_RewriteFile
	dw	_Close,0
	dw	_Seek,0
	dw	_Erase,0
	dw	_Rename,0
	dw	_Halt,_HaltTurbo
	dw	_Exit,0
	dw	_GetMem,0
	dw	_FreeMem,0
	dw	_Truncate,0
	dw	_FillChar,0
	dw	_Move,0
	dw	_Randomize,0
	dw	_Str,0
	dw	_Val,0
	dw	_GetDir,0
	dw	_ChDir,_DirSet
	dw	_ChDir,_DirCreate
	dw	_ChDir,_DirRemove
	dw	_Append,_AppendText
	dw	_Append,_FlushText
	dw	_Inc,0
	dw	_Inc,828h
	dw	_BlockRead,_ReadBlock
	dw	_BlockRead,_WriteBlock
	dw	_SetTextBuf,0
	dw	_Halt,_HaltError
	dw	_Fail,0
StdProcedure	endp

	Loc	_Code,byte,<size TExpr>
_Halt	proc	near
	Entry
	push	ax
	Invoke	CheckOParen
	jnz	@@1
	lea	di,_Code
	Invoke	GetIntExpr
	Invoke	CastWord
	Invoke	NeedCParen
	Invoke	UseExpr
	mov	al,lvAX
	Invoke	LoadValue
	jmp	short @@2
@@1:	mov	ax,0c031h		; xor	ax,ax
	Invoke	PutWord
@@2:	pop	ax
	Invoke	PutSystemCall
	Invoke	DoneGoal
	Exit
_Halt	endp

_Exit	proc	near
	mov	al,cdAlways
	lea	bx,ExitChain
	Invoke	PutJmp
	Chain	DoneGoal
_Exit	endp

_Fail	proc	near
	mov	es,Dictionary.segm
	mov	di,CurProc
	test	es:[di].psFlags,pfConstructor
	jz	@@1
	mov	al,cdAlways
	lea	bx,FailChain
	Invoke	PutJmp
	Chain	DoneGoal
@@1:	mov	ax,154
	Chain	CompileError
_Fail	endp

_Inc	proc	near
	Loc	X,byte,<size TExpr>
	Loc	N,byte,<size TExpr>
	Entry
	push	ax
	Invoke	NeedOParen
	lea	di,X
	Invoke	GetReference
	les	bx,[di].exType
	mov	cx,1
	cmp	es:[bx].tdType,ttInteger
	jae	@@1
	cmp	es:[bx].tdType,ttPointer
	jne	@@2
	mov	si,es:[bx].ptBase.Segm
	mov	bx,es:[bx].ptBase.Offs
	mov	es,es:[si]
	mov	cx,es:[bx].tdSizeOf
	jcxz	@@2
	mov	[di].exModifier,emWord
@@1:	lea	di,N
	Invoke	CheckComma
	jz	@@3
	mov	[di].exCode,0
	mov	[di].exLocation,elImmediate
	mov	[di].exValue.W0,cx
	mov	[di].exValue.W2,0
	jmp	short @@5
@@2:	mov	ax,104
	Chain	CompileError
@@3:	push	cx
	Invoke	GetIntExpr
	Invoke	LoadAddress
	mov	al,X.exModifier
	Invoke	ConvertOrdinal
	pop	cx
	cmp	cx,1
	je	@@5
	cmp	[di].exLocation,elImmediate
	jne	@@4
	mov	ax,[di].exValue.W0
	mul	cx
	mov	[di].exValue.W0,ax
	jmp	short @@5
@@4:	Invoke	UseExpr
	mov	al,lvAX
	Invoke	Scale
	Invoke	DoneExpr
@@5:	Invoke	NeedCParen
	pop	dx
	lea	di,X
	lea	si,N
	Invoke	Increment
	mov	si,di
	Invoke	CastOrdinal
	mov	ax,[di].exCode
	Exit
_Inc	endp

_FillChar	proc	near
	Loc	X,byte,<size TExpr>
	Loc	Count,byte,<size TExpr>
	Loc	Value,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,X
	Invoke	PushReference
	Invoke	NeedComma
	lea	di,Count
	Invoke	GetIntExpr
	Invoke	CastWord
	Invoke	PushValue
	Invoke	NeedComma
	lea	di,Value
	Invoke	GetOrdExpr
	Invoke	CastByte
	Invoke	PushValue
	Invoke	NeedCParen
	mov	ax,X.exCode
	Invoke	UseGoal
	mov	ax,Count.exCode
	Invoke	UseGoal
	mov	ax,Value.exCode
	Invoke	UseGoal
	mov	ax,_FillMem
	Invoke	PutSystemCall
	Invoke	DoneGoal
	Exit
_FillChar	endp

_Move	proc	near
	Loc	Source,byte,<size TExpr>
	Loc	Dest,byte,<size TExpr>
	Loc	Count,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,Source
	Invoke	PushReference
	Invoke	NeedComma
	lea	di,Dest
	Invoke	PushReference
	Invoke	NeedComma
	lea	di,Count
	Invoke	GetIntExpr
	Invoke	CastWord
	Invoke	PushValue
	Invoke	NeedCParen
	mov	ax,Source.exCode
	Invoke	UseGoal
	mov	ax,Dest.exCode
	Invoke	UseGoal
	mov	ax,Count.exCode
	Invoke	UseGoal
	mov	ax,_MoveMem
	Invoke	PutSystemCall
	Invoke	DoneGoal
	Exit
_Move	endp

_Randomize	proc	near
	mov	ax,_InitRand
	Invoke	PutSystemCall
	Chain	DoneGoal
_Randomize	endp

_NewProc	proc	near
	Loc	P,byte,<size TExpr>
	Loc	Init,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,P
	Invoke	GetPtrRef
	lea	di,Init
	Invoke	_New
	Invoke	NeedCParen
	mov	si,di
	lea	di,P
	Invoke	Store
	mov	ax,[di].exCode
	Exit
_NewProc	endp

_New	proc	near
	push	es bx
	mov	si,es:[bx].ptBase.Segm
	mov	bx,es:[bx].ptBase.Offs
	mov	es,es:[si]
	cmp	es:[bx].tdType,ttObject
	jne	@@1
	mov	al,tComma
	Invoke	CheckToken
	jnz	@@1
	xor	ax,ax
	mov	[di].exCode,ax
	mov	[di].exRegsUsed,al
	mov	ax,emNewConstruct+pfConstructor*256
	mov	dx,152
	Invoke	_GetMethod
	Invoke	PutCall
	jmp	short @@2
@@1:	mov	ax,es:[bx].tdSizeOf
	Invoke	PushWord
	mov	ax,_NewPtr
	Invoke	PutSystemCall
	Invoke	DoneExpr
@@2:	pop	[di].exType
	mov	[di].exLocation,elRegister
	mov	[di].exModifier,emLongint
	mov	[di].exRegsUsed,erAll
	mov	[di].exMisc,lvAX
	ret
_New	endp

_Dispose	proc	near
	Loc	P,byte,<size TExpr>
	Loc	Done,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,P
	Invoke	GetPtrExpr
	mov	si,es:[bx].ptBase.Segm
	mov	bx,es:[bx].ptBase.Offs
	mov	es,es:[si]
	cmp	es:[bx].tdType,ttObject
	jne	@@1
	mov	al,tComma
	Invoke	CheckToken
	jnz	@@1
	push	es bx
	Invoke	LoadPtr
	pop	bx es
	mov	ax,emDisposeDestr+pfDestructor*256
	mov	dx,153
	Invoke	_GetMethod
	Invoke	PutCall
	jmp	short @@2
@@1:	push	es:[bx].tdSizeOf
	Invoke	UseExpr
	Invoke	PutPush
	pop	ax
	Invoke	PushWord
	mov	ax,_DisposePtr
	Invoke	PutSystemCall
	Invoke	DoneExpr
@@2:	Invoke	NeedCParen
	mov	ax,[di].exCode
	Exit
_Dispose	endp

_GetMem	proc	near
	Loc	P,byte,<size TExpr>
	Loc	_Size,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,P
	Invoke	GetPtrRef
	Invoke	NeedComma
	lea	di,_Size
	Invoke	GetIntExpr
	Invoke	CastWord
	Invoke	NeedCParen
	Invoke	UseExpr
	Invoke	PutPush
	mov	ax,_NewPtr
	Invoke	PutSystemCall
	Invoke	DoneExpr
	mov	[di].exLocation,elRegister
	mov	[di].exModifier,emLongint
	mov	[di].exRegsUsed,erAll
	mov	[di].exMisc,lvAX
	Invoke	CastPointer
	mov	si,di
	lea	di,P
	Invoke	Store
	mov	ax,[di].exCode
	Exit
_GetMem	endp

_FreeMem	proc	near
	Loc	P,byte,<size TExpr>
	Loc	_Size,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,P
	Invoke	GetPtrExpr
	Invoke	NeedComma
	lea	di,_Size
	Invoke	GetIntExpr
	Invoke	CastWord
	Invoke	NeedCParen
	lea	di,P
	Invoke	UseExpr
	Invoke	PutPush
	lea	di,_Size
	Invoke	UseExpr
	Invoke	PutPush
	mov	ax,_DisposePtr
	Invoke	PutSystemCall
	Invoke	DoneGoal
	Exit
_FreeMem	endp

_Mark	proc	near
	Loc	P,byte,<size TExpr>
	Entry
	push	ax
	Invoke	NeedOParen
	lea	di,P
	Invoke	GetPtrRef
	Invoke	PushAddr
	Invoke	NeedCParen
	mov	ax,P.exCode
	Invoke	UseGoal
	pop	ax
	Invoke	PutSystemCall
	Invoke	DoneGoal
	Exit
_Mark	endp

_Insert	proc	near
	Loc	Source,byte,<size TExpr>
	Loc	S,byte,<size TExpr>
	Loc	Index,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,Source
	Invoke	PushStringExpr
	Invoke	NeedComma
	lea	di,S
	Invoke	PushStringRef
	Invoke	NeedComma
	lea	di,Index
	Invoke	GetIntExpr
	Invoke	CastInt
	Invoke	PushValue
	Invoke	NeedCParen
	mov	ax,Source.exCode
	Invoke	UseGoal
	mov	ax,S.exCode
	Invoke	UseGoal
	les	bx,S.exType
	mov	ax,es:[bx].tdSizeOf
	dec	ax
	Invoke	PushWord
	mov	ax,Index.exCode
	Invoke	UseGoal
	mov	ax,_SInsert
	Invoke	PutSystemCall
	Invoke	DoneGoal
	Exit
_Insert	endp

_Delete	proc	near
	Loc	S,byte,<size TExpr>
	Loc	Index,byte,<size TExpr>
	Loc	Count,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,S
	Invoke	PushStringRef
	Invoke	NeedComma
	lea	di,Index
	Invoke	GetIntExpr
	Invoke	CastInt
	Invoke	PushValue
	Invoke	NeedComma
	lea	di,Count
	Invoke	GetIntExpr
	Invoke	CastInt
	Invoke	PushValue
	Invoke	NeedCParen
	mov	ax,S.exCode
	Invoke	UseGoal
	mov	ax,Index.exCode
	Invoke	UseGoal
	mov	ax,Count.exCode
	Invoke	UseGoal
	mov	ax,_SDelete
	Invoke	PutSystemCall
	Invoke	DoneGoal
	Exit
_Delete	endp

_Str	proc	near
	Loc	X,byte,<size TExpr>
	Loc	_Width,byte,<size TExpr>
	Loc	Decimals,byte,<size TExpr>
	Loc	S,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,X
	Invoke	GetNumExpr
	mov	al,es:[bx].tdType
	cmp	al,ttInteger
	je	@@2
	test	CompilerOptions,co8087
	jz	@@1
	Invoke	ConvReal2Ext
	Invoke	PushExt
	lea	di,_Width
	mov	ax,23
	Invoke	FormatModifier
	lea	di,Decimals
	mov	ax,-1
	Invoke	FormatModifier
	mov	ax,_StrFloat+fnNeed8087
	jmp	short @@3
@@1:	Invoke	ConvExt2Real
	Invoke	PushReal
	lea	di,_Width
	mov	ax,17
	Invoke	FormatModifier
	lea	di,Decimals
	mov	ax,-1
	Invoke	FormatModifier
	mov	ax,_StrReal
	jmp	short @@3
@@2:	Invoke	CastLong
	Invoke	PushValue
	lea	di,_Width
	xor	ax,ax
	Invoke	FormatModifier
	mov	Decimals.exCode,0
	mov	ax,_StrInt
@@3:	push	ax
	Invoke	NeedComma
	lea	di,S
	Invoke	PushStringRef
	Invoke	NeedCParen
	mov	ax,X.exCode
	Invoke	UseGoal
	mov	ax,_Width.exCode
	Invoke	UseGoal
	mov	ax,Decimals.exCode
	Invoke	UseGoal
	mov	ax,S.exCode
	Invoke	UseGoal
	les	bx,S.exType
	mov	ax,es:[bx].tdSizeOf
	dec	ax
	Invoke	PushWord
	pop	ax
	Invoke	PutSystemCall
	Invoke	DoneGoal
	Exit
_Str	endp

_Val	proc	near
	Loc	S,byte,<size TExpr>
	Loc	V,byte,<size TExpr>
	Loc	Code,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,S
	Invoke	PushStringExpr
	Invoke	NeedComma
	lea	di,V
	Invoke	GetReference
	Invoke	CastReal2Ext
	mov	dx,_ValInt
	cmp	al,ttInteger
	je	@@1
	mov	dx,_ValFloat+fnNeed8087
	cmp	al,tt8087
	je	@@1
	mov	dx,_ValReal
	cmp	al,ttReal
	je	@@1
	mov	ax,103
	Chain	CompileError
@@1:	push	ax dx
	Invoke	NeedComma
	lea	di,Code
	Invoke	PushIntRef
	Invoke	NeedCParen
	lea	di,S
	Invoke	UseExpr
	mov	ax,Code.exCode
	Invoke	UseGoal
	pop	ax
	Invoke	PutSystemCall
	Invoke	DoneExpr
	pop	ax
	cmp	al,ttInteger
	je	@@3
	cmp	al,ttReal
	je	@@2
	mov	[di].exLocation,elStack
	mov	[di].exModifier,emExtended
	Invoke	CastExtended
	jmp	short @@4
@@2:	mov	[di].exLocation,elRegister
	mov	[di].exModifier,emReal
	Invoke	CastReal
	jmp	short @@4
@@3:	mov	[di].exLocation,elRegister
	mov	[di].exModifier,emLongint
	mov	[di].exMisc,lvAX
	Invoke	CastLongint
@@4:	mov	[di].exRegsUsed,erAll
	lea	si,V
	Invoke	AssignmentCast
	Invoke	CastOrdinal
	xchg	si,di
	Invoke	Store
	mov	ax,[di].exCode
	Exit
_Val	endp

_GetDir	proc	near
	Loc	D,byte,<size TExpr>
	Loc	S,byte,<size TExpr>
	Entry
	Invoke	NeedOParen
	lea	di,D
	Invoke	GetIntExpr
	Invoke	CastByte
	Invoke	PushValue
	Invoke	NeedComma
	lea	di,S
	Invoke	PushStringRef
	Invoke	NeedCParen
	mov	ax,D.exCode
	Invoke	UseGoal
	mov	ax,S.exCode
	Invoke	UseGoal
	les	bx,S.exType
	mov	ax,es:[bx].tdSizeOf
	dec	ax
	Invoke	PushWord
	mov	ax,_DirGet
	Invoke	PutSystemCall
	Invoke	DoneGoal
	Exit
_GetDir	endp

_ChDir	proc	near
	Loc	S,byte,<size TExpr>
	Entry
	push	ax
	Invoke	NeedOParen
	lea	di,S