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 binder_: proc (P_old_input_ptr);
 12 
 13 /* *      BINDER_
 14    *
 15    *      This procedure, once the standard subroutine interface for the binder, is now
 16    *      just a writearound to call bind_ with the appropriately formatted new structure.
 17    *      It is slightly complicated by the fact that it must copy between two structures
 18    *      both named input, described in two different include files; this is done by
 19    *      including one in the outer procedure, and one in a begin block.
 20    *
 21    *      01/21/81, W. Olin Sibert
 22    *      10/3/84, M. Sharpe modified to use version 2 of binder_input.incl.pl1
 23    */
 24 
 25 dcl  P_old_input_ptr pointer parameter;
 26 
 27 dcl 1 old_input aligned like inp based (P_old_input_ptr);
 28 
 29 dcl (p, inpp) pointer;                                      /* Silly pointers not declared by the include files */
 30 dcl  time_now fixed bin (71);
 31 dcl  (idx, old_idx) fixed bin;
 32 
 33 dcl  inp_area area;
 34 
 35 dcl  bind_ entry (pointer);
 36 dcl  convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35));
 37 dcl  get_system_free_area_ entry () returns (area);
 38 
 39 dcl (clock, null, substr) builtin;
 40 
 41 dcl cleanup condition;
 42 
 43 %page;
 44 
 45           inpp = null ();
 46           on cleanup begin;
 47                if inpp ^= null () then free inp in (inp_area);
 48           end;
 49           begin;                                            /* Copy all the information which is meaningful */
 50 
 51           inp_area = get_system_free_area_ ();
 52           NTOTAL = old_input.nupd+old_input.narc;
 53           NOBJ = old_input.nobj;
 54           allocate inp in (inp_area) set (inpp);
 55 
 56 
 57 
 58                unspec (inp) = ""b;
 59 
 60                inp.version = BINDER_INPUT_VERSION_2;
 61                inp.caller_name = "binder_";                 /* The "caller_name name", left as binder_ for compatibility */
 62 
 63                inp.bound_seg_name = old_input.bound_seg_name;
 64 
 65                inp.narc = old_input.narc;
 66                inp.nupd = old_input.nupd;
 67                inp.ntotal = old_input.narc + old_input.nupd;
 68                inp.nobj = old_input.nobj;
 69 
 70 
 71                inp.archive (*).path = "";                   /* First, clean these all out, then copy the used entries */
 72                inp.archive (*).real_path = "";    /* Most things were already initialized by the unspec, above */
 73                inp.archive (*).ptr = null ();     /* All archive pointers will be null, sorry */
 74 
 75                do idx = 1 to inp.ntotal;                    /* Now, copy what we can from the old input */
 76                     inp.archive (idx).real_path =
 77                          substr (old_input.archive_file (idx).name, 1, old_input.archive_file (idx).lng);
 78                     inp.archive (idx).uid = old_input.archive_file (idx).uid;
 79                     inp.archive (idx).dtm = old_input.archive_file (idx).dtm;
 80                     end;
 81 
 82                inp.bindfilep = old_input.bindfilep;
 83                inp.bindfile_bc = old_input.bindfile_bc;
 84                inp.bindfile_name = substr (old_input.bindfile_name, 1, old_input.bindfile_name_lng);
 85                call convert_date_to_binary_ ((old_input.bindfile_date_up), inp.bindfile_time_up, (0));
 86                call convert_date_to_binary_ ((old_input.bindfile_date_mod), inp.bindfile_time_mod, (0));
 87                inp.bindfile_idx = 1;              /* All archive indices are faked to be one, even though */
 88                                                             /* this may be incorrect, since the field must have some */
 89                                                             /* value for certain error messages to work at all. */
 90 
 91                inp.options.debug = old_input.debug;
 92                inp.options.list_seg = old_input.list_seg;
 93                inp.options.map_opt = old_input.map_opt;
 94                inp.options.list_opt = old_input.list_opt;
 95                inp.options.brief_opt = old_input.brief_opt;
 96 
 97                inp.obj (*).base = null ();                  /* Initialize certain values for all the input components */
 98                inp.obj (*).filename = "";
 99 
100                time_now = clock ();
101 
102                idx = 0;
103                do old_idx = 1 to old_input.nobj;            /* Copy all meaningful values for real components */
104                     if old_input.obj (old_idx).bitcount > 0 then do;
105                          idx = idx + 1;
106                          inp.obj (idx).filename = old_input.obj (old_idx).filename;
107                          inp.obj (idx).base = old_input.obj (old_idx).base;
108                          inp.obj (idx).bitcount = old_input.obj (old_idx).bitcount;
109                          inp.obj (idx).option = old_input.obj (old_idx).option;
110                          inp.obj (idx).flag = old_input.obj (old_idx).flag;
111 
112                          inp.obj (idx).archive_idx = 1;     /* To make messages work; same as for bindfile above */
113                          inp.obj (idx).time_mod = time_now; /* This is as valid as we can make it. They will all be */
114                          inp.obj (idx).time_up = time_now; /* the same, though they will all also be wrong */
115                     end;
116                end;
117 
118                inp.nobj = idx;                              /* reset after tossing out zero-length segs */
119                call bind_ (addr (inp));           /* Call the real interface */
120 
121 %page;    %include binder_input;
122 
123                end;                                         /* Begin block */
124 
125           if inpp ^= null () then free inp in (inp_area);
126           return;                                           /* All done */
127 
128 %page;    %include input;
129 
130           end binder_;