; ===========================================================================
;  Chimaira Memory Manager (c) 2007 Christopher Evans
;
;  2006 - CE, Memory Management Functions for real mode
;
; ===========================================================================
; 
; Since these are complex functions, they shouldn't be used unless you have
; a very specific purpose for them. Misusing these commands may result in
; loss of system memory that can be reclaimed only by rebooting the system.
; Each of the following calls returns the error status in the carry flag. 
;
; Heap managers work by request a large block of memory from the operating
; system. They create a free list of pointers to storage blocks. When an
; allocation request is received, the heap manager marks an appropriately
; sized block of memory as reserved and returns a pointer to the block. Later,
; when a delete request for the same block is received, the heap frees up the
; block, returning it to the free list. Whenever a new allocation request is
; received, the heap manager scans the free list, looking for the first
; available block large enough to grant the request.
;
; ===========================================================================

arena_signature_normal EQU 4dh
arena_signature_end    EQU 5ah
arena_owner_dos        EQU 0008h
arena_owner_app        EQU 0007h
arena_owner_bullshit   EQU 00b0h
arena_block_free       EQU 0000h   ; bulshit stuff.. ignore it ce, ca, cb
IDM                    EQU arena_signature_normal
IDZ                    EQU arena_signature_end
FIRST_FIT  EQU 0  ; 4              ; Search Conventional memory for available
                                   ; block having the lowest address, default.
BEST_FIT   EQU 1                   ; Search conventional RAM for a available
                                   ; block that most closly matches the
                                   ; requested size.
LAST_FIT   EQU 2                   ; Search Conventional RAM from highest
                                   ; address for available block. (Top-Down)
; DOS 5.0+ ------------------------------------------------------------------
FIRST_FIT_HIGH      EQU 0080h      ; Ditto, but with CONV+UMBs address space
BEST_FIT_HIGH       EQU 0081h      ; Ditto, but with CONV+UMBs address space
LAST_FIT_HIGH       EQU 0082h      ; Ditto, but with CONV+UMBs address space
FIRST_FIT_HIGHONLY  EQU 0040h      ; Ditto, but with UMBs address space
BEST_FIT_HIGHONLY   EQU 0041h      ; Ditto, but with UMBs address space
LAST_FIT_HIGHONLY   EQU 0042h      ; Ditto, but with UMBs address space
; NXDOS 8.0+ --[Virtual memory]----------------------------------------------
FIRST_FIT_VIRT      EQU 0400h      ; 
BEST_FIT_VIRT       EQU 0410h      ; 
LAST_FIT_VIRT       EQU 0420h      ; 
; ---------------------------------------------------------------------------
;
LINKSTATE  EQU 1
HF_MASK    EQU NOT FIRST_FIT_HIGH
HO_MASK    EQU NOT FIRST_FIT_HIGHONLY
STRAT_MASK EQU HF_MASK AND HO_MASK
d_minimum  EQU 16
def_size   EQU 1024
IMBA_ERR   EQU 9  ; Invalid memory block address
ALLOCMIN   EQU 16

smm_public:
  MEMMGR      EQU 1
  ;
  smm_handle  EQU 0
  smm_seg     EQU 2
  smm_ofs     EQU 4
  smm_size    EQU 6
  smm_owner   EQU 8
  smm_slab    EQU 10
  ;
  smm_hstart  EQU 1
  smm_hend    EQU 0feh
  smm_avail   EQU 0
  smm_endof   EQU 0ffh
  smm_on      EQU 1
  smm_off     EQU 0ffh
  smm_NOMEM   EQU 8   
  smm_MEMERR  EQU 7   
    maxallocs EQU 256

  chimaira_nym db 'CHIMAIRA',0,' (C)opyright 2007 DMSoft, Christopher R. Evans. ',0ffh
               db 'Do not remove this notice.',0ffh,0,24h

smm_private:

MMUDATA:
        mlock        db 0
        memused      dw 0   ; K
        CurrentPDB   dw (NXDOSSEG + 10h)
        FirstArena   dw (NXDOSSEG + 10h)
        BestArena    dw (NXDOSSEG + 10h)
        LastArena    dw (NXDOSSEG + 10h)
        AllocMethod  dw FIRST_FIT
        umb_head     dw 0
        umbflag      db 0 ; bit 0 = link state
        A20OFF_COUNT db 0
        DOS_FLAG     db 0
        mtemp        dw ?

;
;  FORMAT of arena block:
;  +-----------+---------+------+-------------+---------+
;  |      ID   | OWNER   | SIZE | RESERVED(3) | NAME(8) |
;  +-----------+---------+------+-------------+---------+
;
MCBARENA:
            ; use this to copy heap MCB to work with   pNext = es:(bx+size+1)
        arena_sig  db IDM
        arena_own  dw ?
        arena_size dw 16
        arena_resv db 3 dup(?)
        arena_name db 8 dup(0)
MCBARENASIZE EQU $ - MCBARENA
;
; This is our table record 256*10 = 2560 bytes of kernel space
;
;  +-----------+---------+------+-------+----------+
;  | Handle ID | seg:ofs | size | owner | slab ptr |
;  +-----------+---------+------+-------+----------+
;
smm_rec:
 smm_lhandle dw arena_block_free
    smm_lseg dw ?
    smm_lofs dw ?
   smm_lsize dw ?
  smm_lowner dw arena_owner_dos
  smm_lslab  dw ?                      ; -> to another m_table (special case)
  smm_recsize EQU $ - smm_rec

  SMM_RECORDS EQU (maxallocs*smm_recsize)

MMUDATA_SIZE EQU $ - MMUDATA

MMUSLAB:
arena_head dw (NXDOSSEG + 10h)
arena_free dw 0
   mallocs dw 0
   m_table db SMM_RECORDS dup(0), smm_endof
    m_rec$ EQU $ - MMUSLAB

smm_code:

ParaRound macro
; convert bytes to paragraphs, rounded up.
          add  ax, 15
          rcr  ax, 1
          shr  ax, 1
          shr  ax, 1
          shr  ax, 1
          endm

far2para macro fpseg, fpoff
       mov  ax, fpseg
       shl  ax, 4
       mov  bx, fpoff
       add  ax, bx
       mov  bx, ax          ; bx = linear address
       shr  ax, 4
         endm

seg2phys macro seg1, ofs1
       mov  ax, seg1        ; seg * 16 + offset
       shl  ax, 4
       add  ax, ofs1
       endm

long2para macro l2psize
       mov  ax, l2psize
       mov  bx, 0fh
       add  ax, bx
       shr  ax, 4
          endm 

Freemem$ macro ; var p:pointer;Size:Longint):Longint;
       mov  ax, cs:[freemem]
       endm

MemSize$ macro ; p:pointer:Longint;
       mov  ax, cs:[memsize]
       endm

; ===========================================================================
showmeminfo proc far
; ===========================================================================
     pusha
     _newline
     MemSize$
     call putnum
     _echo 'K'
     _echo ' '
     mov  ax, cs:ext_mem_size
     call putnum
     _echo 'K'
     _echo ' '
     _echo '('
     freemem$
     call putnum
     _echo ')'
     _echo ' '
     mov  ax, cs:arena_head
     call put_hex
     _echo 'H'
     _echo ' '
     mov  ax, cs:paragraphs
     call put_hex
     _echo 'H'
     _echo ' '
     mov  ax, cs:[arena_free]
     call putnum
     _newline
     popa
        ret
showmeminfo endp

disp_smmrec proc far
     pusha

     mov  ax, word ptr si[smm_handle]
     call put_hex
     _echo 'H'
     _echo ' '
     mov  ax, word ptr si[smm_seg]
     call put_hex
     _echo ':'
     mov  ax, word ptr si[smm_ofs]
     call put_hex
     _echo ' '
     mov  ax, word ptr si[smm_owner]
     call putnum 
     _echo ' '
     mov  ax, word ptr si[smm_size]
     call putnum 
     _echo ' '
     mov  ax, word ptr si[smm_slab]
     cmp  ax, 0
     je   nomout
     call put_hex
nomout:
     _newline
     mov  ax, word ptr si[smm_seg]
     push ax
     pop  es
     mov  ax, word ptr si[smm_ofs]
     push ax
     pop  si
     mov  cx, 16
     call debugdump
     popa
     ret
disp_smmrec endp

; ===========================================================================
show_mtable proc far
; ===========================================================================
     mov  si, offset m_table
     mov  cx, maxallocs
smt:
     mov  ax, word ptr si[0]
     cmp  ax, arena_block_free
     je   emptyrec
          push cx
               call disp_smmrec
          pop  cx
emptyrec:
     add  si, smm_recsize
     loop smt
     ret
show_mtable endp

MMUCODE:

; ===========================================================================
mtest proc far
; Input : ES:SI = SEG:OFS
;            CX = size
;       Test memory area... checkerboard save, write, test, restore
;       if fail then return MCB_DESTROYED
; ===========================================================================
        ; xor  ax, ax
        ; mov  si, ax
mtest_1:
	xor  ax, ax
	mov  al, byte ptr es:[si]
	push ax
	mov  al, 55h
	mov  byte ptr es:[si], al
	mov  al, byte ptr es:[si]
	cmp  al, 55h
	jne  short mtfail 
	pop  ax
	mov  byte ptr es:[si], al
	inc  si
	loop mtest_1
	clc
	jmp  short mtestx
mtfail:
	stc
mtestx:
;
;       for (i=0; i<=size; i++) {
;           a = mem[i];
;           mem[i] = 0x55;
;           b = mem[i];
;           if b != 0x55 { failed = true }
;           mem[i] = a;
;           if failed { break; }
;       }
      ret
mtest endp

; ===========================================================================
smm_findfirst proc far
; ===========================================================================
      mov  ax, offset m_table
      mov  si, ax
      ret
smm_findfirst endp

; ===========================================================================
smm_findnext proc far
; ===========================================================================
      push si
      pop  ax
      add  ax, smm_recsize
      push ax
      pop  si
      ret
;
;0+16=16 
;0000000000000000
;^
smm_findnext endp

; ===========================================================================
smm_free proc
; Input : AX = handle
;         BX = 1 = free ALL allocations
; ===========================================================================
     ;  mov  dl, byte ptr cs:[mlock]
     ;  or   dl, dl
     ;  jz   deallocgood
     ;       ret
deallocgood:
       inc  cs:[mlock]
       mov  word ptr cs:[mtemp], ax
       mov  ax, word ptr cs:[mallocs]
       or   ax, ax
       jz   nfreeerr
       mov  word ptr cs:[smmfree_all], bx
       ; Search for handle and free...
       mov  cx, mallocs
       call smm_findfirst
unlink_scan:
            push cx
            mov  ax, word ptr cs:[si]
            cmp  ax, smm_endof             ; -1 end of table         
            je   nfreeok
                 mov  bx, word ptr cs:[smmfree_all]
                 or   bx, bx
                 jnz  remove_entry
                 mov  ax, word ptr cs:[si]
                 mov  bx, word ptr cs:[mtemp]
                 cmp  ax, bx
                 jne  not_ours
remove_entry:
                      ; remove entry
                      xor  ax, arena_block_free 
                      mov  word ptr cs:[si], ax
                      mov  ax, word ptr cs:[arena_free]
                      mov  bx, word ptr cs:[si+smm_size]
                      add  ax, bx
                      mov  word ptr cs:[arena_free], ax
                      dec  cs:[mallocs]
                      jmp  nfreeok
not_ours:
            call smm_findnext
            pop  cx
       loop unlink_scan
       jmp  smmfreex
nfreeerr:
       mov  ax, LOC_MEMORY                  ; 6-2008 - Should I always return 
       mov  byte ptr cs:EXTERR_LOCUS, al    ; LOC_MEMORY? 
       mov  ax, SMM_MEMERR
       stc
       jmp  smmfreex
nfreeok:
       cli
smmfreex:
       dec  cs:mlock
       ret
smmfree_all dw 0
smm_free endp

; ===========================================================================
mfree  proc far                                                ; DOS FUNC 49H
; Freemem (var p:pointer):Longint;
; Input : ES = segment address of block to be deallocated
; Output: CF = CY AX = error code (7 or 9)
; ===========================================================================

       call smm_free

       ret
mfree  endp 

; ===========================================================================
smm_alloc proc
; Input  : CX = SIZE
; Output : AX:DX = SEG:OFS
;          BX    = Handle
; ===========================================================================
       push cs
       pop  ds
     ;  mov  al, byte ptr cs:[mlock]
     ;  or   al, al
     ;  jz   allocgood
     ;       ret
; allocgood:
       inc  cs:[mlock]
       mov  word ptr cs:[mtemp], cx
       mov  ax, word ptr cs:[mallocs]
       cmp  ax, maxallocs
       je   nallc
       call smm_findfirst
smm_allc:
       mov  ax, word ptr ds:[si+smm_handle]
       cmp  ax, smm_endof           ; -1 end of table
       je   nallc
       cmp  ax, 0
       je   allocavail
            mov  ax, word ptr ds:[si+smm_owner]
            mov  word ptr cs:smm_lowner, ax
            mov  ax, word ptr ds:[si+smm_seg]
            mov  bx, word ptr ds:[si+smm_handle]
            mov  cx, word ptr ds:[si+smm_size]
            mov  dx, word ptr ds:[si+smm_ofs] 
            mov  word ptr cs:smm_lseg, ax
            mov  word ptr cs:smm_lofs, dx
            mov  word ptr cs:smm_lsize, cx
            mov  word ptr cs:smm_lhandle, bx
            call smm_findnext
            jmp  smm_allc
nallc:
       stc
       mov  ax, SMM_NOMEM
       mov  byte ptr cs:EXTERR_LOCUS, al
       jmp  smmallocx
allocavail:
       ; ax:dx seg:ofs
       mov  cx, word ptr cs:[mtemp]
       mov  bx, word ptr cs:[arena_free]
       cmp  cx, bx
       ja   short nallc
       sub  bx, cx
       mov  word ptr cs:[arena_free], bx
newlink:
       mov  word ptr ds:[si+smm_size], cx
       mov  ax, word ptr cs:[mallocs]
       cmp  ax, 0
       jne  not_first
            mov  ax, word ptr cs:[arena_head]
            mov  word ptr cs:smm_lseg, ax
            xor  ax, ax
            jmp  firstsegfixup
not_first:
       mov  ax, word ptr cs:smm_lofs
       mov  bx, word ptr cs:smm_lsize
       add  ax, bx
       inc  ax
firstsegfixup:
       mov  dx, ax
       mov  word ptr ds:[si+smm_ofs], dx
       mov  ax, word ptr cs:smm_lseg
       mov  word ptr ds:[si+smm_seg], ax
       mov  bx, arena_owner_dos
       mov  word ptr ds:[si+smm_owner], bx
       mov  bx, word ptr cs:[smm_lhandle]
       inc  bx
       mov  word ptr ds:[si+smm_handle], bx
       ; Return : AX:DX = SEG:OFS  BX = handle
       ;
       inc  cs:[mallocs]
; end of newlink
IF (DEBUG)
       push ax
       push dx
       push bx
       push cx
       call showmeminfo
       call show_mtable
       pop  cx
       pop  bx
       pop  dx
       pop  ax
ENDIF
       clc
smmallocx:
       dec  cs:[mlock]
       ret
smm_alloc endp

; ===========================================================================
arenasetup proc far
; AX = 0 = Set to next segment above current
; AX!= 0 = Set ArenaHead, if DX = 0 default segment or userdefined
;          DX = Segment
; ===========================================================================
        cmp  ax, 0
        jne  set2curr
             cmp  dx, 0
             jne  segfromdx
                  mov  ax, cs:NXDOSSEG
arenatag:
                  ;
                  ;add  ax, 0010h
                  add  ax, 0001h
                  mov  cs:arena_head, ax
                  jmp  segfdx_x
segfromdx:
                  mov  cs:arena_head, dx
segfdx_x:
        xor  ah, ah
        mov  al, 1          ; set strategy
        mov  bx, FIRST_FIT
        call cs:mmconfig
        jc   segsetupe
        ; call cs:setup_arena
        mov  bx, word ptr cs:AllocMethod
        mov  bx, 0ffffh
        mov  word ptr cs:[arena_free], bx
        clc
        jmp segsetupx
set2curr:
        push cs
        pop  ax
        jmp  arenatag
segsetupe:
        stc
segsetupx:
        ret
arenasetup endp

; ===========================================================================
chimaira proc far
; Input : AX = Heap segment
;         BX = 0ffh = turn mem mgr off, else on
; Output: AX = RAM SIZE IN KB
;         BX = EXTENDED RAM SIZE IN KB
;         DX = RAM SIZE IN PARAGRAPHS
;         CF = NCY A-OKAY! ELSE ERROR... HALT SYSTEM AND REBOOT.
; ===========================================================================
m_init:
     cmp  bx, smm_off
     jne  init_smm
          mov  ax, 0
          mov  bx, 1
          call smm_free
          jmp  smminitx
init_smm:
     mov  dx, ax
     mov  ax, 1
     call arenasetup
     call meminfo

     ; call mdpmimode
     ; jc   short dpmi_acs_err
     ; xor  ax, ax
     ; call mdpmi
     ; dpmi_acs_err:

     mov  cx, d_minimum                     ; dummy test block
     call smm_alloc
     jc   smminiterr
     mov  cx, def_size  
     call smm_alloc
     jc   smminiterr
          mov  ax, cs:arena_head
          push ax
          pop  es
          xor  si, si
          mov  cx, d_minimum+def_size  ; FFFFh
          call cs:mtest   
          jc   smminiterr                             ; fail on bad ram read/write
allocgood:
          ; we are golden!
          clc
     jmp  smminitx
smminiterr:
     mov  ax, error_arena_trashed
     stc
     ret             
smminitx:
     mov  ax, cs:memsize
     mov  bx, cs:ext_mem_size
     mov  cx, cs:arena_head
     mov  dx, cs:paragraphs      
     clc
     ret
chimaira endp

; ===========================================================================
memsetup proc far
; ===========================================================================
IF (MEMMGR)
        ; call memory manager
        mov  bx, smm_on
        call chimaira     
        jnc  short boot_memok
        ; panic prints out standard error message and halts pc
        _panic
ELSEIF
        _panic
ENDIF
        jmp  short memsetupx
boot_memok:
        mov  word ptr wbaseMemSeg, cx
        cmp  ax, 128
        jbe  short smallram
        mov  bx, 5             ; > 128K RAM
        jmp  short memsetupx
smallram:
        mov  bx, 3
memsetupx:
        mov  init_buf, bx
        ret
memsetup endp

; 2006 NXxxxx  stupid shit
; r=rand(0ffh-kstart+16h) ; kernel start seg
; if (addr[r:0]=='N') && (addr[r:0]=='X') { valid mem block; checksize }

; ===========================================================================
checkmcb proc far
; Input : AX = address of block header
;         DI = 0
; Output: ES = AX
;         CF = CY = Bad MCB
;              NC = Good MCB
; ===========================================================================
     mov  es, ax
     cmp  byte ptr es:[di], IDM
     je   chkmcb_ok
     cmp  byte ptr es:[di], IDZ
     je   chkmcb_ok
     stc
     jmp  short chkmcbx
chkmcb_ok:
     clc
chkmcbx:
     ret
checkmcb endp

; ===========================================================================
firstmcb proc
; Input : NONE
; Output: ES = pointer to first MCB
;         DI = 0
;         CX = Size
; ===========================================================================
     push ax
     mov  ax, cs:[arena_head]
     xor  di, di
     mov  es, ax
     mov  cx, word ptr es:[di+2]
     pop  ax
     ret
firstmcb endp

; ===========================================================================
nextmcb proc far
; Input : DS = pointer to block head
;         DI = 0
; 
; ===========================================================================
     mov  ax, ds
     add  ax, word ptr ds:[di+1] ; arena_size
     inc  ax
     ;
     call checkmcb ; es:ax set cf if error
     ret
nextmcb endp

; ===========================================================================
firstblock proc far
; INPUT : None
; OUTPUT: ES = Memory of first block in chain
; ===========================================================================
     call firstmcb
     ret
firstblock endp

; ===========================================================================
memcheck proc far
; Checks the MEM MCB CHAIN is good.
; BX = 1 = Display MCB record
; ===========================================================================
     push es
     push ds
     call firstmcb
     push es
     pop  ds
     mov  ax, ds
     call checkmcb
     jc   badmcb
nextblock:
     cmp  bx, 1
     jne  nomemchkd
          mov  ax, di
          mov  si, ax
          mov  cx, 16
          call cs:debugdump 
          _newline
nomemchkd:
     cmp  byte ptr es:[di], IDZ
     je   short mcbok
     mov  ax, ds
     call nextmcb
     jc   badmcb
     jmp  short nextblock
mcbok:
     clc
     jmp  short memc_x
badmcb:
     stc
memc_x:
     pop  ds
     pop  es
     ret
memcheck endp

; ===========================================================================
mfreepid proc far
; Input : BX = PID
; Output: NONE
; ===========================================================================
     push ds
     push cs
     pop  ds
     mov  ax, word ptr ds:[arena_head]
mfp_s:
          ; mov  di, IDM
          mov  di, 0
          call checkmcb
mfp_prcloop:
          jc   mfp_exit
          push es
          pop  ds
          cmp  ds:[arena_own], bx  ; Our PID?
          jnz  mfp_fnext
          mov  DS:[arena_own], DI  ; Free him.
mfp_fnext:
          cmp  byte ptr ds:[di], IDZ ; This is the end... ?
          jz   mfp_chkumbs
          call nextmcb
          jmp  mfp_prcloop
mfp_chkumbs:
          mov  ax, word ptr cs:[umb_head]
          cmp  ax, 0ffffh            ; UMBs available?
          je   mfp_exit
          mov  di, ds
          cmp  di, ax
          jae  mfp_exit
          jmp  mfp_s
mfp_exit: 
     pop  ds
     ret
mfreepid endp

; ===========================================================================
malloc proc far ; DOS FUNC 48H
; getmem(size:longint) : pointer
; Input : BX = Requested block size (paragraphs)
; OutPut: CF = !CY ES:BX = points to allocated memory block
;               CY AX = error code (7 or 8)
;                  BX = maximum possible allocation size        
; ===========================================================================
       mov  ax, bx
       or   ax, ax
       jz   mallc_invalid
       mov  ax, bx
       cmp  ax, 0ffffh
       je   mallc_invalid
       ;
       mov  ax, cs:[memsize]
       mov  dx, cs:[memused]
       sub  ax, dx
       cmp  ax, ALLOCMIN
       jbe  nomem
       ;
       call cs:firstmcb
       ; es:di = starting block
       ; cx = size
       ; mov  ax, word ptr firstmcb
       ; mov  bx, word ptr firstmcb+2
       ; mov  es, ax
searchblocks:
       push es
       push di
       push cx 
searchmcb:
       ; check for corrupt chain ; arena[x].mtype
       mov  al, byte ptr es:[di] ; if es:bx[0] != 'M'  or es:bx[0] != 'Z'
       cmp  al, IDM
       jne  mcbdestroy
       ;
       mov  al, byte ptr es:[di] ; es:bx
       cmp  al, IDZ
       jne  mcbdestroy  ; endarena
       ;
       ; Okay, we are good.
       ; Now test for free based on rules
       ;
       mov  ax, cs:AllocMethod
       cmp  ax, LAST_FIT
       jne  mallc_n1
            ; if p.psp=free and p.size>=size q=p ; keep the last known fit
            ; not free - bump the pointer
            ; if p.type!=mcb_last p=p.ofs+p.size+1 else
            ; if p.type=mcblast  and  q=0 jmp  de_nomem else found = true
mallc_conv:
            test word ptr cs:allocmethod, FIRST_FIT_HIGHONLY
            jz   mallc_conv_alloc
            xor  dx, dx
            jmp  nomem
mallc_conv_alloc:
            ; mov  ax, word ptr cs:nxdos_pstartblock
            ; call malloc_l
            jmp  mallc_ok
mallc_n1:
       ; first fit

mallc_n2:
       ; best fit

       pop  cx
       pop  di
       pop  es
       call nextmcb
       jnc  searchblocks
mallc_invalid:
       nop

mcbdestroy:              
       ; mov  ax, LOC_MEMORY
       mov  ax, 7
       stc
       jmp  short mallc_x
nomem: 
       mov  ax, 8
       stc
       jmp  short mallc_x
mallc_ok:
       ; es:bx = block

       clc

mallc_x:
       ret
malloc endp 

; ===========================================================================
mresize proc far    ; DOS FUNC 4AH, Modify
; ReAllocMem(var p:pointer;Size:longint):Pointer;
; While you can almost always reduce the size of a block, you cannot normally increase the 
; size of a block if other blocks have been allocated after the block being modified. 
; Input : ES = address of block to modify allocation size
;         BX = size of new block
; Output: CF = CY AX = error code 5, 6, or 9
;                 BX = contains maximum size possible (if error 8)
; ===========================================================================

      ret
mresize endp

; ===========================================================================
memblk_size proc far
;          ES = alloc'd mem block
; Return :
;          CX = Size
;          CF = CY = BAD MBLK
; ===========================================================================
      push es
      mov  ax, es
      xor  di, di
      call checkmcb
      jnc  good_blk
           stc
           mov  ax, 1
           ret
good_blk:

      mov  cx, -1 ; memalloc

      clc
      pop  es
      ret
memblk_size endp

; ===========================================================================
GetLastArena proc far
; Input : CX = UMB_HEAD
; OutPut: IF UMBS LINKED = ES:DS = UMB_HEAD:ARENA_BEFORE_UMB_HEAD
;            ELSE DS:ES = LAST_ARENA:NEXT_ARENA. will be UMB_HEAD if NC
;         CY if error
; ===========================================================================
     push ax
     mov  ax, word ptr cs:[ARENA_HEAD]
     mov  es, ax
     xor  di, di
     cmp  byte ptr es:[di], IDZ
     je  GLA_DONE
GLA_NEXT:
     mov  ds, ax
     call nextmcb
     jc   GLA_err   ; mem chain is seriously f*cked up!
     test cs:[UMBFLAG], LINKSTATE
     jnz  GLA_chkumb
     cmp  byte ptr es:[di], IDZ
     je   GLA_DONE                ; jmp  short @f WTF!?  BUGBUGBUG!
GLA_chkumb:
     cmp  ax, cx ; umbhead?
@@:  jne  GLA_NEXT
GLA_DONE:
     test cs:[umbflag], LINKSTATE
     jnz  GLA_RET
     mov  ds, ax
     call nextmcb
     jc   GLA_ERR
     cmp  ax, cx
     jne  GLA_ERR
GLA_RET:
     clc
     pop  ax
     ret
GLA_ERR:
     stc
     pop  ax
     ret
GetLastArena endp

; ===========================================================================
mmconfig proc far
; Input : AL = 0 = GET STRATEGY
;              1 = SET STRATEGY
;                  BX = method = zw0000xy
;                       w = 1  = HIGH_ONLY
;                       z = 1  = HIGH_FIRST
;                      xy = 00 = FIRST_FIT
;                           01 = BEST_FIT
;                           10 = LAST_FIT
;              2 = GET UMB link state
;              3 = SET UMB link state
;                  BX = 0 = UnLink UMBs, else 1 Links them!
; Output: CF = NC = OK. else if CF = AX = error_invalid_function
;         if AL = 0 AX = existing method
;         if AL = 1 AX = who gives a pile.
;         if AL = 2 AL = 0 = UMBs not linked in, else 1 = UMBS are linked in
;         if AL = 3 ... links/unlinks the UMBS into DOS chain
; ===========================================================================
     or   al, al
     jz   alloc_getstrat
     cmp  al, 1 
     jz   alloc_setstrat
     cmp  al, 2 
     jz   alloc_getlink 
     cmp  al, 3 
     jz   alloc_setlink 
mmconfigerr:
     mov  EXTERR_LOCUS, errLoc_mem
     stc
     mov  ax, error_invalid_function
     ret
mmconfigbad:
     mov  EXTERR_LOCUS, errLoc_mem
     stc
     mov  ax, error_arena_trashed
     ret
alloc_getstrat:
     mov  ax, word ptr cs:[Allocmethod]
;     xor  ah, ah
     jmp  mmconfig_xok
alloc_setstrat:
     push bx
     and  bx, STRAT_MASK
     cmp  bx, 2
     pop  bx
     ja   mmconfigerr
     mov  word ptr cs:[Allocmethod], BX
     jmp  mmconfig_xok
alloc_getlink: 
     mov  al, cs:[UmbFlag]
     and  al, LINKSTATE
     jmp  mmconfig_xok
alloc_setlink: 
     mov  cx, cs:[umb_head]
     cmp  cx, 0ffffh        ; init'd ?
     je   mmconfigerr
     cmp  bx, 1
     jb   UnLinkUmbs
     jz   LinkUmbs
     jmp  mmconfigerr
UnLinkUmbs:
     test cs:[UmbFlag], LINKSTATE
     jz   short unlinked
     call GetLastArena
     jc   mmconfigerr
     mov  byte ptr ds:[0], IDZ
     and  cs:[UmbFlag], NOT LINKSTATE
unlinked:
     jmp  mmconfig_xok
LinkUmbs:
     test cs:[UmbFlag], LINKSTATE
     jnz  short linked
     call GetLastArena
     jc   mmconfigerr
     mov  byte ptr ds:[0], IDM
     or   cs:[UmbFlag], LINKSTATE
linked:
     nop
mmconfig_xok:
     clc
     ret
mmconfig endp

; ===========================================================================
mstrategy proc far ; DOS FUNC 58H
; Get/Set Alloc Strategy
; Input : AL = 0 = Get Allocation Strategy
;         AL = 1 = Set Allocation Strategy
;         AL = 2 = Get Upper Memory Link
;         AL = 3 = Set Upper Memory Link
; Output:
; ===========================================================================
;        inc  cs:mlock
;        cmp  al, 3
;        ja   short mstrat_error
;        cbw                             ; AH = 0
;        mov  si, ax
;        add  si, si                   ; SI = word offset of sub-function
;        call cs:f58_tbl[si]          ; execute the sub-function
;        jnc  mstrat_x
;        jmp  short mstrat_error     ;  or the error
mstrat_error:
;        stc
;        mov  ax, ED_FUNCTION
;        jmp  short mstrat_x
;f58_tbl dw   f58_get_strategy
;        dw   f58_set_strategy
;        dw   f58_get_link
;        dw   f58_set_link
f58_get_strategy:
;;       mov     ah, 0                    ; AX = subfunction = 0-3
;        mov     bx, memstrategy
;        clc
;        jmp  short mstrat_x
f58_set_strategy:
;        mov     ah, MS_M_STRATEGY
;        mov     memstrategy, bx
;        clc
;        jmp  short mstrat_x
f58_get_link:
;        mov     ah, MS_M_STRATEGY
;        mov     bx, dmd_upper_link
;        clc
;        jmp  short mstrat_x
f58_set_link:
;        mov  ax, ED_FUNCTION         ; return function not implemented
;        mov  cx, dmd_upper_root      ;  if no upper memory chain 
;        inc  cx                      ; CX = FFFF
;        stc
;        jcxz mstrat_x
;        dec  cx
;        mov  dmd_upper_link, bx      ; set link field
;        mov  ax, dmd_root            ; now find dmd before upper memory root
;        mov  dl, IDM                  ; assume we want to link
;        test bl, bl                   ; do we want to link/unlink UMBs?
;        jnz  f58_set_link10
;        mov  dl, IDZ                  ; no, we want to unlink
f58_set_link10:
;        mov  es, ax                   ; point to DMD
;;        ; call check_dmd_id            ; stop if id is invalid
;        jc   mstrat_x         ;  and return an error
;        push es
;;        ; call next_dmd                ; does the next DMD match our
;        pop  es
;        cmp  ax, cx                   ; upper memory chain ?
;        jne  f58_set_link10
;        mov  DMD_ID, dl               ; set appropriate link type
;        mov  ax, (MS_M_STRATEGY*256)+3; return AX unchanged
;        clc
mstrat_x:
;        dec  cs:mlock
        ret
mstrategy endp

DOS_MEM_RESIZE proc far
; Mem Resize - Set memory block size
      MemSize$
      cmp  ax, 16
      jg   _dos_4amc
_dos_4a_panic:
      ; before 4a: MCB chain corrupted
      _panic
_dos_4amc:      ; memchange ES, BX, &BX < 0
      ; if currentpsp = ES
      ; MK_FP(cupsp, 0) = p
      ; ps_size = BX + cupsp
      ; BX = size of new block
      ; ES = address of block to modify
      call cs:mresize
      jc   _dos_4a_panic
      mov  ax, es ; Undocumented MS-DOS behaviour expected by BRUN45!
      ; if (r.AH == 0x4a)
      ;   size_t size = 0, offs = 0xffff;
      ;   r.ES = offs;
      ;   if (FP_SEG(firstAvailableBuf) == offs) /* HMA present? */
      ;     offs = FP_OFF(firstAvailableBuf);
      ;     size = ~offs;                        /* BX for query HMA   */
      ;     if (r.AL == 0x02)                    /* allocate HMA space */
      ;       if (r.BX < size)
      ;         size = r.BX;
      ;       AllocateHMASpace(offs, offs+size);
      ;       firstAvailableBuf += size;
      ;   r.DI = offs;
      ;   r.BX = size;
      ;   return;
      ret
DOS_MEM_RESIZE endp

Memalloc_Strat proc far
; Get/Set MemAlloc Strategy
_dcs_5800:
       cmp  al, 0
       jne  _dcs_5801
             ; Query Memory Allocation Strategy
             call cs:mmconfig
       jmp  _DOSMEMOK
_dcs_5801:
       cmp  al, 1
       jne  _dcs_5802
             ; Set Memory Allocation Strategy
             ; BX = desired strategy code 
             ; if (lr.BL > LAST_FIT_U ||                 /* 0x82       */
             ; (lr.BL & FIT_MASK) > LAST_FIT)        /* 0x3f, 0x02 */
             ; goto error_invalid;
             ; mov  cs:[allocmethod], BX
             call cs:mmconfig
             jnc  _dcs_5801_ok
                  mov  cs:errorcode, ax
             _dcs_5801_ok:
       jmp  _DOSMEMOK
_dcs_5802:
       cmp  al, 2
       jne  _dcs_5803
             ; Query Upper-memory Link State
             call cs:mmconfig
             ; AL = 01H UMB is linked
             ; AL = 00H UMB not linked
             ; CF = NC = 0 always clear
             ; mov  ax, umb_link
       jmp  _DOSMEMOK
_dcs_5803:
       cmp  al, 3
       jne  _DOSMEMERR
             ; Set Upper-memory Link State
             ; Enables or disables use of and access to upper memory
             ; BX = 00 unlike all allocs go to conventional mem
             ; BX = 01 link UMB for allocations
             call cs:mmconfig
             ; mov  ax, 0 ; umb_root
             ; jmp  ax, 0ffffh
             ; jne  _dos_58x        ; always error if not exists 
             ; mov  umb_link, bx
       jmp  _DOSMEMOK
_DOSMEMOK:
IF (DEBUG)
      ; call show_mcb_chain
ENDIF
       clc
       jmp  short _DOSMEMX
_DOSMEMERR:
       stc
_DOSMEMX:
       ret
Memalloc_Strat endp

; --- cacheinit - 

cacheinit proc far
	lea  si, cache
	mov  cx, 0
mi_l:
        mov  bp, cx
	mov  ax, word ptr [si+bp+2]
	or   ax, ax
	jz   mi_x	
		; debug kmalloc-%d, size	
                ; mem_create(cache[si+bp+2],0,0,0);
		mov  word ptr cache[si+bp], ax
		mov  ax, word ptr cache[si+bp]
		or   ax, ax
		jz   mi_ex
	mov  ax, cx
	add  ax, 4
	mov  cx, ax
	jmp  mi_l
mi_ex:  mov  ax, -1
mi_x:
        ret
memcache:
        cache dw 0,4, 0,8, 0,16, 0,32, 0,64, 0,128, 0,256, 0,512, 0,1024, 0,2048, 0,0 
memcache_end EQU $ - memcache
cacheinit endp
