Program Example A-4

Program Algorithm

1. Open (FOPEN) both the the Permanent disk file and $STDLIST (see procedure open_files).

2. Read (FREADLABEL) the user label from the disk file and write (FWRITE) it to $STDLIST (see procedure read_user_label).

3. 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).

4. Close (FCLOSE) both files (see procedure close_files).

Source code listing

 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 handler  }
 { 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}