;  These definitions are part of the common BIOS access area at seg 40:xxxx                                               ;
_BIOS_Memory            equ 0013h

MEMSIGNATURE      equ 4Dh
ENDSIGNATURE      equ 5Ah
IDM               equ 4Dh
IDZ               equ 5Ah
_PARENT_SIGNATURE equ 0008h               ; mem parent signature
_FREE_MEMBLOCK    equ 0000h               ; mem block is free
_HIGHMEMBLOCK     equ 0A000h - 1          ; start mem block for high mem

_MIN_ALLOC_PARAS  equ 2

_MEM_FIRSTFIT_STRATEGY  equ 0003h               ; masks for allocation test
_MEM_BESTFIT_STRATEGY   equ 0001h
_MEM_LASTFIT_STRATEGY   equ 0002h
_MEM_FIRSTFIT_LOW       equ 0000h               ; strategy requests
_MEM_BESTFIT_LOW        equ 0001h
_MEM_LASTFIT_LOW        equ 0002h
_MEM_FIRSTFIT_HIGH      equ 0080h
_MEM_BESTFIT_HIGH       equ 0081h
_MEM_LASTFIT_HIGH       equ 0082h
_MEM_FIRSTFIT_HIGHONLY  equ 0040h
_MEM_BESTFIT_HIGHONLY   equ 0041h
_MEM_LASTFIT_HIGHONLY   equ 0042h

MCB:
_memSignature    db MEMSIGNATURE        ; always 4D
$memSignature    equ 0               
_memParent       dw 0000h                ; seg address of owner
$memParent       equ 1
_memAlloc        dw 0000h                ; allocated size
$memAlloc        equ 3
_memReserved     db '???'
$memReserved     equ 5   
_memPgmName      db 8 dup (0)            ; program name or null
$memPgmName      equ 8    
sizeMEMBLOCK     equ $ - MCB
_minparag        dw 0
_maxparag        dw 0
_allocation      dw 0
_AllocStrategy   dw _MEM_FIRSTFIT_LOW
MaxMemory        dw 0
initLowMemSegment dw ?                    ; low memory segment
initMemParagraphs dw ?                    ; memory size
_bestfit         dw 0
_lastfit         dw 0

; ===========================================================================
init_block proc far
;  es    segment points to memory block to initialize   
;  ax    is size to initialize (paragraphs )            
;  bx    parent                                         
;        0000 block is free                             
;        0008 (_PARENT_SIGNATURE) block belongs to DOS
; ===========================================================================
     push ax                                      
     xor  ax, ax
     xor  di, di
     mov  cx, (sizeMEMBLOCK)/2                     
     rep  stosw
     pop  ax
     xor  di, di
     mov  byte ptr es:[$memSignature], ENDSIGNATURE
     mov  word ptr es:[$memAlloc], ax
     mov  word ptr es:[$memParent], bx
     ; if valid PSP, copy program name to memory block
     cmp  bx, _PARENT_SIGNATURE                 ; NxDOS Block ?
     jnz  init_blockx                           ; if not NxDOS
     push ds
     push si
     push di
     push cs
     pop  ds
     mov  si, offset [Productname]           ; cs:
     mov  di, $memPgmName[di]
     mov  cx, 4                              ; (size Productname)/2
     rep  movsw      
     pop  di
     pop  si
     pop  ds
init_blockx:
     ret
init_block endp

; ===========================================================================
AllocStrat proc far
; ===========================================================================
      cmp  al, 1
      je   set_strategy
           cmp  al, 0
           jne  end_setstrat
                 mov  ax, word ptr cs:[_AllocStrategy]
                 clc
                 jmp  end_setstrat
set_strategy:
      mov  word ptr cs:[_AllocStrategy], bx
      clc
end_setstrat:
      ret
AllocStrat endp

; ===========================================================================
LocalZoneAlloc proc far
; AX = paragraphs to begin search
; BX = paragraphs of memory requested
; Outputs:
; AX = segment of allocated memory block
; BX = size of largest block of memory available in paragraphs
; ===========================================================================
     push ax
     mov  ax, 0000h
     mov  _bestfit, ax
     mov  _lastfit, ax
     pop  ax
     push ds
     push es
     or   ax, ax
     jnz  scan_blocks
          mov  ax, error_not_enough_memory
          call SetError
          jmp  almx
scan_blocks:
     cli     
     xor  dx, dx                                      ; largest available
     mov  cx, 0ffffh                                  ; best fit
scan_block_loop:
     mov  es, ax                                      ; point to memory seg
     cmp  byte ptr es:[$memSignature], MEMSIGNATURE
     jz   validarena                                  ; if valid arena -->
     cmp  byte ptr es:[$memSignature ], ENDSIGNATURE
     jz   validarena                                  ; if valid arena -->
          mov  ax, error_invalid_block
          call SetError
          jmp  almx
validarena:
     cmp  word ptr es:[$memParent], 0000            ; 0000 for parent means its free
     jnz  regularblock                                ; not a free block -->
     mov  si, word ptr es:[$memAlloc]               ; get available space
     sub  si, bx                                      ; is block within allocation size ?
     jc   allocthis                                    ; no -->
     mov  _lastfit, ax
     test word ptr [_AllocStrategy], _MEM_FIRSTFIT_STRATEGY
     jz   allocblock                                 ; ok to allocate this block ->
     cmp  cx, si                                      ; is this block a better fit ?
     jc   allocthis                                 ; not a better strategy -->
     mov  cx, si                                      ; else save fit
     mov  _bestfit, ax
allocthis:
     cmp  dx, word ptr es:[$memAlloc]               ; larger block ?
     jnc  regularblock                                ; no -->
     mov  dx, word ptr es:[$memAlloc]               ; get size
regularblock:
     inc  ax
     add  ax, word ptr es:[$memAlloc]      
     cmp  byte ptr es:[$memSignature], ENDSIGNATURE
     jnz  scan_block_loop                           ; not at end yet -->
     ;  available block not found or allocation deferred to here
     mov  ax, _bestfit
     test word ptr [_AllocStrategy], _MEM_BESTFIT_STRATEGY
     jnz  isallocation                                ; if best fit -->
     mov  ax, _lastfit
     test word ptr [_AllocStrategy], _MEM_LASTFIT_STRATEGY
     jz   allocblockunavail                                 ; if not last fit -->
isallocation:
     or   ax, ax                                       ; determine if no allocation
     jnz  allocblock                                ; if block available -->
allocblockunavail:
          xor  dx, dx
          stc
          mov  ax, error_not_enough_memory
          jmp  almx
; Allocate block.
; assumes es: points to free block to allocate
allocblock:
     mov  es, ax                                      ; 
     push es                                         ; segment to return
     push bx                                         ; size requested
     mov  dl, byte ptr es:[$memSignature]           ; current block signature
     mov  ax, word ptr es:[$memAlloc]               ; get allocation
     sub  ax, bx                                      ; this is remaining alloc balance
     jz   updateoldmcb                                 ; if exact fit -->
     dec  ax                                          ; make room for second mem control block
     mov  cx, es
     add  cx, bx                                      ; space we'll need
     inc  cx                                          ; where next block will be
     push dx                                         ; current block signature
     mov  es, cx                                      ; create a block here 
     xor  bx, bx                                      ; this block is free
     call init_block                               ; initialize memory block.
     pop  dx
     mov  byte ptr es:[$memSignature], dl           ; save real signature
     mov  dl, MEMSIGNATURE
; update old mem control block
updateoldmcb:
     pop  bx                                          ; request size
     pop  es                                          ; seg address (es: )
     mov  cx, word ptr cs:[_CURRENTPSP]

     ; mov  cx, word ptr ss:[_CurrentPSP]

     mov  word ptr es:[$memParent], cx              ; current owner
     mov  word ptr es:[$memAlloc], bx               ; allocate what we need
     mov  byte ptr es:[$memSignature], dl
     mov  ax, es
     inc  ax                                          ; seg address of data
     mov  dx, word ptr es:[$memAlloc]               ; (was in bx)
IF (DEBUG)
     xor  si, si
     mov  cx, 64
     call debugdump
ENDIF
     clc                                             ; no carry.
almx:
     pop es                                          ; restore segment registers
     pop ds
     sti
     ret
LocalZoneAlloc endp

; ===========================================================================
Get_BlockSize proc far
; ES = allocated block of memory (not header)
; Outputs:
; AX = segment address of allocated block
; CX = size of memory block
; ===========================================================================
     push es
     mov  ax, es
     sub  ax, (sizeMEMBLOCK / PARAGRAPH)
     mov  es, ax                                      ; point to memory seg
     cmp  byte ptr es:[$memSignature], MEMSIGNATURE
     jz   GETSIZE                          ; if valid arena -->
     cmp  byte ptr es:[$memSignature], ENDSIGNATURE
     jz   GETSIZE                          ; if valid arena -->
          mov  ax, error_invalid_block
          call SetError
          jmp  GETSIZEX
GETSIZE:             
     mov cx, word ptr es:[$memAlloc]               ; get allocation size
GETSIZEX:
     pop es
     ret
Get_BlockSize endp

; ===========================================================================
Collect_blocks proc far
; This routine will scan all memory blocks and merge all free memory blocks
; together.                              
; ===========================================================================
     push ds
     push es
     mov  ax, word ptr cs:[wbaseMemSeg]
; is block free ?
collectblocks:
     mov  ds, ax                                      ; next in ax
collectblock:
     cmp  byte ptr ds:[$memSignature], ENDSIGNATURE
     jz   collectdone                                  ; done -->
     cmp  word ptr ds:[$memParent], 0000            ; is block free ?
     jnz  collectnext                               ; no, go to next -->
; is next also free ?
     mov  ax, ds                                      ; get current segment
     add  ax, word ptr ds:[$memAlloc]               ; increment to next block
     inc  ax
     mov  es, ax
     cmp  word ptr es:[$memParent], 0000            ; is next block free ?
     jnz  collectblocks                     ; no, go to next -->
     mov  ax, word ptr es:[$memAlloc]               ; get next allocation
     inc  ax                                          ; kill interim Mem block as well
     add  word ptr ds:[$memAlloc], ax               ; add to current block
     mov  al, byte ptr es:[$memSignature]           ; last signature is passed to current block
     mov  byte ptr ds:[$memSignature], al           ;
     jmp  collectblock
; go to next
collectnext:
     mov  ax, ds                                      ; get current segment
     add  ax, word ptr ds:[$memAlloc]               ; increment to next block
     inc  ax
     jmp  collectblocks
collectdone:
     pop es
     pop ds
     ret
Collect_blocks endp

memblock_expand proc far
     mov  cx, word ptr es:[$memAlloc]               ; existing allocation
     mov  dl, byte ptr es:[$memSignature]           ; existing signature
     pop  es
     add  word ptr es:[$memAlloc], bx               ; expanded allocation
     mov  ax, es                                      ; current allocation
     add  ax, word ptr es:[$memAlloc]               ; where next block will appear
     inc  ax
     mov  es, ax                                      ; create a block here 
     mov  ax, cx                                      ; new allocation size
     sub  ax, bx                                      ; part acquired by expansion
     xor  bx, bx                                      ; parent of new remainder is free
     call init_block                                ; initialize memory block.
     mov  byte ptr es:[$memSignature], dl           ; previous signature stays.
     clc
     ret
memblock_expand endp

memblock_collapse proc far
     mov  cx, es                                      ; current segment
     add  cx, bx
     inc  cx                                          ; where to create next mem seg
     mov  ax, word ptr es:[$memAlloc]               ; existing space
     sub  ax, bx                                      ; size of remaining block
     dec  ax                                          ; make room for mem header
     stc
     jz   mb_cx                                       ; not enough room -->
     mov  byte ptr es:[$memSignature], MEMSIGNATURE
     mov  word ptr es:[$memAlloc], bx               ; re-allocate space
     mov  es, cx
     xor  bx, bx                                      ; free block
     call init_block                                ; initialize memory block.
     call Collect_Blocks                            ; collect free blocks
     clc
mb_cx:
     ret
memblock_collapse endp

; ===========================================================================
Modify_Block proc far
; es   paragraph to free 
; bx   new paragraph size
; ===========================================================================
     mov  ax, es
     sub  ax, (sizeMEMBLOCK / PARAGRAPH)
     mov  es, ax
     cmp  byte ptr es:[$memSignature], MEMSIGNATURE
     jz   modifyblock
     cmp  byte ptr es:[$memSignature], ENDSIGNATURE
     jz   modifyblock
          mov  ax, error_invalid_block
          call SetError
          jmp  modifyblock_done
;  are we expanding allocation ?
modifyblock:
     cmp  bx, word ptr es:[$memAlloc ]
     jz   modifyblock_done                           ; same size as now, ignore request -->
     jc   collapse_modifyblock                           ; no, contracting allocation -->
     push es
     mov  ax, es
     add  ax, word ptr es:[$memAlloc]
     inc  ax                                          ; point to next block
     mov  es, ax
     cmp  word ptr es:[$memParent], 0000            ; is next block free ?
     jz   modifyblock_free                           ; yes, ok to try to expand -->
     pop  es
          mov  ax, error_not_enough_memory
          call SetError
          jmp  modifyblock_done
modifyblock_free:
     cmp  bx, word ptr es:[$memAlloc]               ; is extra block enough to expand ?
     jle  modifyblock_expand                          ; yes, ok to try to expand -->
     pop  es
          mov  ax, error_not_enough_memory
          call SetError
          jmp  modifyblock_done
modifyblock_expand:
     call memblock_expand
     jmp  modifyblock_done
;  collapse allocated space
collapse_modifyblock:
     call memblock_collapse
modifyblock_done:
     ret
Modify_Block endp

; ===========================================================================
Release_Blocks proc far
; BX = PSP address of owner
; ===========================================================================
     push es
     mov  ax, word ptr cs:[wbaseMemSeg]
; does block belong to owner ?
releaseblock:
     mov  es, ax                                      ; next block in ax
     cmp  bx, word ptr es:[$memParent]              ; owner block ?
     jnz  release_notours                ; no -->
     mov  word ptr es:[$memParent], 0000            ; free up block
release_notours:
     cmp  byte ptr es:[$memSignature], ENDSIGNATURE
     jz   release_exit                 ; if at end -->
     mov  ax, es                                      ; get current segment
     add  ax, word ptr es:[$memAlloc]               ; increment to next block
     inc  ax
     jmp  releaseblock
release_exit:
     pop  es
     ret
Release_Blocks endp

; ===========================================================================
Free_Block proc far
; ES = memory block
; ===========================================================================
     push es
     mov  ax, es
     sub  ax, (sizeMEMBLOCK / PARAGRAPH)
     mov  es, ax
     cmp  byte ptr es:[$memSignature], MEMSIGNATURE
     jz   freemem_yes
     cmp  byte ptr es:[$memSignature], ENDSIGNATURE
     jnz  freemem_done
freemem_yes:
     mov  word ptr es:[$memParent], 0000            ; free up block
     call Collect_Blocks                                 ; collect free blocks
freemem_done:
     pop  es
     ret
Free_Block endp

; ===========================================================================
AllocUMB proc far
; BX = paragraphs requested
; Outputs:
; AX = segment
; CX = sizeof largest block
; ===========================================================================
     stc
     ret
     test word ptr [_AllocStrategy], (_MEM_FIRSTFIT_HIGH+_MEM_FIRSTFIT_HIGHONLY)
     jnz  AUMBx                    ; if search upper memory blocks -->
AUMB1:
     mov  ax, error_not_enough_memory
     call SetError
     ret
AUMBx:
     mov  ax, _HIGHMEMBLOCK
     call LocalZoneAlloc
     ret
AllocUMB endp

; ===========================================================================
AllocCONV proc far
; BX = paragraphs requested
; Outputs:
; AX = segment
; DX = sizeof largest block
; ===========================================================================
     test word ptr [_AllocStrategy], (_MEM_FIRSTFIT_HIGHONLY)
     jz   ACONVx                   ; if search conv memory blocks -->
ACONV1:
     mov  ax, error_not_enough_memory
     call SetError
     ret
ACONVx:
     mov  ax, word ptr cs:[wbaseMemSeg]
     call LocalZoneAlloc
     ret
AllocCONV endp

; ===========================================================================
AllocMemBlock proc far
; CX = # of paragraphs of memory requested
; Outputs: ES = segment address of allocated memory block
;          CX = size of largest block of memory available in paragraphs
;          CF = CY = error
; ===========================================================================
     mov  _allocation, cx
     mov  bx, cx
     call AllocUMB
     jnc  AMBx
     mov  bx, word ptr _allocation
     call AllocCONV
AMBx:
     mov  es, ax
     mov  cx, dx
     ret
AllocMemBlock endp

; ===========================================================================
Alloc_MinMax proc far
; AX = minimum block
; DX = maximum block
; Output: ES = Segment  of allocated memory block
;         AX = Segment  of allocated memory block header
;         CX = size of memory available
; ===========================================================================
     mov  cs:[_minParag], ax
     mov  cs:[_maxParag], dx
     mov  cx, dx                          ; try for max
     call allocMemBlock                ; will probably fail
     jnc  ammx
     cmp  cx, word ptr cs:[_minParag][bp] ; largest available will fit ?
     jnc  ammx_gomax                      ; yes, go for max -->
ammx_error:
     stc
     mov  ax, error_not_enough_memory
     jmp  ammx
ammx_gomax:
     call allocMemBlock            
     mov  es, ax            
     sub  ax, (sizeMEMBLOCK/PARAGRAPH)
     or   ax, ax
ammx:
     ret
Alloc_MinMax endp

; ===========================================================================
init_memory proc far
; ===========================================================================
     push ds
     push es
     ;
     int  12h
     mov  word ptr cs:[initMemParagraphs], ax
     ;
     mov  cx, 4
     mov  ax, offset EndOfInitCode
     shr  ax, cl
     mov  cx, cs
     add  cx, ax
     mov  word ptr cs:[wbaseMemSeg], cx            ; allocate from here
     mov  cx, 6
     mov  ax, word ptr es:[initMemParagraphs]  ; available memory size
     mov  bx, ax
     shl  ax, cl                            ; convert to segment address form
     mov  word ptr cs:[MaxMemory], ax       ; memory available
     ;
     ; multiply * 64k
     mov  ax, bx
     shl  ax, 1 
     shl  ax, 1
     shl  ax, 1
     shl  ax, 1
     shl  ax, 1
     shl  ax, 1
     ; max segment
     sub  ax, word ptr cs:[wbaseMemSeg]

     ;mov  bx, 0070h
     ;mov  word ptr cs:[wbaseMemSeg], bx
     ;
     push ax
          mov  bx, _PARENT_SIGNATURE
          mov  cx, word ptr cs:[wbaseMemSeg]
          mov  es, cx  
          call init_block
          xor  cx, cx
          mov  ax, word ptr es:[$memAlloc][di]
          dec  ax
          mov  word ptr es:[$memAlloc][di], cx       
          mov  byte ptr es:[$memSignature][di], MEMSIGNATURE
          mov  dx, es
          inc  dx
          mov  es, dx 
          xor  bx, bx              
          call init_block
          mov  byte ptr es:[$memSignature][di], ENDSIGNATURE
     pop  ax
     pop  es
     pop  ds
     ret
init_memory endp

memwalk proc far
     mov  ax, word ptr cs:[wbaseMemSeg]
     sub  ax, (sizeMEMBLOCK / PARAGRAPH)
     mov  es, ax
mcbwalk:
     xor  si, si
     mov  al, byte ptr es:[si+0]
     cmp  al, IDM
     jne  notamcb
showmcb:
          push es
          push si
          push ax
          call debugdump
          pop  ax
          pop  si
          pop  es
          cmp  al, IDZ
          je   exitwalk
notamcb:
     cmp  al, IDZ
     je   showmcb
     push es
     pop  bx
     mov  ax, word ptr es:[si+$memAlloc]
     add  ax, bx
     inc  ax
     push ax
     pop  es
     jmp  mcbwalk
exitwalk:
     ret
memwalk endp
