dynamic.asm

Dos6.0

	PUSH	DI

;
;	SI:DI are used to accumulate the 32-bit offset of the array element.
;	CX is the loop counter for each index of the array access.
;	BX points to within the array descriptor.
;	BP points to within the stack frame.
;	DX:AX are used for intermediate calculations (including MUL).
;
;	Clear the offset accumulation in SI:DI and get and check the
;	number of indices in the array.
;
	XOR	SI,SI		;clear the running...
	MOV	DI,SI		;...accumulator for the offset
	MOV	CX,ci		; get number of indices from stack
	CMP	CL,[BX].AD_cDims ;test against dimensions in the AD
	JNE	HAryError	;if not the same, then jump to error
;
;	Within the offset calculation loop for each index, BP points
;	to the current index in the stack frame and BX points to the
;	current dimension count in the array descriptor.  Indices are
;	processed from last to first.
;
	PUSH	BX		;save registers again...
	PUSH	BP		;(save BP last for error routines)

	ADD	BP,8		;point to last index in the frame
	ADD	BX,AD_tDM	; points to first DM, last dim count...
	JMP	SHORT HAryStart ;jump to start within the loop
;
;	Calculation loop.  Adjust BP and BX to point to the next
;	index in the array.
;
HAryLoop:

	INC	BP		;point BP to next word...
	INC	BP		;...up the frame on the stack
	ADD	BX,SIZE DM	; point BX to the next index in the AD

;	Multiply SI:DI by the new dimension count.  Since each
;	index is in legal range in the AD, overflow is not possible.

	MOV	AX,DI		;get low word of accumulator
	MUL	[BX].DM_cElements ;multiply by current dimension count
	MOV	DI,AX		;put low word of product in accumulator
	MOV	AX,SI		;get high word of accumulator
	MOV	SI,DX		;accumulator SI:DI has first product
	MUL	[BX].DM_cElements ;multiply high word by count
	ADD	SI,AX		;add low word to high word of accumulator

;	Start within loop.  Get the array index and check if it is
;	within the bounds specified in the AD.	If not, report an error.

HAryStart:
	MOV	AX,[BP] 	;get the array index
	SUB	AX,[BX].DM_iLbound ;subtract lower bound to get index offset
	JL	HAryErrorPopBP	;if negative, then error
	CMP	AX,[BX].DM_cElements ;test if equal or larger than count
	JGE	HAryErrorPopBP	;if so, then error

;	Add array index offset to the accumulator in SI:DI.
;	Loop if more dimensions to process.

	ADD	DI,AX		;add index offset to DI...
	ADC	SI,0		;...and propagate carry to SI
	LOOP	HAryLoop	;loop on CX if more to process

	POP	BP		;restore registers saved before loop
	POP	BX

;	Finish the offset calculation by multiplying by the element
;	size and adding the AD offset.

	MOV	AX,DI		;get low word of accumulator
	MUL	[BX].AD_cbElement ;multiply by element byte count
	MOV	DI,AX		;put low word of product in accumulator
	MOV	AX,SI		;get high word of accumulator
	MOV	SI,DX		;accumulator SI:DI has first product
	MUL	[BX].AD_cbElement ;multiply high word by count
	ADD	SI,AX		;add low word to high word of accumulator

	ADD	DI,[BX].AD_fhd.FHD_oData ;add offset to accumulator...
Finish: 			
	ADC	SI,CX		;...and propagate the carry (CX=0 from LOOP)

;	From the 32-bit offset in SI:DI, compute the far pointer in ES:BX.

	GETSEG	AX,[BX].AD_fhd.FHD_hData,BX	;get segment from the AD
	OR	AX,AX		;test if segment is zero
	JZ	BadSubError	;if so, then array is unallocated
	MOV	CL,b$HugeShift ;get OS dependent shift count...
;	MOV	CL,12		;conversion count from 64K to 16...
	SHL	SI,CL		;...to calculate segment
	ADD	AX,SI		;segment is calculated (far ptr in AX:DI)

;	Move far pointer in AX:DI to ES:BX.

	MOV	ES,AX		;move segment of pointer
NearArray:			
	MOV	BX,DI		;move offset of pointer

	MOV	AX,ci		; AX = number of dimensions on stack
	INC	AX		; 1 extra parameter
	SHL	AX,1		; number of parameter bytes <dim #>*2 + 2
	MOV	b$Buf1,AX	; save # of bytes of parms to clear

	POP	DI		;restore registers
	POP	SI
	POP	DX
	POP	CX
	POP	AX

cEnd	nogen			; fall into CleanStack

;*** 
; CleanStack -- Common return for B$HARY and DIM_COMMON.  Added with [18].
;
;Purpose:
;	Clears variable number of bytes off the stack that are below BP and
;	a return address. Restores BP and jumps to the desired return address.
;
;Entry:
;	b$Buf1 = number of bytes to clear
;Exit:
;	None
;Uses:
;	b$Buf1
;Preserves:
;	All
;Exceptions:
;	None
;
;******************************************************************************
CleanStack:
	POP	BP		; restore BP
	POP	[b$Buf1+2]	; [b$Buf1+2] = far return address
	POP	[b$Buf1+4]
	ADD	SP,b$Buf1	; clean parameters from stack
	JMP	DWORD PTR [b$Buf1+2] ; return far

BadSubError:			
	JMP	B$ERR_BS	;process bad subscript error

	SUBTTL	B$LBND and B$UBND - LBOUND and UBOUND Functions
	PAGE
;***
; B$LBND and B$UBND - LBOUND and UBOUND Functions
; Added rev [11]
;
; Function:
;	Return the lowest or highest legal index for a
;	specified array dimension.
;
; NOTE: In the interpeter (QB), the pointer to the array descriptor is actually
; a pointer into the variable heap. This heap cannot move during this
; operation.
;
; Inputs:
;	pAd	ds relative array descriptor offset
;		(FV_LONGPTR only: pAd is a long ptr to the Ad)
;	iDim	1 relative index to array dimension
;
; Ouputs:
;	ax	lower or upper bound of the indicated dimension
;
; Registers:
;	none
;
;******************************************************************************

cProc	B$LBND,<FAR,PUBLIC>
cBegin	nogen
	XOR	CX,CX				;cx = 0 == LBOUND
	SKIP	2
cEnd	nogen					;fall OVER MOV CX,SP

cProc	B$UBND,<FAR,PUBLIC>
cBegin	nogen
	MOV	CX,SP				;cx <> 0 == UBOUND
cEnd	nogen					;fall INTO common routine

cProc	ULbound,FAR				;common routine to fall into
parmW	pAd					;pointer to array descriptor
parmW	iDim					;Index to desired dimension
cBegin

	MOV	DX,iDim
	mov	bx,pAd				;get pAD into register
	XOR	AX,AX				;Assume iDim out of range case
	CMP	[bx].AD_fhd.FHD_hData,AX	;test if segment is zero
	JZ	BadSubError			; Branch if unallocated
	SUB	DL,[BX].AD_cDims		;not this many dimensions?
	JA	BadSubError			; out of range: bad sub
						; treats negs as out of range
.errnz	(SIZE DM)-4
	NEG	DL				;Index to DIM info
						; Zero relative, always +
	SHL	DX,1				;To word offset
	SHL	DX,1				;2 word fields in DM
	ADD	BX,DX				;Index to dim iDim information
	MOV	AX,[BX.AD_tDM.DM_iLbound]	;Lower bound
	JCXZ	BOUNDX				;Return LBOUND
	ADD	AX,[BX.AD_tDM.DM_cElements]	;Count of elements
	DEC	AX				;To highest index
BOUNDX:

cEnd

	SUBTTL	B$ERAS - erase an array
	PAGE
;***
; B$ERAS - erase an array
; B$IErase - erase an array, but do not try to reclaim dgroup.
;
;Purpose:
; With the array descriptor given, erase the array.  For dynamic arrays, the
; space is deallocated. For static arrays, the array is only cleared. For
; static string arrays, the strings are deallocated.
;
; NOTE: In the interpeter (QB), the pointer to the array descriptor is actually
; a pointer into the variable heap. This heap cannot move during this
; operation.
;
;Entry:
;	pAd	ds relative array descriptor offset
;		(FV_LONGPTR only: pAd is a long ptr to the Ad)
;Exit:
;	None.
;Uses:
;	AX, BX, CX, DX.
;Exceptions:
;	None.
;******************************************************************************
cProc	B$ERAS,<FAR,PUBLIC>	
cBegin	nogen			


	MOV	AX,1		; nz to allow heap movement
	SKIP	2		

cEnd	nogen			

cProc	B$IErase,<FAR,PUBLIC>	
cBegin	nogen			

	XOR	AX,AX		; z to disable heap movement


cEnd	nogen			

cProc	ERASE_COMMON,FAR,<SI,DI>
parmW	pAd			
cBegin				

;	Get the array descriptor and test if array is static or dynamic.

	mov	bx,pAd			;get pAD into register
	mov	cx,[bx].AD_fhd.FHD_hData 
	jcxz	ErasReturn		 ; nothing to do if unalloc'd

	TEST	[bx].AD_fFeatures,FADF_STATIC ;test if a static array
	JNZ	ErasStatic		;if static, then jump

;	Dynamic array.	If not allocated, then just return.  Then test
;	if it is a string array.

	xor	si,si			
	MOV	[bx].AD_fhd.FHD_cPara,si;clear size field
	xchg	si,[bx].AD_fhd.FHD_hData;Get segment/SB, mark deallocated
	TEST	[bx].AD_fFeatures,FADF_SD;test if a string array
	JZ	ErasDynNumAry		;if not, dealloc dynamic numeric array

;	Dynamic string array.  Get the array offset and deallocate it.

	MOV	SI,[bx].AD_fhd.FHD_oData   ;get offset of array from AD
	PUSH	AX		; Save compaction flag
	CALL	B$LHDALC	; deallocate heap entry and compact heap
	POP	CX		; [CX] = compaction flag
	JCXZ	ErasReturn	
	CALL	B$LH_CPCT	; Compact when we're allowed to
	JMP	SHORT ErasReturn ;done - jump to return

;	Dynamic numeric array.	Deallocate it through its descriptor.

ErasDynNumAry:
	PUSH	AX		; Save movement flag
	cCall	B$FHDealloc	; deallocate the FH entry
	POP	CX		
	JCXZ	ErasReturn	; if movement not allowed, just return
	cCall	B$FHTestRaiseBottom ; Else try to reclaim DGROUP
	JMP	SHORT ErasReturn ;done - jump to return

;	Static array.  First get the base offset and compute its size.
;	Test if string or numeric.

ErasStatic:
	CALL	B$ADArraySize	; get the array size in bytes in DX:AX
	MOV	CX,AX		;put the size into CX
	MOV	DI,[bx].AD_fhd.FHD_oData   ;get the base offset from the AD
	TEST	[bx].AD_fFeatures,FADF_SD  ;test if string array
	JZ	ErasStatNumAry	;if not, then numeric and jump

;	Static string array.  Deallocate all strings referenced in
;	loop with BX pointing to each descriptor in the entry.

	SHR	CX,1		;divide byte count to get word count

	SHR	CX,1		;divide word count to get number of strings
	PUSH	BX		; Save array pointer
	MOV	BX,DI		;point to start of entry
ErasStatLoop:
	CALL	B$STDALC	;deallocate the string pointed by desc at BX
	ADD	BX,4		;point to the next descriptor
	LOOP	ErasStatLoop	;loop until done with entry
        MOV     CX,AX           ;get the length of entry back
	POP	BX		; get AD pointer back

;       Static array.  Clear the array entry of CX bytes at offset DI.

ErasStatNumAry:
	INC	CX		; Round up length if odd.
	SHR	CX,1		;Number of words to be cleared.
        XOR     AX,AX           ;value to clear entry
	GETSEG	ES,[bx].AD_fhd.FHD_hData,,<SIZE,LOAD>	;get seg from the AD
        REP     STOSW           ;clear the entry

;	Done - restore and return.

ErasReturn:

cEnd				

sEnd				
	END