1 /* ******************************************************
  2    *                                                    *
  3    *                                                    *
  4    * Copyright (c) 1972 by Massachusetts Institute of   *
  5    * Technology and Honeywell Information Systems, Inc. *
  6    *                                                    *
  7    *                                                    *
  8    ****************************************************** */
  9 
 10 /* LOAD_FIRMWARE_FILE - Load Firmware, ITR's and MDR's from tape or segment.
 11    coded 11/19/74 by Noel I. Morris     */
 12 /* Extensively modified June-July 1975 by Larry Johnson */
 13 /* Modified January 1976 by Larry Johnson for new disk config cards */
 14 /* Modified August 1976 by Larry Johnson to fix some bugs. */
 15 /* Modified January 1979 by Michael R. Jordan for MSS0500 & CCU401. */
 16 
 17 load_firmware_file: lff: proc;
 18 
 19 dcl  data_ptr ptr;                                          /* Pointer to data being loaded */
 20 dcl  segp ptr;                                              /* Pointer to firmware segment */
 21 dcl  data_len fixed bin (6);                                /* Number of words being loaded */
 22 dcl  data_offset fixed bin;                                 /* Offset into segment where they are loaded */
 23 dcl  len fixed bin;                                         /* Length of current record */
 24 dcl  ctl bit (12);                                          /* Control info from tape record */
 25 dcl  load bit (1) init ("1"b);                              /* ON to load files */
 26 dcl  rp ptr;                                                /* Pointer to current tape record */
 27 dcl  eof bit (1);                                           /* Tape EOF flag */
 28 dcl  prev_eof bit (1) init ("1"b);                          /* Previous EOF flag */
 29 dcl  total_len fixed bin (18);                              /* Total length of this F/W file */
 30 dcl  code fixed bin (35);                                   /* Error code */
 31 dcl  iostatus bit (72) aligned;                             /* IOS_ error code */
 32 dcl  argptr ptr;                                            /* Pointer to command argument */
 33 dcl  arglen fixed bin;                                      /* Length of command argument */
 34 dcl  argument char (arglen) based (argptr);                 /* Command argument */
 35 dcl  data (data_len) bit (36) based (data_ptr);             /* Used to copy data */
 36 dcl  tape char (200) var;                                   /* Name of tape or segment being loaded */
 37 dcl  tape_name char (32) var;                               /* Edited name of tape */
 38 dcl  output_dir char (168);                                 /* The output directory */
 39 dcl  segname char (32);                                     /* Current firmware segment name */
 40 dcl  time_string char (24);                                 /* Current date and time */
 41 dcl  fileno fixed bin init (1);                             /* Tape file number */
 42 dcl  objcard char (80);                                     /* $ OBJECT card after ASCII translation */
 43 dcl  dkecard char (80);                                     /* $ DKEND card after ASCII translation */
 44 dcl  type char (6);                                         /* Program type */
 45 dcl  ident char (6);                                        /* Program identifier */
 46 dcl  lff_name char (18) init ("load_firmware_file");
 47 dcl  pgm_name char (4);                                     /* Name of firmware program */
 48 dcl  dev_name char (6);                                     /* Name of device a program is for */
 49 dcl  i fixed bin;                                           /* Index for loops */
 50 dcl  files_loaded fixed bin init (0);                       /* Count of files created */
 51 dcl  ptr_array (2) ptr init (null, null);                   /* For get_temp_segments_ */
 52 dcl  arg_cnt fixed bin;                                     /* Count of command arguments */
 53 dcl  arg_no fixed bin;                                      /* Current argument */
 54 dcl  dev_cnt fixed bin init (0);                            /* Number of devices in command */
 55 dcl  name_cnt fixed bin init (0);                           /* Number of names specified */
 56 dcl  file_cnt fixed bin init (0);                           /* Number of files specified */
 57 dcl  dev_list (32) char (6);                                /* List of devices specified */
 58 dcl  name_list (32) char (4);                               /* List of programs specified */
 59 dcl  file_list (32) fixed bin;                              /* List of files specified */
 60 dcl  dev_flags (32) bit (1);                                /* Set if corresponding entry in dev_list found */
 61 dcl  name_flags (32) bit (1);                               /* Set if corresponding entry in name_list found */
 62 dcl  file_flags (32) bit (1);                               /* Set if corresponding entry if file_list found */
 63 dcl  temp_seg_ptr ptr;                                      /* Pointer to temporary output segment */
 64 dcl  name_index fixed bin;                                  /* Index in list of names */
 65 dcl  dev_index fixed bin;                                   /* Index in list of devices */
 66 dcl  file_index fixed bin;                                  /* Index to list of files */
 67 dcl  line_cnt fixed bin init (0);                           /* Count lines on listing */
 68 dcl  pgm_type char (1);                                     /* Type of current program */
 69 dcl  cv_dec_err fixed bin;                                  /* Error code from cv_dec_check */
 70 dcl  cv_dec_result fixed bin (35);                          /* Result from cv_dec_check_ */
 71 dcl  type_offset fixed bin;                                 /* Offset in module to word containing the type code */
 72 dcl  ident_offset fixed bin;                                /* Location of ident in module */
 73 dcl  fw_list_ptr ptr;                                       /* Pointer to fw_list iocb */
 74 dcl  first_ff fixed bin init (0);                           /* Flag to inhibit first formfeed in list file */
 75 dcl  cont_sw fixed bin init (0);                            /* Flag to insert cont in header */
 76 dcl  bcp ptr;                                               /* Pointer to binary card header */
 77 dcl  total_data fixed bin;                                  /* Accumulated length moved from card */
 78 dcl  data_addr ptr;                                         /* Address of data on  card */
 79 dcl  max_file_no fixed bin init (0);                        /* Maximum file on -file */
 80 dcl  itr_name (32) char (6);                                /* List of devices to load itrs for in -config */
 81 dcl  appl_name (32) char (4);                               /* Application firmware needed for -config */
 82 dcl  mdr_name (32) char (6);                                /* Devices to load mdrs for during -config */
 83 dcl  itr_bits (32) bit (1);                                 /* Indicates which itr_names not loaded yet */
 84 dcl  appl_bits (32) bit (1);                                /* Same for appl_name */
 85 dcl  mdr_bits (32) bit (1);                                 /* Same for mdr_name */
 86 dcl  itr_count fixed bin;                                   /* Number of entries in itr_name */
 87 dcl  mdr_count fixed bin;                                   /* Number of entries in mdr_name */
 88 dcl  appl_count fixed bin;                                  /* Number of entries in appl_name */
 89 dcl  save_cnt fixed bin init (0);                           /* Number of entries in save_seg array */
 90 dcl  save_segp ptr;                                         /*  pointer to save_seg array */
 91 dcl  load_comment char (32) var;
 92 dcl  iomodule_name char (5);                                /* Name of IOS input module */
 93 
 94 dcl 1 misc_bits aligned,                                    /* A structure of misc bits */
 95     2 tape_attach bit (1) unal,                             /* Set when tape attached so clean_up knows */
 96     2 gcos_init bit (1) unal,                               /* Set when gcos_init called for same reason */
 97     2 fw_list_attach bit (1) unal,                          /* Set when listing file attached */
 98     2 fw_list_open bit (1) unal,                            /* Set when listing file opened */
 99     2 get_path bit (1) unal,                                /* Set if next argument is to be path name */
100     2 dev_sw bit (1) unal,                                  /* Set if command has device list */
101     2 name_sw bit (1) unal,                                 /* Set if command has name list */
102     2 file_sw bit (1) unal,                                 /* Set if command has file list */
103     2 mdr_sw bit (1) unal,                                  /* Set if -mdr used */
104     2 itr_sw bit (1) unal,                                  /* Set if -itr used */
105     2 appl_sw bit (1) unal,                                 /* Set if -appl used */
106     2 all_sw bit (1) unal,                                  /* Set if all types (mdr, itr, appl) needed */
107     2 header_sw bit (1) unal,                               /* Set when header printed for current file */
108     2 scan_dev bit (1) unal,                                /* Set during a scan for device names */
109     2 scan_name bit (1) unal,                               /* Set during scan for program names */
110     2 scan_file bit (1) unal,                               /* Set during scan for file numbers */
111     2 input_segment_sw bit (1) unal,                        /* Set when input is from a segment */
112     2 config_sw bit (1) unal;                               /* Set when -config is specified */
113 
114 dcl  total_seg (total_len) bit (36) aligned based;          /* This is an entire segment */
115 
116 dcl 1 card based (rp) aligned,                              /* Binary card declaration */
117    (2 type bit (12),                                        /* Card type info */
118     2 count bit (6),                                        /* Count of data words on this card */
119     2 load_address bit (18),                                /* Load address for data on this card */
120     2 checksum bit (36),                                    /* Checksum */
121     2 not_used (3) bit (36),
122     2 data (data_len) bit (36)) unal;                       /* Data words */
123 
124 
125 dcl 1 bincard based (bcp) aligned,                          /* Header word of binary data */
126    (2 type bit (12),                                        /* Type code 2005 */
127     2 count bit (6),                                        /* Data length */
128     2 load_address bit (18)) unal;                          /* Load address */
129 
130 dcl 1 save_seg (save_cnt) aligned based (save_segp),        /* For saveing names of modules stored */
131     2 name char (32),
132     2 file fixed bin;                                       /* File it was loaded from */
133 
134 
135 /* Entry variables */
136 
137 dcl  ios_$attach entry (char (*), char (*), char (*), char (*), bit (72) aligned);
138 dcl  ios_$setsize entry (char (*), fixed bin, bit (72) aligned);
139 dcl  ios_$detach entry (char (*), char (*), char (*), bit (72) aligned);
140 dcl  gcos_gsr_read_$gsr_read_init entry (char (*), fixed bin (35));
141 dcl  gcos_gsr_read_$gsr_read_close entry (char (*), fixed bin (35));
142 dcl  gcos_gsr_read_ entry (char (*), ptr, fixed bin, bit (12), bit (1), fixed bin (35));
143 dcl  expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35));
144 dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
145 dcl  cu_$arg_count entry (fixed bin);
146 dcl  com_err_ entry options (variable);
147 dcl  ioa_ entry options (variable);
148 dcl  ioa_$ioa_switch entry options (variable);
149 dcl  clock_ entry returns (fixed bin (52));
150 dcl  date_time_ entry (fixed bin (52), char (*));
151 dcl  get_wdir_ entry returns (char (168));
152 dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
153 dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
154 dcl  hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35));
155 dcl  hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35));
156 dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
157 dcl  gcos_cv_gebcd_ascii_ entry (ptr, fixed bin, ptr);
158 dcl  iox_$attach_ioname entry (char (*), ptr, char (*), fixed bin (35));
159 dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
160 dcl  iox_$close entry (ptr, fixed bin (35));
161 dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
162 dcl  cv_dec_check_ entry (char (*), fixed bin) returns (fixed bin (35));
163 dcl  get_temp_segments_ entry (char (*), dim (*) ptr, fixed bin (35));
164 dcl  release_temp_segments_ entry (char (*), dim (*) ptr, fixed bin (35));
165 dcl  error_table_$badopt ext fixed bin (35);
166 dcl  error_table_$file_not_opened ext fixed bin (35);
167 dcl  error_table_$inconsistent ext fixed bin (35);
168 
169 dcl (addr, addrel, bin, index, max, null, substr, string, unspec, verify) builtin;
170 
171 dcl  cleanup condition;
172 ^L
173 /* First argument will be the name of the tape to mount or name of input segment */
174 
175           call cu_$arg_count (arg_cnt);
176           if arg_cnt = 0 then do;
177                call com_err_ (0, lff_name, "Usage: ^a -control_args- ^/^-^a", lff_name,
178                     "{-mdr,-appl,-itr,-list,-device,-name,-file,-pathname,-segment,-config}");
179                return;
180           end;
181           call date_time_ (clock_ (), time_string);         /* Convert date and time. */
182           string (misc_bits) = "0"b;                        /* Reset a whole lot of bits */
183           output_dir = get_wdir_ ();                        /* Get working directory. */
184           call cu_$arg_ptr (1, argptr, arglen, code);       /* Get first argument. */
185           if code ^= 0 then go to err;
186           tape = argument;                                  /* Set tape ID. */
187           i = index (tape, ",");                            /* Check for commas in tape name */
188           if i > 1 then tape_name = substr (tape, 1, i - 1); /* If comma, use stuff before */
189           else tape_name = tape;                            /* Otherwise use the whole thing */
190 
191 /* Loop to scan the rest of the argument list */
192 
193           do arg_no = 2 to arg_cnt;                         /* And then loop thru them */
194                call cu_$arg_ptr (arg_no, argptr, arglen, code); /* Get an argument */
195                if code ^= 0 then go to err;
196 
197                if get_path then do;                         /* If next thing expected is path name */
198                     get_path = "0"b;                        /* Not expected any more */
199                     call expand_path_ (argptr, arglen, addr (output_dir), null, code);
200                     if code ^= 0 then go to arg_err;
201                end;
202 
203                else if substr (argument, 1, 1) = "-" then do; /* Found a control argument */
204                     scan_dev, scan_name, scan_file = "0"b;  /* No longer scanning for devices or names or files */
205                     if argument = "-mdr" then mdr_sw = "1"b;
206                     else if argument = "-appl" then appl_sw = "1"b;
207                     else if argument = "-itr" then itr_sw = "1"b;
208                     else if argument = "-list" | argument = "-ls" then load = "0"b;
209                     else if argument = "-device" | argument = "-dv" then scan_dev, dev_sw = "1"b;
210                     else if argument = "-name" | argument = "-nm" then scan_name, name_sw = "1"b;
211                     else if argument = "-file" then scan_file, file_sw = "1"b;
212                     else if argument = "-pathname" | argument = "-pn" then get_path = "1"b;
213                     else if argument = "-segment" | argument = "-sm" then input_segment_sw = "1"b;
214                     else if argument = "-config" then config_sw = "1"b;
215                     else do;
216                          code = error_table_$badopt;
217                          go to arg_err;
218                     end;
219                end;
220 
221                else if scan_dev then do;                    /* If scanning for devices after -dv */
222                     if dev_cnt >= 32 then
223                          call com_err_ (0, lff_name, "Too many device names: ^a ignored.", argument);
224                     else do;
225                          dev_cnt = dev_cnt + 1;             /* Count another device */
226                          dev_list (dev_cnt) = argument;     /* And save the argument */
227                     end;
228                end;
229 ^L
230                else if scan_name then do;                   /* If scanning for names after -nm */
231                     if name_cnt >= 32 then
232                          call com_err_ (0, lff_name, "Too many program names: ^a ignored.", argument);
233                     else do;
234                          name_cnt = name_cnt + 1;           /* Count the names */
235                          name_list (name_cnt) = argument;   /* And save it */
236                     end;
237                end;
238 
239                else if scan_file then do;                   /* If scanning for files after -file */
240                     if file_cnt >= 32 then
241                          call com_err_ (0, lff_name, "Too many file numbers: ^a ignored.", argument);
242                     else do;
243                          cv_dec_result = cv_dec_check_ (argument, cv_dec_err);
244                          if cv_dec_err ^= 0 then do;        /* If file number is not numeric */
245                               call com_err_ (0, lff_name, "Invalid file number: ^a", argument);
246                               return;
247                          end;
248                          file_cnt = file_cnt + 1;
249                          file_list (file_cnt) = cv_dec_result;
250                          max_file_no = max (max_file_no, cv_dec_result); /* Save highest file requested */
251                     end;
252                end;
253 
254                else do;                                     /* Ran out of things that the argument could be */
255                     code = error_table_$badopt;
256                     go to arg_err;
257                end;
258           end;
259 ^L
260 /* Perform some consistency checks on the accumulated arguments */
261 
262           if get_path then do;
263                call com_err_ (0, lff_name, "Missing pathname after -pathname");
264                return;
265           end;
266 
267           if config_sw then do;                             /* Check for things which conflict with -config */
268                segname = "";                                /* This will be name of conflicting control arg, if any */
269                if name_sw then segname = "-name";
270                else if dev_sw then segname = "-device";
271                else if file_sw then segname = "-file";
272                if segname ^= "" then do;                    /* If conflict found */
273                     call com_err_ (error_table_$inconsistent, lff_name, "-config and ^a", segname);
274                     return;
275                end;
276           end;
277 
278           if name_sw & (name_cnt = 0) then do;
279                call com_err_ (0, lff_name, "Missing program names after -name");
280                return;
281           end;
282 
283           if dev_sw & (dev_cnt = 0) then do;
284                call com_err_ (0, lff_name, "Missing device names after -device");
285                return;
286           end;
287 
288           if file_sw & (file_cnt = 0) then do;
289                call com_err_ (0, lff_name, "Missing file number after -file");
290                return;
291           end;
292 
293           if ^(mdr_sw | itr_sw | appl_sw) then mdr_sw, itr_sw, appl_sw = "1"b; /* If none, then use all */
294           if (mdr_sw & itr_sw & appl_sw) then all_sw = "1"b; /* If all types needed */
295           string (dev_flags), string (name_flags), string (file_flags) = "0"b;
296 
297 
298           on cleanup call clean_up;
299 
300           if config_sw then call scan_config;               /* If -config specified, scan config deck */
301 ^L
302 /* Create a temporary segment in the process directory to load firmware modules into */
303 
304           if load then do;
305                call get_temp_segments_ (lff_name, ptr_array, code);
306                if code ^= 0 then do;
307                     call com_err_ (code, lff_name, "Unable to get temp segment.");
308                     go to close;
309                end;
310                temp_seg_ptr = ptr_array (1);
311                save_segp = ptr_array (2);
312           end;
313 
314 
315 /* Make attachment for the listing segment */
316 
317 attach:   call iox_$attach_ioname ("fw_list", fw_list_ptr, "vfile_ " || tape_name || ".list", code);
318           if code ^= 0 then do;
319                call com_err_ (code, lff_name, "Attaching listing file");
320                go to close;
321           end;
322           fw_list_attach = "1"b;
323 
324           call iox_$open (fw_list_ptr, 2, "0"b, code);
325           if code ^= 0 then do;
326                call com_err_ (code, lff_name, "Opening listing file.");
327                go to close;
328           end;
329           fw_list_open = "1"b;
330 
331 
332 /* Make attachment for the tape or segment input file */
333 
334           if input_segment_sw then iomodule_name = "file_"; /* If segment input */
335           else iomodule_name = "nstd_";                     /* Otherwise tape input */
336           call ios_$attach ("fw_tape", iomodule_name, (tape), "r", iostatus); /* If segment input */
337           if substr (iostatus, 1, 36) then do;
338                unspec (code) = substr (iostatus, 1, 36);
339                call com_err_ (code, lff_name, "Attaching to input file with ^a", iomodule_name);
340                go to close;
341           end;
342           tape_attach = "1"b;
343           if input_segment_sw then do;                      /* If input from segment */
344                call ios_$setsize ("fw_tape", 36, iostatus);
345                if substr (iostatus, 1, 36) then do;
346                     unspec (code) = substr (iostatus, 1, 36);
347                     call com_err_ (code, lff_name, "Setting element size to 36.");
348                     go to close;
349                end;
350           end;
351 
352 
353 open:     call gcos_gsr_read_$gsr_read_init ("fw_tape", code);
354           if code ^= 0 then do;
355                call com_err_ (code, lff_name, "From gcos_gsr_read_$gsr_read_init.");
356                go to close;
357           end;
358           gcos_init = "1"b;
359 ^L
360 /* The first card should be the $object card */
361 
362 next:     call gcos_gsr_read_ ("fw_tape", rp, len, ctl, eof, code);
363           if code ^= 0 then do;
364 gcos_err:      call com_err_ (code, lff_name, "Error reported by gcos_gsr_read_");
365                go to close;
366           end;
367 got_eof:  if eof then do;                                   /* If EOF encountered ... */
368                if input_segment_sw then go to done;         /* Only one file in segment */
369                if prev_eof then go to done;                 /* If 2 EOF's in a row, we're finished. */
370                prev_eof = "1"b;                             /* Set flag to detect consecutive EOF's. */
371                fileno = fileno + 1;                         /* Bump tape file number. */
372                if file_sw then if fileno > max_file_no then go to done; /* Can quit if enough files scanned */
373                if config_sw then call config_eof;           /* Check progress */
374                header_sw = "0"b;                            /* Header will be needed */
375                cont_sw = 0;                                 /* Continued msg not needed now */
376                go to open;                                  /* And open for reading again. */
377           end;
378           else prev_eof = "0"b;                             /* Clear adjacent EOF flag. */
379 
380           if bin (substr (ctl, 3, 4), 4) ^= 2 then do;      /* Must be BCD record. */
381 oberr:         call com_err_ (0, lff_name, "Could not find $ OBJECT card.");
382                go to close;
383           end;
384 
385           call gcos_cv_gebcd_ascii_ (rp, 80, addr (objcard)); /* Convert the card to ASCII. */
386           if substr (objcard, 1, 13) ^= "$      object" then go to oberr;
387 
388 /* Next should be the preface card */
389 
390 got_obj:  call gcos_gsr_read_ ("fw_tape", rp, len, ctl, eof, code);
391           if code ^= 0 then go to gcos_err;
392           if eof then do;                                   /* Read the preface card. */
393 eoferr:        call com_err_ (0, lff_name, "Unexpected EOF.");
394                go to close;
395           end;
396           if bin (substr (ctl, 3, 4), 4) ^= 1 then do;      /* Must be binary card. */
397 perr:          call com_err_ (0, lff_name, "Error reading preface card.");
398                go to close;
399           end;
400           if card.type ^= "100000101101"b then
401                go to perr;                                  /* Must be 4055(8). */
402 
403           total_len = bin (card.load_address, 18);          /* Total length of this firmware deck. */
404           type = "";                                        /* Type isn't known til end of deck */
405           type_offset = total_len - 8;                      /* Type should be found in this word */
406           ident = "";                                       /* Ident not known */
407           ident_offset = total_len - 10;                    /* But will be here */
408           pgm_name = substr (objcard, 73, 4);               /* Name of program */
409           dev_name = substr (objcard, 43, 6);               /* Name of device or mpc */
410 ^L
411 /* If selecting special devices or names, test now to see if this program is needed */
412 
413           if ^dev_sw then go to chk_name;                   /* If no specific devices selected */
414           else do dev_index = 1 to dev_cnt;
415                if dev_list (dev_index) = dev_name then go to chk_name;
416           end;
417           go to flush;                                      /* Not needed */
418 
419 chk_name: if ^name_sw then go to chk_file;                  /* If no special names selected */
420           else do name_index = 1 to name_cnt;
421                if name_list (name_index) = pgm_name then go to chk_file;
422           end;
423           go to flush;                                      /* Not needed */
424 
425 chk_file: if ^file_sw then go to passed;                    /* If no specific files specified */
426           else do file_index = 1 to file_cnt;
427                if file_list (file_index) = fileno then go to passed;
428           end;
429           go to flush;                                      /* Failed */
430 
431 /* Flush the input tape until an eof or the next $object card */
432 
433 flush:    call gcos_gsr_read_ ("fw_tape", rp, len, ctl, eof, code);
434           if code ^= 0 then go to gcos_err;
435           if eof then go to got_eof;
436           if bin (substr (ctl, 3, 4), 4) ^= 2 then go to flush; /* If not bcd, then it can't be object card */
437           call gcos_cv_gebcd_ascii_ (rp, 80, addr (objcard));
438           if substr (objcard, 1, 15) = "$      object" then go to got_obj;
439           go to flush;
440 
441 /* Come here if all above tests have been passed succesfully */
442 
443 passed:
444 
445 
446 /* Check here for wimmix unit record file and exclude it unless it has been specifically
447    requested, or only a list option is being done */
448 
449           if load then if index (substr (objcard, 49, 6), "ww") ^= 0 then if ^file_sw then go to flush;
450 ^L
451 /* Now read binary cards, and if loading, store data in segment */
452 
453 loop:     call gcos_gsr_read_ ("fw_tape", rp, len, ctl, eof, code);
454           if code ^= 0 then go to gcos_err;                 /* Read the next card. */
455           if eof then go to eoferr;
456 
457           if bin (substr (ctl, 3, 4), 4) = 1 then do;       /* If binary card ... */
458                if card.type ^= "010000000101"b then do;     /* Check for legitimate card. */
459                     call com_err_ (0, lff_name, "Error reading binary card.");
460                     go to close;
461                end;
462 
463                bcp = addr (card);                           /* First control word is here */
464                data_addr = addr (card.data (1));            /* First data is here */
465                total_data = 0;                              /* Data transferred so far is 0 */
466 
467 loop2:         data_len = bin (bincard.count, 6);           /* Get length */
468                data_offset = bin (bincard.load_address, 18); /* Get address */
469 
470                if load then do;
471                     data_ptr = addrel (temp_seg_ptr, data_offset); /* Get pointer to data loc */
472                     data_ptr -> data = data_addr -> data;   /* Copy words */
473                end;
474 
475 
476                call find_word (type_offset, addr (type));   /* Get type if on this card */
477                call find_word (ident_offset, addr (ident)); /* Get ident if on this card */
478 
479                if total_data = 0 then total_data = data_len; /* On first card entry */
480                else total_data = total_data + data_len + 1; /* After first, must account for control word */
481                if total_data >= 18 then go to loop;         /* If it seems card is exhausted */
482                bcp = addr (card.data (total_data+1));       /* Compute next control word address */
483                data_addr = addrel (bcp, 1);                 /* And data address if more data */
484                if bincard.type = "010000000101"b then go to loop2; /* If more stuff */
485                else go to loop;                             /* If not */
486           end;
487 
488 /* Not a binary card, so this should be the $dkend card */
489 
490           else do;                                          /* Must be BCD card. */
491                call gcos_cv_gebcd_ascii_ (rp, 80, addr (dkecard));
492                if substr (dkecard, 1, 12) ^= "$      dkend" then do;
493                     call com_err_ (0, lff_name, "Could not find $ DKEND card.");
494                     go to close;
495                end;
496 ^L
497 /* If not all firmware types being loaded, check the type now */
498 
499                if substr (type, 4, 3) = "itr" then pgm_type = "i";
500                else if substr (type, 4, 3) = "mdr" then pgm_type = "m";
501                else pgm_type = "a";                         /* Must be application firmware */
502 
503                if pgm_type = "m" & load then                /* If dealing with mdr */
504                     if verify (substr (ident, 5, 2), "0123456789") ^= 0 then /* This is a "before-after" package */
505                          if substr (ident, 5, 2) ^= "om" then go to next; /* Ignore it, cause its not for multics */
506 
507                if config_sw then do;                        /* Selection is based on config deck */
508                     if pgm_type = "m" then do;              /* If this is an mdr */
509                          if mdr_sw then do i = 1 to mdr_count; /* If mdrs wanted, scan list */
510                               if dev_name = mdr_name (i) then do; /* Match */
511                                    mdr_bits (i) = "0"b;
512                                    go to need_it;
513                               end;
514                          end;
515                          go to next;
516                     end;
517                     if pgm_type = "a" then do;              /* If application firmware */
518                          if appl_sw then do i = 1 to appl_count; /* If application firmware wanted, scan list */
519                               if pgm_name = appl_name (i) then do;
520                                    appl_bits (i) = "0"b;
521                                    go to need_it;
522                               end;
523                          end;
524                          go to next;
525                     end;
526                     if pgm_type = "i" then do;              /* If itr */
527                          if itr_sw then do i = 1 to itr_count; /* If itrs wanted, scan list */
528                               if dev_name = itr_name (i) then do;
529                                    itr_bits (i) = "0"b;
530                                    go to need_it;
531                               end;
532                          end;
533                          go to next;
534                     end;
535                     go to next;                             /* Shouldn't get here */
536                end;
537 
538                if mdr_sw then if pgm_type = "m" then go to need_it;
539                if itr_sw then if pgm_type = "i" then go to need_it;
540                if appl_sw then if pgm_type = "a" then go to need_it;
541                go to next;                                  /* Don't need it */
542 
543 need_it:       if dev_sw then dev_flags (dev_index) = "1"b; /* Record fact that a match was made */
544                if name_sw then name_flags (name_index) = "1"b;
545                if file_sw then file_flags (file_index) = "1"b;
546 ^L
547 /* Now create the real segment */
548 
549                load_comment = "";
550                if load then do;                             /* If loading files ... */
551                     segname = "fw." || ident || "." || pgm_name;
552                     do i = 1 to save_cnt;                   /* Scan to see if one of these already done */
553                          if save_seg.name (i) = segname then do; /* Yes */
554                               load_comment = "(duplicate)";
555                               call hcs_$initiate (output_dir, segname, "", 0, 0, segp, code);
556                               if segp = null then do;
557                                    call com_err_ (code, lff_name, "Unable to initiate ^a>^a", output_dir, segname);
558                                    go to close;
559                               end;
560                               if unspec (segp -> total_seg) ^= unspec (temp_seg_ptr -> total_seg) then do; /* Not the same */
561                                    load_comment = "(duplicate, and unequal)";
562                                    call com_err_ (0, lff_name, "Module ^a from file ^d not the same as version in file ^d.",
563                                         segname, fileno, save_seg.file);
564                               end;
565                               go to skip_copy;
566                          end;
567                     end;
568                     save_cnt = save_cnt + 1;
569                     save_seg.name (save_cnt) = segname;
570                     save_seg.file (save_cnt) = fileno;
571                     call hcs_$make_seg (output_dir, segname, "", 01010b, segp, code);
572                     if segp = null then do;
573                          call com_err_ (code, lff_name, "Unable to create ^a", segname);
574                          go to close;
575                     end;
576                     segp -> total_seg = temp_seg_ptr -> total_seg; /* And copy it */
577                     files_loaded = files_loaded + 1;
578                     call hcs_$set_bc_seg (segp, total_len * 36, code);
579                     if code ^= 0 then do;
580                          call com_err_ (code, lff_name, "Unable to set bit count of ^a", segname);
581                          go to close;
582                     end;
583 skip_copy:          call hcs_$terminate_noname (segp, code);
584                     call hcs_$truncate_seg (temp_seg_ptr, 0, code);
585                     if code ^= 0 then do;
586                          call com_err_ (code, lff_name, "Unable to truncate temp segment.");
587                          go to close;
588                     end;
589                end;                                         /* Terminate the segment. */
590 
591 
592 /* Record firmware segment in the listing file */
593 
594                if ^header_sw then do;
595                     header_sw = "1"b;
596                     call ioa_$ioa_switch (fw_list_ptr, "^v(^|^)^-Contents of Firmware Tape: ^a^2-^a^2/",
597                          first_ff, tape_name, time_string);
598                     first_ff = 1;                           /* Form feeds no longer inhibited */
599                     call ioa_$ioa_switch (fw_list_ptr, "^4-File Number ^d.^v(  (cont'd)^)^2/",
600                          fileno, cont_sw);
601                     cont_sw = 1;                            /* Print continued next time */
602                     call ioa_$ioa_switch (fw_list_ptr, "^-^a^a^/",
603                          "P^H__^Hr_^Ho_^Hg_^Hr_^Ha_^Hm N^H__^Hu_^Hm_^Hb_^He_^Hr      D^H__^He_^Hv_^Hi_^Hc_^He    T^H__^Hy_^Hp_^He    I^H__^Hd_^He_^Hn_^Ht",
604                          "    N^H__^Ha_^Hm_^He     V^H__^He_^Hr_^Hs_^Hi_^Ho_^Hn  R^H__^He_^Hv.^H_  A^H__^Hs_^Hs.^H_    D^H__^Ha_^Ht_^He    L^H__^He_^Hn_^Hg_^Ht_^Hh");
605                     line_cnt = 0;                           /* No lines on page yet */
606                end;
607 
608                call ioa_$ioa_switch (fw_list_ptr,
609                     "^-^18a  ^6a   ^6a   ^6a   ^6a   ^6a    ^2a    ^a    ^2a/^2a/^2a  ^6o  ^a^/",
610                     substr (objcard, 16, 18), dev_name, type, ident, pgm_name,
611                     substr (objcard, 49, 6), substr (dkecard, 71, 2), substr (objcard, 60, 1),
612                     substr (objcard, 67, 2), substr (objcard, 69, 2), substr (objcard, 71, 2),
613                     total_len, load_comment);
614                line_cnt = line_cnt + 1;                     /* Count a line */
615                if line_cnt >= 25 then header_sw = "0"b;     /* Need a new page header */
616 
617 
618                go to next;                                  /* Go process next segment. */
619           end;
620 ^L
621 /* If special devices were specified, scan the list to be sure all were found */
622 
623 done:     if dev_sw then do dev_index = 1 to dev_cnt;
624                if ^dev_flags (dev_index) then
625                     call com_err_ (0, lff_name, "No programs loaded for device ^a.", dev_list (dev_index));
626           end;
627           if name_sw then do name_index = 1 to name_cnt;
628                if ^name_flags (name_index) then
629                     call com_err_ (0, lff_name, "No programs loaded with name ^a.", name_list (name_index));
630           end;
631           if file_sw then do file_index = 1 to file_cnt;
632                if ^file_flags (file_index) then
633                     call com_err_ (0, lff_name, "No programs loaded from file ^d.", file_list (file_index));
634           end;
635 
636 close:    call clean_up;
637 
638           return;
639 
640 
641 
642 err:      call com_err_ (code, lff_name);                   /* Print error message. */
643 
644           go to close;                                      /* Close out everything. */
645 
646 arg_err:  call com_err_ (code, lff_name, "^a", argument);
647           go to close;
648 ^L
649 /* Procedure to extract word from binary data */
650 
651 find_word: proc (word_offset, word_ptr);
652 
653 dcl  word_offset fixed bin;                                 /* Location in module of required word */
654 dcl  word_ptr ptr;                                          /* Pointer to where to store it */
655 dcl  indx fixed bin;                                        /* Relative loc if on current card */
656 
657                if word_offset < data_offset then return;    /* Before this card so return */
658                if word_offset >= data_offset + data_len then return; /* After this card, so return */
659                indx = word_offset - data_offset + 1;        /* Relative word of card */
660                if total_data > 0 then indx = indx + total_data + 1; /* Adjustment if not first field on binary card */
661                call gcos_cv_gebcd_ascii_ (addr (card.data (indx)), 6, word_ptr); /* Convert to ascii */
662                return;
663 
664           end find_word;
665 ^L
666 /* This routine is called if -config is specified to determine what is needed by scanning the config deck.
667    Three tables are prepared: itr_name contains device names for which itrs are needed,
668    appl_name contains names of needed application firmware programs, and mdr_name contains names of devices
669    for which mdrs are needed. */
670 
671 scan_config: proc;
672 
673 dcl (chan, chan_start, chan_end) fixed bin (6);             /* Channel numbers */
674 dcl  mpc_ptr ptr;                                           /* Pointer to mpc card */
675 dcl  prph_ptr ptr;                                          /* Pointr to prph card */
676 dcl  i fixed bin;
677 dcl  stopper fixed bin (35) based;                          /* For checking end of deck */
678 
679 dcl  config_deck$ ext;                                      /* The config deck */
680 
681 dcl 1 mpc aligned based (mpc_ptr),                          /* Mpc card */
682     2 word char (4),                                        /* "mpc " */
683     2 la (2),                                               /* A per link adapter table */
684       3 iom fixed bin,
685       3 chan fixed bin,
686       3 nchan fixed bin;
687 
688 dcl 1 prph aligned based (prph_ptr),                        /* Prph card for all but dskx */
689     2 word char (4),                                        /* "prph" */
690     2 name char (4),
691     2 iom fixed bin,
692     2 chan fixed bin,
693     2 model fixed bin;
694 
695 dcl 1 prph_dsk aligned based (prph_ptr),
696     2 word char (4),
697     2 name char (4),
698     2 iom fixed bin,
699     2 chan fixed bin,
700     2 nchan fixed bin,
701     2 model_tab (5),
702       3 model fixed bin,
703       3 ndrives fixed bin;
704 
705 dcl  chan_flag (4, 0:63) bit (1) unal;                      /* Tells what iom,channel combos are connected to mpc */
706 
707                mdr_count, itr_count, appl_count = 0;        /* Initialize some counters */
708                string (mdr_bits) = "0"b;
709                string (appl_bits) = "0"b;
710                string (itr_bits) = "0"b;
711 
712 
713                do mpc_ptr = addr (config_deck$) repeat (addrel (mpc_ptr, 16)) while (mpc_ptr -> stopper ^= -1);
714 
715                     if mpc.word = "mpc" then do;            /* Found mpc card */
716                          string (chan_flag) = "0"b;
717                          do i = 1 to 2 while (mpc.iom (i) ^= -1); /* Build table of all iom/chan combinations */
718                               chan_start = mpc.chan (i);
719                               chan_end = chan_start + mpc.nchan (i) - 1;
720                               do chan = chan_start to chan_end;
721                                    chan_flag (mpc.iom (i), chan) = "1"b;
722                               end;
723                          end;
724 
725 /* Now find prph cards for mpc */
726 
727                          do prph_ptr = addr (config_deck$) repeat (addrel (prph_ptr, 16)) while (prph_ptr -> stopper ^= -1);
728                               if prph.word = "prph" then do;
729                                    if chan_flag (prph.iom, prph.chan) then do;
730                                         if substr (prph.name, 1, 3) ^= "dsk" then
731                                              call check_dev (prph.name, prph.model);
732                                         else do i = 1 to 6 while (prph_dsk.model (i) ^= -1);
733                                              if prph_dsk.model (i) ^= 0 then
734                                                   call check_dev (prph_dsk.name, prph_dsk.model (i));
735                                         end;
736                                    end;
737                               end;
738                          end;
739                     end;
740                end;
741 
742                return;
743 
744           end scan_config;
745 
746 
747 /* This procedure is called at the end of each file to update what has been
748    loaded. This eliminates duplicates, and may enable program to stop before the
749    end of the tape. */
750 
751 config_eof: proc;
752 
753                if string (mdr_bits) = "0"b then mdr_count = 0;
754                if string (appl_bits) = "0"b then appl_count = 0;
755                if string (itr_bits) = "0"b then itr_count = 0;
756 
757                if itr_count = 0 & appl_count = 0 & mdr_count = 0 then go to close;
758 
759                do i = 1 to itr_count;                       /* Remove all names that have been processed */
760                     if ^itr_bits (i) then itr_name (i) = "******";
761                end;
762                do i = 1 to mdr_count;
763                     if ^mdr_bits (i) then mdr_name (i) = "******";
764                end;
765                do i = 1 to appl_count;
766                     if ^appl_bits (i) then appl_name (i) = "****";
767                end;
768                return;
769 
770           end config_eof;
771 ^L
772 /* This procedure, given a device and model, will decide what firmware is needed */
773 
774 check_dev: proc (devname, model);
775 
776 dcl  devname char (4) aligned;                              /* Name of device found */
777 dcl  model fixed bin;                                       /* Its model number */
778 dcl  device char (3);                                       /* This is type of device */
779 
780                device = substr (devname, 1, 3);             /* Type is just start of device name */
781                if device = "rdr" then do;                   /* If card reader */
782                     call store_itr ("urc002");              /* Unit record its */
783                     call store_appl ("ucmn");               /* Unit record common firmware */
784                     call store_appl ("ucrp");               /* Reader-punch overlay */
785                     call store_mdr ("crz301");              /* Reader mdrs */
786                     call store_mdr ("crdr/p");              /* Reader/Punch mdrs */
787                end;
788                else if device = "pun" then do;              /* If card punch */
789                     call store_itr ("urc002");              /* Unit record itrs */
790                     call store_appl ("ucmn");               /* Common unit record firmware */
791                     call store_appl ("ucrp");               /* Reader-punch overlay */
792                     call store_mdr ("cpz300");              /* Card punch mdrs */
793                     call store_mdr ("crdr/p");              /* Reader/Punch mdrs */
794                     call store_mdr ("cpz301");              /* Because of firmware tape inconsistency */
795                end;
796                else if device = "prt" then do;              /* If printer */
797                     call store_itr ("urc002");              /* Unit records itrs */
798                     call store_appl ("ucmn");               /* Unit record common firmware */
799                     if model = 203 then do;
800                          call store_appl ("u203");
801                          call store_mdr ("prt203");
802                     end;
803                     else if model = 303 then do;
804                          call store_appl ("u303");
805                          call store_mdr ("prt303");
806                     end;
807                     else if model = 401 | model = 402 | model = 1200 | model = 1600 then do;
808                          call store_appl ("u400");
809                          call store_mdr ("prt401");
810                     end;
811                     else go to bad_dev;
812                end;
813                else if device = "tap" then do;              /* If a tape drive */
814                     if model = 410 then do;
815                          call store_itr ("mtc500");
816                          call store_appl ("m500");
817                          call store_mdr ("mtu410");
818                     end;
819                     else if model = 500 | model = 600 then do;
820                          call store_itr ("mtc500");
821                          call store_appl ("m500");
822                          call store_mdr ("mtc500");
823                     end;
824                     else if model = 601 then do;
825                          call store_itr ("mtp601");
826                          call store_appl ("m601");
827                          call store_mdr ("mtp601");
828                     end;
829                     else if model = 610 then do;
830                          call store_itr ("mtp610");
831                          call store_appl ("m610");
832                          call store_mdr ("mtp601");
833                     end;
834                     else go to bad_dev;
835                end;
836                else if device = "dsk" then do;              /* Disk subsystem */
837                     if model = 181 then do;
838                          call store_itr ("dss181");
839                          call store_appl ("m181");
840                          call store_mdr ("dss181");
841                     end;
842                     else if model = 190 then do;
843                          call store_itr ("dss190");
844                          call store_appl ("m190");
845                          call store_mdr ("dss190");
846                     end;
847                     else if model = 191 | model = 400 | model = 450 | model = 451 then do;
848                          call store_itr ("dss191");
849                          call store_appl ("m191");
850                          call store_mdr ("dss191");
851                          call store_mdr ("ndm450");
852                     end;
853                     else if model = 500 then do;
854                          call store_itr ("mss500");
855                          call store_appl ("d500");
856                          call store_mdr ("dsu500");
857                     end;
858                     else go to bad_dev;
859                end;
860                else do;
861 bad_dev:            call com_err_ (0, lff_name, "Device ""^a"" model ""^d"" not known.", devname, model);
862                end;
863 
864                return;
865 
866           end check_dev;
867 ^L
868 /* These procedures store names of itrs, mdrs, and applications firmware to be loaded */
869 
870 store_itr: proc (name);
871 
872 dcl  name char (6);
873 dcl  i fixed bin;
874 
875                do i = 1 to itr_count;
876                     if itr_name (i) = name then return;
877                end;
878                itr_count = itr_count+1;
879                itr_name (itr_count) = name;
880                itr_bits (itr_count) = "1"b;
881                return;
882 
883           end store_itr;
884 
885 store_appl: proc (name);
886 
887 dcl  name char (4);
888 dcl  i fixed bin;
889 
890                do i = 1 to appl_count;
891                     if appl_name (i) = name then return;
892                end;
893                appl_count = appl_count+1;
894                appl_name (appl_count) = name;
895                appl_bits (appl_count) = "1"b;
896                return;
897 
898           end store_appl;
899 
900 store_mdr: proc (name);
901 
902 dcl  name char (6);
903 dcl  i fixed bin;
904 
905                do i = 1 to mdr_count;
906                     if mdr_name (i) = name then return;
907                end;
908                mdr_count = mdr_count+1;
909                mdr_name (mdr_count) = name;
910                mdr_bits (mdr_count) = "1"b;
911                return;
912 
913           end store_mdr;
914 ^L
915 /* Clean up handler for when command terminates */
916 
917 clean_up: proc;
918 
919                if ptr_array (1) ^= null then call release_temp_segments_ (lff_name, ptr_array, code);
920 
921                if fw_list_open then do;                     /* If listing file was opened */
922                     fw_list_open = "0"b;
923                     call iox_$close (fw_list_ptr, code);
924                     if code ^= 0 then call clean_up_err;
925                end;
926 
927                if fw_list_attach then do;                   /* If listing file attached */
928                     fw_list_attach = "0"b;
929                     call iox_$detach_iocb (fw_list_ptr, code);
930                     if code ^= 0 then call clean_up_err;
931                end;
932 
933                if gcos_init then do;                        /* If gcos routine was inited */
934                     gcos_init = "0"b;
935                     call gcos_gsr_read_$gsr_read_close ("fw_tape", code);
936                     if code ^= 0 then do;
937                          if code ^= error_table_$file_not_opened then call clean_up_err;
938                     end;
939                end;
940 
941                if tape_attach then do;                      /* If tape was attached */
942                     tape_attach = "0"b;
943                     call ios_$detach ("fw_tape", "", "", iostatus);
944                     unspec (code) = substr (iostatus, 1, 36);
945                     if code ^= 0 then call clean_up_err;
946                end;
947 
948                if load then if files_loaded > 0 then
949                          call ioa_ ("^a: ^d firmware segment^v(s^) created.",
950                          lff_name, files_loaded, bin (files_loaded ^= 1, 1));
951 
952 
953           end clean_up;
954 
955 
956 clean_up_err: proc;
957 
958                call com_err_ (code, lff_name);
959                return;
960 
961           end clean_up_err;
962 
963 
964 
965      end load_firmware_file;