1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30 check_mst:
31 ckm:
32 procedure;
33
34 dcl (
35 error_table_$noarg,
36 error_table_$inconsistent,
37 error_table_$too_many_args,
38 error_table_$badopt,
39 error_table_$bad_conversion,
40 error_table_$bad_arg
41 ) ext static fixed bin (35);
42
43 dcl density fixed bin;
44 dcl thing_name char (168);
45 dcl filename char (168);
46 dcl code fixed bin (35);
47 dcl (file, positional, tape)
48 bit (1) aligned;
49 dcl ap pointer;
50 dcl al fixed bin (21);
51 dcl argument char (al) based (ap);
52 dcl argx fixed bin;
53 dcl n_args fixed bin;
54
55 dcl (addr, before, binary, char, fixed, null, string)
56 builtin;
57
58 dcl (get_temp_segments_, release_temp_segments_)
59 entry (char (*), dim (*) ptr, fixed bin (35));
60 dcl ioa_ entry options (variable);
61 dcl checker_print_$init entry;
62 dcl define_area_ entry (ptr, fixed bin (35));
63 dcl pathname_ entry (char (*), char (*)) returns (char (168));
64 dcl tape_reader_$init entry (char (*), char (*), fixed bin, bit (1) aligned, fixed bin (35));
65 dcl tape_reader_$final entry;
66 dcl com_err_ entry options (variable);
67 dcl cu_$arg_count entry entry (fixed bin, fixed bin (35));
68 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
69 dcl expand_pathname_$add_suffix
70 entry (char (*), char (*), char (*), char (*), fixed bin (35));
71 dcl get_wdir_ entry returns (char (168));
72
73 dcl checker_init_meters_ entry;
74 dcl checker_load_MST_ entry;
75 dcl checker_crossref_ entry;
76
77 dcl sslt_manager_$init entry (ptr);
78 dcl sslt_init_ entry (ptr, ptr);
79
80 dcl cleanup condition;
81 dcl checker_fatal_error_ condition;
82 dcl conversion condition;
83 %page;
84 %include iox_modes;
85 %page;
86 %include iox_entries;
87 %page;
88 %include area_info;
89 dcl 1 AI aligned like area_info;
90
91 %page;
92 %include checker_dcls_;
93
94 dcl sys_info$max_seg_size fixed bin (35) ext;
95
96 dcl ME char (32) init ("check_mst") int static options (constant);
97 ^L
98
99 call cu_$arg_count (n_args, code);
100 if code ^= 0
101 then do;
102 call com_err_ (code, ME);
103 return;
104 end;
105
106 thing_name = "";
107 positional = "0"b;
108 file = "0"b;
109 tape = "0"b;
110 density = 0;
111 checker_data_$severity = 0;
112
113 do argx = 1 to n_args;
114 call cu_$arg_ptr (argx, ap, al, (0));
115 if char (argument, 1) ^= "-"
116 then do;
117 if positional
118 then do;
119 call com_err_ (error_table_$too_many_args, ME,
120 "Only one MST may be supplied. ^a cannot be processed.", argument);
121 return;
122 end;
123 positional = "1"b;
124 thing_name = argument;
125 end;
126 else if argument = "-severity" | argument = "-sv"
127 then do;
128 if argx = n_args
129 then do;
130 call com_err_ (error_table_$noarg, ME,
131 "-severity must be followed by a severity number.");
132 return;
133 end;
134 on conversion
135 begin;
136 call com_err_ (error_table_$bad_conversion, ME, "Invalid severity number ^a.",
137 argument);
138 go to RETURN;
139 end;
140 argx = argx + 1;
141 call cu_$arg_ptr (argx, ap, al, (0));
142 checker_data_$severity = fixed (argument);
143 revert conversion;
144 if checker_data_$severity > 4 | checker_data_$severity < 0
145 then do;
146 call com_err_ (error_table_$bad_arg, ME,
147 "-severity must be followed by N, for 0 <= N <= 4.");
148 return;
149 end;
150 end;
151 else if argument = "-tape"
152 then do;
153 if file | tape
154 then
155 DUP_INPUT:
156 do;
157 call com_err_ (error_table_$inconsistent, ME,
158 "-tape and -file may not both be specified.");
159 return;
160 end;
161 tape = "1"b;
162 end;
163 else if argument = "-file"
164 then do;
165 if file | tape
166 then goto DUP_INPUT;
167 file = "1"b;
168 end;
169 else if argument = "-density" | argument = "-den"
170 then do;
171 if argx = n_args
172 then do;
173 call com_err_ (error_table_$noarg, ME, "-density must be followed by a density.");
174 return;
175 end;
176 argx = argx + 1;
177 call cu_$arg_ptr (argx, ap, al, (0));
178 if char (argument, 1) = "-"
179 then do;
180 call com_err_ (error_table_$noarg, ME,
181 "-density must be followed by a density, but a control argument, ^a, was found.",
182 argument);
183 return;
184 end;
185 on conversion
186 begin;
187 call com_err_ (error_table_$bad_conversion, ME, "^a is not a valid density.", argument)
188 ;
189 go to RETURN;
190 end;
191
192 density = binary (argument);
193 revert conversion;
194 end;
195
196 else do;
197 call com_err_ (error_table_$badopt, ME, "Unrecognized control argument ^a", argument);
198 RETURN:
199 return;
200 end;
201 end;
202
203 if ^file & ^tape
204 then tape = "1"b;
205 if thing_name = ""
206 then do;
207 call com_err_ (error_table_$noarg, ME, "No input specified.");
208 return;
209 end;
210
211 if file & density ^= 0
212 then do;
213 call com_err_ (error_table_$inconsistent, ME, "-density may not be specified with -file.");
214 return;
215 end;
216
217 thing_name = before (thing_name, ",");
218
219 checker_data_$temp_ptrs (*) = null ();
220 checker_data_$input_iocbp, checker_data_$output_iocbp = null;
221 on cleanup call clean_up;
222
223 call get_temp_segments_ (ME, checker_data_$temp_ptrs, code);
224 if code ^= 0
225 then do;
226 call com_err_ (code, ME, "No temp segs to be had.");
227 go to EXIT;
228 end;
229
230 call tape_reader_$init (ME, thing_name, density, file, code);
231 if code ^= 0
232 then go to EXIT;
233
234 AI.version = area_info_version_1;
235 AI.owner = "check_mst";
236 AI.size = sys_info$max_seg_size;
237 AI.areap = checker_data_$area_ptr;
238 string (AI.control) = ""b;
239 AI.no_freeing = "1"b;
240 AI.extend = "1"b;
241
242 call define_area_ (addr (AI), code);
243 if code ^= 0
244 then do;
245 call com_err_ (code, "check_mst", "Could not define def area.");
246 go to EXIT;
247 end;
248
249 call expand_pathname_$add_suffix (thing_name, "ckrout", (""), filename, code);
250 filename = pathname_ (get_wdir_ (), (filename));
251
252 call iox_$attach_name ("checker_output_", checker_data_$output_iocbp, "vfile_ " || filename, null (), code);
253 if code ^= 0
254 then do;
255 outerr:
256 call com_err_ (code, "check_mst", "checker output file");
257 go to EXIT;
258 end;
259 call iox_$open (checker_data_$output_iocbp, Stream_output, "0"b, code);
260 if code ^= 0
261 then go to outerr;
262
263
264
265 call ioa_ ("Begin checker");
266
267 call checker_init_meters_;
268 call checker_print_$init;
269
270 call sslt_init_ (checker_data_$slt_ptr, checker_data_$name_table_ptr);
271 call sslt_manager_$init (checker_data_$slt_ptr);
272
273 on checker_fatal_error_
274 begin;
275 call com_err_ (0, ME, "Fatal error. Checker run aborted.");
276 go to EXIT;
277 end;
278
279 call checker_load_MST_;
280
281 call checker_crossref_;
282
283 call tape_reader_$final;
284
285 call ioa_ ("End checker");
286
287 EXIT:
288 call clean_up;
289
290 return;
291 ^L
292
293 clean_up:
294 proc;
295
296
297 if checker_data_$temp_ptrs (1) ^= null ()
298 then call release_temp_segments_ (ME, checker_data_$temp_ptrs, code);
299 checker_data_$temp_ptrs (*) = null;
300
301 call tape_reader_$final ();
302
303 if checker_data_$output_iocbp ^= null
304 then do;
305 call iox_$close (checker_data_$output_iocbp, code);
306 call iox_$detach_iocb (checker_data_$output_iocbp, code);
307 checker_data_$output_iocbp = null;
308 end;
309
310 return;
311 end;
312
313 end check_mst;