rtinit.asm

[随书类]Dos6.0源代码

cBegin

	cmp	b$ucodeseg,0		; compiled code present?
	jz	NoQlbCode		; brif not -- nothing to do.
	test	b$CtrlFlags,ULInited	; has QuickLib been initialized yet?
	jz	NoQlbCode		; brif not -- nothing to do.
					; (b$nmalloc_start and b$nmalloc_end
					; haven't been properly initialized).

	les	BX,DWORD PTR b$ucodeoff ; ES:BX = ptr to users module

	mov	DI,ES:[BX].OF_COM	; DI = ptr to COMMON block
	mov	CX,b$nmalloc_start	; CX = start of NMALLOC

	cmp	cx,di			; before start of COMMON
	jbe	NoNMALLOC		; brif so -- no QLB nmalloc
	cmp	cx,ES:[BX].OF_FT	; past end of BC_FT? 
	jae	NoNMALLOC		; brif so -- no QLB nmalloc

	push	bx			; save module addr
	call	ClearHelper		; deallocate owners in range + zero
	pop	bx			; restore module addr

	mov	DI,b$nmalloc_end	; DI = end of NMALLOC
NoNMALLOC:
	mov	CX,ES:[BX].OF_FT	; CX = start of BC_FT
	call	ClearHelper		; deallocate owners in range + zero

NoQlbCode:
cEnd

;*** 
;ClearHelper -- helper routine for B$IRTCLR
;
;Purpose:
;	Deallocate all items are in a given range, and zero the range
;	Added with revision [98].
;
;Entry:
;	DI = start addr to zero
;	CX = end addr to zero
;
;Exit:
;	None
;
;Uses:
;	Per convention + DI
;
;Preserves:
;
;Exceptions:
;	None
;
;******************************************************************************
cProc	ClearHelper,<NEAR>,<ES>
cBegin

	push	ds			; set ES=DS
	pop	es

	push	cx			; save end addr
	cCall	<FAR PTR B$ClearRange>,<DI,CX>	; clean out entries whose
					; owners are in range DI ==> CX
	pop	cx			; restore end address

	sub	CX,DI			; CX = count of bytes to clear
	shr	CX,1			; move words not bytes
	xor	AX,AX			; fill with zeros
	REP	STOSW			; clear block at ES:DI
cEnd


	SUBTTL	RT Component CLEAR statement support
	PAGE
;***
;B$RTCLR -	RT Core CLEAR statement support
;void pascal B$RTCLR()
;
;Purpose:
;	Resets all user variables, runtime state variables,
;	and DEF SEG segment.
;
;Entry:
;	None.
;
;Exit:
;	b$seg = DS
;	BC3:
;		COMMON variables cleared
;		USER variables cleared
;	runtime state vars reset
;
;Uses:
;	Per convention.
;
;Exceptions:
;	None.
;****
cProc	B$RTCLR,<NEAR>,<ES,DI>		
cBegin

	CMP	b$ucodeseg,0		;compiled code present?
	JZ	NoCompiledCode		;brif not

	LES	BX,DWORD PTR b$ucodeoff ;load ES:BX with ptr to users module
	MOV	DI,ES:[BX].OF_COM	;get ptr to COMMON block
	MOV	CX,ES:[BX].OF_DAT	; get end of blank COMMON for
					; normal RTM's
	SUB	CX,DI			; get size of blank COMMON

;
;	Set up pointers into COMMON block.  b$commonfirst points to
;	first word of the soft key function table which immediately preceeds
;	the blank COMMON block.  b$commonlast to the end of COMMON block.
;
	PUSH	DS			;get dgroup
	POP	ES			;force ES = DS

	MOV	b$commonfirst,DI	;QB common and soft keys are
	SHR	CX,1			;move words not bytes
	XOR	AX,AX			;fill common with zeros
	REP	STOSW			;CLEAR COMMON block
	MOV	b$commonlast,DI 	;save end of common block

NoCompiledCode: 			
	MOV	b$seg,DS		;Initialize the default DEF SEG segment
	cCall	B$CLEAR 		;clear other user vars and RT data
cEnd
	SUBTTL	B$ClearRange - Clear heap entries in ranges
	PAGE
;***
;B$ClearRange - Clear heap entries in ranges
;void far pascal B$ClearRange(ushort start, ushort end)
;
;Purpose:
; Release all local heap, variable heap, far heap and string entries whose 
; owners fall into a particular range. Except for updating the affected owners,
; other data in range is untouched.
; Exception: Not to be called to clear a range in the variable heap. WILL
;		handle variable heap entries whose owners are in the given
;		range, but the range must not be in the variable heap (the
;		string code, at least, doesn't support this)
;
; The range is inclusive, and must/may include any valid DGROUP range.
; Assumption is made that the heaps will not move during this operation. If
; start>=end, no operation occurs. Debug code asserts that end is greater than
; start. Release code checks, but skips the operation on an invalid range.
;
;Entry:
; rstart = low address of range
; rend	 = ending address of range.
;
;
;Exit:
; none
;
;Uses:
; Per convention, plus preserves ES
;
;******************************************************************************
cProc	B$ClearRange,<FAR,PUBLIC>,ES 
parmW	rstart
parmW	rend
cBegin
	PUSH	DS		; Set ES = DS
	POP	ES		
	MOV	AX,rstart
	MOV	BX,rend


	CMP	AX,BX		; Anything to do?
	JAE	ClearRangeExit	; skip the work if not

	cCall	B$FHClearRange	;Clear far heap

	MOV	AX,rstart
	MOV	BX,rend
	MOV	CX,SP		; CX != 0: release ALL owners in range
	cCall	B$LHClearRange	;Clear local heap

	call	B$TglHeapSptNEAR 
	MOV	AX,rstart	
	MOV	BX,rend		
	MOV	CX,SP		; CX != 0: release ALL owners in range
	cCall	B$LHClearRange	; Clear variable heap
	call	B$TglHeapSptNEAR 
	MOV	AX,rstart
	MOV	BX,rend
	cCall	B$SSClearRange	;Clear string space

ClearRangeExit: 		

cEnd

	SUBTTL
	PAGE
;***
;B$CLEAR - common CLEAR statement support
;void pascal B$CLEAR()
;
;Purpose:
;	Resets user variables, and runtime state variables.
;Entry:
;	None.
;Exit:
;	BC3:
;		USER variables cleared
;	runtime state vars reset
;Uses:
;	None.
;Exceptions:
;	None.
;******************************************************************************

cProc	B$CLEAR,<NEAR,PUBLIC>,<ES,SI,DI> 
cBegin
	PUSH	DS			;Get dgroup
	POP	ES			;force ES = DS
	XOR	AX,AX			;fill user data with zeros

	TEST	b$CtrlFlags, NoInitBcVars ; have BC_Vars already been
	JNZ	NoCompiledData		; cleared?  brif so -- don't
					; clear them again.  An NMALLOC
					; could have been done by an XI
					; initializer!

	CMP	b$ucodeseg,AX		;compiled code present?
	JZ	NoCompiledData		;brif not

; Clear the named common segments, including NMALLOC
	PUSH	ES			;Save ES
	LES	BX,DWORD PTR b$ucodeoff ;load ES:BX with ptr to users module
	MOV	DI,ES:[BX].OF_DAT	;get ptr to start of user data
	MOV	CX,ES:[BX].OF_FT	;get ptr to end of user data
	POP	ES			;recover ES
	SUB	CX,DI			;compute size of user data
	SHR	CX,1			;move words not bytes
	REP	STOSW			;CLEAR user data block

NoCompiledData: 			
	MOV	DI,OFFSET DGROUP:STARTZERO	;get ptr to start of RT data
	MOV	CX,STOPZERO-STARTZERO	;compute size of RT data
	REP	STOSB			;clear runtime data state vars


;
; Fill the stack from [b$pend] to [SP] for known data, for use by FRE(-2)
;
	MOV	BX,SP			; location to end at
	cCall	<FAR PTR B$STACKINIT>	
cEnd
	SUBTTL	B$STACKINIT - Init Stack Area
	PAGE
;*** 
;B$STACKINIT - Init Stack Area
;
;Purpose:
; Load stack area with known data for use by FRE(-2)
;
;Entry:
; [BX]	=  Stack Address at which to STOP filling
;
;Exit:
; none
;
;Uses:
; per convention + DI & ES
;
;******************************************************************************
cProc	B$STACKINIT,<FAR,PUBLIC>
cBegin				
	TEST	b$CtrlFlags,NoSTACKINIT ; B$STACKINIT disabled?
	JNZ	StackInitExit	; brif so -- just exit
	SUB	BX,4		; Adjust BX for return address on stack
	PUSH	SS		
	POP	ES		
	MOV	DI,[b$pend]	; [ES:DI] points to stack area
	MOV	AX,-STACK_MIN	; word to be written to stack area
InitStackLoop:			
	STOSW			; put into unused stack space
	INC	AX		; bump count of available bytes
	INC	AX		
	CMP	DI,BX		; have we reached our stack?
	JC	InitStackLoop	; loop until stack filled

StackInitExit:			
cEnd				

	SUBTTL	Def Seg setup routines.
	PAGE

;***
; B$DSG0 - Set BASIC Segment Address to Data Segment (DEF SEG w/no parameter)
;
; Purpose:
;  Runtime Entry Point. Save DS in b$seg
;
; Input:
;  NONE
;
; Output:
;  [b$seg] == DS
;
; Modifies:
;	NONE
;
;******************************************************************************
cProc	B$DSG0,<PUBLIC,FAR>	
cBegin				
	MOV	[b$seg],DS	;Save initial data seg
cEnd				

;***
; B$DSEG - Set BASIC Segment Address (DEF SEG w/parameter)
;
; Purpose:
;  Runtime Entry Point. Save given segment address in b$seg
;
; Input:
;  new segment address
;
; Output:
;  [b$seg] set.
;
; Modifies:
;	NONE
;
;******************************************************************************
cProc	B$DSEG,<PUBLIC,FAR>	
parmW	newseg			
cBegin				
	MOV	AX,newseg	; get...
	MOV	[b$seg],AX	; and save new b$seg value
cEnd				

;*** 
;B$GetCompSwitches
;
;Purpose:
;	Added with revision [85].  The interpreter calls this routine
;	to find out whether or not any QuickLIB modules were compiled
;	with /V or /W.	Since the interpreter uses both or neither of
;	these, we just return TRUE or FALSE with no differentiation
;	between V or W.
;Entry:
;	None
;Exit:
;	AX=0  if no QuickLIB modules were compiled with /V or /W
;	AX<>0 if at least one QuickLIB routine was compiled /V or /W
;Uses:
;	None
;Exceptions:
;	None
;******************************************************************************
cProc	B$GetCompSwitches,<PUBLIC,FAR>
cBegin
	MOV	AX,[b$userflags]	;get switches used
	AND	AX,u_sw_w + u_sw_v	;mask down to just /V and /W
cEnd					;AX = 0 if no /V or /W, else nonzero

	page

sEnd	RT_TEXT
	END