1
2
3
4
5
6
7
8
9
10
11 getonsource: proc() returns(char(*)) options(support);
12
13 %include on_data_;
14
15
16 return(ondata_$onsource);
17
18 get_onfield: entry() returns(char(*));
19
20 return(ondata_$datafield);
21
22 get_onfile: entry() returns(char(*));
23
24 return(ondata_$onfile);
25
26 get_onkey: entry() returns(char(*));
27
28 return(ondata_$onkey);
29
30
31 get_onloc: entry() returns(char(*));
32
33
34 dcl i fixed bin;
35 dcl segno fixed bin(18);
36 dcl code fixed bin(35);
37
38 dcl spno bit(18) aligned;
39
40 dcl ename char(256) aligned;
41 dcl lang char(8) aligned;
42
43 dcl nsp ptr;
44
45 dcl (baseno, addr, null, index, substr) builtin;
46 dcl find_condition_info_ entry(ptr, ptr, fixed bin(35));
47 dcl find_condition_frame_ entry(ptr) returns(ptr);
48 dcl get_entry_name_ entry(ptr, char(*) aligned, fixed bin(18), char(8) aligned, fixed bin(35));
49 dcl error_table_$begin_block fixed bin(35) external;
50
51 %include condition_info;
52 declare 1 CI aligned like condition_info;
53
54 %include pl1_info;
55 %include condition_info_header;
56
57
58
59 %include stack_frame;
60
61
62
63
64
65
66
67 sp = find_condition_frame_(null);
68 if sp = null then return ("");
69
70 call find_condition_info_(sp, addr(CI), code);
71 if code ^= 0 then return ("");
72
73 nsp = sp;
74 if CI.loc_ptr ^= CI.user_loc_ptr then do;
75 spno = baseno (sp);
76 do while (baseno(nsp -> stack_frame.prev_sp) = spno);
77 nsp = nsp -> stack_frame.prev_sp;
78 if ^nsp -> stack_frame_flags.support then go to get_name;
79 end;
80 nsp = sp;
81 end;
82
83 get_name:
84 call get_entry_name_(nsp -> stack_frame.entry_ptr, ename, segno, lang, code);
85 if code ^= 0 then if code = error_table_$begin_block
86 then do;
87 nsp = nsp -> stack_frame.prev_sp;
88 go to get_name;
89 end;
90 else ename = " ";
91 i = index(ename, " ") - 1;
92 if i = -1 then i = 0;
93
94 return (substr(ename, 1, i));
95
96 end;