371 lines
11 KiB
NASM
371 lines
11 KiB
NASM
;
|
||
; 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
|
||
|