HP 3000 Manuals HP 3000 Manuals
Appendix A HP Pascal/XL Program Examples
The HP Pascal/XL program examples in this appendix are provided to help
you better understand how to use MPE/iX file system intrinsics to perform
common file access tasks.
Here is a short description of the task handled by each of the program
examples in this appendix:
* Program Example A-1 illustrates how you can open three different
files--an unlabeled magnetic tape file, $STDLIST, and a new disk
file--and copy records sequentially from the tape file to the disk
file, while concurrently writing the records to $STDLIST.
* Program Example A-2 illustrates how you can open a labeled
magnetic tape file and a new disk file, print the user label to
$STDLIST, then copy records sequentially from the tape file to the
disk file. Play close attention to how the program closes the new
disk file as a permanent file, and how it allows the user to
specify alternate file designators if the file name already
exists.
* Program Example A-3 illustrates how you can use the sequential
access method of reading records from an old disk file, then use
the random access method of writing the records to a new labeled
disk file.
* Program Example A-4 illustrates how you can read from a file using
random access method of data access. In addition, the program
shows how you can use the FREADSEEK intrinsic to increase program
performance by prefetching records, thus minimizing I/O wait-time.
* Program Example A-5 illustrates how you can allow a user to update
records in a shared data file. This program makes use of file
locking intrinsics, FLOCK and FUNLOCK, to ensure exclusive access
to the shared file during the update process.
Program example A-1
This program illustrates how you can open three different files--an
unlabeled magnetic tape file, $STDLIST, and a new disk file--and copy
records sequentially from the tape file to the disk file while
concurrently writing the records 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:
1. Open (HPFOPEN) three files--an unlabeled magnetic tape
file, and new disk file, and $STDLIST (see procedure
open_unlabeled_tape_file and procedure open_file).
2. In a loop, sequentially read (FREAD) records from tape file, then
write (FWRITE) them to both disk file and $STDLIST (see procedure
copy_tapefile_to_disk_file). Continue loop till tape file's EOF
is reached.
3. Close (FCLOSE) the tape file and the disk file (see procedure
close_file).
If a file system intrinsic returns an unsuccessful condition code,
procedure handle_file_error is called to print file information and then
abort the program.
Source code listing
Example A-1. Sequential Access
$standard_level 'hp3000'$
$lines 100$
$code_offsets on$
$tables on$
$list_code on$
program open_close_example(input,output);
{***********************************************************************}
{ DECLARATION PART }
{***********************************************************************}
const
ccg = 0; {Condition code warning }
ccl = 1; {Condition code error }
cce = 2; {Condition code successful }
update = 5; {HPFOPEN item value }
save_temp = 2; {HPFOPEN item value }
save_perm = 1; {HPFOPEN item value }
new = 0; {HPFOPEN item value }
permanent = 1; {HPFOPEN item value }
write = 1; {HPFOPEN item value }
type
pac256 = packed array [1..256] of char;
pac80 = packed array [1..80] of char;
status_type = record {HPFOPEN status variable type}
case integer of
0 : (info : shortint;
subsys : shortint);
1 : (all : integer);
end;
var
disk_file : integer;
tape_file : integer;
filename : pac80;
std_list : integer;
std_in : integer;
outbuf : pac80;
function FREAD: shortint; intrinsic; {Read from mag tape file }
procedure HPFOPEN; intrinsic; {Open tape, disk, $STDLIST files }
procedure FCLOSE; intrinsic; {Close tape and disk files }
procedure FWRITE; intrinsic; {Write to disk and $STDLIST files}
procedure PRINTFILEINFO; intrinsic; {If unsuccessful intrinsic call }
procedure QUIT; intrinsic; {If unsuccessful intrinsic call }
procedure handle_file_error
(
file_num : shortint;
quit_num : shortint
);
{************************************************************************}
{ procedure handle_file_error is invoked when a file system intrinsic }
{ returns and unsuccessful condition code. File information is printed }
{ to $STDLIST, then the program aborts. }
{************************************************************************}
begin
PRINTFILEINFO (file_num);
QUIT (quit_num);
end; {end procedure }
procedure open_unlabeled_tape_file
(
var file_num : integer
);
{************************************************************************}
{ procedure open_unlabeled_tape_file opens a permanent unlabeled mag }
{ tape file update access only. }
{************************************************************************}
const
{**define HPFOPEN item numbers **}
formal_designator_option = 2;
domain_option = 3;
access_type_option = 11;
device_class_optin = 42;
density_option = 24;
var
{**define HPFOPEN items ** }
file_name : pac80;
permanent,update,density : integer;
device_class : pac80;
status : status_type;
begin
file_name :='&tapefile&';
permanent := 3;
update := 5;
device_class := '&TAPE&';
density := 1600;
HPFOPEN (file_num, status, formal_designator_option, file_name,
domain_option, permanent,
access_type_option, update
device_class_option, device_class
density_option, density );
if status.all <> 0 then
handle_file_error (file_num, 1);
end; {end procedure }
procedure open_file
(
var file_num : integer;
file_name : pac80;
domain : integer;
access : integer
);
{************************************************************************}
{ procedure open_file acts as a generic file open procedure allowing }
{ you to specify the domain option and the access type option }
{************************************************************************}
const
{**define HPFOPEN item numbers**}
formal_designator_option = 2;
domain_option = 3;
access_type_option = 11;
ascii_binary_option = 53;
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);
if status.all <> 0 then
handle_file_error (file_num, 2);
end; {end procedure }
procedure copy_tapefile_to_discfile
(
tape_file : integer;
disk_file : integer
);
{************************************************************************}
{ procedure copy_tapefile_to_discfile copies logical records }
{ sequentially from tape file to disk file with concurrent print to }
{ stdlist. }
{************************************************************************}
var
inbuf : pac80;
end_of_file : boolean;
read_length : integer;
begin
end_of_file := false;
repeat
{**In a loop, do a simple sequential read from tape file to ***}
{**disk file. **}
read_length := FREAD (tape_file, inbuf, 80);
if ccode = ccl then
handle_file_error (tape_file, 3)
else
if ccode = ccg then
end_of_file := true
else
begin
FWRITE (std_list, inbuf, read_length, 0);
if ccode <> cce then
handle_file_error (std_list, 4);
FWRITE (disk_file, inbuf, read_length,0);
if ccode <> cce then
handle_file_error (disk_file, 5);
end
until end_of_file;
end; {end procedure }
procedure close_file
(
file_num : integer;
disp : integer
);
{************************************************************************}
{ procedure close_file is a generic file closing procedure that allows }
{ you to specify the final disposition of the file. }
{************************************************************************}
var
msgbuf : pac80;
begin
FCLOSE (file_num, disp, 0);
if ccode = ccl then
handle_file_error (file_num, 6);
end; {end procedure }
{************************************************************************}
{ MAIN PROGRAM }
{************************************************************************}
begin
open_unlabeled_tape_file (tape_file); { STEP 1 }
filename := '&$stdlist&'; { STEP 1 }
open_file (std_list, filename, permanent,write); { STEP 1 }
filename := '&dataone&'; { STEP 1 }
open_file (disk_file, filename, new,update); { STEP 1 }
copy_tapefile_to_discfile(tape_file,disk_file); { STEP 2 }
close_file(disk_file, save_temp); { STEP 3 }
close_file(tape_file, save_perm); { STEP 3 }
end. {end program }