Unit Memory;

Interface

Const
    ONE_MBYTE = $100000;
    FOUR_MBYTE = $400000;
    END_OF_RAM = $FFFFFFFF;

    KERNEL_MEMORY_NONPAGED_SIZE = 8;
    KERNEL_MEMORY_PAGED_SIZE = 24;
    KERNEL_MEMORY_SIZE = KERNEL_MEMORY_NONPAGED_SIZE + KERNEL_MEMORY_PAGED_SIZE;

    KERNEL_MEMORY_NONPAGED_END = KERNEL_MEMORY_NONPAGED_SIZE * ONE_MBYTE - 1;
    KERNEL_MEMORY_PAGED_START = KERNEL_MEMORY_NONPAGED_SIZE * ONE_MBYTE;
    KERNEL_MEMORY_END = KERNEL_MEMORY_SIZE * ONE_MBYTE - 1;

    USER_MEMORY_END = END_OF_RAM - FOUR_MBYTE;
    USER_MEMORY_START = KERNEL_MEMORY_SIZE * ONE_MBYTE;
    USER_MEMORY_SIZE = USER_MEMORY_END - USER_MEMORY_START + 1;

    PAGES_ARRAY_START = ONE_MBYTE;
    VIDEO_SEG_START = $A0000;

    PAGE_SIZE = 4096;
    PAGE_TAB_ENTRYES = 1024;
    DIR_INDEX_SHIFT = 22;
    TAB_INDEX_SHIFT = 12;

    MAGIC_PAGE = 1023;
    MAGIC_PAGE_TAB_ADDR = MAGIC_PAGE Shl DIR_INDEX_SHIFT;
    MAGIC_PAGE_DIR_ADDR = MAGIC_PAGE_TAB_ADDR + MAGIC_PAGE Shl TAB_INDEX_SHIFT;

    SYSTEM_PAGE_ADDR = $9F000;
    SYSTEM_PAGE = SYSTEM_PAGE_ADDR Shr TAB_INDEX_SHIFT;

    KERNEL_MEMORY_SIZE_PAGES = KERNEL_MEMORY_SIZE * ONE_MBYTE Div PAGE_SIZE;
    KERNEL_MEMORY_NONPAGED_SIZE_PAGES = KERNEL_MEMORY_NONPAGED_SIZE * ONE_MBYTE Div PAGE_SIZE;
    KERNEL_MEMORY_DIRENTRY = KERNEL_MEMORY_SIZE_PAGES Div PAGE_TAB_ENTRYES - 1;
    KERNEL_MEMORY_NONPAGED_DIRENTRY = KERNEL_MEMORY_NONPAGED_SIZE_PAGES Div PAGE_TAB_ENTRYES - 1;

    p_Present   = $001;
    p_ReadWrite = $002;
    p_UserSuper = $004;
    p_PWT	= $008;
    p_PCD	= $010;
    p_Accessed  = $020;
    p_Dirty     = $040;
    p_PS	= $080;
    p_Global	= $100;

    p_Page      = p_Present Or p_ReadWrite;

    p_Usr1 = $200;
    p_Usr2 = $400;
    p_Usr3 = $600;
    p_Usr4 = $800;
    p_Usr5 = $A00;
    p_Usr6 = $C00;
    p_Usr7 = $E00;

Type
(* -------------------------------------------------------------------------- *)
    pArray = ^tArray;
    tArray = Array [0..$3FFFF] of DWord;

    pPhysPages = ^tPhysPages;
    tPhysPages = object
        FreeList    : pArray;
        PagesCount  : DWord;

        Function    Init(nSize : DWord) : DWord;
        Procedure   Done;

        Function    Get : DWord;
        Procedure   Put(nAddr : DWord);
        Function    Avail : DWord;
    End;
(* -------------------------------------------------------------------------- *)
    pFreeList = ^tFreeList;
    tFreeList = Record
        Prev        : pFreeList;
        Next        : pFreeList;
        Size        : DWord;
    End;

    pTable = ^tTable;
    tTable = Array [0..PAGE_TAB_ENTRYES-1] of DWord;

    pLogPages = ^tLogPages;
    tLogPages = object
        PagesCount  : DWord;

        Function    Init(First : Boolean) : DWord;
        Procedure   Done;

        Procedure   Fault(RCR2 : DWord);
        Procedure   Free(nAddr : DWord);
        Procedure   ChangeAttr(nAddr, nSize, nSAttr, nRAttr : DWord);

        Function    MapPage(nAddr : DWord) : DWord;
        Procedure   CopyPageLP(nSource, nTarget : DWord);
        Procedure   CopyPagePL(nSource, nTarget : DWord);
        Procedure   ClearPage(nAddr : DWord);
    End;

    pMemory = ^tMemory;
    tMemory = object
        FreeList    : pFreeList;
        HeapStart   : DWord;
        HeapEnd     : DWord;

        MemSize     : DWord;

        Procedure   Init(nStart, nSize : DWord);
        Procedure   Done;

        Function    Get(nSize : DWord) : DWord;
        Function    Free(nOffset : DWord; nSize : Dword) : Boolean;
        Function    Avail : DWord;
        Function    MaxAvail : DWord;
    End;

Var
    PagesPool : tPhysPages;
(*    KernelMemory : tMemory; *)
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
(* -------------------------------------------------------------------------- *)
Implementation

Procedure FillChar(Var X; Count : Longint; Value : Byte); External;
Procedure CopyChar(Var X,Y; Count : Longint); External;
Procedure ResetTLB; (*External; *)
Begin
End;

(* -------------------------------------------------------------------------- *)
Function tPhysPages.Init;
Var
    I,J,K : DWord;
Begin
    (* Memory below 1MB not include *)
    I := nSize - PAGES_ARRAY_START;
    (* Memory for FreePagesList table *)
    J := (I Div (PAGE_SIZE Div 4) + (PAGE_SIZE - 1)) And Not (PAGE_SIZE - 1);
    (* Memory with out Free Pages List table *)
    K := PAGES_ARRAY_START + J;
    PagesCount := (I - J) Div PAGE_SIZE;
    FreeList := pArray(PAGES_ARRAY_START);
    For I := 0 To PagesCount - 1 Do
         FreeList^[I] := K + I * PAGE_SIZE;
    Init := K;
End;

Procedure tPhysPages.Done;
Begin
End;

Function tPhysPages.Get : DWord;
Begin
    If PagesCount = 0 Then
        Get := -1
    Else Begin
        Dec(PagesCount);
        Get := FreeList^[PagesCount];
    End;
End;

Procedure tPhysPages.Put;
Begin
    FreeList^[PagesCount] := nAddr And (Not PAGE_SIZE + 1);
    Inc(PagesCount);              
End;

Function tPhysPages.Avail : DWord;
Begin
    Avail := PagesCount;
End;
(* -------------------------------------------------------------------------- *)
Function tLogPages.Init;
Var
    I,J,K,OldPage : DWord;
    PD, PDTmp : pTable;
    PT : Array [0..7] of pTable;
Begin
    If First Then Begin
        I := PagesPool.Get;
        If I = -1 Then Begin
            Init := -1;
            Exit;
        End;
        PD := pTable(I);
        For I := 0 To PAGE_TAB_ENTRYES - 1 Do
            PD^[I] := 0;
        PD^[MAGIC_PAGE] := DWord(PD) Or p_Page;
        For J := 0 To KERNEL_MEMORY_NONPAGED_DIRENTRY Do Begin
            I := PagesPool.Get;
            If I = -1 Then Begin
                K := J;
                While K > 0 Do Begin
                    PagesPool.Put(DWord(PT[K-1]));
                    Dec(K);
                End;
                PagesPool.Put(DWord(PD));
                Init := -1;
                Exit;
            End;
            PT[J] := pTable(I);
            PD^[J] := I Or p_Page;
            For I := 0 To PAGE_TAB_ENTRYES - 1 Do
                PT[J]^[I] := (J * PAGE_TAB_ENTRYES + I) * PAGE_SIZE Or p_Page;
        End;
    End
    Else Begin
        PD := pTable(MAGIC_PAGE_DIR_ADDR);
        I := PagesPool.Get;
        If I = -1 Then Begin
            Init := -1;
            Exit;
        End;
        K := I;
        OldPage := MapPage(I);
        PDTmp := pTable(SYSTEM_PAGE_ADDR);
        For I := 0 To PAGE_TAB_ENTRYES - 1 Do
            PDTmp^[I] := 0;
        PDTmp^[MAGIC_PAGE] := DWord(K) Or p_Page;
        For J := 0 To KERNEL_MEMORY_DIRENTRY Do
            PDTmp^[J] := PD^[J];
        MapPage(OldPage);
        PD := pTable(K);
    End;
    Init := DWord(PD);
End;

Procedure tLogPages.Done;
Begin
End;

Procedure tLogPages.Fault;
Var
    RegCR2 : pTable;
    DIRIndex, TABIndex : DWord;
    PD, PT : pTable;
    I, J : DWord;
Begin
    DIRIndex := RCR2 Shr DIR_INDEX_SHIFT;
    TABIndex := RCR2 Shr TAB_INDEX_SHIFT And (PAGE_TAB_ENTRYES-1);
    PD := pTable(MAGIC_PAGE_DIR_ADDR);
    PT := pTable(MAGIC_PAGE_TAB_ADDR + DIRIndex * PAGE_SIZE);
    If PD^[DIRIndex] = 0 Then Begin
        I := PagesPool.Get;
        If I <> -1 Then Begin
            PD^[DIRIndex] := I Or p_Page;
            Asm
               Mov EAx,CR3
               Mov CR3,EAx
            End [];
            For I := 0 To PAGE_TAB_ENTRYES - 1 Do
                PT^[I] := 0;
        End;
    End
    Else If PD^[DIRIndex] And p_Present = 0 Then Begin
        I := PagesPool.Get;
        If I <> -1 Then Begin
            J := PD^[DIRIndex] Shr 1;
            PD^[DIRIndex] := I Or p_Page;
            (* LoadFromSwap(J, I); *)
        End;
    End;
    If PT^[TABIndex] = 0 Then Begin
        I := PagesPool.Get;
        If I <> -1 Then Begin
            PT^[TABIndex] := I Or p_Page;
            Asm
               Mov EAx,CR3
               Mov CR3,EAx
            End [];
            RegCR2 := pTable(RCR2);
            For I := 0 To PAGE_TAB_ENTRYES - 1 Do
                RegCR2^[I] := 0;
        End;
    End
    Else If PT^[TABIndex] And p_Present = 0 Then Begin
        I := PagesPool.Get;
        If I <> -1 Then Begin
            J := PD^[DIRIndex] Shr 1;
            PT^[TABIndex] := I Or p_Page;
            (* LoadFromSwap(J, I); *)
        End;
    End;
End;

Procedure tLogPages.Free;
Var
    DIRIndex, TABIndex : DWord;
    PD, PT : pTable;
    I : DWord;
Begin
    DIRIndex := nAddr Shr DIR_INDEX_SHIFT;
    TABIndex := nAddr Shr TAB_INDEX_SHIFT And (PAGE_TAB_ENTRYES-1);
    PD := pTable(MAGIC_PAGE_DIR_ADDR);
    PT := pTable(MAGIC_PAGE_TAB_ADDR + DIRIndex * PAGE_SIZE);
    If PD^[DIRIndex] <> 0 Then Begin
        If PD^[DIRIndex] And p_Present = 0 Then Begin
            I := PD^[DIRIndex];
            PD^[DIRIndex] := 0;
            (* FreeSwapPage(I); *)
        End
        Else Begin
            If PT^[TABIndex] <> 0 Then Begin
                If PT^[TABIndex] And p_Present = 0 Then Begin
                    I := PT^[TABIndex];
                    PT^[TABIndex] := 0;
                    (* FreeSwapPage(I); *)
                End
                Else Begin
                    I := PT^[TABIndex];
                    PagesPool.Put(I);
                    PT^[TABIndex] := 0;
                End;
            End;
            I := 0;
            While (PT^[I] = 0) And (I < 1024) Do
                Inc(I);
            If I = 1024 Then Begin
                I := PD^[DIRIndex];
                PagesPool.Put(I);
                PD^[DIRIndex] := 0;
            End;
        End;
        Asm
            Mov EAx,CR3
            Mov CR3,EAx
        End [];
    End;
End;

Procedure tLogPages.ChangeAttr;
Var
    DIRIndex, TABIndex, PCnt : DWord;
    PD, PT : pTable;
Begin
    DIRIndex := nAddr Shr DIR_INDEX_SHIFT;
    TABIndex := nAddr Shr TAB_INDEX_SHIFT And (PAGE_TAB_ENTRYES-1);
    PD := pTable(MAGIC_PAGE_DIR_ADDR);
    PT := pTable(MAGIC_PAGE_TAB_ADDR + DIRIndex * PAGE_SIZE);
    PCnt := (nSize + (PAGE_SIZE - 1)) And (-PAGE_SIZE) Shr TAB_INDEX_SHIFT;
    While PCnt > 0 Do Begin
        PT^[TABIndex] := PT^[TABIndex] And (nRAttr And (PAGE_SIZE-1)) Or (nSAttr And (PAGE_SIZE-1));
        Inc(TABIndex);
        Dec(PCnt);
    End;
End;

Function tLogPages.MapPage;
Var
    PT : pTable;
Begin
    PT := pTable(MAGIC_PAGE_TAB_ADDR);
    MapPage := PT^[SYSTEM_PAGE];
    PT^[SYSTEM_PAGE] := nAddr Or p_Page;
    ResetTLB;
(*    Asm
       Mov EAx,CR3
       Mov CR3,EAx
    End; *)
End;

Procedure tLogPages.CopyPageLP;
Var
    Tmp : DWord;
Begin
    MapPage(nTarget);
    Tmp := SYSTEM_PAGE_ADDR;
    CopyChar(nSource,Tmp,PAGE_SIZE);
End;

Procedure tLogPages.CopyPagePL;
Var
    Tmp : DWord;
Begin
    MapPage(nSource);
    Tmp := SYSTEM_PAGE_ADDR;
    CopyChar(Tmp,nTarget,PAGE_SIZE);
End;

Procedure tLogPages.ClearPage;
Var
    Tmp : DWord;
Begin
    MapPage(nAddr);
    Tmp := SYSTEM_PAGE_ADDR;
    FillChar(Tmp,PAGE_SIZE,0);
End;
(* -------------------------------------------------------------------------- *)
Procedure tMemory.Init;
Var
    I : Byte;
Begin
    MemSize := nSize;
    HeapStart := nStart;
    HeapEnd := nStart + nSize;
    FreeList := pFreeList(HeapStart);
    FreeList^.Prev := Nil;
    FreeList^.Size := 0;
    FreeList^.Next := pFreeList(HeapStart + 16);
    FreeList^.Next^.Size := nSize - 16;
    FreeList^.Next^.Prev := FreeList;
    FreeList^.Next^.Next := Nil;
End;

Procedure tMemory.Done;
Begin
End;

Function tMemory.Get;
Var
    TmpList1, TmpList2 : pFreeList;
    TmpOffset : DWord;
Begin
    nSize := (nSize + 15) And $FFFFFFF0;
    If nSize <> 0 Then Begin
        TmpList1 := FreeList;
        While (TmpList1^.Next <> Nil) And (TmpList1^.Size < nSize) Do
            TmpList1 := TmpList1^.Next;
        If TmpList1^.Next = Nil Then
            If TmpList1^.Size < nSize Then
                TmpOffset := -1
            Else Begin
                TmpOffset := DWord(TmpList1);
                TmpList2 := pFreeList(TmpOffset + nSize);
                TmpList2^.Next := Nil;
                TmpList2^.Size := TmpList1^.Size - nSize;
                TmpList2^.Prev := TmpList1^.Prev;
                TmpList1^.Prev^.Next := TmpList2;
            End
        Else
            If TmpList1^.Size <> nSize Then Begin
                TmpOffset := DWord(TmpList1);
                TmpList2 := pFreeList(TmpOffset + nSize);
                TmpList2^.Next := TmpList1^.Next;
                TmpList2^.Prev := TmpList1^.Prev;
                TmpList2^.Size := TmpList1^.Size - nSize;
                TmpList1^.Prev^.Next := TmpList2;
                TmpList1^.Next^.Prev := TmpList2;
            End
            Else Begin
                TmpOffset := DWord(TmpList1);
                TmpList1^.Prev^.Next := TmpList1^.Next;
                TmpList1^.Next^.Prev := TmpList1^.Prev;
            End;
    End
    Else
        TmpOffset := -1;
    Get := TmpOffset;
End;

Function tMemory.Free;
Var
    TmpList1, TmpList2 : pFreeList;
Begin
    nSize := (nSize + 15) And $FFFFFFF0;
    If (nOffset = 0) Or (nOffset > HeapEnd) Or
       (nSize = 0) Or (nOffset + nSize > HeapEnd) Then
            Free := False
    Else Begin
        TmpList1 := FreeList;
        While (TmpList1^.Next <> Nil) And (DWord(TmpList1) <= nOffset) Do
            TmpList1 := TmpList1^.Next;
        If TmpList1^.Next = Nil Then
            If DWord(TmpList1) < nOffset Then Begin
                Free := False;
                Exit;
            End;
        TmpList2 := pFreeList(nOffset);
        TmpList2^.Size := nSize;
        TmpList2^.Prev := TmpList1^.Prev;
        TmpList2^.Next := TmpList1;
        TmpList1^.Prev^.Next := TmpList2;
        TmpList1^.Prev := TmpList2;
        If DWord(TmpList2^.Prev) + TmpList2^.Prev^.Size = DWord(TmpList2) Then Begin
            TmpList2^.Prev^.Next := TmpList2^.Next;
            TmpList2^.Next^.Prev := TmpList2^.Prev;
            TmpList2^.Prev^.Size := TmpList2^.Prev^.Size + TmpList2^.Size;
        End;
        If DWord(TmpList1^.Prev) + TmpList1^.Prev^.Size = DWord(TmpList1) Then Begin
            TmpList1^.Prev^.Next := TmpList1^.Next;
            TmpList1^.Next^.Prev := TmpList1^.Prev;
            TmpList1^.Prev^.Size := TmpList1^.Prev^.Size + TmpList1^.Size;
        End;
        Free := True;
    End;
End;

Function tMemory.Avail : DWord;
Var
    TmpList : pFreeList;
    Tmp : DWord;
Begin
    Tmp := FreeList^.Size;
    TmpList := FreeList;
    While TmpList^.Next <> Nil Do Begin
        TmpList := pFreeList(TmpList^.Next);
        Tmp := Tmp + TmpList^.Size;
    End;
    Avail := Tmp;
End;

Function tMemory.MaxAvail : DWord;
Var
    TmpList : pFreeList;
    Tmp : DWord;
Begin
    Tmp := FreeList^.Size;
    TmpList := FreeList;
    While TmpList^.Next <> Nil Do Begin
        TmpList := pFreeList(TmpList^.Next);
        If TmpList^.Size > Tmp Then
            Tmp := TmpList^.Size;
    End;
    MaxAvail := Tmp;
End;

End.