MS-DOS/v2.0/source/ALLOC.ASM
2018-09-21 17:53:34 -07:00

371 lines
11 KiB
NASM
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;
; 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