dynamic.asm

DOS 6.22 的源代码

	TITLE	DYNAMIC - Dynamic array support
	PAGE	56,132
;***
; DYNAMIC.ASM - Dynamic array support
;
;	Copyright <C> 1986, Microsoft Corporation
;
;Purpose:
;
; BASIC Syntax mapping to included runtime entry points:
;
; - DIM/REDIM Statement - Generates runtime call if $DYNAMIC was specified:
;
;	B$DDIM(hi 1, lo 1,... hi n, lo n, element size, ndims+typ<<8, pAd)
;	B$RDIM(hi 1, lo 1,... hi n, lo n, element size, ndims+typ<<8, pAd)
;
; - Dynamic array access routine - one call:
;
;	B$HARY(index 1, ..., index n, nindex) with BX = pointer to AD
;
; - ERASE Statement - generates one call:
;
;      ERASE arrayname {,arrayname}
;
;	B$ERAS(array desc)
;
;******************************************************************************
	INCLUDE switch.inc
	INCLUDE rmacros.inc	;Runtime Macro Defintions

	useSeg	_DATA		
	useSeg	_BSS		
	useSeg	FH_TEXT 	

	INCLUDE seg.inc 	
	INCLUDE array.inc	;far heap and array descriptor structures
	INCLUDE pointers.inc	;pointer reference macros
	INCLUDE baslibma.inc	
	INCLUDE nhutil.inc
	INCLUDE idmac.inc	

sBegin	_BSS			
	externB	b$HugeShift	;OS Selector increment for HUGE access
	externW	b$Buf1		; temporary buffer
sEnd	_BSS




sBegin	FH_TEXT 		
assumes CS,FH_TEXT		
;
;	Dynamic array runtime support
;


externNP B$FHAlloc		;FHINIT - far heap allocation
externNP B$FHDealloc		;FHINIT - far heap deallocation
externNP B$LHALC_CPCT		; compact heap and allocate heap entry
externNP B$LHDALC		; deallocate heap entry and compact heap
externNP B$LH_CPCT		; compact heap
externNP B$STDALC
externNP B$FHTestRaiseBottom	; attempt to reclaim DGROUP from FH
externNP B$ADArraySize		; Compute array size

externNP B$ERR_BS		;bad subscript error
externNP B$ERR_DD		;double dimension error


	SUBTTL	B$DDIM & B$RDIM - dimension & redimension
	PAGE
;***
; B$ADIM - DIM a dynamic array
; I4 pascal B$ADIM(I2 lo1, I2 hi1, ..., I2 loN, I2 hiN, I2 cbelem,	
;		      U2 ndims+typ<<8, ad *pAd)
;
; B$DDIM - DIM a dynamic array
; void pascal B$DDIM(I2 lo1, I2 hi1, ..., I2 loN, I2 hiN, I2 cbelem,	
;		      U2 ndims+typ<<8, ad *pAd)
;
; B$RDIM - REDIM a dynamic array
; void pascal B$RDIM(I2 lo1, I2 hi1, ..., I2 loN, I2 hiN, I2 cbelem,	
;		      U2 ndims+typ<<8, ad *pAd)
;
;Purpose:
; Runtime Entry Point. DIM Statement for dynamic arrays. If the array is
; already defined, an error is returned. REDIM Statement for dynamic arrays. If
; the array is already defined, it is released and then reallocated.
;
; B$ADIM performs all the functions of B$DDIM, except it does not actually
; allocate space for the array. It is used to fill in an array descriptor, and
; return the size of the array. [14]
;
; 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:
; lb	= lower bound for dimension n (lo1 through loN, above)
; ub	= upper bound for dimension n (hi1 through hiN, above)
; cbelem= element size
; ndtyp = number of dimensions (byte) & flags
; pAd	= pointer to array descriptor
;		(FV_LONGPTR only: pAd is a long ptr to the Ad)
;
;Outputs:
; [DX:AX] = resulting size of the array (B$ADIM only)
; Input parameters are removed from the stack.
;
;Modifies:
; Per convention
;
;*****************************************************************************
cProc	B$ADIM,<FAR,PUBLIC>	
cBegin	nogen			
	MOV	AL,1		; non-zero to indicate dim
	SKIP	2		; skip next instruction
cEnd	nogen			; fall into B$RDIM

cProc	B$RDIM,<FAR,PUBLIC>	
cBegin	nogen			
	XOR	AL,AL		; zero to indicate re-dim
	SKIP	2		; skip next instruction
cEnd	nogen			; fall into B$DDIM

cProc	B$DDIM,<FAR,PUBLIC>	
cBegin	nogen			
	MOV	AL,0FFH 	; flag to indicate dim
cEnd	nogen			


cProc	DIM_COMMON,FAR		
parmW	lb			;[4] lower bound for dimension n
parmW	ub			;[4] upper bound for dimension n
parmW	cbelem			; element size
parmW	ndtyp			; number of dimensions (byte) & flags
parmW	pAd			; pointer to array descriptor
cBegin				


	PUSH	SI		
	PUSH	DI		

	OR	AL,AL		; see who we were called as
	CBW			; [AX] = entry type
	XCHG	AX,DI		; [DI] = entry type (NOTE: Used way below)
	JNZ	BDDIM_5 	; Jump if dim (don't erase first)

;
;	Erase the present array if allocated.
;
	cCall	<FAR PTR B$ERAS>,pAd ; call runtime routine to erase array
;
;	Test if array is already allocated.  If so, clean the stack and
;	process the error.
;
BDDIM_5:			
	mov	bx,pAD		
	CMP	[bx].AD_fhd.FHD_hData,0    ;test if AD segment is zero
	JZ	BDDimNotAlloc	;if so, then not allocated, continue
	JMP	B$ERR_DD	;jump to double-dimensioned array error

;	Array is not allocated.  Fill in the AD from the stack variables.

BDDimNotAlloc:
	MOV	CX,ndtyp	; get number of dimensions and flags
	MOV	WORD PTR [bx].AD_cDims,CX  ;put flags, number of dims in AD
	MOV	AX,cbelem	; get size of an element in bytes
	MOV	[bx].AD_cbElement,AX	;and also put into AD
	XOR	CH,CH		;leave number of dimensions in CX
	LEA	SI,ub		;[4] point at lb entry of last index def
;
;	For each dimension, move the lower bound and compute the count
;	from the information on the stack.
;
;	[SI]			 -> upper bound of dimension on stack	
;	[SI+2]			 -> lower bound of dimension on stack	
;	ds:[bx].AD_tDM.DM_cElements -> count of elements of dimension in AD
;	ds:[bx].AD_tDM.DM_iLbound   -> lower bound of dimension in AD
;
	PUSH	BX		;save registers during move
	XOR	DX,DX		; [DX] = offset adjustment
BDDimLoop:
	lods	word ptr DGROUP:[si]	;get upper bound of current dimension
	SUB	AX,DGROUP:[SI] 	;subtract lower bound to count less 1
	JS	BDDimBadSubscript ; if lower > upper, bad subscript
	INC	AX		;increment to get real count of dimension
	MOV	[bx].AD_tDM.DM_cElements,AX ;put count of dimension into AD
	MUL	DX		; [AX] = offset adjustment * cElements
	XCHG	AX,DX		; [DX] = offset adjustment
	lods	word ptr DGROUP:[si]	;get lower bound of current dimension
	MOV	[bx].AD_tDM.DM_iLbound,AX  ;put into lower bound in AD
	SUB	DX,AX		; update offset adjustment
	ADD	BX,SIZE DM	;move AD pointers to next dimension entry
	LOOP	BDDimLoop

	POP	BX		;restore registers...
	XCHG	AX,DX		; [AX] = offset adjustment
	MUL	[bx].AD_cbElement	; Account for element size
	MOV	[bx].AD_oAdjusted,AX	; Store offset adjustment
;
;	With the information now in the AD pointed by BX, compute the
;	size of the array to allocate.
;
	CALL	B$ADArraySize	; compute the size in DX:AX
DJMP	JC	BDDimBadSubscript ;if too large, then give bad subscript error
        MOV     [bx].AD_fhd.FHD_cPara,AX; save byte count
	DEC	DI		; [DI] = entry type-1
	JZ	BDDimExit	; B$ADIM? if so, then go exit.
;
;	Jump if array is huge.	For a near or far array, give a bad
;	subscript error if the size is 64K or more.
;

	MOV	[bx].AD_fhd.FHD_oData,size AHD	; default offset

	TEST	[bx].AD_fFeatures,FADF_HUGE	;test if array is huge
	JNZ	BDDimHuge	;if huge, then jump
	CMP	DX,1		; byte count < 64K?
	JB	Less64K		; brif so -- value ok
	JA	BDDimBadSubscript ; brif > 64K -- give bad-subscript error
	OR	AX,AX		; byte count = 64K?
	JNZ	BDDimBadSubscript ; brif not -- give bad-subscript error
Less64K:			
;
;	Jump if array is far.  For a near array, allocate through the
;	near heap manager and jump to exit.
;
	TEST	[bx].AD_fFeatures,FADF_FAR ;test if array is far
	JNZ	BDDimAlloc	;if far, then just allocate directly
	MOV	CX,BX		;get array descriptor offset
	MOV	DL,LH_ARRAY	;set near heap entry type
	XCHG	BX,AX		;get size in bytes of entry to allocation
	CALL	B$LHALC_CPCT	; compact heap and allocate heap entry
	MOV	BX,CX		;get array descriptor pointer back
	MOV	[bx].AD_fhd.FHD_hData,DGROUPSEG ;save DGROUP segment/SB
						;  in descriptor
	MOV	[bx].AD_fhd.FHD_oData,SI   ;save base offset in descriptor
	ADD	[bx].AD_oAdjusted,SI	   ;Save adjusted offset
	JMP	SHORT BDDimExit ;jump to exit routine
;
; Place in center for relative jumps
;
BDDimBadSubscript:
	JMP	B$ERR_BS	;jump to bad-subscript error



;
;	Array is huge.	Determine 64K MOD <element-size> to compute
;	the array offset. (Value is remainder of integer divide of
;	64K by the element size.)
;
BDDimHuge:
	OR	DX,DX		; skip offset calc for arrays < 64k
	JZ	BDDimAlloc	
	PUSH	AX		;save size of allocation now in...
	PUSH	DX		;DX:AX since they are used by DIV
	XOR	AX,AX		;load 64K into DX:AX - 0 in AX...
	CWD			
	INC	DX		;...and 1 in DX
	DIV	[bx].AD_cbElement  ;divide 64K in DX:AX by element size
	MOV	[bx].AD_fhd.FHD_oData,DX ;move remainder into the AD offset
	ADD	[bx].AD_oAdjusted,DX	;Save adjusted offset
	OR	DX,DX		;test if remainder (MOD) is zero
	POP	DX		;restore array byte size...
	POP	AX		;in DX:AX
	JZ	BDDimAlloc	;if remainder was zero, then just allocate
	ADD	AX,[bx].AD_fhd.FHD_oData   ;make room for alignment
	ADC	DX,0		
	CMP	DX,1		;test if array was less than 128K
	JA	BDDimBadSubscript ;if 128K or more and nonzero offset, then err

BDDimAlloc:
	CALL	B$FHAlloc	;allocate FH entry of size DX:AX at desc BX

BDDimExit:
	MOV	CX,ndtyp	; CL = number of dimensions on stack
	XOR	CH,CH		; Clear high byte
	SHL	CX,1		; number of parameter bytes <dim #>*4
	SHL	CX,1		
	ADD	CX,6		; space for rest of parms
	MOV	b$Buf1,CX	; save # of bytes of parms to clear

	POP	DI		; restore registers
	POP	SI		

cEnd	nogen			

	JMP	CleanStack	; clean up stack and return

HAryErrorPopBP: 		
	POP	BP		;get back frame pointer (must be pushed last)
HAryError:			
	JMP	B$ERR_BS	;process bad subscript error

	SUBTTL	B$HARY - compute huge array element pointer
	PAGE
;***
;B$HARY - compute huge array element pointer
;void pascal B$HARY(BX: ad* pAd, i1, ..., iN, ci)
;
;Purpose:
; Runtime entry point. With the array descriptor and indices given, compute the
; segmented pointer to the huge array element.
;
; 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:
; [BX]	= offset of array descriptor
; iN	= element index
; ci	= count of element indecies
;
;Exit:
; ES:BX = far pointer to array element.
;
;Uses:
; None.
;
;Preserves:
; AX,CX,DX	(Compiler requirement)
;
;Exceptions:
;	Error for unallocated array, bad subscript, or index number
;	inconsistency.
;******************************************************************************
cProc	B$HARY,<FAR,PUBLIC>	
parmW	iNdecies		; indecies
parmW	ci			; count of indecies
cBegin				
	PUSH	AX
	PUSH	CX
	PUSH	DX
	PUSH	SI