1
2
3
4
5
6 gcos: gc: proc;
7
8
9
10
11
12
13
14
15
16
17
18 %page;
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 %page;
51
52 me = "gcos (4.0)";
53 goto gcos_common;
54
55 spawn: entry;
56 temp_spawnflag = "1"b;
57 me = "gcos$spawn (4.0)";
58 goto gcos_common;
59
60 task: entry;
61 temp_taskflag = "1"b;
62 me = "gcos$task (4.0)";
63 goto gcos_common;
64
65 dbs: entry;
66 call cu_$arg_ptr (i, pp, lp, code);
67 call gcos_dbs;
68 goto exit_gcos;
69
70 gcos_common:
71
72 on condition (cleanup) begin;
73 simulator_already_active = "0"b;
74 end;
75
76 if simulator_already_active
77 then do;
78 call com_err_ (
79 0
80 , me
81 , "job already active, you must complete it (""start"")"
82 ||"^/or terminate it (""release"") before starting another one."
83 );
84 goto fatal_error;
85 end;
86
87 call initialize_routine;
88
89 call process_args;
90
91
92
93
94 if ^job_deck
95 then do;
96 call com_err_ (error_table_$noarg,
97 me, "No job deck pathname given.");
98 goto fatal_error;
99 end;
100
101 if expecting
102 then do;
103 call com_err_ (error_table_$noarg,
104 me, "^/Could not find expected argument after ""^a"" ",
105 targ);
106 goto fatal_error;
107 end;
108
109
110
111 if id_jd | gcos_ext_stat_$job_id = "" then do;
112
113 i = index (jd_ename, ".gcos");
114 if i = 0 then
115 i = length (rtrim (jd_ename))+1;
116
117 if i > 19
118 then do;
119
120 i = 19;
121 call com_err_ (0, me,
122 "Job ID too long. Using first 18 chracters"
123 || " (""^a"")", (substr (jd_ename, 1, 18)));
124
125 end;
126
127 gcos_ext_stat_$job_id = substr (jd_ename, 1, i-1);
128
129 end;
130
131
132
133 if dpo_given then
134 gcos_ext_stat_$save_data.dprint = "1"b;
135 else gcos_ext_stat_$dpo = "-dl";
136 if dpno_given then
137 gcos_ext_stat_$save_data.dpunch = "1"b;
138 else gcos_ext_stat_$dpno = "-dl";
139
140 if gcos_ext_stat_$save_data.dprint then gcos_ext_stat_$save_data.list = "1"b;
141 if gcos_ext_stat_$save_data.dpunch then gcos_ext_stat_$save_data.raw = "1"b;
142
143
144
145 if ^hold_given then do;
146 if ^gcos_ext_stat_$save_data.raw then
147 gcos_ext_stat_$save_data.raw, gcos_ext_stat_$save_data.dpunch = "1"b;
148
149 if ^gcos_ext_stat_$save_data.list then
150 gcos_ext_stat_$save_data.list, gcos_ext_stat_$save_data.dprint = "1"b;
151 end;
152
153
154 gcos_ext_stat_$dpno = gcos_ext_stat_$dpno || " -raw";
155
156
157
158
159 if gcos_ext_stat_$save_data.gcos then
160 if gcos_ext_stat_$save_data.no_canonicalize then do;
161 warning_return = ignored_ncan;
162 err_msg = "-no_canonicalize ignored - valid only for ascii job deck segment";
163 com_err_inconsistent:
164 call com_err_ (0, me, "Warning:" || err_msg);
165
166 goto warning_return;
167 end;
168
169 ignored_ncan:
170 if gcos_ext_stat_$save_data.gcos then if gcos_ext_stat_$save_data.truncate then do;
171 warning_return = ignored_truncate;
172 err_msg = "-truncate ignored - valid only for ascii job deck segment";
173 goto com_err_inconsistent;
174 end;
175
176 ignored_truncate:
177
178
179
180
181
182 if gcos_ext_stat_$stop_code = 1 then do;
183 call ioa_ ("Results of arg list processing:");
184 call ioa_ ("gcos_ext_stat_$save_data.flgs: ^12.3b", unspec (gcos_ext_stat_$save_data.flgs));
185 call ioa_ ("job id: ^a", gcos_ext_stat_$job_id);
186 call ioa_ ("temp_dir: ^a", gcos_ext_stat_$temp_dir);
187 call ioa_ ("input seg: ^a", gcos_ext_stat_$input_segment_path);
188 call ioa_ ("jd_ename: ^a", jd_ename);
189 call ioa_ ("dprint options: ^a", gcos_ext_stat_$dpo);
190 call ioa_ ("dpunch options: ^a", gcos_ext_stat_$dpno);
191 call ioa_ ("pdir: ^a", gcos_ext_stat_$pdir);
192 call ioa_ ("save_dir: ^a", gcos_ext_stat_$save_dir);
193 call ioa_ ("nargs: ^d", nargs);
194 call ioa_ ("DB:");
195 call db;
196
197
198 goto fatal_error;
199 end;
200
201 gcos_ext_stat_$abort_return = fatal_error;
202
203 gcos_ext_stat_$validation_level = get_ring_ ();
204 if gcos_ext_stat_$save_data.gtssflag & (gcos_ext_stat_$validation_level < 4) then do;
205 gcos_ext_stat_$dir_rings (1) = gcos_ext_stat_$validation_level;
206 gcos_ext_stat_$dir_rings (2), gcos_ext_stat_$dir_rings (3)
207 , gcos_ext_stat_$seg_rings (*)
208 = 4;
209 end;
210 else gcos_ext_stat_$dir_rings (*), gcos_ext_stat_$seg_rings (*) = gcos_ext_stat_$validation_level;
211
212 call gcos_gein_ ;
213
214 fatal_error:
215
216
217 simulator_already_active = "0"b;
218
219 exit_gcos: ;
220
221 return;
222 %page;
223 gcos_dbs: proc;
224
225 debug
226
227 do i = 1 by 1;
228 call cu_$arg_ptr (i, pp, lp, code);
229 if code ^= 0 then do;
230 if i<2
231 then call print_dbs_usage;
232 goto fatal_error;
233 end;
234 if targ = "-print" | targ = "-pr" then do;
235 do j = 1 to hbound (dbs_names, 1);
236 call ioa_ (
237 "^3i. ^[ ON^;OFF^] ^a"
238 , j
239 , dbsv (j)
240 , dbs_names (j)
241 );
242 end;
243 end;
244 else do;
245 if lp<2 then targ_fc, tl = length (targ);
246 else do;
247 if substr (targ, 1, 1) = "^" then targ_fc = 2;
248 else targ_fc = 1;
249 tl = index (substr (targ, targ_fc), ",");
250 if tl = 0 then
251 tl = length (targ) - targ_fc + 1;
252 else
253 tl = tl - 1;
254 end;
255 do j = 1 to hbound (dbs_names, 1);
256 if substr (targ, targ_fc, tl) = dbs_names (j) then do;
257 dbsv (j) = (targ_fc = 1);
258
259
260 if (targ_fc+tl) > length (targ) then do;
261 ta_fc = 1;
262 ta_ln = 0;
263 end;
264 else do;
265 ta_fc = targ_fc+tl+1;
266 ta_ln = length (targ) - ta_fc +1;
267 end;
268 if substr (targ, targ_fc, tl) = "filecode" then
269 call gcos_mme_inos_$inos_trace_filecode (substr (targ, ta_fc, ta_ln));
270 else if substr (targ, targ_fc, tl) = "trace_mme" then
271 call gcos_process_mme_$mme_trace (substr (targ, ta_fc, ta_ln));
272 else if substr (targ, targ_fc, tl) = "stop_mme" then
273 call gcos_process_mme_$mme_stop (substr (targ, ta_fc, ta_ln));
274 goto dbs_next;
275 end;
276 end;
277 call com_err_ (
278 0
279 , "gcos$dbs"
280 , "Arg ^i ""^a"" unknown. Need -print (-pr) or switch name."
281 , i
282 , substr (targ, targ_fc, tl)
283 );
284 dbs_next: ;
285 end;
286 end;
287
288 return;
289
290 end gcos_dbs;
291 %page;
292 print_dbs_usage: proc;
293 call gcos_print_call_ (
294 "Usage: gcos$dbs arg ..."
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309 );
310
311 return;
312
313 end print_dbs_usage;
314 %page;
315 initialize_routine: proc;
316
317
318
319 simulator_already_active = "1"b;
320 query_info.yes_or_no_sw = "1"b;
321 expecting = "0"b;
322 literal_string = "0"b;
323 buffsize_next = "0"b;
324 string (gcos_ext_stat_$dbs) = string (dbsv);
325 save_data.activity_no = 0;
326 gcos_ext_stat_$incode,
327 gcos_ext_stat_$gf = 0;
328 gcos_ext_stat_$last_mme = 0;
329 gcos_ext_stat_$ldrss = 0;
330 gcos_ext_stat_$max_activities = 63;
331 gcos_ext_stat_$save_data.param = "";
332 gcos_ext_stat_$tape_buffer_size = 4096;
333 save_data.sqindex = 1;
334 unspec (gcos_ext_stat_$save_data.flgs) = (72)"0"b;
335 gcos_ext_stat_$job_id = "";
336
337 gcos_ext_stat_$er
338 , gcos_ext_stat_$gcos_slave_area_seg
339 , gcos_ext_stat_$patchfile_ptr
340 , gcos_ext_stat_$pch
341 , gcos_ext_stat_$prt
342 , gcos_ext_stat_$rs
343 , gcos_ext_stat_$saveseg_ptr
344 , gcos_ext_stat_$sig_ptr
345 , gcos_ext_stat_$temp_seg_ptr
346 = null ();
347 gcos_ext_stat_$system_free_pointer = get_system_free_area_ ();
348
349
350
351 gcos_ext_stat_$save_data.spawnflag = temp_spawnflag;
352 gcos_ext_stat_$save_data.gtssflag = temp_spawnflag;
353 gcos_ext_stat_$save_data.taskflag = temp_taskflag;
354
355
356
357
358 gcos_ext_stat_$temp_dir,
359 gcos_ext_stat_$pdir = rtrim (get_pdir_ ());
360
361 save_data.syot_dir,
362 gcos_ext_stat_$save_dir = rtrim (get_wdir_ ());
363
364 save_data.pathname_prefix = rtrim (get_default_wdir_ ()) ;
365 save_data.skip_umc = "1"b ;
366
367 return;
368
369 end initialize_routine;
370 %page;
371 print_call: proc;
372
373
374
375 call gcos_print_call_ (
376 "Usage: gcos JOB_DECK_PATH {-control_args}"
377
378
379
380
381
382
383
384
385
386
387
388
389
390 debugdebug
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426 );
427 return;
428 end print_call;
429 %page;
430 process_args: proc;
431
432
433 call cu_$arg_count (nargs, code);
434 if code ^= 0 then do;
435 call com_err_ (
436 code
437 , "gcos"
438 );
439 return;
440 end;
441 if nargs = 0 then do;
442 usage: ;
443 call com_err_ (
444 error_table_$noarg
445 , me
446 );
447 call print_call;
448
449 goto fatal_error;
450 end;
451
452 do i = 1 to nargs;
453 call cu_$arg_ptr (i, pp, lp, code);
454
455 if code ^= 0 then do;
456 call com_err_ (code, me, targ);
457 goto usage;
458 end;
459
460
461
462
463
464
465 if ^literal_string
466 then if (targ = "-string" | targ = "-str") then do;
467 literal_string = "1"b;
468 goto end_arg_loop;
469 end;
470
471
472 num_arg = cv_dec_check_ (targ, code);
473 if lp = 0 then control = "0"b;
474 else if (substr (targ, 1, 1) = "-" & ^literal_string)
475 then do;
476 control = "1"b;
477 processing_params = "0"b;
478 end;
479 else control = "0"b;
480
481
482 if processing_params then do;
483 if i-param_base > hbound (save_data.param, 1) then do;
484 call com_err_ (error_table_$too_many_args, "gcos"
485 , "Maximum number of -parameter arguments is ^d."
486 , hbound (save_data.param, 1));
487 return;
488 end;
489 if literal_string then param_base = param_base +1;
490 save_data.param (i-param_base) = targ;
491 literal_string = "0"b;
492 goto end_arg_loop;
493 end;
494
495
496 if expecting then do;
497
498 if temp_dir_next then do;
499 if control then do;
500
501 err_msg = "(pathname, between -temp_dir and ^a)";
502 com_err_noarg: call com_err_ (error_table_$noarg, me, err_msg, targ);
503 if print_usage then goto usage;
504 goto fatal_error;
505 end;
506
507
508 get_dir: ;
509
510 call expand_pathname_ ((substr (targ, 1, lp)), fullname, ename, code);
511
512 if code ^= 0 then goto ex_error;
513
514 call hcs_$status_minf ((fullname), (ename), chase, type, bit_count, code);
515 if code ^= 0 then goto in_error;
516
517
518 if type ^= 2 | bit_count ^= 0 then do;
519 call com_err_ (0, me, "expected directory path is that of a ^a:^/^a>^a",
520 type_name (type), fullname, ename);
521 goto fatal_error;
522 end;
523
524
525 itemp = index (fullname, " ");
526 if itemp = 0 then itemp = 169;
527
528 jtemp = index (ename, " ");
529 if jtemp = 0 then jtemp = 33;
530 fullname = substr (fullname, 1, itemp-1) || ">" || substr (ename, 1, jtemp-1);
531
532 itemp = itemp + jtemp - 1;
533
534 if temp_dir_next then
535 gcos_ext_stat_$save_dir
536 , gcos_ext_stat_$temp_dir = substr (fullname, 1, itemp);
537 else if syot_dir_next then
538 save_data.syot_dir = substr (fullname, 1, itemp);
539 else save_data.pathname_prefix = substr (fullname, 1, itemp) ;
540
541
542 syot_dir_next, smc_next
543 , expecting, temp_dir_next = "0"b;
544
545 end;
546
547 else if syot_dir_next then do;
548 if control then do;
549 err_msg = "(pathname, between -syot_dir and ^a)";
550 goto com_err_noarg;
551 end;
552 goto get_dir;
553 end;
554
555 else if smc_next then do ;
556
557 save_data.skip_umc = "0"b ;
558
559 if control then do ;
560 err_msg = "(pathname, between -smc and ^a)" ;
561 goto com_err_noarg ;
562 end ;
563 else goto get_dir ;
564 end ;
565
566 else if stop_code_next then do;
567
568
569 if code ^= 0 then do;
570 err_msg = "(numeric, between -stop and ^a)";
571 goto com_err_noarg;
572 end;
573
574 gcos_ext_stat_$stop_code = num_arg;
575 expecting, stop_code_next = "0"b;
576
577 end;
578
579 else if buffsize_next
580 then do;
581 if ^valid_buffsize (targ)
582 then goto fatal_error;
583
584 buffsize_next = "0"b;
585 expecting = "0"b;
586 end;
587
588 else if dpo_next then do;
589 gcos_ext_stat_$dpo = targ;
590 expecting, dpo_next = "0"b;
591 dpo_given = "1"b;
592 end;
593
594 else if dpno_next then do;
595 gcos_ext_stat_$dpno = targ;
596 expecting, dpno_next = "0"b;
597 dpno_given = "1"b;
598
599 end;
600
601 else if job_id_next then do;
602 if ^control then do;
603
604
605 if lp > 18 then do;
606 lp = 18;
607
608
609
610
611
612
613
614 if substr (targ, 7, 1) = "!" then
615 goto ignored_string_end;
616 err_msg = targ;
617 warning_return = ignored_string_end;
618 com_err_id_too_long: call com_err_ (0, me, "job id too long; using first 18 characters: ^a", err_msg);
619 goto warning_return;
620 end;
621
622 ignored_string_end:
623 gcos_ext_stat_$job_id = targ;
624 end;
625
626 else if targ = "-unique" then do;
627 gcos_ext_stat_$job_id = unique_chars_ ("0"b);
628 end;
629
630
631 else if targ = "-jd" | targ = "-jd_seg" then do;
632 id_jd = "1"b;
633 end;
634
635 NOTE
636
637
638
639
640 else do;
641 err_msg = "(job id, between -job_id and ^a)";
642 goto com_err_noarg;
643 end;
644
645 expecting, job_id_next = "0"b;
646 end;
647
648 else do;
649 err_msg = "ERROR IN GCOS. Flags not reset properly.";
650 goto com_err_noarg;
651 end;
652 end;
653
654
655 else if control then do;
656 if targ = "-gc" | targ = "-gcos" then gcos_ext_stat_$save_data.gcos = "1"b;
657
658 else if targ = "-nosv" | targ = "-nosave" then gcos_ext_stat_$save_data.nosave = "1"b;
659
660
661 else if targ = "-hd" | targ = "-hold" then hold_given = "1"b;
662
663 else if targ = "-ls" | targ = "-list" then gcos_ext_stat_$save_data.list = "1"b;
664
665 else if targ = "-bf" | targ = "-brief" then gcos_ext_stat_$save_data.brief = "1"b;
666
667 else if targ = "-lg" | targ = "-long" then gcos_ext_stat_$save_data.long = "1"b;
668
669 else if targ = "-db" | targ = "-debug" then gcos_ext_stat_$save_data.debug = "1"b;
670
671 else if targ = "-nb" | targ = "-nobar" | targ = "-no_bar" then gcos_ext_stat_$save_data.no_bar = "1"b;
672
673 else if targ = "-tnc" | targ = "-tc" | targ = "-truncate" then gcos_ext_stat_$save_data.truncate = "1"b;
674
675 else if targ = "-ctu" | targ = "-continue" then gcos_ext_stat_$save_data.continue = "1"b;
676
677 else if targ = "-userlib" then gcos_ext_stat_$save_data.userlib = "1"b;
678
679 else if targ = "-no" | targ = "-no_canonicalize" | targ = "-nocan" then
680 gcos_ext_stat_$save_data.no_canonicalize = "1"b;
681
682 else if targ = "-aci" | targ = "-ascii" then do;
683 ascii_given = "1"b;
684 gcos_ext_stat_$save_data.gcos = "0"b;
685 end;
686
687 else if targ = "-id" | targ = "-job_id" then expecting, job_id_next = "1"b;
688
689 else if targ = "-stop" then expecting, stop_code_next = "1"b;
690
691 else if targ = "-td" | targ = "-temp_dir" then expecting, temp_dir_next = "1"b;
692
693 else if targ = "-sd" | targ = "-syot_dir" then expecting, syot_dir_next = "1"b;
694
695 else if targ = "-raw" then gcos_ext_stat_$save_data.raw = "1"b;
696
697 else if targ = "-dp" | targ = "-dprint" then gcos_ext_stat_$save_data.dprint = "1"b;
698
699 else if targ = "-dpn" | targ = "-dpunch" then gcos_ext_stat_$save_data.dpunch = "1"b;
700
701 else if targ = "-dpo" | targ = "-dprint_options" then expecting, dpo_next = "1"b;
702
703 else if targ = "-dpno" | targ = "-dpunch_options" then expecting, dpno_next = "1"b;
704
705 else if targ = "-lc" | targ = "-lower_case" then gcos_ext_stat_$save_data.lower_case = "1"b;
706
707 else if targ = "-unique" then do;
708 unexpected_id:
709 err_msg = "immediately following -job_id";
710 call com_err_ (0, me, "-unique out of place - only allowed following -job_id");
711 goto fatal_error;
712 end;
713
714 else if targ = "-jd" | targ = "-jd_seg" then goto unexpected_id;
715
716 else if targ = "-smc" then expecting, smc_next = "1"b ;
717
718 else if (targ = "-parameter" | targ = "-pm" | targ = "-param") then do;
719 processing_params = "1"b;
720 param_base = i;
721 end;
722
723 else if targ = "-gtss" then gcos_ext_stat_$save_data.gtssflag = "1"b;
724
725 else if targ = "-ident" then gcos_ext_stat_$save_data.identflag = "1"b;
726
727 else if targ = "-block" | targ = "-bk" then expecting, buffsize_next = "1"b;
728
729
730 else do;
731 call com_err_ (error_table_$badopt, me, targ);
732 goto fatal_error;
733 end;
734 end;
735
736
737
738
739
740
741 else if ^job_deck then do;
742
743 job_deck = "1"b;
744
745 call expand_pathname_ ((substr (targ, 1, lp)), fullname, ename, code);
746 if code ^= 0 then do;
747 ex_error: call com_err_ (code, me, targ);
748 goto fatal_error;
749 end;
750
751 jd_ename = ename;
752
753
754
755 call hcs_$status_minf ((fullname), (ename), chase, type, bit_count, code);
756 if code ^= 0 then do;
757 in_error: call com_err_ (code, me, "^a>^a", fullname, ename);
758 goto fatal_error;
759 end;
760
761 if bit_count = 0 then do;
762 call com_err_ (0, me, "zero length job deck segment: ^a>^a", fullname, ename);
763 goto fatal_error;
764 end;
765
766
767
768 itemp = index (fullname, " ");
769 if itemp = 0 then itemp = 169;
770 gcos_ext_stat_$input_segment_path = substr (fullname, 1, itemp-1)||">";
771
772 itemp = index (ename, " ");
773 if itemp = 0 then itemp = 33;
774 gcos_ext_stat_$input_segment_path = gcos_ext_stat_$input_segment_path||substr (ename, 1, itemp-1);
775
776
777
778
779 if ^ascii_given then
780 if lp > length (".gcos") then
781 if substr (targ, lp-length (".gcos")+1, length (".gcos")) = ".gcos" then
782 gcos_ext_stat_$save_data.gcos = "1"b;
783 end;
784
785 else do;
786 call com_err_ (0, me, "Unidentified non-control argument: ^a", targ);
787 goto usage;
788 end;
789
790 literal_string = "0"b;
791
792 end_arg_loop: ;
793 end;
794
795
796 return;
797
798 end process_args;
799 %page;
800 valid_buffsize: proc (charbuffsize) returns (bit(1));
801
802
803
804 dcl charbuffsize char (*) parm;
805 dcl buffsize fixed bin (35);
806
807
808 code = 0;
809
810 buffsize = cv_dec_check_ (ltrim (rtrim (charbuffsize)), code);
811
812
813 if buffsize < 1
814 | buffsize > 4096
815 | code ^= 0
816 then do;
817 code = error_table_$bad_conversion;
818 call com_err_ (code, me,
819 "Could not use ""^a"" as buffer size."
820 || "^/Permissible values are 1 <= buffsize <= 4096^/^/",
821 ltrim (rtrim (charbuffsize)));
822 goto exit_valid_buffsize;
823 end;
824
825 gcos_ext_stat_$tape_buffer_size = buffsize;
826
827 exit_valid_buffsize: ;
828
829 return (code = 0);
830
831 end valid_buffsize;
832 %page;
833
834
835 dcl addr builtin;
836 dcl bit_count fixed bin(24) ;
837 dcl buffsize_next bit (1);
838 dcl chase fixed bin(1) init (1);
839 dcl cleanup condition;
840 dcl code fixed bin(35) ;
841 dcl com_err_ entry options(variable);
842 dcl cu_$arg_count entry (fixed bin, fixed bin(35));
843 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35));
844 dcl cv_dec_check_ entry (char(*), fixed bin(35)) returns (fixed bin);
845 dcl db entry options(variable);
846 dcl dbsv (36)bit(1)static int init((36)(1)"0"b);
847 dcl ename char (32) ;
848 dcl error_table_$badopt fixed bin(35) ext static;
849 dcl error_table_$bad_conversion fixed bin(35) ext static;
850 dcl error_table_$big_ws_req fixed bin(35) ext static;
851 dcl error_table_$noarg fixed bin(35) ext static;
852 dcl error_table_$too_many_args fixed bin(35) ext static;
853 dcl err_msg char(100) varying ;
854 dcl expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35));
855 dcl fullname char(168) ;
856 dcl gcos_gein_ entry;
857 dcl gcos_mme_inos_$inos_trace_filecode entry(char(*));
858 dcl gcos_process_mme_$mme_stop entry(char(*));
859 dcl gcos_process_mme_$mme_trace entry(char(*));
860 dcl gcos_print_call_ entry options(variable);
861 dcl get_default_wdir_ entry returns (char(168) aligned);
862 dcl get_pdir_ entry returns (char(168) aligned);
863 dcl get_ring_ entry returns (fixed bin(3));
864 dcl get_system_free_area_ entry returns (ptr);
865 dcl get_wdir_ entry returns (char(168) aligned);
866 dcl hbound builtin;
867 dcl i fixed bin(17);
868 dcl index builtin;
869 dcl ioa_ entry options(variable);
870 dcl j fixed bin(24);
871 dcl jd_ename char(32) ;
872 dcl length builtin;
873 dcl literal_string bit(1);
874 dcl ltrim builtin;
875 dcl me char(16) ;
876 dcl null builtin;
877 dcl rtrim builtin;
878 dcl send_message_ entry (char(*), char(*), char(*), fixed bin(35));
879 dcl simulator_already_active bit (1) aligned int static init ("0"b);
880 dcl size builtin;
881 dcl string builtin;
882 dcl substr builtin;
883 dcl targ_fc fixed bin(24);
884 dcl ta_fc fixed bin(24);
885 dcl ta_ln fixed bin;
886 dcl tl fixed bin(24);
887 dcl type fixed bin(2) ;
888 dcl unique_chars_ entry (bit (*)) returns (char(15));
889 dcl unspec builtin;
890 dcl warning_return label local ;
891
892
893 dcl type_name (0:2) char(8) int static init (
894 "link",
895 "segment",
896 "msf");
897
898 dcl 1 statbuff automatic aligned like status_branch.short;
899
900 dcl lp fixed bin(21),
901 pp ptr,
902 targ char(lp) based (pp);
903
904 dcl (print_usage,
905 control,
906 expecting,
907 stop_code_next,
908 dpo_next,
909 dpno_next,
910 job_id_next,
911 temp_dir_next,
912 syot_dir_next,
913 smc_next,
914 id_jd,
915 job_deck,
916 hold_given,
917 processing_params,
918 dpo_given,
919 dpno_given,
920 temp_spawnflag,
921 temp_taskflag,
922 ascii_given)
923 bit (1) init ("0"b);
924
925 dcl (nargs,
926 num_arg,
927 param_base,
928 jtemp,
929 itemp)
930 fixed bin(17)init (0);
931
932 dcl hcs_$status_ entry (char(*), char(*), fixed bin(1), ptr, ptr, fixed bin(35));
933 dcl hcs_$status_minf entry (char(*) aligned, char(*) aligned, fixed bin(1),
934 fixed bin(2), fixed bin(24), fixed bin(35));
935 %page;
936 %include gcos_ext_stat_;
937 %page;
938 %include query_info;
939 %page;
940 %include gcos_dbs_names;
941 %page;
942 %include status_structures;
943 end gcos;