<<>>
    <<VMChunksImpl.mesa>>
        <<Copyright Ó 1990, 1991 by Xerox Corporation.  All rights reserved.>>
        <<Christian Jacobi, February 7, 1990>>
        <<Christian Jacobi, July 22, 1992 11:19 am PDT>>
        <<>>
    DIRECTORY
        FinalizeOps, VMChunks;

    VMChunksImpl: CEDAR MONITOR LOCKS domain USING domain: Domain 
        IMPORTS FinalizeOps
        EXPORTS VMChunks =  
    BEGIN OPEN VMChunks; 

    DomainRep: PUBLIC TYPE = DomainRec;
    ChunkRep: PUBLIC TYPE = ChunkClientRec;

    Domain: TYPE = REF DomainRec;
    DomainRec: TYPE = MONITORED RECORD [
        root: REF ChunkRealRec --contains the first address !
        ];

    Chunk: TYPE = REF ChunkClientRec;

    ChunkRealRec: TYPE = PRIVATE RECORD [
        addr: CARD,
        size: CARD,
        prev, next: REF ChunkRealRec,
        occupied: BOOL ¬ FALSE
        ];

    ChunkClientRec: TYPE = RECORD [
        c: REF ChunkRealRec,
        dom: Domain
        ];

    IsChunk: PUBLIC PROC [x: REF ANY] RETURNS [BOOL] = {
        RETURN [x#NIL AND ISTYPE[x, REF ChunkClientRec]]
        };

    NarrowChunk: PUBLIC PROC [x: REF ANY] RETURNS [Chunk] = {
        RETURN [NARROW[x, REF ChunkClientRec]]
        };

    AddressOfChunk: PUBLIC PROC [chunk: Chunk] RETURNS [CARD] = {
        RETURN [chunk.c.addr]
        };

    SizeOfChunk: PUBLIC PROC [chunk: Chunk] RETURNS [CARD] = {
        RETURN [chunk.c.size]
        };

    DomainOfChunk: PUBLIC PROC [chunk: Chunk] RETURNS [Domain] = {
        RETURN [chunk.dom]
        };

    CreateDomain: PUBLIC PROC [startAddress: CARD, size: CARD] RETURNS [d: Domain] = {
        InitRoot: PROC [startAddress: CARD, size: CARD] RETURNS [c: REF ChunkRealRec] = {
            c ¬ NEW[ChunkRealRec];
            c.size ¬ size;
            c.addr ¬ startAddress;
            c.next ¬ c.prev ¬ c;
            };
        d ¬ NEW[DomainRec];
        d.root ¬ InitRoot[startAddress, size];
        };

    alignRestrict: CARD = 8;--hardest alignment on sparc

    NewChunk: PROC [domain: Domain, c: REF ChunkRealRec] RETURNS [ch: Chunk] = {
        ch ¬ NEW[ChunkClientRec ¬ [dom: domain, c: c]];
        c.occupied ¬ TRUE; 
        [] ¬ FinalizeOps.EnableFinalization[ch, finalizationQueue]
        };

    AllocateChunk: PUBLIC ENTRY PROC [domain: Domain, size: CARD] RETURNS [Chunk] = {
        root: REF ChunkRealRec ~ domain.root;
        c: REF ChunkRealRec ¬ root;
        size ¬ (size+alignRestrict-1)/alignRestrict*alignRestrict; 
        IF size=0 THEN RETURN [NIL];
        <<--try exact hole>>
        c ¬ root;
        DO
            IF ~c.occupied AND c.size=size THEN {RETURN[NewChunk[domain, c]]};
            c ¬ c.next; IF c=root THEN EXIT; 
            ENDLOOP;
        <<--try larger hole>>
        c ¬ root;
        DO
            IF ~c.occupied AND c.size>size THEN {
                SplitNCreateNext[c, size];
                RETURN [NewChunk[domain, c]];
                };
            c ¬ c.next; IF c=root THEN EXIT; 
            ENDLOOP;
        RETURN [NIL];
        };

    Free: ENTRY PROC [domain: Domain, c: REF ChunkRealRec] = {
        IF ~c.occupied THEN ERROR;
        c.occupied ¬ FALSE;
        IF ~c.next.occupied THEN JoinNRemoveNext[domain, c];
        <<--order matters! JoinNRemoveNext of c.prev might clubber c>>
        IF ~c.prev.occupied THEN JoinNRemoveNext[domain, c.prev];
        };

    SplitNCreateNext: INTERNAL PROC [c: REF ChunkRealRec, nbytes: CARD] = {
        new: REF ChunkRealRec ~ NEW[ChunkRealRec];
        IF c.occupied OR nbytes>=c.size THEN ERROR; --programming error
        new.size ¬ c.size - nbytes;
        c.size ¬ nbytes;
        new.addr ¬ c.addr + nbytes;
        new.next ¬ c.next;
        new.prev ¬ c;
        c.next.prev ¬ new;
        c.next ¬ new;
        };

    JoinNRemoveNext: INTERNAL PROC [domain: Domain, c: REF ChunkRealRec] = {
        root: REF ChunkRealRec ~ domain.root;
        remove: REF ChunkRealRec ¬ c.next;
        IF remove=root THEN RETURN; --don't !!! memory is not circular
        IF c.occupied OR remove.occupied THEN ERROR; --programming error
        c.next ¬ remove.next;
        remove.next.prev ¬ c;
        c.size ¬ c.size+remove.size;
        };

    finalizationQueue: FinalizeOps.CallQueue ~ FinalizeOps.CreateCallQueue[Finalizor];
        Finalizor: FinalizeOps.FinalizeProc = {
            chunk: REF ChunkClientRec ~ NARROW[object];
            Free[chunk.dom, chunk.c];
            };

    END.