;
; xenix memory calls for MSDOS
;
; CAUTION: The following routines rely on the fact that arena_signature and
; arena_owner_system are all equal to zero and are contained in DI.
;
INCLUDE DOSSEG.ASM
CODE SEGMENT BYTE PUBLIC 'CODE'
ASSUME SS:DOSGROUP,CS:DOSGROUP
.xlist
.xcref
INCLUDE DOSSYM.ASM
INCLUDE DEVSYM.ASM
.cref
.list
TITLE ALLOC.ASM - memory arena manager
NAME Alloc
SUBTTL memory allocation utility routines
PAGE
;
; arena data
;
i_need arena_head,WORD ; seg address of start of arena
i_need CurrentPDB,WORD ; current process data block addr
i_need FirstArena,WORD ; first free block found
i_need BestArena,WORD ; best free block found
i_need LastArena,WORD ; last free block found
i_need AllocMethod,BYTE ; how to alloc first(best)last
;
; arena_free_process
; input: BX - PID of process
; output: free all blocks allocated to that PID
;
procedure arena_free_process,NEAR
ASSUME DS:NOTHING,ES:NOTHING
MOV DI,arena_signature
MOV AX,[arena_head]
CALL Check_Signature ; ES <- AX, check for valid block
arena_free_process_loop:
retc
PUSH ES
POP DS
CMP DS:[arena_owner],BX ; is block owned by pid?
JNZ arena_free_next ; no, skip to next
MOV DS:[arena_owner],DI ; yes... free him
arena_free_next:
CMP BYTE PTR DS:[DI],arena_signature_end
; end of road, Jack?
retz ; never come back no more
CALL arena_next ; next item in ES/AX carry set if trash
JMP arena_free_process_loop
arena_free_process ENDP
;
; arena_next
; input: DS - pointer to block head
; output: AX,ES - pointers to next head
; carry set if trashed arena
;
procedure arena_next,NEAR
ASSUME DS:NOTHING,ES:NOTHING
MOV AX,DS ; AX <- current block
ADD AX,DS:[arena_size] ; AX <- AX + current block length
INC AX ; remember that header!
;
; fall into check_signature and return
;
; CALL check_signature ; ES <- AX, carry set if error
; RET
arena_next ENDP
;
; check_signature
; input: AX - address of block header
; output: ES=AX, carry set if signature is bad
;
procedure check_signature,NEAR
ASSUME DS:NOTHING,ES:NOTHING
MOV ES,AX ; ES <- AX
CMP BYTE PTR ES:[DI],arena_signature_normal
; IF next signature = not_end THEN
JZ check_signature_ok ; GOTO ok
CMP BYTE PTR ES:[DI],arena_signature_end
; IF next signature = end then
JZ check_signature_ok ; GOTO ok
STC ; set error
return
check_signature_ok:
CLC
return
Check_signature ENDP
;
; Coalesce - combine free blocks ahead with current block
; input: DS - pointer to head of free block
; output: updated head of block, AX is next block
; carry set -> trashed arena
;
procedure Coalesce,NEAR
ASSUME DS:NOTHING,ES:NOTHING
CMP BYTE PTR DS:[DI],arena_signature_end
; IF current signature = END THEN
retz ; GOTO ok
CALL arena_next ; ES, AX <- next block, Carry set if error
retc ; IF no error THEN GOTO check
coalesce_check:
CMP ES:[arena_owner],DI
retnz ; IF next block isnt free THEN return
MOV CX,ES:[arena_size] ; CX <- next block size
INC CX ; CX <- CX + 1 (for header size)
ADD DS:[arena_size],CX ; current size <- current size + CX
MOV CL,ES:[DI] ; move up signature
MOV DS:[DI],CL
JMP coalesce ; try again
Coalesce ENDP
SUBTTL $Alloc - allocate space in memory
PAGE
;
; Assembler usage:
; MOV BX,size
; MOV AH,Alloc
; INT 21h
; AX:0 is pointer to allocated memory
; BX is max size if not enough memory
;
; Description:
; Alloc returns a pointer to a free block of
; memory that has the requested size in paragraphs.
;
; Error return:
; AX = error_not_enough_memory
; = error_arena_trashed
;
procedure $ALLOC,NEAR
ASSUME DS:NOTHING,ES:NOTHING
XOR AX,AX
MOV DI,AX
MOV [FirstArena],AX ; init the options
MOV [BestArena],AX
MOV [LastArena],AX
PUSH AX ; alloc_max <- 0
MOV AX,[arena_head] ; AX <- beginning of arena
CALL Check_signature ; ES <- AX, carry set if error
JC alloc_err ; IF error THEN GOTO err
alloc_scan:
PUSH ES
POP DS ; DS <- ES
CMP DS:[arena_owner],DI
JZ alloc_free ; IF current block is free THEN examine
alloc_next:
CMP BYTE PTR DS:[DI],arena_signature_end
; IF current block is last THEN
JZ alloc_end ; GOTO end
CALL arena_next ; AX, ES <- next block, Carry set if error
JNC alloc_scan ; IF no error THEN GOTO scan
alloc_err:
POP AX
alloc_trashed:
error error_arena_trashed
alloc_end:
CMP [FirstArena],0
JNZ alloc_do_split
alloc_fail:
invoke get_user_stack
POP BX
MOV [SI].user_BX,BX
error error_not_enough_memory
alloc_free:
CALL coalesce ; add following free block to current
JC alloc_err ; IF error THEN GOTO err
MOV CX,DS:[arena_size]
POP DX ; check for max found size
CMP CX,DX
JNA alloc_test
MOV DX,CX
alloc_test:
PUSH DX
CMP BX,CX ; IF BX > size of current block THEN
JA alloc_next ; GOTO next
CMP [FirstArena],0
JNZ alloc_best
MOV [FirstArena],DS ; save first one found
alloc_best:
CMP [BestArena],0
JZ alloc_make_best ; initial best
PUSH ES
MOV ES,[BestArena]
CMP ES:[arena_size],CX ; is size of best larger than found?
POP ES
JBE alloc_last
alloc_make_best:
MOV [BestArena],DS ; assign best
alloc_last:
MOV [LastArena],DS ; assign last
JMP alloc_next
;
; split the block high
;
alloc_do_split_high:
MOV DS,[LastArena]
MOV CX,DS:[arena_size]
SUB CX,BX
MOV DX,DS
JE alloc_set_owner ; sizes are equal, no split
ADD DX,CX ; point to next block
MOV ES,DX ; no decrement!
DEC CX
XCHG BX,CX ; bx has size of lower block
JMP alloc_set_sizes ; cx has upper (requested) size
;
; we have scanned memory and have found all appropriate blocks
; check for the type of allocation desired; first and best are identical
; last must be split high
;
alloc_do_split:
CMP BYTE PTR [AllocMethod], 1
JA alloc_do_split_high
MOV DS,[FirstArena]
JB alloc_get_size
MOV DS,[BestArena]
alloc_get_size:
MOV CX,DS:[arena_size]
SUB CX,BX ; get room left over
MOV AX,DS
MOV DX,AX ; save for owner setting
JE alloc_set_owner ; IF BX = size THEN (don't split)
ADD AX,BX
INC AX ; remember the header
MOV ES,AX ; ES <- DS + BX (new header location)
DEC CX ; CX <- size of split block
alloc_set_sizes:
MOV DS:[arena_size],BX ; current size <- BX
MOV ES:[arena_size],CX ; split size <- CX
MOV BL,arena_signature_normal
XCHG BL,DS:[DI] ; current signature <- 4D
MOV ES:[DI],BL ; new block sig <- old block sig
MOV ES:[arena_owner],DI
alloc_set_owner:
MOV DS,DX
MOV AX,[CurrentPDB]
MOV DS:[arena_owner],AX
MOV AX,DS
INC AX
POP BX
transfer SYS_RET_OK
$alloc ENDP
SUBTTL $SETBLOCK - change size of an allocated block (if possible)
PAGE
;
; Assembler usage:
; MOV ES,block
; MOV BX,newsize
; MOV AH,setblock
; INT 21h
; if setblock fails for growing, BX will have the maximum
; size possible
; Error return:
; AX = error_invalid_block
; = error_arena_trashed
; = error_not_enough_memory
; = error_invalid_function
;
procedure $SETBLOCK,NEAR
ASSUME DS:NOTHING,ES:NOTHING
MOV DI,arena_signature
MOV AX,ES
DEC AX
CALL check_signature
JNC setblock_grab
setblock_bad:
JMP alloc_trashed
setblock_grab:
MOV DS,AX
CALL coalesce
JC setblock_bad
MOV CX,DS:[arena_size]
PUSH CX
CMP BX,CX
JBE alloc_get_size
JMP alloc_fail
$setblock ENDP
SUBTTL $DEALLOC - free previously allocated piece of memory
PAGE
;
; Assembler usage:
; MOV ES,block
; MOV AH,dealloc
; INT 21h
;
; Error return:
; AX = error_invalid_block
; = error_arena_trashed
;
procedure $DEALLOC,NEAR
ASSUME DS:NOTHING,ES:NOTHING
MOV DI,arena_signature
MOV AX,ES
DEC AX
CALL check_signature
JC dealloc_err
MOV ES:[arena_owner],DI
transfer SYS_RET_OK
dealloc_err:
error error_invalid_block
$DEALLOC ENDP
SUBTTL $AllocOper - get/set allocation mechanism
PAGE
;
; Assembler usage:
; MOV AH,AllocOper
; MOV BX,method
; MOV AL,func
; INT 21h
;
; Error return:
; AX = error_invalid_function
;
procedure $AllocOper,NEAR
ASSUME DS:NOTHING,ES:NOTHING
CMP AL,1
JB AllocOperGet
JZ AllocOperSet
error error_invalid_function
AllocOperGet:
MOV AL,BYTE PTR [AllocMethod]
XOR AH,AH
transfer SYS_RET_OK
AllocOperSet:
MOV [AllocMethod],BL
transfer SYS_RET_OK
$AllocOper ENDP
do_ext
CODE ENDS
END
���������