home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / nicol / sti_vm / makevp.pas next >
Encoding:
Pascal/Delphi Source File  |  1979-12-31  |  7.1 KB  |  177 lines
  1. program MakeVP;                             { program for creating a unit   }
  2.                                             { that has virtual pointers     }
  3. Const
  4.   NUMPAGES  = 50;                           { this is the number of pointers}
  5.                                             { available for the system      }
  6. Var                                         { maximum is about 512          }
  7.   OutFile : Text;
  8.   Loop    : word;
  9.  
  10. {---------------------------------------------------------------------------}
  11.  
  12. begin
  13.   assign(OutFile,'STI_VPTR.PAS');
  14.   rewrite(OutFile);
  15.   WriteLn(OutFile,'Unit STI_VPTR;');
  16.   WriteLn(OutFile,'{$V-}');
  17.   WriteLn(OutFile,'');
  18.   WriteLn(OutFile,'interface');
  19.   WriteLn(OutFile,'');
  20.   WriteLn(OutFile,'Const');
  21.   WriteLn(OutFile,'  NUMPAGES      = ',NUMPAGES,';');
  22.   WriteLn(OutFile,'');
  23.   WriteLn(OutFile,'Type');
  24.   WriteLn(OutFile,'  STI_VPointer  = function : pointer;');
  25.   WriteLn(OutFile,'');
  26.   WriteLn(OutFile,'procedure STI_VPGetMem(Var Point : STI_VPointer);');
  27.   WriteLn(OutFile,'procedure STI_VPFreeMem(Point : pointer);');
  28.   WriteLn(OutFile,'Procedure STI_VPInitialise(Name : string; Pages,SizePage : word);');
  29.   WriteLn(OutFile,'procedure STI_VPClose;');
  30.   WriteLn(OutFile,'');
  31.   WriteLn(OutFile,'implementation');
  32.   WriteLn(OutFile,'');
  33.   WriteLn(OutFile,'Var');
  34.   WriteLn(OutFile,'  VMCallArray : array[1..',NUMPAGES,'] of STI_VPointer;');
  35.   WriteLn(OutFile,'  VMFlags     : array[1..',NUMPAGES,'] of byte;       ');
  36.   WriteLn(OutFile,'  PageNumber  : word;');
  37.   WriteLn(OutFile,'  PageSize    : word;');
  38.   WriteLn(OutFile,'  Point       : pointer;');
  39.   WriteLn(OutFile,'  SwapFile    : File;');
  40.   WriteLn(OutFile,'');
  41.   WriteLn(OutFile,
  42. '{---------------------------------------------------------------------------}');
  43.   WriteLn(OutFile,'');
  44.   WriteLn(OutFile,'procedure PutPage;');
  45.   WriteLn(OutFile,'');
  46.   WriteLn(OutFile,'begin');
  47.   WriteLn(OutFile,'  Seek(SwapFile,PageNumber);');
  48.   WriteLn(OutFile,'  BlockWrite(SwapFile,Point^,1);');
  49.   WriteLn(OutFile,'  if VMFlags[PageNumber] > 200 then');
  50.   WriteLn(OutFile,'    Dec(VMFlags[PageNumber],200);');
  51.   WriteLn(OutFile,'end;');
  52.   WriteLn(OutFile,'');
  53.   WriteLn(OutFile,
  54. '{---------------------------------------------------------------------------}');
  55.   WriteLn(OutFile,'');
  56.   WriteLn(OutFile,'function GetPage(PageNum : word) : pointer;');
  57.   WriteLn(OutFile,'');
  58.   WriteLn(OutFile,'begin');
  59.   WriteLn(OutFile,'  if PageNum <> PageNumber then');
  60.   WriteLn(OutFile,'    PutPage;');
  61.   WriteLn(OutFile,'  if (PageNum < FileSize(SwapFile)) and (VMFlags[PageNum] < 200) then');
  62.   WriteLn(OutFile,'    begin');
  63.   WriteLn(OutFile,'      Seek(SwapFile,PageNum);');
  64.   WriteLn(OutFile,'      BlockRead(SwapFile,Point^,1);');
  65.   WriteLn(OutFile,'      Inc(VMFlags[PageNum],200);');
  66.   WriteLn(OutFile,'    end; ');
  67.   WriteLn(OutFile,'  PageNumber := PageNum;');
  68.   WriteLn(OutFile,'  GetPage := Point;');
  69.   WriteLn(OutFile,'end;');
  70.   WriteLn(OutFile,'');
  71.   WriteLn(OutFile,
  72. '{---------------------------------------------------------------------------}');
  73.   WriteLn(OutFile,'');
  74.   WriteLn(OutFile,'procedure STI_VPGetMem(Var Point : STI_VPointer);');
  75.   WriteLn(OutFile,'');
  76.   WriteLn(OutFile,'Var');
  77.   WriteLn(OutFile,'  Loop   : word;');
  78.   WriteLn(OutFile,'  Dummy1 : pointer absolute Point;');
  79.   WriteLn(OutFile,'  Dummy2 : array[1..NUMPAGES] of pointer absolute VMCallArray;');
  80.   WriteLn(OutFile,'');
  81.   WriteLn(OutFile,'begin');
  82.   WriteLn(OutFile,'  for Loop := 1 to NUMPAGES do');
  83.   WriteLn(OutFile,'    begin');
  84.   WriteLn(OutFile,'      if VMFlags[Loop] < 1 then');
  85.   WriteLn(OutFile,'        begin');
  86.   WriteLn(OutFile,'          Dummy1 := Dummy2[Loop];');
  87.   WriteLn(OutFile,'          VMFlags[Loop] := 1;');
  88.   WriteLn(OutFile,'          Exit;');
  89.   WriteLn(OutFile,'        end;');
  90.   WriteLn(OutFile,'    end;');
  91.   WriteLn(OutFile,'  WriteLn(''Virtual Memory OverFlow'');');
  92.   WriteLn(OutFile,'  Halt;');
  93.   WriteLn(OutFile,'end;');
  94.   WriteLn(OutFile,'');
  95.   WriteLn(OutFile,
  96. '{---------------------------------------------------------------------------}');
  97.   WriteLn(OutFile,'');
  98.   WriteLn(OutFile,'procedure STI_VPFreeMem(Point : pointer);');
  99.   WriteLn(OutFile,'');
  100.   WriteLn(OutFile,'Var');
  101.   WriteLn(OutFile,'  Loop   : word;');
  102.   WriteLn(OutFile,'  Dummy1 : pointer absolute Point;');
  103.   WriteLn(OutFile,'  Dummy2 : array[1..NUMPAGES] of pointer absolute VMCallArray;');
  104.   WriteLn(OutFile,'');
  105.   WriteLn(OutFile,'begin');
  106.   WriteLn(OutFile,'  for Loop := 1 to NUMPAGES do');
  107.   WriteLn(OutFile,'    begin');
  108.   WriteLn(OutFile,'      if Dummy1 = Dummy2[Loop] then');
  109.   WriteLn(OutFile,'        begin');
  110.   WriteLn(OutFile,'          VMFlags[Loop] := 0;');
  111.   WriteLn(OutFile,'          Exit;');
  112.   WriteLn(OutFile,'        end;');
  113.   WriteLn(OutFile,'    end;');
  114.   WriteLn(OutFile,'end;');
  115.   WriteLn(OutFile,'');
  116.   WriteLn(OutFile,
  117. '{---------------------------------------------------------------------------}');
  118.   for Loop := 1 to NUMPAGES do
  119.     begin
  120.       WriteLn(OutFile,'{$F+}');
  121.       WriteLn(OutFile,'function PageCall',Loop,' : Pointer;');
  122.       WriteLn(OutFile,'{$F-}');
  123.       WriteLn(OutFile,'begin');
  124.       WriteLn(OutFile,'  PageCall',Loop,' := GetPage(',Loop,');');
  125.       WriteLn(OutFile,'end;');
  126.       WriteLn(OutFile,
  127. '{---------------------------------------------------------------------------}');
  128.     end;
  129.  
  130.   WriteLn(OutFile,'Procedure STI_VPInitialise(Name : string; Pages,SizePage : word);');
  131.   WriteLn(OutFile,'');
  132.   WriteLn(OutFile,'Var');
  133.   WriteLn(OutFile,'  Dummy : string;');
  134.   WriteLn(OutFile,'  Loop  : word;');
  135.   WriteLn(OutFile,'');
  136.   WriteLn(OutFile,'begin');
  137.   for Loop := 1 to NUMPAGES do
  138.     begin
  139.       WriteLn(OutFile,'  VMCallArray[',Loop:5,']  := PageCall',Loop,';');
  140.     end;
  141.   WriteLn(OutFile,'  For Loop := 1 to NUMPAGES do');
  142.   WriteLn(OutFile,'    begin');
  143.   WriteLn(OutFile,'      VMFlags[Loop] := 0;');
  144.   WriteLn(OutFile,'    end;');
  145.   WriteLn(OutFile,'  PageNumber := 1;');
  146.   WriteLn(OutFile,'  PageSize   := SizePage;');
  147.   WriteLn(OutFile,'  Assign(SwapFile,Name);');
  148.   WriteLn(OutFile,'  Rewrite(SwapFile,SizePage);');
  149.   WriteLn(OutFile,'  GetMem(Point,SizePage);');
  150.   WriteLn(OutFile,'  FillChar(Point^,SizePage,#32);');
  151.   WriteLn(OutFile,'  Dummy := ''STIVPTR''+#26+''Virtual Memory Management System Copyright (C) 1990,1991 by STI'';');
  152.   WriteLn(OutFile,'  Seek(SwapFile,0);');
  153.   WriteLn(OutFile,'  BlockWrite(SwapFile,Dummy[1],0);');
  154.   WriteLn(OutFile,'end;');
  155.   WriteLn(OutFile,'');
  156.   WriteLn(OutFile,
  157. '{---------------------------------------------------------------------------}');
  158.   WriteLn(OutFile,'');
  159.   WriteLn(OutFile,'procedure STI_VPClose;');
  160.   WriteLn(OutFile,'');
  161.   WriteLn(OutFile,'begin');
  162.   WriteLn(OutFile,'  Close(SwapFile);');
  163.   WriteLn(OutFile,'  Erase(SwapFile);');
  164.   WriteLn(OutFile,'  FreeMem(Point,PageSize);');
  165.   WriteLn(OutFile,'end;');
  166.   WriteLn(OutFile,'');
  167.   WriteLn(OutFile,
  168. '{---------------------------------------------------------------------------}');
  169.   WriteLn(OutFile,'');
  170.   WriteLn(OutFile,'begin');
  171.   WriteLn(OutFile,'end.');
  172.   flush(OutFile);
  173.   Close(OutFile);
  174. end.
  175.  
  176.  
  177.