
    <<AllocImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Sweet, 19-Aug-81 12:15:12>>
        <<Satterthwaite, June 10, 1986 3:02:12 pm PDT>>
        <<Maxwell, August 11, 1983 11:29 am>>
        <<Rovner, October 12, 1983 10:52 am>>
    <<Russ Atkinson (RRA) February 19, 1985 6:05:00 pm PST>>
    <<>>
    DIRECTORY
        Alloc: TYPE USING [Base, BaseSeq, Index, Notifier, OrderedIndex, Selector, TableInfo, addrSpan],
        PrincOpsUtils: TYPE USING [LongCopy],
        VM: TYPE USING [AddressForPageNumber, Allocate, Free, Interval, nullInterval, wordsPerPage];

    AllocImpl: MONITOR LOCKS h.LOCK USING h: Handle
        IMPORTS PrincOpsUtils, VM 
        EXPORTS Alloc = {
        OPEN Alloc;

    <<types>>

        Handle: TYPE = REF InstanceData;

        InstanceData: PUBLIC TYPE = MONITORED RECORD[
            nTables: CARDINAL,
            notifiers: NotifyChainHandle _ NIL,
            bases: REF BaseSeq,        -- tag codes subtracted
            offsets: REF OffsetSeq,        -- (shifted) tag codes
            vm: REF SpaceSeq,
            chunks: REF ChunkSeq,
            top: REF SizeSeq,        -- tag codes added
            limit: REF BoundSeq,        -- tag codes added
            vmPages: REF SizeSeq,
            maxPages: REF PageSeq];

        OffsetSeq: TYPE = RECORD[SEQUENCE length: NAT OF CARD];
        SizeSeq: TYPE = RECORD[SEQUENCE length: NAT OF CARD];
        Bound: TYPE = CARD;
        BoundSeq: TYPE = RECORD[SEQUENCE length: NAT OF Bound];
        PageCount: TYPE = CARD;
        PageSeq: TYPE = RECORD[SEQUENCE length: NAT OF PageCount];
        SpaceSeq: TYPE = RECORD[SEQUENCE length: NAT OF VM.Interval];
        ChunkSeq: TYPE = RECORD[SEQUENCE length: NAT OF ChunkHandle];

    <<signals>>

        Failure: PUBLIC ERROR[h: Handle, table: Selector] = CODE;
        Overflow: PUBLIC SIGNAL[h: Handle, table: Selector] RETURNS[extra: CARD] = CODE;


    <<stack allocation from subzones>>

        Words: PUBLIC ENTRY PROC[h: Handle, table: Selector, size: CARDINAL]
              RETURNS[x: OrderedIndex] = {
            ENABLE UNWIND => {NULL};
            RETURN[WordsInternal[h, table, size ! Failure => {GO TO Fail}]]
            EXITS
                Fail => {RETURN WITH ERROR Failure[h, table]}
            };

        WordsInternal: INTERNAL PROC[h: Handle, table: Selector, size: CARDINAL]
              RETURNS[OrderedIndex] = {
            index: CARD = h.top[table];
            newTop: Bound = index + size;
            IF newTop > h.limit[table] THEN {
                IF newTop-h.offsets[table] > UnitsForPages[h.maxPages[table]] THEN
                    ERROR Failure[h, table];
                GrowTable[h, table, newTop]}; 
            h.top[table] _ newTop;
            RETURN[OrderedIndex.FIRST + index]};


    <<linked list allocation>>

        Chunk: TYPE = MACHINE DEPENDENT RECORD[
            free(0: 0..0): BOOL,
            size(0: 1..15): NAT,
            fLink(1): CIndex,
            bLink(3): CIndex];

        CIndex: TYPE = Base RELATIVE LONG POINTER TO Chunk;    -- tag codes added

        ChunkHandle: TYPE = REF ChunkObject;
        ChunkObject: TYPE = RECORD[
            chunkRover: CIndex,
            nullChunkIndex: CIndex,
            firstSmall: NAT,
            smallLists: SEQUENCE nSmall: NAT OF CIndex];

        GetChunk: PUBLIC ENTRY PROC[h: Handle, size: CARDINAL, table: Selector] 
              RETURNS[Index] = {
            ENABLE UNWIND => {NULL};
            ch: ChunkHandle = h.chunks[table];
            cb: Base = h.bases[table];
            q: CIndex;
            IF ch = NIL THEN RETURN WITH ERROR Failure[h, table];
            size _ MAX[size, Chunk.SIZE];
            BEGIN
            IF size IN [ch.firstSmall..NAT[ch.firstSmall+ch.nSmall]) THEN { 
                offset: CARDINAL = size - ch.firstSmall;
                q _ ch.smallLists[offset];
                IF q # ch.nullChunkIndex THEN {ch.smallLists[offset] _ cb[q].fLink; GO TO found}};
            q _ GetRoverChunk[cb, h.top[table], ch, size];
            IF q # ch.nullChunkIndex THEN GO TO found;
            q _ WordsInternal[h: h, table: table, size: size ! Failure => {GO TO noneAtEnd}];
            EXITS
                noneAtEnd => {
                    <<none the right size, no space at the end, and no big ones to split>>
                    FOR s: NAT IN [ch.firstSmall.. ch.firstSmall+ch.nSmall) DO
                        offset: NAT = s - ch.firstSmall;
                        r: CIndex _ ch.smallLists[offset];
                        WHILE r # ch.nullChunkIndex DO
                            next: CIndex = cb[r].fLink;
                            FreeRoverChunk[cb, ch, r, s];
                            r _ next;
                            ENDLOOP;
                        ch.smallLists[offset] _ ch.nullChunkIndex;
                        ENDLOOP;
                    <<now all possible merges of free nodes can happen>>
                    q _ GetRoverChunk[cb, h.top[table], ch, size];
                    IF q = ch.nullChunkIndex THEN RETURN WITH ERROR Failure[h, table]};
                found => NULL;
            END;
            h.bases[table][q].free _ FALSE;
            RETURN[q]};

        GetRoverChunk: INTERNAL PROC[
                cb: Base, top: CARDINAL, ch: ChunkHandle, size: CARDINAL] 
              RETURNS[Index] = {
            p, q, next: CIndex;
            nodeSize: INTEGER;
            n: INTEGER;
            BEGIN
            IF (p _ ch.chunkRover) = ch.nullChunkIndex THEN GO TO notFound;
            <<search for a chunk to allocate>>
            DO
                nodeSize _ cb[p].size;
                WHILE (next _ p + nodeSize) - CIndex.FIRST # top AND cb[next].free DO
                    cb[cb[next].bLink].fLink _ cb[next].fLink;
                    cb[cb[next].fLink].bLink _ cb[next].bLink;
                    cb[p].size _ nodeSize _ nodeSize + cb[next].size;
                    ch.chunkRover _ p; -- in case next = chunkRover
                    ENDLOOP;
                SELECT (n _ nodeSize-size) FROM
                    = 0 => {
                        IF cb[p].fLink = p THEN ch.chunkRover _ ch.nullChunkIndex
                        ELSE {
                            ch.chunkRover _ cb[cb[p].bLink].fLink _ cb[p].fLink;
                            cb[cb[p].fLink].bLink _ cb[p].bLink};
                        q _ p;
                        GO TO found};
                    >= Chunk.SIZE => {
                        cb[p].size _ n; ch.chunkRover _ p; q _ p + n; GO TO found};
                    ENDCASE;
                IF (p _ cb[p].fLink) = ch.chunkRover THEN GO TO notFound;
                ENDLOOP;
            EXITS
                found => NULL;
                notFound => q _ ch.nullChunkIndex;
            END;
            RETURN[q]};

        FreeChunk: PUBLIC ENTRY PROC[h: Handle, index: Index, size: CARDINAL, table: Selector] = {
            ENABLE UNWIND => {NULL};
            ch: ChunkHandle = h.chunks[table];
            cb: Base = h.bases[table];
            p: CIndex = LOOPHOLE[index];
            IF ch = NIL THEN RETURN WITH ERROR Failure[h, table];
            cb[p].size _ size _ MAX[size, Chunk.SIZE];
            IF size IN [ch.firstSmall..NAT[ch.firstSmall+ch.nSmall]) THEN {
                offset: NAT = size - ch.firstSmall;
                cb[p].fLink _ ch.smallLists[offset];
                ch.smallLists[offset] _ p;
                <<don't set cb[p].free _ TRUE; to avoid coalescing nodes>>
                cb[p].bLink _ ch.nullChunkIndex} -- note, only singly linked
            ELSE FreeRoverChunk[cb, ch, index, size]};

        FreeRoverChunk: INTERNAL PROC[
              cb: Base, ch: ChunkHandle, index: Index, size: CARDINAL] = {
            p: CIndex = LOOPHOLE[index];
            cb[p].size _ size _ MAX[size, Chunk.SIZE];
            IF ch.chunkRover = ch.nullChunkIndex THEN
                ch.chunkRover _ cb[p].fLink _ cb[p].bLink _ p
            ELSE {
                rover: CIndex = ch.chunkRover;
                cb[p].fLink _ cb[rover].fLink;
                cb[cb[p].fLink].bLink _ p;
                cb[p].bLink _ rover;
                cb[rover].fLink _ p};
            cb[p].free _ TRUE};


    <<queries>>

        Bounds: PUBLIC ENTRY PROC[h: Handle, table: Selector] RETURNS[base: Base, size: CARD] = {
            RETURN[h.bases[table], h.top[table]-h.offsets[table]]};

        Top: PUBLIC ENTRY PROC[h: Handle, table: Selector] RETURNS[OrderedIndex] = {
            RETURN[OrderedIndex.FIRST + h.top[table]]};

        Bias: PUBLIC ENTRY PROC[h: Handle, table: Selector] RETURNS[CARD] = {
            RETURN[h.offsets[table]]};


    <<VM utilities>>

        unitsPerPage: NAT = VM.wordsPerPage;

        UnitsForPages: PROC[pages: PageCount] RETURNS[CARD] = INLINE {
            RETURN[pages*unitsPerPage]};

        PagesForUnits: PROC[units: CARD] RETURNS[PageCount] = {
            RETURN[(units+(unitsPerPage-1))/unitsPerPage]};


    <<stack allocation from subzones>>

        GrowTable: INTERNAL PROC[h: Handle, table: Selector, newTop: Bound] = {
            newPages: CARD = PagesForUnits[newTop-h.offsets[table]];
            IF newPages > h.vmPages[table] THEN {
                extra: CARD = SIGNAL Overflow[h, table];
                newVMSize: CARD = MIN[h.maxPages[table], newPages + extra];
                newVM: VM.Interval = VM.Allocate[newVMSize];
                newVMPointer: LONG POINTER _ VM.AddressForPageNumber[newVM.page];
                oldVM: VM.Interval = h.vm[table];
                IF oldVM # VM.nullInterval THEN {
                    oldVMPointer: LONG POINTER _ VM.AddressForPageNumber[oldVM.page];
                    nWords: CARD _ UnitsForPages[oldVM.count];
                    copyMax: CARDINAL = (CARDINAL.LAST-unitsPerPage)+1;
                    WHILE nWords > copyMax DO
                        PrincOpsUtils.LongCopy[oldVMPointer, copyMax, newVMPointer];
                        oldVMPointer _ oldVMPointer + copyMax;
                        newVMPointer _ newVMPointer + copyMax;
                        nWords _ nWords - copyMax;
                        ENDLOOP;
                    PrincOpsUtils.LongCopy[oldVMPointer, nWords, newVMPointer];
                    VM.Free[oldVM]};
                h.vm[table] _ newVM;
                h.bases[table] _ LOOPHOLE[newVMPointer-h.offsets[table]];
                h.limit[table] _ UnitsForPages[newVMSize]+h.offsets[table];
                h.vmPages[table] _ newVMSize;
                RunNotifierChain[h]}
            };

        <<initialization, expansion and termination>>

        Create: PUBLIC PROC[weights: DESCRIPTOR FOR ARRAY OF TableInfo] RETURNS[h: Handle] = {
            cnt: CARDINAL = weights.LENGTH;
            h _ NEW[InstanceData _ [
                nTables: cnt,
                notifiers: NIL,
                bases: NEW[BaseSeq[cnt]],
                offsets: NEW[OffsetSeq[cnt]],
                vm: NEW[SpaceSeq[cnt]],
                chunks: NEW[ChunkSeq[cnt]],
                top: NEW[SizeSeq[cnt]],
                limit: NEW[BoundSeq[cnt]],
                vmPages: NEW[PageSeq[cnt]],
                maxPages: NEW[PageSeq[cnt]]]];
            FOR i: CARDINAL IN [0..cnt) DO InitTable[h, i, weights[i]] ENDLOOP};

        InitTable: PROC[h: Handle, table: Selector, info: TableInfo] = {
            base: Base;
            h.maxPages[table] _ MIN[info.maxPages, PagesForUnits[addrSpan]];
            IF info.initialPages > h.maxPages[table] THEN ERROR Failure[h, table];
            h.vmPages[table] _ info.initialPages;
            IF info.initialPages = 0 THEN {h.vm[table] _ VM.nullInterval; base _ NIL}
            ELSE {
                h.vm[table] _ VM.Allocate[info.initialPages];
                base _ LOOPHOLE[VM.AddressForPageNumber[h.vm[table].page]]};
            h.offsets[table] _ info.tag*addrSpan;
            h.top[table] _ 0 + h.offsets[table];  h.limit[table] _ 0 + h.offsets[table];
            h.bases[table] _ base - h.offsets[table];
            h.chunks[table] _ NIL};

        ResetTable: PUBLIC ENTRY PROC[h: Handle, table: Selector, info: TableInfo] = {
            ENABLE UNWIND => {NULL};
            IF h.vm[table] # VM.nullInterval THEN VM.Free[h.vm[table]];
            InitTable[h, table, info];
            RunNotifierChain[h]};

        Destroy: PUBLIC ENTRY PROC[h: Handle] = {
            ENABLE UNWIND => {NULL};
            FOR i: CARDINAL IN [0..h.nTables) DO h.bases[i] _ Base.NIL-h.offsets[i] ENDLOOP;
            RunNotifierChain[h];
            FOR i: CARDINAL IN [0..h.nTables) DO
                IF h.vm[i] # VM.nullInterval THEN VM.Free[h.vm[i]]
                ENDLOOP;
            };

        Reset: PUBLIC ENTRY PROC[h: Handle] = {
            ENABLE UNWIND => {NULL};
            FOR i: CARDINAL IN [0..h.nTables) DO 
                h.top[i] _ 0 + h.offsets[i];
                ResetChunkInternal[h, i];
                ENDLOOP;
            };

        Chunkify: PUBLIC ENTRY PROC[h: Handle, table: Selector, firstSmall, nSmall: NAT] = {
            ENABLE UNWIND => {NULL};
            ch: ChunkHandle _ h.chunks[table];
            IF ch # NIL THEN RETURN WITH ERROR Failure[h, table];
            ch _ NEW[ChunkObject[nSmall]];
            ch.firstSmall _ firstSmall;
            ch.nullChunkIndex _ CIndex.FIRST + h.offsets[table];    -- set tag
            h.chunks[table] _ ch;
            ResetChunkInternal[h, table]};

        UnChunkify: PUBLIC ENTRY PROC[h: Handle, table: Selector] = {
            ENABLE UNWIND => {NULL};
            h.chunks[table] _ NIL};

        Trim: PUBLIC ENTRY PROC[h: Handle, table: Selector, size: CARD] = {
            ENABLE UNWIND => {NULL};
            newTop: CARD = size + h.offsets[table];
            IF newTop <= h.top[table] THEN {h.top[table] _ newTop; ResetChunkInternal[h, table]}
            ELSE RETURN WITH ERROR Failure[h, table]};

        ResetChunk: PUBLIC ENTRY PROC[h: Handle, table: Selector] = {
            ResetChunkInternal[h, table ! UNWIND => {NULL}]};

        ResetChunkInternal: INTERNAL PROC[h: Handle, table: Selector] = {
            ch: ChunkHandle = h.chunks[table];
            IF ch # NIL THEN {
                ch.chunkRover _ ch.nullChunkIndex;
                FOR i: NAT IN [0..ch.nSmall) DO ch.smallLists[i] _ ch.nullChunkIndex ENDLOOP}
            };


    <<Notifier stuff>>

        NotifyNode: TYPE = RECORD[notifier: Notifier, link: NotifyChainHandle];
        NotifyChainHandle: TYPE = REF NotifyNode;

        AddNotify: PUBLIC ENTRY PROC[h: Handle, proc: Notifier] = {
            ENABLE UNWIND => {NULL};
            p: NotifyChainHandle = NEW[NotifyNode _ [notifier: proc, link: h.notifiers]];
            h.notifiers _ p;
            proc[h.bases]};

        DropNotify: PUBLIC ENTRY PROC[h: Handle, proc: Notifier] = {
            ENABLE UNWIND => {NULL};
            IF h.notifiers # NIL THEN {
                p: NotifyChainHandle _ h.notifiers;
                IF p.notifier = proc THEN h.notifiers _ p.link
                ELSE {
                    q: NotifyChainHandle;
                    DO
                        q _ p;
                        p _ p.link;
                        IF p = NIL THEN RETURN;
                        IF p.notifier = proc THEN EXIT
                        ENDLOOP;
                    q.link _ p.link};
                p _ NIL;
                };
            };

        RunNotifierChain: INTERNAL PROC[h: Handle] = {
            FOR p: NotifyChainHandle _ h.notifiers, p.link UNTIL p = NIL DO
                p.notifier[h.bases] ENDLOOP
            };

        }.

