All:
I finally resolved all the syntax errors and logic errors in this
subroutine.
Its purpose was to pass a file name (Image db name) to the routine and it
would load a table of entries (200 max) showing all those processes
(sessions and jobs) accessing the file.
It finally works.
I want to thank Stan @ Allegro for his invaluable assistance in helping me
solve this problem. Now I understand a bit more about AIF's and Pascal :-)
I am listing the final working source code on the HP3000-L list here in
case anyone is interested in it.
Thanks,
Brian Donaldson.
$standard_level 'hp_modcal'$
$optimize on$
$global$
$assume 'LOCAL_GOTOS_ONLY'$
$assume 'LOCAL_ESCAPES_ONLY'$
$assume 'NO_HEAP_CHANGES'$
$SUBPROGRAM 'get_accessors'$
program get_accessors(input,output);
type
bit2 = 0..3;
bit14 = 0..16383;
cipin_array = packed array [1..200] of integer;
filename_type = record
filename: packed array[1..16] of char;
group : packed array[1..16] of char;
account : packed array[1..16] of char;
end;
inp_array = packed array [1..200] of integer;
jsdev_type = record
device_class :boolean;
output_device:integer;
end;
jsid_array = array [1..200] of shortint;
jsmain_array = packed array [1..200] of integer;
jsnum_type = packed record
js_type : bit2;
js_num : bit14;
js_ext : shortint;
end;
longint_type = record
left : integer;
right : integer;
end;
out_array = packed array [1..200] of jsdev_type;
pac8 = string[8];
pac10 = string[10];
pins_array = packed array [1..200] of integer;
jname_array = array [1..200] of pac8;
jnum_array = array [1..200] of integer;
status_type = record
case boolean of
true : (all :integer);
false : (info :shortint;
subsys:shortint);
end;
status_2_type = array [1..16] of status_type;
UFID_type = record
ufid: packed array[1..200] of char;
end;
const
init_item_status_array=status_2_type
[16 of status_type [info :0,
subsys:0]];
var
aif_area : integer;
count_1 : integer;
item_array : packed array [1..16] of globalanyptr;
item_num_array : packed array [1..16] of integer;
item_status_array: status_2_type;
job_session_no : jsnum_type;
max_pids : integer;
overall_status : status_type;
pid_array_1 : packed array [1..1023] of longint_type;
pid_array_2 : packed array [1..1023] of longint_type;
stop_flag : shortint;
ufid : UFID_type;
$sysintr 'sysintr.pub.sys'$
$sysintr 'aifintr.pub.sys'$
procedure AIFFILEGGET ; intrinsic;
procedure AIFJSGET ; intrinsic;
procedure AIFPROCGET ; intrinsic;
procedure AIFSYSWIDEGET; intrinsic;
PROCEDURE get_accessors(var overall_status:status_type;
var proc_no :shortint;
var file_name :filename_type;
var user_count :integer;
var reader_count :integer;
var writer_count :integer;
var job_name :jname_array;
var user_name :jname_array;
var acct_name :jname_array;
var group_name :jname_array;
var pins :pins_array;
var input_device :inp_array;
var output_device :out_array;
var jsmain_pin :jsmain_array;
var ci_pin :cipin_array;
var js_id :jsid_array;
var job_number :jnum_array;
var start_date :jnum_array;
var start_time :jnum_array);
label 999;
begin
overall_status.all := 0;
proc_no := 0;
count_1 := 0;
item_num_array[1] := 5001;
item_num_array[2] := 5025;
item_num_array[3] := 5026;
item_num_array[4] := 5027;
item_num_array[5] := 5002;
item_num_array[6] := 0;
item_array [1] := addr(file_name);
item_array [2] := addr(user_count);
item_array [3] := addr(reader_count);
item_array [4] := addr(writer_count);
item_array [5] := addr(ufid);
item_status_array := init_item_status_array;
proc_no := 1;
AIFFILEGGET(overall_status,
item_num_array,
item_array,
item_status_array,
,
file_name);
if overall_status.all <> 0 then
goto 999;
overall_status.all := 0;
stop_flag := 0;
aif_area := 2000;
max_pids := 1023;
item_num_array[1] := 2065;
item_num_array[2] := 0;
item_array[1] := addr(ufid);
item_status_array := init_item_status_array;
proc_no := 2;
AIFSYSWIDEGET(overall_status,
aif_area,
pid_array_1,
pid_array_2,
max_pids,
item_num_array,
item_array,
item_status_array);
if overall_status.all <> 0 then
goto 999;
if (pid_array_1[1].left=0) and (pid_array_1[1].right=0) then
begin
max_pids :=0;
stop_flag:=1;
goto 999;
end;
count_1:=1;
repeat
item_num_array[1] := 2015;
item_num_array[2] := 2002;
item_num_array[3] := 0;
item_array [1] := addr(job_session_no);
item_array [2] := addr(pins[count_1]);
item_status_array := init_item_status_array;
overall_status.all:= 0;
proc_no := 3;
AIFPROCGET(overall_status,
item_num_array,
item_array,
item_status_array,,
pid_array_1[count_1]);
if overall_status.all = 0 then
begin
js_id [count_1]:=job_session_no.js_type;
job_number[count_1]:=job_session_no.js_num;
item_num_array[1] := 1001;
item_num_array[2] := 1009;
item_num_array[3] := 1011;
item_num_array[4] := 1010;
item_num_array[5] := 1012;
item_num_array[6] := 1013;
item_num_array[7] := 1014;
item_num_array[8] := 1015;
item_num_array[9] := 1017;
item_num_array[10] := 1018;
item_num_array[11] := 0;
item_array [1] := addr(job_name [count_1]);
item_array [2] := addr(user_name [count_1]);
item_array [3] := addr(acct_name [count_1]);
item_array [4] := addr(group_name [count_1]);
item_array [5] := addr(input_device [count_1]);
item_array [6] := addr(output_device[count_1]);
item_array [7] := addr(start_date [count_1]);
item_array [8] := addr(start_time [count_1]);
item_array [9] := addr(jsmain_pin [count_1]);
item_array [10] := addr(ci_pin [count_1]);
item_status_array := init_item_status_array;
proc_no := 4;
AIFJSGET(overall_status,
item_num_array,
item_array,
item_status_array,
job_session_no);
if overall_status.all <> 0 then
stop_flag:=1;
end
else
stop_flag:=1;
count_1:=count_1 + 1;
until (count_1 > max_pids) or (stop_flag = 1);
if stop_flag <> 0 then
goto 999;
999:
end;
begin
end.
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
|
