www.pudn.com > tp60src.zip > STDUTILS.ASM

	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