//
// Handle based swapping memory manager
//
include "inc/cmdsys.plh"
include "inc/fileio.plh"

struc t_initdata
    word    volptr
    word    freeblks
    word    ramvol
    word    bestvol
    word    ramfree
    word    bestfree
    word    filecnt
    word    catentry
    byte    catref
    byte    firstblk
    byte    entrylen
    byte    entriesblk
    byte    swapstrlen
    byte[4] volparms
    byte[]  volinfo
    byte[]  catalog
end
word initdata
//
// Access bytes within a word
//
struc t_word
    byte lsb
    byte msb
end
//
// Alloced memory block structure
//
struc t_memblk
    word blksiz
    byte blkref
    byte blklok
end
//
// Free memory block structure
//
struc t_freblk
    word fresiz
    word frenxt
end
//
// Block size
//
const MAX_BLK_SIZE = $2010
const MAX_BLK_MASK = $1FFF
const MIN_BLK_SIZE = $04
const MIN_BLK_MASK = $03
//
// Block states
//
const HMEM_ADDR     = $FFFC
const HMEM_SIZE     = $FFFC
const HMEM_STATE    = $03
const HMEM_MOVEABLE = $00 // Many dependencies on this being $00
const HMEM_AVAIL    = $01
const HMEM_LOCKED   = $02
const HMEM_SWAPPED  = $03
//
// Block flags
//
const HMEM_ACCESSED = $80
//
// Handle modifier
//
const HMOD = $4321
//
// Handle tables/lists
//
const PG_SIZE     = 512
const PG_ENTRIES  = 256
const PG_TBL_SIZE = 8
word sysbuf
word[PG_TBL_SIZE] hpgtbl // Handle page table
word pooladdr
word poolsize
word frelst              // Free list
byte sweeppg, sweepen
byte[64] swapvol = "/"   // Swap volume
byte swapdir = "/SWAP/"
byte hexchar = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
//
// DEBUG
//
//byte swapinstr = "Swap in:"
//byte swapoutstr = "Swap out:"
//byte getblkstr = "Get block = "
//byte allocpgstr = "Alloc page:"
//
//def putln
//    return putc($0D)
//end
//def putb(hexb)
//    return call($FDDA, hexb, 0, 0, 0)
//end
//def puth(hex)
//    return call($F941, hex >> 8, hex, 0, 0)
//end
//
// Fill block filename
//
def strcharadd(str, chr)#0
    ^str = ^str + 1
    str->.[^str] = chr
end
def swapfile(filestr, hmem)#0
    memcpy(filestr, @swapvol, swapvol + 1)
    strcharadd(filestr, 'H')
    strcharadd(filestr, hexchar[(hmem >> 12) & $0F])
    strcharadd(filestr, hexchar[(hmem >> 8)  & $0F])
    strcharadd(filestr, hexchar[(hmem >> 4)  & $0F])
    strcharadd(filestr, hexchar[ hmem        & $0F])
end
//
// Find exact/best free memory match
//
def unlink(freblk, freprv)
    //
    // Unlink free block
    //
    if freprv
        freprv=>frenxt = freblk=>frenxt
    else
        frelst = freblk=>frenxt
    fin
    return freblk
end
def unfre(freblk, freprv, size)
    word shrink

    if freblk=>fresiz == size
        //
    // Unlink free block
    //
        unlink(freblk, freprv)
    elsif freblk=>fresiz > size
        //
    // Shrink free block
    //
    shrink = freblk + size
    if freprv
        freprv=>frenxt = shrink
    else
        frelst = shrink
    fin
    shrink=>fresiz = freblk=>fresiz - size
    shrink=>frenxt = freblk=>frenxt
    else
        freblk = 0
    fin
    return freblk
end
def addfre(freblk)#0
    word srch

    //freblk=>fresiz = freblk=>blksiz
    if frelst and frelst < freblk
        srch = frelst
        while srch=>frenxt
            if srch=>frenxt > freblk
                //
                // Insert into list
                //
                freblk=>frenxt = srch=>frenxt
                srch=>frenxt   = freblk
                return
            fin
            srch = srch=>frenxt
        loop
        //
        // Add to end of list
        //
        freblk=>frenxt = 0
        srch=>frenxt   = freblk
    else
        //
        // Add to beginning of list
        //
        freblk=>frenxt = frelst
        frelst         = freblk
    fin
end
//
// Memory coallesce/compaction/swap out routines
//
def coallesce
    word srch, combined

    combined = 0
    srch = frelst
    while srch and srch=>frenxt
        if srch + srch=>fresiz == srch=>frenxt
            //
            // Combine adjacent free space
            //
            //putc('C');putc(' ');puth(srch);putc('+');puth(srch=>frenxt);putc(' ')
            srch=>fresiz = srch=>fresiz + srch=>frenxt=>fresiz
            srch=>frenxt = srch=>frenxt=>frenxt
            combined = 1
        else
            srch = srch=>frenxt
        fin
    loop
    return combined
end
def compact
    word page, entry, memblk, moveblk, size, srch, prev
    byte moved

    moved = 0
    for page = PG_TBL_SIZE - 1 downto 0
        if hpgtbl[page]
            for entry = 255 downto 0
                if hpgtbl:[page, entry].lsb & HMEM_STATE == HMEM_MOVEABLE
                    memblk = hpgtbl:[page, entry]
                    size    = memblk=>blksiz
                    moveblk = 0
                    prev    = 0
                    srch    = frelst
                    while srch and srch < memblk
                        if srch=>fresiz >= size
                            moveblk = unfre(srch, prev, size)
                            break
                        fin
                        prev = srch
                        srch = srch=>frenxt
                    loop
                    if moveblk
                        //putc('M');putc(' ');puth(moveblk);putc('=');puth(memblk);putc(' ')
                        memcpy(moveblk, memblk, size)
                        hpgtbl:[page, entry] = moveblk
                        addfre(memblk)
                        moved = 1
                    fin
                fin
            next
        else
            break
        fin
    next
    if moved
        coallesce
    fin
    return moved
end
//
// Swap out memory block
//
def swapout(accessed)
    byte[64] filename
    byte ref
    word page, entry, memblk, hmem, size
    byte swapped

    swapped = 0
    for page = PG_TBL_SIZE - 1 downto 0
        if hpgtbl[page]
            for entry = 255 downto 0
                if hpgtbl:[page, entry].lsb & HMEM_STATE == HMEM_MOVEABLE
                    memblk = hpgtbl:[page, entry]
                    if not (memblk->blklok & accessed)
                        //
                        // Swap this block out
                        //
                        size     = memblk=>blksiz
                        hmem.lsb = page
                        hmem.msb = entry
                        swapfile(@filename, hmem)
                        fileio:create(@filename, $00, size) // embed size in aux type
                        //puts(@swapoutstr);puts(@filename);putc('@');puth(memblk);putc(':');puth(size);putln
                        ref = fileio:open(@filename)
                        if ref
                            //
                            // Write it out
                            //
                            if fileio:write(ref, memblk, size) == size
                                //
                                // Zero size in page table flags swapin to read from disk
                                //
                                hpgtbl:[page, entry] = HMEM_SWAPPED
                                addfre(memblk)
                                swapped = 1
                            fin
                            fileio:close(ref)
                        fin
                    fin
                fin
            next
        else
            break
        fin
    next
    if swapped
        coallesce
        compact
    fin
    return swapped
end
//
// Find a memory block
//
def findexact(size)
    word srch, prev

    srch = frelst
    prev = 0
    while srch
        if srch=>fresiz == size
            //putc('E')
            return unlink(srch, prev)
        fin
        prev = srch
        srch = srch=>frenxt
    loop
    return 0
end
def findbest(size)
    word srch, prev

    prev = 0
    srch = frelst
    while srch
        if srch=>fresiz >= size
            //putc('B')
            return unfre(srch, prev, size)
        fin
        prev = srch
        srch = srch=>frenxt
    loop
    return 0
end
def findblk(size)
    word addr

    if size > MAX_BLK_SIZE; return 0; fin
    addr = findexact(size)
    if !addr
        coallesce
        addr = findexact(size)
        if !addr
            compact
            addr = findbest(size)
            if !addr
                swapout(HMEM_ACCESSED)
                addr = findbest(size)
                if !addr
                    swapout(0)
                    addr = findbest(size)
                fin
            fin
        fin
    fin
    //
    // Fill in the block
    //
    //puts(@getblkstr);puth(addr);putc(':');puth(size);putln
    if addr
        addr=>blksiz = size
        addr->blkref = 1
        addr->blklok = 0
    fin
    return addr
end
//
// Swap in a memory block (or allocate an uninitialized block)
//
def swapin(hmem)
    byte[64] filename
    byte[15] info
    byte ref
    word memblk, size

    size = hpgtbl:[hmem.lsb, hmem.msb] & HMEM_SIZE
    if size
        //
        // This was just uninitialized memory, don't bother reading from file
        //
        memblk = findblk(size)
    else
        //
        // Swap this block back in
        //
        swapfile(@filename, hmem)
        fileio:getfileinfo(@filename, @info)
        size   = info:2 // Size encoded in aux type
        memblk = findblk(size)
        //puts(@swapinstr);puts(@filename);putc('@');puth(memblk);putc(':');puth(size);putln
        if memblk
            //
            // Read it in
            //
            ref = fileio:open(@filename)
            if ref
                fileio:read(ref, memblk, size)
                fileio:close(ref)
                fileio:destroy(@filename)
            fin
        fin
    fin
    if memblk
        hpgtbl:[hmem.lsb, hmem.msb] = memblk
    fin
    return memblk
end
//
// Incrementally clear the ACCESSED BIT
//
export def sweep#0
    word memblk

    if hpgtbl[sweeppg]
        memblk = hpgtbl:[sweeppg, sweepen]
        when memblk.lsb & HMEM_STATE
            is HMEM_MOVEABLE
            is HMEM_LOCKED
                memblk = memblk & HMEM_ADDR
                if memblk->blklok & HMEM_ACCESSED
                    memblk->blklok = memblk->blklok & $7F
                fin
        wend
        if sweepen == 255
            sweepen = 0
            if sweeppg == 0
                sweeppg = PG_TBL_SIZE - 1
            else
                sweeppg = sweeppg - 1
            fin
        else
            sweepen = sweepen + 1
        fin
    else
        sweeppg = PG_TBL_SIZE - 1
    fin
end
//
// Set end of memory pool
//
export def brk(addr)
    word heapalign, brkblk, brksiz, srch

    //
    // Check if addr is too high or low
    //
    if isuge(addr, @heapalign); return 0; fin
    if isule(addr, heapmark); return 0; fin
    if not pooladdr
        //
        // Allocate the memory pool
        //
        heapalign = (heapmark | MIN_BLK_MASK) + 1
        brksiz    = addr - heapalign
        if isult(brksiz, MAX_BLK_SIZE); return 0; fin // Not enough heap
            poolsize = addr - heapmark
            pooladdr = heapalloc(poolsize)
            if pooladdr
                frelst         = heapalign
                frelst=>fresiz = brksiz
                frelst=>frenxt = 0
            else
                poolsize = 0
            fin
        else
        //
        // Can we extend the memory pool?
        //
        if pooladdr + poolsize == heapmark
            brksiz = addr - heapmark
            brkblk = heapalloc(brksiz)
            if brkblk
                //
                // Add block to end of free list
                //
                poolsize       = poolsize + brksiz
                brkblk=>fresiz = brksiz
                brkblk=>frenxt = 0
                if frelst
                    srch = frelst
                    while srch=>frenxt; srch = srch=>frenxt; loop
                    srch=>frenxt = brkblk
                else
                    frelst = brkblk
                fin
                coallesce // combine adjacent free space
            fin
        fin
    fin
    return poolsize
end
export def sbrk(size)
    return brk((heapmark | MIN_BLK_MASK) + 1 + size + MIN_BLK_SIZE)
end
//
// Return the amount of free memory available, after garbage
// collection, swaps
//
export def hmemFre(lptr)
    word srch, free, largest

    coallesce
    while compact; loop
    free    = 0
    largest = 0
    srch    = frelst
    while srch
        //putc('F'); putc(' '); puth(srch); putc(':'); puth(srch=>fresiz); putln
        free = free + srch=>fresiz
        if srch=>fresiz > largest
            largest = srch=>fresiz
        fin
        srch = srch=>frenxt
    loop
    if lptr
        *lptr = largest - MIN_BLK_SIZE
    fin
    return free - MIN_BLK_SIZE
end
//
// Allocate memory block
//
export def hmemNew(size)
    word page, entry, hnew, memblk

    //
    // First, find a free handle
    //
    for page = PG_TBL_SIZE - 1 downto 0
        if !hpgtbl[page]
            //
            // Allocate a new page table
            //
            hpgtbl[page] = heapalloc(PG_SIZE)
            memset(hpgtbl[page], HMEM_AVAIL, PG_SIZE)
            //puts(@allocpgstr);puth(hpgtbl[page]);putln
            //
            // Check if we need to allocate the memory pool
            //
            if not pooladdr
                //
                // Allocate 3/4 of available heap on 128K machine, 1/2 on 64K machine
                //
                poolsize = (heapavail >> 1) & $7FFF
                if MACHID & $30 == $30
                        poolsize = poolsize + (poolsize >> 1)
                fin
                if isult(poolsize, MAX_BLK_SIZE)
                    poolsize = MAX_BLK_SIZE
                fin
                sbrk(poolsize)
            fin
        fin
        for entry = 255 downto 0
            if hpgtbl:[page, entry].lsb == HMEM_AVAIL
                //
                // Reserve handle as swapped out block
                // Nonzero size will flag swapin to not read from disk
                //
                //putc('N');putc(' ');putb(entry);putb(page);putc('@')
                size = ((size + t_memblk) | MIN_BLK_MASK) + 1
                hpgtbl:[page, entry] = size | HMEM_SWAPPED
                hnew.lsb = page
                hnew.msb = entry
                return hnew
            fin
        next
    next
    return 0
end
//
// Lock memory block in place
//
export def hmemLock(hmem)
    word memblk

    memblk = hpgtbl:[hmem.lsb, hmem.msb]
    when memblk.lsb & HMEM_STATE
        is HMEM_SWAPPED
            memblk = swapin(hmem)
            if not memblk; return 0; fin
        is HMEM_MOVEABLE
            hpgtbl:[hmem.lsb, hmem.msb] = memblk | HMEM_LOCKED
        is HMEM_LOCKED
            memblk = memblk & HMEM_ADDR
            memblk->blklok = (memblk->blklok + 1) | HMEM_ACCESSED
            //putc('L');putc(' ');puth(hmem);putc('@');puth(memblk);putln
            return memblk + t_memblk
    wend
    return 0
end
//
// Unlock memory block
//
export def hmemUnlock(hmem)#0
    byte lock
    word memblk

    memblk = hpgtbl:[hmem.lsb, hmem.msb]
    if memblk.lsb & HMEM_STATE == HMEM_LOCKED
        memblk = memblk & HMEM_ADDR
        lock = memblk->blklok - 1
        if lock == HMEM_ACCESSED
            //
            // Block is now moveable
            //
            hpgtbl:[hmem.lsb, hmem.msb] = memblk
        fin
        memblk->blklok = lock
        //putc('U');putc(' ');puth(hmem);putln
    fin
end
//
// Increment reference count
//
export def hmemRef(hmem)#0
    word memblk

    memblk = hpgtbl:[hmem.lsb, hmem.msb]
    when memblk.lsb & HMEM_STATE
        is HMEM_SWAPPED
            memblk = swapin(hmem)
        is HMEM_LOCKED
        is HMEM_MOVEABLE
            memblk = memblk & HMEM_ADDR
            if not memblk; return; fin
            memblk->blkref = memblk->blkref + 1
    wend
end
//
// Decrement reference count
//
export def hmemDel(hmem)#0
    byte ref
    word memblk

    memblk = hpgtbl:[hmem.lsb, hmem.msb]
    when memblk & HMEM_STATE
        is HMEM_SWAPPED
        memblk = swapin(hmem)
        is HMEM_LOCKED
        is HMEM_MOVEABLE
            memblk = memblk & HMEM_ADDR
            if not memblk; return; fin
            ref = memblk->blkref - 1
            if ref == 0
                //
                // No more references, free block
                //
                hpgtbl:[hmem.lsb, hmem.msb] = HMEM_AVAIL
                addfre(memblk)
            else
                memblk->blkref = ref
            fin
            break
    wend
end
//
// Initialization:
//
// Search for best swap volume
//
// !!! Does this work on Apple ///???
//
sysbuf = $0800 // heapallocalign(1024, 8, 0)
initdata = heapalloc(t_initdata) // Use data on heap for initialization
initdata=>volparms.0 = 2
initdata=>volparms.1 = 0
initdata=>volparms:2 = sysbuf
syscall($C5, @initdata=>volparms)
initdata=>volptr   = sysbuf
initdata=>ramfree  = 0
initdata=>bestfree = 0
for sweepen = 0 to 15
    ^initdata=>volptr = ^initdata=>volptr & $0F
    if ^initdata=>volptr
        memcpy(@swapvol + 2, initdata=>volptr + 1, ^initdata=>volptr)
        swapvol = ^initdata=>volptr + 1
        fileio:getfileinfo(@swapvol, @initdata->volinfo)
        initdata=>freeblks = initdata=>volinfo:2 - initdata=>volinfo:5
        if initdata=>volptr:1 == $522F and initdata=>volptr:3 == $4D41 // '/RAM'
            if isugt(initdata=>freeblks, initdata=>ramfree)
                initdata=>ramvol  = initdata=>volptr
                initdata=>ramfree = initdata=>freeblks
            fin
        elsif isugt(initdata=>freeblks, initdata=>bestfree)
            initdata=>bestvol  = initdata=>volptr
            initdata=>bestfree = initdata=>freeblks
        fin
    fin
    initdata=>volptr = initdata=>volptr + 16
next
if isugt(initdata=>ramfree, $40) or isugt(initdata=>ramfree, initdata=>bestfree) // RAMdrive greater than 64K? Use it
    initdata=>bestvol  = initdata=>ramvol
    initdata=>bestfree = initdata=>ramfree
fin
memcpy(@swapvol + 2, initdata=>bestvol + 1, ^initdata=>bestvol)
swapvol = ^initdata=>bestvol + 1
memcpy(@swapvol + swapvol + 1, @swapdir + 1, swapdir)
swapvol = swapvol + swapdir
fileio:create(@swapvol, $0F, $0000) // Create the swap directory
//
// Clear out left over swap files
//
initdata->catref     = fileio:open(@swapvol)
initdata->firstblk   = 1
initdata->swapstrlen = swapvol
repeat
    if fileio:read(initdata->catref, @initdata->catalog, 512) == 512
        initdata=>catentry = @initdata->catalog.4
        if initdata->firstblk
            initdata->entrylen   = initdata->catalog.$23
            initdata->entriesblk = initdata->catalog.$24
            initdata=>filecnt    = initdata=>catalog:$25
            initdata=>catentry   = initdata=>catentry + initdata->entrylen
        fin
        for sweepen = initdata->firstblk to initdata->entriesblk
            ^initdata=>catentry = ^initdata=>catentry & $0F
            if ^initdata=>catentry
                memcpy(@swapvol + swapvol + 1, initdata=>catentry + 1, ^initdata=>catentry)
                swapvol = swapvol + ^initdata=>catentry
                fileio:destroy(@swapvol)
                swapvol = initdata->swapstrlen
            fin
            initdata=>catentry = initdata=>catentry + initdata->entrylen
        next
        initdata->firstblk = 0
    else
        initdata->filecnt = 0
    fin
until !initdata->filecnt
fileio:close(initdata->catref)
heaprelease(initdata)
//puts(@swapvol); putln
done