Program Example A-4

This HP Pascal/XL program illustrates how you can use the FREADSEEK intrinsic to improve I/O performance during random access reads. The program opens a permanent disk file containing data, and $STDLIST. Even numbered records are read from the data file and printed to $STDLIST.

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 (FOPEN) both the the Permanent disk file and $STDLIST (see procedure open_files).
Read (FREADLABEL) the user label from the disk file and write (FWRITE) it to $STDLIST (see procedure read_user_label).
In a loop, read (FREADDIR) even numbered records from the disk file. Before writing (FWRITE) the records to disk, prefetch the next record (FREADSEEK). Do this till EOF of the disk file is reached (see procedure read_from_datafile).
Close (FCLOSE) both files (see procedure close_files).

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-4. Random Access

   program Read_Example (input,output); 

   {************************************************************************}

   {                         DECLARATION PART                               }

   {************************************************************************}



     const 

       CCG = 0;                              { condition code warning       }

       CCL = 1;                              { condition code error         }

       CCE = 2;                              { condition code successful    }

     type 

       file_name = packed array [1..9] of char; 

       buffertype = packed array [1..80] of char; 





     var 

       datafile_name: file_name; 

       listfile_name: file_name; 

       buffer       : buffertype; 

       message      : buffertype; 

       datafile     : shortint; 

       listfile     : shortint; 

       record_num   : integer; 



     function fopen:shortint; intrinsic;    { open files                    }

     procedure freadlabel;    intrinsic;    { read user-defined label       }

     procedure freaddir;      intrinsic;    { random access read file       }

     procedure fwrite;        intrinsic;    { sequential write to $STDLIST  }

     procedure fclose;        intrinsic;    { close files                   }

     procedure freadseek;     intrinsic;    { prefetch selected record      }

     procedure printfileinfo; intrinsic;    { used in error-handler         }

     procedure quit;          intrinsic;    { used in error-handler         }

 







     procedure error_handler (filenum, quitnum: shortint); 

   {************************************************************************}

   { procedure error_handler is a standard file system error handling       }

   { procedure invoked after an unsuccessful file system intrinsic call.    }

   { A file information display is printed to $STDLIST, then program aborts.}

   {************************************************************************}



       begin 

         printfileinfo (filenum); 

         quit (quitnum); 

       end;                                 {end error_handler              }

 

     procedure open_files; 

   {************************************************************************}

   { procedure open_files opens the data file and $STDLIST using the FOPEN  }

   { intrinsic.                                                             }

   {************************************************************************}



       const 

         permanent     = 5; 

         read_write    = 4; 

         stdlist      = 12; 

         write        =  1; 



       begin 

         datafile_name:= 'datafile '; 

         listfile_name:= 'listfile '; 

         datafile:= fopen(datafile_name,permanent,read_write,-80); 

         if ccode <> CCE then error_handler(datafile,1); 

         listfile:= fopen(listfile_name,stdlist,write); 

         if ccode <> CCE then error_handler(listfile,2); 

       end;                                       {end open_files           }





   procedure read_user_label; 

   {************************************************************************}

   {procedure read_user_label reads the user label located in the           }

   {user-defined label portion of the data file, then prints it to $STDLIST.}

   {************************************************************************}



     begin 

       freadlabel(datafile,buffer,-80); 

       if ccode <> CCE then error_handler(datafile,101); 

       fwrite (listfile,buffer,-80,0); 

       if ccode <> CCE then error_handler(listfile,102); 

     end;                                         {end read_user_label      }



   procedure read_from_datafile; 

   {************************************************************************}

   { procedure read_from_data_file first calls procedure read_user_label to }

   { print the label to $STDLIST, then enters a loop to select only even    }

   { numbered records from the data file and writing them to $STDLIST.      }

   {************************************************************************}



     var end_of_file: boolean; 



     begin 

 

       end_of_file:= false;                       {initialize loop control  }

       record_num:= 0; 





                                      { enter loop, random access read even }

                                      { numbered record, freadseek next     }

                                      { selection, then sequential write    }

                                      { to $STDLIST, till EOF.              }



       while not end_of_file do 

         begin 

           freaddir(datafile,buffer,-80,record_num); 

           if ccode <> CCE then error_handler(datafile,103); 

           record_num:= record_num + 2; 

           freadseek(datafile,record_num); 

           if ccode = CCL then error_handler(datafile,104) else 

           if ccode = CCG then end_of_file:= true; 

           fwrite(listfile,buffer,-80,0); 

           if ccode <> CCE then error_handler(listfile,105); 

         end; 

     end;                                          {end read_from_datafile  }







   procedure close_files;

   {************************************************************************}

   { procedure close_files  calls the fclose intrinsic twice to close bot   }

   { files previously opened by procedure open_files.                       }

   {************************************************************************}





     begin 

       fclose(datafile,0,0); 

       if ccode <> CCE then error_handler(datafile,1001); 

       fclose(listfile,0,0); 

       if ccode <> CCE then error_handler(listfile,1002); 

     end;







   {************************************************************************}

   {                        MAIN PROGRAM                                    }

   {************************************************************************}



   begin

     open_files;                                        { STEP 1            }

     read_user_label;                                   { STEP 2            }

     read_from_datafile;                                { STEP 3            }

     close_files;                                       { STEP 4            }



   end.                                                 {end main program   }

Program Example A-4

Technical documentation

» Table of Contents

» Index

Program Algorithm

Source code listing