1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 
 12 /****^  HISTORY COMMENTS:
 13   1) change(2016-02-23,Swenson), approve(2016-02-23,MCR10008),
 14      audit(2016-04-03,GDixon), install(2016-04-05,MR12.6e-0003):
 15      Fix to not reference options variable before it is set. This prevents
 16      incorrect argument processing that mis-constructs segment names and
 17      incorrectly reports an error
 18                                                    END HISTORY COMMENTS */
 19 
 20 map355:
 21      procedure ();
 22 
 23 
 24 /*             "map355" -- command to assemble a Macro Assembly for   */
 25 /*        the DataNet-355 computer.  This assembly process is         */
 26 /*        currently performed by invoking the GCOS simulator.  This   */
 27 /*        particular method has the drawbacks that 1) it tends to use */
 28 /*        features of the Honeywell/6180 which Multics does not use   */
 29 /*        (and thus are more unlikely to work properly) and 2) it     */
 30 /*        uses the GCOS simulator which is actually designed for use  */
 31 /*        by the GCOS Daemon.  It is this particular problem which    */
 32 /*        causes this program to do such things as link to things     */
 33 /*        in the process directory (to get temporary segments).       */
 34 
 35 /*        Originally coded by D. M. Wells in Spring, 1973.            */
 36 /*        Modified by D. M. Wells in February, 1974, to prepare       */
 37 /*             for installation.                                      */
 38 /*        Modified by T. Casey, May 1974, for compatibility with new  */
 39 /*             gcos simulator.                                        */
 40 /*        Modified by M. Grady, May, 1976, to fix core size and       */
 41 /*             cleanup code.                                          */
 42 /*        Modified by Robert coren, April, 1978, to supply severity value */
 43 
 44 
 45 
 46 /* * * * * PARAMETER DECLARATIONS  * * * * * * * */
 47 
 48 /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */
 49 
 50 declare
 51         ((num_args, pddl) fixed binary (17),
 52         (arg_length, bit_count, string_len) fixed binary (24),
 53          err_code bit (36) aligned,
 54          NP character (1),                                  /* cant put this in a canonicalized file                    */
 55          ename character (32),
 56          dirname character (168),
 57         (base_name, job_name, map355_options) character (32) varying,
 58         (gcos_list_pathname, list_pathname, macro_file_pathname, jobdeck_pathname,
 59          process_dir, source_dir, working_dir, pdd) character (168) varying,
 60          argsw bit (1) aligned init ("0"b),
 61          args char (200) varying init ("-brief"),
 62          var_line char (300) varying init (""),
 63          command_line char (300) init (""),
 64         (acl_info_ptr, arg_ptr, object_seg_ptr) pointer)
 65          automatic;
 66 
 67 declare
 68          1 options unaligned automatic,
 69          2 only_check bit (1),
 70          2 from_comdk bit (1),
 71          2 make_comdk bit (1),
 72          2 make_list bit (1),
 73          2 make_gcos_list bit (1);
 74 
 75 declare
 76          1 status aligned automatic,
 77          2 error_code bit (36) aligned,
 78          2 detail_info unaligned,
 79          3 successful_logical_initiation bit (1),
 80          3 successful_logical_completion bit (1),
 81          3 successful_physical_initiation bit (1),
 82          3 successful_physical_completion bit (1),
 83          3 transaction_terminated bit (1),
 84          3 unassigned_bits_42_to_45 (42 : 45) bit (1),
 85          3 end_of_logical_data_indicator bit (1),
 86          3 end_of_physical_data_indicator bit (1),
 87          3 unassigned_bits_48_to_51 (48 : 51) bit (1),
 88          3 stream_name_detached bit (1),
 89          3 unassigned_bit_53 bit (1),
 90          3 transaction_aborted bit (1),
 91          3 transaction_index bit (18);
 92 
 93 /* * * * * TEXT SECTION REFERENCES * * * * * * * */
 94 
 95 declare
 96          NL initial ("
 97 ")
 98          character (1) internal static;
 99 
100 declare
101         (comdk_suffix character (6) initial (".comdk"),
102          source_suffix character (7) initial (".map355"),
103          job_deck_stream character (16) initial ("map355_job_deck_"))
104          internal static;
105 
106 /* * * * * BASED & TEMPLATE DECLARATIONS * * * * */
107 
108 declare
109          based_argument character (arg_length)
110          based;
111 
112 /* * * * * EXTERNAL STATIC DECLARATIONS  * * * * */
113 
114 declare
115          error_table_$badopt
116          bit (36) aligned external static;
117 declare
118           map355_severity_ fixed bin (35) ext static;
119 
120 /* * * * * ENTRY & PROCEDURE DECLARATIONS  * * * */
121 
122 declare
123          adjust_bit_count_ entry (char (168), char (32), bit (1) aligned, fixed bin (24), bit (36) aligned),
124          com_err_ entry options (variable),
125          cu_$arg_count entry (fixed bin (17)),
126          cu_$arg_list_ptr entry () returns (ptr),
127          cu_$arg_ptr_rel entry (fixed bin (17), ptr, fixed bin (24), bit (36) aligned, ptr),
128          cu_$cp ext entry (ptr, fixed bin, bit (36) aligned),
129          delete_$path entry (char (*), char (*), bit (6), char (*), bit (36) aligned),
130          expand_path_ entry (ptr, fixed bin (24), ptr, ptr, bit (36) aligned),
131          get_pdir_ entry () returns (char (168) aligned),
132          get_shortest_pathname_ entry (char (*), char (*), bit (36) aligned),
133          get_wdir_ entry () returns (char (168) aligned),
134          hcs_$append_link entry (char (*), char (*), char (*), bit (36) aligned),
135          hcs_$delentry_file entry (char (*), char (*), bit (36) aligned),
136          hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, bit (36) aligned),
137          hcs_$set_bc entry (char (*), char (*), fixed bin (24), bit (36) aligned),
138          hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), bit (36) aligned),
139          hcs_$terminate_noname entry (ptr, bit (36) aligned),
140          ioa_ entry options (variable),
141          ioa_$ioa_stream entry options (variable),
142          ios_$attach entry (char (*), char (*), char (*), char (*), 1 aligned like status),
143          ios_$detach entry (char (*), char (*), char (*), 1 aligned like status),
144          ios_$seek entry (char (*), char (*), char (*), fixed bin (24), 1 aligned like status),
145          ios_$write_ptr entry (ptr, fixed bin (24), fixed bin (24)),
146          tssi_$finish_segment entry (ptr, fixed bin (24), bit (36) aligned, ptr, bit (36) aligned),
147          tssi_$get_segment entry (char (*), char (*), ptr, ptr, bit (36) aligned);
148 
149 declare
150         (addr, divide, index, length, null, reverse, substr, unspec, verify)
151          builtin;
152 ^L
153 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
154 
155           map355_severity_ = 0;                             /* initially */
156           unspec (NP) = "000001100"b;
157 
158           dirname = get_pdir_ ();
159           string_len = length (dirname) - verify (reverse (dirname), " ") + 1;
160           process_dir = substr (dirname, 1, string_len);
161 
162           dirname = get_wdir_ ();
163           string_len = length (dirname) - verify (reverse (dirname), " ") + 1;
164           working_dir = substr (dirname, 1, string_len);
165 
166           call ioa_ ("MAP355");
167 
168           call cu_$arg_count (num_args);
169 
170           if num_args = 0
171           then do;
172                call ioa_ ("Usage is:^/^10xmap355 source -options-");
173                call ioa_ ("Current options are: -list, -comdk, -check, -noconvert, -gcos_list, -macro_file <path> -ag <gcos args>");
174                map355_severity_ = 2;
175                return;
176           end;
177 
178           call process_options (cu_$arg_list_ptr (), num_args);
179 
180           pddl = length (process_dir) - index (reverse (process_dir), ">"); /* get length of pdd */
181           pdd = substr (process_dir, 1, pddl);              /* get process dir dir name */
182           call reduce_path_name (pdd);                      /* reduce pdd name */
183           process_dir = pdd || substr (process_dir, pddl + 1); /* reconstruct name */
184 
185           call reduce_path_name (working_dir);
186           call reduce_path_name (source_dir);
187           call reduce_path_name (macro_file_pathname);
188 
189           jobdeck_pathname = process_dir || ">" || job_name || ".jobdk_";
190 
191           call ios_$attach ((job_deck_stream), "file_", (jobdeck_pathname), "w", status);
192           if status.error_code ^= ""b
193           then do;
194                err_code = status.error_code;
195                goto print_err_code;
196           end;
197 
198           call ios_$seek ((job_deck_stream), "write", "first", 0, status);
199 
200           call ioa_$ioa_stream ((job_deck_stream), "$      snumb   assm");
201           call ioa_$ioa_stream ((job_deck_stream), "$      ident   1234,ident");
202 
203           map355_options = "";
204           if options.only_check
205           then map355_options = map355_options || "ndeck,";
206           else map355_options = map355_options || "deck,";
207           if options.make_comdk
208           then map355_options = map355_options || "comdk,";
209           else map355_options = map355_options || "ncomdk,";
210 
211           map355_options = substr (map355_options, 1, length (map355_options) - 1);
212           call ioa_$ioa_stream ((job_deck_stream), "$      355map  ^a", map355_options);
213           call ioa_$ioa_stream ((job_deck_stream), "$      limits  20,128k         0.20 = 12 minutes");
214 
215           if options.from_comdk
216           then call ioa_$ioa_stream ((job_deck_stream), "$      prmfl   g*,r,l,^a>^a.comdk", source_dir, base_name);
217           else do;
218                call ioa_$ioa_stream ((job_deck_stream), "$      data    g*");
219                call ioa_$ioa_stream ((job_deck_stream), "$      select  ^a>^a^x-ascii", (source_dir), base_name ||
220                     source_suffix);
221           end;
222 
223 
224           call ioa_$ioa_stream ((job_deck_stream), "$      prmfl   **,r,r,^a", macro_file_pathname);
225           if options.make_gcos_list
226           then gcos_list_pathname = working_dir || ">" || base_name || ".glist";
227           else gcos_list_pathname = process_dir || ">" || base_name || ".glist_";
228 
229           call ioa_$ioa_stream ((job_deck_stream), "$      prmfl   p*,r/w,l,^a", gcos_list_pathname);
230 
231           if ^ options.only_check
232           then call ioa_$ioa_stream ((job_deck_stream), "$      prmfl   c*,r/w,l,^a>^a.objdk", working_dir, base_name);
233 
234           if options.make_comdk
235           then call ioa_$ioa_stream ((job_deck_stream), "$      prmfl   k*,r/w,l,^a>^a.comdk", working_dir, base_name);
236 
237           call ioa_$ioa_stream ((job_deck_stream), "$      endjob");
238 
239           call ios_$seek ((job_deck_stream), "bound", "write", 0, status);
240 
241           call ios_$detach ((job_deck_stream), "", "", status);
242 
243           if ^ options.only_check
244           then do;
245                call tssi_$get_segment ((working_dir), base_name || ".objdk", object_seg_ptr, acl_info_ptr, err_code);
246                if err_code ^= ""b
247                then do;
248                     call com_err_ (err_code, "map355", "Attempting to create object segment.");
249                     map355_severity_ = 2;
250                     return;
251                end;
252           end;
253 
254           call hcs_$append_link ((working_dir), (job_name || ".jobdk_.job_deck"),
255                (jobdeck_pathname || ".job_deck"), err_code);
256 
257           var_line = "gcos " || jobdeck_pathname || " -hd -tnc " || args;
258           command_line = var_line;
259           call cu_$cp (addr (command_line), length (var_line), err_code);
260 
261           if options.make_list
262           then list_pathname = working_dir || ">" || base_name || ".list";
263           else list_pathname = process_dir || ">" || base_name || ".list_";
264 
265           var_line = "gcos_sysprint " || gcos_list_pathname || " " || list_pathname || " -lower_case";
266           command_line = var_line;
267           call cu_$cp (addr (command_line), length (var_line), err_code);
268 
269           call check_error_messages ((list_pathname));
270 
271           if ^ options.only_check
272           then do;
273                call adjust_bit_count_ ((working_dir), base_name || ".objdk", "0"b, bit_count, err_code);
274                call tssi_$finish_segment (object_seg_ptr, bit_count, "1000"b, acl_info_ptr, err_code);
275                if err_code ^= ""b
276                then do;
277                     call com_err_ (err_code, "map355", "Calling tssi_$finish_segment.");
278                     map355_severity_ = 2;
279                     return;
280                end;
281           end;
282 
283           if options.make_comdk
284           then call abc_new_comdk ();
285 
286           dirname = process_dir;                            /* copy process dir name for calls to hardcore    */
287 
288           if ^ options.make_list
289           then call delete_$path (dirname, base_name || ".list_", "100110"b, "map355", err_code);
290 
291           if ^ options.from_comdk
292           then call delete_$path (dirname, base_name || ".comdk_", "100110"b, "map355", err_code);
293 
294           call hcs_$delentry_file (dirname, job_name || ".jobdk_", err_code);
295           call hcs_$delentry_file (dirname, job_name || ".jobdk_.job_deck", err_code);
296 
297           if ^ options.make_gcos_list
298           then call delete_$path (dirname, base_name || ".glist_", "100110"b, "map355", err_code);
299 
300           dirname = working_dir;
301 
302           call hcs_$delentry_file (dirname, job_name || ".jobdk_.sysprint", err_code);
303           call hcs_$delentry_file (dirname, job_name || ".jobdk_.job_deck", err_code);
304 
305           return;
306 
307 /* * * * * * * * * * * * * * * * * * * * * * * * */
308 
309 print_err_code:
310 unexpected_error:
311           call com_err_ (err_code, "map355", "");
312           map355_severity_ = 2;
313 
314           return;
315 
316 /* * * * * * * * * * * * * * * * * * * * * * * * */
317 
318 path_name_error:
319           call com_err_ ((36)"0"b, "map355", "path_name_error");
320 
321 return_to_caller:
322           map355_severity_ = 2;
323           return;
324 ^L
325 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
326 
327 reduce_path_name:
328           procedure (bv_path_name);
329 
330 /* * * * * PARAMETER DECLARATIONS  * * * * * * * */
331 
332 declare
333          bv_path_name character (168) varying
334          parameter;
335 
336 /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */
337 
338 declare
339          string_len fixed binary (24)
340          automatic;
341 
342 /* * * * * * * * * * * * * * * * * * * * * * * * */
343 
344                dirname = bv_path_name;
345 
346                call get_shortest_pathname_ (dirname, dirname, err_code);
347                if err_code ^= ""b then goto print_err_code;
348 
349                string_len = length (dirname) - verify (reverse (dirname), " ") + 1;
350                bv_path_name = substr (dirname, 1, string_len);
351 
352                return;
353 
354           end reduce_path_name;
355 ^L
356 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
357 
358 abc_new_comdk:
359           procedure ();
360 
361 /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */
362 
363 declare
364          bit_count fixed binary (24)
365          automatic;
366 
367 /* * * * * * * * * * * * * * * * * * * * * * * * */
368 
369                call hcs_$status_minf ((working_dir), base_name || ".comdk", 1b, (0), bit_count, err_code);
370                if err_code ^= ""b
371                then do;
372                     call com_err_ (err_code, "map355", "unable to set bit count on new comdk");
373                     map355_severity_ = 2;
374                     return;
375                end;
376 
377                bit_count = divide (bit_count, 36, 24, 0);
378                bit_count = divide (bit_count, 320, 24, 0);
379                bit_count = bit_count * 320;
380                bit_count = bit_count + 320;
381                bit_count = bit_count * 36;
382 
383                call hcs_$set_bc ((working_dir), base_name || ".comdk", bit_count, err_code);
384                if err_code ^= ""b
385                then do;
386                     call com_err_ (err_code, "map355", "unable to set bit count (^d) on new comdk", bit_count);
387                     map355_severity_ = 2;
388                     return;
389                end;
390 
391                return;
392 
393           end abc_new_comdk;
394 ^L
395 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
396 
397 check_error_messages:
398           procedure (bv_list_pathname);
399 
400 /* * * * * PARAMETER DECLARATIONS  * * * * * * * */
401 
402 declare
403          bv_list_pathname character (*)
404          parameter;
405 
406 /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */
407 
408 declare
409         (seg_type fixed binary (2),
410         (message_seg, seg_indx) fixed binary (12),
411         (bit_count, cur_position, last_char, newline_pos, temp_pos, the_end_pos) fixed binary (24),
412          seg_length (0 : 9) fixed binary (24),
413          temp_char character (1),
414          entry_name character (32),
415          dir_name character (168),
416          seg_pointer (0 : 9) pointer)
417          automatic;
418 
419 /* * * * * TEXT SECTION REFERENCES * * * * * * * */
420 
421 declare
422          number (0 : 9) character (1) initial ("0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
423          internal static;
424 
425 /* * * * * BASED & TEMPLATE REFERENCES * * * * * */
426 
427 declare
428          based_seg character (last_char)
429          based;
430 
431 /* * * * * STACK REFERENCES  * * * * * * * * * * */
432 
433 declare
434          program_interrupt condition;
435 
436 /* * * * * * * * * * * * * * * * * * * * * * * * */
437                call expand_path_ (addr (bv_list_pathname), length (bv_list_pathname), addr (dir_name), addr (entry_name),
438                     err_code);
439                if err_code ^= ""b
440                then goto err;
441 
442                call hcs_$status_minf (dir_name, entry_name, 1b, seg_type, bit_count, err_code);
443                                                             /* see if this is a multisegment file             */
444                if err_code ^= ""b
445                then goto err;
446 
447                if seg_type = 2
448                then do;                                     /* this is a directory (read: multi-segment file) */
449                     call expand_path_ (addr (bv_list_pathname), length (bv_list_pathname), addr (dir_name),
450                               null (), err_code);
451                     do seg_indx = 0 to bit_count - 1;
452                          call hcs_$initiate_count (dir_name, (number (seg_indx)), "", seg_length (seg_indx), 0,
453                               seg_pointer (seg_indx), err_code);
454                          if seg_pointer (seg_indx) = null ()
455                          then goto err;
456                     end;
457 
458 /* seg_pointer and seg_length arrays now hold addresses and */
459 /* bit_counts of each of N segs from 0 to N - 1             */
460                end;
461                else do;
462                     bit_count = 1;
463                     call hcs_$initiate_count (dir_name, entry_name, "", seg_length (0), 0, seg_pointer (0), err_code);
464                     if seg_pointer (0) = null ()
465                     then goto err;
466                end;
467 
468                seg_indx = bit_count;
469 
470                cur_position = 0;
471                do while (cur_position = 0);
472                     seg_indx = seg_indx - 1;
473                     if seg_indx < 0
474                     then do;
475                          call com_err_ ((36)"0"b, "map355", "can't find assembly error count message");
476                          goto terminate;
477                     end;
478 
479                     last_char = divide (seg_length (seg_indx), 9, 24, 0); /* get char lenth of a seg    */
480                     cur_position, the_end_pos = index (seg_pointer (seg_indx) -> based_seg,
481                                                   "warning flags in the above assembly");
482                                                             /* look for assembly total error count            */
483                end;
484 
485 /*      Now, character cur_position in segment seg_indx     */
486 /* points to the middle of the error count line, if this              */
487 /* count is non-zero, we also want to print the error lines   */
488 
489                message_seg = seg_indx;
490 
491                call ios_$write_ptr (seg_pointer (message_seg), cur_position - 19, 54);
492                if substr (seg_pointer (message_seg) -> based_seg, cur_position - 4, 2) ^= "no"
493                then do;                                     /* if there are any errors, print messages        */
494                     map355_severity_ = 1;                   /* and remember the fact */
495                     on program_interrupt                    /* if user doesn't want to see these lines,       */
496                          goto terminate;                    /* let him suppress the printing of them          */
497 
498                     do seg_indx = 0 by 1 to message_seg;    /* loop to print errors                           */
499                          last_char = divide (seg_length (seg_indx), 9, 24, 0); /* get char length of a seg  */
500                          if seg_indx = 0
501                          then do;
502                               cur_position = index (substr (seg_pointer (0) -> based_seg, 1, last_char), "program break");
503                                                             /* don't print alter listing                      */
504                               if cur_position = 0
505                               then do;
506                                    call com_err_ ((36)"0"b, "map355", "can't find ""program break"".");
507                                    cur_position = 1;
508                               end;
509                          end;
510                          else cur_position = 1;
511 
512                          do while (cur_position < last_char);
513                               if (seg_indx = message_seg) & (cur_position >= the_end_pos)
514                               then goto terminate;          /* no need to look further                        */
515 
516                               newline_pos = index (substr (seg_pointer (seg_indx) -> based_seg, cur_position,
517                                    last_char + 1 - cur_position), NL);
518                               if newline_pos = 0
519                               then goto done;               /* done with this segment                         */
520 
521                               temp_char = substr (seg_pointer (seg_indx) -> based_seg, cur_position + newline_pos, 1);
522                               if (temp_char ^= " ") & (temp_char ^= NP) &
523                                  (index ("0123456789", temp_char) = 0) & (temp_char ^= NL)
524                               then do;
525                                    temp_pos = index (substr (seg_pointer (seg_indx) -> based_seg,
526                                         cur_position + newline_pos, last_char - cur_position - newline_pos + 1), NL);
527                                                             /* look for next newline                          */
528                                    if temp_pos = 0
529                                    then temp_pos = last_char - cur_position - newline_pos + 1; /* this indicates   */
530                                                             /* error in last line in seg -- NP      */
531                                    call ioa_ (substr (seg_pointer (seg_indx) -> based_seg, cur_position + newline_pos,
532                                         temp_pos - 1));
533                                                             /* print line in error                            */
534                               end;
535                               cur_position = cur_position + newline_pos;
536                          end;
537 done:               end;
538                end;
539 
540 terminate:
541                revert program_interrupt;
542 
543                do seg_indx = 0 to bit_count - 1;
544                     call hcs_$terminate_noname (seg_pointer (seg_indx), err_code);
545                end;
546 
547                return;
548 
549 /* * * * * * * * * * * * * * * * * * * * * * * * */
550 
551 err:
552                call com_err_ (err_code, "map355", "checking for error messages in listing file.");
553                map355_severity_ = 2;                        /* couldn't find error message, something must be wrong */
554 
555                return;
556 
557           end check_error_messages;
558 ^L
559 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
560 
561 process_options:
562           procedure (bv_arg_list_ptr, bv_num_args);
563 
564 /* * * * * PARAMETER DECLARATIONS  * * * * * * * */
565 
566 declare
567         (bv_num_args fixed binary (17),
568          bv_arg_list_ptr pointer)
569          parameter;
570 
571 /* * * * * AUTOMATIC STORAGE DECLARATIONS  * * * */
572 
573 declare
574         (indx fixed binary (17),
575          string_len fixed binary (24))
576          automatic;
577 
578 /* * * * * * * * * * * * * * * * * * * * * * * * */
579 
580                call cu_$arg_ptr_rel (1, arg_ptr, arg_length, err_code, bv_arg_list_ptr);
581                if err_code ^= ""b
582                then goto unexpected_error;
583 
584                call expand_path_ (arg_ptr, arg_length, addr (dirname), addr (ename), err_code);
585                if err_code ^= ""b
586                then goto print_err_code;
587 
588                macro_file_pathname = ">ldd>mcs>info>355_macros";
589 
590                options.only_check = "0"b;
591                options.make_comdk = "0"b;
592                options.from_comdk = "0"b;
593                options.make_list = "0"b;
594                options.make_gcos_list = "0"b;
595 
596                do indx = 2 by 1 to bv_num_args;
597                     call cu_$arg_ptr_rel (indx, arg_ptr, arg_length, err_code, bv_arg_list_ptr);
598                     if err_code ^= ""b
599                     then goto unexpected_error;
600 
601                     call process_control_argument (arg_ptr -> based_argument);
602                end;
603 
604                string_len = length (dirname) - verify (reverse (dirname), " ") + 1;
605                source_dir = substr (dirname, 1, string_len);
606 
607                string_len = length (ename) - verify (reverse (ename), " ") + 1;
608                if options.from_comdk then do;
609                     if string_len > length (comdk_suffix)
610                     then if substr (ename, string_len + 1 - length (comdk_suffix), length (comdk_suffix)) = comdk_suffix
611                          then string_len = string_len - length (comdk_suffix);
612                end;
613                else do;
614                     if string_len > length (source_suffix)
615                     then if substr (ename, string_len + 1 - length (source_suffix), length (source_suffix)) = source_suffix
616                          then string_len = string_len - length (source_suffix);
617                end;
618 
619                base_name = substr (ename, 1, string_len);
620 
621                if length (base_name) > 11 then
622                     job_name = substr (base_name, 1, 11);
623                else job_name = base_name;
624 
625                return;
626 ^L
627 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
628 
629 process_control_argument:
630                procedure (bv_control_argument);
631 
632 /* * * * * PARAMETER DECLARATIONS  * * * * * * * */
633 
634 declare
635          bv_control_argument character (*)
636          parameter;
637 
638 /* * * * * * * * * * * * * * * * * * * * * * * * */
639 
640                     if argsw then do;
641                          args = args || " " || bv_control_argument;
642                          return;
643                     end;
644 
645                     if (bv_control_argument = "-ag" | bv_control_argument = "-arguments") then do;
646                          argsw = "1"b;
647                          args = "";                         /* clear the default of -brief */
648                          return;
649                     end;
650 
651                     if bv_control_argument = "-noconvert"
652                     then do;
653                          options.from_comdk = "1"b;
654                          return;
655                     end;
656 
657                     if (bv_control_argument = "-list") | (bv_control_argument = "-ls")
658                     then do;
659                          options.make_list = "1"b;
660                          return;
661                     end;
662 
663                     if bv_control_argument = "-comdk"
664                     then do;
665                          options.make_comdk = "1"b;
666                          return;
667                     end;
668 
669                     if bv_control_argument = "-check"
670                     then do;
671                          options.only_check = "1"b;
672                          return;
673                     end;
674 
675                     if (bv_control_argument = "-gcos_list") | (bv_control_argument = "-gcls")
676                     then do;
677                          options.make_gcos_list = "1"b;
678                          return;
679                     end;
680 
681                     if (bv_control_argument = "-macro_file")
682                     then do;
683                          indx = indx + 1;
684                          call cu_$arg_ptr_rel (indx, arg_ptr, arg_length, err_code, bv_arg_list_ptr);
685                          if err_code ^= ""b
686                          then do;
687                               call com_err_ (err_code, "map355", "getting pathname of macros");
688                               goto return_to_caller;
689                          end;
690                          call expand_path_ (arg_ptr, arg_length, addr (dirname), null (), err_code);
691                          if err_code ^= ""b
692                          then do;
693                               call com_err_ (err_code, "map355", "Expanding pathname of macro file.");
694                               goto return_to_caller;
695                          end;
696                          macro_file_pathname = dirname;
697                          return;
698                     end;
699 
700                     call com_err_ (error_table_$badopt, "map355", bv_control_argument);
701 
702                     goto return_to_caller;
703 
704                end process_control_argument;
705 
706 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
707 
708           end process_options;
709 
710 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
711 
712      end map355;