
    <<AllocImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Sweet, 19-Aug-81 12:15:12>>
        <<Satterthwaite, December 10, 1982 11:56 am>>
        <<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 USING [Base, BaseSeq, Index, Limit, maxForBits, Notifier, OrderedIndex, pagesForBits, Selector, TableInfo],
        PrincOpsUtils USING [LongCopy],
        VM USING [AddressForPageNumber, Allocate, Free, Interval, nullInterval, PagesForWords, WordsForPages];

    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,
                indexBits: CARDINAL,
                tileSize: CARDINAL,
                notifiers: NotifyChainHandle _ NIL,
                bases: REF BaseSeq,
                vm: REF SpaceSeq,
                chunks: REF ChunkSeq,
                top: REF SizeSeq,
                limit: REF BoundSeq,
                vmPages: REF SizeSeq];

            SizeSeq: TYPE = RECORD [SEQUENCE length: NAT OF CARDINAL];
            Bound: TYPE = LONG CARDINAL;
            BoundSeq: TYPE = RECORD [SEQUENCE length: NAT OF Bound];
            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: CARDINAL] = CODE;


        <<stack allocation from subzones>>

            Words: PUBLIC ENTRY PROC [h: Handle, table: Selector, size: CARDINAL]
                RETURNS [x: OrderedIndex] = {
                ENABLE UNWIND => NULL;
                ok: BOOL _ TRUE;
                x _ WordsInternal[h, table, size ! Failure => {ok _ FALSE; CONTINUE}];
                IF NOT ok THEN RETURN WITH ERROR Failure[h, table];
                };

            WordsInternal: INTERNAL PROC [h: Handle, table: Selector, size: CARDINAL] RETURNS [OrderedIndex] = {
                index: CARDINAL = h.top[table];
                newTop: Bound = index.LONG + size; -- could overflow CARDINAL for 16 bit pointers
                IF newTop > h.limit[table] THEN {
                    IF newTop > maxForBits[h.indexBits] 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): [0..maxForBits[15]],
                fLink(1): CIndex,
                bLink(2): CIndex];

            CIndex: TYPE = Base RELATIVE POINTER [0..Limit) TO Chunk;
            nullChunkIndex: CIndex = CIndex.FIRST;

            ChunkHandle: TYPE = REF ChunkObject;
            ChunkObject: TYPE = RECORD [
                chunkRover: CIndex,
                firstSmall: CARDINAL,
                smallLists: SEQUENCE nSmall: CARDINAL 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..ch.firstSmall+ch.nSmall) THEN { 
                    offset: CARDINAL = size - ch.firstSmall;
                    q _ ch.smallLists[offset];
                    IF q # nullChunkIndex THEN {ch.smallLists[offset] _ cb[q].fLink; GO TO found}};
                q _ GetRoverChunk[cb, h.top[table], ch, size];
                IF q # 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: CARDINAL IN [ch.firstSmall.. ch.firstSmall+ch.nSmall) DO
                            offset: CARDINAL = s - ch.firstSmall;
                            r: CIndex _ ch.smallLists[offset];
                            WHILE r # nullChunkIndex DO
                                next: CIndex = cb[r].fLink;
                                FreeRoverChunk[cb, ch, r, s];
                                r _ next;
                                ENDLOOP;
                            ch.smallLists[offset] _ nullChunkIndex;
                            ENDLOOP;
                        <<now all possible merges of free nodes can happen>>
                        q _ GetRoverChunk[cb, h.top[table], ch, size];
                        IF q = 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) = 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 _ 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 _ 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..ch.firstSmall+ch.nSmall) THEN {
                    offset: CARDINAL = 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 _ 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 = 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: CARDINAL] = {RETURN [h.bases[table], 
            h.top[table]]};

            <<stack allocation from subzones>>

            fileTileSize: CARDINAL = 32; -- must be >= tileSize;

            GrowTable: INTERNAL PROC [h: Handle, table: Selector, newTop: Bound] = {
                newPages: CARDINAL = VM.PagesForWords[newTop];
                IF newPages > h.vmPages[table] THEN {
                    extra: CARDINAL = SIGNAL Overflow[h, table];
                    newVMSize: CARDINAL = MIN[maxForBits[h.indexBits], 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: CARDINAL = VM.WordsForPages[oldVM.count];
                        PrincOpsUtils.LongCopy[oldVMPointer, nwords, newVMPointer];
                        VM.Free[oldVM]};
                    h.vm[table] _ newVM;
                    h.bases[table] _ LOOPHOLE[newVMPointer];
                    h.vmPages[table] _ newVMSize;
                    RunNotifierChain[h]}};

            <<initialization, expansion and termination>>

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

            InitTable: PROC [h: Handle, table: Selector, info: TableInfo] = {
                max: CARDINAL = WITH w: info SELECT FROM
                    TRUE => pagesForBits[h.indexBits],
                    FALSE => w.initialVMemPages,
                    ENDCASE => ERROR;
                iPages: CARDINAL _ info.initialPages;
                IF iPages > max OR max > pagesForBits[h.indexBits] THEN 
                    ERROR Failure[h, table];
                h.vmPages[table] _ max;
                h.top[table] _ 0;  h.limit[table] _ 0;
                h.chunks[table] _ NIL;
                IF iPages = 0 THEN {h.vm[table] _ VM.nullInterval; h.bases[table] _ NIL}
                ELSE {
                    h.vm[table] _ VM.Allocate[max];
                    h.bases[table] _ LOOPHOLE[VM.AddressForPageNumber[h.vm[table].page]]}};

            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] _ NIL 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;
                    ResetChunkInternal[h, i];
                    ENDLOOP;
                };

            Chunkify: PUBLIC ENTRY PROC [
                h: Handle, table: Selector, firstSmall, nSmall: CARDINAL] = {
                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;
                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: CARDINAL] = {
                ENABLE UNWIND => {NULL};
                IF size <= h.top[table] THEN {h.top[table] _ size; 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 _ nullChunkIndex;
                    FOR i: CARDINAL IN [0..ch.nSmall) DO ch.smallLists[i] _ 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};

            }.