1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1988                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         *********************************************************** */
  8 %;                                                          /* Driver for mload procedure. */
  9 /* ******************************************************
 10    *                                                    *
 11    *                                                    *
 12    * Copyright (c) 1972 by Massachusetts Institute of   *
 13    * Technology and Honeywell Information Systems, Inc. *
 14    *                                                    *
 15    *                                                    *
 16    ****************************************************** */
 17 
 18 reload:                                                     /* Created 21 May 1969, R H Campbell. */
 19      procedure;                                             /* Modified 15 March 1970, R H Campbell. */
 20                                                             /* Last mod by Kobziar, 1 May 75 to add system_release entry */
 21 /* -dprint and -no_dprint added 03/19/80 S. Herbst */
 22 /* Changed dprinting to see -ds, -he, and -rqt 12/01/81 S. Herbst */
 23 /* Changed to dprint -no_endpage since map is already page-formatted 01/21/82 S. Herbst */
 24 /* Updated dprint_defaults structure to reflect latest dprint_arg.incl.pl1 04/01/85 Steve Herbst */
 25 
 26 
 27 /****^  HISTORY COMMENTS:
 28   1) change(87-05-10,Gilcrease), approve(87-05-13,MCR7686),
 29      audit(88-02-01,Farley), install(88-02-02,MR12.2-1019):
 30      Updated to use version 9 of dprint_msg structure.
 31   2) change(88-10-27,Brunelle), approve(88-10-27,MCR7911),
 32      audit(88-10-18,Wallman), install(88-10-28,MR12.2-1199):
 33      Upgraded to use new version of dprint_args structure.
 34                                                    END HISTORY COMMENTS */
 35 
 36 
 37 
 38 dcl (cold, complete, print_map, array) bit (1) init ("0"b); /* Flags to remember mode of operation. */
 39 dcl  map_name char (64),                                    /* The reload map segment name. */
 40      arg_array (20) char (32) aligned;
 41 
 42 dcl (dir char (168),
 43      ent char (32)) aligned,
 44      rings (3) fixed bin (6),
 45      error_table_$noarg ext fixed bin,
 46      error_table_$namedup ext fixed bin;
 47 dcl  device char (8);                                       /* Device map is attached to. */
 48 dcl  mode char (0);                                         /* Mode of attachment. */
 49 dcl  tchar char (1) based;                                  /* Test character */
 50 dcl  mname char (32);
 51 dcl  code fixed bin;                                        /* Error status code. */
 52 dcl (l, n) fixed bin;                                       /* Temporary. */
 53 dcl (ap, alp, sp) pointer;                                  /* Pointer to argument,  IO status string. */
 54 dcl  arg based char (n);
 55 dcl  error_table_$ionmat external fixed bin;                /* Error code from ios_. */
 56 dcl  date_name_ entry (char (*), char (*), char (*), char (*), fixed bin);
 57 dcl  backup_load entry;
 58 dcl  com_err_ entry options (variable),
 59      cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin),
 60      cu_$arg_list_ptr entry (pointer),
 61      bk_arg_reader_$reload_arg_reader entry (fixed bin, pointer, fixed bin),
 62      bk_arg_reader_$array_arg_reader entry ((20) char (32) aligned, fixed bin),
 63      dprint_ entry (char(*) aligned, char(*) aligned, ptr, fixed bin),
 64      expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin),
 65      hcs_$status_minf entry (char (*) aligned, char (*) aligned, fixed bin (1),
 66                     fixed bin, fixed bin (35), fixed bin),
 67      hcs_$append_branchx entry (char (*) aligned, char (*) aligned, fixed bin (5), (3) fixed bin (6),
 68      char (*) aligned, fixed bin (1), fixed bin (1), fixed bin (24), fixed bin),
 69      hcs_$acl_add1 entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5),
 70     (3) fixed bin (6), fixed bin),
 71      get_group_id_$tag_star returns (char (32) aligned),
 72      cu_$level_get returns (fixed bin),
 73     (ioa_, ioa_$rsnnl) entry options (variable),            /* Variable arguments. */
 74      ios_$attach entry (char (*), char (*), char (*), char (*), bit (72) aligned),
 75      ios_$detach entry (char (*), char (*), char (*), bit (72) aligned),
 76      ios_$get_at_entry_ entry (char (*), char (*), char (*), char (*), fixed bin),
 77      unique_chars_ entry (bit (*) aligned) returns (char (15) aligned);
 78 
 79 dcl (addr, max) builtin;
 80 
 81 %         include bk_ss_;
 82 
 83 %         include io_status;
 84 
 85 %         include dprint_arg;
 86 
 87 dcl 1 dprint_defaults aligned,                              /* argument structure */
 88     2 version fixed bin init (9),                           /* version number of dcl */
 89     2 copies fixed bin init (1),                            /* number of copies wanted */
 90     2 delete fixed bin init(0),                             /* 1=delete after print */
 91     2 queue fixed bin init(-1),                             /* default print queue */
 92     2 pt_pch fixed bin init (1),                            /* 1=print, 2=punch */
 93     2 notify fixed bin init (0),                            /* 1 = notify user when done */
 94     2 heading char (64) init (""),                          /* first page heading */
 95     2 output_module fixed bin init (1),                     /* 1=print, 2=7punch, 3=mcc, 4=raw */
 96     2 dest char (12) init (""),                             /* destination */
 97 
 98 /* limit of version 1 structure */
 99 
100     2 carriage_control,                                     /* Carriage control flags. */
101       3 nep bit (1) unal init ("0"b),                       /* TRUE if print thru perf. */
102       3 single bit (1) unal init ("0"b),                    /* TRUE if ignore FF and VT */
103       3 non_edited bit (1) unal init ("0"b),                /* TRUE if printing in non-edited mode */
104       3 truncate bit (1) unal init ("0"b),                  /* TRUE if truncating lines at line length */
105       3 center_top_label bit (1) unal init ("0"b),          /* TRUE if top label to be centered */
106       3 center_bottom_label bit (1) unal init ("0"b),       /* TRUE if bottom label to be centered */
107       3 esc bit (1) unal init ("0"b),
108       3 no_separator bit (1) unal init ("0"b),
109       3 line_nbrs bit (1) unal init ("0"b),
110       3 padding bit (27) unal init ((27)"0"b),
111     2 pad (30) fixed bin init ((30)0),
112     2 forms char (8) init (""),                             /* forms required */
113     2 lmargin fixed bin init (0),                           /* left margin */
114     2 line_lth fixed bin init (-1),                         /* max line lth */
115 
116 /* limit of version 2 structure */
117 
118     2 class char(8) init (""),                              /* obsolete: device class */
119     2 page_lth fixed bin init (-1),                         /* Paper length arg */
120 
121 /* limit of version 3 structure */
122 
123     2 top_label char(136) init (""),                        /* top-of-page label */
124     2 bottom_label char(136) init (""),                     /* bottom-of-page label */
125 
126 /* limit of version 4 structure */
127 
128     2 bit_count fixed bin (35) init (0),
129     2 form_name char (24) init (""),
130     2 destination char (24) init (""),
131     2 chan_stop_path char (168) init (""),
132 
133 /* limit of version 5 structure */
134 
135     2 request_type char (24) unaligned init (""), /* default request type */
136        2 defer_until_process_termination fixed bin init (0),
137                                         /* 1 = don't process terminates      */
138     2 forms_name char (64) unaligned init ("");
139 /*^L*/
140 join_reload:
141           cold = ""b;                                       /* Entry for complete reload on "warm" system. */
142           print_map = "1"b;                                 /* Set flags to indicate operation. */
143           bk_ss_$myname = "reload";
144           go to squo;                                       /* Go to common code. */
145                                                             /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
146 reload_arg_array: entry (arg_array);
147           array = "1"b;                                     /* set flag */
148           goto join_reload;                                 /* use common code */
149                                                             /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ** * */
150 system_release: entry;                                      /* trim everything, tape info overwrites always */
151           cold = "0"b;
152           print_map = "0"b;
153           bk_ss_$myname = "reload";                         /* function as a reload */
154           bk_ss_$ignore_dates = "1"b;                       /* all info on tape gets in */
155           bk_ss_$dir_trim = "1"b;                           /* directories go too */
156           go to squo;
157                                                             /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
158 iload:    entry;                                            /* For complete (initial) reload on "cold" system. */
159           cold = "1"b;                                      /* Set up flags. */
160           print_map = "0"b;                                 /* .. */
161           bk_ss_$myname = "iload";
162 squo:     bk_ss_$trimsw = "1"b;                             /*  Set to trim for reload */
163           complete = "1"b;                                  /* Complete dump wanted */
164           bk_ss_$quotasw = "1"b;                            /* Allow quota setting on reload */
165           go to reset_control;                                        /* Go start processing. */
166                                                             /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
167 retrieve: entry;                                            /* Entry to start retrieve-by-name. */
168           cold, complete, print_map = ""b;                  /* Set up flags for retrieval. */
169           bk_ss_$quotasw = ""b;                             /* No quota changing on retrieval */
170           bk_ss_$datesw = ""b;                              /* Flag to load segment dumped after given date */
171           bk_ss_$myname = "retrieve";
172           bk_ss_$trimsw = ""b;                              /* No trim on retrieve */
173 reset_control:
174           bk_ss_$sub_entry = "0"b;
175           bk_ss_$pvname = "";
176           bk_ss_$pvsw = "0"b;
177           bk_ss_$rname = "";
178           bk_ss_$retrievesw = "0"b;
179           bk_ss_$rsize = 0;
180 start:
181           n = 1;                                            /* Set up to read first arg if any */
182 
183           if ^complete then do;                             /* This is a retrieval */
184                call cu_$arg_ptr (1, ap, n, code);
185                if code ^= 0 then do;                        /* arg is required */
186                     call com_err_ (code, bk_ss_$myname, "Control file path required.");
187                     go to ended;
188                end;
189 
190                if ap -> tchar = "-" then do;                /* Prepare to call argument reader */
191                     n = 1;                                  /* Start with first arg */
192                     go to arg_reader;
193                end;
194                bk_ss_$rname = ap -> arg;                    /* Save retrieval control file name */
195                bk_ss_$retrievesw = "1"b;                    /* Flag retrieval */
196                bk_ss_$rsize = n;                            /* And length. */
197 
198                n = 2;                                       /* Set up arg number for arg reader */
199 
200           end;
201 
202 arg_reader:
203           bk_ss_$mapsw = "1"b;                              /* First set some switches */
204           if ^array then do;
205                call cu_$arg_list_ptr (alp);                 /* Get a pointer to the argument list */
206                call bk_arg_reader_$reload_arg_reader (n, alp, code);
207           end;
208           else call bk_arg_reader_$array_arg_reader (arg_array, code);
209           if code ^= 0 then if code ^= error_table_$noarg then go to ended;
210 
211           if bk_ss_$myname = "retrieve"                     /* Is this supposed to be a retrieval */
212           then if bk_ss_$retrievesw                         /* If this is a retrieval */
213                then call ioa_$rsnnl ("^a.retrieve.map", map_name, l, bk_ss_$rname); /* Construct name using argument. */
214                else do;
215                     call ioa_ ("No retrieval file argument given");
216                     go to ended;
217                end;
218 
219           else if bk_ss_$debugsw then do;                   /* Just debuging or user trying to use this */
220                call date_name_ ("", "", "reload.map", mname, code); /* Make up a map name */
221                if code ^= 0 then do;
222                     call com_err_ (code, "reload", "Termination on error from date_name_");
223                     go to ended;
224                end;
225                map_name = mname;                            /* Copy map name */
226                l = 32;
227           end;
228 
229           else do;                                          /* This is for real */
230                if cold then do;                             /* For COLD reload */
231                     rings (1), rings (2), rings (3) = 7;
232                     call hcs_$append_branchx (">", "reload_dir", 01011b, rings,
233                          (get_group_id_$tag_star ()), 1, 0, 0, code);
234                     if code ^= 0 then if code ^= error_table_$namedup then go to ended; /* Can it be created? */
235                     call hcs_$acl_add1 (">", "reload_dir", "*.SysDaemon.*", 01011b, rings, code);
236                     if code ^= 0 then go to ended;
237                end;
238                                                             /* Put map in special directory */
239                call ioa_$rsnnl (">reload_dir>^a.reload.map", map_name, l, unique_chars_ (""b));
240           end;
241 
242           rings (1), rings (2), rings (3) = max ((cu_$level_get ()), 4);
243 
244           call expand_path_ (addr (map_name), l, addr (dir), addr (ent), code);
245           call hcs_$append_branchx (dir, ent, 01011b, rings, (get_group_id_$tag_star ()), 0, 0, 0, code);
246           if (code = 0) | (code = error_table_$namedup)
247           then call hcs_$acl_add1 (dir, ent, "*.SysDaemon.*", 01011b, rings, code);
248           sp = addr (status);                               /* Set up pointer to status structure. */
249           call ios_$attach ("map", "file_", map_name, "w", sp -> status_bits); /* Try to attach the map. */
250           if status.code = error_table_$ionmat then do;     /* If name already attached, use it. */
251                if print_map then do;                        /* Will we need the name of the map file? */
252                     call ios_$get_at_entry_ ("map", device, map_name, mode, code); /* Get AT info. */
253                     if code = 0 then do;                    /* OK? */
254                          if device ^= "file_" then          /* Is it a file? */
255                               print_map = ""b;              /* No, we can't print it. */
256                     end;
257                     else do;                                /* No, gripe. */
258                          call com_err_ (code, bk_ss_$myname, "ios_$get_at_entry_ for map");
259                          print_map = ""b;                   /* We can't print the map. */
260                     end;
261                end;
262           end;
263           else if status.code ^= 0 then do;                 /* All OK? */
264                call com_err_ (status.code, bk_ss_$myname, "ios_$attach for ^a", map_name);
265                go to ended;                                 /* Quit. */
266           end;
267 
268           call backup_load ();                              /* Start the loading */
269 
270 done:     call ios_$detach ("map", "", "", sp -> status_bits); /* Detach the map. */
271           if status.code ^= 0 then                          /* If not all OK, type comment, but ignore. */
272                call com_err_ (status.code, bk_ss_$myname, "ios_$detach for ^a", map_name);
273           if print_map & bk_ss_$dprintsw then do;                     /* Can we print the map? */
274                dpap = addr(dprint_arg_buf);
275                dprint_arg_buf = dprint_defaults;
276                dprint_arg.nep = "1"b;                       /* -no_endpage since map is already page-formatted */
277                dprint_arg_buf.queue = bk_ss_$dprint_queue;
278                if bk_ss_$dprint_destination_setsw then dprint_arg_buf.destination = bk_ss_$dprint_destination;
279                else dprint_arg_buf.destination = "BACKUP";
280                if bk_ss_$dprint_heading_setsw then dprint_arg_buf.heading = bk_ss_$dprint_heading;
281                else dprint_arg_buf.heading = "RELOAD MAP";
282                if bk_ss_$dprint_request_type_setsw then dprint_arg_buf.request_type = bk_ss_$dprint_request_type;
283                call hcs_$status_minf (dir, ent, 1, 0, dprint_arg_buf.bit_count, code);
284 
285                call dprint_ ( dir, ent, dpap, code );
286                if code ^= 0
287                     then call com_err_ ( code, bk_ss_$myname, "Unable to dprint map." );
288                end;
289 
290 ended:    bk_ss_$myname = "";                               /* we are no more */
291      end reload;