Program Example A-3

This HP Pascal/XL program illustrates how you can use a sequential method of reading records from an old disk file and use a random access method of writing the records in an inverted order to a new user-labeled disk file, where record 1 of the first file is written to location n of the second file, record 2 is written to location n-1, and so on.

Program Algorithm

The task specified above is accomplished by following the steps described below. Also indicated are the intrinsics used to accomplish file access tasks and the name of the procedure where the task is accomplished:

Open (HPFOPEN) a permanent disk file and a new user-labeled disk file (see procedure open_disk_file).
Write (FWRITELABEL) a user-defined label to the new file (see procedure write_user_label).
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.
Close (FCLOSE) the old file as deleted from the system, and close the new file as a temporary file (see procedure close_disk_file).

If a file system intrinsic returns an unsuccessful condition code, procedure handle_file_error is called to print file information (PRINTFILEINFO) and then abort (QUIT) the program.

Source code listing

Example A-3. Random Access

   $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,/etc.. }

      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 allowsa }

   { 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.

Program Example A-3

Technical documentation

» Table of Contents

» Index

Program Algorithm

Source code listing