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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55 debug
56
57
58 debug
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98 %page;
99
100 help:
101 procedure;
102
103 dcl (Iarg, Iarg_end_ca, Iarg_end_scn, Iarg_start_ca, Iarg_start_scn, Iarg_start_srh, Ipath)
104 fixed bin,
105 (Larg, Lop) fixed bin (21),
106 Nargs fixed bin,
107 Nctl_args fixed bin,
108 (Parg, Pop) ptr,
109 Serror bit (1),
110 Stopics bit (1),
111 Sstandalone_invocation
112 bit (1),
113 (cleanup, conversion, size)
114 condition,
115 code fixed bin (35),
116 error_type fixed bin,
117 j fixed bin,
118 sci_ptr ptr;
119
120 dcl arg char (Larg) based (Parg),
121 op char (Lop) based (Pop);
122
123 dcl (bin, convert, dim, index, maxlength, null, substr)
124 builtin;
125
126 dcl com_err_ entry options (variable),
127 cu_$arg_count entry (fixed bin, fixed bin (35)),
128 ssu_$abort_line
129 entry () options (variable),
130 ssu_$arg_count entry (ptr, fixed bin),
131 ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)),
132 ssu_$destroy_invocation
133 entry (ptr),
134 ssu_$get_subsystem_and_request_name
135 entry (ptr) returns (char (72) var),
136 ssu_$standalone_invocation
137 entry (ptr, char (*), char (*), ptr, entry, fixed bin (35));
138
139 dcl (
140 FALSE init ("0"b),
141 TRUE init ("1"b)
142 ) bit (1) aligned int static options (constant);
143
144
145 dcl (
146 ctl_abbrev (19) char (6) varying int static options (constant) init (
147 "-scn",
148 "-srh",
149 "-bf",
150 "-ca",
151 "-ep",
152 "-he",
153 "-bfhe",
154 "-pn",
155 "-a",
156 "-title",
157 "-topic",
158 "-lep",
159 "-cs",
160 "-ncs",
161 "-Info",
162 "-mln",
163 "-minln",
164 "-nv",
165 "-db"),
166 ctl_word (19) char (20) varying int static options (constant) init (
167 "-section",
168 "-search",
169 "-brief",
170 "-control_arg",
171 "-entry_point",
172 "-header",
173 "-brief_header",
174 "-pathname",
175 "-all",
176 "-titles",
177 "-topics",
178 "-list_entry_points",
179
180 "-case_sensitive",
181
182 "-non_case_sensitive",
183
184 "-info",
185 "-maxlines",
186 "-minlines",
187 "-no_video",
188 "-debug"),
189 ctl_obsolete (2) char (3) varying int static options (constant) init (
190 "-sc",
191 "-sh")
192 );
193
194
195 dcl (
196 error_table_$active_function,
197 error_table_$bad_arg,
198 error_table_$badopt,
199 error_table_$bigarg,
200 error_table_$inconsistent,
201 error_table_$noarg,
202 error_table_$noentry,
203 error_table_$unimplemented_version
204 ) fixed bin (35) ext static;
205 %page;
206 %include help_args_;
207 %page;
208
209
210
211 call cu_$arg_count (Nargs, code);
212 if code = error_table_$active_function then
213 do;
214 call com_err_ (code, "help");
215 return;
216 end;
217
218 Sstandalone_invocation = TRUE;
219 sci_ptr = null;
220 Phelp_args = null;
221 on cleanup call janitor ();
222
223 call ssu_$standalone_invocation (sci_ptr, "help", "1", null, abort_help_command, code);
224 if code ^= 0 then
225 do;
226 call com_err_ (code, "help", "Calling ssu_$standalone_invocation");
227 return;
228 end;
229 go to COMMON;
230
231 ssu_help_request:
232 entry (Asci_ptr, AStopics, find_subsystem_info_file);
233
234 dcl Asci_ptr ptr,
235 AStopics bit (1),
236 find_subsystem_info_file
237 entry (ptr, char (*)) returns (char (300) var);
238
239 sci_ptr = Asci_ptr;
240 AStopics = FALSE;
241 Sstandalone_invocation = FALSE;
242 Phelp_args = null;
243 on cleanup call janitor ();
244
245 COMMON:
246 call help_$init (ssu_$get_subsystem_and_request_name (sci_ptr), "info_segments", "", Vhelp_args_3, Phelp_args, code);
247 if Phelp_args = null then
248 go to ARG_STRUC_ERR;
249 if help_args.version ^= Vhelp_args_3 then
250 do;
251 code = error_table_$unimplemented_version;
252 go to ARG_STRUC_ERR;
253 end;
254 help_args.sci_ptr = sci_ptr;
255 %page;
256 call ssu_$arg_count (sci_ptr, Nargs);
257
258 Serror = FALSE;
259 Iarg_start_srh = Nargs + 1;
260 Iarg_start_ca = Nargs + 1;
261 Iarg_start_scn = Nargs + 1;
262 Iarg_end_ca = 0;
263 Iarg_end_scn = 0;
264 if Sstandalone_invocation then
265 help_args.Sctl.he_pn = TRUE;
266 help_args.Sctl.he_counts = TRUE;
267 Stopics = FALSE;
268 Nctl_args = 0;
269 do Iarg = 1 to Nargs;
270 call ssu_$arg_ptr (sci_ptr, Iarg, Parg, Larg);
271 if index (arg, "-") = 1 then
272 PROCESS_CONTROL_ARG:
273 do;
274 Nctl_args = Nctl_args + 1;
275 do j = 1 to dim (ctl_abbrev, 1) while (arg ^= ctl_abbrev (j));
276 end;
277 if j > dim (ctl_abbrev, 1) then
278 do;
279 do j = 1 to dim (ctl_word, 1) while (arg ^= ctl_word (j));
280 end;
281 if j > dim (ctl_word, 1) then
282 do;
283 do j = 1 to dim (ctl_obsolete, 1) while (arg ^= ctl_obsolete (j));
284 end;
285 if j > dim (ctl_obsolete, 1) then
286 do;
287 Serror = TRUE;
288 call ssu_$abort_line (sci_ptr, error_table_$badopt, arg);
289 go to NEXT_ARG;
290 end;
291 end;
292 end;
293 go to DO_ARG (j);
294 %page;
295 DO_ARG (1):
296 if Iarg = Nargs then
297 go to NO_OPERAND;
298 call ssu_$arg_ptr (sci_ptr, Iarg + 1, Pop, Lop);
299 if Lop >= 1 then
300 if substr (op, 1, 1) = "-" then
301 go to NO_OPERAND;
302 help_args.Sctl.scn = TRUE;
303 Iarg = Iarg + 1;
304 Iarg_start_scn = Iarg;
305 Iarg_end_scn = Iarg;
306 do Iarg = Iarg + 1 to Nargs;
307
308 call ssu_$arg_ptr (sci_ptr, Iarg, Pop, Lop);
309 if Lop >= 1 then
310 if substr (op, 1, 1) = "-" then
311 do;
312 Iarg = Iarg - 1;
313 go to NEXT_ARG;
314 end;
315 Iarg_end_scn = Iarg;
316 end;
317 go to NEXT_ARG;
318 %page;
319 DO_ARG (2):
320 if Iarg = Nargs then
321 go to NO_OPERAND;
322 help_args.Sctl.srh = TRUE;
323
324 Iarg_start_srh = Iarg + 1;
325 Iarg = Nargs;
326 go to NEXT_ARG;
327
328 DO_ARG (3):
329 help_args.Sctl.bf = TRUE;
330 go to NEXT_ARG;
331
332 DO_ARG (4):
333 if Iarg = Nargs then
334 go to NO_OPERAND;
335 Iarg = Iarg + 1;
336
337 Iarg_start_ca = Iarg;
338 Iarg_end_ca = Iarg;
339 help_args.Sctl.ca = TRUE;
340 do Iarg = Iarg + 1 to Nargs;
341 call ssu_$arg_ptr (sci_ptr, Iarg, Pop, Lop);
342 if Lop >= 1 then
343 if substr (op, 1, 1) = "-" then
344 do;
345 Iarg = Iarg - 1;
346 go to NEXT_ARG;
347 end;
348 Iarg_end_ca = Iarg;
349 end;
350 go to NEXT_ARG;
351 %page;
352 DO_ARG (5):
353 help_args.Sctl.ep = TRUE;
354 go to NEXT_ARG;
355
356 DO_ARG (6):
357 help_args.Sctl.he_only = TRUE;
358 go to NEXT_ARG;
359
360 DO_ARG (7):
361 help_args.Sctl.he_pn = FALSE;
362 go to NEXT_ARG;
363
364 DO_ARG (8):
365 if Iarg = Nargs then
366 go to NO_OPERAND;
367 Iarg = Iarg + 1;
368 call ssu_$arg_ptr (sci_ptr, Iarg, Pop, Lop);
369 j = 1;
370 if maxlength (help_args.path (j).value) < Lop then
371 do;
372 call ssu_$abort_line (sci_ptr, error_table_$bigarg, " ^a ^a", arg, op);
373 Serror = TRUE;
374 end;
375 else
376 do;
377 help_args.Npaths, j = help_args.Npaths + 1;
378 help_args.path (j).S = "0"b;
379 help_args.path (j).S.pn_ctl_arg = TRUE;
380 help_args.path (j).value = op;
381 help_args.path (j).info_name = "";
382 end;
383 go to NEXT_ARG;
384 %page;
385 DO_ARG (9):
386 help_args.Sctl.all = TRUE;
387 go to NEXT_ARG;
388
389 DO_ARG (10):
390 help_args.Sctl.title = TRUE;
391 go to NEXT_ARG;
392
393 DO_ARG (11):
394 Stopics = TRUE;
395 go to NEXT_ARG;
396
397
398
399
400 DO_ARG (12):
401 help_args.Sctl.lep = TRUE;
402 goto NEXT_ARG;
403
404 DO_ARG (13):
405 help_args.Sctl.cs = TRUE;
406 goto NEXT_ARG;
407
408 DO_ARG (14):
409 help_args.Sctl.cs = FALSE;
410 goto NEXT_ARG;
411
412 DO_ARG (15):
413 if Iarg = Nargs then
414 go to NO_OPERAND;
415 Iarg = Iarg + 1;
416 call ssu_$arg_ptr (sci_ptr, Iarg, Pop, Lop);
417 j = 1;
418 if maxlength (help_args.path (j).info_name) < Lop then
419 do;
420 call ssu_$abort_line (sci_ptr, error_table_$bigarg, " -info ^a", op);
421 Serror = TRUE;
422 end;
423 else
424 do;
425 j = help_args.Npaths;
426 if j = 0 then
427 call ssu_$abort_line (sci_ptr, error_table_$inconsistent, " -info must follow an info segment name.");
428 help_args.path (j).info_name = op;
429 if op = "?" then
430 help_args.path (j).info_name_not_starname = TRUE;
431 help_args.Sctl.he_info_name = TRUE;
432 end;
433 go to NEXT_ARG;
434
435 DO_ARG (16):
436 if Iarg = Nargs then
437 go to NO_OPERAND;
438 Iarg = Iarg + 1;
439 call ssu_$arg_ptr (sci_ptr, Iarg, Pop, Lop);
440 on conversion, size go to BAD_MAX_OPERAND;
441 help_args.max_Lpgh = convert (help_args.max_Lpgh, op);
442 revert conversion, size;
443 if help_args.max_Lpgh < 1 | help_args.max_Lpgh > 200 then
444 go to BAD_MAX_OPERAND;
445 go to NEXT_ARG;
446
447 DO_ARG (17):
448 if Iarg = Nargs then
449 go to NO_OPERAND;
450 Iarg = Iarg + 1;
451 call ssu_$arg_ptr (sci_ptr, Iarg, Pop, Lop);
452 on conversion, size go to BAD_MIN_OPERAND;
453 help_args.min_Lpgh = convert (help_args.min_Lpgh, op);
454 revert conversion, size;
455 if help_args.min_Lpgh < 1 | help_args.min_Lpgh > 50 then
456 go to BAD_MIN_OPERAND;
457 go to NEXT_ARG;
458
459 DO_ARG (18):
460 help_args.Sctl.no_video = TRUE;
461 goto NEXT_ARG;
462
463 DO_ARG (19):
464 help_args.Sctl.mbz1 = FALSE; debug
465 if Iarg = Nargs then
466 go to NO_OPERAND;
467 Iarg = Iarg + 1;
468 call ssu_$arg_ptr (sci_ptr, Iarg, Pop, Lop);
469 dcl db_op fixed bin(4) unsigned;
470 on conversion, size go to BAD_DB_OPERAND;
471 db_op = convert (db_op, op);
472 revert conversion, size;
473 if db_op < 0 | db_op > 15 then
474 go to BAD_DB_OPERAND;
475 help_args.pad2 (6) = db_op;
476 go to NEXT_ARG;
477
478 NO_OPERAND:
479 Serror = TRUE;
480 call ssu_$abort_line (sci_ptr, error_table_$noarg, "No operand given following ^a.", arg);
481 go to NEXT_ARG;
482
483 BAD_DB_OPERAND:
484 Serror = TRUE; debug
485 call ssu_$abort_line (sci_ptr, error_table_$bad_arg, " ^a ^a^/ Operand must be an integer from 0 to 15.", arg, op);
486 go to NEXT_ARG;
487
488 BAD_MAX_OPERAND:
489 Serror = TRUE;
490 call ssu_$abort_line (sci_ptr, error_table_$bad_arg, " ^a ^a^/Operand must be an integer from 1 to 200.", arg, op);
491 go to NEXT_ARG;
492
493 BAD_MIN_OPERAND:
494 Serror = TRUE;
495 call ssu_$abort_line (sci_ptr, error_table_$bad_arg, " ^a ^a^/Operand must be an integer from 1 to 50.", arg, op);
496 go to NEXT_ARG;
497
498 end PROCESS_CONTROL_ARG;
499 else
500 PROCESS_ONE_POSITIONAL_ARG:
501 do;
502 j = 1;
503 if maxlength (help_args.path (j).value) < Larg then
504 do;
505 call ssu_$abort_line (sci_ptr, error_table_$bigarg, " ^a", arg);
506 Serror = TRUE;
507 end;
508 else
509 do;
510 help_args.Npaths, j = help_args.Npaths + 1;
511 help_args.path (j).S = "0"b;
512 help_args.path (j).info_name = "";
513 if Sstandalone_invocation then
514 help_args.path (j).value = arg;
515 else help_args.path (j).value = find_subsystem_info_file (sci_ptr, arg);
516 end;
517 end PROCESS_ONE_POSITIONAL_ARG;
518 NEXT_ARG:
519 end;
520 %page;
521 if Stopics then
522 do;
523 if Nctl_args ^= 1 | help_args.Npaths ^= 0 then
524 call ssu_$abort_line (sci_ptr, error_table_$inconsistent, "-topics and any other arguments");
525 AStopics = TRUE;
526 go to RETURN;
527 end;
528
529 if help_args.Sctl.he_only then
530 if help_args.Sctl.title | help_args.Sctl.bf | help_args.Sctl.all | help_args.Sctl.ca | help_args.Sctl.lep
531 then
532 do;
533 Serror = TRUE;
534 call ssu_$abort_line (sci_ptr, error_table_$inconsistent, "
535 -header may not be given with: ^[ -brief^]^[ -title^]^[ -control_arg^]^[ -all^]^[ -lep^].", help_args.Sctl.bf,
536 help_args.Sctl.title, help_args.Sctl.ca, help_args.Sctl.all, help_args.Sctl.lep);
537 end;
538 if help_args.Sctl.cs then
539 if ^help_args.Sctl.srh & ^help_args.Sctl.scn & ^help_args.Sctl.ca then
540 do;
541 Serror = TRUE;
542 call ssu_$abort_line (sci_ptr, error_table_$inconsistent, "
543 ^[-cs^] may only be used with the -srh, -scn or -ca arguments.", help_args.Sctl.cs);
544 end;
545 if help_args.Sctl.lep then
546 if help_args.Sctl.srh | help_args.Sctl.scn then
547 do;
548 Serror = TRUE;
549 call ssu_$abort_line (sci_ptr, error_table_$inconsistent, "-lep may not be given with : ^[ -srh^]^[ -scn^].",
550 help_args.Sctl.srh, help_args.Sctl.scn);
551 end;
552 if help_args.Npaths = 0 then
553 do;
554 if Sstandalone_invocation then
555 do;
556 help_args.Npaths = 1;
557 help_args.path (1).value = "help_system.gi.info";
558
559 help_args.path (1).info_name = "";
560 help_args.path (1).S = "0"b;
561 end;
562 else call ssu_$abort_line (sci_ptr, error_table_$noarg, "One or more topic names.");
563 end;
564 %page;
565 do Iarg = Iarg_start_ca to Iarg_end_ca;
566
567 call ssu_$arg_ptr (sci_ptr, Iarg, Parg, Larg);
568 j = 1;
569 if maxlength (help_args.ca (j)) < Larg then
570 do;
571 Serror = TRUE;
572 call ssu_$abort_line (sci_ptr, error_table_$bigarg, " -ca ^a
573 Maximum length is ^d characters.", arg, maxlength (help_args.ca (j)));
574 end;
575 else
576 do;
577 help_args.Ncas, j = help_args.Ncas + 1;
578 help_args.ca (j) = arg;
579 end;
580 end;
581 do Iarg = Iarg_start_scn to Iarg_end_scn;
582
583 call ssu_$arg_ptr (sci_ptr, Iarg, Parg, Larg);
584 j = 1;
585 if maxlength (help_args.scn (j)) < Larg then
586 do;
587 Serror = TRUE;
588 call ssu_$abort_line (sci_ptr, error_table_$bigarg, " -scn ^a
589 Maximum length is ^d characters.", arg, maxlength (help_args.scn (j)));
590 end;
591 else
592 do;
593 help_args.Nscns, j = help_args.Nscns + 1;
594 help_args.scn (j) = arg;
595 end;
596 end;
597 do Iarg = Iarg_start_srh to Nargs;
598 call ssu_$arg_ptr (sci_ptr, Iarg, Parg, Larg);
599 j = 1;
600 if maxlength (help_args.srh (j)) < Larg then
601 do;
602 Serror = TRUE;
603 call ssu_$abort_line (sci_ptr, error_table_$bigarg, " -srh ^a
604 Maximum length is ^d characters.", arg, maxlength (help_args.srh (j)));
605 end;
606 else
607 do;
608 help_args.Nsrhs, j = help_args.Nsrhs + 1;
609 help_args.srh (j) = arg;
610 end;
611 end;
612 if Serror then
613 goto RETURN;
614
615 call help_ (ssu_$get_subsystem_and_request_name (sci_ptr), Phelp_args, "info", error_type, code);
616 go to ERROR (error_type);
617 %page;
618 ARG_STRUC_ERR:
619 ERROR (1):
620 ERROR (2):
621 call ssu_$abort_line (sci_ptr, code, "^/Processing the argument structure used by help_.");
622 goto RETURN;
623
624 ERROR (3):
625
626 do Ipath = 1 to help_args.Npaths;
627 if help_args.path (Ipath).code ^= 0 then
628 call ssu_$abort_line (sci_ptr, help_args.path (Ipath).code, " ^[-pn ^]^a", help_args.path (Ipath).S.pn_ctl_arg,
629 help_args.path (Ipath).value);
630 end;
631 goto RETURN;
632
633 ERROR (5):
634
635
636
637 if code ^= 0 then
638 call ssu_$abort_line (sci_ptr, error_table_$noentry,
639 "
640 Looking for infos matching info_name^[s^]^[^; and -search criteria^; and -section criteria^;"
641 || ", plus -section and -search criteria^].", (help_args.Npaths > 1),
642 (1 + 2 * bin (help_args.Sctl.scn, 1) + bin (help_args.Sctl.srh, 1)));
643
644 ERROR (4):
645 RETURN:
646 call janitor ();
647 return;
648
649
650
651
652 abort_help_command:
653 procedure ();
654
655 go to RETURN;
656
657 end abort_help_command;
658
659
660
661
662 janitor:
663 procedure;
664
665 dcl Acode fixed bin (35);
666
667 if Phelp_args ^= null then
668 call help_$term (ssu_$get_subsystem_and_request_name (sci_ptr), Phelp_args, Acode);
669 if Sstandalone_invocation then
670 call ssu_$destroy_invocation (sci_ptr);
671
672 end janitor;
673
674
675
676 end help;