Appendix A Pascal/XL Program Examples
MPE documents | |
 Complete PDF | |
| Table of Contents | |
| Index | |
| E0300 Edition 6 ♥ | |
| E0692 Edition 5 |
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.
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).
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.
Close (FCLOSE) the tape file and the disk file (see procedure close_file).
$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 }
|
Displaying File Error Information |
Program Example A-2 |