typmgr.asm

Dos6.0

DefineElem_Exit:
cEnd	DefineElem

;***
;RefElem - return offset to specified element in tTyp
;
;Purpose:
;  Given the oNam for an element in type mkVar.MKVAR_oTyp, return the offset 
;  into mrsCur.bdVar for the element, and place the type of the element into
;  mkVar.MKVAR_oTyp.
;
;Entry:
;  oNam - name of the element to be found
;  oTypElem - oTyp of element; ET_IMP if caller doesn't know type.
;		This is used so we can give ER_TM if user puts an (incorrect)
;		explicit type char on an element reference.
;  The oTyp of the parent type is in mkVar.MKVAR_oTyp.
;Exit:
;  return value is an offset into mrsCur.bdVar for the element if bit
;     15 is clear, or is a standard BASIC error code OR'd with bit 15 if set.
;  If successful, mkVar.MKVAR_oTyp is changed to the oTyp of the found element.
;  If the found element is a fixed-length string/text, mkVar.MKVAR_fsLength
;	is changed to the length of the string.
;  Static oElemLast:
;	if the element contains no types of the found element is the first
;		in the chain, oElemLast will be unchanged.
;	else if the element is found, oElemLast will be an offset to the
;		previous element in the chain.
;	else (element not found in non-empty element chain), oElemLast is
;		an offset to the last element in the chain.
;
;Exceptions:
;  none.
;
;******************************************************************************
cProc	RefElem,<PUBLIC,FAR>,<si,di>	
	parmW	oNamElem		
	parmW	oTypElem		
cBegin					
	mov	si,[mrsCur.MRS_bdVar.BD_pb] 
	mov	bx,[mkVar.MKVAR_oTyp]	
	DbChk	UserTyp,bx		;Ensure the oTyp we're looking in is 
					;  valid, and a user defined oTyp
	mov	ax,PTRVAR[bx.TYP_oElementFirst][si]	
	and	ah,07FH			;mask off fReferenced bit
	xchg	di,ax			;di = table offset to first elem in typ
	mov	dx,[oNamElem]		
	DbChk	oNam,dx 		
	jmp	short RefElem_LoopStart 

RefElem_MSG_Undefined:
	mov	ax,MSG_UndElem OR 08000H
	jmp	SHORT RefElem_Exit

RefElem_Loop:
	mov	di,PTRVAR[di.ELEM_oElementNext]	
RefElem_LoopStart:
	or	di,di			
	jz	RefElem_MSG_Undefined	;brif end of elem chain - elem not found
	
	mov	[oElemLast],di		;always keep oElem of last elem here
	add	di,si			;di = pElem
	cmp	PTRVAR[di.ELEM_oNam],dx	
	jnz	RefElem_Loop		;brif no match

	mov	ax,PTRVAR[di.ELEM_oTyp]	
	mov	[mkVar.MKVAR_oTyp],ax	;set oTyp of found element in location
					;  provided by caller
	mov	bx,ax			
	cmp	ax,ET_FS		
	jnz	RefElem_Exit1		

	mov	bx,ET_SD		; explicit type char for ET_SD ($)
					; legally matches element of ET_FS
	mov	ax,PTRVAR[di.ELEM_cbFixed] 
	mov	[mkVar.MKVAR_fsLength],ax  
RefElem_Exit1:
	xchg	ax,di			;ax = pElemFound
	sub	ax,si			;ax = retval = oElemFound

	.errnz	ET_IMP - 0		
	mov	cx,[oTypElem]		
	jcxz	RefElem_Exit		; brif caller doesn't want to
					; check type of element
	cmp	cx,bx			; does element match given oTyp?
	jz	RefElem_Exit		; brif so

	mov	ax,ER_TM OR 08000H	; type mismatch error
RefElem_Exit:				
cEnd					


;***
;CompareTypsRecurse - compare 2 types to see if they're the same
;
;Purpose:
;	Given two oTyps, compare them (recursively element-by-element)
;	to see if they're the same. The given oTyp's do not have to be
;	for user-defined types - - - any valid oTyp's are okay.
;
;Entry:
;  ax = oTyp1 - first type
;  bx = oTyp2 - first type
;  if SizeD,
;		ds is set to seg of type table for oTyp1,
;		es is set to seg of type table for oTyp2.
;  else
;		si points to base of type table for oTyp1
;		di points to base of type table for oTyp2
;Exit:
;  PSW.Z set if the two types match, reset if not.
;	if PSW.Z set, CX = 0 indicates no further comparison need be made.
;	if CX != 0, however, the oTyp's are either ET_FS or ET_FT, and
;	the lengths must be compared by the caller (who presumeably has
;	access to these lengths).
;  If PSW.Z reset, CX = 0 if routine succeeded, ER_OM if insufficient
;	stack space for required recursion.
;Exceptions:
;  none.
;
;******************************************************************************
cProc	CompareTypsRecurse,<NEAR,NODATA>
cBegin	CompareTypsRecurse
	cmp	bx,ET_MAX		;is oTyp2 user-defined?
	jbe	Compare_Cmp_Exit	; brif not

	cmp	ax,ET_MAX		;is oTyp1 user-defined?
	jbe	Compare_Cmp_Exit	; brif not
	add	ax,si			;ax = pTyp1
	add	bx,di			;bx = pTyp2
	mov	bx,PTRVAR[bx.TYP_oElementFirst]	
	and	bh,07FH			;mask off fReferenced bit
	xchg	ax,bx
	mov	bx,[bx.TYP_oElementFirst]
	and	bh,07FH			;mask off fReferenced bit
Elem_Compare_Loop:
	;bx = oElem1, ax = oElem2
	or	bx,bx			
	jz	Compare_Cmp_Exit	;end of chain 1 - set exit code based on
					; whether both chains end
	or	ax,ax			;end of chain 2?
	jz	Compare_Cmp_Exit	;brif end of chain 2  - reset PSW.Z,exit
					;not end of either chain - - continue

	add	bx,si			;bx = pElem1
	push	bx			;save across recursive call
	mov	bx,[bx.ELEM_oTyp]
	xchg	ax,bx			;ax = oTyp of element 1, bx = oElem2
	add	bx,di			;bx = pElem2
	push	bx			;save across recursive call
	mov	bx,PTRVAR[bx.ELEM_oTyp]	; bx = oTyp of element2
	mov	cx,sp
	sub	cx,6			;CompareTypsRecurse requires 6 bytes
					; of stack space per invocation
	cmp	cx,[b$pend]
	ja	Compare_Cont		;brif sufficient stack space to recurse

	mov	cx,ER_OM		;abnormal termination - not enough stack
	mov	[b$ErrInfo],OMErr_STK;note this is really Out of Stack space
	pop	ax			; clean stack
	pop	ax			; clean stack
	or	sp,sp			;reset PSW.Z to indicate failure
	jmp	short CompareTypsRec_Exit1
Compare_Cont:
	call	CompareTypsRecurse	;compare these types
	pop	bx			;pElem2Old
	pop	ax			;pElem1Old
	jnz	CompareTypsRec_Exit	;if any element match fails, whole
					; process terminates
	jcxz	Compare_Cont_1

	;ET_FS or ET_FT - - - oTyp's compare, but must also check string
	;lengths - - -
	xchg	ax,bx			
	mov	cx,[bx.ELEM_cbFixed]	; cx = size of element1
	xchg	ax,bx			
	cmp	cx,PTRVAR[bx.ELEM_cbFixed] 
	jnz	CompareTypsRec_Exit	; if lengths are different, no match
Compare_Cont_1:
	mov	bx,PTRVAR[bx.ELEM_oElementNext]	; fetch new oElem2
	xchg	ax,bx			;ax = oElem2, bx = pElem1Old
	mov	bx,[bx.ELEM_oElementNext]
	jmp	short Elem_Compare_Loop	;continue until end of both chains
					; found, or an element pair is found
					; that doesn't match
Compare_Cmp_Exit:
	cmp	ax,ET_FS		; special comparison required?
	jnz	CompareTypsRec_Cmp	; brif no special compare step
	;ax is either ET_FS or ET_FT	
	cmp	ax,bx			; set condition codes for retval
	mov	cx,sp			; caller must check string lengths
	jmp	short CompareTypsRec_Exit1 
CompareTypsRec_Cmp:			
	cmp	ax,bx			;sets condition codes for retval
CompareTypsRec_Exit:
	mov	cx,0			;routine terminated normally
CompareTypsRec_Exit1:
cEnd	CompareTypsRecurse

;***
;CompareTyps - compare 2 types to see if they're the same
;
;Purpose:
;	Given two oTyps, compare them (recursively element-by-element)
;	to see if they're the same. The given oTyp's do not have to be
;	for user-defined types - - - any valid oTyp's are okay.
;
;	This routine does the start-up work, and uses
;	CompareTypsRecurse to do the actual comparison.
;
;	Interface modified as revision [15].
;
;Entry:
;  ax = oRs1  - oRs of first type
;  bx = oRs2  - oRs of first type
;  cx = oTyp1 - first type
;  dx = oTyp2 - first type
;
;  parm1 = oRs1 = oRs of 1st type
;  parm2 = oRs2 = oRs of 2nd type
;  parm3 = oTyp1 = oTyp of 1st type
;  parm4 = oTyp2 = oTyp of 2nd type
;Exit:
;  PSW.Z set if the two types match, reset if not.
;  If PSW.Z reset, CX = 0 if routine succeeded, ER_OM if insufficient
;	stack space for required recursion.
;
;  AX = 0 if two types match
;  If AX != 0, DX = 0 if routine succeeded, ER_OM if insufficient
;	stack space for required recursion.
;Preserves:
;  ES - scanner depends on this (in non-windows versions)
;Exceptions:
;  none.
;
;******************************************************************************
cProc	CompareTyps,<PUBLIC,FAR,NODATA>,<SI,DI,ES>	
	parmW	oRs1			
	parmW	oRs2			
	parmW	oTyp1			
	parmW	oTyp2			
cBegin	CompareTyps
assumes ds,DATA 			
	mov	ax,[oRs1]		; parm to OMrsORs
	call	OMrsORs 		;get oMrs of type1
	mov	si,[oRs2]		
	xchg	si,ax			;si = oMrs1, ax = oRs2
	call	OMrsORs			;get oMrs of type2
	xchg	ax,di			;di = oMrs2, ax = garbage
	mov	cx,[oTyp1]		
	mov	dx,[oTyp2]		
	cmp	si,di			;oTyp's in different modules?
	jnz	Diff_Module		; brif so

	cmp	cx,dx			;return PSW.Z set appropriately
	mov	cx,0			;CompareTyps terminated normally
	jmp	short CompareTyps_Exit
Diff_Module:
	push	[grs.GRS_oRsCur]
	push	cx			;preserve oTyp's across call
	push	dx
	call	MrsDeActivate		;so both mrs's are in mrs table
	RS_BASE add,si			; si = pMrs1
	RS_BASE add,di			; di = pMrs2
	GETRS_SEG es,bx,<SIZE,LOAD>	;[5] es == Rs table seg, trashes bx
	mov	si,PTRRS[si.MRS_bdVar.BD_pb] ;[2] si = base pointer to type table 1
	mov	di,PTRRS[di.MRS_bdVar.BD_pb] ;[2] di = base pointer to type table 2
	pop	bx			;bx = oTyp2
	pop	ax			;ax = oTyp1
	call	CompareTypsRecurse
	pop	ax			;oRsCur on entry
	pushf				;save retval flags
	cCall	RsActivateCP,<ax>	;restore oRsCur to entry value
	popf
CompareTyps_Exit:
	mov	dx,cx			; per new interface
	mov	ax,sp			; non-zero
	jnz	CompareTyps_Exit_1	; brif types don't match

	sub	ax,ax			
CompareTyps_Exit_1:			
cEnd	CompareTyps

;***
;ONamOElem, ONamOTyp - Return the oNam for the name of a given element or type
;Purpose: 
;  Used for descanning. Given an offset into mrsCur.bdVar to an element or type
;  entry, returns the oNam for the name of the element.
;
;Entry:
;  oElem or oTyp - offset into mrsCur.bdVar for the desired element or type
;
;Exit:
;  return value is an offset into the module name table for the name of the
;	element or type.
;
;Exceptions:
;  none.
;
;Preserves:
;  All but AX and BX (for callers in CP. Callers from outside CP cannot
;  assume this).
;
;******************************************************************************
PUBLIC	ONamOTyp
ONamOTyp PROC FAR
	.errnz	TYP_oNam - ELEM_oNam
	;fall into ONamOElem, taking advantage of the fact that the oNam
	;  field is in the same position in the ELEM and TYP structures.
ONamOTyp ENDP
cProc	ONamOElem,<PUBLIC,FAR,NODATA>
	parmW	oStruc			
cBegin	ONamOElem
	mov	bx,[oStruc]		
	add	bx,[mrsCur.MRS_bdVar.BD_pb]
	mov	ax,[bx.ELEM_oNam]
cEnd	ONamOElem

;===============================================================================

;***
;ForEachPrimElem - recursively walk each primitive element in a TYPE
;
;Purpose:
;  Recursively visit each primitive element in a TYPE. By "primitive element"
;  we mean an element that is not itself of some user-defined type.
;  For each primitive element, call the near routine pointed to by SI.
;  In the special case where SI == 0, just increment CX instead, i.e., this
;  routine then simply counts all primitive elements.
;
;Entry:
;  an oTyp in ax.
;  SI == 0 to count, or is a near pointer to a helper routine.
;
;Exit:
;  if SI == 0, cx = count of primitive elements on exit,
;  otherwise cx is not touched, and can be used as a return value by the
;	helper routine.
;  Does not use dx - - - caller & helper routine can also use dx as desired.
;
;Exceptions:
;  In non-RELEASE case, DebHalt may be called if input not a valid 
;     user-defined oTyp.
;
;******************************************************************************
DbPub	ForEachPrimElem 		
cProc	ForEachPrimElem,<NEAR,NODATA>,<DI>
cBegin
	DbChk	oTyp,ax
	mov	bx,[mrsCur.MRS_bdVar.BD_pb] 
	mov	di,ax
	mov	di,PTRVAR[di.TYP_oElementFirst][bx]	
	and	di,07FFFH		;mask off fReferenced bit
	add	di,bx			;di = pElem
	add	ax,bx
	cmp	ax,di
	jz	ForEachPrimElem_Exit

ForEachPrimElem_Loop_Start:
	lea	ax,[bx+0]		
	cmp	ax,di
	jz	ForEachPrimElem_Exit	;brif end of chain

	mov	ax,PTRVAR[di.ELEM_oTyp] 
	cmp	ax,ET_MAX
	ja	@F			; brif user-defined type

	or	si,si			; special case?
	jnz	CallHelper		; brif not - - call helper

	inc	cx			; increment count of prim elements
	jmp	short ForEachPrimElem_Continue 
CallHelper:				
	;ax == oTyp of primitive element
	;if SizeD, es == segment of type table
	;di == pElem for primitive element
	call	si			; call helper for this prim element
	jmp	short ForEachPrimElem_Continue 
@@:					
	call	ForEachPrimElem 	; recurse to handle elements in
					;	this user-defined type
ForEachPrimElem_Continue:		
	mov	di,PTRVAR[di.ELEM_oElementNext]
	add	di,bx			;add table base to get next element
	jmp	short ForEachPrimElem_Loop_Start
ForEachPrimElem_Exit:
cEnd


;***
;CPrimElemFar(oTyp) - return the number of primitive elements in a type
;
;Purpose:
;  Recursively count the total number of primitive elements owned by a 
;  given user-defined type. 
;
;Entry:
;  an oTyp.
;
;Exit:
;  a count of the number of actual elements (i.e., of type ET_I2, ET_I4,
;     ET_R4, ET_R8, fixed-length string, etc) in the type.
;
;Exceptions:
;  In non-RELEASE case, DebHalt may be called if input not a valid 
;     user-defined oTyp.
;
;******************************************************************************
cProc	CPrimElemFar,<PUBLIC,FAR,NODATA>,<SI>
	parmW	oTyp
cBegin	CPrimElemFar
	mov	ax,[oTyp]
	sub	si,si			; just inc cx for each prim element
	sub	cx,cx			; initialize count
	call	ForEachPrimElem 	; cx == count of primitive elemtns
	xchg	ax,cx			; ax == retval
cEnd	CPrimElemFar

;===============================================================================


sEnd	CP


;===============================================================================


	end