        TITLE ALLOC.ASM - memory arena manager  NAME Alloc


IF 1
;-----------------------------------------------------------------------
; The 4.5% improvement costs 29 extra bytes over DOS 5.00
; The 7.5% improvement costs 105 extra bytes over DOS 5.00
;
; The 4.5% is probably worth the 29 bytes.  Is the 7.5% worth the extra
; 105 bytes?  I don't know...everything needs to be evaluated...
;-----------------------------------------------------------------------
;;__TONYI__ = 1         ; 4.5% faster than DOS 5.00
;;__TONYI2__ = 1        ; 7.5% faster than DOS 5.00 (~DOS 4.0 speed level)
__TONYI__3 = 1          ; Space reduction for LOCUS errors
__TONYI__4 = 1          ; Space reductions
__TONYI__5 = 1          ; Space reductions
__TONYI_486__= 1	; 486 pipeline optimizations (8088 benign)
ENDIF


;**
;       IBM Corporation
;       Copyright (C) IBM Corporation 1993
;       All Rights Reserved.
;
;       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
;
;           Revision: M000 - added support for allocing UMBs. 7/9/90
;                     M003 - added support for link/unlink UMBs from
;                            DOS arena chain. 7/18/90
;                     M009 - Added error returns invalid function and
;                            arena trashed in set link state call.
;                     M010 - Release UMB arenas allocated to current PDB
;                            if UMB_HEAD is initialized.
;
;                     M016 - MACE utilities mkeyrate.com version 1.0
;                            support. Please see under M009 in
;                            ..\inc\dossym.inc. 8/31/90.
;
;                     M061 - In GetLastArena, if linking in UMBs check to make
;                            sure that umb_head arena is valid and also make
;                            sure that the previous arena is pointing to
;                            umb_head.
;
;                     M064 - allow HIGH_ONLY bit to be set by a call to
;                            set allloc strategy.
;                            use STRAT_MASK to mask out bits 6 & 7 of
;                            bx in AllocSetStrat.
;
;                     M068 - use a count value (A20OFF_COUNT) rather than
;                            a bit to indicate to dos dispatcher to turn
;                            a20 off before iret. See M016.
;
;    06/10/92 - AC000 - Changed a long Jump to a SHORT.  WRA.         ;AC000;
;                                                                     ;AC000;
;

        .xlist
        .xcref
        include version.inc
        include dosseg.inc
        INCLUDE DOSSYM.INC
        INCLUDE DEVSYM.INC
        include arena.inc

        .cref
        .list

        BREAK   <memory allocation utility routines>

        i_need  arena_head,WORD         ; seg address of start of arena
        i_need  CurrentPDB,WORD         ; current process data block addr
        i_need  FirstArena,WORD         ; first free block found
        i_need  BestArena,WORD          ; best free block found
        i_need  LastArena,WORD          ; last free block found
        i_need  AllocMethod,BYTE        ; how to alloc first(best)last
        I_need  EXTERR_LOCUS,BYTE       ; Extended Error Locus


        I_need  umb_head,WORD           ; seg address of start of umb arenas
        I_need  start_arena,WORD        ; seg address of arena from which to
                                        ; start alloc scan
        I_need  umbflag,BYTE            ; bit 0 indicates link state

        I_need  A20OFF_COUNT,BYTE       ; M016, M068
        I_need  DOS_FLAG, BYTE          ; M068

IFDEF __TONYI__
SignatureCheck macro goto_on_error
        local   exit_label
        .ERRB   <goto_on_error>
        MOV     ES,AX                   ; ES <- AX
        CMP     BYTE PTR ES:[DI],arena_signature_normal
                                        ; IF next signature = not_end THEN
        jz      exit_label               ;   GOTO OK (ret if Z)

        CMP     BYTE PTR ES:[DI],arena_signature_end
                                        ; IF next signature = end then
        jnz     goto_on_error           ; set error
exit_label:
        endm
ENDIF

IFDEF __TONYI2__
ArenaNextInline macro goto_on_error
        .ERRB   <goto_on_error>
        MOV     AX,DS                   ; AX <- current block
        ADD     AX,DS:[arena_size]      ; AX <- AX + current block length
        INC     AX                      ; remember that header!
        SignatureCheck <goto_on_error>
        endm
ENDIF


DOSCODE SEGMENT
        ASSUME  SS:DOSDATA,CS:DOSCODE

IFDEF __TONYI__5
;-------------------------------------------------
; Doing this as a proc saves 11 bytes...
;-------------------------------------------------
Test_UmbFlag_LINKSTATE proc near
        test    [UmbFlag], LINKSTATE    ; Q: are umb's linked
	ret
Test_UmbFlag_LINKSTATE endp
ENDIF

        BREAK   <Arena_Free_Process - Free a processes memory>


;**     Arena_Free_Process
;
;       Free all arena blocks allocated to a pricess
;
;       ENTRY   (bx) = PID of process
;       EXIT    none
;       USES    ????? BUGBUG

procedure   arena_free_process,NEAR

        MOV     AX,[arena_head]

arena_free_process_start:
        MOV     DI,arena_signature
IFDEF __TONYI2__
        SignatureCheck ret_label
ELSE
        CALL    Check_Signature         ; ES <- AX, check for valid block
ENDIF

arena_free_process_loop:
        jc      ret_label               ; return if carry set

        PUSH    ES
        POP     DS
        CMP     DS:[arena_owner],BX     ; is block owned by pid?
        JNZ     arena_free_next         ; no, skip to next
        MOV     DS:[arena_owner],DI     ; yes... free him

arena_free_next:
        CMP     BYTE PTR DS:[DI],arena_signature_end
                                        ; end of road, Jack?

        jz      arena_chk_umbs          ; M010: let's check umb arenas

IFDEF __TONYI2__
        ArenaNextInline ret_label
ELSE
        CALL    arena_next              ; next item in ES/AX carry set if trash
ENDIF
        JMP     SHORT arena_free_process_loop                         ;AC000;

arena_chk_umbs:                         ; M010 - Start
        mov     ax, [umb_head]          ; ax = umb_head
        cmp     ax, 0ffffh              ; Q: is umb_head initialized
        je      ret_label               ; N: we're done

        mov     di, ds                  ; di = last arena
        cmp     di, ax                  ; Q: is last arena above umb_head
IFDEF __TONYI__3
;----------------------------------------------------------
; Save 1 or 2 bytes depending what's enabled....
;----------------------------------------------------------
	jnae	arena_free_process_start
	IFNDEF __TONYI2__
	ret
	ENDIF
ELSE
        jae     ret_label               ; Y: we've scanned umbs also. done.
        jmp     short arena_free_process_start
ENDIF

IFDEF __TONYI2__
ret_label:
        ret
ENDIF
EndProc arena_free_process

        BREAK   <Arena Helper Routines>
IFDEF __TONYI2__
;---------------------------
; Inlined as macros
;---------------------------
ELSE
;**     Arena_Next - Find Next item in Arena
;
;       ENTRY   DS - pointer to block head
;               (di) = 0
;       EXIT    AX,ES - pointers to next head
;               'C' set iff arena damaged

procedure   arena_next,NEAR

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

;**     Check_Signature - Check Memory Block Signature
;
;       ENTRY   (AX) = address of block header
;               (di) = 0
;       EXIT     ES = AX
;               'C' clear if signature good
;               'C' set if signature bad
;       USES    ES, Flags

procedure   check_signature,NEAR

        MOV     ES,AX                   ; ES <- AX
        CMP     BYTE PTR ES:[DI],arena_signature_normal
                                        ; IF next signature = not_end THEN
        jz      ret_label               ;   GOTO OK (ret if Z)

        CMP     BYTE PTR ES:[DI],arena_signature_end
                                        ; IF next signature = end then
        jz      ret_label               ;   GOTO ok (ret if Z)
        STC                             ; set error

ret_label:
        return

EndProc Check_signature
ENDIF


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

procedure   Coalesce,NEAR

        CMP     BYTE PTR DS:[DI],arena_signature_end
                                        ; IF current signature = END THEN
        retz                            ;   GOTO ok
IFDEF __TONYI2__
        ArenaNextInline Coalesce_exit
ELSE
        CALL    arena_next              ; ES, AX <- next block, Carry set if error
        retc                            ; IF no error THEN GOTO check
ENDIF


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     SHORT coalesce          ; try again                   ;AC000;

IFDEF __TONYI2__
Coalesce_exit:
        ret
ENDIF

EndProc Coalesce

        BREAK  <$Alloc - allocate space in memory>

;**     $Alloc - Allocate Memory Space
;
;       $Alloc services the INT21 that allocates memory space to a program.
;       Alloc returns   a  pointer  to  a  free  block of
;       memory that has the requested  size  in  paragraphs.
;
;       If the allocation strategy is HIGH_FIRST or HIGH_ONLY memory is
;       scanned from umb_head if not from arena_head. If the strategy is
;       HIGH_FIRST the scan is continued from arena_head if a block of
;       appropriate size is not found in the UMBs. If the strategy is
;       HIGH_FIRST+HIGH_ONLY only the UMBs are scanned for memory.
;
;       In either case if bit 0 of UmbFlag is not initialized then the scan
;       starts from arena_head.
;
;       Assembler usage:
;           MOV     BX,size
;           MOV     AH,Alloc
;           INT     21h
;
;       BUGBUG - a lot can be done to improve performance.  We can set marks
;       so that we start searching the arena at it's first non-trivial free
;       block, we can peephole the code, etc.  (We can move some subr calls
;       inline, etc.)  I assume that this is called rarely and that the arena
;       doesn't have too many memory objects in it beyond the first free one.
;       verify that this is true; if so, this can stay as is
;
;       ENTRY   (bx) = requested size, in bytes
;               (DS) = (ES) = DOSGROUP
;       EXIT    'C' clear if memory allocated
;                 (ax:0) = address of requested memory
;               'C' set if request failed
;                 (AX) = error_not_enough_memory
;                   (bx) = max size we could have allocated
;                 (ax) = error_arena_trashed
;       USES    All

procedure   $ALLOC,NEAR

        EnterCrit   critMem

                                        ; M000 - start
        mov     ax, [arena_head]
IFDEF __TONYI_486__
        test    byte ptr [AllocMethod], HIGH_FIRST+HIGH_ONLY
        mov     [start_arena], ax       ; assume LOW_FIRST
ELSE
        mov     [start_arena], ax       ; assume LOW_FIRST

        test    byte ptr [AllocMethod], HIGH_FIRST+HIGH_ONLY
ENDIF
                                        ; Q: should we start scanning from
                                        ;    UMB's
        jz      norm_alloc              ; N: scan from arena_head
IFDEF __TONYI__5
;-------------------------------------------
; Save 3 bytes.......
;-------------------------------------------
	call	Test_UmbFlag_LINKSTATE
ELSE
        test    [UmbFlag], LINKSTATE    ; Q: are umb's linked
ENDIF
        jz      norm_alloc              ; N: scan from arena_head

        mov     ax, [umb_head]
        mov     [start_arena], ax       ; start_arena = umb_head

                                        ; M000 - end

norm_alloc:

        XOR     AX,AX
        MOV     DI,AX

                                        ; SS override for next First/Best/Last
                                        ; Arena
        MOV     [FirstArena],AX         ; init the options
        MOV     [BestArena],AX
        MOV     [LastArena],AX

        PUSH    AX                      ; alloc_max <- 0

start_scan:
        MOV     AX,[start_arena]        ; M000: AX <- beginning of arena
IFDEF __TONYI__
;--------------------------------------
; Inline sig check............
;--------------------------------------
        SignatureCheck alloc_err
ELSE
        CALL    Check_signature         ; ES <- AX, carry set if error
        JC      alloc_err               ; IF error THEN GOTO err
ENDIF

alloc_scan:
        PUSH    ES
        POP     DS                      ; DS <- ES
        CMP     DS:[arena_owner],DI
        JZ      alloc_free              ; IF current block is free THEN examine

alloc_next:
                                        ; M000 - start

IFDEF __TONYI__5
;-------------------------------------------
; Save 3 bytes.......
;-------------------------------------------
	call	Test_UmbFlag_LINKSTATE
ELSE
        test    [UmbFlag], LINKSTATE    ; Q: are umb's linked
ENDIF
        jz      norm_strat              ; N: see if we reached last arena

        test    byte ptr [AllocMethod], HIGH_FIRST
                                        ; Q: is alloc strategy high_first
        jz      norm_strat              ; N: see if we reached last arena
        mov     ax, [start_arena]
        cmp     ax, [arena_head]        ; Q: did we start scan from
                                        ;    arena_head
        jne     norm_strat              ; N: see if we reached last arena
        mov     ax, ds                  ; ax = current block
        cmp     ax, [umb_head]          ; Q: check against umb_head
        jmp     short alloc_chk_end

norm_strat:                             ; M000 - end
                                        ; check against last sig '5A'
        CMP     BYTE PTR DS:[DI],arena_signature_end

alloc_chk_end:                          ; M000
                                        ; IF current block is last THEN
        JZ      alloc_end               ;   GOTO end
IFDEF __TONYI2__
        ArenaNextInline alloc_err
        jmp     short   alloc_scan      ; IF no error THEN GOTO scan
ELSE
        CALL    arena_next              ; AX, ES <- next block, Carry set if error
        JNC     alloc_scan              ; IF no error THEN GOTO scan
ENDIF

alloc_err:
        POP     AX

alloc_trashed:
        LeaveCrit   critMem
IFDEF __TONYI__4
Merge_arena_trashed:
ENDIF
        error   error_arena_trashed

alloc_end:
        CMP     [FirstArena],0
        LJNZ    alloc_do_split
                                        ; M000 - start
        mov     ax, [arena_head]
        cmp     ax, [start_arena]       ; Q: started scanning from arena_head
        je      alloc_fail              ; Y: not enough memory
                                        ; N:
                                        ; Q: is the alloc strat HIGH_ONLY
        test    byte ptr [AllocMethod], HIGH_ONLY
        jnz     alloc_fail              ; Y: return size of largest UMB

        mov     [start_arena], ax       ; N: start scanning from arena_head
IFDEF __TONYI2__
        jmp     start_scan
ELSE
        jmp     short start_scan
ENDIF

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     alloc_test
        MOV     DX,CX

alloc_test:
        PUSH    DX
        CMP     BX,CX                   ; IF BX > size of current block THEN
IFDEF __TONYI2__
        ja      NearToAllocNext
ELSE
        JA      alloc_next              ;   GOTO next
ENDIF
        CMP     [FirstArena],0
        JNZ     alloc_best
        MOV     [FirstArena],DS         ; save first one found
alloc_best:
        CMP     [BestArena],0
        JZ      alloc_make_best         ; initial best
        PUSH    ES
        MOV     ES,[BestArena]
        CMP     ES:[arena_size],CX      ; is size of best larger than found?
        POP     ES
        JBE     alloc_last
alloc_make_best:
        MOV     [BestArena],DS          ; assign best
alloc_last:
        MOV     [LastArena],DS          ; assign last
IFDEF __TONYI2__
NearToAllocNext:
ENDIF
        JMP     alloc_next

;
; split the block high
;
alloc_do_split_high:
        MOV     DS,[LastArena]
        MOV     CX,DS:[arena_size]
        SUB     CX,BX
        MOV     DX,DS
        JE      alloc_set_owner         ; sizes are equal, no split
        ADD     DX,CX                   ; point to next block
        MOV     ES,DX                   ; no decrement!
        DEC     CX
        XCHG    BX,CX                   ; bx has size of lower block
        JMP     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:
                                        ; M000 - start
        xor     cx, cx
        mov     cl, byte ptr [AllocMethod]
        and     cx, STRAT_MASK          ; mask off bit 7
        cmp     cx, BEST_FIT            ; Q; is the alloc strategy best_fit

                                        ; M000 - end

                                        ; Q: is the alloc strategy best_fit
        JA      alloc_do_split_high     ; N: it is last fit
        MOV     DS,[FirstArena]         ; assume first_fit
        JB      alloc_get_size          ; it is first_fit
        MOV     DS,[BestArena]          ; it is last_fit
alloc_get_size:
        MOV     CX,DS:[arena_size]
IFDEF __TONYI_486__
        MOV     AX,DS
        SUB     CX,BX                   ; get room left over
ELSE
        SUB     CX,BX                   ; get room left over
        MOV     AX,DS
ENDIF
        MOV     DX,AX                   ; save for owner setting
        JE      alloc_set_owner         ; IF BX = size THEN (don't split)
        ADD     AX,BX
        INC     AX                      ; remember the header
        MOV     ES,AX                   ; ES <- DS + BX (new header location)
        DEC     CX                      ; CX <- size of split block
alloc_set_sizes:
        MOV     DS:[arena_size],BX      ; current size <- BX
IFDEF __TONYI_486__
        MOV     BL,arena_signature_normal
        MOV     ES:[arena_size],CX      ; split size <- CX
ELSE
        MOV     ES:[arena_size],CX      ; split size <- CX
        MOV     BL,arena_signature_normal
ENDIF
        XCHG    BL,DS:[DI]              ; current signature <- 4D
IFDEF __TONYI_486__
        MOV     ES:[arena_owner],DI
        MOV     ES:[DI],BL              ; new block sig <- old block sig
ELSE
        MOV     ES:[DI],BL              ; new block sig <- old block sig
        MOV     ES:[arena_owner],DI
ENDIF

alloc_set_owner:
        MOV     DS,DX


        MOV     AX,[CurrentPDB]         ; SS override
        MOV     DS:[arena_owner],AX
        MOV     AX,DS
        INC     AX
        POP     BX
        LeaveCrit   critMem
        transfer    SYS_RET_OK

EndProc $alloc

        BREAK $SETBLOCK - change size of an allocated block (if possible)

;**     $SETBLOCK - Change size of an Alocated Block
;
;       Setblock changes the size of an allocated block.  First, we coalesce
;       any following free space onto this block; then we try to trim the
;       block down to the size requested.
;
;       Note that if the guy wants to grow the block but that growth fails,
;       we still go ahead and coalesce any trailing free blocks onto it.
;       Thus the maximum-size-possible value that we return has already
;       been allocated!  This is a bug, dare we fix it?  BUGBUG
;
;       NOTE - $SETBLOCK is in bed with $ALLOC and jumps into $ALLOC to
;               finish it's work.  FOr this reason we build the allocsf
;               structure on the frame, to make us compatible with $ALLOCs
;               code.
;
;       ENTRY   (es) = segment of old block
;               (bx) = newsize
;               (ah) = SETBLOCK
;
;       EXIT    'C' clear if OK
;               'C' set if error
;                 (ax) = error_invalid_block
;                      = error_arena_trashed
;                      = error_not_enough_memory
;                      = error_invalid_function
;                 (bx) = maximum size possible, iff (ax) = error_not_enough_memory
;       USES    ???? BUGBUG

procedure   $SETBLOCK,NEAR

        EnterCrit   critMem
        MOV     DI,arena_signature
        MOV     AX,ES
        DEC     AX
IFDEF __TONYI__
;----------------------------------------------
; Streamline and inline..........
;----------------------------------------------
        SignatureCheck setblock_bad
ELSE
        CALL    check_signature
        JNC     setblock_grab

setblock_bad:
        JMP     alloc_trashed
ENDIF
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
IFDEF __TONYI__
;--------------------------------------
; Inline sig check............
;--------------------------------------
setblock_bad:
        JMP     alloc_trashed
ENDIF
EndProc $setblock

        BREAK $DEALLOC - free previously allocated piece of memory

;**     $DEALLOC - Free Heap Memory
;
;       ENTRY   (es) = address of item
;
;       EXIT    'C' clear of OK
;               'C' set if error
;                 (AX) = error_invalid_block
;       USES    ???? BUGBUG

procedure   $DEALLOC,NEAR

        EnterCrit   critMem

                                        ; M016, M068 - Start
        test    [DOS_FLAG], EXECA20OFF
                                        ; Q: was the previous call an int 21
                                        ;    exec call
        jz      @f                      ; N: continue
        cmp     [A20OFF_COUNT], 0       ; Q: is count 0
        jne     @f                      ; N: continue
IFDEF __TONYI__5
;--------------------------------------------
; Save a byte.....
;--------------------------------------------
        inc     [A20OFF_COUNT]          ; Y: set count to 1
ELSE
        mov     [A20OFF_COUNT], 1       ; Y: set count to 1
ENDIF
@@:                                     ; M016, M068 - End


        MOV     DI,arena_signature
        MOV     AX,ES
        DEC     AX
IFDEF __TONYI__
;--------------------------------------
; Inline sig check............
;--------------------------------------
        SignatureCheck dealloc_err
ELSE
        CALL    check_signature
        JC      dealloc_err
ENDIF
        MOV     ES:[arena_owner],DI
        LeaveCrit   critMem
        transfer    SYS_RET_OK

dealloc_err:
        LeaveCrit   critMem
        error   error_invalid_block

EndProc $DEALLOC

        BREAK $AllocOper - get/set allocation mechanism

;**     $AllocOper - Get/Set Allocation Mechanism
;
;       Assembler usage:
;           MOV     AH,AllocOper
;           MOV     BX,method
;           MOV     AL,func
;           INT     21h
;
;       ENTRY
;               (al) = 0
;                 Get allocation Strategy in (ax)
;
;               (al) = 1, (bx) = method = zw0000xy
;                 Set allocation strategy.
;                  w  = 1  => HIGH_ONLY
;                  z  = 1  => HIGH_FIRST
;                  xy = 00 => FIRST_FIT
;                     = 01 => BEST_FIT
;                     = 10 => LAST_FIT
;
;               (al) = 2
;                 Get UMB link state in (al)
;
;               (al) = 3
;                 Set UMB link state
;                  (bx) = 0 => Unlink UMBs
;                  (bx) = 1 => Link UMBs
;
;
;       EXIT    'C' clear if OK
;
;                if (al) = 0
;                 (ax) = existing method
;                if (al) = 1
;                 Sets allocation strategy
;                if (al) = 2
;                 (al) = 0 => UMBs not linked
;                 (al) = 1 => UMBs linked in
;                if (al) = 3
;                 Links/Unlinks the UMBs into DOS chain
;
;               'C' set if error
;                 AX = error_invalid_function
;
;       Rev. M000 - added support for HIGH_FIRST in (al) = 1. 7/9/90
;       Rev. M003 - added functions (al) = 2 and (al) = 3. 7/18/90
;       Rev. M009 - (al) = 3 will return 'invalid function' in ax if
;                   umbhead has'nt been initialized by sysinit and 'trashed
;                   arena' if an arena sig is damaged.
;


procedure   $AllocOper,NEAR

        or      al, al
        jz      AllocGetStrat
IF 0   ;;;;; IFDEF __TONYI__5
; This code breaks Clarion3 Database developer!!!
;-----------------------------------------------------------
; Save 2 bytes...
;-----------------------------------------------------------
	cbw			; 
	dec	ax		; Was AL == 1
        jz      AllocSetStrat
	dec	ax		; Was AL == 2
        jz      AllocGetLink
	dec	ax		; Was AL == 3
        jz      AllocSetLink
ELSE
        cmp     al, 1
        jz      AllocSetStrat
        cmp     al, 2
        jz      AllocGetLink
        cmp     al, 3
        jz      AllocSetLink
ENDIF

AllocOperError:
IFDEF __TONYI__3
        invoke  SetErrLocMem
ELSE
        MOV     EXTERR_LOCUS,errLoc_mem ; Extended Error Locus
ENDIF
        error   error_invalid_function

IFNDEF __TONYI__5
;------------------------------------------------------
; Relocated/inlined this code down in GetLastArena().
;------------------------------------------------------
AllocArenaError:
IFDEF __TONYI__3
        invoke  SetErrLocMem
ELSE
        MOV     EXTERR_LOCUS,errLoc_mem ; M009: Extended Error Locus
ENDIF

IFDEF __TONYI__4
;-------------------------------------------------
; Save a couple of bytes....
;-------------------------------------------------
	jmp	Merge_arena_trashed
ELSE
        error   error_arena_trashed     ; M009:
ENDIF
ENDIF


AllocGetStrat:
                                        ; SS override
        MOV     AL,BYTE PTR [AllocMethod]
        XOR     AH,AH
IFDEF __TONYI__4
;-------------------------------------------------------
; These alloc strategy calls are low frequency.  Let's save
; some space...
;-------------------------------------------------------
NearTo_SYS_RET_OK:
ENDIF
        transfer SYS_RET_OK

AllocSetStrat:

        push    bx                      ; M000 - start
        and     bx, STRAT_MASK          ; M064: mask off bit 6 & 7
        cmp     bx,2                    ; BX must be 0-2
        pop     bx                      ; M000 - end
        ja      AllocOperError

        MOV     [AllocMethod],BL
IFDEF __TONYI__4
;------------------------------------------
; Save a byte......
;------------------------------------------
	jmp	short NearTo_SYS_RET_OK
ELSE
        transfer    SYS_RET_OK
ENDIF

AllocGetLink:

        mov     al, [UmbFlag]           ; return link state in al
        and     al, LINKSTATE
IFDEF __TONYI__4
;------------------------------------------
; Save a byte......
;------------------------------------------
	jmp	short NearTo_SYS_RET_OK
ELSE
        transfer SYS_RET_OK
ENDIF

AllocSetLink:

                                        ; M009 - start
        mov     cx, [umb_head]          ; cx = umb_head
IFDEF __TONYI__5
;----------------------------------------------------------
; INC/DEC saves a byte over the compare.
;----------------------------------------------------------
	inc	cx			; CX = -1?
	jz	AllocOperError          ; Yep, error!
	dec	cx			; Nope, put it back to normal
ELSE
        cmp     cx, 0ffffh              ; Q: has umb_head been initialized
        je      AllocOperError          ; N: error
ENDIF
                                        ; Y: continue
                                        ; M009 - end

IFDEF __TONYI__5
;----------------------------------------------------------
; INC/DEC saves a byte over the compare.
;----------------------------------------------------------
	dec	bx		; Was BX = 1?
        jz      LinkUmbs
	inc	bx		; Was BX = 0? (0-1+1 == 0)
        jz      UnlinkUmbs
ELSE
        cmp     bx, 1
        jb      UnlinkUmbs
        jz      LinkUmbs
ENDIF

        jmp     short AllocOperError

UnlinkUmbs:

IFDEF __TONYI__5
;-------------------------------------------
; Save 3 bytes.......
;-------------------------------------------
	call	Test_UmbFlag_LINKSTATE
ELSE
        test    [UmbFlag], LINKSTATE    ; Q: umbs unlinked?
ENDIF
        jz      unlinked                ; Y: return

        call    GetLastArena            ; get arena before umb_head in DS
IFNDEF __TONYI__5
;-------------------------------------------------
; GetLastArena will jump to AllocArenaError on error.
;-------------------------------------------------
        jc      AllocArenaError         ; M009: arena trashed
ENDIF

                                        ; make it last
        mov     byte ptr ds:[0], arena_signature_end

        and     [UmbFlag], NOT LINKSTATE; indicate unlink'd state in umbflag

unlinked:
IFDEF __TONYI__4
;------------------------------------------
; Save a byte......
;------------------------------------------
	jmp	short NearTo_SYS_RET_OK
ELSE
        transfer SYS_RET_OK
ENDIF

LinkUmbs:

IFDEF __TONYI__5
;-------------------------------------------
; Save 3 bytes.......
;-------------------------------------------
	call	Test_UmbFlag_LINKSTATE
ELSE
        test    [UmbFlag], LINKSTATE    ; Q: umbs linked?
ENDIF
        jnz     linked                  ; Y: return

        call    GetLastArena            ; get arena before umb_head
IFNDEF __TONYI__5
;-------------------------------------------------
; GetLastArena will jump to AllocArenaError on error.
;-------------------------------------------------
        jc      AllocArenaError         ; M009: arena trashed
ENDIF

                                        ; make it normal. M061: ds points to
                                        ; arena before umb_head
        mov     byte ptr ds:[0], arena_signature_normal

        or      [UmbFlag], LINKSTATE    ; indicate link'd state in umbflag
linked:
IFDEF __TONYI__4
;------------------------------------------
; Save a byte......
;------------------------------------------
	jmp	short NearTo_SYS_RET_OK
ELSE
        transfer SYS_RET_OK
ENDIF

EndProc $AllocOper


;--------------------------------------------------------------------------
;
; Procedure Name : GetLastArena         -  M003
;
; Inputs         : cx = umb_head
;
;
; Outputs        : If UMBs are linked
;                       ES = umb_head
;                       DS = arena before umb_head
;                  else
;                       DS = last arena
;                       ES = next arena. will be umb_head if NC.
;
;                  CY if error
;
; Uses           : DS, ES, DI, BX
;
;--------------------------------------------------------------------------

IFDEF __TONYI__5
;----------------------------------------------------------------------
; WARNING!!! In case of error this routine will NOT return!
;----------------------------------------------------------------------
ENDIF

Procedure       GetLastArena, NEAR


        push    ax                      ; save ax

        mov     ax, [arena_head]
        mov     es, ax                  ; es = arena_head
        xor     di, di

        cmp     byte ptr es:[di],arena_signature_end
                                        ; Q: is this the last arena
        je      GLA_done                ; Y: return last arena in ES


GLA_next:
        mov     ds, ax
IFDEF __TONYI2__
        ArenaNextInline GLA_err
ELSE
        call    arena_next              ; ax, es -> next arena
        jc      GLA_err
ENDIF

IFDEF __TONYI__5
;-------------------------------------------
; Save 3 bytes.......
;-------------------------------------------
	call	Test_UmbFlag_LINKSTATE
ELSE
        test    [UmbFlag], LINKSTATE    ; Q: are UMBs linked
ENDIF
        jnz     GLA_chkumb              ; Y: terminating condition is
                                        ;    umb_head
                                        ; N: terminating condition is 05Ah

        cmp     byte ptr es:[di],arena_signature_end
                                        ; Q: is this the last arena
        jmp     short @f
GLA_chkumb:
        cmp     ax, cx                  ; Q: is this umb_head
@@:
        jne     GLA_next                ; N: get next arena

GLA_done:
                                        ; M061 - Start
IFDEF __TONYI__5
;-------------------------------------------
; Save 3 bytes.......
;-------------------------------------------
	call	Test_UmbFlag_LINKSTATE
ELSE
        test    [UmbFlag], LINKSTATE    ; Q: are UMBs linked
ENDIF
        jnz     GLA_ret                 ; Y: we're done
                                        ; N: let us confirm that the next
                                        ;    arena is umb_head
        mov     ds, ax
IFDEF __TONYI2__
        ArenaNextInline GLA_err
ELSE
        call    arena_next              ; ax, es -> next arena
        jc      GLA_err
ENDIF
        cmp     ax, cx                  ; Q: is this umb_head
        jne     GLA_err                 ; N: error
                                        ; M061 - End

GLA_ret:
        clc
        pop     ax                      ; M061
        ret                             ; M061

GLA_err:
        stc                             ; M061
        pop     ax
IFDEF __TONYI__5
;----------------------------------------------------------------------
; Go directly to error routine.........
; This saves the mainline code from having to check CF and saves a 
; byte or two. The old AX doesn't matter anymore since we're erroring
; out anyway...........
;----------------------------------------------------------------------
	pop	ax		; Eat the return address.
AllocArenaError:
        invoke  SetErrLocMem
	jmp	Merge_arena_trashed
ELSE
        ret
ENDIF

EndProc GetLastArena

DOSCODE ENDS
        END

