home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_vm / sti_vm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-20  |  18.4 KB  |  509 lines
  1. Unit STI_VM;
  2. {$S-,R-,V-,B-,D-}
  3. interface
  4.  
  5. Const
  6.   ALL_OK                = 0;                {no errors                      }
  7.   BAD_VM_ID             = -1;               {the id is bad, allocated or no }
  8.   PAGE_SIZE_TOO_BIG     = -2;               {the page size is too large     }
  9.   PAGE_SIZE_TOO_SMALL   = -3;               {the page size is too small     }
  10.   CACHE_SIZE_TOO_BIG    = -4;               {the cache size is too alrge    }
  11.   CACHE_SIZE_TOO_SMALL  = -5;               {the cache is too small         }
  12.   FILE_CREATE_ERROR     = -6;               {couldn't create the swap file  }
  13.   OUT_OF_MEMORY         = -7;               {out of convebtional memory     }
  14.   BAD_PAGE_NUMBER       = -8;               {there are no pages of this #   }
  15.  
  16.   MAX_VM_FILES    =    10;                  {maximum number of files        }
  17.   MEM_PAGES       =  4096;                  {maximum number of resident page}
  18.   MAX_PAGE_SIZE   = 65535;                  {maximum page size              }
  19.   MAX_PAGES       = 65535;                  {maximum number of pages        }
  20.  
  21.  
  22.  
  23. function  STI_VM_Flush_Cache(ID : Byte) : shortint;
  24. function  STI_VM_Open(ID : byte; Swap : string; Page_Size, Cache : word) : shortint;
  25. function  STI_VM_ReOpen(ID : byte; Swap : string) : shortint;
  26. function  STI_VM_Allocate(ID : byte; Var Point) : longint;
  27. function  STI_VM_Demand(ID : byte; Var Point; PageNo : word) : shortint;
  28. function  STI_VM_Rollback(ID : byte; Var Point; PageNo : word) : shortint;
  29. function  STI_VM_Close(ID : byte; EraseFile : boolean) : shortint;
  30. function  STI_VM_Hit_Rate : real;
  31. procedure STI_VM_Init;                     {initialise the virtual memory   }
  32. procedure STI_VM_Log_Cache(B : boolean);
  33.  
  34.  
  35. implementation
  36.  
  37. Type
  38.   One_Page = record                         {one page                       }
  39.                Access  : word;
  40.            Data    : pointer;           {data of the page               }
  41.                PageID  : word;              {page ID                        }
  42.              end;
  43.  
  44.   One_Set = array[1..MEM_PAGES] of One_Page;{one page buffer                }
  45.  
  46.   One_SYS = record
  47.               File_Name  : string;          {swap file name                 }
  48.               FileP      : file;            {file pointer                   }
  49.               Page_Size  : word;            {size of the page               }
  50.               No_Pages   : word;            {number of cached pages         }
  51.               Tot_pages  : word;            {total number of pages          }
  52.               Used       : boolean;         {is this system used            }
  53.               Cache      : ^One_Set;        {cache for this system          }
  54.             end;
  55.   All_SYS = array[1..MAX_VM_FILES] of One_SYS; {the complete buffer         }
  56.  
  57. Var
  58.   Pages : All_SYS;                          {this is it folks               }
  59.   Log   : Boolean;
  60.   Tries,
  61.   Hits  : real;
  62.  
  63. {---------------------------------------------------------------------------}
  64.  
  65. function Lowest_Access(ID : byte) : word;
  66.  
  67. var
  68.   Loop,
  69.   Temp1,
  70.   Temp2 : word;
  71.  
  72. begin
  73.   Temp1 := 65535;
  74.   Temp2 := 1;
  75.   for Loop := 1 to Pages[ID].No_Pages do
  76.     begin
  77.       if Pages[ID].Cache^[Loop].Access < Temp1 then
  78.         begin
  79.           Temp1 := Pages[ID].Cache^[Loop].Access;
  80.           Temp2 := Loop;
  81.         end;
  82.     end;
  83.   Lowest_Access := Temp2;
  84. end;
  85.  
  86. {---------------------------------------------------------------------------}
  87.  
  88. procedure Write_Out(ID : byte; VirtualPage,LogicalPage : word);
  89.  
  90. begin
  91.   seek(Pages[ID].FileP,1 + ((VirtualPage-1) * (Pages[ID].Page_Size div 128)));
  92.   blockwrite(Pages[ID].FileP,Pages[ID].Cache^[LogicalPage].Data^,Pages[ID].Page_Size div 128);
  93. end;
  94.  
  95. {---------------------------------------------------------------------------}
  96.  
  97. procedure Read_In(ID : byte; VirtualPage,LogicalPage : word);
  98.  
  99. begin
  100.   seek(Pages[ID].FileP,1 + ((VirtualPage-1) * (Pages[ID].Page_Size div 128)));
  101.   blockread(Pages[ID].FileP,Pages[ID].Cache^[LogicalPage].Data^,Pages[ID].Page_Size div 128);
  102. end;
  103.  
  104. {---------------------------------------------------------------------------}
  105.  
  106. function STI_VM_Flush_Cache(ID : Byte) : shortint;
  107.  
  108. Var
  109.   Loop : word;
  110.  
  111. begin
  112.   if not(Pages[ID].Used) then               {check if this system is used  }
  113.     begin
  114.       STI_VM_Flush_Cache := BAD_VM_ID;      {yes return a bad ID error     }
  115.       Exit;                                 {and get out of here           }
  116.     end;
  117.   for loop := 1 to Pages[ID].No_Pages do    {loop & write them to disk     }
  118.     begin
  119.       if Pages[ID].Cache^[Loop].PageID > 0 then
  120.         Write_Out(ID,Pages[ID].Cache^[Loop].PageID,loop);
  121.     end;
  122. end;
  123.  
  124. {---------------------------------------------------------------------------}
  125.  
  126. function STI_VM_Open(ID : byte; Swap : string; Page_Size, Cache : word) : shortint;
  127.  
  128. Var
  129.   Loop   : word;
  130.   Dummy  : string;
  131.   Header : String;
  132.  
  133. begin
  134.   if Page_Size > 128 then
  135.     begin
  136.       if (Page_Size mod 128) > 0 then
  137.         Page_Size := Page_Size + (128 - (Page_Size mod 128));
  138.     end
  139.   else
  140.     Page_Size := 128;
  141.   if Pages[ID].Used then                    {check if this system is used  }
  142.     begin
  143.       STI_VM_Open := BAD_VM_ID;             {yes return a bad ID error     }
  144.       Exit;                                 {and get out of here           }
  145.     end;
  146.   if Page_Size > MAX_PAGE_SIZE then         {check if page size is ok      }
  147.     begin
  148.       STI_VM_Open := PAGE_SIZE_TOO_BIG;     {no  return a bad page size err}
  149.       Exit;                                 {and get out of here           }
  150.     end;
  151.   if Page_Size < 1 then                     {check if page size is ok      }
  152.     begin
  153.       STI_VM_Open := PAGE_SIZE_TOO_SMALL;   {no  return a bad page size err}
  154.       Exit;                                 {and get out of here           }
  155.     end;
  156.   if Cache > MEM_PAGES then                 {check if cache size is ok     }
  157.     begin
  158.       STI_VM_Open := CACHE_SIZE_TOO_BIG;    {no return a cache size err    }
  159.       Exit;                                 {and get out of here           }
  160.     end;
  161.   if Cache < 1 then                         {check if cache size is ok     }
  162.     begin
  163.       STI_VM_Open := CACHE_SIZE_TOO_SMALL;  {no  return a cache size err   }
  164.       Exit;                                 {and get out of here           }
  165.     end;
  166.   if MaxAvail < (Cache * Page_Size) then    {check if enough memory        }
  167.     begin
  168.       STI_VM_Open := OUT_OF_MEMORY;         {no  return a memory error     }
  169.       Exit;                                 {and get out of here           }
  170.     end;
  171.                                             {from here everything SHOULD be}
  172.                                             {ok, so do minimal checking    }
  173.  
  174.   Pages[ID].File_Name := Swap;              {let the file name = this      }
  175.   assign(Pages[ID].FileP,Swap);             {initialise the file name      }
  176.   {$I-}                                     {turn off I/O checking         }
  177.   rewrite(Pages[ID].FileP);                 {try to create the file        }
  178.   if IOResult <> 0 then                     {check if file make is ok      }
  179.     begin
  180.       STI_VM_Open := FILE_CREATE_ERROR;     {no  return a bad file make err}
  181.       {$I+}
  182.       Exit;                                 {and get out of here           }
  183.     end;
  184.   {$I+}
  185.   Pages[ID].Used      := TRUE;              {this is used                  }
  186.   Pages[ID].No_Pages  := Cache;             {the number of cached pages    }
  187.   Pages[ID].Page_Size := Page_Size;         {set the page size             }
  188.   getmem(Pages[ID].Cache,Cache*sizeof(One_Page));
  189.   for Loop := 1 to Cache do                 {loop over the pages           }
  190.     begin
  191.       Pages[ID].Cache^[Loop].PageID := 0;     {default assignment           }
  192.       getmem(Pages[ID].Cache^[Loop].Data,Page_Size); {get the memory        }
  193.     end;
  194.   STI_VM_Open := ALL_OK;                    {everthing is fine here folks  }
  195.   FillChar(Header[1],128,#32);
  196.   Dummy := '';
  197.   Dummy := Dummy + char(hi(Pages[ID].Page_Size));
  198.   Dummy := Dummy + char(lo(Pages[ID].Page_Size));
  199.   Dummy := Dummy + char(hi(Pages[ID].No_Pages));
  200.   Dummy := Dummy + char(lo(Pages[ID].No_Pages));
  201.   Dummy := Dummy + char(hi(Pages[ID].Tot_Pages));
  202.   Dummy := Dummy + char(lo(Pages[ID].Tot_Pages));
  203.   Header := 'Virtual Memory Management System.'+#13#10+'Copyright (C) 1990 By Software Technology International' +
  204.              #26+Dummy + Header;
  205.   seek(Pages[ID].FileP,0);
  206.   blockwrite(Pages[ID].FileP,Header,1);
  207. end;
  208.  
  209. {---------------------------------------------------------------------------}
  210.  
  211. function STI_VM_ReOpen(ID : byte; Swap : string) : shortint;
  212.  
  213. Var
  214.   Temp1,
  215.   Temp2,
  216.   Temp3,
  217.   Temp4,
  218.   Loop   : word;
  219.   Dummy  : string[8];
  220.   Header : String;
  221.  
  222. begin
  223.   if Pages[ID].Used then                    {check if this system is used  }
  224.     begin
  225.       STI_VM_ReOpen := BAD_VM_ID;           {yes return a bad ID error     }
  226.       Exit;                                 {and get out of here           }
  227.     end;
  228.   Pages[ID].File_Name := Swap;              {let the file name = this      }
  229.   assign(Pages[ID].FileP,Swap);             {initialise the file name      }
  230.   {$I-}                                     {turn off I/O checking         }
  231.   reset(Pages[ID].FileP);                   {try to create the file        }
  232.   if IOResult <> 0 then                     {check if file make is ok      }
  233.     begin
  234.       STI_VM_ReOpen := FILE_CREATE_ERROR;   {no  return a bad file make err}
  235.       {$I+}
  236.       Exit;                                 {and get out of here           }
  237.     end;
  238.   {$I+}
  239.  
  240.   seek(Pages[ID].FileP,0);
  241.   blockread(Pages[ID].FileP,Header,1);
  242.   Temp1 := (ord(Header[94]) * 256) + ord(Header[95]);    {cache}
  243.   Temp2 := (ord(Header[92]) * 256) + ord(Header[93]);    {page size}
  244.   Temp3 := (ord(Header[96]) * 256) + ord(Header[97]);    {tot pages}
  245.   Temp4 := (ord(Header[98]) * 256) + ord(Header[99]);    {replace}
  246.  
  247.   if MaxAvail < (Temp1 * Temp2) then    {check if enough memory        }
  248.     begin
  249.       STI_VM_ReOpen := OUT_OF_MEMORY;         {no  return a memory error     }
  250.       Exit;                                 {and get out of here           }
  251.     end;
  252.                                             {from here everything SHOULD be}
  253.                                             {ok, so do minimal checking    }
  254.  
  255.   Pages[ID].Used      := TRUE;              {this is used                  }
  256.   Pages[ID].No_Pages  := Temp1;             {the number of cached pages    }
  257.   Pages[ID].Page_Size := Temp2;             {set the page size             }
  258.   Pages[ID].Tot_Pages := Temp3;
  259.   getmem(Pages[ID].Cache,Temp1*sizeof(One_Page));
  260.   for Loop := 1 to Temp1 do                 {loop over the pages           }
  261.     begin
  262.       Pages[ID].Cache^[Loop].PageID := 0;     {default assignment           }
  263.       getmem(Pages[ID].Cache^[Loop].Data,Temp2); {get the memory        }
  264.     end;
  265.   STI_VM_ReOpen := ALL_OK;                    {everthing is fine here folks  }
  266. end;
  267.  
  268. {---------------------------------------------------------------------------}
  269.  
  270. function STI_VM_Allocate(ID : byte; Var Point) : longint;
  271.  
  272. Var
  273.   Temp  : word;
  274.   ThisP : pointer absolute Point;
  275.  
  276. begin
  277.   if not(Pages[ID].Used) then               {is this a valid system         }
  278.     begin
  279.       STI_VM_Allocate := BAD_VM_ID;         {no, return an error and escape }
  280.       Exit;
  281.     end;
  282.   Temp := Lowest_Access(ID);
  283.   if Pages[ID].Cache^[Temp].PageID = 0 then
  284.     begin
  285.       inc(Pages[ID].Tot_Pages);
  286.       Pages[ID].Cache^[Temp].PageID := Pages[ID].Tot_Pages;
  287.       Pages[ID].Cache^[Temp].Access := 65535;
  288.       FillChar(Pages[ID].Cache^[Temp].Data^,Pages[ID].Page_Size,#32);
  289.       ThisP := Pages[ID].Cache^[Temp].Data;
  290.       STI_VM_Allocate := Pages[ID].Tot_Pages;
  291.     end
  292.   else
  293.     begin
  294.       Write_Out(ID,Pages[ID].Cache^[Temp].PageID,Temp);
  295.       inc(Pages[ID].Tot_Pages);
  296.       Pages[ID].Cache^[Temp].PageID := Pages[ID].Tot_Pages;
  297.       Pages[ID].Cache^[Temp].Access := 65535;
  298.       FillChar(Pages[ID].Cache^[Temp].Data^,Pages[ID].Page_Size,#32);
  299.       ThisP := Pages[ID].Cache^[Temp].Data;
  300.       STI_VM_Allocate := Pages[ID].Tot_Pages;
  301.     end;
  302. end;
  303.  
  304. {---------------------------------------------------------------------------}
  305.  
  306. function STI_VM_Demand(ID : byte; Var Point; PageNo : word) : shortint;
  307.  
  308. Var
  309.   Found : boolean;
  310.   Loop,
  311.   temp  : word;
  312.   ThisP : pointer absolute Point;
  313.  
  314. begin
  315.   if not(Pages[ID].Used) then               {is this a valid system         }
  316.     begin
  317.       STI_VM_Demand := BAD_VM_ID;           {no, return an error and escape }
  318.       Exit;
  319.     end;
  320.   if Pages[ID].Tot_Pages < PageNo then      {is this a valid page number    }
  321.     begin
  322.       STI_VM_Demand := BAD_PAGE_NUMBER;     {no, return an error and escape }
  323.       Exit;
  324.     end;
  325.   Found := FALSE;
  326.   if Log then
  327.     Tries := Tries + 1;
  328.   for Loop := 1 to Pages[ID].No_Pages do
  329.     begin
  330.       if Pages[ID].Cache^[Loop].PageID = PageNo then
  331.     begin
  332.       if Log then
  333.         Hits := Hits + 1;
  334.           ThisP := Pages[ID].Cache^[Loop].Data;
  335.           Found := TRUE;
  336.           if Pages[ID].Cache^[Loop].Access < 65535 then
  337.             Inc(Pages[ID].Cache^[Loop].Access);
  338.         end else
  339.       if Pages[ID].Cache^[Loop].Access > 0 then
  340.         Dec(Pages[ID].Cache^[Loop].Access);
  341.     end;
  342.   if Found then
  343.     begin
  344.       STI_VM_Demand := ALL_OK;
  345.       Exit;
  346.     end;
  347.   Temp := Lowest_Access(ID);
  348.   if Pages[ID].Cache^[Temp].PageID = 0 then
  349.     begin
  350.       Read_In(ID,PageNo,Temp);
  351.       Pages[ID].Cache^[Temp].PageID := PageNo;
  352.       Pages[ID].Cache^[Temp].Access := 65535;
  353.       ThisP := Pages[ID].Cache^[Temp].Data;
  354.       STI_VM_Demand := ALL_OK;
  355.     end
  356.   else
  357.     begin
  358.       Write_Out(ID,Pages[ID].Cache^[Temp].PageID,Temp);
  359.       Read_In(ID,PageNo,Temp);
  360.       Pages[ID].Cache^[Temp].PageID := PageNo;
  361.       Pages[ID].Cache^[Temp].Access := 65535;
  362.       ThisP := Pages[ID].Cache^[Temp].Data;
  363.       STI_VM_Demand := ALL_OK;
  364.     end;
  365. end;
  366.  
  367. {---------------------------------------------------------------------------}
  368.  
  369. function STI_VM_Rollback(ID : byte; Var Point; PageNo : word) : shortint;
  370.  
  371. Var
  372.   Logic : word;
  373.   temp  : word;
  374.   ThisP : pointer absolute Point;
  375.  
  376. begin
  377.   if not(Pages[ID].Used) then               {is this a valid system         }
  378.     begin
  379.       STI_VM_Rollback := BAD_VM_ID;         {no, return an error and escape }
  380.       Exit;
  381.     end;
  382.   if Pages[ID].Tot_Pages < PageNo then      {is this a valid page number    }
  383.     begin
  384.       STI_VM_Rollback := BAD_PAGE_NUMBER;   {no, return an error and escape }
  385.       Exit;
  386.     end;
  387.   Logic := 0;
  388.   for Temp := 1 to Pages[ID].No_Pages do
  389.     begin
  390.       if Pages[ID].Cache^[Temp].PageID = PageNo then
  391.         Logic := Temp;
  392.     end;
  393.   if Logic = 0 then                         {is this a valid page number    }
  394.     begin
  395.       STI_VM_Rollback := BAD_PAGE_NUMBER;   {no, return an error and escape }
  396.       Exit;
  397.     end;
  398.   Temp := Lowest_Access(ID);
  399.   if Pages[ID].Tot_Pages < Logic  then      {no page to roll back           }
  400.     begin
  401.       STI_VM_RollBack := All_OK;
  402.       Exit;
  403.     end
  404.   else
  405.     begin
  406.       Read_In(ID,PageNo,Logic);
  407.       STI_VM_Rollback := ALL_OK;
  408.     end;
  409. end;
  410.  
  411. {---------------------------------------------------------------------------}
  412.  
  413. function STI_VM_Close(ID : byte; EraseFile : boolean) : shortint;
  414.  
  415. Var
  416.   loop  : word;
  417.   dummys : shortint;
  418.   dummy  : string;
  419.   header : string;
  420.  
  421. begin
  422.   if not(Pages[ID].Used) then               {is this a valid system         }
  423.     begin
  424.       STI_VM_Close := BAD_VM_ID;            {no, return an error and escape }
  425.       Exit;
  426.     end;
  427.   dummys := STI_VM_Flush_Cache(ID);
  428.   FillChar(Header[1],128,#32);
  429.   Dummy := '';
  430.   Dummy := Dummy + char(hi(Pages[ID].Page_Size));
  431.   Dummy := Dummy + char(lo(Pages[ID].Page_Size));
  432.   Dummy := Dummy + char(hi(Pages[ID].No_Pages));
  433.   Dummy := Dummy + char(lo(Pages[ID].No_Pages));
  434.   Dummy := Dummy + char(hi(Pages[ID].Tot_Pages));
  435.   Dummy := Dummy + char(lo(Pages[ID].Tot_Pages));
  436.   Header := 'Virtual Memory Management System.'+#13#10+'Copyright (C) 1990 By Software Technology International' +
  437.              #26 + Dummy + Header;
  438.   seek(Pages[ID].FileP,0);
  439.   blockwrite(Pages[ID].FileP,Header,1);
  440.   Close(Pages[ID].FileP);
  441.   if EraseFile then
  442.     Erase(Pages[ID].FileP);
  443.   Pages[ID].File_Name := '';                {null the swap file name        }
  444.   Pages[ID].Used      := FALSE;             {set to unused                  }
  445.   Pages[ID].Tot_Pages := 0;                 {number of pages in the system  }
  446.   for loop := 1 to Pages[ID].No_Pages do    {loop on memeory resident pages }
  447.         begin
  448.           freemem(Pages[ID].Cache^[loop].Data,Pages[ID].Page_Size);
  449.           Pages[ID].Cache^[loop].Data   := NIL;  {null the pointer           }
  450.           Pages[ID].Cache^[loop].PageID := 0;    {null the page ID           }
  451.           Pages[ID].Cache^[loop].Access := 0;    {null the access counter    }
  452.         end;
  453.   freemem(Pages[ID].Cache,Pages[ID].No_Pages*sizeof(One_Page));
  454.   Pages[ID].No_Pages  := 0;                  {no pages cached               }
  455.   Pages[ID].Page_Size := 128;               {default page size              }
  456.   STI_VM_Close := ALL_OK;
  457. end;
  458.  
  459. {---------------------------------------------------------------------------}
  460.  
  461. function STI_VM_Hit_Rate : real;
  462.  
  463. begin
  464.   STI_VM_Hit_Rate := (Hits / Tries) * 100;
  465. end;
  466.  
  467. {---------------------------------------------------------------------------}
  468.  
  469. procedure STI_VM_Log_Cache(B : boolean);
  470.  
  471. begin
  472.   Log := B;
  473.   Hits := 0;
  474.   Tries := 0;
  475. end;
  476.  
  477. {---------------------------------------------------------------------------}
  478.  
  479. procedure STI_VM_Init;                     {initialise the virtual memory   }
  480.  
  481. Var
  482.   loop1,                                   {general loop variables          }
  483.   loop2  : word;
  484.  
  485. begin
  486.   Log   := FALSE;
  487.   Hits  := 0;
  488.   Tries := 0;
  489.   for loop1 := 1 to MAX_VM_FILES do        {loop over all the systems       }
  490.     begin
  491.       Pages[loop1].File_Name := '';        {null the swap file name         }
  492.       Pages[loop1].Used      := FALSE;     {set to unused                   }
  493.       Pages[loop1].Tot_Pages := 0;         {number of pages in the system   }
  494.       Pages[loop1].No_Pages  := 0;         {no pages cached                 }
  495.       Pages[loop1].Page_Size := 128;       {defaultpage size                }
  496.       Pages[loop1].Cache     := NIL;       {null the pointer       }
  497.     end;
  498. end;
  499.  
  500. {---------------------------------------------------------------------------}
  501.  
  502. begin
  503.   STI_VM_Init;
  504. end.
  505.  
  506.  
  507.  
  508.  
  509.