1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1988                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1986 *
   6         *                                                         *
   7         *********************************************************** */
   8 
   9 /****^  HISTORY COMMENTS:
  10   1) change(86-12-03,DGHowe), approve(86-12-03,MCR7592),
  11      audit(87-01-07,Martinson), install(87-01-07,MR12.0-1261):
  12      cc, is the command that puts a C source segment through the various passes
  13      of the c compiler. It can generate output files with suffixes of .cpp .alm
  14   2) change(88-08-30,DGHowe), approve(88-08-30,MCR7967),
  15      audit(88-09-09,RWaters), install(88-10-10,MR12.2-1157):
  16      Alter to use tssi_ interface to access alm segments. Use find_source_file_
  17      to find and access the alm source file.
  18   3) change(89-01-25,RWaters), approve(89-01-25,MCR8026),
  19      audit(89-02-06,DGHowe), install(89-03-01,MR12.3-1019):
  20      Added the -list control argument, and modified to use search rules to find
  21      the default library.
  22   4) change(90-07-31,DGHowe), approve(90-07-31,MCR8181), audit(90-10-11,Itani),
  23      install(90-10-17,MR12.4-1045):
  24      Changed to allow the use of referencing directory search rules.
  25                                                    END HISTORY COMMENTS */
  26 
  27 
  28 /* format: ind3,ifthen,^ifthendo,^indnoniterdo,^indend,insnl,^inddcls,^elsestmt,indbegin,comcol68,ll80 */
  29 
  30 
  31 /* cc
  32    is the command to run a c program through cpp, comp, alm and the
  33    linkage editor. It is dependant on the input arguments. It may
  34    also in the future run the alm output through the optimizer.
  35    Only programs named prefix.c are run through the compiler the
  36    rest are passed onto the linkage editor as input.
  37 
  38    all errors are reported via com_err_.
  39 
  40 */
  41 
  42 c_compile:
  43 cc:
  44 c:
  45    procedure ();
  46 
  47 
  48 /* external routines */
  49 
  50 dcl     absolute_pathname_     entry (char (*), char (*), fixed bin (35));
  51 dcl     alm_                   entry (pointer, pointer, fixed bin (35),
  52                                fixed bin (35));
  53 dcl     com_err_               entry () options (variable);
  54 dcl     cu_$arg_count          entry (fixed bin, fixed bin (35));
  55 dcl     cu_$arg_list_ptr       entry (ptr);
  56 dcl     cu_$arg_ptr_rel        entry (fixed bin, ptr, fixed bin (21),
  57                                fixed bin (35), ptr);
  58 dcl     cu_$cl                 entry ();
  59 dcl     cu_$gen_call           entry () options (variable);
  60 dcl     delete_$path           entry (char (*), char (*), bit (36) aligned,
  61                                char (*), fixed bin (35));
  62 dcl     expand_pathname_       entry (char (*), char (*), char (*),
  63                                fixed bin (35));
  64 dcl     find_source_file_      entry (char (*), char (*), char (*), ptr,
  65                                fixed bin (24), fixed bin (35));
  66 dcl     get_pdir_              entry () returns (char (168));
  67 dcl     get_system_free_area_  entry () returns (ptr);
  68 dcl     get_temp_segment_      entry (char (*), ptr, fixed bin (35));
  69 dcl     hcs_$fs_get_path_name  entry (ptr, char (*), fixed bin,
  70                                char (*), fixed bin (35));
  71 dcl     hcs_$make_ptr          entry (ptr, char(*), char(*), ptr,
  72                                fixed bin(35));
  73 dcl     release_temp_segment_  entry (char (*), ptr, fixed bin (35));
  74 dcl     terminate_file_        entry (ptr, fixed bin (24), bit (*),
  75                                fixed bin (35));
  76 dcl     tssi_$clean_up_segment entry (ptr);
  77 dcl     tssi_$get_segment      entry (char (*), char (*), ptr, ptr,
  78                                fixed bin (35));
  79 dcl     tssi_$finish_segment   entry (ptr, fixed bin (24), bit (36) aligned,
  80                                ptr, fixed bin (35));
  81 
  82 
  83 dcl     ioa_                   entry () options (variable);
  84 
  85 
  86 /* builtins */
  87 
  88 dcl     (addr, after, before, index, length, null, reverse, rtrim,
  89         substr, unspec)
  90                                builtin;
  91 
  92 
  93 /* conditions */
  94 
  95 dcl     cleanup                condition;
  96 
  97 /* automatic */
  98 
  99 dcl     arg_count              fixed bin automatic;                /* number of command line args */
 100 dcl     arg_length             fixed bin (21) automatic;           /* length of current argument */
 101 dcl     arglist_ptr            pointer automatic;                  /* ptr to our arglist */
 102 dcl     arg_list_arg_count     fixed bin automatic;                /* size of the arg lists to cpp and comp */
 103 dcl     arg_ptr                pointer automatic;                  /* ptr to our current argument */
 104 dcl     call_arg_ptr           pointer automatic;                  /* ptr to the arglsit for calls to cpp and comp */
 105 dcl     current_file_name      char (168) automatic;               /* the current input file to this pass */
 106 dcl     current_source_file    char (168) automatic;               /* the current file being compiled */
 107 dcl     cpp_ptr                pointer automatic;                  /* pointer to the cpp entry */
 108 dcl     comp_ptr               pointer automatic;                  /* pointer to the comp entry */
 109 dcl     desc_ptr               pointer automatic;                  /* pointer to the descriptor list for the call */
 110 dcl     directory_name         char (168) automatic;               /* the directory portion of the filename */
 111 dcl     error_code             fixed bin (35) automatic;           /* system error code */
 112 dcl     error_occurred         bit (1) automatic;                  /* specifies an error has occurred in one of the passes */
 113 dcl     filename               char (168) automatic;               /* the current output filename for this pass */
 114 dcl     (i, j)                 fixed bin automatic;                /* loop counter */
 115 dcl     le_ptr                 pointer automatic;                  /* ptr to the le command */
 116 dcl     lib_dir                char (168) automatic;               /* directory name for the lib */
 117 dcl     lib_dir_length         fixed bin automatic;                /* length of lib dir name */
 118 dcl     lib_entry              char (32) automatic;                /* entry name for lib */
 119 dcl     lib_full_path          char (168) automatic;               /* full path of lib */
 120 dcl     lib_ptr                pointer automatic;                  /* ptr to the runtime lib */
 121 dcl     list                   bit (1) automatic;                  /* -ls specified */
 122 dcl     long_sw                bit (1) automatic;                  /* specifies if the -lg or -bf option were given */
 123 dcl     main_dir               char (168) automatic;               /* directory name for main_ */
 124 dcl     main_dir_length        fixed bin automatic;                /* length of main_ dir name */
 125 dcl     main_entry             char (32) automatic;                /* entry name for main_ */
 126 dcl     main_full_path         char (168) automatic;               /* full path of main_ */
 127 dcl     main_ptr               pointer automatic;                  /* a pointer to the main_ routine */
 128 dcl     number_of_defines      fixed bin automatic;                /* number of deines to pass onto cpp */
 129 dcl     number_of_files        fixed bin automatic;                /* the number of input files */
 130 dcl     number_of_includes     fixed bin automatic;                /* the number of include dirs */
 131 dcl     number_of_libraries    fixed bin automatic;                /* the number of libraries specified by the user */
 132 dcl     number_of_undefines    fixed bin automatic;                /* the number of undefines to pass to cpp */
 133 dcl     only_alm               bit (1) automatic;                  /* -S specified. stop before alm */
 134 dcl     only_compile           bit (1) automatic;                  /* -c command line option stop after alm */
 135 dcl     only_cpp               bit (1) automatic;                  /* -E specified. run through cpp only */
 136 dcl     only_le                bit (1) automatic;                  /* specifies this file is only input to the le if .cob or not other suffixes */
 137 dcl     optimize               bit (1) automatic;                  /* -ot optimize not available */
 138 dcl     output_file            bit (1) automatic;                  /* -of specified output file name is next arg */
 139 dcl     output_file_name       char (168) automatic;               /* the output_file_name if present */
 140 dcl     profile                bit (1) automatic;                  /* -p specified */
 141 dcl     process_dir            char (168) automatic;               /* out process directory */
 142 dcl     source_entry_name      char (168) automatic;               /* the entry name portio of the filename */
 143 dcl     source_prefix          char (168) automatic;               /* the prefix of the source file name */
 144 dcl     source_suffix          char (168) automatic;               /* the suffix of the source file name */
 145 dcl     start_alm              bit (1) automatic;                  /* start passes at alm if filename is .alm */
 146 dcl     start_comp             bit (1) automatic;                  /* start passes at comp if filename .cpp */
 147 dcl     start_cpp              bit (1) automatic;                  /* start passes at cpp if filename .c */
 148 dcl     sys_area_ptr           pointer automatic;                  /* pointer to the sys free area */
 149 dcl     table                  bit (1) automatic;                  /* -tb specified */
 150 
 151 
 152 /* constants */
 153 
 154 dcl     ME                     char (2) init ("cc") static options (constant);
 155 dcl     CPP_NAME               char (3) init ("cpp") static options (constant);
 156 dcl     COMP_NAME              char (4) init ("ccom") static options (constant);
 157 
 158 dcl     LIB_NAME               char (16) init ("runtime.archive")
 159                                static options (constant);
 160 dcl     DESC_BITS              bit (12) unaligned init ("5260"b3) static
 161                                options (constant);
 162 dcl     LE_NAME                char (2) init ("le") static options (constant);
 163 dcl     LIB                    char (3) init ("-lb") static options (constant);
 164 dcl     LIST                   char (5) init ("-list") static
 165                                options (constant);
 166 dcl     MAIN_                  char (5) init ("main_") static
 167                                options (constant);
 168 dcl     NOVER                  char (6) init ("-nvers") static
 169                                options (constant);
 170 dcl     OUTFILE                char (3) init ("-of") static options (constant);
 171 
 172 
 173 /* externals */
 174 
 175 dcl     C_inter_level_value    ext fixed bin (35);                 /* the variable C uses to pass values in between mains */
 176 
 177 
 178 /* based */
 179 
 180 dcl     argument               char (arg_length) based (arg_ptr);
 181 dcl     1 arglist              like command_name_arglist based (call_arg_ptr);
 182 
 183 dcl     1 descriptors          unaligned based (desc_ptr),
 184           2 desc               (arg_list_arg_count),
 185             3 bits             bit (12) unaligned,
 186             3 size             fixed bin (24) unsigned unaligned;
 187 
 188 dcl     1 file_list_desc       based,
 189           2 pathname           (arg_count),
 190             3 name             char (168),
 191             3 name_length      fixed bin (21),
 192             3 output_name      char (168),
 193             3 output_name_length
 194                                fixed bin (21);
 195 
 196 dcl     sys_area               area based (sys_area_ptr);
 197 
 198 %page;
 199 
 200       call cu_$arg_count (arg_count, error_code);
 201       if (error_code ^= 0) | (arg_count ^> 0) then
 202          do;
 203          call com_err_ (error_code, ME,
 204               "Syntax: cc [options] file1... fileN.");
 205          return;
 206       end;
 207 
 208       call cu_$arg_list_ptr (arglist_ptr);
 209 
 210       number_of_libraries, number_of_includes, number_of_defines,
 211            number_of_undefines, number_of_files = 0;
 212       only_alm, only_compile, only_cpp, only_le, error_occurred = "0"b;
 213       optimize, output_file, long_sw, profile, table, list = "0"b;
 214       output_file_name = "a.out";
 215 
 216       sys_area_ptr = get_system_free_area_ ();
 217 
 218 /* get pointers to all of the routines that we require to execute. */
 219 
 220       process_dir = get_pdir_ ();
 221 
 222 /* set up a pointer to main_ */
 223 
 224       call hcs_$make_ptr (codeptr (c_compile), MAIN_, "", main_ptr, error_code);
 225       if error_code ^= 0 then
 226          do;
 227          call com_err_ (error_code, ME, "Can not find main_.");
 228          goto ERROR;
 229       end;
 230 
 231 /* get pathname for main_ */
 232 
 233       call hcs_$fs_get_path_name (main_ptr, main_dir, main_dir_length,
 234            main_entry, error_code);
 235       if error_code ^= 0 then
 236          do;
 237          call com_err_ (error_code, ME, "Finding pathname of main_.");
 238          goto ERROR;
 239       end;
 240 
 241       main_full_path = rtrim (main_dir, " >") || ">" || rtrim (main_entry);
 242 
 243 
 244 /* set up a pointer to runtime library */
 245 
 246       call hcs_$make_ptr (codeptr(c_compile), LIB_NAME, "", lib_ptr, error_code);
 247       if error_code ^= 0 then
 248          do;
 249          call com_err_ (error_code, ME, "While locating the Runtime Library.");
 250          call cu_$cl ();
 251          goto ERROR;
 252       end;
 253 
 254 /* get pathname for library */
 255 
 256       call hcs_$fs_get_path_name (lib_ptr, lib_dir, lib_dir_length,
 257            lib_entry, error_code);
 258       if error_code ^= 0 then
 259          do;
 260          call com_err_ (error_code, ME, "Finding pathname of the Runtime Library.");
 261          goto ERROR;
 262       end;
 263 
 264       lib_full_path = rtrim (lib_dir, " >") || ">" || rtrim (lib_entry);
 265 
 266 
 267 /* set up a pointer to cpp */
 268 
 269       call hcs_$make_ptr (codeptr (c_compile), CPP_NAME, "main_", cpp_ptr,
 270            error_code);
 271       if error_code ^= 0 then
 272          do;
 273          call com_err_ (error_code, ME, "Can not find cpp.");
 274          goto ERROR;
 275       end;
 276 
 277 
 278 /* set up a pointer to comp */
 279 
 280       call hcs_$make_ptr (codeptr (c_compile), COMP_NAME, "main_", comp_ptr,
 281            error_code);
 282       if error_code ^= 0 then
 283          do;
 284          call com_err_ (error_code, ME, "Can not find ccom.");
 285          goto ERROR;
 286       end;
 287 
 288 /* set up a pointer to le */
 289 
 290       call hcs_$make_ptr (codeptr(c_compile), LE_NAME, "le", le_ptr, error_code);
 291       if error_code ^= 0 then
 292          do;
 293          call com_err_ (error_code, ME, "Can not find le.");
 294          goto ERROR;
 295       end;
 296 
 297 %page;
 298 
 299 /* we set up a begin block to allocate our file list for us as the
 300    maximum size is known from the number of args given to us.
 301 */
 302 
 303       begin;
 304 
 305 dcl     1 file_list            like file_list_desc automatic;
 306 
 307 
 308 /* initialize the file list */
 309 
 310          do i = 1 to arg_count;
 311             file_list.pathname (i).name = "";
 312             file_list.pathname (i).name_length = 0;
 313             file_list.pathname (i).output_name = "";
 314             file_list.pathname (i).output_name_length = 0;
 315          end;
 316 
 317 
 318 /* get our temp seg and set up a cleanup handler for it */
 319 
 320          cc_info_ptr = null ();
 321 
 322          on condition (cleanup)
 323             begin;
 324 
 325                call cleanup_objs (addr (file_list));
 326 
 327                if cc_info_ptr ^= null () then
 328                   call release_temp_segment_ ("cc", cc_info_ptr, error_code);
 329             end;
 330 
 331 
 332          call get_temp_segment_ ("cc", cc_info_ptr, error_code);
 333          if error_code ^= 0 then
 334             do;
 335             call com_err_ (error_code, ME,
 336                  "While obtaining the temporary segment for cc.");
 337             goto ERROR;
 338          end;
 339 
 340 
 341 /* parse the input arguments */
 342 
 343          call parse_args (addr (file_list), arglist_ptr);
 344 
 345          if number_of_files = 0 then
 346             do;
 347             call com_err_ (0, ME, "No input files specified.");
 348             goto ERROR;
 349          end;
 350 
 351 
 352 %page;
 353 
 354 /* loop through all of the files generating the temporary files
 355    in the process dir unless otherwise specified
 356 */
 357 
 358          do i = 1 to number_of_files;
 359 
 360 /* get the current file name */
 361 
 362             current_file_name =
 363                  substr (file_list.pathname (i).name, 1,
 364                  file_list.pathname (i).name_length);
 365             current_source_file = rtrim (current_file_name);
 366             filename = rtrim (current_file_name);
 367 
 368 
 369             call expand_pathname_ (substr (file_list.pathname (i).name, 1,
 370                  file_list.pathname (i).name_length),
 371                  directory_name, source_entry_name, error_code);
 372             if error_code ^= 0 then
 373                do;
 374                call com_err_ (error_code, ME,
 375                     "An error has occurred while locating ^a",
 376                     current_file_name);
 377                goto ERROR;
 378             end;
 379 
 380 
 381 /* get the prefix and suffix from the source file name entryname */
 382 
 383             source_suffix =
 384                  rtrim (reverse (before (reverse (source_entry_name), ".")));
 385             source_prefix =
 386                  rtrim (reverse (after (reverse (source_entry_name), ".")));
 387 
 388 
 389 /* now check and see what passes the file has to go through by its
 390    suffix name. ie. .c through all passes, .cpp through comp, .alm
 391    through alm and all the rest including .cob files go through the
 392    le only.
 393 */
 394 
 395             only_le, start_cpp, start_comp, start_alm = "0"b;
 396 
 397             if source_suffix = "c" then
 398                start_cpp, start_comp, start_alm = "1"b;
 399             else if source_suffix = "cpp" then
 400                start_alm, start_comp = "1"b;
 401             else if source_suffix = "alm" then
 402                start_alm = "1"b;
 403 
 404 /* we have either a .cob file or some other suffix so it must be
 405     input to the le
 406 */
 407             else
 408                only_le = "1"b;
 409 
 410 
 411 /* now call the various passes. C_inter_level_value is the only way
 412    we have of telling if an error has occured in compiler as it does an
 413    exit(0) if no errors and an exit(1|2) if an error occurs.
 414 */
 415 
 416             if ^only_le then
 417                do;
 418 
 419 /*  set up for the call to cpp */
 420 
 421                if start_cpp then
 422                   do;
 423                   if long_sw then
 424                      call ioa_ ("Preprocessing ^a.", source_entry_name);
 425                   call do_cpp ();
 426                   if C_inter_level_value ^= 0 then
 427                      do;
 428                      call com_err_ (0, ME,
 429                           "An error has occurred while Preprocessing ^a.",
 430                           current_source_file);
 431                      error_occurred = "1"b;
 432                      goto NEXT_FILE;
 433                   end;
 434                end;
 435 
 436                if only_cpp then
 437                   goto NEXT_FILE;
 438 
 439 
 440 /* set up for call to comp input file name is the output filename from cpp */
 441 
 442                if start_comp then
 443                   do;
 444                   if long_sw then
 445                      call ioa_ ("Compiling ^a.", source_entry_name);
 446 
 447                   call do_comp ();
 448                   if C_inter_level_value ^= 0 then
 449                      do;
 450                      call com_err_ (0, ME,
 451                           "An error has occurred while Compiling ^a.",
 452                           current_source_file);
 453                      error_occurred = "1"b;
 454                      goto NEXT_FILE;
 455                   end;
 456                end;
 457 
 458                if only_alm then
 459                   goto NEXT_FILE;
 460 
 461 
 462 /* set for call to alm */
 463 
 464                if start_alm then
 465                   do;
 466                   if long_sw then
 467                      call ioa_ ("Assembling ^a.", source_entry_name);
 468                   call do_alm ();
 469                end;
 470 
 471                if only_compile then
 472                   goto NEXT_FILE;
 473 
 474             end;
 475                                                                    /* we have the object name in filename so we store it in the filename list */
 476 
 477             file_list.pathname (i).output_name = rtrim (filename);
 478             file_list.pathname (i).output_name_length =
 479                  length (rtrim (filename));
 480 
 481 NEXT_FILE:
 482          end;
 483 
 484 /* we should be finished all of the files now so we can set up for the
 485    linkage editor.
 486 */
 487 
 488          if ^only_compile & ^only_alm & ^only_cpp & ^error_occurred then
 489             do;
 490             if long_sw then
 491                call ioa_ ("Link Editing.");
 492             call do_le (addr (file_list));
 493          end;
 494 
 495          call cleanup_objs (addr (file_list));
 496 
 497       end;
 498 
 499 
 500 ERROR:
 501       if cc_info_ptr ^= null () then
 502          call release_temp_segment_ ("cc", cc_info_ptr, error_code);
 503 
 504       return;
 505 
 506 %page;
 507 /* cleanup_objs
 508    goes through the file name list and deletes any output file names
 509    in the process dir. As we would have created them in there we
 510    should be able to delete them.
 511 */
 512 
 513 cleanup_objs:
 514    procedure (filelist_ptr);
 515 
 516 /* parameters */
 517 
 518 dcl     filelist_ptr           pointer parameter;
 519 
 520 /* automatic */
 521 
 522 dcl     entry_name             char (168) automatic;
 523 dcl     dir_name               char (168) automatic;
 524 dcl     i                      fixed bin automatic;
 525 
 526 /* based */
 527 
 528 dcl     1 file_list            like file_list_desc based (filelist_ptr);
 529 
 530 
 531       if number_of_files = 0 then
 532          return;
 533 
 534       do i = 1 to number_of_files;
 535 
 536          call expand_pathname_ (file_list.pathname (i).output_name,
 537               dir_name, entry_name, error_code);
 538 
 539          if dir_name = process_dir then
 540             call delete_$path (dir_name, entry_name, "010100"b, "cc",
 541                  error_code);
 542       end;
 543 
 544    end cleanup_objs;
 545 %page;
 546 
 547 /* do_le
 548    sets and calls the linkage editor. Because of the amount of work
 549    involved in doing what le the command does we will set up a command
 550    argument list and call the le command.
 551 */
 552 
 553 do_le:
 554    procedure (filelist_ptr);
 555 
 556 /* parameters */
 557 
 558 dcl     filelist_ptr           pointer parameter;
 559 
 560 /* automatic */
 561 
 562 dcl     (j, k, l)              fixed bin automatic;
 563 dcl     have_default_lib       bit (1) automatic;
 564 dcl     default_lib            char (168) automatic;
 565 dcl     cur_lib_path           char (168) automatic;
 566 
 567 /* based */
 568 
 569 dcl     1 file_list            like file_list_desc based (filelist_ptr);
 570 
 571 /* check if the user specified the default libary path */
 572 
 573       have_default_lib = "0"b;
 574       call absolute_pathname_ (lib_full_path, default_lib, error_code);
 575 
 576       do i = 1 to number_of_libraries;
 577 
 578          call absolute_pathname_ (cc_info.libraries (i).library_pathname,
 579               cur_lib_path, error_code);
 580 
 581          if error_code ^= 0 then
 582             do;
 583             call com_err_ (error_code, ME, "Can not find library ^a.",
 584                  cc_info.libraries (i).library_pathname);
 585             goto ERROR;
 586          end;
 587 
 588          if rtrim (default_lib) = rtrim (cur_lib_path) then
 589             have_default_lib = "1"b;
 590       end;
 591 
 592 
 593 
 594 /* times 2 for the -lib for each library + 4 for main_ , -lib
 595     default lib and the -novers control arg.
 596 */
 597       arg_list_arg_count = number_of_files + 4 + (number_of_libraries * 2);
 598 
 599       if have_default_lib then
 600          arg_list_arg_count = arg_list_arg_count - 2;              /* for -lib and path */
 601 
 602 
 603       if output_file then
 604          arg_list_arg_count = arg_list_arg_count + 2;              /* + 2 for -of and filename */
 605 
 606       if list then
 607          arg_list_arg_count = arg_list_arg_count + 1;
 608 
 609 
 610       call_arg_ptr, desc_ptr = null ();
 611 
 612 
 613       on cleanup
 614          begin;
 615 
 616             if call_arg_ptr ^= null () then
 617                free arglist in (sys_area);
 618             if desc_ptr ^= null () then
 619                free descriptors in (sys_area);
 620          end;
 621 
 622 
 623       allocate arglist in (sys_area) set (call_arg_ptr);
 624       allocate descriptors in (sys_area) set (desc_ptr);
 625 
 626 /* set up the argument list */
 627 
 628       arglist.arg_count = arg_list_arg_count;
 629       arglist.desc_count = arg_list_arg_count;
 630       arglist.call_type = Interseg_call_type;
 631       arglist.has_command_name = "1"b;
 632       arglist.mbz = "0"b;
 633       arglist.pad1 = "0"b;
 634       arglist.pad2 = "0"b;
 635       arglist.name.command_name_ptr = addr (LE_NAME);
 636       arglist.name.command_name_length = length (LE_NAME);
 637 
 638       k, l = 0;
 639 
 640       arglist.arg_ptrs (1) = addr (main_full_path);
 641       arglist.desc_ptrs (1) = addr (descriptors.desc (1));
 642       descriptors.desc (1).bits = DESC_BITS;
 643       descriptors.desc (1).size = length (rtrim (main_full_path));
 644 
 645       j = 2;                                                       /* next free position */
 646       l = 0;
 647       do j = 2 to (number_of_files + 1);
 648          l = l + 1;
 649          arglist.arg_ptrs (j) = addr (file_list.pathname (l).output_name);
 650          arglist.desc_ptrs (j) = addr (descriptors.desc (j));
 651          descriptors.desc (j).bits = DESC_BITS;
 652          descriptors.desc (j).size = file_list.pathname (l).output_name_length;
 653       end;
 654 
 655       k = j;                                                       /* have to set k in case we don't have any libs */
 656 
 657       l = 0;
 658       j = number_of_files + 1;                                     /* +1 for main_ */
 659       if number_of_libraries > 0 then
 660          do k = (j + 1) to ((number_of_libraries * 2) + j);
 661             l = l + 1;
 662 
 663             arglist.arg_ptrs (k) = addr (LIB);
 664             arglist.desc_ptrs (k) = addr (descriptors.desc (k));
 665             descriptors.desc (k).bits = DESC_BITS;
 666             descriptors.desc (k).size = length (rtrim (LIB));
 667 
 668             k = k + 1;
 669             arglist.arg_ptrs (k) =
 670                  addr (cc_info.libraries (l).library_pathname);
 671             arglist.desc_ptrs (k) = addr (descriptors.desc (k));
 672             descriptors.desc (k).bits = DESC_BITS;
 673             descriptors.desc (k).size =
 674                  cc_info.libraries (l).library_pathname_length;
 675 
 676          end;
 677 
 678       if output_file then
 679          do;
 680 
 681          arglist.arg_ptrs (k) = addr (OUTFILE);
 682          arglist.desc_ptrs (k) = addr (descriptors.desc (k));
 683          descriptors.desc (k).bits = DESC_BITS;
 684          descriptors.desc (k).size = length (OUTFILE);
 685 
 686          k = k + 1;
 687          arglist.arg_ptrs (k) = addr (output_file_name);
 688          arglist.desc_ptrs (k) = addr (descriptors.desc (k));
 689          descriptors.desc (k).bits = DESC_BITS;
 690          descriptors.desc (k).size = length (rtrim (output_file_name));
 691 
 692          k = k + 1;                                                /* so the next arg will be in the right place */
 693       end;
 694 
 695       if list then
 696          do;
 697 
 698          arglist.arg_ptrs (k) = addr (LIST);
 699          arglist.desc_ptrs (k) = addr (descriptors.desc (k));
 700          descriptors.desc (k).bits = DESC_BITS;
 701          descriptors.desc (k).size = length (LIST);
 702 
 703          k = k + 1;                                                /* so the next arg will be in the right place */
 704 
 705       end;
 706 
 707 /* default lib */
 708 
 709       if ^have_default_lib then
 710          do;
 711 
 712          arglist.arg_ptrs (k) = addr (LIB);
 713          arglist.desc_ptrs (k) = addr (descriptors.desc (k));
 714          descriptors.desc (k).bits = DESC_BITS;
 715          descriptors.desc (k).size = length (LIB);
 716 
 717          k = k + 1;
 718          arglist.arg_ptrs (k) = addr (default_lib);
 719          arglist.desc_ptrs (k) = addr (descriptors.desc (k));
 720          descriptors.desc (k).bits = DESC_BITS;
 721          descriptors.desc (k).size = length (rtrim (default_lib));
 722 
 723          k = k + 1;                                                /* so next arg will be in the right place */
 724 
 725       end;
 726 
 727 
 728 
 729 /* -novers */
 730 
 731       arglist.arg_ptrs (k) = addr (NOVER);
 732       arglist.desc_ptrs (k) = addr (descriptors.desc (k));
 733       descriptors.desc (k).bits = DESC_BITS;
 734       descriptors.desc (k).size = length (NOVER);
 735 
 736 /* do the call */
 737 
 738       call cu_$gen_call (le_ptr, call_arg_ptr);
 739 
 740 
 741    end do_le;
 742 %page;
 743 /* do_alm
 744    creates the info for the call to alm and performs the call.
 745    the output file from the previous pass is in filename as a full
 746    pathname.
 747 */
 748 
 749 do_alm:
 750    procedure ();
 751 
 752 
 753 /* automatic */
 754 
 755 dcl     entry_name             char (168) automatic;
 756 dcl     object_aclinfo_ptr     pointer automatic;
 757 dcl     output_directory       char (168) automatic;
 758 dcl     output_entry           char (168) automatic;
 759 dcl     severity               fixed bin (35) automatic;
 760 
 761 
 762 /* structures */
 763 
 764 dcl     01 ai                  like alm_info automatic;
 765 dcl     01 alm_args,
 766           02 version           char (8),
 767           02 argcount          fixed bin,
 768           02 args              (1),
 769             03 argptr          pointer,
 770             03 len             fixed bin (21);
 771 
 772 
 773 
 774 /* filename = our intput file name */
 775 
 776       current_file_name = rtrim (filename);
 777 
 778       if only_compile & output_file then
 779          filename = rtrim (output_file_name);
 780       else
 781          filename = rtrim (source_prefix) || ".cob";
 782 
 783       if ^only_compile & number_of_files = 1 then
 784          filename = rtrim (process_dir) || ">" || rtrim (filename);
 785 
 786 /* split the input and output filenames into a pathname and an entry
 787    name.
 788 */
 789 
 790       call expand_pathname_ (filename,
 791            output_directory, output_entry, error_code);
 792       if error_code ^= 0 then
 793          do;
 794          call com_err_ (error_code, ME,
 795               "An error has occurred while locating ^a", filename);
 796          goto ERROR;
 797       end;
 798 
 799 /* initialize the alm_info structure */
 800 
 801       ai.version = ALM_INFO_V1;
 802       unspec (ai.flags) = "0"b;
 803       ai.flags.brief = "1"b;
 804       ai.target = "";
 805       ai.generator = "C";
 806       ai.gen_number = C_gen_number;
 807       ai.gen_version = C_version_info;
 808       ai.gen_created = 0;
 809       ai.option_string = "";
 810       ai.source_path = "";
 811       ai.source_entryname = "";
 812       ai.source_ptr = null ();
 813       ai.source_bc = 0;
 814       ai.object_ptr = null ();
 815       ai.object_bc = 0;
 816       ai.list_fcb_ptr = null ();
 817       ai.list_component_ptr = null ();
 818       ai.list_bc = 0;
 819       ai.list_component = 0;
 820 
 821       on condition (cleanup)
 822          begin;
 823             if ai.source_ptr ^= null () then
 824                do;
 825                if (index (current_file_name, rtrim (process_dir)) = 1) then
 826                   call terminate_file_ (ai.source_ptr, 0, TERM_FILE_DELETE, 0);
 827                else
 828                   call terminate_file_ (ai.source_ptr, 0, TERM_FILE_TERM, 0);
 829             end;
 830             if object_aclinfo_ptr ^= null () then
 831                call tssi_$clean_up_segment (object_aclinfo_ptr);
 832 
 833          end;
 834 
 835 
 836 RETRY_SRC:
 837 
 838       call find_source_file_ (current_file_name, "alm",
 839            entry_name, ai.source_ptr, ai.source_bc, error_code);
 840       if error_code ^= 0 then
 841          do;
 842          call com_err_ (error_code, ME, "While initiating alm source.");
 843          call cu_$cl ();
 844          goto RETRY_SRC;
 845       end;
 846 
 847 RETRY_OBJ:
 848       call tssi_$get_segment (output_directory, output_entry,
 849            ai.object_ptr, object_aclinfo_ptr, error_code);
 850       if error_code ^= 0 then
 851          do;
 852          call com_err_ (error_code, ME, "While creating ALM object.");
 853          call cu_$cl ();
 854          goto RETRY_OBJ;
 855       end;
 856 
 857       alm_args.version = ALM_ARGS_V1;
 858       alm_args.argcount = 0;
 859 
 860       call alm_ (addr (ai), addr (alm_args), severity, error_code);
 861       if (error_code ^= 0) | (severity > 2) then
 862          do;
 863          call com_err_ (error_code, ME, "^/While assembling: ^a.",
 864               current_source_file);
 865          error_occurred = "1"b;
 866       end;
 867 
 868 /* want to terminate_file_ on both files  and set bit count on object */
 869 
 870       if (index (current_file_name, rtrim (process_dir)) = 1) then
 871          call terminate_file_ (ai.source_ptr, 0, TERM_FILE_DELETE, 0);
 872       else do;
 873          call terminate_file_ (ai.source_ptr, ai.source_bc,
 874               TERM_FILE_TERM, error_code);
 875          if error_code ^= 0 then
 876             call com_err_ (error_code, ME,
 877                  "An error occurred while terminating the alm file.");
 878       end;
 879 
 880       if object_aclinfo_ptr ^= null () then
 881          call tssi_$finish_segment (ai.object_ptr, ai.object_bc,
 882               "110"b, object_aclinfo_ptr, error_code);
 883       if (error_code ^= 0) & ^error_occurred then
 884          do;
 885          call com_err_ (error_code, ME,
 886               "An error occured while terminating ^a.", filename);
 887          goto ERROR;
 888       end;
 889 
 890 
 891 
 892    end do_alm;
 893 %page;
 894 /* do_comp
 895    performs the call to the second pass comp.
 896 */
 897 
 898 do_comp:
 899    procedure ();
 900 
 901 dcl     compiler_flags         char (10) automatic;
 902 dcl     dir_name               char (168) automatic;
 903 dcl     entry_name             char (168) automatic;
 904 
 905 
 906       arg_list_arg_count = 2;                                      /* input file and output file */
 907 
 908       if table | profile then
 909          do;
 910          arg_list_arg_count = 3;
 911          compiler_flags = "-X";
 912 
 913          if profile then
 914             compiler_flags = rtrim (compiler_flags) || "p";
 915 
 916          if table then
 917             compiler_flags = rtrim (compiler_flags) || "g";
 918 
 919       end;
 920 
 921 /* filename = our intput file name */
 922 
 923       current_file_name = rtrim (filename);
 924 
 925       if only_alm & output_file then
 926          filename = rtrim (output_file_name);
 927       else
 928          filename = rtrim (source_prefix) || ".alm";
 929 
 930       if ^only_alm then
 931          filename = rtrim (process_dir) || ">" ||
 932             rtrim (source_prefix) || ".alm";
 933 
 934       desc_ptr, call_arg_ptr = null ();
 935 
 936       on cleanup
 937          begin;
 938 
 939             if call_arg_ptr ^= null () then
 940                free arglist in (sys_area);
 941             if desc_ptr ^= null () then
 942                free descriptors in (sys_area);
 943 
 944 /* delete our input and output file if they are in the process dir. */
 945 
 946             if (index (filename, rtrim (process_dir)) = 1) then
 947                do;
 948                call expand_pathname_ (filename, dir_name, entry_name,
 949                     error_code);
 950                call delete_$path (dir_name, entry_name, "010100"b, "cc",
 951                     error_code);
 952             end;
 953 
 954 
 955             if (index (current_file_name, rtrim (process_dir)) = 1) then
 956                do;
 957 
 958                call expand_pathname_ (current_file_name, dir_name,
 959                     entry_name, error_code);
 960                call delete_$path (dir_name, entry_name, "010100"b, "cc",
 961                     error_code);
 962             end;
 963 
 964          end;
 965 
 966 
 967       allocate arglist in (sys_area) set (call_arg_ptr);
 968       allocate descriptors in (sys_area) set (desc_ptr);
 969 
 970 /* set up the argument list */
 971 
 972       arglist.arg_count = arg_list_arg_count;
 973       arglist.desc_count = arg_list_arg_count;
 974       arglist.call_type = Interseg_call_type;
 975       arglist.has_command_name = "1"b;
 976       arglist.mbz = "0"b;
 977       arglist.pad1 = "0"b;
 978       arglist.pad2 = "0"b;
 979       arglist.name.command_name_ptr = addr (COMP_NAME);
 980       arglist.name.command_name_length = length (COMP_NAME);
 981 
 982       j = 1;
 983       if table | profile then
 984          do;
 985          arglist.arg_ptrs (j) = addr (compiler_flags);
 986          arglist.desc_ptrs (j) = addr (descriptors.desc (j));
 987          descriptors.desc (j).bits = DESC_BITS;
 988          descriptors.desc (j).size = length (rtrim (compiler_flags));
 989          j = j + 1;
 990       end;
 991 
 992       arglist.arg_ptrs (j) = addr (current_file_name);
 993       arglist.desc_ptrs (j) = addr (descriptors.desc (j));
 994       descriptors.desc (j).bits = DESC_BITS;
 995       descriptors.desc (j).size = length (rtrim (current_file_name));
 996 
 997       j = j + 1;
 998       arglist.arg_ptrs (j) = addr (filename);
 999       arglist.desc_ptrs (j) = addr (descriptors.desc (j));
1000       descriptors.desc (j).bits = DESC_BITS;
1001       descriptors.desc (j).size = length (rtrim (filename));
1002 
1003       call cu_$gen_call (comp_ptr, call_arg_ptr);
1004 
1005       free arglist in (sys_area);
1006       free descriptors in (sys_area);
1007 
1008 
1009       if (index (current_file_name, rtrim (process_dir)) = 1) then
1010          do;
1011 
1012          call expand_pathname_ (current_file_name, dir_name,
1013               entry_name, error_code);
1014          call delete_$path (dir_name, entry_name, "010100"b, "cc",
1015               error_code);
1016       end;
1017 
1018    end do_comp;
1019 
1020 %page;
1021 /* do_cpp
1022    creates the argument list for cpp and performs the call.
1023 */
1024 
1025 do_cpp:
1026    procedure ();
1027 
1028 /* automatic */
1029 
1030 dcl     (j, k, l)              fixed bin automatic;
1031 dcl     dir_name               char (168) automatic;
1032 dcl     entry_name             char (168) automatic;
1033 dcl     processor_flags        char (10) automatic;
1034 
1035 
1036       arg_list_arg_count = number_of_defines +
1037            number_of_undefines + number_of_includes + 2;
1038 
1039       if table then
1040          do;
1041          arg_list_arg_count = arg_list_arg_count + 1;
1042          processor_flags = "-P";
1043       end;
1044 
1045 
1046       call_arg_ptr = null ();
1047       desc_ptr = null ();
1048 
1049       on cleanup
1050          begin;
1051 
1052             if call_arg_ptr ^= null () then
1053                free arglist in (sys_area);
1054             if desc_ptr ^= null () then
1055                free descriptors in (sys_area);
1056 
1057 /* delete our output file if it is in the process dir. */
1058 
1059             if (index (filename, rtrim (process_dir)) = 1) then
1060                do;
1061                call expand_pathname_ (filename, dir_name, entry_name,
1062                     error_code);
1063                call delete_$path (dir_name, entry_name, "010100"b, "cc",
1064                     error_code);
1065             end;
1066 
1067          end;
1068 
1069 
1070       allocate arglist in (sys_area) set (call_arg_ptr);
1071       allocate descriptors in (sys_area) set (desc_ptr);
1072 
1073 
1074 
1075 /* get output file name */
1076 
1077       if only_cpp & output_file then
1078          filename = rtrim (output_file_name);
1079       else
1080          filename = rtrim (source_prefix) || ".cpp";
1081 
1082       if ^only_cpp then
1083          filename = rtrim (process_dir) || ">" || rtrim (filename);
1084 
1085       arglist.arg_count = arg_list_arg_count;
1086       arglist.desc_count = arg_list_arg_count;
1087       arglist.call_type = Interseg_call_type;
1088       arglist.has_command_name = "1"b;
1089       arglist.mbz = "0"b;
1090       arglist.pad1 = "0"b;
1091       arglist.pad2 = "0"b;
1092       arglist.name.command_name_ptr = addr (CPP_NAME);
1093       arglist.name.command_name_length = length (CPP_NAME);
1094 
1095       j, k, l = 0;
1096 
1097       if number_of_defines > 0 then
1098          do j = 1 to number_of_defines;
1099             arglist.arg_ptrs (j) = addr (cc_info.defines (j).define_name);
1100             arglist.desc_ptrs (j) = addr (descriptors.desc (j));
1101             descriptors.desc (j).bits = DESC_BITS;
1102             descriptors.desc (j).size = cc_info.defines (j).define_name_length;
1103          end;
1104 
1105       l = 0;
1106       j = number_of_defines;
1107       if number_of_undefines > 0 then
1108          do k = (j + 1) to (number_of_undefines + j);
1109             l = l + 1;
1110             arglist.arg_ptrs (k) = addr (cc_info.undefines (l).undefine_name);
1111             arglist.desc_ptrs (k) = addr (descriptors.desc (k));
1112             descriptors.desc (k).bits = DESC_BITS;
1113             descriptors.desc (k).size =
1114                  cc_info.undefines (l).undefine_name_length;
1115          end;
1116 
1117       l = 0;
1118       k = number_of_defines + number_of_undefines;
1119       if number_of_includes > 0 then
1120          do j = (k + 1) to (number_of_includes + k);
1121             l = l + 1;
1122             arglist.arg_ptrs (j) =
1123                  addr (cc_info.include_files (l).include_pathname);
1124             arglist.desc_ptrs (j) = addr (descriptors.desc (j));
1125             descriptors.desc (j).bits = DESC_BITS;
1126             descriptors.desc (j).size =
1127                  cc_info.include_files (l).include_pathname_length;
1128 
1129          end;
1130 
1131 
1132 
1133 /* input file */
1134 
1135       j = number_of_defines + number_of_undefines + number_of_includes + 1;
1136 
1137       arglist.arg_ptrs (j) = addr (current_file_name);
1138       arglist.desc_ptrs (j) = addr (descriptors.desc (j));
1139       descriptors.desc (j).bits = DESC_BITS;
1140       descriptors.desc (j).size = length (rtrim (current_file_name));
1141 
1142 /* output_file */
1143 
1144       j = number_of_defines + number_of_undefines + number_of_includes + 2;
1145 
1146       if table then
1147          do;
1148          arglist.arg_ptrs (j) = addr (processor_flags);
1149          arglist.desc_ptrs (j) = addr (descriptors.desc (j));
1150          descriptors.desc (j).bits = DESC_BITS;
1151          descriptors.desc (j).size = length (rtrim (processor_flags));
1152          j = j + 1;
1153       end;
1154 
1155 
1156       arglist.arg_ptrs (j) = addr (filename);
1157       arglist.desc_ptrs (j) = addr (descriptors.desc (j));
1158       descriptors.desc (j).bits = DESC_BITS;
1159       descriptors.desc (j).size = length (rtrim (filename));
1160 
1161       call cu_$gen_call (cpp_ptr, call_arg_ptr);
1162 
1163       free arglist in (sys_area);
1164       free descriptors in (sys_area);
1165 
1166    end do_cpp;
1167 %page;
1168 
1169 /* parse the command line setting what options have been set by the user.
1170    Create a list of possible files to be compiled and/or linked.
1171 */
1172 
1173 parse_args:
1174    procedure (filelist_ptr, arglist_ptr);
1175 
1176 /* parameters */
1177 
1178 dcl     filelist_ptr           pointer parameter;
1179 dcl     arglist_ptr            pointer parameter;
1180 
1181 /* automatic */
1182 
1183 dcl     i                      fixed bin automatic;
1184 dcl     coma_pos               fixed bin automatic;
1185 dcl     current_pos            fixed bin automatic;
1186 dcl     defname_len            fixed bin automatic;
1187 dcl     true                   bit (1) automatic;
1188 
1189 
1190 /* based */
1191 
1192 dcl     1 file_list            like file_list_desc based (filelist_ptr);
1193 
1194 
1195 /* step through the args */
1196 
1197       do i = 1 to arg_count;
1198 
1199          call cu_$arg_ptr_rel (i, arg_ptr, arg_length, error_code, arglist_ptr);
1200          if error_code ^= 0 then
1201             do;
1202             call com_err_ (error_code, ME);
1203             goto ERROR;
1204          end;
1205 
1206 /* see if we have an option specifier */
1207 
1208          if (index (argument, "-") = 1) then
1209             do;
1210 
1211             if (argument = "-table") | (argument = "-tb") then
1212                table = "1"b;
1213             else if (argument = "-list") | (argument = "-ls") then
1214                list = "1"b;
1215 
1216             else if (argument = "-stop_after") | (argument = "-spaf") then
1217                do;
1218 
1219                i = i + 1;
1220                call cu_$arg_ptr_rel (i, arg_ptr, arg_length, error_code,
1221                     arglist_ptr);
1222 
1223                if (error_code ^= 0) | (arg_length ^> 0) then
1224                   do;
1225                   call com_err_ (error_code, ME, "Pass specifier is missing.");
1226                   goto ERROR;
1227                end;
1228 
1229                if (argument = "preprocessor") | (argument = "pp") then
1230                   only_cpp = "1"b;
1231 
1232                else if (argument = "c") then
1233                   only_alm = "1"b;
1234 
1235                else if (argument = "alm") then
1236                   only_compile = "1"b;
1237 
1238                else
1239                   do;
1240 
1241                   call com_err_ (0, ME, "Invalid pass specifier ^a.", argument);
1242                   goto ERROR;
1243                end;
1244 
1245             end;
1246 
1247 %page;
1248 
1249             else if (argument = "-profile") | (argument = "-pf") then
1250                profile = "1"b;
1251 
1252             else if (argument = "-long") | (argument = "-lg") then
1253                long_sw = "1"b;
1254 
1255             else if (argument = "-brief") | (argument = "-bf") then
1256                long_sw = "0"b;
1257 
1258             else if (argument = "-optimize") | (argument = "-ot") then
1259                optimize = "1"b;
1260 
1261             else if (argument = "-output_file") | (argument = "-of") then
1262                do;
1263                output_file = "1"b;
1264                i = i + 1;
1265                call cu_$arg_ptr_rel (i, arg_ptr, arg_length, error_code,
1266                     arglist_ptr);
1267 
1268                if (error_code ^= 0) | (arg_length ^> 0) then
1269                   do;
1270                   call com_err_ (error_code, ME,
1271                        "Output file name missing with the -of option");
1272                   goto ERROR;
1273                end;
1274 
1275                output_file_name = rtrim (argument);
1276 
1277             end;
1278 
1279 %page;
1280 
1281             else if (argument = "-library") | (argument = "-lb") then
1282                do;
1283 
1284                true = "1"b;
1285                i = i + 1;
1286                call cu_$arg_ptr_rel (i, arg_ptr, arg_length, error_code,
1287                     arglist_ptr);
1288 
1289                if (error_code ^= 0) | (arg_length ^> 0) |
1290                     (index (argument, "-") = 1) then
1291                   do;
1292                   call com_err_ (error_code, ME,
1293                        "Library pathname missing with the -library option");
1294                   goto ERROR;
1295                end;
1296 
1297                do while (true);
1298 
1299                   if number_of_libraries = MAX_LIB_INCL then
1300                      do;
1301                      call com_err_ (0, ME, "Too many library paths specified.");
1302                      goto ERROR;
1303 
1304                   end;
1305 
1306 
1307                   number_of_libraries = number_of_libraries + 1;
1308 
1309                   cc_info.libraries (number_of_libraries)
1310                        .library_pathname_length = arg_length;
1311                   cc_info.libraries (number_of_libraries).library_pathname =
1312                        argument;
1313                   i = i + 1;
1314                   if (i > arg_count) then
1315                      true = "0"b;
1316                   else
1317                      do;
1318                      call cu_$arg_ptr_rel (i, arg_ptr, arg_length, error_code,
1319                           arglist_ptr);
1320 
1321                      if (error_code ^= 0) | (arg_length ^> 0) then
1322                         do;
1323                         call com_err_ (error_code, ME,
1324                              "Include directory pathname missing with the -include option"
1325                              );
1326                         goto ERROR;
1327                      end;
1328 
1329                      if (index (argument, "-") = 1) then
1330                         do;
1331                         true = "0"b;
1332                         i = i - 1;
1333                      end;
1334                   end;
1335 
1336                end;
1337             end;
1338 
1339 %page;
1340 
1341 
1342             else if (argument = "-include") | (argument = "-incl") then
1343                do;
1344                true = "1"b;
1345 
1346                i = i + 1;
1347                call cu_$arg_ptr_rel (i, arg_ptr, arg_length, error_code,
1348                     arglist_ptr);
1349 
1350                if (error_code ^= 0) | (arg_length ^> 0) |
1351                     (index (argument, "-") = 1) then
1352                   do;
1353                   call com_err_ (error_code, ME,
1354                        "Include directory pathname missing with the -include option"
1355                        );
1356                   goto ERROR;
1357                end;
1358 
1359                do while (true);
1360 
1361 
1362                   if number_of_includes = MAX_LIB_INCL then
1363                      do;
1364                      call com_err_ (0, ME,
1365                           "Too many include directory paths specified.");
1366                      goto ERROR;
1367                   end;
1368 
1369                   number_of_includes = number_of_includes + 1;
1370 
1371                   cc_info.include_files (number_of_includes)
1372                        .include_pathname_length = arg_length + 2;
1373                   cc_info.include_files (number_of_includes).include_pathname =
1374                        "-I" || argument;
1375 
1376                   i = i + 1;
1377                   if (i > arg_count) then
1378                      true = "0"b;
1379                   else
1380                      do;
1381                      call cu_$arg_ptr_rel (i, arg_ptr, arg_length, error_code,
1382                           arglist_ptr);
1383 
1384                      if (error_code ^= 0) | (arg_length ^> 0) then
1385                         do;
1386                         call com_err_ (error_code, ME,
1387                              "Include directory pathname missing with the -include option"
1388                              );
1389                         goto ERROR;
1390                      end;
1391 
1392                      if (index (argument, "-") = 1) then
1393                         do;
1394                         true = "0"b;
1395                         i = i - 1;
1396                      end;
1397                   end;
1398 
1399 
1400                end;
1401             end;
1402 
1403 %page;
1404 
1405             else if (argument = "-definition") | (argument = "-def") then
1406                do;
1407 
1408 /* get next arg which specifes what is to be defined and undefined
1409 */
1410 
1411                i = i + 1;
1412                call cu_$arg_ptr_rel (i, arg_ptr, arg_length,
1413                     error_code, arglist_ptr);
1414 
1415                if (error_code ^= 0) | (arg_length ^> 0) then
1416                   do;
1417                   call com_err_ (error_code, ME,
1418                        "Definition string missing with the -definition option");
1419                   goto ERROR;
1420                end;
1421 
1422 /* check for spaces in the next arg ie. a user typed -def "v, y, etc" */
1423 
1424                if index (argument, " ") ^= 0 then
1425                   do;
1426                   call com_err_ (0, ME, "An argument to -def has spaces. ^a",
1427                        argument);
1428                   goto ERROR;
1429                end;
1430 
1431 
1432 /* parse the arg for coma seperators */
1433 
1434                current_pos = 1;
1435                do while (current_pos ^> arg_length);
1436 
1437                   coma_pos = index (substr (argument, current_pos), ",");
1438                   if coma_pos = 0 then
1439                      defname_len = arg_length - current_pos + 1;
1440                   else
1441                      defname_len = coma_pos - 1;
1442 
1443 
1444                   if index (substr (argument, current_pos, defname_len), "^")
1445                        = 1 then
1446                      do;                                           /* we have a -U option */
1447 
1448                      if number_of_undefines = MAX_LIB_INCL then
1449                         do;
1450                         call com_err_ (0, ME,
1451                              "Too many undefine names specified.");
1452                         goto ERROR;
1453                      end;
1454 
1455 
1456                      current_pos = current_pos + 1;                /* skip the ^ */
1457                      defname_len = defname_len - 1;
1458                      number_of_undefines = number_of_undefines + 1;
1459 
1460                      cc_info.undefines (number_of_undefines)
1461                           .undefine_name_length = defname_len + 2;
1462                      cc_info.undefines (number_of_undefines).undefine_name =
1463                           "-U" || substr (argument, current_pos, defname_len);
1464 
1465                   end;
1466 
1467 
1468                   else
1469                      do;                                           /* we have a -D option */
1470 
1471                      if number_of_defines = MAX_LIB_INCL then
1472                         do;
1473                         call com_err_ (0, ME,
1474                              "Too many define names specified.");
1475                         goto ERROR;
1476                      end;
1477 
1478 
1479                      number_of_defines = number_of_defines + 1;
1480                      cc_info.defines (number_of_defines).define_name_length =
1481                           defname_len + 2;
1482                      cc_info.defines (number_of_defines).define_name = "-D" ||
1483                           substr (argument, current_pos, defname_len);
1484 
1485                   end;
1486 
1487                   current_pos = current_pos + defname_len + 1;
1488 
1489                end;
1490             end;
1491 
1492             else
1493                do;
1494                call com_err_ (0, ME, "Invalid option specified to cc. ^a",
1495                     argument);
1496                goto ERROR;
1497             end;
1498 
1499          end;
1500 
1501 /* must be a file name */
1502 
1503          else
1504             do;
1505             number_of_files = number_of_files + 1;
1506             file_list.pathname (number_of_files).name = argument;
1507             file_list.pathname (number_of_files).name_length = arg_length;
1508          end;
1509       end;
1510 
1511    end parse_args;
1512 
1513 %page;
1514 /* Include Files */
1515 %include arg_list;
1516 %page;
1517 
1518 %include alm_info;
1519 %page;
1520 
1521 %include terminate_file;
1522 %page;
1523 
1524 %include cc_info;
1525 
1526 
1527    end c_compile;