Power-Programmierung/CD1.mdf/pascal/library/dos/nicol/sti_vm/sti_vptr.pas

Pascal/Delphi Source File | 1979-12-31 | 13.0 KB | 535 lines

Unit STI_VPTR;
{$V-}

interface

Const
  NUMPAGES      = 50;

Type
  STI_VPointer  = function : pointer;

procedure STI_VPGetMem(Var Point : STI_VPointer);
procedure STI_VPFreeMem(Point : pointer);
Procedure STI_VPInitialise(Name : string; Pages,SizePage : word);
procedure STI_VPClose;

implementation

Var
  VMCallArray : array[1..50] of STI_VPointer;
  VMFlags     : array[1..50] of byte;
  PageNumber  : word;
  PageSize    : word;
  Point       : pointer;
  SwapFile    : File;

{---------------------------------------------------------------------------}

procedure PutPage;

begin
  Seek(SwapFile,PageNumber);
  BlockWrite(SwapFile,Point^,1);
  if VMFlags[PageNumber] > 200 then
    Dec(VMFlags[PageNumber],200);
end;

{---------------------------------------------------------------------------}

function GetPage(PageNum : word) : pointer;

begin
  if PageNum <> PageNumber then
    PutPage;
  if (PageNum < FileSize(SwapFile)) and (VMFlags[PageNum] < 200) then
    begin
      Seek(SwapFile,PageNum);
      BlockRead(SwapFile,Point^,1);
      Inc(VMFlags[PageNum],200);
    end;
  PageNumber := PageNum;
  GetPage := Point;
end;

{---------------------------------------------------------------------------}

procedure STI_VPGetMem(Var Point : STI_VPointer);

Var
  Loop   : word;
  Dummy1 : pointer absolute Point;
  Dummy2 : array[1..NUMPAGES] of pointer absolute VMCallArray;

begin
  for Loop := 1 to NUMPAGES do
    begin
      if VMFlags[Loop] < 1 then
        begin
          Dummy1 := Dummy2[Loop];
          VMFlags[Loop] := 1;
          Exit;
        end;
    end;
  WriteLn('Virtual Memory OverFlow');
  Halt;
end;

{---------------------------------------------------------------------------}

procedure STI_VPFreeMem(Point : pointer);

Var
  Loop   : word;
  Dummy1 : pointer absolute Point;
  Dummy2 : array[1..NUMPAGES] of pointer absolute VMCallArray;

begin
  for Loop := 1 to NUMPAGES do
    begin
      if Dummy1 = Dummy2[Loop] then
        begin
          VMFlags[Loop] := 0;
          Exit;
        end;
    end;
end;

{---------------------------------------------------------------------------}
{$F+}
function PageCall1 : Pointer;
{$F-}
begin
  PageCall1 := GetPage(1);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall2 : Pointer;
{$F-}
begin
  PageCall2 := GetPage(2);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall3 : Pointer;
{$F-}
begin
  PageCall3 := GetPage(3);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall4 : Pointer;
{$F-}
begin
  PageCall4 := GetPage(4);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall5 : Pointer;
{$F-}
begin
  PageCall5 := GetPage(5);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall6 : Pointer;
{$F-}
begin
  PageCall6 := GetPage(6);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall7 : Pointer;
{$F-}
begin
  PageCall7 := GetPage(7);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall8 : Pointer;
{$F-}
begin
  PageCall8 := GetPage(8);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall9 : Pointer;
{$F-}
begin
  PageCall9 := GetPage(9);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall10 : Pointer;
{$F-}
begin
  PageCall10 := GetPage(10);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall11 : Pointer;
{$F-}
begin
  PageCall11 := GetPage(11);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall12 : Pointer;
{$F-}
begin
  PageCall12 := GetPage(12);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall13 : Pointer;
{$F-}
begin
  PageCall13 := GetPage(13);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall14 : Pointer;
{$F-}
begin
  PageCall14 := GetPage(14);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall15 : Pointer;
{$F-}
begin
  PageCall15 := GetPage(15);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall16 : Pointer;
{$F-}
begin
  PageCall16 := GetPage(16);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall17 : Pointer;
{$F-}
begin
  PageCall17 := GetPage(17);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall18 : Pointer;
{$F-}
begin
  PageCall18 := GetPage(18);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall19 : Pointer;
{$F-}
begin
  PageCall19 := GetPage(19);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall20 : Pointer;
{$F-}
begin
  PageCall20 := GetPage(20);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall21 : Pointer;
{$F-}
begin
  PageCall21 := GetPage(21);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall22 : Pointer;
{$F-}
begin
  PageCall22 := GetPage(22);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall23 : Pointer;
{$F-}
begin
  PageCall23 := GetPage(23);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall24 : Pointer;
{$F-}
begin
  PageCall24 := GetPage(24);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall25 : Pointer;
{$F-}
begin
  PageCall25 := GetPage(25);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall26 : Pointer;
{$F-}
begin
  PageCall26 := GetPage(26);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall27 : Pointer;
{$F-}
begin
  PageCall27 := GetPage(27);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall28 : Pointer;
{$F-}
begin
  PageCall28 := GetPage(28);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall29 : Pointer;
{$F-}
begin
  PageCall29 := GetPage(29);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall30 : Pointer;
{$F-}
begin
  PageCall30 := GetPage(30);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall31 : Pointer;
{$F-}
begin
  PageCall31 := GetPage(31);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall32 : Pointer;
{$F-}
begin
  PageCall32 := GetPage(32);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall33 : Pointer;
{$F-}
begin
  PageCall33 := GetPage(33);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall34 : Pointer;
{$F-}
begin
  PageCall34 := GetPage(34);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall35 : Pointer;
{$F-}
begin
  PageCall35 := GetPage(35);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall36 : Pointer;
{$F-}
begin
  PageCall36 := GetPage(36);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall37 : Pointer;
{$F-}
begin
  PageCall37 := GetPage(37);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall38 : Pointer;
{$F-}
begin
  PageCall38 := GetPage(38);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall39 : Pointer;
{$F-}
begin
  PageCall39 := GetPage(39);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall40 : Pointer;
{$F-}
begin
  PageCall40 := GetPage(40);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall41 : Pointer;
{$F-}
begin
  PageCall41 := GetPage(41);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall42 : Pointer;
{$F-}
begin
  PageCall42 := GetPage(42);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall43 : Pointer;
{$F-}
begin
  PageCall43 := GetPage(43);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall44 : Pointer;
{$F-}
begin
  PageCall44 := GetPage(44);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall45 : Pointer;
{$F-}
begin
  PageCall45 := GetPage(45);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall46 : Pointer;
{$F-}
begin
  PageCall46 := GetPage(46);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall47 : Pointer;
{$F-}
begin
  PageCall47 := GetPage(47);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall48 : Pointer;
{$F-}
begin
  PageCall48 := GetPage(48);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall49 : Pointer;
{$F-}
begin
  PageCall49 := GetPage(49);
end;
{---------------------------------------------------------------------------}
{$F+}
function PageCall50 : Pointer;
{$F-}
begin
  PageCall50 := GetPage(50);
end;
{---------------------------------------------------------------------------}
Procedure STI_VPInitialise(Name : string; Pages,SizePage : word);

Var
  Dummy : string;
  Loop  : word;

begin
  VMCallArray[    1]  := PageCall1;
  VMCallArray[    2]  := PageCall2;
  VMCallArray[    3]  := PageCall3;
  VMCallArray[    4]  := PageCall4;
  VMCallArray[    5]  := PageCall5;
  VMCallArray[    6]  := PageCall6;
  VMCallArray[    7]  := PageCall7;
  VMCallArray[    8]  := PageCall8;
  VMCallArray[    9]  := PageCall9;
  VMCallArray[   10]  := PageCall10;
  VMCallArray[   11]  := PageCall11;
  VMCallArray[   12]  := PageCall12;
  VMCallArray[   13]  := PageCall13;
  VMCallArray[   14]  := PageCall14;
  VMCallArray[   15]  := PageCall15;
  VMCallArray[   16]  := PageCall16;
  VMCallArray[   17]  := PageCall17;
  VMCallArray[   18]  := PageCall18;
  VMCallArray[   19]  := PageCall19;
  VMCallArray[   20]  := PageCall20;
  VMCallArray[   21]  := PageCall21;
  VMCallArray[   22]  := PageCall22;
  VMCallArray[   23]  := PageCall23;
  VMCallArray[   24]  := PageCall24;
  VMCallArray[   25]  := PageCall25;
  VMCallArray[   26]  := PageCall26;
  VMCallArray[   27]  := PageCall27;
  VMCallArray[   28]  := PageCall28;
  VMCallArray[   29]  := PageCall29;
  VMCallArray[   30]  := PageCall30;
  VMCallArray[   31]  := PageCall31;
  VMCallArray[   32]  := PageCall32;
  VMCallArray[   33]  := PageCall33;
  VMCallArray[   34]  := PageCall34;
  VMCallArray[   35]  := PageCall35;
  VMCallArray[   36]  := PageCall36;
  VMCallArray[   37]  := PageCall37;
  VMCallArray[   38]  := PageCall38;
  VMCallArray[   39]  := PageCall39;
  VMCallArray[   40]  := PageCall40;
  VMCallArray[   41]  := PageCall41;
  VMCallArray[   42]  := PageCall42;
  VMCallArray[   43]  := PageCall43;
  VMCallArray[   44]  := PageCall44;
  VMCallArray[   45]  := PageCall45;
  VMCallArray[   46]  := PageCall46;
  VMCallArray[   47]  := PageCall47;
  VMCallArray[   48]  := PageCall48;
  VMCallArray[   49]  := PageCall49;
  VMCallArray[   50]  := PageCall50;
  For Loop := 1 to NUMPAGES do
    begin
      VMFlags[Loop] := 0;
    end;
  PageNumber := 1;
  PageSize   := SizePage;
  Assign(SwapFile,Name);
  Rewrite(SwapFile,SizePage);
  GetMem(Point,SizePage);
  FillChar(Point^,SizePage,#32);
  Dummy := 'STIVPTR'+#26+'Virtual Memory Management System Copyright (C) 1990,1991 by STI';
  Seek(SwapFile,0);
  BlockWrite(SwapFile,Dummy[1],0);
end;

{---------------------------------------------------------------------------}

procedure STI_VPClose;

begin
  Close(SwapFile);
  Erase(SwapFile);
  FreeMem(Point,PageSize);
end;

{---------------------------------------------------------------------------}

begin
end.