HP 3000 Manuals HP 3000 Manuals
Appendix A Global RIN Program Example
This HP Pascal/XL program illustrates how you can use the two intrinsics,
LOCKGLORIN and UNLOCKGLORIN, to prevent simultaneous access to a selected
record in a shared file while one user is updating the record. Five
global RINs were previously acquired through the :GETRIN command. Each
RIN is associated with a subset of 4 records in a 20 record data file.
This method of assigning RINs allows other users to concurrently access
other subsets of records in the same file. RIN-locking occurs in
procedure access_record_exclusively. This program is intended to be used
with the file BOOKFILE (illustrated in Chapter 2).
program global_RIN_example;
{*********************************************************************}
{ DECLARATION PART }
{*********************************************************************}
const
rinbase = 1; {Lowest RIN assigned }
recds_per_rin = 4; {Partition the datafile }
maxrin = 5; {Highest RIN assigned }
CCG = 0; {Condition Code Warning }
CCL = 1; {Condition Code Error }
CCE = 2; {Condition Code successful }
maxbooks =19; {Last record in datafile }
type {holds titles and locations }
record_field = packed array [1..36] of char;
{record structure of datafile }
library_record = packed record
title: record_field; {Holds book title }
location: record_field; {Holds book location }
end;
hp_status = packed record
case integer of
0: (all:integer);
1: (info:shortint; {Error number from subsys }
subsys: shortint); {Subsystem number }
end;
var
stdin,stdlist,booklist: integer; {HPFOPEN file numbers }
ascii,perm,rw,share,cctl:integer; {HPFOPEN item variables }
status: hp_status; {HPFOPEN intrinsic status }
length,accno,rin: shortint; {Vars required by intrinsics }
lockflag: 0..65565; {Required by lock intrinsics }
bookrecord: library_record; {Used in read/write operations}
dummy: boolean; {Required by FCONTROL }
infile,outfile,datafile, {File names used with HPFOPEN }
{Required by LOCKGLORIN }
rinpassword: packed array [1..12] of char;
{vars required by intrinsics }
buffer,change,head,request: record_field;
procedure hpfopen; intrinsic; {Opens three files }
function fread:shortint; intrinsic; {Reads from $STDIN }
procedure fwrite; intrinsic; {Writes to $STDLIST }
procedure fcontrol; intrinsic; {Post to disc }
procedure freaddir; intrinsic; {Random reads from datafile }
procedure fwritedir; intrinsic; {Random writes to datafile }
procedure lockglorin; intrinsic; {RIN-locking intrinsic }
procedure unlockglorin; intrinsic; {RIN-unlocking intrinsic }
function binary:shortint; intrinsic; {Convert ASCII to binary }
procedure printfileinfo; intrinsic; {Used in Error Handler }
procedure quit; intrinsic; {Used in Error Handler }
procedure error_handler(filenum,quitnum: shortint);
{*********************************************************************}
{ procedure error_handler is invoked whenever a system intrinsic }
{ call is unsuccessful. }
{*********************************************************************}
begin
{If valid file number, then }
{print file info to $STDLIST }
if filenum >=0 then printfileinfo(filenum);
quit(quitnum); {Abort process }
end;
procedure initialize_variables;
{*********************************************************************}
{ procedure initialize_variables initializes all global variables }
{ prior to use. }
{*********************************************************************}
begin
infile:= ' $stdin '; {associated with $STDIN }
outfile:= ' $stdlist '; {associated with $STDLIST }
datafile:= ' bookfile '; {formaldesignator = BOOKFILE }
lockflag:= 1;
rinpassword:= 'bookrin ';
dummy:= true;
status.all:= 0;
ascii := 1; {ascii/binary option ASCII }
perm := 1; {domain option PERMANENT }
rw := 4; {access type option READ/WRITE}
share := 3; {exclusive option SHARE }
cctl := 1; {carriage control option CCTL }
stdin := 0;
stdlist := 0;
booklist := 0;
head:= 'LIBRARY INFORMATION PROGRAM '; {Header introduces program }
change:= 'NEW LOCATION '; {User interface }
request:= 'ACCESSION NO: '; {User interface }
end;
procedure open_files;
{*********************************************************************}
{ procedure open_files opens all files used by program. }
{*********************************************************************}
begin
hpfopen(stdin,status,2,infile,3,perm,53,ascii); {Open $STDIN }
if status.all <> 0 then error_handler(-1, status.info);
hpfopen(stdlist,status,2,outfile,3,perm,
7,cctl,53,ascii); {Open $STDLIST }
if status.all <> 0 then error_handler(-1, status.info);
hpfopen(booklist,status,2,datafile,
3,perm,53,ascii,11,rw,13,share); {Open datafile }
if status.all <> 0 then error_handler(-1, status.info);
end;
procedure select_record(var record_length: shortint;
var book_number: record_field);
{*********************************************************************}
{ procedure select_record allows user to select the bookrecord for }
{ viewing and updating. }
{*********************************************************************}
begin
fwrite(stdlist,request,7,208); {Ask user for Book number }
if ccode <> CCE then error_handler(stdlist,101);
record_length:= fread(stdin,buffer ,-10); {Read user input }
if ccode <> CCE then error_handler(stdin,102);
end;
procedure update_record;
{*********************************************************************}
{ procedure update_record prints the selected book record to $STDLIST,}
{ prompts user for new location, then reads the input from $STDIN. If }
{ user supplies a location, record is updated, then posted to disc. }
{*********************************************************************}
begin
fwrite(stdlist,bookrecord,-72,0); {Print selected bookrecord }
if ccode <> CCE then error_handler(stdlist,105);
fwrite(stdlist,change,-14,208); {Prompt user for new location }
if ccode <> CCE then error_handler(stdlist,106);
buffer:= ' '; {Clear variable }
length:= fread(stdin,buffer,-36); {Read user-input new location }
if ccode <> CCE then error_handler(stdin,107);
{If user input characters, }
{update record in datafile }
if length > 0 then
begin
bookrecord.location:= buffer; {Update location field }
fwritedir(booklist,bookrecord,-72,accno); {Update datafile }
if ccode <> CCE then error_handler(booklist,108);
fcontrol(booklist,2,dummy); {Force posting to disc }
if ccode <> CCE then error_handler (booklist,109);
end;
end;
procedure access_record_exclusively(rinnum:shortint);
{*********************************************************************}
{ procedure access_record_exclusively locks the global rin associated }
{ with the selected bookrecord. While the RIN is locked, others }
{ attempting to lock the same RIN are denied. While RIN is locked, }
{ the user-selected book record is read from the datafile, then }
{ PROCEDURE update_record is invoked to update the location field of }
{ the bookrecord. After successful update, RIN is unlocked. }
{*********************************************************************}
begin
lockglorin(rinnum,lockflag,rinpassword); {Lock global RIN }
if ccode <> CCE then error_handler(-1,103);
freaddir(booklist,bookrecord,-72,accno); {Read selected bookrecord }
if ccode = CCL then error_handler(booklist,104) else
if ccode = CCE then update_record; {Call PROCEDURE update_record }
unlockglorin(rinnum); {Unlock global RIN }
if ccode <> CCE then error_handler(-1, 110);
end;
procedure update_book_information;
{*********************************************************************}
{ procedure update_book_information is the main outer-block procedure.}
{*********************************************************************}
begin
fwrite(stdlist,head,14,0); {Print program intro to $STDLIST }
if ccode <> CCE then error_handler(stdlist,4);
select_record(length,buffer); {Call record selection procedure }
while length <> 0 do
{Continue loop so long as user }
{selects a bookrecord to update. }
begin
accno:= binary(buffer,length); {Converts ascii to shortint }
if ccode <> CCE then error_handler(-1,112) else
begin {If accno is successfully converted,}
{use it to compute RIN. }
rin:= rinbase + (accno div recds_per_rin);
{If computed RIN one of those from }
{:GETRIN, call PROCEDURE to access }
{the selected record exclusively. }
if rin in [rinbase..maxrin]
then access_record_exclusively(rin);
end;
select_record(length,buffer); {Select another record, loop }
end; {Loop }
end;
{*********************************************************************}
{ MAIN PROGRAM PART }
{*********************************************************************}
begin
initialize_variables;
open_files;
update_book_information;
end.