Program Example A-3

Program Algorithm

1. Open (HPFOPEN) a permanent disk file and a new user-labeled disk file (see procedure open_disk_file).

2. Write (FWRITELABEL) a user-defined label to the new file (see procedure write_user_label).

3. Get EOF (FGETINFO) of old file and assign that value to new file's record pointer; in a loop, sequentially read (FREAD) records from old file and write (FWRITEDIR) them to a location in the new file specified by the record pointer, then decrement the new file's record pointer (see procedure copy_oldfile_to_newfile). Continue the loop till the old file's EOF is reached.

4. Close (FCLOSE) the old file as deleted from the system, and close the new file as a temporary file (see procedure close_disk_file).

Source code listing

 $standard_level 'hp3000'$
 $lines 100$
 $code_offsets on$
 $tables on$
 $list_code on$
 program write_read (input,output);

 {******************************************************************}
 {                       DECLARATION PART                           }
 {******************************************************************}

 const
    ccg              = 0;            { condition code warning/EOF   }
    ccl              = 1;            { condition code error         }
    cce              = 2;            { condition code successful    }
    permanent        = 1;
    new              = 0;
    temp             = 2;
    delete           = 4;

 type
    pac256           = packed array [1..256] of char;
    pac80            = packed array [1..80] of char;
                                     {HPFOPEN status parameter type }
    status_type      = record
                         case integer of
                            0 : (info    : shortint;
                                 subsys  : shortint);
                            1 : (all     : integer);
                         end;

 var
    old_file      : integer;
    new_file      : integer;
    filename      : pac80;
    label_id      : integer;
    label_len     : integer;
    outbuf        : pac80;

 function FREAD: shortint; intrinsic;  { sequential read old file   }
 procedure HPFOPEN; intrinsic;         { open both disk files       }
 procedure FCLOSE; intrinsic;          { close both disk files      }
 procedure FWRITEDIR; intrinsic;    {random access write to new file}
 procedure FWRITELABEL; intrinsic;     {write new user-defined label}
 procedure PRINTFILEINFO; intrinsic;   { user in error-handler      }
 procedure FGETINFO; intrinsic;        { get EOF location           }
 procedure QUIT; intrinsic;            { use in error-handler       }
 
 procedure handle_file_error
           (
              file_num : shortint;
              quit_num : shortint
           );
 {******************************************************************}
 { procedure handle_file_error prints file information on the       }
 { job/session list device, then aborts the program.                }
 {******************************************************************}

 begin
   PRINTFILEINFO (file_num);
   QUIT (quit_num);
 end;                               { end handle_file_error         }


 procedure open_disk_file
           (
              var file_num  : integer;
                  file_name : pac80;
                  domain    : integer
           );

 {******************************************************************}
 {procedure open_disk_file is a generic file open procedure that    }
 {allows you to specify the file name, it's domain, type of access, }
 {and internal format - ASCII or binary.                            }
 {******************************************************************}

 const
                                        {define HPFOPEN item numbers}
    formal_designator_option  = 2;
    domain_option             = 3;
    access_type_option        = 11;
    ascii_binary_option       = 53;

 var
                                       {define HPFOPEN items********}
    update         : integer;
    ascii          : integer;

                                       {**define scratch variables  }
    msgbuf         : pac80;
    status         : status_type;

 begin
    update := 5;
    ascii := 1;

    HPFOPEN (file_num, status, formal_designator_option, file_name,
                               domain_option, domain,
                               ascii_binary_option, ascii,
                               access_type_option, update);

    if status.all <> 0 then
       handle_file_error (file_num, 1);
 end;                                  { end open_disk_file         }


 procedure write_user_label
           (
              file_num : integer;
              buffer   : pac80;
              length   : integer;
              lnum     : integer
           );

 {******************************************************************}
 { procedure write_user_label writes a user-defined label to the    }
 { specified file.                                                  }
 {******************************************************************}

 begin
   FWRITELABEL (file_num, buffer, length, lnum);
   if ccode <> cce then
     handle_file_error (file_num, 2);
 end;                                { end write_user_label         }

 procedure copy_oldfile_to_newfile
           (
              new_discfile : integer;
              old_discfile : integer
           );

 {******************************************************************}
 { procedure copy_oldfile_to_newfile gets EOF of old file & assigns }
 { record pointer to that value. In a loop, sequentially reads from }
 { old file; random access writes to new file.                      }
 {******************************************************************}

 var
    rec          : integer;
    inbuf        : pac256;
    end_of_file  : boolean;
    read_length  : integer;

 begin
                                  { Locate the EOF in old disk file }
   end_of_file := false;         { initialize loop control variable }
   rec := 0;

   FGETINFO (old_discfile,,,,,,,,,, rec);
   if ccode = ccl then
     handle_file_error (old_discfile, 3);

   repeat
        {**Copy the records in the reverse orders from old disk file}
                     {**to the new disk file**                      }

    read_length := FREAD (old_discfile, inbuf, 128);
    if ccode = ccl then
       handle_file_error (old_discfile, 4)
        else
       if ccode = ccg then
          end_of_file := true
       else
 begin
           rec := rec - 1;            { decrement record pointer    }
           FWRITEDIR (new_discfile, inbuf, 128, rec);
           if ccode <> cce then
             handle_file_error (new_discfile, 5);
         end
   until end_of_file                  { check control variable EOF  }
 end;                                 { end copy_oldfile_to_newfile }


 procedure close_disk_file
           (
              file_num : integer;
              disp     : integer
           );

 {******************************************************************}
 { procedure close_disk_file is a disk file closing procedure that  }
 { allows you to specify the final disposition of the file you are  }
 { closing.                                                         }
 {******************************************************************}

 var
    msgbuf : pac80;

 begin
   FCLOSE (file_num, disp, 0);
   if ccode = ccl then
      handle_file_error (file_num, 6);
 end;                                      { end close_disk_file    }

 {******************************************************************}
 {                           Main Program                           }
 {******************************************************************}

 begin
 filename := '&dataone&';
 open_disk_file (old_file, filename, permanent);           { STEP 1 }
 filename := '&datatwo&';
 open_disk_file (new_file, filename, new);                 { STEP 1 }
 outbuf := 'Employee Data File';
 label_len := 9;
 label_id := 0;
 write_user_label(new_file, outbuf, label_len, label_id);  { STEP 2 }
 copy_oldfile_to_newfile(new_file, old_file);              { STEP 3 }
 close_disk_file(new_file, temp);                          { STEP 4 }
 close_disk_file (old_file, delete);                       { STEP 4 }
 end.