gwinterf.asm

dos 1.0 其中包含quick basic源代码、内存管理himem emm386 发展历史

; Procedure to expand a global handle table
;
;   Inputs:	CX = #handle table entries to expand the table by
;		DS:DI global info structure
;
;   Outputs:	AX = address of handle table block of requested size
;
;   Destroys:	ES,BX,CX,DX
;
ghexpand:
	mov	ax,ds
	push	cx
	call	ghandle
	pop	cx
	jz	ghfail
	mov	dx,ax
	xor	ax,ax
	mov	bx,DS:[di].hi_htable
	mov	bx,DS:[bx].ht_count
	inc	bx
	add	bx,cx
	shl	bx,1
	shl	bx,1
	add	bx,DS:[di].hi_htable
	jc	ghfail
	add	bx,15
	jc	ghfail
	mov	cl,4
	shr	bx,cl
	; Dont allow master object into reserve swap area
	and	byte ptr [di].gi_cmpflags,not GA_DISCCODE
	call	grealloc
	jcxz	ghfail
	mov	dx,ax
	call	gdref
	jz	ghfail
	mov	bx,ES:[di].ga_size
	mov	cl,4
	shl	bx,cl
	sub	bx,HE_ALIGN
	and	bl,HE_MASK
	sub	bx,DS:[di].hi_htable
	mov	cl,2
	shr	bx,cl
	mov	ax,bx
	mov	bx,DS:[di].hi_htable
	mov	cx,ax
	xchg	DS:[bx].ht_count,ax
	sub	cx,ax
	inc	bx
	inc	bx
	shl	ax,1
	shl	ax,1
	add	bx,ax
	xchg	bx,di
	call	hthread
	mov	DS:[di],cx
	mov	di,bx
	mov	cx,ax
	ret
ghfail:
	xor	cx,cx
	ret

gmemcheck:
	or	ax,ax
	jz	gmemfail
	ret
gmemfail:
	ret


SUBRS	ENDP


IFNDEF NOPCODE
;********** FixHandleTable **********
;    Inputs:	AL = message code (GN_MOVE, GN_DISCARD)
;		BX = handle
;		CX = optional argument (new ps, discard flags)
;*		DS = pGlobalHeap
;*	* Fix Handle Table
;*	exit : n/a - Trashes AX,BX,CX,DX,DI,ES

cProc	FixHandleTable,<NEAR,ATOMIC>
cBegin	FixHandleTable

;*	* find new address
	cmp	al,GN_MOVE
	je	move_in_handle_table
	xor	cx,cx				;* new ps is 0
move_in_handle_table:

	mov	ax,ss
	mov	es,ax				;* set ES to DDS

;*	* find old address
	mov	ax,ds:[bx].he_address

;*	* set up for test : ax = old ps, cx = new ps
	mov	dx,cx				;* dx = psNew
	mov	di,dataOffset $q_mpsnq
	mov	cx,DGROUP:[DI-4]		;* count of entries

;*	* scan till old value matched
	cld
fix_ht_loop:
	jcxz	fix_ht_end
	repne	scasw
	jne	fix_ht_end
	mov	es:[di-2],dx
	jmp	fix_ht_loop
fix_ht_end:

cEnd	FixHandleTable

ENDIF ;!NOPCODE

;*****************************************************************************

; The remainder of this file implements the exported interface to the
; global memory manager.
;
;   DWORD	far PASCAL GlobalSize( HANDLE );
;   HANDLE	far PASCAL GlobalAlloc( WORD, DWORD );
;   HANDLE	far PASCAL GlobalReAlloc( HANDLE, DWORD, WORD );
;   HANDLE	far PASCAL GlobalFree( HANDLE );
;   DWORD	far PASCAL GlobalCompact( DWORD );
;   #define GlobalDiscard( h ) GlobalReAlloc( h, 0L, GMEM_MOVEABLE )
;   HANDLE	far PASCAL GlobalHandle( WORD );
;


;
; Procedure return the handle for a global segment.
;
;   Inputs:	Stack = sp   -> near return return address of ghandle
;			sp+2 -> far return return address of caller
;			sp+6 -> segment address parameter
;
;   Outputs:	AX = handle or zero if invalid segment address
;		Old DS,DI have been pushed on the stack
;		Z flag set if invalid or fixed segment.  O.W. Z flag
;		reset and BX = pointer to handle table entry
;			  CX = flags and count word from handle table
;			  DX = segment address
;			  ES:DI = arena header of object
;			  DS:DI = master object segment address
;
;
;
xhandle PROC	NEAR
	pop	dx		    ; Get near return address
	mov	bx,sp		    ; Get seg parameter from stack
	mov	ax,SS:[bx+4]
	inc	ax		    ; Is it -1?
	jz	xh2		    ; Yes, handle special
	dec	ax		    ; No, restore AX
xh1:
	push	ds		    ; Save DS:DI
	push	di
	mov	ds,pGlobalHeap		; Point to master object
	xor	di,di
	inc	ds:[di].gi_lrulock
	push	dx		    ; Call ghandle and return
	jmp	ghandle 	    ; to our caller directly
xh2:
	mov	ax,ds		    ; If passed -1 use callers DS
	jmp	xh1
xhandle ENDP


cPublic GlobalHandle
;   parmW   seg
cBegin	nogen
gh0:
	call	xhandle
xhandlex:
	dec	ds:[di].gi_lrulock
	pop	di
	pop	ds
	ret	2
cEnd	nogen ;GlobalHandle


cPublic GlobalSize
;   parmW   h
cBegin	nogen
	call	xhandle 		; Call ghandle with handle in DX
	or	dx,dx			; Did we get a segment address?
	jz	xhandlex		; No, all done then
	mov	ax,ES:[di].ga_size	; Yes, get size in paragraphs
	push	ax
	xor	dx,dx			; Returning a long result
	mov	cx,4
gs2:
	shl	ax,1
	rcl	dx,1
	loop	gs2
	pop	cx			; Return number paragraphs in CX
	jmp	short xhandlex
cEnd	nogen ;GlobalSize


cPublic GlobalAlloc,<>,<ds,si,di>
    parmW   flags
    parmD   nbytes
cBegin
	CheckHeap   GlobalAlloc
IFDEF	WINDOWS_OLD_APP
	cmp	fWoaPresent,0
	jz	GA10
	xor	ax,ax
	cCall	WoaRelease,<nbytes,ax>
GA10:
ENDIF	; WINDOWS_OLD_APP
; EnterCrit
	call	genter			; About to modify memory arena
	xor	dx,dx			; No handle
	mov	ax,flags		; Allocate space for object
	lea	bx,nbytes		; Convert requested bytes to paragraphs
	call	gbtop			; ... into BX
	call	galloc
	call	gmemcheck
cEnd	GlobalAlloc


cPublic GlobalReAlloc,<>,<ds,si,di>
    parmW   h
    parmD   nbytes
    parmW   rflags
cBegin
	CheckHeap   GlobalReAlloc

IFDEF	WINDOWS_OLD_APP
	cmp	fWoaPresent,0
	jz	GR10
	cCall	GlobalSize,<h>
	sub	ax, WORD PTR (nbytes)
	sbb	dx, WORD PTR (nbytes+2)
	jnc	GR10
	xor	ax,ax
	cCall	WoaRelease,<nbytes,ax>
GR10:
ENDIF	; WINDOWS_OLD_APP

; EnterCrit
	call	genter		    ; About to modify memory arena
	mov	dx,h
	mov	ax,rflags
	lea	bx,nbytes	    ; Convert requested bytes to paragraphs
	call	gbtop		    ; ... into BX
	call	grealloc	    ; Reallocate global object
	call	gmemcheck
cEnd	GlobalReAlloc


cPublic GlobalFree,<>,<ds,si,di>
    parmW   h
cBegin
	CheckHeap   GlobalFree
; EnterCrit
	call	genter		    ; About to modify memory arena
IFDEF DEBUG
	mov	dx,h
	call	gdref
	or	si,si
	jz	free_ok
	cmp	ch,00h		    ; Debugging check for count underflow
	je	free_ok
	cCall	CowAssertFailed
	DB	"GlobalFree: freeing locked object$"
free_ok:
ENDIF ;DEBUG
	mov	dx,h		    ; Free handle
	xor	cx,cx		    ; Dont check owner field
	call	gfree
cEnd	GlobalFree


cPublic GlobalCompact,<>,<ds,si,di>
    parmD   minBytes
cBegin
IFDEF	DUAL
IFDEF	DEBUG
	mov	cx,fProtectMode		; real mode only!
	jcxz	@F
	BREAKPOINT			; m3 would call cowassertfaileddos3
@@:
ENDIF
ENDIF
	CheckHeap   GlobalCompact
; EnterCrit
	call	genter		    ; About to modify memory arena
	mov	ax,-1
	lea	bx,minBytes
	call	gbtop
	clc			    ; galign should be called with carry clear
	call	galign
	call	gavail		    ; Returns paragraphs in DX:AX
	mov	cx,4		    ; Convert paragraphs to bytes
	push	ax
gcsize1:
	shl	ax,1
	rcl	dx,1
	loop	gcsize1
	pop	cx		    ; let caller to jcxz to test failure
cEnd	GlobalCompact


;*****************************************************************************
;* Debug support

IFDEF	DEBUG

;********** PrintGlobalHeap **********
;*	entry : n/a
;*	* print the contents of the global heap
;*	exit : n/a
;*	* NOTE : this code must be fixed since it throws everything out.

cProc	PrintGlobalHeap, <FAR, PUBLIC, ATOMIC>, <DS,ES,SI,DI,AX,BX,CX,DX>
cBegin	PrintGlobalHeap

	mov	ax,DGROUP
	mov	ds,ax
    assumes DS,DGROUP

;*	* compact the heap (removing any free gaps) -- throw out code as well

	mov	es,pGlobalHeap
	xor	di,di

	mov	es,es:[di].hi_first	 ;* es => first block.
;*	* scan from end till finding free block

Print_next_thunk:
	xor	ah,ah			;get all pieces to print.
	mov	al,es:[di].ga_sig	; Put sig with flags
	mov	ah,es:[di].ga_flags
	mov	bx,es:[di].ga_owner
	mov	cx,es:[di].ga_size
	mov	dx,es:[di].ga_next	;
	mov	si,offset dgroup:szThunkFormat

	push	es
?PLM = 0
	cCall	dprintf, <si,es,ax,bx,cx,dx>
?PLM = 1
	pop	es

	mov	ax,es
	cmp	ax,dx			;see if at end of list
	jz	end_print		; yes lets get out
	mov	es,dx			; no move to segment
	jmp	Print_next_thunk

end_print:

cEnd	PrintGlobalHeap
ENDIF ;DEBUG


;*****************************************************************************

sEnd	KERNEL

	END