stdutils.asm

Turbo Pascal 6.0编译器源码

	model	large compiler_text,pascal
	include	compiler.inc

	.code	compiler_text

	public	PushReference
	public	PushFileRef
	public	PushStringRef
	public	PushIntRef
	public	GetPtrRef
	public	GetPtrExpr
	public	GetStringExpr
	public	GetOrdExpr
	public	GetIntExpr
	public	GetNumExpr
	public	PushStringExpr
	public	GetOrdParam
	public	GetIntParam
	public	GetNumParam
	public	MarkReadOnly
	public	CastPointer
	public	CastString
	public	CastExtended
	public	CastReal
	public	CastLongint
	public	CastBoolean
	public	CastReal2Ext
	public	DefaultFile
	public	CheckIOResult
	public	CheckOParen
	public	CheckComma
	public	NeedOParen
	public	NeedCParen
	public	NeedComma

PushReference	proc	near
	Invoke	GetReference
	Invoke	PushAddr
	les	bx,[di].exType
	ret
PushReference	endp

PushFileRef	proc	near
	call	PushReference
	cmp	es:[bx].tdType,ttFile
	je	@@1
	cmp	es:[bx].tdType,ttText
	jne	@@2
@@1:	ret
@@2:	mov	ax,77
	Chain	CompileError
PushFileRef	endp

PushStringRef	proc	near
	call	PushReference
	cmp	es:[bx].tdType,ttString
	jne	@@1
	ret
@@1:	mov	ax,66
	Chain	CompileError
PushStringRef	endp

PushIntRef	proc	near
	call	PushReference
	cmp	es:[bx].tdType,ttInteger
	jne	@@1
	cmp	es:[bx].tdSizeOf,2
	jne	@@1
	ret
@@1:	mov	ax,98
	Chain	CompileError
PushIntRef	endp

GetPtrRef	proc	near
	Invoke	GetReference
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttPointer
	jne	@@1
	ret
@@1:	mov	ax,65
	Chain	CompileError
GetPtrRef	endp

GetPtrExpr	proc	near
	Invoke	GetExpr
	cmp	es:[bx].tdType,ttPointer
	jne	@@1
	ret
@@1:	mov	ax,78
	Chain	CompileError
GetPtrExpr	endp

GetStringExpr	proc	near
	Invoke	GetExpr
	Invoke	ConvChar2String
	Invoke	LoadPackedChar
	les	bx,[di].exType
	cmp	es:[bx].tdType,ttString
	jne	@@1
	ret
@@1:	mov	ax,67
	Chain	CompileError
GetStringExpr	endp

GetOrdExpr	proc	near
	Invoke	GetExpr
	cmp	es:[bx].tdType,ttInteger
	jb	@@1
	ret
@@1:	mov	ax,39
	Chain	CompileError
GetOrdExpr	endp

GetIntExpr	proc	near
	Invoke	GetExpr
	cmp	es:[bx].tdType,ttInteger
	jne	@@1
	ret
@@1:	mov	ax,38
	Chain	CompileError
GetIntExpr	endp

GetNumExpr	proc	near
	Invoke	GetExpr
	les	bx,[di].exType
	mov	al,es:[bx].tdType
	cmp	al,ttInteger
	je	@@1
	cmp	al,ttReal
	je	@@1
	cmp	al,tt8087
	jne	@@2
@@1:	ret
@@2:	mov	ax,79
	Chain	CompileError
GetNumExpr	endp

PushStringExpr	proc	near
	call	GetStringExpr
	Invoke	PutImmedString
	Chain	PushAddr
PushStringExpr	endp

GetOrdParam	proc	near
	Invoke	NeedOParen
	call	GetOrdExpr
	Chain	NeedCParen
GetOrdParam	endp

GetIntParam	proc	near
	Invoke	NeedOParen
	call	GetIntExpr
	Chain	NeedCParen
GetIntParam	endp

GetNumParam	proc	near
	Invoke	NeedOParen
	call	GetNumExpr
	Chain	NeedCParen
GetNumParam	endp

MarkReadOnly	proc	near
	cmp	[di].exLocation,elMemory
	jne	@@1
	or	[di].exMisc,efReadOnly
@@1:	ret
MarkReadOnly	endp

CastPointer	proc	near
	mov	ax,SystemUnit
	mov	[di].exType.Offs,_Pointer
	mov	[di].exType.Segm,ax
	ret
CastPointer	endp

CastString	proc	near
	mov	ax,SystemUnit
	mov	[di].exType.Offs,_String
	mov	[di].exType.Segm,ax
	ret
CastString	endp

CastExtended	proc	near
	mov	ax,SystemUnit
	mov	[di].exType.Offs,_Extended
	mov	[di].exType.Segm,ax
	ret
CastExtended	endp

CastReal	proc	near
	mov	ax,SystemUnit
	mov	[di].exType.Offs,_Real
	mov	[di].exType.Segm,ax
	ret
CastReal	endp

CastLongint	proc	near
	mov	ax,SystemUnit
	mov	[di].exType.Offs,_Longint
	mov	[di].exType.Segm,ax
	ret
CastLongint	endp

CastBoolean	proc	near
	mov	ax,SystemUnit
	mov	[di].exType.Offs,_Boolean
	mov	[di+2],ax
	ret
CastBoolean	endp

CastReal2Ext	proc	near
	les	bx,[di].exType
	mov	al,es:[bx].tdType
	cmp	al,ttReal
	jne	@@1
	test	CompilerOptions,co8087
	jz	@@1
	mov	al,tt8087
@@1:	ret
CastReal2Ext	endp

DefaultFile	proc	near
	or	ax,ax
	jnz	@@1
	mov	al,0bfh			; mov	di,...
	Invoke	PutByte
	mov	ax,SystemUnit
	xor	bx,bx
	mov	cx,ffData+ffOffs
	Invoke	PutFixup
	mov	ax,571eh		; push	ds	pop	di
	Chain	PutWord
@@1:	Chain	UseGoal
DefaultFile	endp

CheckIOResult	proc	near
	test	CompilerOptions,coIOChk
	jz	@@1
	mov	ax,_InOutCheck
	Chain	PutSystemCall
@@1:	ret
CheckIOResult	endp

CheckOParen	proc	near
	mov	al,tOParen
	Chain	CheckToken
CheckOParen	endp

CheckComma	proc	near
	mov	al,tComma
	Chain	CheckToken
CheckComma	endp

NeedOParen	proc	near
	mov	al,tOParen
	Chain	NeedToken
NeedOParen	endp

NeedCParen	proc	near
	mov	al,tCParen
	Chain	NeedToken
NeedCParen	endp

NeedComma	proc	near
	mov	al,tComma
	Chain	NeedToken
NeedComma	endp

	end