1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 linus_retrieve:
20 proc (lcb_ptr, ca_ptr, char_ptr, al_ptr, e_ptr, icode);
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40 debug
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62 ^L
63 %include linus_lcb;
64 %page;
65 %include linus_char_argl;
66 %page;
67 %include linus_arg_list;
68 %page;
69 %include linus_select_info;
70 %page;
71 %include mdbm_arg_list;
72 ^L
73
74 dcl 1 arg_len_bits based,
75 2 pad bit (12) unal,
76 2 length bit (24);
77
78 dcl debug_switch bit (1) int static init ("0"b);
79
80 dcl icode fixed bin (35);
81
82 dcl (desc, l, loop) fixed bin;
83
84 dcl initial_vclock float bin (63);
85
86 dcl (addr, addrel, fixed, null, rel, vclock) builtin;
87
88 dcl (
89 e_ptr,
90 env_ptr init (null),
91 temp_ptr init (null)
92 ) ptr;
93
94 dcl ANOTHER char (8) init ("-another") int static options (constant);
95 dcl ANOTHER_LEN bit (24) init ("000000000000000000001000"b) int static
96 options (constant);
97 dcl ANOTHER_PTR ptr init (null) int static;
98
99 dcl cu_$generate_call entry (entry, ptr);
100 dcl dsl_$retrieve entry options (variable);
101 dcl ioa_ entry options (variable);
102 dcl mdb_display_data_value$ptr entry (ptr, ptr);
103 dcl mdbm_util_$varying_data_class entry (ptr) returns (bit (1) aligned);
104 dcl sys_info$max_seg_size fixed bin (35) ext;
105 dcl work_area area (sys_info$max_seg_size) based (lcb.linus_area_ptr);
106 ^L
107
108
109
110
111 if ANOTHER_PTR = null then
112 ANOTHER_PTR = addr (ANOTHER);
113
114 si_ptr = lcb.si_ptr;
115 desc = select_info.n_mrds_items + 3 + select_info.nsevals;
116
117 if al_ptr = null then do;
118 num_ptrs = desc * 2;
119 allocate arg_list in (work_area);
120 arg_list.arg_des_ptr (desc) = addr (icode);
121 if char_ptr = null then do;
122 n_chars_init = 1;
123 allocate char_desc in (work_area);
124 end;
125 arg_list.arg_des_ptr (num_ptrs) = addr (char_desc.fb_desc);
126
127 arg_list.arg_des_ptr (1) = addr (lcb.db_index);
128 arg_list.arg_des_ptr (desc + 1) = addr (char_desc.fb_desc);
129
130 arg_list.arg_count, arg_list.desc_count = num_ptrs;
131 arg_list.code = 4;
132 arg_list.pad = 0;
133
134
135 char_desc.arr.var (1) =
136 addr (select_info.se_len) -> arg_len_bits.length;
137 arg_list.arg_des_ptr (2) = select_info.se_ptr;
138 arg_list.arg_des_ptr (desc + 2) = addr (char_desc.arr (1));
139 if select_info.nsevals ^= 0 then
140 do l = 1 to select_info.nsevals;
141 arg_list.arg_des_ptr (2 + l) = select_info.se_vals.arg_ptr (l);
142 arg_list.arg_des_ptr (2 + desc + l) =
143 select_info.se_vals.desc_ptr (l);
144 end;
145 l = 1;
146 do loop = 3 + select_info.nsevals
147 to 2 + select_info.n_mrds_items + select_info.nsevals;
148
149 arg_list.arg_des_ptr (loop) = select_info.mrds_item.arg_ptr (l);
150 arg_list.arg_des_ptr (desc + loop) =
151 addr (select_info.mrds_item.desc (l));
152 if mdbm_util_$varying_data_class (
153 addr (select_info.mrds_item.desc (l))) then do;
154 temp_ptr = select_info.mrds_item.arg_ptr (l);
155 arg_list.arg_des_ptr (loop) = addrel (temp_ptr, 1);
156 end;
157 l = l + 1;
158 end;
159 end;
160
161 if debug_switch then do;
162 call ioa_ ("Selection expression:");
163 call
164 mdb_display_data_value$ptr (select_info.se_ptr,
165 addr (char_desc.arr (1)));
166 end;
167
168 if lcb.timing_mode then
169 initial_vclock = vclock;
170
171 call cu_$generate_call (dsl_$retrieve, al_ptr);
172
173 if lcb.timing_mode then
174 lcb.mrds_time = lcb.mrds_time + vclock - initial_vclock;
175
176
177
178 if arg_list.arg_des_ptr (2) ^= ANOTHER_PTR then do;
179 arg_list.arg_des_ptr (2) = ANOTHER_PTR;
180 char_desc.arr (1).var = ANOTHER_LEN;
181 end;
182
183 return;
184 ^L
185 db_on:
186 entry;
187
188
189
190
191
192
193
194
195 debug_switch = "1"b;
196 return;
197 ^K
198 db_off:
199 entry;
200
201
202
203
204
205
206
207
208 debug_switch = "0"b;
209 return;
210
211 end linus_retrieve;