Program Example A-5

Program Algorithm

1. Open (HPFOPEN) three files, $STDLIST, $STDIN, and a permanent disk file containing data to update (see procedure open_file).

2. In a loop, lock (FLOCK) a shared data file; read (FREAD) data from disk file; write (FWRITE) data to $STDLIST; read (FREAD) new data from $STDIN; update (FUPDATE) shared data file with data read from $STDIN. The loop ends when EOF of disk file is reached (see procedure update_file).

3. Close (FCLOSE) the disk file (see procedure close_disk_file); let normal program termination close the other files.

Source code listing

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

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

 const
    ccg              = 0;                  { condition code warning }
    ccl              = 1;                  { condition code warning }
    cce              = 2;               { condition code successful }
 { HPFOPEN item values}
    permanent        = 1;
    read             = 0;
    write            = 1;
    update           = 5;
    save             = 1;
    shared           = 4; 
    locking          = 1;

 type
    pac256           = packed array [1..256] of char;
    pac80            = packed array [1..80] of char;

                                           { HPFOPEN status type    }
    status_type      = record
                         case integer of
                            0 : (info    : shortint;
                                 subsys  : shortint);
                            1 : (all     : integer);
                         end;

 var
    disk_file     : integer;
    filename      : pac80;
    std_list      : integer;
    std_in        : integer;
    outbuf        : pac80;

 function FREAD: shortint; intrinsic;      { sequential reads       }
 procedure HPFOPEN; intrinsic;             { open files             }
 procedure FCLOSE; intrinsic;              { close files            }
 procedure FWRITE; intrinsic;              { sequential writes      }
 procedure FWRITEDIR; intrinsic;           { random access writes   }
 procedure FUNLOCK; intrinsic;             { unlock locked file     }
 procedure PRINTFILEINFO; intrinsic;       { use in error handler   }
 procedure FLOCK; intrinsic;               { lock file              }
 procedure FUPDATE; intrinsic;             { update record          }
 procedure QUIT; intrinsic;                { use in error handler   }

   procedure handle_file_error
           (
              file_num : shortint;
              quit_num : shortint
           );

 {******************************************************************}
 { procedure handle_file_errorPrints the file information on the    }
 { session/job list device.                                         }
 {******************************************************************}

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


 procedure open_file
           (
              var file_num  : integer;
                  file_name : pac80;
                  domain    : integer;
                  access    : integer;
                  excl      : integer
                  lockable  : integer;
           );

 {******************************************************************}
 { procedure open_file is a generic file opening procedure that     }
 { allows you to specify the designator, domain, access type,       }
 { ASCII/binary, and exclusive options for the file.                }
 {******************************************************************}

 const
 {**define HPFOPEN item numbers**}
    formal_designator_option  = 2;
    domain_option             = 3;
    access_type_option        = 11;
    ascii_binary_option       = 53;
    exclusive_option          = 13;
    dynamic_locking_option    = 12;

 var
    ascii          : integer;
                                          {define scratch variables }
    msgbuf         : pac80;
    status         : status_type;

 begin
    ascii := 1;

    HPFOPEN (file_num, status, formal_designator_option, file_name,
                               domain_option, domain,
                               ascii_binary_option, ascii,
                               access_type_option, access,
                               exclusive_option, excl
                               dynamic_locking_option, lockable);
    if status.all <> 0 then
       handle_file_error (file_num, 1);
 end;                                      { end open_file          }


 procedure update_file
           (
              old_discfile : integer
           );

 {******************************************************************}
 { procedure update_file pdates records in the disk file with the   }
 { replacement read from the stdin.                                 }
 *******************************************************************}

 var
    dummy        : integer;
    inbuf        : array [1..80] of char;
    end_of_file  : boolean;
    read_length  : integer;

 begin
                                          {Lock the file and suspend}
   end_of_file := false;
   FLOCK (old_discfile,1);
   if ccode = ccl then
     handle_file_error (old_discfile, 3);

   repeat

    { Read record from disk file, write employee name to $stdlist   }
    { and read corresponding record number from $stdin and update   }
    { the disk file with the input record and unlock 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
           FWRITE (std_list, inbuf, -20, octal('320'));
           if ccode <> cce then
             handle_file_error (std_list, 5);
           dummy := FREAD (std_in, inbuf[20], 5);
           if ccode = ccl then
             handle_file_error (std_in, 6)
           else
             if ccode = ccg then
               end_of_file := true;
           FUPDATE (old_discfile, inbuf, 128);
           if ccode <> cce then
             handle_file_error (old_discfile, 7);
         end
     until end_of_file;
   FUNLOCK (old_discfile);              { final unlock of disk file }
           if ccode <> cce then
             handle_file_error (file_num, 2);
 end;                                      { end update_file        }


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

 {******************************************************************}
 {procedure close_disk_file is a generic 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, 8);
 end;                                     { end close_disk_file     }


 {******************************************************************}
 {                            MAIN PROGRAM                          }
 {******************************************************************}

 begin
   filename := '&$stdlist&';
   open_file (std_list, filename, permanent,write,0,0);     { STEP 1}
   filename := '&$stdin&';
   open_file (std_in, filename, permanent,read,0,0);        { STEP 1}
   filename := '&dataone&';
   open_file (disk_file, filename, permanent,update,shared,locking);
   update_file(disk_file);                                  { STEP 2}
   close_disk_file(disk_file, save);                        { STEP 3}

 end.                                      { end main program       }