;       SCCSID = @(#)demarena.asm	6.1 91/07/12
;       SCCSID = @(#)demarena.asm       6.2 91/03/04
;       SCCSID = @(#)demarena.asm       6.2 91/03/04
;BN001;
; LINE TAGS BEGINNING WITH 'B' ARE FOR THE CRUISER RELEASE:  OS/2 VERSION 2.0
;BN001;
TITLE DemArena.ASM - memory arena manager

;********************************************************************* ;BN001;
; REVISION HISTORY                                                     ;BN001;
;                                                                      ;BN001;
;  B001  DCR 1329 - 2/16/91 TMB -  Add support for loading DOS device  ;BN001;
;                   drivers and TSRs into UMBs.                        ;BN001;
;                                                                      ;BN001;
;                   Module dependencies:                               ;BN001;
;                   drv6\src\dos\v86code\v86init.asm                   ;BN001;
;                   drv6\src\dos\v86code\demarena.asm                  ;BN001;
;                   drv6\src\dos\v86code\demcnst.asm                   ;BN001;
;                   drv6\src\dos\v86code\demproc.asm                   ;BN001;
;                   drv6\src\dos\v86code\demexec.asm                   ;BN001;
;                   drv6\src\dos\v86code\demumb.inc                    ;BN001;
;                   drv6\src\vdev\vbios.c                              ;BN001;
;                   drv6\src\vdev\propname.h                           ;BN001;
;                   drv6\inc\vdmprop.inc                               ;BN001;
;                   drv6\h\vdmprop.h                                   ;BN001;
;                   drv6\src\dos\mvdm\dem.c                            ;BN001;
;**********************************************************************;BN001;
;
; Memory related system calls and low level routines for MSDOS 2.X.
; I/O specs are defined in DISPATCH.
;
;   $ALLOC
;   $SETBLOCK
;   $DEALLOC
;   $AllocOper
;   arena_free_process
;   arena_next
;   check_signature
;   Coalesce
;
;   Modification history:
;
;       Created: ARR 30 March 1983
;
;       danno   08-Nov-1988     Segments/macros/includes for MVDM
;

.xlist
include v86seg.inc
;
; get the appropriate segment definitions
;
.xcref
include error.inc
.cref

include arena.inc

.xcref
include basemaca.inc
include osmaca.inc
include oldmaca.inc
include demmac.inc
include dossymc.inc
.cref
.list

.lall

        CpuMode 386

V86CODE SEGMENT
        ASSUME  CS:V86GROUP

        EXTRN   ECritMem:NEAR
        EXTRN   LCritMem:NEAR
        EXTRN   get_user_stack:NEAR
                                                                         ;BN001;
        I_am    start_arena,WORD,<-1>   ; M000: this is the first arena  ;BN001;
                                        ; M000: from which DOS will      ;BN001;
                                        ; M000: start its scan for alloc.;BN001;
                                        ; seg address of arena from which;BN001;
                                        ; to start allocation scan       ;BN001;
                                                                         ;BN001;

SUBTTL memory allocation utility routines
PAGE
;
; arena data
;
;m        ReferV86    arena_head,WORD         ; seg address of start of arena
        ReferV86    CurrentPDB,WORD         ; current process data block addr
;m        ReferV86    FirstArena,WORD         ; first free block found
;m        ReferV86    BestArena,WORD          ; best free block found
;m        ReferV86    LastArena,WORD          ; last free block found
;m        ReferV86    AllocMethod,BYTE        ; how to alloc first(best)last
        ReferV86    EXTERR_LOCUS,BYTE       ; Extended Error Locus

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

;BD001;  MOV     DI,arena_signature
;m        MOV     AX,[arena_head]

        mov     ah,52h                  ; mdr get DOS internal values
        int     21h                     ; mdr
        mov     ax,es:[bx-2]            ; mdr this should be first mem block
                                                                         ;BN001;
arena_free_process_start:                                                ;BN001;
                                                                         ;BN001;
        MOV     DI,arena_signature                                       ;BN001;
        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     short 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     ;BD001                 ; never come back no more
        CALL    arena_next              ; next item in ES/AX carry set if trash
        JMP     arena_free_process_loop
;arena_chk_umbs:                         ; M010 - Start                   ;BN001;
;        mov     ax, [umb_head]          ; ax = umb_head                  ;BN001;
;        cmp     ax, 0ffffh              ; Q: is umb_head initialized     ;BN001;
;        je      ret_label               ; N: we're done                  ;BN001;
;                                                                         ;BN001;
;        mov     di, ds                  ; di = last arena                ;BN001;
;        cmp     di, ax                  ; Q: is last arena above umb_head;BN001;
;        jae     ret_label               ; Y: we've scanned umbs also.done;BN001;
;        jmp     short arena_free_process_start                           ;BN001;
;                                        ; M010 - End                     ;BN001;
;                                                                         ;BN001;

EndProc arena_free_process

;
; arena_next
; input:    DS - pointer to block head
;               (di) = 0                                                 ;BN001;
; 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
EndProc arena_next

;
; check_signature
;                                                                        ;BN001;
;       ENTRY   (AX) = address of block header                           ;BN001;
;               (di) = 0                                                 ;BN001;
;       EXIT     ES = AX                                                 ;BN001;
;               'C' clear if signature good                              ;BN001;
;               'C' set if signature bad                                 ;BN001;
;       USES    ES, Flags                                                ;BN001;
;                                                                        ;BN001;
;
        procedure   check_signature,NEAR
        ASSUME  DS:NOTHING,ES:NOTHING
        MOV     ES,AX                   ; ES <- AX

        mov     ax,es:[di]              ;mdr
        mov     ax,es                   ;mdr

        CMP     BYTE PTR ES:[DI],arena_signature_normal
                                        ; IF next signature = not_end THEN
        retz                            ;   GOTO ok
        CMP     BYTE PTR ES:[DI],arena_signature_end
                                        ; IF next signature = end then
        retz                            ;   GOTO ok
        STC                             ; set error

ret_label:                                                               ;BN001;
        return

EndProc Check_signature

;                                                                        ;BN001;
; Coalesce - combine free blocks ahead with current block                ;BN001;
;                                                                        ;BN001;
;  Coalesce adds the block following the argument to the argument block, ;BN001;
;  iff it's free.  Coalesce is usually used to join free blocks, but     ;BN001;
;  some callers (such as $setblock) use it to join a free block to it's  ;BN001;
;  preceeding allocated block.                                           ;BN001;
;                                                                        ;BN001;
;             ENTRY   (ds) = pointer to the head of a free block         ;BN001;
;                     (di) = 0                                           ;BN001;
;             EXIT    'C' clear if OK                                    ;BN001;
;                       (ds) unchanged, this block updated               ;BN001;
;                       (ax) = address of next block, IFF not at end     ;BN001;
;                     'C' set if arena trashed                           ;BN001;
;             USES    (cx)                                               ;BN001;
;                                                                        ;BN001;
;        Output:   updated head of block, AX is next block               ;BN001;

        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
EndProc Coalesce

SUBTTL $Alloc - allocate space in memory
;                                                                           ;PAGE                                                                                ;BN001;
;                                                                           ;;                                                                                   ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;  $Alloc services the INT21 that allocates memory space to a program.   ;BN001;
;                                                                           ;;  Alloc returns   a  pointer  to  a  free  block of                     ;BN001;
;                                                                           ;;  memory that has the requested  size  in  paragraphs.                  ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;  If the allocation strategy is HIGH_FIRST or HIGH_ONLY memory is       ;BN001;
;                                                                           ;;  scanned from umb_head if not from arena_head. If the strategy is      ;BN001;
;                                                                           ;;  HIGH_FIRST the scan is continued from arena_head if a block of        ;BN001;
;                                                                           ;;  appropriate size is not found in the UMBs. If the strategy is         ;BN001;
;                                                                           ;;  HIGH_FIRST+HIGH_ONLY only the UMBs are scanned for memory.            ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;  In either case if bit 0 of UmbFlag is not initialized then the scan   ;BN001;
;                                                                           ;;  starts from arena_head.                                               ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;  Assembler usage:                                                      ;BN001;
;                                                                           ;;      MOV     BX,size                                                   ;BN001;
;                                                                           ;;      MOV     AH,Alloc                                                  ;BN001;
;                                                                           ;;      INT     21h                                                       ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;  BUGBUG - a lot can be done to improve performance.  We can set marks  ;BN001;
;                                                                           ;;  so that we start searching the arena at it's first non-trivial free   ;BN001;
;                                                                           ;;  block, we can peephole the code, etc.  (We can move some subr calls   ;BN001;
;                                                                           ;;  inline, etc.)  I assume that this is called rarely and that the arena ;BN001;
;                                                                           ;;  doesn't have too many memory objects in it beyond the first free one. ;BN001;
;                                                                           ;;  verify that this is true; if so, this can stay as is                  ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;       ENTRY   (bx) = requested size, in bytes                          ;BN001;
;                                                                           ;;               (DS) = (ES) = DOSGROUP                                   ;BN001;
;                                                                           ;;       EXIT    'C' clear if memory allocated                            ;BN001;
;                                                                           ;;                 (ax:0) = address of requested memory                   ;BN001;
;                                                                           ;;               'C' set if request failed                                ;BN001;
;                                                                           ;;                 (AX) = error_not_enough_memory                         ;BN001;
;                                                                           ;;                   (bx) = max size we could have allocated              ;BN001;
;                                                                           ;;                 (ax) = error_arena_trashed                             ;BN001;
;                                                                           ;;       USES    All                                                      ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;        procedure   $ALLOC,NEAR
;                                                                           ;        ASSUME  DS:NOTHING,ES:NOTHING
;                                                                           ;
;                                                                           ;        EnterCrit   critMem
;                                                                           ;;*********************************************************************   ;BN001;
;                                                                           ;;               added for UMB support                                    ;BN001;
;                                                                           ;;*********************************************************************   ;BN001;
;                                                                           ;        MOV     AX,[arena_head]                                          ;BN001;
;                                                                           ;        MOV     [start_arena],AX        ; default to load low            ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        TEST    [AllocMethod], HIGH_FIRST+HIGH_ONLY                      ;BN001;
;                                                                           ;        jz      norm_alloc              ; no, scan from arena header     ;BN001;
;                                                                           ;        TEST    [UmbFlag],UMBAVAIL      ; Are UMBs useable?              ;BN001;
;                                                                           ;        jz      norm_alloc              ;                                ;BN001;
;                                                                           ;        TEST    [UmbFlag], DOSALLOC     ; Do we scan from UMB_HEAD even  ;BN001;
;                                                                           ;                                        ; if not linked?                 ;BN001;
;                                                                           ;        jnz     al_001                  ; start at UMB_HEAD anyway(OS/2) ;BN001;
;                                                                           ;        TEST    [UmbFlag],LINKSTATE     ; Are UMBs already linked in?    ;BN001;
;                                                                           ;        jz      norm_alloc              ; yes, scan from arena_head      ;BN001;
;                                                                           ;al_001:                                                                  ;BN001;
;                                                                           ;        MOV     AX,[umb_head]           ; otherwise, start with umbs     ;BN001;
;                                                                           ;        cmp     ax,-1                   ; just in case                   ;BN001;
;                                                                           ;        je      norm_alloc                                               ;BN001;
;                                                                           ;        MOV     [start_arena], AX                                        ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;norm_alloc:                                                              ;BN001;
;                                                                           ;        XOR     AX,AX
;                                                                           ;        MOV     DI,AX
;                                                                           ;
;                                                                           ;        MOV     [FirstArena],AX         ; init the options
;                                                                           ;        MOV     [BestArena],AX
;                                                                           ;        MOV     [LastArena],AX
;                                                                           ;
;                                                                           ;        PUSH    AX                      ; alloc_max <- 0
;                                                                           ;start_scan:                                                              ;BN001;
;                                                                           ;;BD001;  MOV     AX,[arena_head]         ; AX <- beginning of arena
;                                                                           ;        MOV     AX,[start_arena]        ; AX = beginning of arena        ;BN001;
;                                                                           ;        CALL    Check_signature         ; ES <- AX, carry set if error
;                                                                           ;        JC      short alloc_err         ; IF error THEN GOTO err
;                                                                           ;
;                                                                           ;alloc_scan:
;                                                                           ;        PUSH    ES
;                                                                           ;        POP     DS                      ; DS <- ES
;                                                                           ;        CMP     DS:[arena_owner],DI
;                                                                           ;        JZ      short alloc_free        ; IF current block is free THEN examine
;                                                                           ;
;                                                                           ;alloc_next:
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        test    [UmbFlag], LINKSTATE    ; Q: are umb's linked            ;BN001;
;                                                                           ;        jz      norm_strat              ; N: see if we reached last      ;BN001;
;                                                                           ;                                        ;    arena                       ;BN001;
;                                                                           ;        test    [AllocMethod], HIGH_FIRST                                ;BN001;
;                                                                           ;                                        ; Q: is alloc strategy           ;BN001;
;                                                                           ;                                        ;    high_first                  ;BN001;
;                                                                           ;        jz      norm_strat              ; N: see if we reached last      ;BN001;
;                                                                           ;                                        ;        arena                   ;BN001;
;                                                                           ;        mov     ax, [start_arena]                                        ;BN001;
;                                                                           ;        cmp     ax, [arena_head]        ; Q: did we start scan from      ;BN001;
;                                                                           ;                                        ;    arena_head                  ;BN001;
;                                                                           ;        jne     norm_strat              ; N: see if we reached last      ;BN001;
;                                                                           ;                                        ; arena                          ;BN001;
;                                                                           ;        mov     ax, ds                  ; ax = current block             ;BN001;
;                                                                           ;        cmp     ax, [umb_head]          ; Q: check against umb_head      ;BN001;
;                                                                           ;        jmp     short alloc_chk_end                                      ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;norm_strat:                             ; M000 - end                     ;BN001;
;                                                                           ;                                        ; check against last sig '5A'    ;BN001;
;                                                                           ;        CMP     BYTE PTR DS:[DI],arena_signature_end
;                                                                           ;alloc_chk_end:                          ; M000                           ;BN001;
;                                                                           ;                                        ; IF current block is last THEN
;                                                                           ;        JZ      short 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:
;                                                                           ;        LeaveCrit   critMem
;                                                                           ;        error   error_arena_trashed
;                                                                           ;
;                                                                           ;alloc_end:
;                                                                           ;        CMP     [FirstArena],0
;                                                                           ;        JNZ     alloc_do_split
;                                                                           ;
;                                                                           ;        mov     ax, [arena_head]                                         ;BN001;
;                                                                           ;        cmp     ax, [start_arena]       ; Q: started scanning from       ;BN001;
;                                                                           ;                                        ;    arena_head                  ;BN001;
;                                                                           ;        je      alloc_fail              ; Y: not enough memory           ;BN001;
;                                                                           ;                                        ; N:                             ;BN001;
;                                                                           ;                                        ; Q: is the alloc strat          ;BN001;
;                                                                           ;                                        ;    HIGH_ONLY                   ;BN001;
;                                                                           ;        test    [AllocMethod], HIGH_ONLY                                 ;BN001;
;                                                                           ;        jnz     alloc_fail              ; Y: return size of              ;BN001;
;                                                                           ;                                        ;    largest UMB                 ;BN001;
;                                                                           ;        mov     [start_arena], ax       ; N: start scanning from         ;BN001;
;                                                                           ;                                        ;    arena_head                  ;BN001;
;                                                                           ;        jmp     short start_scan                                         ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;alloc_fail:
;                                                                           ;        invoke  get_user_stack
;                                                                           ;        POP     BX
;                                                                           ;        MOV     [SI].user_BX,BX
;                                                                           ;        LeaveCrit   critMem
;                                                                           ;        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     short 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     short alloc_best
;                                                                           ;        MOV     [FirstArena],DS         ; save first one found
;                                                                           ;alloc_best:
;                                                                           ;        CMP     [BestArena],0
;                                                                           ;        JZ      short 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     short 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      short 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     short 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:
;                                                                           ;;BD001; xor     cx, cx                                                   ;BN001;
;                                                                           ;        mov     cl, byte ptr [AllocMethod]                               ;BN001;
;                                                                           ;        and     cl, HF_HO_MASK          ; mask off bit 7 and bit 6       ;BN001;
;                                                                           ;        cmp     cl, BEST_FIT            ; Q; is the alloc strategy       ;BN001;
;                                                                           ;                                        ;    best_fit                    ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;;BD001;  CMP     BYTE PTR [AllocMethod], 1
;                                                                           ;        JA      alloc_do_split_high
;                                                                           ;        MOV     DS,[FirstArena]
;                                                                           ;        JB      short 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      short 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
;                                                                           ;        LeaveCrit   critMem
;                                                                           ;        transfer    SYS_RET_OK
;                                                                           ;
;                                                                           ;EndProc $alloc
;                                                                           ;
;                                                                           ;SUBTTL $SETBLOCK - change size of an allocated block (if possible)
;                                                                           ;PAGE
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;  Setblock changes the size of an allocated block.  First, we coalesce  ;BN001;
;                                                                           ;;  any following free space onto this block; then we try to trim the     ;BN001;
;                                                                           ;;  block down to the size requested.                                     ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;  Note that if the guy wants to grow the block but that growth fails,   ;BN001;
;                                                                           ;;  we still go ahead and coalesce any trailing free blocks onto it.      ;BN001;
;                                                                           ;;  Thus the maximum-size-possible value that we return has already       ;BN001;
;                                                                           ;;  been allocated!  This is a bug, dare we fix it?  BUGBUG               ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;  NOTE - $SETBLOCK is in bed with $ALLOC and jumps into $ALLOC to       ;BN001;
;                                                                           ;;          finish it's work.  FOr this reason we build the allocsf       ;BN001;
;                                                                           ;;          structure on the frame, to make us compatible with $ALLOCs    ;BN001;
;                                                                           ;;          code.                                                         ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;   Assembler usage:                                                     ;BN001;
;                                                                           ;;           MOV     ES,block                                             ;BN001;
;                                                                           ;;           MOV     BX,newsize                                           ;BN001;
;                                                                           ;;           MOV     AH,setblock                                          ;BN001;
;                                                                           ;;           INT     21h                                                  ;BN001;
;                                                                           ;;         if setblock fails for growing, BX will have the maximum        ;BN001;
;                                                                           ;;         size possible                                                  ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;       EXIT    'C' clear if OK                                          ;BN001;
;                                                                           ;;               'C' set if error                                         ;BN001;
;                                                                           ;;   Error return:                                                        ;BN001;
;                                                                           ;;           AX = error_invalid_block                                     ;BN001;
;                                                                           ;;              = error_arena_trashed                                     ;BN001;
;                                                                           ;;              = error_not_enough_memory                                 ;BN001;
;                                                                           ;;              = error_invalid_function                                  ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;        procedure   $SETBLOCK,NEAR
;                                                                           ;        ASSUME  DS:NOTHING,ES:NOTHING
;                                                                           ;        EnterCrit   critMem
;                                                                           ;        MOV     DI,arena_signature
;                                                                           ;        MOV     AX,ES
;                                                                           ;        DEC     AX
;                                                                           ;        CALL    check_signature
;                                                                           ;        JNC     short 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
;                                                                           ;EndProc $setblock
;                                                                           ;
;                                                                           ;SUBTTL $DEALLOC - free previously allocated piece of memory
;                                                                           ;PAGE
;                                                                           ;;
;                                                                           ;;       ENTRY   (es) = address of item                                   ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;       EXIT    'C' clear of OK                                          ;BN001;
;                                                                           ;;           Error return:                                                ;BN001;
;                                                                           ;;               'C' set if error                                         ;BN001;
;                                                                           ;;           AX = error_invalid_block                                     ;BN001;
;                                                                           ;;              = error_arena_trashed                                     ;BN001;
;                                                                           ;;
;                                                                           ;;   Assembler usage:
;                                                                           ;;           MOV     ES,block
;                                                                           ;;           MOV     AH,dealloc
;                                                                           ;;           INT     21h
;                                                                           ;;
;
;                                                                           ;        procedure   $DEALLOC,NEAR
;                                                                           ;        ASSUME  DS:NOTHING,ES:NOTHING
;                                                                           ;        EnterCrit   critMem
;                                                                           ;        MOV     DI,arena_signature
;                                                                           ;        MOV     AX,ES
;                                                                           ;        DEC     AX
;                                                                           ;        CALL    check_signature
;                                                                           ;        JC      short dealloc_err
;                                                                           ;        MOV     ES:[arena_owner],DI
;                                                                           ;        LeaveCrit   critMem
;                                                                           ;        transfer    SYS_RET_OK
;                                                                           ;
;                                                                           ;dealloc_err:
;                                                                           ;        LeaveCrit   critMem
;                                                                           ;        error   error_invalid_block
;                                                                           ;EndProc $DEALLOC
;                                                                           ;
;                                                                           ;SUBTTL $AllocOper - get/set allocation mechanism
;                                                                           ;PAGE
;                                                                           ;;
;                                                                           ;;   Assembler usage:
;                                                                           ;;           MOV     AH,AllocOper
;                                                                           ;;           MOV     BX,method
;                                                                           ;;           MOV     AL,func
;                                                                           ;;           INT     21h
;                                                                           ;;  ENTRY                                                                 ;BN001;
;                                                                           ;;          (al) = 0                                                      ;BN001;
;                                                                           ;;            Get allocation Strategy in (ax)                             ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;          (al) = 1, (bx) = method = z00000xy                            ;BN001;
;                                                                           ;;            Set allocation strategy.                                    ;BN001;
;                                                                           ;;             z  = 1  => HIGH_FIRST                                      ;BN001;
;                                                                           ;;             xy = 00 => FIRST_FIT                                       ;BN001;
;                                                                           ;;                = 01 => BEST_FIT                                        ;BN001;
;                                                                           ;;                = 10 => LAST_FIT                                        ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;          (al) = 2                                                      ;BN001;
;                                                                           ;;            Get UMB link state in (al)                                  ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;          (al) = 3                                                      ;BN001;
;                                                                           ;;            Set UMB link state                                          ;BN001;
;                                                                           ;;             (bx) = 0 => Unlink UMBs                                    ;BN001;
;                                                                           ;;             (bx) = 1 => Link UMBs                                      ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;  EXIT    'C' clear if OK                                               ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;           if (al) = 0                                                  ;BN001;
;                                                                           ;;            (ax) = existing allocmethod                                 ;BN001;
;                                                                           ;;           if (al) = 1                                                  ;BN001;
;                                                                           ;;            Sets allocation strategy                                    ;BN001;
;                                                                           ;;           if (al) = 2                                                  ;BN001;
;                                                                           ;;              (al) = 0 => UMBs not linked                               ;BN001;
;                                                                           ;;              (al) = 1 => UMBs linked in                                ;BN001;
;                                                                           ;;           if (al) = 3                                                  ;BN001;
;                                                                           ;;            Links/Unlinks the UMBs into DOS chain                       ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;        Error return:                                                   ;BN001;
;                                                                           ;;              'C' set if error                                          ;BN001;
;                                                                           ;;               AX = error_invalid_function                              ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;        procedure   $AllocOper,NEAR
;                                                                           ;        ASSUME  DS:NOTHING,ES:NOTHING
;                                                                           ;;BD001;  CMP     AL,1
;                                                                           ;;BD001;  JB      short AllocOperGet
;                                                                           ;;BD001;   JZ      short AllocOperSet
;                                                                           ;;BD001;   MOV     EXTERR_LOCUS,errLoc_mem ; Extended Error Locus
;                                                                           ;;BD001;   error   error_invalid_function
;                                                                           ;        or      al, al                                                   ;BN001;
;                                                                           ;        jz      AllocOperGet                                             ;BN001;
;                                                                           ;        cmp     al, 1                                                    ;BN001;
;                                                                           ;        jz      AllocOperSet                                             ;BN001;
;                                                                           ;        cmp     al, 2                                                    ;BN001;
;                                                                           ;        jz      AllocGetLink                                             ;BN001;
;                                                                           ;        cmp     al, 3                                                    ;BN001;
;                                                                           ;        jz      AllocSetLink                                             ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;AllocOperError:                                                          ;BN001;
;                                                                           ;                                        ; SS override                    ;BN001;
;                                                                           ;        MOV     EXTERR_LOCUS,errLoc_mem ; Extended Error Locus           ;BN001;
;                                                                           ;        error   error_invalid_function                                   ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;AllocArenaError:                                                         ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        MOV     EXTERR_LOCUS,errLoc_mem ; M009: Extended Error Locus     ;BN001;
;                                                                           ;        error   error_arena_trashed     ; M009:                          ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;AllocOperGet:
;                                                                           ;        MOV     AL,BYTE PTR [AllocMethod]
;                                                                           ;        XOR     AH,AH                   ; Return current AllocMethod     ;BC001;
;                                                                           ;        transfer    SYS_RET_OK
;                                                                           ;AllocOperSet:
;                                                                           ;        push    bx                      ;                                ;BN001;
;                                                                           ;        and     bl, HF_MASK             ; mask off bit 7. Note bit 6, the;BN001;
;                                                                           ;                                        ; HIGH_ONLY bit can't be set by a;BN001;
;                                                                           ;                                        ; call to this. It's set by $exec;BN001;
;                                                                           ;                                        ; if HIGH_FRIST is set.          ;BN001;
;                                                                           ;        cmp     bl,LAST_FIT             ; BX must be first/best/last     ;BN001;
;                                                                           ;        pop     bx                      ;                                ;BN001;
;                                                                           ;        ja      AllocOperError                                           ;BN001;
;                                                                           ;
;                                                                           ;        MOV     [AllocMethod],BL        ; establish new allocation method;BC001;
;                                                                           ;        transfer    SYS_RET_OK
;                                                                           ;AllocGetLink:                                                            ;BN001;
;                                                                           ;;    RETURN:                                                             ;BN001;
;                                                                           ;;              (al) = 0 => UMBs not linked                               ;BN001;
;                                                                           ;;              (al) = 1 => UMBs linked in                                ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;        mov     ax, [UmbFlag]           ; return link state in al        ;BN001;
;                                                                           ;        and     al, LINKSTATE           ; LINKSTATE, bit 0= 0 or 1       ;BN001;
;                                                                           ;        transfer SYS_RET_OK                                              ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;AllocSetLink:                                                            ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;       ENTRY:                                                           ;BN001;
;                                                                           ;;             (bx) = 0 => Unlink UMBs                                    ;BN001;
;                                                                           ;;             (bx) = 1 => Link UMBs                                      ;BN001;
;                                                                           ;;        Error return:                                                   ;BN001;
;                                                                           ;;              'C' set if error                                          ;BN001;
;                                                                           ;;               AX = error_invalid_function                              ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;                                        ;                                ;BN001;
;                                                                           ;        mov     cx, [umb_head]          ; cx = umb_head                  ;BN001;
;                                                                           ;        cmp     cx, -1                  ; Q: has umb_head been init'd    ;BN001;
;                                                                           ;        je      AllocOperError          ; N: can't link or unlink then   ;BN001;
;                                                                           ;                                        ; Y: continue                    ;BN001;
;                                                                           ;        test    [UmbFlag], UMBAVAIL     ; Q: are UMBs available to us?   ;BN001;
;                                                                           ;        je      AllocOperError          ; N: we can't link/unlink then   ;BN001;
;                                                                           ;        test    [UmbFlag], NOLINKUMBS   ; Q: low arena built for linking?;BN001;
;                                                                           ;        jnz     AllocOperError          ; N: can't link or unlink then   ;BN001;
;                                                                           ;        cmp     bx, 1                                                    ;BN001;
;                                                                           ;        jb      UnlinkUmbs                                               ;BN001;
;                                                                           ;        jz      LinkUmbs                                                 ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        jmp     short AllocOperError                                     ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;UnlinkUmbs:                                                              ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        test    [UmbFlag], LINKSTATE    ; Q: umbs unlinked?              ;BN001;
;                                                                           ;        jz      unlinked                ; Y: return                      ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        call    GetLastArena            ; get last low arena in DS       ;BN001;
;                                                                           ;        jc      AllocArenaError         ; arena trashed                  ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;                                        ; make it last                   ;BN001;
;                                                                           ;        mov     byte ptr ds:[0], arena_signature_end                     ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        and     [UmbFlag], NOT LINKSTATE; indicate unlink'd state        ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;unlinked:                                                                ;BN001;
;                                                                           ;        transfer SYS_RET_OK                                              ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;LinkUmbs:                                                                ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        test    [UmbFlag], LINKSTATE    ; Q: umbs linked?                ;BN001;
;                                                                           ;        jnz     linked                  ; Y: return                      ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        call    GetLastArena            ; get arena before umb_head      ;BN001;
;                                                                           ;        jc      AllocArenaError         ;  arena trashed                 ;BN001;
;                                                                           ;                                        ; make it normal.  ds points to  ;BN001;
;                                                                           ;                                        ; arena before umb_head          ;BN001;
;                                                                           ;        mov     byte ptr ds:[0], arena_signature_normal                  ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;        or      [UmbFlag], LINKSTATE    ; indicate link'd state in       ;BN001;
;                                                                           ;                                        ; UmbFlag                        ;BN001;
;                                                                           ;linked:                                                                  ;BN001;
;                                                                           ;        transfer SYS_RET_OK                                              ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;EndProc $AllocOper
;                                                                           ;;------------------------------------------------------------------------;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;; Procedure Name : GetLastArena                                          ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;; Inputs         : cx = umb_head                                         ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;; Outputs        : If UMBs are linked                                    ;BN001;
;                                                                           ;;                       ES = umb_head                                    ;BN001;
;                                                                           ;;                       DS = arena before umb_head                       ;BN001;
;                                                                           ;;                  else                                                  ;BN001;
;                                                                           ;;                       DS = last arena                                  ;BN001;
;                                                                           ;;                       ES = next arena. will be umb_head if NC.         ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;                  CY if error                                           ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;; Uses           : DS, ES, DI, BX                                        ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;;------------------------------------------------------------------------;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;Procedure       GetLastArena, NEAR                                       ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;          push    ax                      ; save ax                      ;BN001;
;                                                                           ;          mov     ax, [arena_head]                                       ;BN001;
;                                                                           ;          mov     es, ax                  ; es = arena_head              ;BN001;
;                                                                           ;          xor     di, di                                                 ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;          cmp     byte ptr es:[di],arena_signature_end                   ;BN001;
;                                                                           ;;                                         ; Q: is this the last arena    ;BN001;
;                                                                           ;          je      GLA_done                ; Y: return last arena in ES   ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;GLA_next:                                                                ;BN001;
;                                                                           ;          mov     ds, ax                                                 ;BN001;
;                                                                           ;          call    arena_next              ; ax, es -> next arena         ;BN001;
;                                                                           ;          jc      GLA_err                                                ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;          test    [UmbFlag], LINKSTATE    ; Q: are UMBs linked           ;BN001;
;                                                                           ;          jnz     GLA_chkumb              ; Y: terminating condition is  ;BN001;
;                                                                           ;                                          ;    umb_head                  ;BN001;
;                                                                           ;                                          ; N: terminating condition is  ;BN001;
;                                                                           ;                                          ;    05Ah                      ;BN001;
;                                                                           ;          cmp     byte ptr es:[di],arena_signature_end                   ;BN001;
;                                                                           ;                                          ; Q: is this the last arena    ;BN001;
;                                                                           ;          jmp     short GLA_1                                            ;BN001;
;                                                                           ;GLA_chkumb:                                                              ;BN001;
;                                                                           ;          cmp     ax, cx                  ; Q: is this umb_head          ;BN001;
;                                                                           ;GLA_1:                                                                   ;BN001;
;                                                                           ;          jne     GLA_next                ; N: get next arena            ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;GLA_done:                                                                ;BN001;
;                                                                           ;;                                         ;                              ;BN001;
;                                                                           ;          test    [UmbFlag], LINKSTATE    ; Q: are UMBs linked           ;BN001;
;                                                                           ;          jnz     GLA_ret                 ; Y: we're done                ;BN001;
;                                                                           ;                                          ; N: let us confirm that the   ;BN001;
;                                                                           ;                                          ;    next arena is umb_head    ;BN001;
;                                                                           ;          mov     ds, ax                                                 ;BN001;
;                                                                           ;          call    arena_next              ; ax, es -> next arena         ;BN001;
;                                                                           ;          jc      GLA_err                                                ;BN001;
;                                                                           ;          cmp     ax, cx                  ; Q: is this umb_head          ;BN001;
;                                                                           ;          jne     GLA_err                 ; N: error                     ;BN001;
;                                                                           ;                                          ;                              ;BN001;
;                                                                           ;GLA_ret:                                                                 ;BN001;
;                                                                           ;          clc                             ; no error                     ;BN001;
;                                                                           ;          pop     ax                                                     ;BN001;
;                                                                           ;          ret                                                            ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;GLA_err:                                                                 ;BN001;
;                                                                           ;           stc                            ; error                        ;BN001;
;                                                                           ;           pop     ax                                                    ;BN001;
;                                                                           ;           ret                                                           ;BN001;
;                                                                           ;;                                                                        ;BN001;
;                                                                           ;EndProc GetLastArena                                                     ;BN001;
;                                                                           ;                                                                         ;BN001;
;                                                                           ;

;*  arena_pack_owner - arena owner value for EXEPACK loading fix
;
;   This value is chosen as one which is large enough that a PDB
;   will never be allocated at this address.  See Alloc/FreeLowMemory
;   for details on how this is used.

arena_pack_owner    equ     0FEDCh

;*  parPackBoundary - paragraph address below which EXEPACK'd files cannot load

parPackBoundary     equ     1000h


;***    AllocLowMemory - Consume memory below to make EXEPACK'd apps happy
;
;       ENTRY   none
;
;       EXIT    All memory below 64K is allocated to a special owner
;
;       USES    flags
;
;       PCODE   For each memory arena block starting below 64K
;                   Calculate size of block fully below 64K;
;                   Allocate that block
;                   Set owner to "pack" owner, for FreeLowMemory

        procedure   AllocLowMemory,NEAR
    assume  ds:nothing,es:nothing

        pushf
        pusha
        SaveReg <ds,es>

        xor     di,di                   ; Required by Check_signature, etc.

;m        mov     ax,[arena_head]         ; ax = first block in arena

        mov     ah,52h                  ; mdr get DOS internal values
        int     21h                     ; mdr
        mov     ax,es:[bx-2]            ; mdr this should be ptr to arenahead

        call    Check_signature         ; es = ax, carry set if error
        jnc     alm10
        jmp     short almx              ;   ERROR, go exit

alm10:  mov     ax,es                   ; ax = block header
        cmp     ax,parPackBoundary      ; Block above EXEPACK boundary?
        jae     short almx              ;   YES, done allocating

        mov     ds,ax                   ;   NO, ds = block header
        cmp     ds:[arena_owner],di     ; Block free?
        jne     short alm50             ;   NO, go to next block

;   We must allocate some (or all) of this block.  Allocate the smaller
;   of 1) the block size and 2) the amount of memory below the boundary.

        mov     bx,parPackBoundary
        sub     bx,ax                   ;
        dec     bx                      ; bx = # free paragraphs below boundary

;   We must handle the case where the header is just below the boundary,
;   and the rest of the block is above it.  In this case, we allocate one
;   paragraph above the boundary.

        jnz     alm20                   ;   NO problem, at least one is free
        inc     bx                      ;   Allocate exactly one paragraph

alm20:  mov     ax,ds:[arena_size]      ; ax = size of this block
        cmp     ax,bx                   ; Does this block span the boundary?
        jae     alm30                   ;   YES, go allocate portion below

        xchg    bx,ax                   ;   NO, bx=size of block

;   bx = size of allocation


alm30:                                                                   ;BC001;
;       Ensure allocation method is low.  This is necessary because,     ;BN001;
;       $EXEC calls this code for exe packed files, and allocmethod      ;BN001;
;       can now be set to 'high first' for UMB support.                  ;BN001;
;                                                                        ;BN001;
;        push    cx                                                       ;BN001;
;m        mov     cl,[AllocMethod]        ; lets save current allocmethod  ;BN001;
;m        and     [AllocMethod], NOT HIGH_FIRST                            ;BN001;
;m        and     [AllocMethod], NOT HIGH_ONLY                             ;BN001;

;        mov     ax,5800h                ;mdr get alloc method
;        int     21h                     ;mdr
;        push    ax                      ;mdr save alloc method
;        push    bx                      ;mdr
;        mov     ax,5801h                ;mdr now set method to low
;        mov     bl,0                    ;mdr
;        int     21h                     ;mdr
;        pop     bx                      ;mdr restore bx to size of allocation

;m        call    $alloc                  ; ax = Allocated block
        mov     ax,4869h                ;mdr
        int     21h                     ;mdr

;m        mov     [AllocMethod], cl       ; restore allocation method      ;BN001;
;m        pop     cx                                                       ;BN001;

        dec     ax                      ; ax = block header
        mov     ds,ax                   ; ds = Allocated block

;        mov     ax,5801h                ;mdr restore alloc method
;        pop     bx                      ;mdr get method
;        int     21h                     ;mdr

        xor     di,di                   ; Required by check_signature, etc.
        mov     ds:[arena_owner],arena_pack_owner ; set EXEPACK owner!

alm50:  cmp     byte ptr ds:[di],arena_signature_end ; Last block?
        je      short almx              ;   YES, go exit
        call    arena_next              ; AX, ES <- next block
        jnc     alm10                   ;   No error, continue scan

almx:   RestoreReg <es,ds>
        popa
        popf
        ret
endproc AllocLowMemory


;***    AssignLowMemory - Set owner of blocks allocated by AllocLowMemory
;
;       After consuming
;       specified PDB process.  This ensures that the EXEPACK unpack
;       routine cannot allocate low memory, yet allows this memory to
;       be freed when the PDB process terminates.
;
;       ENTRY   dx = new owner (PDB)
;
;       EXIT    All AllocLowMemory blocks are now owned by DX
;
;       USES    flags

        procedure   AssignLowMemory,NEAR
    assume  ds:nothing,es:nothing

        pusha
        SaveReg <ds,es>

        xor     di,di
        .ERRNZ  arena_signature
;m        mov     ax,[arena_head]

        mov     ah,52h                  ; mdr get DOS internal values
        int     21h                     ; mdr
        mov     ax,es:[bx-2]            ; mdr this should be first mem block

        CALL    Check_Signature         ; ES=AX, check for valid block

slm10:  jc      slmx                    ;   ARENA trashed
        mov     ds,ax                   ; ds = arena block
        cmp     ds:[arena_owner],arena_pack_owner ; EXEPACK block?
        jne     short slm20             ;   NO, skip to next

        mov     ds:[arena_owner],dx     ;   YES, change owner

slm20:  cmp     byte ptr ds:[di],arena_signature_end ; last block
        je      short slmx              ;   YES, go exit
        call    arena_next              ; ES/AX = next block; carry set if trash
        jnc     slm10

slmx:   RestoreReg <es,ds>
        popa
        ret

endproc AssignLowMemory


;***    FreeLowMemory -
;
;       ENTRY   none
;
;       EXIT    All memory allocated to the special owner is freed
;
;       USES    none
;
        procedure   FreeLowMemory,NEAR
    assume  ds:nothing,es:nothing

        pushf
        pusha
        SaveReg <ds,es>
        mov     bx,arena_pack_owner     ; owner used by AllocLowMemory
        call    arena_free_process      ; free all such blocks

;   Ignore errors.  The caller will find them soon enough.

        RestoreReg <es,ds>
        popa
        popf
        ret
endproc FreeLowMemory

V86CODE    ENDS
    END
