context.asm

[随书类]Dos6.0源代码

;     If a match is found to a prs entry, the oPrs is returned, otherwise, 
;     UNDEFINED.
;     This function will not normally affect prsCur; if, however, procType
;     is PT_SUB and the entry does not already exist, instead of returning
;     UNDEFINED, it will create the entry and return the oPrs.
;
;     The procType field is primarily used to indicate whether the procedure
;     is a DEF FN or not; if not, then the oTyp input is not used. If it
;     is a DEF FN, however, the search logic is different - - - rather than
;     just matching on the name, the search algorithm must match on the oTyp
;     and oMrs as well.
;
;     This routine is called by the parser when a procedure reference is seen,
;     and probably by the scanner when it sees a function entry in a variable
;     table.
;
;Entry:
;	oNam is an offset into current module's name table for proc name
;       procType is either PT_SUB, PT_FUNCTION, or PT_DEFFN.
;	oTyp is only valid if procType == PT_DEFFN, in which case it is
;		the oTyp of the DEF; otherwise, this input is undefined.
;Exit:
;	AX == oPrs if found, UNDEFINED otherwise.
;	In the event that the input procType is PT_SUB and no matching prs
;		is found, the prs will be created; if an error occurs in
;		creating the prs, the same standard error code will be returned,
;		(as is returned by PrsDefine) OR'd with 0x8000. If no error
;		occurs, the oPrs of the new prs will be returned.
;	In all cases, prsCur will be the same on exit as on entry.
;Uses:
;	none.
;Exceptions:
;	none.
;*******************************************************************************
cProc	PrsRef,<PUBLIC,NEAR,NODATA>,<SI>
	parmW	oNam
	parmB	procType
	parmB	oTyp
cBegin	PrsRef
	DbChk	oNam,oNam			;sanity check on input oNam
	mov	si,[grs.GRS_oPrsCur]		;save for later restoring
	cCall	PrsDeActivate			;must deactivate for search

	cCall	OgNamOfONam,<oNam>		; given oNam, fetch ogNam
	xchg	ax,cx				; cx = ogNam or 0
	mov	ax,08000H OR ER_OM		;[10] in case of OM err ret
	jcxz	PrsRef_Exit			;[10]  brif OM error

	mov	al,[procType]			;tell RsTableSearch to use tPrs
	mov	dl,[oTyp]
	cCall	RsTableSearch,<cx>		; search tRs for entry

	cmp	ax,UNDEFINED
	jnz	PrsRef_Exit			;brif found

PrsRef_No_Match:
	cmp	[procType],PT_SUB		;looking for a SUB?
	jnz	PrsRef_Exit			;  brif not - exit

	;special case; reference to a SUB which was not found. Create the
	;	entry, return the oPrs or error code
	push	[oNam]
	push	Word Ptr [procType]
	push	ax				;push garbage for oTyp parm
	mov	al,1
	push	ax				;push a non-zero word (true)
	call	far ptr PrsDefine		; create the entry
PrsRef_Err_Check:
	or	ah,080h				;set high bit in case of error
	cmp	ax,08000h			;FALSE return if no error
	jnz	PrsRef_Exit			;  brif error; pass code back

	mov	ax,[grs.GRS_oPrsCur]		;retval

PrsRef_Exit:
	push	ax				;save retval
	push	si				;parm to PrsActivateCP
	call	PrsActivateCP			;reactivate original prs
	pop	ax				;retval
cEnd	PrsRef

;***
;PrsMake(ogNam, procType)
;
;Purpose:
;     This function searches for a procedure by the name ogNam.
;     If found, it gives an ER_DD if the found procedure has
;     a text table; otherwise, it just activates the found procedure and gives
;     it a text table.  If a new entry is created, it calls the TextMgr
;     routine TxtCurInit() to initialize the text table,
;     and calls the Variable Manager's MakePrsTVar().
;Entry:
;	 ogNam for the proc name
;	 procType - PT_SUB or PT_FUNCTION (should never get PT_DEFFN here)
;Exit:
;        AX == FALSE if no error, ER_OM if out of memory, MSG_IdTooLong
;		if the input name is too long, and ER_DD if a matching
;		entry is found that already has a text table, or if a
;		match is found to a compiled module name.
;	 if ER_DD, [oRsDupErr] = oRs of existing proc with same name.
;        Note that is an error code is returned, there will be no active prs
;	 grs.oMrsCur = procedure's oMrs (unchanged if new proc)
;	 grs.oPrsCur = procedure's oPrs
;	 all fields in prsCur are setup if we're making an existing prs active
;		if we're creating a new prs, then prsCur will have the correct 
;		ogNam, oVarHash, oMrs, and oPrs fields; other fields must be 
;		set up by caller as appropriate.
;	 all fields in txdCur are setup
;Uses:
;	none.
;Exceptions:
;	none.
;*******************************************************************************
cProc	PrsMake,<PUBLIC,FAR,NODATA>,<SI>
	parmW	ogNam			
	parmB	procType
	LocalW	oPrsSave
	LocalW	oMrsSave
	LocalW	searchResult
cBegin	PrsMake
	mov	ax,[grs.GRS_oPrsCur]
	mov	[oPrsSave],ax		;save original oPrs
	mov	ax,[grs.GRS_oMrsCur]
	mov	[oMrsSave],ax		;save original oMrs
	cCall	PrsDeActivate
	mov	si,[ogNam]		
	cCall	ONamOfOgNam,<si>	; given ogNam, fetch oNam
	jnz	PrsMake_Cont		;  Catch possible OM error
					;  now, so later callers of FieldsOfPrs
					;  don't have to consider it.
	jmp	PrsMake_ER_OM1		;brif ONamOfOgNam returned Out of Memory
PrsMake_Cont:
	;---------------------------------------------------------------------
	cmp	[procType],PT_SUB
	jnz	PrsMake_Namespace_OK	;brif not a SUB - leave name space alone

	push	ax			;save oNam across call
	mov	dl,NMSP_Sub
	cCall	SetONamSpace,<ax,dx>	;set namespace bit to remember that this
					;  is a procedure name
	pop	ax
	jnz	PrsMake_ER_DD_1		;brif namespace conflict	

PrsMake_Namespace_OK:
	cCall	GetVarNamChar,<ax>	;ah non-zero if name starts with FN
	or	ah,ah
	jz	No_FN_Name_Error

	cmp	[procType],PT_DEFFN
	jz	No_FN_Name_Error

	mov	ax,MSG_FNstart		;"Can't start with 'FN'"
	jmp	PrsMake_ER_Exit
No_FN_Name_Error:
	DbAssertRelB procType,nz,PT_DEFFN,CP,<PrsMake got called with PT_DEFFN>
	mov	al,[procType]
	cCall	RsTableSearch,<ogNam>	; if err code in CX on retn, ignore
	mov	[searchResult],ax	;save in case of OM error
	inc	ax			;matching entry found?
	.errnz	UNDEFINED - 0FFFFh
	jz	No_Match_Found		;  brif not

	dec	ax			;restore search result
	push	ax			;parm to PrsActivate
	call	PrsActivateCP		;activate this oPrs
	test	[txdCur.TXD_flags],FTX_mrs
	jnz	PrsMake_EnsureTxd	;no error
	;txdCur is for found prs - - error

PrsMake_ER_DD_1:
	jmp	short PrsMake_ER_DD

No_Match_Found:
	call	MakeNewPrs		;make a new entry in prsCur
	jz	PrsMake_ER_OM		;  brif so

	mov	[prsCur.PRS_ogNam],si	; set ogNam in new entry to input
PrsMake_EnsureTxd:
 	mov	al,[procType]		;if we found a match on a FUNCTION or a
 	mov	[prsCur.PRS_procType],al;  DEF FN, FORCE it's proctype to the
	cCall	EnsurePrsTVar		;ax = prs's oVarHash
	jz	PrsMake_ER_OM

	call	AlphaORsFree		;release table of sorted oRs's
	cCall	TxtDeActivate		;save the txd for mrsCur
					; table. leave txdCur as mrs

	;This assignment is necessary for case where prs ref preceded prs
	;definition.  When prs was created for reference, prs's oMrs field
	;was set to mrs with reference.  Now that definition is here, the
	;oMrs field must be set to the mrs which 'owns' the prs.
	
	mov	ax,[oMrsSave]		;ax = caller's oMrs
	mov	[prsCur.PRS_oMrs],ax
;
; At this point mrsCur may not be the same as prsCur.PRS_oMrs, so let's
; ensure that it is.
;
	cmp	[grs.GRS_oMrsCur], ax	
	je	@F			;[477
	push	[grs.GRS_oPrsCur]	; For PrsActivate
	call	PrsDeactivate		
	call	far ptr PrsActivate	
@@:					

	cCall	TxtCurInit		;init txdCur for this new prs
	jz	PrsMake_ER_OM_Txd

	.errnz	FALSE
	xor	ax,ax			;return FALSE
PrsMake_Exit:
cEnd	PrsMake

PrsMake_ER_DD:
	mov	ax,[grs.GRS_oRsCur]
	mov	[oRsDupErr],ax			;tell caller oRs of conflict
	mov	ax,ER_DD
	jmp	short PrsMake_ER_Exit

PrsMake_ER_OM_Txd:
	call	TxtActivate		;reactivate txd for mrsCur
	call	PrsDeActivate		; Set oPrsCur to UNDEFINED,
					;so TxtActivate will activate txd for
					;mrsCur, not this aborted prs
					; Also, in case prsCur on entry was
					; the given prs, must deactivate it
					; here so shared code below will
					; succeed in activating oPrsSave
PrsMake_ER_OM:
	mov	ax,[searchResult]
	inc	ax
	.errnz	UNDEFINED - 0FFFFh
	jnz	PrsMake_ER_OM1		;brif we did not create this prs

	;O.K. - we created it, so we must remove it from the prs table
	mov	ax,dataOFFSET prsCur
	push	ax
	add	ax,SIZE PRS
	dec	ax			;pointer to last byte in range to free
	push	ax
	call	B$ClearRange		;free any owners in prsCur
	call	SetPrsUndef		;grs.oPrsCur=UNDEFINED, oRsCur=oMrsCur
PrsMake_ER_OM1:
	mov	ax,ER_OM
PrsMake_ER_Exit:
	push	ax
	push	oPrsSave		;parm to PrsActivate
	call	PrsActivateCP		;reactivate prsCur
	pop	ax
	jmp	short PrsMake_Exit


;***
;MakeNewPrs
;
;Purpose:
;	Common code to PrsDefine and PrsMake. Sets up prsCur as a new prs.
;Entry:
;	bx = offset to hole in prs table, or UNDEFINED if there is no hole
;	This function assumes that no prs is active (i.e. txdCur reflects
;	   the module's text table)
;Exit:
;	PSW.Z set if out-of-memory
;	grs.oPrsCur is set, meaning prsCur now contains valid info
;Uses:
;	none.
;Exceptions:
;	none.
;****
MakeNewPrs PROC	NEAR
	push	di

	inc	bx				;was there a hole in the table?
	.errnz	UNDEFINED - 0FFFFh
	jz	Prs_GrowTbl			;brif not

	;Unlink the hole from the free list
	GETRS_SEG   es,di,<SIZE,LOAD>		
	dec	bx
	mov	di,bx				;put oHole in di
	DbAssertRel bx,z,oFreePrsFirst,CP,<MakeNewPrs: hole not 1st in free list>
	RS_BASE add,bx
	mov	ax,PTRRS[bx.PRS_oPrsNext]
	mov	[oFreePrsFirst],ax		;free entry now unlinked
	jmp	short PRS_Hole_Found

Prs_GrowTbl:
	sub	ax,ax				
	mov	di,[grs.GRS_bdRs.BD_cbLogical]	;offset to new prs in table
	or	di,di				; Rs table > 32k?
	js	@F				; brif so - OM error

	PUSHI	ax,<dataOFFSET grs.GRS_bdRs>
	PUSHI	ax,<SIZE PRS>
	call	BdGrow
@@:						
	or	ax,ax
	jz	MakeNewPrs_Ret
	
PRS_Hole_Found:
	mov	ax,di
						;new entry put in hole location
	call	SetPrsAx			;grs.oPrsCur = ax
						;grs.oRsCur = 8000h + ax
	GETRS_SEG   es,bx,<SIZE,LOAD>		
	mov	bx,di				;bx = offset to prs in table
	RS_BASE add,bx				;bx = pointer to prs in table
	mov	PTRRS[bx.PRS_ogNam],UNDEFINED	; mark tbl entry as inactve,
						;  since prs is in prsCur
	;Now, link this new prs entry into the prs chain
	mov	PTRRS[bx.PRS_oPrsNext],UNDEFINED ; terminate chain
	mov	dx,bx				; save pPrsNew

	mov	ax,[oPrsFirst]			
	inc	ax				; is this the first prs?
	jnz	LastPrs_Loop			; brif not

	mov	[oPrsFirst],di			; point to new entry
	jmp	short After_Link		; link complete - continue

LastPrs_Loop:					
	dec	ax				; bx == oPrs
	xchg	ax,bx				; advance to next prs
	RS_BASE add,bx				; bx = ptr to prs in table
	mov	ax,PTRRS[bx.PRS_oPrsNext]	; fetch pointer to next prs
	inc	ax				; no more prs's?
	jz	@F				; brif so

	jmp	short LastPrs_Loop		; loop until end of chain
@@:
	mov	PTRRS[bx.PRS_oPrsNext],di	; link new prs in @ end
After_Link:					
	mov	ax,dataOFFSET prsCur		;initialize prsCur, filling it
	mov	bx,SIZE PRS			;  with UNDEFINED, and zeroes 
	mov	cx,PRS_CB_ZERO_INIT		;  as appropriate
	call	InitStruct			; note that this sets
						; the PRS_oPrsNext field to
						; UNDEFINED
	mov	[prsCur.PRS_cbFrameVars],-FR_FirstVar	;	
						; reset to init. value. This
						; value is 2 to account for
						; the fact that b$curframe 
						; is always pushed on the
						; stack after bp, so we
						; treat this word as a frame
						; var for ref'ing the real
						; frame vars off of bp

	mov	ax,[grs.GRS_oMrsCur]		;set oMrs field
	mov	[prsCur.PRS_oMrs],ax
	mov	[fCouldBeBogusPrs],TRUE		;note that there's now a chance
						;  of an unref'd prs
	or	sp,sp				;normal return - reset PSW.Z
MakeNewPrs_Ret:
	pop	di				;restore caller's di
	ret
MakeNewPrs ENDP

;***
;EnsurePrsTVar
;Purpose:
;	Create a local variable table (i.e. allocate oVarHash in
;	module's variable table for local variables) iff:
;	  (1) prs doesn't already have one AND
;	  (2) prs's scan state != SS_RUDE
;Entry:
;	none
;Exit:
;	If didn't need to make local variable table, because prs already
;	   had one, or procedure's scan state == SS_RUDE, ax = UNDEFINED
;	Else if out-of-memory,
;	   ax = 0
;	Else
;	   ax = prs's newly created oVarHash
;	PSW is set based on value in ax
;Exceptions:
;	none
;
;*******************************************************************************
EnsurePrsTVar PROC NEAR
	mov	ax,UNDEFINED
	cmp	[txdCur.TXD_scanState],SS_RUDE	;test table's scan state
	jae	NoTVar			; don't make hash table if there
					; is no variable table
	cmp	[prsCur.PRS_oVarHash],ax
	jnz	NoTVar			;brif prs already has oVarHash
	cCall	MakePrsTVar		;ax = prs's oVarHash, (0 if no memory)
NoTVar:
	or	ax,ax			;set PSW for caller
	ret
EnsurePrsTVar ENDP

;***
;PrsDefine(oNam, pr