1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    *********************************************************** */
  6 gcos: gc: proc;
  7 
  8 /*
  9 
 10    This procedure is invoked when a user types the "gcos" command.
 11 
 12    It  interprets  all  of the command arguments, setting switches
 13    and  storing  values  in  external  static  variables,  and  it
 14    verifies  the existence of the input segment(s).  It then calls
 15    gcos_gein_, which processes the gcos job deck and runs the job.
 16 
 17 */
 18 %page;
 19 /*
 20 
 21   Author: T. CASEY            MAR 1973
 22   Change: T. CASEY            OCT 1973
 23                               FEB 1974
 24                               APR 1974
 25                               MAY 1974
 26                               AUG 1974
 27   Change: D. KAYDEN           FEB 1975
 28   Change: M. R. JORDAN        JUN 1976  To process "-smc" control argument.
 29   Change: Mel Wilson          MAR 1979  For gtss interface and -ident option.
 30   Change: Mel Wilson          OCT 1979  For gtss ring_bracket compatibility.
 31   Change: Dave Ward           MAY 1981  DBS entry, source reorganized.
 32   Change: Scott Akers         DEC 1981  Fix "-syot_dir" control_arg.
 33                                         Change "expand_path_" to "expand_pathname_."
 34                         2.5   FEB 1982  Add "-block" control_arg.
 35   Change: Ron Barstad   2.5   Sep 1982  Fix usage statement to be only 1 line
 36   Change: Ron Barstad   3.0   Feb 1983  Change version to "3.0" for 4JS3
 37   Change: Ron Barstad   3.1   83-02-15  Add init for $param vaules to ""
 38                                         Fix bug: was not processing past first
 39                                         -param value! missplaced label end_arg_loop
 40                                         Allow non-control args to start with "-" by adding -string arg
 41                                         Allow null "" param after -param.
 42   Change: Ron Barstad   3.2   83-04-28  Delete long gcos$dbs usage message
 43                                         Update spawn & task versions
 44                                         Make default buffer size 4096, remove workspace.acs check
 45                                         Declared some undeclared builtins
 46   Change: Ron Barstad  3.3  83-08-02    Added activity_card_num to ext static
 47   Change: Ron Barstad  3.4  83-08-10    Added 4js3 control cards
 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;                          /* Do all the init stuff. */
 88 
 89           call process_args;                                /* Now, dink around with the args. */
 90 
 91 
 92 /*        NOW ALL ARGUMENTS HAVE BEEN PROCESSED - SEE IF THERE WERE ANY PROBLEMS */
 93 
 94           if ^job_deck
 95           then do;                                          /* If job deck pathname not given, complain. */
 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;                                          /* If we were waiting for something, complain. */
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 /* check for job deck segment pathname to be used as job id */
110 
111           if id_jd | gcos_ext_stat_$job_id = "" then do;    /* default, if not specified */
112                                                             /* get rid of ".gcos" appendage, if it's there */
113                i = index (jd_ename, ".gcos");               /* look for .gcos */
114                if i = 0 then                                /* if not there */
115                     i = length (rtrim (jd_ename))+1;
116 
117                if i > 19                                    /* If job ID longer than 18 characters, */
118                then do;                                     /* truncate it and warn user. */
119 
120                     i = 19;                                 /* 19 since i-1 is used below */
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;                                              /* end of id_jd do group */
130 
131 /*     SET SYSOUT OPTIONS  */
132 
133           if dpo_given then
134                gcos_ext_stat_$save_data.dprint = "1"b;      /* if dprint (or dpunch) options given */
135           else gcos_ext_stat_$dpo = "-dl";                  /* the default is delete */
136           if dpno_given then
137                gcos_ext_stat_$save_data.dpunch = "1"b;      /* then dprint (or dpunch) is implied */
138           else gcos_ext_stat_$dpno = "-dl";                 /* the default is delete */
139 
140           if gcos_ext_stat_$save_data.dprint then gcos_ext_stat_$save_data.list = "1"b; /* if dprint (or dpunch) to be done */
141           if gcos_ext_stat_$save_data.dpunch then gcos_ext_stat_$save_data.raw = "1"b; /* then conversion from bcd is implied */
142 
143 /* see if defaults are to be used */
144 
145           if ^hold_given then do;                           /* set defaults, if not told to skip it */
146                if ^gcos_ext_stat_$save_data.raw then        /* if nothing said about punch files */
147                     gcos_ext_stat_$save_data.raw, gcos_ext_stat_$save_data.dpunch = "1"b; /* the default is convert and punch */
148 
149                if ^gcos_ext_stat_$save_data.list then       /* if nothing said about print files */
150                     gcos_ext_stat_$save_data.list, gcos_ext_stat_$save_data.dprint = "1"b; /* the default is convert and print */
151           end;                                              /* end of set defaults do group */
152 
153 
154           gcos_ext_stat_$dpno = gcos_ext_stat_$dpno || " -raw"; /* raw option always used, since any other
155                                                                way would produce garbage on the cards */
156 
157 /*    FUSSY WARNING MESSAGES */
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 /*        END OF ARGUMENT LIST PROCESSING */
179 
180 /* for debugging arg list processing */
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                                                             /* to allow looking at others */
197                                                             /* .q to get out of db */
198                goto fatal_error;                            /* to get any necessary cleaning up done */
199           end;
200 
201           gcos_ext_stat_$abort_return = fatal_error;        /* set up abort nonlocal goto */
202 
203           gcos_ext_stat_$validation_level = get_ring_ ();   /* set up ring numbers for created branches */
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_ ;                                 /* go read job deck and run job */
213 
214 fatal_error:                                                /* if an abort occurs, control returns here via a nonlocal
215                                                                transfer to gcos_ext_stat_$abort_return, causing the stack
216                                                                to be cleaned up, and cleanup handlers to be invoked */
217           simulator_already_active = "0"b;                  /* allow simulator to be invoked again */
218 
219 exit_gcos:          ;
220 
221           return;
222 %page;
223 gcos_dbs: proc;
224 
225 /* Process argument(s) to switch debug switches.
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); /* Use whole targ. */
246                     else do;                                /* Examine for leading "^" and comma. */
247                          if substr (targ, 1, 1) = "^" then targ_fc = 2; /* Start with 2nd character of targ, exclude "^". */
248                          else targ_fc = 1;                  /* Start with 1st character of targ. */
249                          tl = index (substr (targ, targ_fc), ",");
250                          if tl = 0 then                     /* No comma in argument string. */
251                               tl = length (targ) - targ_fc + 1; /* Use the whole available string. */
252                          else                               /* There is a comma. */
253                          tl = tl - 1;                       /* Use the available string up to the comma. */
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 /* Locate the portion of "targ" after the first comma. */
260                               if (targ_fc+tl) > length (targ) then do; /* There is none. */
261                                    ta_fc = 1;               /* Let 1st character be at one, */
262                                    ta_ln = 0;               /* but the length is zero (to allow substring). */
263                               end;
264                               else do;                      /* Ther is a comma. */
265                                    ta_fc = targ_fc+tl+1;    /* Location of 1st character after comma. */
266                                    ta_ln = length (targ) - ta_fc +1; /* Number of character. */
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_ (                         /* Report dbs arg error. */
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;                                      /* Prints gcos_dbs usage message. */
293                          call gcos_print_call_ (
294                          "Usage: gcos$dbs arg ..."
295 /* DON'T PRINT THIS:     , "args:"
296                          , " -print, -pr|Print names of switches."
297                          , " name or ^name|Switch name value from following:"
298                          , "|attach_file"
299                          , "|open_file"
300                          , "|msf_test"
301                          , "|dollar"
302                          , "|nondollar"
303                          , "|filecode{,-print,file-code[DEFAULT all codes]}"
304                          , "|mme_inos_trace"
305                          , "|mme_inos_stop"
306                          , "|mme_call"
307                          , "|trace_mme{,-print,-all[DEFAULT],-on[DEFAULT],-off,-clear,mme#|mme-name}"
308                          , "|stop_mme{,-print,-all[DEFAULT],-on[DEFAULT],-off,-clear,mme#|mme-name}"
309 */                       );
310 
311           return;
312 
313 end print_dbs_usage;
314 %page;
315 initialize_routine: proc;                                   /* Perform initialization */
316 
317 /*   INITIALIZE EXTERNAL STATICS USED IN ARGUMENT PROCESSING */
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; /* zero out gcos_ext_stat_$save_data before argument processing */
335           gcos_ext_stat_$job_id = "";                       /* must be initialized to blanks so we can tell whether to
336                                                                set it to default after all args processed */
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                                                             /* get pointer to free area for allocating things in */
349 
350 
351           gcos_ext_stat_$save_data.spawnflag = temp_spawnflag; /* set entry point gcos_ext_stat_$save_data */
352           gcos_ext_stat_$save_data.gtssflag = temp_spawnflag;
353           gcos_ext_stat_$save_data.taskflag = temp_taskflag;
354 
355 
356 /*        GET PROCESS, WORKING AND DEFAULT WORKING DIRECTORY PATHNAMES FOR USE IN FILE NAMES */
357 
358           gcos_ext_stat_$temp_dir,                          /* temp_dir = pdir, by default */
359                gcos_ext_stat_$pdir = rtrim (get_pdir_ ());  /* put it in ext static varying string */
360 
361           save_data.syot_dir,                               /* syot_dir and save_dir = wdir, by default */
362                gcos_ext_stat_$save_dir = rtrim (get_wdir_ ()); /* put in ext static varying string */
363 
364           save_data.pathname_prefix = rtrim (get_default_wdir_ ()) ; /* pathname_prefix = default_wdir_ by default */
365           save_data.skip_umc = "1"b ;
366 
367           return;
368 
369 end initialize_routine;
370 %page;
371 print_call: proc;
372 
373 /* Display on caller's terminal the calling sequence.
374 */
375                call gcos_print_call_ (
376                     "Usage: gcos JOB_DECK_PATH {-control_args}"
377 /*                  , ""
378                     , "job_deck_path|Pathname of JCL file, can be a Multics segment or GCOS file"
379                     ||" regulated by control argument and suffix."
380                     , ""
381                     , "control_args:"
382                     , " -gcos, -gc|Job deck segment is in gcos file format (not required if pathname ends in "".gcos"")."
383                     , " -ascii, -aci|Job deck segment is Multics ascii format (to override "".gcos"")."
384                     , " -nosave, -nosv|Do not save (make restartable) any activities (in a resumed job)."
385                     , " -hold, -hd|Do not perform default conversion and output of sysout files (needed only when some sysout files are to be left in gcos bcd format, since any"
386                     ||" of -ls -dp -dpo (or -raw -dpn -dpno) override the defaults for print (punch) files.)."
387                     , " -list, -ls|Translate sysout print files to Multics ascii."
388                     , " -brief, -bf|Do not print any except fatal error messages on the terminal."
389                     , " -long, -lg|Duplicate certain lines from the execution report on the terminal."
390                     , " -debug, -db|Give user option of calling debug before aborting job."
391                     , " -no_bar,|Do not run slave program in BAR mode (used for debugging.)."
392                     , " -nobar, -nb"
393                     , " -no_canonicalize,|Do not canonicalize (ascii) job deck segment - it is already"
394                     ||" in canonical form (no tabs, and all fields in right columns)."
395                     , " -nocan, -no"
396                     , " -job_id ID,|ID, used in output file names."
397                     , " -id ID"
398                     , "  ID from:"
399                     , "  <string>|Job id given as character string (max 18 char)."
400                     , "  -unique|Use shriekname (result of unique_chars_) as job id."
401                     , "  -jd_seg, -jd|Use entry name of job deck segment as job id."
402                     , ""
403                     , " -stop n|Debugging: print results, call db, then return, at stopping point n."
404                     , " -temp_dir TD,|TD ispathname of ""gcos pool"" directory, to be used for temporary files."
405                     , " -tp TD"
406                     , " -syot_dir, -sd|Pathname of ""gcos pool"" directory, to be used for sysout files."
407                     , " -smc|Pathname of directory to be used as the gcos SMC in processing prmfl cards."
408                     , " -raw|Convert sysout punch files from bcd."
409                     , " -dprint, -dp|Dprint -delete converted sysout print files (implies -list)."
410                     , " -dpunch, -dpn|Dpunch -delete -raw converted sysout punch files (implies -raw)."
411                     , " -dprint_options O,|O are options to use in dprint call (implies -dprint)."
412                     , " -dpo O"
413                     , " -dpunch_options O,|O are options to use in dpunch call (implies -dpunch)."
414                     , " -dpno O"
415                     , " -userlib|Allow use of libraries other than the installed ones. (see gcos_gein_)."
416                     , " -truncate,|Truncate without warning any ascii input lines longer than 80 characters."
417                     , " -tnc, -tc"
418                     , " -continue, -ctu|Continue executing job when nonfatal erros occur."
419                     , " -lower_case,|Translate BCD sysout and print files to lower case ASCII"
420                     ||" (the default is uppercase ASCII, simulating the appearance of BCD printer output)."
421                     , " -lc"
422                     , " -gtss|Update gtss_user_state_ during execution."
423                     , " -ident|Use $ident fields for print & punch banners."
424                     , " -block N, -bk N|Specify tape buffer size. (Default = 4096)"
425 */
426                     );
427                return;
428 end print_call;
429 %page;
430 process_args: proc;                                         /* Process the arguments. */
431 /*   PROCESS ARGUMENT LIST */
432 
433           call cu_$arg_count (nargs, code);                 /* get number of arguments */
434           if code ^= 0 then do;
435                call com_err_ (                              /* arg count failed. */
436                     code
437                     , "gcos"
438                     );
439                return;
440           end;
441           if nargs = 0 then do;                             /* if no args, complain */
442 usage:         ;
443                call com_err_ (                              /* Print the USAGE msgs. */
444                     error_table_$noarg
445                     , me
446                     );
447                call print_call;
448 /*             call print_dbs_usage;     */
449                goto fatal_error;
450           end;
451 
452           do i = 1 to nargs;                                /* process all arguments in this loop */
453                call cu_$arg_ptr (i, pp, lp, code);          /* get pointer to, and length of, argument */
454                                                             /* targ is declared char(lp) based(pp) */
455                if code ^= 0 then do;                        /* if something wrong with it */
456                     call com_err_ (code, me, targ);         /* complain, print the arg, if it's there */
457                     goto usage;                             /* and then go print the usage message */
458                end;
459 
460 
461 
462 /*     NOW, WHAT DO WE HAVE, AND WHAT DO WE NEED? */
463 
464                /* special handling of -string arg: following arg is NOT a control arg */
465                if ^literal_string           /* can have "-string -string" */
466                     then if (targ = "-string" | targ = "-str") then do;
467                          literal_string = "1"b;
468                          goto end_arg_loop;
469                     end;
470 
471                /* determine type arg we have */
472                num_arg = cv_dec_check_ (targ, code);        /* in case it is numeric */
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;          /* no more params */
478                     end;
479                     else control = "0"b;
480 
481                /* process substitution parameters for gcos JCL */
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 /* it is a control arg or a value following one */
496                if expecting then do;                        /* if we were expecting a value after a control arg */
497                                                             /* then see if this is it */
498                     if temp_dir_next then do;
499                          if control then do;                /* if not a pathname, complain */
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; /* optionally, print the usage message */
504                               goto fatal_error;             /* otherwise, quit */
505                          end;
506 
507 /* get the directory pathname */
508 get_dir: ;                                                  /* come here from syot_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 /* make sure it is a directory */
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 /* put pathname back together and save it in external static */
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;         /* length of full pathname */
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; /* turn off , expecting switches */
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;                      /* share code with temp_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 ;               /* must be a string */
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 /* if stop code expected, save it */
569                          if code ^= 0 then do;              /* if it was non numeric, complain */
570                               err_msg = "(numeric, between -stop and ^a)";
571                               goto com_err_noarg;
572                          end;                               /* end of non numeric stop code do group */
573 
574                          gcos_ext_stat_$stop_code = num_arg;
575                          expecting, stop_code_next = "0"b;  /* turn off expecting switches */
576 
577                     end;
578 
579                     else if buffsize_next
580                          then do;
581                               if ^valid_buffsize (targ)
582                               then goto fatal_error;        /* Bail out if buffer size not legal.
583                                                                Error was reported by valid_buffsize. */
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;         /* copy without checking validity */
590                          expecting, dpo_next = "0"b;        /* turn off expecting switches */
591                          dpo_given = "1"b;                  /* remember that we read it */
592                     end;
593 
594                     else if dpno_next then do;
595                          gcos_ext_stat_$dpno = targ;        /* copy without checking validity */
596                          expecting, dpno_next = "0"b;       /* turn off expecting switches */
597                          dpno_given = "1"b;                 /* remember that we read it */
598 
599                     end;
600 
601                     else if job_id_next then do;
602                          if ^control then do;               /* must be a string */
603                                                             /* impose limit of 18 characters on
604                                                                id (14 more chars max in entry names) */
605                               if lp > 18 then do;
606                                    lp = 18;                 /* this cuts end off targ */
607 
608 /* *****
609    ***** TEMPORARY FIX TO PREVENT DAEMON JOBS FROM COMPLAINING VIA com_err_
610    ***** REMOVE WHEN DAEMON IS FIXED TO SUPPLY 18 CHAR JOB ID. TAC, 6 JUNE 74
611    *****
612    */
613 
614                                    if substr (targ, 7, 1) = "!" then
615                                         goto ignored_string_end;
616                                    err_msg = targ;          /* this puts first 18 chars of targ in err_msg */
617                                    warning_return = ignored_string_end; /* come back here */
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;     /* continue processing */
620                               end;                          /* end too long do group */
621 
622 ignored_string_end:
623                               gcos_ext_stat_$job_id = targ;
624                          end;                               /* end of job id = string do group */
625 
626                          else if targ = "-unique" then do;  /* unique job id wanted */
627                               gcos_ext_stat_$job_id = unique_chars_ ("0"b);
628                          end;                               /* end of -unique do group */
629 
630 
631                          else if targ = "-jd" | targ = "-jd_seg" then do; /* jd seg name wanted as job id */
632                               id_jd = "1"b;                 /* might not have jd seg path yet. remember to use it later */
633                          end;                               /* end of -jd do group */
634 
635 /* NOTE*   WE CAN NEVER USE THE SNUMB AS THE JOB ID
636    (UNLESS THE DAEMON GIVES IT TO US AS -id <string> )
637    SINCE WE HAVE TO USE IT IN FILE PATHNAMES BEFORE WE
638    START READING THE JOB DECK TO GET THE SNUMB CARD */
639 
640                          else do;                           /* control arg after -id. complain */
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;     /* turn off expecting switches */
646                     end;
647 
648                     else do;                                /* should never get here */
649                          err_msg = "ERROR IN GCOS. Flags not reset properly.";
650                          goto com_err_noarg;
651                     end;                                    /* end of ERROR IN GCOS do group */
652                end;
653 
654 
655                else if control then do;                     /* if a control arg */
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;       /* unique not after job id - complain */
708 unexpected_id:                                              /* can come here from below, too */
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; /* -jd not after -id so complain */
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;                                /* complain about unrecognized control argument */
731                          call com_err_ (error_table_$badopt, me, targ);
732                          goto fatal_error;
733                     end;
734                end;
735 
736 
737 /*        IT MUST BE A PATHNAME. DO WE WANT ONE? */
738 
739 /* since we were not expecting anything special, it is either the job deck pathname, or an error */
740 
741                else if ^job_deck then do;                   /* if job deck pathname not read yet, this must be it */
742 
743                     job_deck = "1"b;                        /* remember that we read it */
744 
745                     call expand_pathname_ ((substr (targ, 1, lp)), fullname, ename, code);
746                     if code ^= 0 then do;                   /* if unable to expand... */
747 ex_error:                call com_err_ (code, me, targ);    /* print error and */
748                          goto fatal_error;                  /* exit stage left */
749                     end;
750 
751                     jd_ename = ename;                       /* save entry name for possible use in job id */
752 
753 /*        See if the segment is there   */
754 
755                     call hcs_$status_minf ((fullname), (ename), chase, type, bit_count, code);
756                     if code ^= 0 then do;                   /* if any problem */
757 in_error:                call com_err_ (code, me, "^a>^a", fullname, ename); /* print error msg and */
758                          goto fatal_error;                  /* exit stage rear */
759                     end;
760 
761                     if bit_count = 0 then do;               /* put out error msg if zero length segment */
762                          call com_err_ (0, me, "zero length job deck segment: ^a>^a", fullname, ename);
763                          goto fatal_error;
764                     end;
765 
766 /* if it looks OK, save its pathname for later use     */
767 
768                     itemp = index (fullname, " ");          /* find first blank */
769                     if itemp = 0 then itemp = 169;          /* if none, 168 char dirname */
770                     gcos_ext_stat_$input_segment_path = substr (fullname, 1, itemp-1)||">";
771 
772                     itemp = index (ename, " ");             /* find end */
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 /* if segment has suffix ".gcos", then it is in gcos file format, as
777    gotten from the gcos daemon, gcos utility, or IMCV tape */
778 
779                     if ^ascii_given then                    /* (unless told to ignore .gcos by -ascii) */
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;                                         /* end processing of job deck pathname */
784 
785                else do;                                     /* complain about unrecognized NON-control argument */
786                     call com_err_ (0, me, "Unidentified non-control argument: ^a", targ);
787                     goto usage;                             /* and go print usage message */
788                end;
789 
790                literal_string = "0"b;                       /* just once */
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));       /* Check buffer size for validity, report errors
801                                                                if it's not kosher. Set gcos_ext_stat_$tape_buffer_size
802                                                                if it's O.K. */
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 /*   Variables for gcos:                           */
834 /*   IDENTIFIER               ATTRIBUTES           */
835 dcl  addr                     builtin;
836 dcl  bit_count                fixed bin(24)                 /* length of input segment in bits */;
837 dcl  buffsize_next            bit (1);
838 dcl  chase                    fixed bin(1) init (1);
839 dcl  cleanup                  condition;
840 dcl  code                     fixed bin(35)                 /* return param. for passing error codes */;
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)                     /* holds entry name of input seg */;
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             /* varying error message, to save com_err_ calls */;
854 dcl  expand_pathname_         entry (char(*), char(*), char(*), fixed bin(35));
855 dcl  fullname                 char(168)                     /* holds pathname of input seg */;
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)                      /* to hold job deck entry name for possible -id -jd */;
872 dcl  length                   builtin;
873 dcl  literal_string           bit(1);                        /* allow non control args to start with - */
874 dcl  ltrim                    builtin;
875 dcl  me                       char(16)                      /* command name, for error messages */;
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)                  /* entry type returned by status_minf calls */;
888 dcl  unique_chars_            entry (bit (*)) returns (char(15));
889 dcl  unspec                   builtin;
890 dcl  warning_return           label local                   /* to continue after warning messages */;
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),                /* length of argument */
901      pp ptr,                                                /* pointer to argument */
902      targ char(lp) based (pp);                              /* argument from command line */
903 
904 dcl (print_usage,                                           /* switch on to print usage message */
905      control,                                               /* switch on if arg begins with "-" */
906      expecting,                                             /* switch on if specific argument expected next */
907      stop_code_next,                                        /* switch on when stop code expected next */
908      dpo_next,                                              /* switch on when dprint options expected next */
909      dpno_next,                                             /* switch on when dpunch options expected next */
910      job_id_next,                                           /* switch on when job id expected next */
911      temp_dir_next,                                         /* switch on when temp dir expected next */
912      syot_dir_next,                                         /* switch on when syot dir expected next */
913      smc_next,                                              /* switch on when ssmc dir expected next */
914      id_jd,                                                 /* switch on when jd seg name wanted as job id */
915      job_deck,                                              /* switch on when job deck path read */
916      hold_given,                                            /* switch on if hold option read */
917      processing_params,                                     /* switch on if -parameter control argument has been encountered */
918      dpo_given,                                             /* switch on if dpo option read */
919      dpno_given,                                            /* switch on if dpno option given */
920      temp_spawnflag,                                        /* switch on if entry via gcos$spawn */
921      temp_taskflag,                                         /* switch on if entry via gcos$task */
922      ascii_given)                                           /* switch on if -ascii given */
923      bit (1) init ("0"b);                                   /* switches initially off */
924 
925 dcl (nargs,                                                 /* number of arguments */
926      num_arg,                                               /* place to put converted numeric argument */
927      param_base,                                            /* argument number of the -parameter control argument */
928      jtemp,
929      itemp)                                                 /* temporary */
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;