(* * * * * * * * * * * * * * * * * * *
 *
 * vmalloc.pas  --     Allocate and Free VM blocks
 *
 *      Defines routines for allocating and freeing VM blocks
 *
 * * * * * * * * * * * * * * * * * * *)

function VM_VmBlk.alloc(size: DWord) : Boolean;

var
    newVmBlock:         VM_VmBlockPtr;
    page:               VM_VmPagePtr;
    i:                  Word;

    numPages:           Word;

begin

    (*
     *  Get a new VM_VmBlock structure:
     *)
    New(newVmBlock);

    (*
     *  Start by changing size to number of pages
     *)
    numPages:= Word((size + VM_PAGE_OFFSET_MASK) shr VM_PAGE_SHIFT);

    (*
     *  Allocate the vm block and pages
     *)
    newVmBlock^.size:= numPages;
    GetMem(newVmBlock^.pages, sizeof(VM_VmPage) * numPages);

    for i:= 0 to numPages-1 do begin
        page:= @newVmBlock^.pages^[i];

        page^.pageNum:= i;
        page^.secondaryKind:= VM_SEC_UNALLOCATED;
        page^.sec.disk:= Nil;
        page^.convBuff:= Nil;
        page^.offset:= 0;
        page^.wired:= 0;
        page^.dirty:= False;
        end;

    (*
     *  Link it into the list of blocks
     *)
    newVmBlock^.enqueHead(@firstVmBlock, @lastVmBlock);

    (*
     *  Finally return the handle
     *)
    handle:= DWord(newVmBlock);

    (*
     *  Indicate that there was no error
     *)
    errno:= VMErrOK;
    alloc:= False;

end;


function VM_VmBlk.free : Boolean;

var

    i:                  Integer;

    vmBlock:            VM_VmBlockPtr;

begin

    vmBlock:= VM_VmBlockPtr(handle);

    (*
     *  One by one, free up the pages.
     *)
    for i:= 0 to vmBlock^.size-1 do begin
        vm_freeVmPage(@vmBlock^.pages^[i]);
        end;

    (*
     *  Free the page array
     *)
    FreeMem(vmBlock^.pages, sizeof(VM_VmPage) * vmBlock^.size);

    (*
     *  Unlink the block
     *)
    vmBlock^.deque(@firstVmBlock, @lastVmBlock);

    (*
     *  Finally, free it up
     *)
    Dispose(vmBlock);

    (*
     *  Give no error
     *)
    errno:= VMErrOK;
    free:= False;

end;


procedure vm_freeVmPage(vmPage: VM_VmPagePtr);

begin

    (*
     *  First free the secondary memory page
     *)
    case vmPage^.secondaryKind of
    VM_SEC_UNALLOCATED:
        ;

    VM_SEC_DISK:
        vm_freeDiskPage(vmPage^.sec.disk);

    VM_SEC_EMS:
        vm_freeEmsPage(vmPage^.sec.ems);

    VM_SEC_XMS:
        vm_freeXmsPage(vmPage^.sec.xms);
        end;

    (*
     *  Now free the primary memory page (if it's in memory)
     *)
    if (vmPage^.convBuff <> Nil) and (vmPage^.convBuff <> PFABUFF) then begin
        vm_freeConvBuff(vmPage^.convBuff);
        end;

end;


procedure vm_freeDiskPage(diskPage: VM_DiskPagePtr);

begin

    (*
     *  First remove it from the list of disk pages.
     *)
    diskPage^.deque(@disk.firstPage, @disk.lastPage);

    (*
     *  Now add the space to the free list
     *)
    vm_addFree(0, diskPage^.pageNum, 1,
                    disk.firstFree, disk.lastFree);

    (*
     *  Finally free the actual memory.
     *)
    Dispose(diskPage);

end;

procedure vm_freeEmsPage(emsPage: VM_EmsPagePtr);

begin

    (*
     *  First remove it from the list of disk pages.
     *)
    if emsPage^.vmPage^.wired <> 0 then begin
        emsPage^.deque(@em.firstWired, @em.lastWired);
        end
    else begin
        emsPage^.deque(@em.mruPage, @em.lruPage);
        end;

    (*
     *  Now add the space to the free list
     *)
    vm_addFree(DWord(emsPage^.emsBuff),
                emsPage^.pageNum,
                1,
                em.firstFree,
                em.lastFree);
    emsPage^.emsBuff^.useCount:= emsPage^.emsBuff^.useCount;

    (*
     *  This may have emptied the buffer. If so, free the buffer.
     *)
    if emsPage^.emsBuff^.useCount = 0 then begin
        vm_freeEmsBuff(emsPage^.emsBuff);
        end;

    (*
     *  Finally free the actual memory.
     *)
    Dispose(emsPage);

end;

procedure vm_freeXmsPage(xmsPage: VM_XmsPagePtr);

begin

    (*
     *  First remove it from the list of disk pages.
     *)
    if xmsPage^.vmPage^.wired <> 0 then begin
        xmsPage^.deque(@xm.firstWired, @xm.lastWired);
        end
    else begin
        xmsPage^.deque(@xm.mruPage, @xm.lruPage);
        end;

    (*
     *  Now add the space to the free list
     *)
    vm_addFree(DWord(xmsPage^.xmsBuff),
                xmsPage^.pageNum,
                1,
                xm.firstFree,
                xm.lastFree);
    xmsPage^.xmsBuff^.useCount:= xmsPage^.xmsBuff^.useCount - 1;


    (*
     *  This may have emptied the buffer. If so, free the buffer.
     *)
    if xmsPage^.xmsBuff^.useCount = 0 then begin
        vm_freeXmsBuff(xmsPage^.xmsBuff);
        end;

    (*
     *  Finally free the actual memory.
     *)
    Dispose(xmsPage);

end;

procedure vm_freeConvBuff(convBuff: VM_ConvBuffPtr);

var
    i:                  DWord;
    pageNum:            Word;

begin

    (*
     *  First go through all of the pages in the buffer
     *  removing references to this buffer.
     *)
    pageNum:= convBuff^.startPage;
    for i:= 0 to convBuff^.buffSize - 1 do begin
        convBuff^.vmBlock^.pages^[pageNum].convBuff:= Nil;
        convBuff^.vmBlock^.pages^[pageNum].offset:= 0;

        pageNum:= pageNum + 1;
        end;

    (*
     *  Remove the buffer from the buffer list
     *)
    if (convBuff^.wiredPages <> 0) then begin
        convBuff^.deque(@conv.firstWired, @conv.lastWired);
        end
    else begin
        convBuff^.deque(@conv.mruBuff, @conv.lruBuff);
        end;

    (*
     *  Free the buffer memory
     *)
    FreeMem(convBuff^.address, convBuff^.buffSize * VM_PAGE_SIZE);

    (*
     *  Finally, free the descriptor itself
     *)
    Dispose(convBuff);

end;

procedure vm_freeEmsBuff(emsBuff: VM_EmsBuffPtr);

var

    currFreeArea:       VM_FreeAreaPtr;
    nextFreeArea:       VM_FreeAreaPtr;

begin

    (*
     *  First remove it from the ems buffer list
     *)
    emsBuff^.deque(@em.firstBuff, @em.lastBuff);

    (*
     *  Now release the EMS memory
     *)
    if emsBuff^.handle.freeEM then begin
        vm_fatal('EMS_EmBlk.freeEM');
        end;

    (*
     *  Now go through the free memory chain removing any references
     *  to this buffer
     *)
    currFreeArea:= em.firstFree;
    while currFreeArea <> Nil do begin
        nextFreeArea:= currFreeArea^.next;

        if currFreeArea^.handle = DWord(emsBuff) then begin
            currFreeArea^.deque(@em.firstFree, @em.lastFree);
            Dispose(currFreeArea);
            end;

        currFreeArea:= nextFreeArea;
        end;

    (*
     *  Now release the buffer descriptor
     *)
    Dispose(emsBuff);

end;

procedure vm_freeXmsBuff(xmsBuff: VM_XmsBuffPtr);

var
    currFreeArea:       VM_FreeAreaPtr;
    nextFreeArea:       VM_FreeAreaPtr;

begin

    (*
     *  First remove it from the xms buffer list
     *)
    xmsBuff^.deque(@xm.firstBuff, @xm.lastBuff);

    (*
     *  Now release the XMS memory
     *)
    if xmsBuff^.handle.freeXM then begin
        vm_fatal('XMS_Xms.freeXM');
        end;

    (*
     *  Now go through the free memory chain removing any references
     *  to this buffer
     *)
    currFreeArea:= xm.firstFree;
    while currFreeArea <> Nil do begin
        nextFreeArea:= currFreeArea^.next;

        if currFreeArea^.handle = DWord(xmsBuff) then begin
            currFreeArea^.deque(@xm.firstFree, @xm.lastFree);
            Dispose(currFreeArea);
            end;

        currFreeArea:= nextFreeArea;
        end;

    (*
     *  Now release the buffer descriptor
     *)
    Dispose(xmsBuff);

end;