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 
 13 
 14 /****^  HISTORY COMMENTS:
 15   1) change(2021-12-24,GDixon), approve(2021-12-24,MCR10109),
 16      audit(2022-01-04,Swenson), install(2022-01-04,MR12.8-1016):
 17      Initialize access_mode argument to R_ACCESS before passing that argument
 18      to initiate_file_ when initiating object archives/segements for the
 19      bind operation.
 20                                                    END HISTORY COMMENTS */
 21 
 22 
 23 
 24 bind:
 25 oldbind:
 26 bd:
 27           procedure ();
 28 
 29 /* *      BIND -- the command procedure of the Multics binder
 30    *
 31    *
 32    *      Redesigned and coded by Michael J. Spier, September 17, 1970
 33    *      Modified 75.06.24 by M. Weaver to remove no_old_alm option
 34    *      Modified 5/76 by M. Weaver to add -brief option, identify bad control args and improve names in messages
 35    *      Completely reimplemented, to make comprehensible, 01/14/81 W. Olin Sibert; Added several features:
 36    *        warning for no bindfile, -force_order, -force_update, warning for update by earlier version.
 37    *      Modified 11/22/83 by M. Weaver to initialize inp.bindfile_name
 38    *      Modified 11/06/84 by M. Sharpe to implement -segment, -archive and -bindfile;
 39    *        bind now uses a new version of binder_input.incl.pl1 which removes the limitation
 40    *        on the number of archives/segments and object components.
 41    *      Modified 01/07/84 by M. Sharpe to correct problem with control argument processing;
 42    */
 43 
 44 /*   Automatic   */
 45 
 46 dcl  access_mode                        bit (3);
 47 dcl  archive_dname                      char (168);
 48 dcl  archive_ename                      char (32);
 49 dcl  archive_idx                        fixed bin;
 50 dcl (argno, nargs)                      fixed bin;
 51 dcl  argp                               pointer;
 52 dcl  argl                               fixed bin (21);
 53 dcl  bindfile_flag                      bit (1) aligned init ("0"b);
 54 dcl  bindfile_to_use                    char (32);
 55 dcl  code                               fixed bin (35);
 56 dcl  component_name                     char (32) init ("");
 57 dcl  comp_ptr                           pointer;
 58 dcl 1 comp_info                         aligned like archive_component_info;
 59 dcl  ctl_arg                            char (10) varying;
 60 dcl  (inpp, p)                          pointer;   /* pointers which must be declared to use binder_input.incl.pl1 */
 61 dcl  error_sw                           bit (1) aligned;
 62 dcl  ignore_not_found                   bit (1) aligned;
 63 dcl  obj_idx                            fixed bin;
 64 dcl  real_dname                         char (168);
 65 dcl  real_ename                         char (32);
 66 dcl  standalone_segment                 bit (1) aligned init ("0"b);
 67 dcl  update_idx                         fixed bin;
 68 
 69 /*   Based   */
 70 
 71 dcl  arg                                char (argl) based (argp);
 72 
 73 
 74 /*   Builtin   */
 75 
 76 dcl  (addr, char, index, length,
 77             null, reverse, rtrim,
 78             search, substr)   builtin;
 79 
 80 /*   Condition   */
 81 
 82 dcl  cleanup                            condition;
 83 
 84 /*   Entries   */
 85 
 86 dcl  absolute_pathname_                 entry (char(*), char(*), fixed bin(35));
 87 dcl  absolute_pathname_$add_suffix      entry (char (*), char (*), char (*), fixed bin (35));
 88 dcl  archive_$next_component_info       entry (pointer, fixed bin (24), pointer, pointer, fixed bin (35));
 89 dcl  bind_                              entry (pointer);
 90 dcl  com_err_                           entry options (variable);
 91 dcl  cu_$arg_count                      entry (fixed bin, fixed bin (35));
 92 dcl  cu_$arg_ptr                        entry (fixed bin, pointer, fixed bin (21), fixed bin (35));
 93 dcl  date_time_                         entry (fixed bin (71), char (*));
 94 dcl  expand_pathname_$component         entry (char(*), char(*), char(*), char(*), fixed bin(35));
 95 dcl  expand_pathname_$add_suffix        entry (char (*), char (*), char (*), char (*), fixed bin (35));
 96 dcl  get_temp_segment_                  entry (char(*), ptr, fixed bin(35));
 97 dcl  hcs_$terminate_noname              entry (pointer, fixed bin (35));
 98 dcl  initiate_file_                     entry (char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35));
 99 dcl  release_temp_segment_              entry (char(*), ptr, fixed bin(35));
100 dcl  translator_info_$get_source_info   entry (pointer, char (*), char (*), fixed bin (71), bit (36) aligned,
101                                                fixed bin (35));
102 
103 /*   External Static   */
104 
105 dcl  error_table_$archive_pathname      fixed bin (35) external static;
106 dcl  error_table_$badopt                fixed bin (35) external static;
107 dcl  error_table_$noarg                 fixed bin (35) external static;
108 dcl  error_table_$noentry               fixed bin (35) external static;
109 dcl  error_table_$pathlong              fixed bin (35) external static;
110 
111 /*   Internal Static   */
112 
113 dcl  ARCHIVE_SUFFIX                     char (7) internal static options (constant) init ("archive");
114 dcl  WHOAMI                             char (32) internal static options (constant) init ("bind");
115 
116 dcl  binder_invoked                     bit (1) aligned internal static init ("0"b);      /* Prevent recursion */
117 
118 
119 %page;
120 
121           if binder_invoked then do;
122                call com_err_ (0, WHOAMI, "^a^/^a",
123                     "The binder may not be invoked while a previous invocation is",
124                     "suspended. Use the ""release"" or ""start"" command first.");
125                return;                                      /* Avoid resetting the flag, of course */
126                end;
127 
128 
129           inpp = null;
130           on cleanup call CLEAN_UP ();
131 
132 
133           binder_invoked = "1"b;                            /* Set recursion-prevention flag */
134 
135           call get_temp_segment_ (WHOAMI, inpp, code);
136           if code ^= 0 then do;
137                call com_err_ (code, WHOAMI, "Could not obtain temporary segment. Report to maintainer.");
138                return;
139           end;
140 
141           inp.ntotal = 0;
142 
143           inp.version = BINDER_INPUT_VERSION_2;
144           inp.caller_name = WHOAMI;
145 
146           inp.bindfilep = null ();
147           inp.bindfile_name = "";
148 
149           update_idx = 0;
150           archive_idx = 0;
151           error_sw = "0"b;                                  /* Only set when multiple errors might occur */
152           ignore_not_found = "0"b;
153 
154 
155           call cu_$arg_count (nargs, code);
156           if code ^= 0 then do;
157                call com_err_ (code, WHOAMI);
158 
159 MAIN_RETURN:   if error_sw then                             /* Make mention of the fact that nothing will happen */
160                     call com_err_ (0, WHOAMI, "Fatal errors have occurred; binding will not be attempted.");
161 
162                call CLEAN_UP ();                            /* This is the ONLY exit from this program */
163                return;                                      /* except for the one which prevents recursion */
164                end;
165 
166 %page;
167 
168 
169 /* Now, loop through the arguments, picking up the options and the archive pathnames.
170    This loop initiates all the supposed archives, and fills in inp.archive_file for
171    each one, but does not inspect their contents.
172    */
173 
174 /* The first part of the loop handles the simple control argument options */
175 
176           argno = 1;
177           do while (argno <= nargs);
178                call cu_$arg_ptr (argno, argp, argl, (0));
179 
180                if (arg = "-debug") | (arg = "-db") then
181                     inp.debug = "1"b;
182 
183                else if (arg = "-map") then do;
184                     inp.list_seg = "1"b;
185                     inp.map_opt = "1"b;
186                     end;
187 
188                else if (arg = "-list") | (arg = "-ls") then do;
189                     inp.list_opt = "1"b;
190                     inp.list_seg = "1"b;
191                     inp.map_opt = "1"b;
192                     end;
193 
194                else if (arg = "-brief") | (arg = "-bf") then
195                     inp.brief_opt = "1"b;
196 
197                else if (arg = "-force_order") | (arg = "-fco") then
198                     inp.force_order_opt = "1"b;
199 
200 %page;
201 
202 
203 /* The next portion of the loop handles some of the more complicated control arguments */
204 
205                else if (arg = "-update") | (arg = "-ud") then do;
206                     if inp.narc = 0 then do;
207 NO_PRIMARY_ARCHIVE:      call com_err_ (0, WHOAMI, "^a specified before any primary archive names.", arg);
208                          goto MAIN_RETURN;
209                          end;
210 
211                     if update_idx > 0 then do;
212 MULTIPLE_UPDATES:        call com_err_ (0, WHOAMI, "Multiple -update or -force_update control arguments not allowed.");
213                          goto MAIN_RETURN;
214                          end;
215 
216                     update_idx = inp.narc + 1;              /* Start updating with the next archive */
217                     end;
218 
219                else if (arg = "-force_update") | (arg = "-fud") then do;
220                     if inp.narc = 0 then
221                          goto NO_PRIMARY_ARCHIVE;
222                     if update_idx > 0 then
223                          goto MULTIPLE_UPDATES;
224 
225                     ignore_not_found = "1"b;                /* Set the flag to ignore update archives not found */
226                     update_idx = inp.narc + 1;              /* Start updating with the next archive */
227                     end;
228 
229 %page;
230 
231 /* This portion handles control args that require another argument immediatedly following them */
232                else if (arg = "-segment") | (arg = "-sm") then do;
233                     if argno = nargs then goto MISSING_ARG;
234 
235                     ctl_arg = arg;
236                     call cu_$arg_ptr (argno+1, argp, argl, (0)); /* Just checking! */
237                     if char (arg, 1) = "-" then do;
238                          call com_err_ (error_table_$badopt, WHOAMI,
239                               "^a ^a^/ ^a must be followed by a pathname.^/", ctl_arg, arg, ctl_arg);
240                          goto MAIN_RETURN;
241                     end;
242 
243                     standalone_segment = "1"b;
244                end;
245 
246                else if (arg = "-archive") | (arg = "-ac") then do;
247 
248                     if argno = nargs then do;
249 MISSING_ARG:             call com_err_ (error_table_$noarg, WHOAMI, "^a must be followed by a pathname", arg);
250                          goto MAIN_RETURN;
251                     end;
252 
253                     ctl_arg = arg;
254                     call cu_$arg_ptr (argno+1, argp, argl, (0)); /* Just checking! */
255                     if char (arg, 1) = "-" then do;
256                          call com_err_ (error_table_$badopt, WHOAMI,
257                               "^a ^a^/ ^a must be followed by a pathname.^/", ctl_arg, arg, ctl_arg);
258                          goto MAIN_RETURN;
259                     end;
260 
261                     standalone_segment = "0"b;
262                end;
263 
264                else if (arg = "-bindfile") | (arg = "-bdf") then do;
265                     if bindfile_flag then do;
266                          call com_err_ (0, WHOAMI, "Multiple -bindfile control args not allowed.");
267                          goto MAIN_RETURN;
268                     end;
269 
270                     if argno = nargs then do;
271                          call com_err_ (error_table_$noarg, WHOAMI,
272                               "^a must be followed by an entry name.", arg);
273                          goto MAIN_RETURN;
274                     end;
275 
276                     bindfile_flag = "1"b;                   /* don't use this arg again */
277 
278                     ctl_arg = arg;
279                     argno = argno + 1;
280                     call cu_$arg_ptr (argno, argp, argl, (0));
281                     if (search (arg, "<>") > 0) | (index (arg, "-") = 1)
282                     then do;
283                          call com_err_ (0, WHOAMI,
284                               "^a must be followed by an entry name ^[not^;not a pathname.^] ^a.",
285                               ctl_arg, (index (arg,"-") = 1), arg);
286                          error_sw = "1"b;
287                     end;
288 
289                     if (argl > 4 & index (arg, ".bind") = argl - 4) then do;  /* has .bind suffix */
290                          if argl > 32 then do;              /* too long */
291                               call com_err_ (0, WHOAMI, "Bindfile name is too long. ^a", arg);
292                               error_sw = "1"b;
293                          end;
294                          else bindfile_to_use = arg;
295                     end;
296 
297                     else do;                                /* no .bind suffix */
298                          if argl > 27 then do;              /* too long */
299                               call com_err_ (0, WHOAMI, "Bindfile name is too long. ^a", arg);
300                               error_sw = "1"b;
301                          end;
302                          else bindfile_to_use = arg || ".bind";
303                     end;
304                end;                                         /* -bindfile */
305 
306                else if char (arg, 1) = "-" then do;
307                     call com_err_ (error_table_$badopt, WHOAMI, "^a", arg);
308                     goto MAIN_RETURN;
309                     end;
310 
311 %page;
312 /* The final portion deals with initiating archives and getting information about them */
313 
314                else do;                                     /* If not a control argument, must be an archive name */
315                     inp.ntotal,                             /* update the array bound */
316                     archive_idx = archive_idx + 1;          /* and the index */
317                     inp.archive(archive_idx).ptr = null;    /* initialize the ptr so that CLEAN_UP won't break */
318 
319 
320                     if standalone_segment then call absolute_pathname_
321                          (arg, inp.archive (archive_idx).path, code);
322                     else call absolute_pathname_$add_suffix
323                          (arg, ARCHIVE_SUFFIX, inp.archive (archive_idx).path, code);
324                     if code ^= 0 then do;
325 BAD_ARCHIVE_PATH:        call com_err_ (code, WHOAMI, "^a", arg);
326                          goto MAIN_RETURN;
327                          end;
328 
329                     if standalone_segment then call expand_pathname_$component
330                          (inp.archive (archive_idx).path, archive_dname, archive_ename, component_name, code);
331                     else call expand_pathname_$add_suffix (inp.archive (archive_idx).path,
332                          ARCHIVE_SUFFIX, archive_dname, archive_ename, code);
333                     if code ^= 0 then
334                          goto BAD_ARCHIVE_PATH;
335                     if component_name ^= "" then do;
336                          call com_err_ (error_table_$archive_pathname, "bind_", inp.archive (archive_idx).path);
337                          component_name = "";
338                          archive_idx = archive_idx - 1;
339                          goto SKIP_ARCHIVE;
340                     end;
341 
342                     inp.archive(archive_idx).entryname = archive_ename;
343 
344                     access_mode = R_ACCESS;
345                     call initiate_file_ (archive_dname, archive_ename, access_mode,
346                          inp.archive (archive_idx).ptr, inp.archive (archive_idx).bc, code);
347 
348                     if inp.archive (archive_idx).ptr = null () then do;
349                          if ignore_not_found then             /* We can skip it */
350                               if code = error_table_$noentry then do;
351                                    archive_idx = archive_idx - 1; /* Keep this one out of the array */
352                                    goto SKIP_ARCHIVE;
353                                    end;
354 
355 BAD_SEGMENT:             call com_err_ (code, WHOAMI, "^a", inp.archive (archive_idx).path);
356                          goto MAIN_RETURN;
357                          end;
358 
359                     if ^inp.brief_opt                       /* Warn about empties */
360                          & inp.archive (archive_idx).bc = 0 then
361                          call com_err_ (0, WHOAMI, "Warning: ^a is empty.", inp.archive (archive_idx).path);
362 
363                     call translator_info_$get_source_info (inp.archive (archive_idx).ptr, real_dname, real_ename,
364                          inp.archive (archive_idx).dtm, inp.archive (archive_idx).uid, code);
365                     if code ^= 0 then
366                          goto BAD_SEGMENT;
367 
368                     if (length (rtrim (real_dname)) + length (rtrim (real_ename)) + 1) > 168 then do;
369                          call com_err_ (error_table_$pathlong, WHOAMI, "^a>^a", real_dname, real_ename);
370                          goto MAIN_RETURN;
371                          end;
372 
373                     inp.archive (archive_idx).real_path = rtrim (real_dname) || ">" || rtrim (real_ename);
374 
375                     inp.archive (archive_idx).standalone_seg = standalone_segment;
376 
377                     if archive_idx = 1 then                 /* Apply default value for output segment */
378                          inp.bound_seg_name = substr (archive_ename, 1,
379                               (length (rtrim (archive_ename)) - (length (ARCHIVE_SUFFIX) + 1)));
380 
381                     if update_idx > 0 then                  /* Update the counts in the input */
382                          inp.nupd = inp.nupd + 1;
383                     else inp.narc = inp.narc + 1;
384 SKIP_ARCHIVE:
385                end;                               /* Of processing one archive */
386                if char (arg, 1) = "-" & arg ^= "-segment" & arg ^= "-sm" then standalone_segment = "0"b;
387                                                   /* -segment is only in effect until the next control argument. */
388                argno = argno + 1;
389 
390           end;                                              /* Of loop through arguments */
391 
392           if inp.narc = 0 then do;
393                call com_err_ (error_table_$noarg, WHOAMI,
394                     "^/Usage:^-^a archive_path{s} {-update update_archive_path{s}} {-control_args}", WHOAMI);
395                goto MAIN_RETURN;
396                end;
397 
398           if (update_idx > 0) & (inp.nupd = 0) & (^ignore_not_found) then do;
399                call com_err_ (0, WHOAMI, "-update was specified, but not followed by any update archive names.");
400                goto MAIN_RETURN;
401                end;
402 
403 %page;
404           comp_info.version = ARCHIVE_COMPONENT_INFO_VERSION_1;  /* In preparation for calling archive */
405 
406           do archive_idx = 1 to inp.ntotal;                 /* Go through all the input archives */
407                comp_ptr = null ();                          /* Set up to loop through components */
408 
409 GET_NEXT_OBJECT:
410                if inp.archive (archive_idx).standalone_seg then do;
411                     comp_info.comp_ptr = inp.archive (archive_idx).ptr;
412                     comp_info.comp_bc = inp.archive (archive_idx).bc;
413                     comp_info.name = inp.archive (archive_idx).entryname;
414                     comp_info.time_updated,
415                          comp_info.time_modified = inp.archive (archive_idx).dtm;
416                end;
417 
418                else do;
419                     call archive_$next_component_info
420                          (inp.archive (archive_idx).ptr, inp.archive (archive_idx).bc, comp_ptr, addr (comp_info), code);
421 
422                     if code ^= 0 then do;
423                          call com_err_ (code, WHOAMI, "Searching ^a.", inp.archive (archive_idx).path);
424                          goto MAIN_RETURN;
425                     end;
426 
427                     if comp_ptr = null () then              /* Nothing more in this archive */
428                          goto GET_NEXT_ARCHIVE;
429                end;
430 
431                if substr (reverse (rtrim (comp_info.name)), 1, 5) = reverse (".bind") then do; /* A bindfile */
432                     if bindfile_flag then do;               /* -bindfile was specified */
433                          if comp_info.name ^= bindfile_to_use then goto IGNORE_BINDFILE;
434                     end;
435 
436                     else if inp.bindfilep ^= null () then do;
437                          if archive_idx <= inp.narc then do; /* We are not processing an update archive */
438                               if ^inp.brief_opt then        /* Complain about it if not brief */
439                                    call com_err_ (0, WHOAMI, "Warning: Multiple bindfile ^a in ^a ignored.",
440                                         comp_info.name, inp.archive (archive_idx).path);
441 
442                               goto IGNORE_BINDFILE;         /* and ignore it in any case */
443                          end;                               /* of case for duplicate bindfile in non-update archive */
444 
445                          if ^inp.brief_opt then             /* Mention it if not brief */
446                               call com_err_ (0, WHOAMI, "Warning: ^a of ^a^/^2xreplaced by: ^a of ^a",
447                                    inp.bindfile_name, inp.archive (inp.bindfile_idx).path,
448                                    comp_info.name, inp.archive (archive_idx).path);
449                     end;                                    /* of checking for duplicate bindfile */
450 
451                     inp.bindfilep = comp_info.comp_ptr;     /* In any case, make this the bindfile */
452                     inp.bindfile_bc = comp_info.comp_bc;
453                     inp.bindfile_idx = archive_idx;         /* Index of archive from which this came */
454                     inp.bindfile_name = comp_info.name;
455                     inp.bindfile_time_up = comp_info.time_updated;
456                     inp.bindfile_time_mod = comp_info.time_modified;
457 
458 IGNORE_BINDFILE:                                            /* Now that we have it, go on to the next component */
459                     if inp.archive (archive_idx).standalone_seg then goto GET_NEXT_ARCHIVE;
460                     else goto GET_NEXT_OBJECT;
461                     end;                                    /* Of processing a bindfile entry */
462 %page;
463 
464 /* If we get here, we are known to be processing a "object" component. Put it in
465    the list, perhaps replacing one which was there earlier, and complaining about
466    a variety of things. */
467 
468                do obj_idx = 1 to inp.nobj;                  /* Look for this one elsewhere in the input stream */
469                     if inp.obj (obj_idx).filename = comp_info.name then do;
470                          if archive_idx <= inp.narc then do;
471                               call com_err_ (0, WHOAMI, "Duplicate object ^a in ^a",
472                                    comp_info.name, inp.archive (archive_idx).path);
473 
474                               error_sw = "1"b;              /* Report all of these, but don't try binding */
475 
476                               if inp.archive (archive_idx).standalone_seg then goto GET_NEXT_ARCHIVE;
477                               else goto GET_NEXT_OBJECT;
478 
479                               end;
480 
481                          inp.obj (obj_idx).base = comp_info.comp_ptr; /* Replace the previous entry for this component */
482                          inp.obj (obj_idx).bitcount = comp_info.comp_bc; /* The name, of course, is already correct */
483 
484                          if inp.obj (obj_idx).time_mod > comp_info.time_modified then
485                               if ^inp.brief_opt then        /* Mention it, in case the user has made a mistake */
486                                    call com_err_ (0, WHOAMI,
487                                         "Note: ^a in ^a (modified ^a)^/^3xreplaced by earlier (^a) copy in ^a",
488                                         comp_info.name, inp.archive (inp.obj (obj_idx).archive_idx).path,
489                                         DATE_TIME (inp.obj (obj_idx).time_mod), DATE_TIME (comp_info.time_modified),
490                                         inp.archive (archive_idx).path);
491 
492                          inp.obj (obj_idx).time_mod = comp_info.time_modified;
493                          inp.obj (obj_idx).time_up = comp_info.time_updated;
494                          inp.obj (obj_idx).archive_idx = archive_idx;
495 
496                inp.obj(obj_idx).to_be_ignored = (inp.obj(obj_idx).bitcount = 0);
497                                                             /* set ignore bit if seg is zero length; */
498                                                             /* reset it if it was previously set & bitcount > 0 */
499                if inp.obj(obj_idx).bitcount = 0 then inp.zeroseg_seen = "1"b;
500                                                             /* Tell parse_bindfile_ to check for zsegs */
501                                                             /* Having found the replacement, look no further */
502                          if inp.archive (archive_idx).standalone_seg then goto GET_NEXT_ARCHIVE;
503                          else goto GET_NEXT_OBJECT;
504 
505                          end;                               /* Of replacing a component */
506                     end;                                    /* of loop through objects */
507 
508 %page;
509 
510 /* If we fall through to here, the object we are processing was not already in our
511    list of objects, so we must add it to the list. */
512 
513 
514                obj_idx = inp.nobj + 1;
515 
516                inp.obj (obj_idx).filename = comp_info.name; /* These items need only be set the first time */
517                inp.obj (obj_idx).option = ""b;              /* No options yet, of course */
518 
519                inp.obj (obj_idx).base = comp_info.comp_ptr;
520                inp.obj (obj_idx).bitcount = comp_info.comp_bc;
521                inp.obj (obj_idx).time_mod = comp_info.time_modified;
522                inp.obj (obj_idx).time_up = comp_info.time_updated;
523                inp.obj (obj_idx).archive_idx = archive_idx;
524 
525                inp.obj(obj_idx).to_be_ignored = (inp.obj(obj_idx).bitcount = 0);
526                                                             /* set ignore bit if seg is zero length; */
527                                                             /* reset it if it was previously set & bitcount > 0 */
528                if inp.obj(obj_idx).bitcount = 0 then inp.zeroseg_seen = "1"b;
529                                                             /* Tell parse_bindfile_ to check for zsegs */
530                inp.nobj = obj_idx;
531 
532                if ^inp.archive (archive_idx).standalone_seg
533                     then goto GET_NEXT_OBJECT;              /* Having added it, go find another */
534 
535 GET_NEXT_ARCHIVE:                                           /* This "loop" is only reached after running out of */
536                                                             /* components in an archive or processing a standalone */
537                end;                                         /* segment -- see the top of the loop for details. */
538 
539 /* Having done all the processing of the input archives, we now just call
540    the subroutine which does the real work, and hope for the best.
541    */
542 
543           if error_sw then                                  /* Reject the binding attempt, because something happened */
544                goto MAIN_RETURN;
545 
546           if inp.bindfilep = null () then do;               /* Make this be more useful */
547                if bindfile_flag then do;                    /* Bindfile specified but not found -- ERROR */
548                     call com_err_ ((0), WHOAMI,
549                          "Specified bindfile ^a was not found in the input archive^[s^].",
550                          bindfile_to_use, ((inp.narc + inp.nupd) ^= 1));
551                     goto MAIN_RETURN;
552                end;
553 
554                else                                         /* No bindfiles specified or found -- Warning */
555                     if ^inp.brief_opt then                  /* But only if we're allowed to be noisy */
556                     call com_err_ (0, WHOAMI, "Warning: No bindfile was found in the input archive^[s^].",
557                          ((inp.narc + inp.nupd) ^= 1));
558           end;
559 
560           call bind_ (inpp);
561 
562           goto MAIN_RETURN;                                 /* All done. Finish up, and return */
563 
564 %page;
565 
566 CLEAN_UP: proc ();
567 
568 /* cleanup and exit procedure -- terminates all the input archives */
569 
570 dcl  idx fixed bin;
571 dcl  tempp pointer;
572 
573           if inpp ^= null then do;
574                do idx = 1 to inp.ntotal;
575                     if inp.archive (idx).ptr ^= null () then do;
576                          tempp = inp.archive (idx).ptr;
577                          inp.archive (idx).ptr = null ();
578                          call hcs_$terminate_noname (tempp, (0));
579                     end;
580                end;
581 
582                call release_temp_segment_ (WHOAMI, inpp, (0));
583                binder_invoked = "0"b;                       /* Always turn off the flag */
584           end;
585 
586           return;
587           end CLEAN_UP;
588 
589 
590 
591 DATE_TIME: proc (P_time) returns (char (14));
592 
593 dcl  P_time fixed bin (71) parameter;
594 
595 dcl  ret_str char (14);
596 dcl  date_str char (24);
597 
598 
599           call date_time_ (P_time, date_str);
600 
601           substr (ret_str, 1, 8) = substr (date_str, 1, 8);
602           substr (ret_str, 9, 1) = " ";
603           substr (ret_str, 10, 2) = substr (date_str, 11, 2);
604           substr (ret_str, 12, 1) = ":";
605           substr (ret_str, 13, 2) = substr (date_str, 13, 2);
606 
607           return (ret_str);
608           end DATE_TIME;
609 
610 %page;    %include binder_input;
611 %page;    %include archive_component_info;
612 %page;    %include access_mode_values;
613           end bind;