1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 make_branches: proc (pathp, namep, bitcnt, aclp, rb, access, dirsw);
 14 
 15 /* Modified 741115 by PG to turn off safety switch before trying to delete branch. */
 16 /* Modified 751104 by BSG for NSS: to trek around deleting stuff on non-RPV volume */
 17 /* Modified 3/82 BIM acl cleanup */
 18 
 19 dcl  bitcnt fixed bin (24),
 20     (pnl, pcnt, i, j) fixed bin (17),
 21      ercode fixed bin (35),
 22     (rb (3), nrb (3)) fixed bin (6),
 23      access bit (3),
 24      dirsw fixed bin (1),
 25      mode fixed bin (5);
 26 
 27 dcl 1 seg_access_string unaligned,
 28     2 zero1 bit (1) unaligned,
 29     2 rew bit (3) unaligned,
 30     2 zero2 bit (1) unaligned;
 31 
 32 dcl 1 dir_access_string unaligned,
 33     2 zero1 bit (1) unaligned,
 34     2 s bit (1) unaligned,
 35     2 zero2 bit (1) unaligned,
 36     2 m bit (1) unaligned,
 37     2 a bit (1) unaligned;
 38 
 39 dcl 1 dir_access_bit_string unaligned,
 40     2 s bit (1) unaligned,
 41     2 m bit (1) unaligned,
 42     2 a bit (1) unaligned;
 43 
 44 
 45 dcl (error_table_$namedup, error_table_$noaccess) fixed bin (35) external;
 46 dcl  error_table_$pvid_not_found fixed bin (35) external;
 47 
 48 
 49 dcl 1 nename aligned,                                       /* name structure for recursive call */
 50     2 count fixed bin (17),
 51     2 names,
 52       3 size fixed,
 53       3 name char (32) unaligned;
 54 
 55 dcl (addr, null, substr) builtin;
 56 
 57 
 58 dcl  asd_$replace_sall entry (char (*), char (*), ptr, fixed bin, bit (1) aligned, fixed bin (35)),
 59      append$branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (6), char (*),
 60      fixed bin (1), fixed bin, fixed bin (24), fixed bin (35)),
 61      chname$cfile entry (char (*), char (*), char (*), char (*), fixed bin (35)),
 62      delentry$dfile entry (char (*), char (*), fixed bin (35)),
 63      set$safety_sw_path entry (char (*), char (*), bit (1), fixed bin (35)),
 64      syserr ext entry options (variable),
 65      syserr$error_code entry options (variable),
 66      unique_chars_ entry (bit (*)) returns (char (15));
 67 
 68 %include slt;
 69 %include access_mode_values;
 70 ^L
 71 
 72 /* program */
 73 
 74           if dirsw = 0 /* segment */ then do;
 75                unspec (seg_access_string) = ""b;
 76                seg_access_string.rew = access;
 77                mode = bin (string (seg_access_string), 5);
 78           end;
 79           else do;
 80                unspec (dir_access_string) = ""b;
 81                string (dir_access_bit_string) = access;
 82                dir_access_string = dir_access_bit_string, by name;
 83                mode = bin (string (dir_access_string), 5);
 84           end;
 85 
 86 rpt:
 87           pnl = pathp -> path.size;                         /* Grab length of pathname. */
 88           call append$branchx (pathp -> path.name, namep -> segnam.names (1).name,
 89                mode, rb, "*.*.*", dirsw, 0, bitcnt, ercode); /* Try to append. */
 90           if ercode ^= 0 then do;                           /* Check for errors. */
 91                if ercode = error_table_$namedup then do;    /* Name dup. */
 92                     call delete (pathp -> path.name, namep -> segnam.names (1).name); /* Go delete. */
 93                     go to rpt;                              /* Try again. */
 94                end;
 95                else if ercode = error_table_$noaccess then do; /* See if dir. does not exist. */
 96                     do i = pnl to 1 by -1 while (substr (pathp -> path.name, i, 1) ^= ">");
 97                     end;
 98                     if i = 1 then
 99                          if substr (pathp -> path.name, 1, 1) ^= ">" then
100                               call syserr (1, "make_branches: bad path name ^a", pathp -> path.name);
101                          else pcnt = 1;
102                     else pcnt = i - 1;
103                     nename.names.name = substr (pathp -> path.name, i + 1, pnl - i);
104                     nrb (1), nrb (2), nrb (3) = 5;
105                     nename.count = 1;
106                     pathp -> path.size = pcnt;              /* This KLUDGE is worthy of Charles Garman. */
107                     call make_branches (pathp, addr (nename), 0, aclp, nrb, SMA_ACCESS, 1);
108                     pathp -> path.size = pnl;               /* However, it was perpetrated by NIM. */
109                     go to rpt;
110                end;
111                call syserr$error_code (1, ercode, "make_branches: error from append on ^a>^a:",
112                     pathp -> path.name, namep -> segnam.names (1).name);
113           end;
114           if aclp ^= null then do;                          /* must append an acl to the branch */
115 
116                call asd_$replace_sall (pathp -> path.name, namep -> segnam.names (1).name,
117                     addr (aclp -> acls.acl), aclp -> acls.count, "1"b, ercode);
118                if ercode ^= 0 then call syserr$error_code (1, ercode,
119                     "make_branches: error from asd_$replace_sall on ^a>^a:", pathp -> path.name, namep -> segnam.names (1).name);
120           end;
121           do j = 2 to namep -> segnam.count;                /* Add all other names. */
122 repeat:        call chname$cfile (pathp -> path.name, namep -> segnam.names (1).name, "",
123                     namep -> segnam.names (j).name, ercode); /* Add a name. */
124                if ercode ^= 0 then do;
125                     if ercode = error_table_$namedup then do;
126                          call delete (pathp -> path.name, namep -> segnam.names (j).name);
127                          go to repeat;                      /* Try again. */
128                     end;
129                     call syserr$error_code (1, ercode, "make_branches: error from chname on ^a>^a:",
130                          pathp -> path.name, namep -> segnam.names (1).name);
131                end;
132           end;
133           return;
134 
135 delete:   entry (pathname, entryname);                      /* Entry to delete something. */
136 
137 dcl (pathname, entryname) char (*);
138 dcl  newname char (32);
139 dcl  ustr char (15);
140 
141           call set$safety_sw_path (pathname, entryname, "0"b /* OFF */, ercode);
142           if ercode ^= 0 then if ercode = error_table_$pvid_not_found then go to nopv; /* online inst */
143                else call syserr$error_code (1, ercode, "make_branches: delete: could not turn ^a>^a safety switch off:",
144                     pathname, entryname);
145 
146           call delentry$dfile (pathname, entryname, ercode);
147           if ercode ^= 0 then if ercode = error_table_$pvid_not_found then do;
148 nopv:               ustr = unique_chars_ ("0"b);            /* Make up new name */
149                     newname = ustr || entryname;
150                     call syserr (0, "make_branches: delete: renaming ^a to ^a in ^a", entryname, newname, pathname);
151                     call chname$cfile (pathname, entryname, entryname, newname, ercode);
152                     if ercode ^= 0 then call syserr$error_code (1, ercode, "make_branches: delete: failed to rename");
153                end;
154                else call syserr$error_code (1, ercode, "make_branches: could not delete ^a>^a:", pathname, entryname);
155           return;
156 
157 /* BEGIN MESSAGE DOCUMENTATION
158 
159    Message:
160    make_branches: bad path name PATH
161 
162    S:     $crash
163 
164    T:     $init
165 
166    M:     $err
167 
168    A:     $recover
169    $boot_tape
170 
171 
172    Message:
173    make_branches: error from append on PATH: ERROR_MESSAGE
174 
175    S:     $crash
176 
177    T:     $init
178 
179    M:     $err
180 
181    A:     $recover
182    $boot_tape
183 
184 
185    Message:
186    make_branches: error from chname on PATH: ERROR_MESSAGE
187 
188    S:     $crash
189 
190    T:     $init
191 
192    M:     $err
193 
194    A:     $recover
195    $boot_tape
196 
197 
198    Message:
199    make_branches: error from asd_$replace_sall on PATH: ERROR_MESSAGE
200 
201    S:     $crash
202 
203    T:     $init
204 
205    M:     $err
206 
207    A:     $recover
208    $boot_tape
209 
210 
211    Message:
212    make_branches: delete: could not turn PATH safety switch off: ERROR_MESSAGE
213 
214    S:     $crash
215 
216    T:     $init
217 
218    M:     $err
219 
220    A:     $recover
221    $boot_tape
222 
223 
224    Message:
225    make_branches: delete: renaming NAME to UNIQUE in DIRNAME
226 
227    S:     $info
228 
229    T:     $init
230 
231    M:     A segment which
232    is being loaded from the system tape
233    encountered a previous copy
234    on a physical volume which
235    is not now mounted.
236    The old version of the segment is being renamed
237    so that the new copy can be loaded.
238 
239    A:     $note
240    The system programmers will want to delete the unique-named segment.
241 
242 
243    Message:
244    make_branches: delete: failed to rename
245 
246    S:     $crash
247 
248    T:     $init
249 
250    M:     $err
251 
252    A:     $recover
253    $boot_tape
254 
255 
256    Message:
257    make_branches: could not delete PATH: ERROR_MESSAGE
258 
259    S:     $crash
260 
261    T:     $init
262 
263    M:     $err
264 
265    A:     $recover
266    $boot_tape
267 
268 
269    END MESSAGE DOCUMENTATION */
270 
271      end make_branches;