Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/549a.lha/M2P_v1.0/mods.lzh/FStorage.mod

Text File | 1991-08-10 | 4KB | 219 lines

(*======================================================================*)

IMPLEMENTATION MODULE FStorage;

IMPORT
    SYSTEM;

IMPORT
    Memory;





   (* I really trust this code :-) *)





(*----------------------------------------------------------------------*)
(*  Memory Tracking list structure                                      *)
(*----------------------------------------------------------------------*)

TYPE
    TrackList = POINTER TO TrackNode;
    TrackNode = RECORD
        Next : TrackList;
        Size : LONGCARD;
    END;

CONST
    TrackSize = SYSTEM.TSIZE(TrackNode);

VAR
    Track : TrackList;

(*----------------------------------------------------------------------*)
(*  Type definition for the FreeList.                                   *)
(*----------------------------------------------------------------------*)

TYPE
    ListRec = RECORD
        Free : TrackList;
        HowMany: CARDINAL;
    END;

CONST
    BlockSize = 4096;               (* Blocking factor (must be > MaxBlock) *)
    MaxBlock = 512;                 (* Maximum size block using freelist    *)
    Grain = 8;                      (* Allocations sizes are modulus Grain  *)

CONST
    NumFreeLists = MaxBlock DIV Grain;

VAR
    FreeList: ARRAY [1..NumFreeLists] OF ListRec;
    i: CARDINAL;

(*----------------------------------------------------------------------*)

PROCEDURE ALLOCATE(VAR addr:SYSTEM.ADDRESS; amount: LONGCARD);

VAR
    node : TrackList;
    i: CARDINAL;
    siz: SYSTEM.ADDRESS;

BEGIN
    IF amount > MaxBlock THEN
        addr:=NIL;
        INC(amount,TrackSize);

        node:=Memory.AllocMem(amount,Memory.MemReqSet{Memory.MemPublic});
        IF SYSTEM.ADDRESS(node) # SYSTEM.ADDRESS(0) THEN
            node^.Size:=amount;
            addr:=SYSTEM.ADDRESS(node);
            INC(addr,TrackSize);
            node^.Next:=Track;
            Track:=node;
        END;










    ELSIF amount=0 THEN
        DISPOSEALL;
        HALT;
    ELSE
        INC(amount,Grain-1);
        i:=CARDINAL(amount) DIV Grain;
        WITH FreeList[i] DO
            IF Free = NIL THEN
                ALLOCATE(node,LONGCARD(BlockSize));
                IF node = NIL THEN
                    addr:=NIL;
                    RETURN;
                END;
                siz :=SYSTEM.ADDRESS(i*Grain);
                i := 0;
                WHILE i<HowMany DO
                    node^.Next:=Free;
                    Free:=node;
                    node:=SYSTEM.ADDRESS(node)+siz;
                    INC(i);
                END;
            END;
            addr:=Free;
            Free:=Free^.Next;
        END;
    END;
END ALLOCATE;

(*----------------------------------------------------------------------*)

PROCEDURE DEALLOCATE(VAR addr:SYSTEM.ADDRESS; amount: LONGCARD);

VAR
    node,follow: TrackList;
    i: CARDINAL;

BEGIN
    IF addr # NIL THEN
        IF amount > MaxBlock THEN
            node:=Track;
            DEC(addr,TrackSize);
            WHILE (node # addr) AND (node # NIL) DO
                follow:=node;
                node:=follow^.Next;
            END;
            IF node # NIL THEN
                IF Track=node THEN
                    Track:=node^.Next;
                ELSE
                    follow^.Next:=node^.Next;
                END;

                Memory.FreeMem(node,node^.Size);



            END;
        ELSIF amount # 0 THEN
            node:=addr;
            INC(amount,Grain-1);
            i:=CARDINAL(amount) DIV Grain;
            WITH FreeList[i] DO
                node^.Next:=Free;
                Free:=node;
            END;
        END;
        addr:=NIL;
    END;
END DEALLOCATE;

(*----------------------------------------------------------------------*)



PROCEDURE DUPLICATE(block: ARRAY OF SYSTEM.BYTE):SYSTEM.ADDRESS;

VAR
    newblock: SYSTEM.ADDRESS;
    i: CARDINAL;
    ptr: POINTER TO SYSTEM.BYTE;

BEGIN
    ALLOCATE(newblock,LONGCARD(HIGH(block)+1));
    ptr:=newblock;
    i:=0;
    WHILE (i<=HIGH(block)) DO
        ptr^:=block[i];
        INC(i);
        INC(ptr);
    END;
    RETURN newblock;
END DUPLICATE;

(*----------------------------------------------------------------------*)
(*  DISPOSALL   Walks the FreeList, disposing of all allocated memory.  *)
(*----------------------------------------------------------------------*)

PROCEDURE DISPOSEALL();

VAR
    next : TrackList;

BEGIN
    WHILE Track # NIL DO
        next:=Track^.Next;

        Memory.FreeMem(Track,Track^.Size);



        Track:=next;
    END;
END DISPOSEALL;

(************************************************************************)
(*  MAIN INITIALIZATION CODE                                            *)
(************************************************************************)

BEGIN
    Track:=NIL;
    FOR i:= 1 TO NumFreeLists DO
        WITH FreeList[i] DO
            Free := NIL;
            HowMany := BlockSize DIV (i*Grain);
        END;
    END;
END FStorage.