(* * * * * * * * * * * * * * * * * * *
 *
 * vmutil.pas   -- Some utility functions for VM
 *
 *      Defines routines for queue handling and free
 * area handling. Also defines the vm_fatal routine.
 *
 * * * * * * * * * * * * * * * * * * *)

procedure VM_QueueElem.enqueTail(
    head:               Pointer;
    tail:               Pointer);

var
    qHead:             ^VM_QueueElemPtr;
    qTail:             ^VM_QueueElemPtr;

begin
    qHead:= head;
    qTail:= tail;

    prev:= qTail^;
    next:= Nil;
    if qTail^ <> Nil then begin
        qTail^^.next:= @self;
        end
    else begin
        qHead^:= @self;
        end;
    qTail^:= @self;
end; 
        
procedure VM_QueueElem.enqueHead(
    head:               Pointer;
    tail:               Pointer);

var
    qHead:             ^VM_QueueElemPtr;
    qTail:             ^VM_QueueElemPtr;

begin
    qHead:= head;
    qTail:= tail;

    next:= qHead^;
    prev:= Nil;
    if qHead^ <> Nil then begin
        qHead^^.prev:= @self;
        end
    else begin
        qTail^:= @self;
        end;
    qHead^:= @self;
end; 
 

procedure VM_QueueElem.deque(
    head:               Pointer;
    tail:               Pointer);
var
    qHead:             ^VM_QueueElemPtr;
    qTail:             ^VM_QueueElemPtr;

begin
    qHead:= head;
    qTail:= tail;

    (*
     *  DEQUEing an element from a list which isn't on the list
     *  can cause all kinds of problems. Let's do a sanity check.
     *)
    if prev = Nil then begin
        if qHead^ <> @self then begin
            vm_fatal('deque error');
            end;
        end
    else begin
        if VM_QueueElemPtr(prev)^.next <> @self then begin
            vm_fatal('deque error');
            end;
        end;

    if next = Nil then begin
        if qTail^ <> @self then begin
            vm_fatal('deque error');
            end;
        end
    else begin
        if VM_QueueElemPtr(next)^.prev <> @self then begin
            vm_fatal('deque error');
            end;
        end;



    if prev = Nil then begin
        qHead^:= next;
        end
    else begin
        VM_QueueElemPtr(prev)^.next:= next;
        end;
    if next = Nil then begin
        qTail^:= prev;
        end
    else begin
        VM_QueueElemPtr(next)^.prev:= prev;
        end;
    
end;

procedure vm_addFree(
    handle:             DWord;
    start:              DWord;
    size:               DWord;
    var head:           VM_FreeAreaPtr;
    var tail:           VM_FreeAreaPtr);

label
    100;

var

    nextArea:           VM_FreeAreaPtr;
    prevArea:           VM_FreeAreaPtr;
    newArea:            VM_FreeAreaPtr;

begin
    (*
     *  Find the right place to insert it.
     *)
    prevArea:= NIl;
    nextArea:= head;
    while nextArea <> Nil do begin
        if (nextArea^.handle > handle) or
                (nextArea^.handle = handle) and
                    (nextArea^.start >= start + size) then begin
            goto 100;
            end;
        prevArea:= nextArea;
        nextArea:= nextArea^.next;
        end;

100:
    (*
     *  See if we merge with previous area
     *)
    if (prevArea <> Nil) and
            (prevArea^.handle = handle) and
            (prevArea^.start + prevArea^.size = start) then begin
        (*
         *  See if we merge with next area
         *)
        if (nextArea <> Nil) and
                (nextArea^.handle = handle) and
                (start + size = nextArea^.start) then begin
            (*
             *  New area is sandwiched between prev and next.
             *  Merge them all into prev.
             *)
            prevArea^.size:= prevArea^.size + size + nextArea^.size;
            nextArea^.deque(@head, @tail);
            Dispose(nextArea);
            end
        else begin
            (*
             *  Merge with previous area
             *)
            prevArea^.size:= prevArea^.size + size;
            end;
        end
    else begin
        (*
         *  See if we merge with next area
         *)
        if (nextArea <> Nil) and
                (nextArea^.handle = handle) and
                (start + size = nextArea^.start) then begin
            (*
             *  We merge with next area.
             *)
            nextArea^.start:= start;
            nextArea^.size:= size + nextArea^.size;
            end
        else begin
            (*
             *  No merging. We need to insert a new element.
             *)
            New(newArea);
            newArea^.handle:= handle;
            newArea^.start:= start;
            newArea^.size:= size;
            newArea^.next:= nextArea;
            newArea^.prev:= prevArea;
            if prevArea <> Nil then begin
                prevArea^.next:= newArea;
                end
            else begin
                head:= newArea;
                end;
            if nextArea <> Nil then begin
                nextArea^.prev:= newArea;
                end
            else begin
                tail:= newArea;
                end;
            end;
        end;
end;

            
procedure vm_fatal(errorMsg: String);

begin
    writeln('Fatal error: ', errorMsg, ', ', errno);
    Halt;
end;