1 /* ******************************************************
  2    *                                                    *
  3    *                                                    *
  4    * Copyright (c) 1972 by Massachusetts Institute of   *
  5    * Technology and Honeywell Information Systems, Inc. *
  6    *                                                    *
  7    *                                                    *
  8    ****************************************************** */
  9 
 10 
 11 /* FIRMWARE_UTIL_ - A procedure for locating firmware segments in a firmware archive */
 12 /* Written July 1975 by Larry Johnson */
 13 
 14 
 15 firmware_util_: proc;
 16           return;
 17 
 18 /* parameters */
 19 
 20 dcl  fwptr ptr;                                             /* pointer to firmware archive */
 21 dcl  code fixed bin (35);                                   /* system status code */
 22 dcl  ident char (6);                                        /* firmware program ident */
 23 dcl  name char (4);                                         /* firmware program name  */
 24 dcl  segp ptr;                                              /* returned pointer to firmware segment */
 25 dcl  seglen fixed bin (18);                                 /* returned length of firmware segment */
 26 
 27 /* automatic storage */
 28 
 29 dcl  dir char (168);                                        /* directory name */
 30 dcl  ename char (32);                                       /* entry name */
 31 dcl  v_ename char (32) varying;                             /* varying form of entry name  */
 32 dcl  segname char (32);                                     /* name of segment in archive */
 33 dcl  ac_code fixed bin;                                     /* error code form archive_util_ */
 34 dcl  head_ptr ptr;                                          /* pointer to header in archive */
 35 dcl  temp_ptr ptr;
 36 dcl  star_sw bit (1);                                       /* set if name uses star convention */
 37 dcl  bit_count fixed bin (24);                              /* bit count of segment */
 38 
 39 /* entry variables */
 40 
 41 dcl  get_wdir_ entry returns (char (168));
 42 dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
 43 dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
 44 dcl  archive_util_$first_element entry (ptr, fixed bin);
 45 dcl  archive_util_$first_disected entry (ptr, ptr, char (32), fixed bin (24), fixed bin);
 46 dcl  archive_util_$disected_element entry (ptr, ptr, char (32), fixed bin (24), fixed bin);
 47 dcl  match_star_name_ entry (char (*), char (*), fixed bin (35));
 48 
 49 dcl  error_table_$noentry ext fixed bin (35);
 50 dcl  error_table_$archive_fmt_err ext fixed bin (35);
 51 dcl  error_table_$zero_length_seg ext fixed bin (35);
 52 
 53 dcl (divide, index, null, substr) builtin;
 54 
 55 
 56 /* entry point to initialize processing of firmware directory */
 57 
 58 init:     entry (fwptr, code);
 59 
 60           dir = get_wdir_ ();                               /* use working directory for now */
 61           call hcs_$initiate (dir, "firmware.archive", "", 0, 0, fwptr, code); /* initiate segment */
 62           if fwptr = null then do;                          /* failed in -wd so try >firmware */
 63                call hcs_$initiate (">firmware", "firmware.archive", "", 0, 0, fwptr, code);
 64                if fwptr = null then return;                 /* failed there too */
 65           end;
 66           call archive_util_$first_element (fwptr, ac_code); /* check first element */
 67           if ac_code = 0 then do;                           /* archive ok */
 68                code = 0;                                    /* return good status */
 69                return;
 70           end;
 71           call hcs_$terminate_noname (fwptr, code);         /* bad archive, so terminate */
 72           if ac_code = 1 then code = error_table_$zero_length_seg; /* if empty */
 73           else code = error_table_$archive_fmt_err;         /* if bad format */
 74           return;
 75 
 76 
 77 /* entry point to locate a firmware segment in the archive */
 78 
 79 find:     entry (fwptr, ident, name, segp, seglen, code);
 80 
 81 /* first build name of module to be found (may be a star name) */
 82 
 83           star_sw = "0"b;                                   /* use of star convention not found yet */
 84           v_ename = "fw.";                                  /* standard first component */
 85           v_ename = v_ename || cvt_name (ident);            /* add ident portion */
 86           v_ename = v_ename || ".";
 87           v_ename = v_ename || cvt_name (name);             /* add name portion */
 88           ename = v_ename;                                  /* final name */
 89 
 90 /* check first entry */
 91 
 92           head_ptr = fwptr;                                 /* initialize pointer for the scan */
 93           call archive_util_$first_disected (head_ptr, temp_ptr, segname, bit_count, ac_code);
 94           if ac_code ^= 0 then do;                          /* some error */
 95                if ac_code = 1 then code = error_table_$zero_length_seg;
 96                else code = error_table_$archive_fmt_err;
 97                segp = null;
 98                seglen = 0;
 99                return;
100           end;
101 
102 /* check to see if this is the entry wanted */
103 
104 check:    if star_sw then do;                               /* if start name needed  */
105                call match_star_name_ (segname, ename, code); /* try match */
106                if code = 0 then go to hit;                  /* found it */
107           end;
108           else if segname = ename then go to hit;           /* simple match will do */
109 
110 /* step to next entry in segment */
111 
112           call archive_util_$disected_element (head_ptr, temp_ptr, segname, bit_count, ac_code);
113           if ac_code = 0 then go to check;                  /* if no error, check for match */
114           if ac_code = 1 then code = error_table_$noentry;  /* not found */
115           else code = error_table_$archive_fmt_err;
116           segp = null;
117           seglen = 0;
118           return;
119 
120 /* come here when match made */
121 
122 hit:      segp = temp_ptr;
123           seglen = divide (bit_count, 36, 18, 0);
124           code = 0;
125           return;
126 
127 /* subroutine to return character string with leading and trailing blanks removed */
128 
129 cvt_name: proc (string) returns (char (6) var);
130 
131 dcl  string char (*);
132 dcl  temp char (6);
133 dcl  i fixed bin;
134 
135                temp = string;                               /* copy input */
136 loop:          if temp = "" | temp = "*" then do;
137                     star_sw = "1"b;
138                     return ("*");
139                end;
140                i = index (temp, " ");                       /* find a blank */
141                if i = 0 then return (temp);                 /* no blanks */
142                if i = 1 then do;                            /* blank is first */
143                     temp = substr (temp, 2);
144                     go to loop;
145                end;
146                return (substr (temp, 1, i-1));              /* return string without trailing blanks */
147 
148           end cvt_name;
149 
150 
151 
152 
153 
154      end firmware_util_;