home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol085 / disc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  2.9 KB  |  102 lines
  1. External btree::disc(2);
  2.  
  3. PROCEDURE Store;
  4. { stores contents of tree onto disc }
  5. VAR
  6.   fileroot,
  7.   filename: filestring;
  8.   dummy_end: persondetails;
  9.     {a dummy end of file record is needed because EOF function
  10.     does not work correctly in Pascal/Z.  See page 54}
  11.   slug: shorty;
  12.   i: integer;
  13.   test: boolean;
  14.  
  15. BEGIN
  16.   { get file name 
  17.   }
  18.   write ('Name of output file - ');
  19.   readln (filename);
  20.   reset(filename,fin);
  21.   if not eof(fin)    {false if file does not exist}
  22.     then begin
  23.          i := 1;
  24.          setlength(fileroot, 0);
  25.          while filename[i] <> '.' do    {strip CPM file type}
  26.            begin
  27.            append( fileroot, filename[i]);
  28.            { filename[i] works ok to READ characters of a string,
  29.            but fileroot[i] will not WRITE characters into the string.
  30.            One of the sneaky differences between strings and arrays
  31.            of characters.}
  32.            i := i + 1;
  33.            end;    {while}
  34.     append(fileroot, '.BAK');
  35.     test := rename (filename, fileroot);
  36.     writeln('Existing ', filename, ' renamed ', fileroot,'.');
  37.     writeln('New ',filename, ' being opened.');
  38.     end;    {then}
  39.   rewrite (filename, fout);
  40.   disc := true;
  41.     {raise flag for use in DISPLAY procedure}
  42.   Preorder ( employee );
  43.   {Preorder is used rather than Inorder so that the tree is stored
  44.   in other than a sorted fashion.  When putting the leaves back
  45.   onto the tree (in FETCH below), inserting them in a sorted order
  46.   will result in a lopsided tree - one pointer in each record will
  47.   always be NIL.  In other words a linked list rather than a full
  48.   b - tree will result.  The program will work, but the speed of
  49.   a balanced tree will be lost.
  50.   }
  51.   slug := '****************************************';
  52.   with dummy_end do
  53.   {for reasons I have been unable to divine, leaving 'city'
  54.   undefined gets a "string too long" fatal error.  Filling
  55.   all fields of the record makes the error go away.  If you
  56.   know why, please tell me.    Buddenberg
  57.   }
  58.     begin
  59.     name := slug;
  60.     company := 'end of file marker';
  61.     address := slug;
  62.     city := slug;
  63.     state := slug;
  64.     zip := slug;
  65.     salary := slug;
  66.     end;    {with}
  67.   write (fout, dummy_end);
  68. END;    {Store}
  69.  
  70. {$T-}
  71. PROCEDURE Fetch;
  72. { reads data from disc and causes it to be placed onto tree }
  73. VAR
  74.   filename: string 14;
  75.   fileend: boolean;
  76.   rec: persondetails;
  77. BEGIN
  78.   write ('Name of file where the data is - ');
  79.   readln (filename);
  80.   reset (filename, fin);
  81.   fileend := false;
  82.   while not fileend do
  83.     BEGIN
  84.       read (fin, rec );
  85.     if rec.name = '****************************************'
  86.         then fileend := true;
  87.     if not fileend then
  88.     with rec do
  89.       begin
  90.       key := name;
  91.       new_salary := salary;
  92.       new_company := company;
  93.       new_address := address;
  94.       new_city := city;
  95.       new_state := state;
  96.       new_zip := zip
  97.       end;    {with}
  98.     insert (Employee, key);
  99.   end;    {while}
  100. END;    {fetch}
  101.  .
  102.