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 /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */
 13 
 14 /*
 15    Written March 1975 by R. Bratt
 16 
 17    Last Modified:
 18 
 19    Janurary 30 1976 by R. Bratt to flush pam on directory renames and deletions
 20    May 31 1976 by R. Bratt to implement kst garbage collection
 21    November 1984 by Keith Loepere to move pam flush buffer to
 22      active_hardcore_data.  Also to change to using uid based flushing,
 23      instead of hierarchy depth.
 24 
 25    pathname_am  provides an associative memory to remember the correspondence
 26    between pathnames and directory segment numbers in a process. This associative
 27    memory is  managed by an lru algorithm.
 28 
 29    pathname_am$set places a pathname, segment number pair in the associative memory
 30    USAGE: call pathname_am$set (pathname, segnum);
 31 
 32    pathname_am$get_segno gets the segment number given a pathname
 33    USAGE: call pathname_am$get_segno (pathname, segnum);
 34    NOTE: since segment number associations kept in the pathname associative
 35    memory are not immune to garbage collection we increment a segment number's
 36    usage count before returning it.
 37 
 38    pathname_am$get_path gets the pathname given a segment number
 39    USAGE: call pathname_am$get_path (pathname, segnum);
 40 
 41    pathname_am$clear clears all associations between pathnames and a given segment number
 42    USAGE: call pathname_am$clear (segnum);
 43 
 44    pathname_am$flush causes a global flush from a given uid
 45    USAGE: call pathname_am$flush (uid);
 46 
 47    pathname char(*) varying --- pathname (no trailing blanks allowed)
 48    segnum fixed bin(17) --- segment number
 49    uid bit (36) aligned --- uid of directory
 50 
 51 */
 52 pathname_am: proc;
 53 
 54 /* Parameters */
 55 
 56 dcl  a_pname                            char (*) varying parameter;
 57 dcl  a_segnum                           fixed bin (17) parameter;
 58 dcl  a_uid                              bit (36) aligned parameter;
 59 
 60 /* Variables */
 61 
 62 dcl  flush_level                        fixed bin (35);
 63 dcl  hash_slot                          fixed bin;
 64 dcl  pam_index                          fixed bin;
 65 dcl  plen                               fixed bin;
 66 dcl  prevp                              ptr;
 67 
 68 /* Entries */
 69 
 70 dcl  kstsrch                            entry (bit (36) aligned, fixed bin (17), ptr);
 71 dcl  segno_usage$increment              entry (fixed bin (17), fixed bin (35));
 72 
 73 /* Misc */
 74 
 75 dcl  (addr, baseptr, dimension, length, mod, null, segno, stacq, substr) builtin;
 76 %page;
 77 initialize: entry ();
 78 
 79           amp = addr (pds$pathname_am);
 80           call empty_pam;
 81           pam.sets, pam.gets, pam.hits, pam.getps, pam.hitps, pam.rejects = 0;
 82           pam.clears, pam.flushes, pam.overflows, pam.overflow_uids, pam.flushed = 0;
 83           pam.initial_flush_level, pam.flush_level = active_hardcore_data$pam_flush_level;
 84           return;
 85 %page;
 86 get_segno: entry (a_pname, a_segnum);
 87 
 88           call update_to_current_flush_level ();
 89           plen = length (a_pname);
 90           a_segnum = -1;
 91           pam.gets = pam.gets + 1;
 92           if plen > PAM_name_max_lth then return;
 93           do amep = amp -> ame.fp repeat (ame.fp) while (amep ^= amp);
 94                if plen = ame.name_len then
 95                     if a_pname = substr (ame.name, 1, ame.name_len) then do;
 96                          pam.hits = pam.hits + 1;
 97                          call segno_usage$increment ((ame.segno), (0)); /* prevent garbage collection */
 98                          a_segnum = ame.segno;
 99                          call thread_to_head ();
100                          return;
101                     end;
102           end;
103           return;
104 %page;
105 get_path: entry (a_pname, a_segnum);
106 
107           call update_to_current_flush_level ();
108           pam.getps = pam.getps + 1;
109           do amep = amp -> ame.fp repeat (ame.fp) while (amep ^= amp);
110                if a_segnum = ame.segno then do;
111                     pam.hitps = pam.hitps + 1;
112                     a_pname = substr (ame.name, 1, ame.name_len);
113                     call thread_to_head ();
114                     return;
115                end;
116           end;
117           a_pname = "";
118           return;
119 %page;
120 set: entry (a_pname, a_segnum);
121 
122           call update_to_current_flush_level ();
123           pam.sets = pam.sets + 1;
124           plen = length (a_pname);
125           if plen > PAM_name_max_lth then do;
126                pam.rejects = pam.rejects + 1;
127                return;
128           end;
129           amep = amp -> ame.bp;                             /* take LRU entry */
130           ame.segno = a_segnum;
131           substr (ame.name, 1, plen) = a_pname;
132           ame.name_len = plen;
133           call thread_to_head ();
134           return;
135 %page;
136 clear: entry (a_segnum);
137 
138           amp = addr (pds$pathname_am);
139           pam.clears = pam.clears + 1;
140           do pam_index = 1 to dimension (pam.search, 1);
141                if pam.search (pam_index).segno = a_segnum then do;
142                     pam.cleared = pam.cleared + 1;
143                     amep = addr (pam.search (pam_index));
144                     ame.segno = 0;
145                     ame.name_len = 0;
146                     call thread_to_tail ();
147                end;
148           end;
149           return;
150 %page;
151 flush: entry (a_uid);
152 
153 /* The idea is to record in the circular pam_flush_buffer the uid of the
154 directory that was deleted/renamed.  Everyone must make sure no path in
155 their pam contains this uid before they can use their pam again. */
156 
157           amp = addr (pds$pathname_am);
158           do flush_level = active_hardcore_data$pam_flush_level + 1 repeat (active_hardcore_data$pam_flush_level + 1) while (^set_flush_level ());
159                                                             /* get a flush buffer slot all to myself */
160           end;                                              /* set associated depth */
161           active_hardcore_data$pam_flush_buffer
162                (mod (flush_level, dimension (active_hardcore_data$pam_flush_buffer, 1))) = a_uid;
163                                                             /* make sure  others haven't caught up and eaten our slot */
164           do while (active_hardcore_data$pam_flush_level - flush_level
165                > dimension (active_hardcore_data$pam_flush_buffer, 1));
166                flush_level = active_hardcore_data$pam_flush_level; /* DAMN!!!! - system will have lost track of uids to flush */
167                active_hardcore_data$pam_flush_buffer
168                     (mod (flush_level, dimension (active_hardcore_data$pam_flush_buffer, 1))) = (36)"1"b; /* make sure the world knows */
169           end;
170           return;
171 
172 set_flush_level: proc () returns (bit (1) aligned);         /* try to store new flush_level */
173 
174 dcl  flush_level_minus_1                fixed bin (35);
175 
176 dcl  new_value                          bit (36) aligned based (addr (flush_level));
177 dcl  old_value                          bit (36) aligned based (addr (flush_level_minus_1));
178 dcl  word                               bit (36) aligned based (addr (active_hardcore_data$pam_flush_level));
179 
180           flush_level_minus_1 = flush_level - 1;
181           return (stacq (word, new_value, old_value));
182      end;
183 %page;
184 empty_pam: proc;
185 
186           prevp = addr (pds$pathname_am);
187           do pam_index = 1 to dimension (pam.search, 1);
188                amep = addr (pam.search (pam_index));
189                prevp -> ame.fp = amep;
190                ame.bp = prevp;
191                ame.segno = 0;
192                ame.name_len = 0;
193                prevp = amep;
194           end;
195           prevp -> ame.fp = amp;
196           amp -> ame.bp = prevp;
197           return;
198      end;
199 
200 thread_to_head: proc;
201 
202           ame.fp -> ame.bp = ame.bp;                        /* thread out */
203           ame.bp -> ame.fp = ame.fp;
204           ame.fp = amp -> ame.fp;                           /* thread back in */
205           ame.bp = amp;
206           ame.bp -> ame.fp = amep;
207           ame.fp -> ame.bp = amep;
208           return;
209      end thread_to_head;
210 
211 thread_to_tail: proc;
212 
213           ame.fp -> ame.bp = ame.bp;                        /*  thread out */
214           ame.bp -> ame.fp = ame.fp;
215           ame.bp = amp -> ame.bp;                           /* thread back in */
216           ame.fp = amp;
217           ame.bp -> ame.fp = amep;
218           ame.fp -> ame.bp = amep;
219           return;
220      end thread_to_tail;
221 %page;
222 update_to_current_flush_level: proc;                        /* catch up to global flush level */
223 
224 /* Actually, this sub-proc implements the logic to make sure that our pam
225 doesn't contain any paths which contain a directory that was deleted or
226 renamed.  This is done by checking the uidpaths of the paths in our pam against
227 the list of uids of directories that have been deleted/renamed system wide.
228 If this list of uids is small enough, we can flush only certain paths.  If
229 too many directories were deleted/renamed system wide to keep up with, we
230 are stuck flushing our entire pam. */
231 
232 dcl  ahd_flush_buffer_index             fixed bin;
233 dcl  current_flush_level                fixed bin (35);
234 dcl  entryp                             ptr;
235 dcl  num_uids_to_flush                  fixed bin;
236 dcl  pam_index                          fixed bin;
237 dcl  uid                                bit (36) aligned;
238 dcl  uids_to_flush                      (15) bit (36) aligned; /* if more than this many uids match in addr space, not worth not flushing all */
239 dcl  uids_to_flush_index                fixed bin;
240 
241           amp = addr (pds$pathname_am);
242           current_flush_level = active_hardcore_data$pam_flush_level;
243           if current_flush_level = pam.flush_level then return;
244 
245           if current_flush_level - pam.flush_level ^> dimension (active_hardcore_data$pam_flush_buffer, 1) then do;
246                                                             /* not too many uids - looks like we can selectively flush */
247                num_uids_to_flush = 0;
248                do ahd_flush_buffer_index = pam.flush_level + 1 to current_flush_level;
249                     uid = active_hardcore_data$pam_flush_buffer (mod (ahd_flush_buffer_index, dimension (active_hardcore_data$pam_flush_buffer, 1)));
250                     if uid = (36)"1"b then go to overflow;
251                     call kstsrch (uid, hash_slot, kstep);   /* quick check to see if we should consider uid */
252                     if kstep ^= null then do;               /* appears in our addr space */
253                          if num_uids_to_flush >= dimension (uids_to_flush, 1) then do;
254                               pam.overflow_uids = pam.overflow_uids + 1;
255                               go to overflow;
256                          end;
257                          num_uids_to_flush = num_uids_to_flush + 1; /* add to list */
258                          uids_to_flush (num_uids_to_flush) = uid;
259                     end;
260                end;
261                if active_hardcore_data$pam_flush_level - pam.flush_level
262                     > dimension (active_hardcore_data$pam_flush_buffer, 1) then go to overflow; /* system overwrote where we were looking - sigh */
263           end;
264           else do;
265 overflow:                                                   /* complete flush required */
266                pam.overflows = pam.overflows + 1;
267                call empty_pam;
268                pam.flush_level = current_flush_level;
269                return;
270           end;
271 
272           if num_uids_to_flush > 0 then do;
273                kstp = pds$kstp;
274                pam.flushes = pam.flushes + 1;
275                do pam_index = 1 to dimension (pam.search, 1);
276                     if pam.search (pam_index).segno > 0 then
277                          do entryp = baseptr (pam.search (pam_index).segno) repeat kste.entryp while (entryp ^= null);
278                                                             /* check uid paths of all pam entries */
279                          kstep = addr (kst.kst_entry (segno (entryp)));
280                          do uids_to_flush_index = 1 to num_uids_to_flush;
281                               if kste.uid = uids_to_flush (uids_to_flush_index) then do;
282                                    amep = addr (pam.search (pam_index));
283                                                             /* pam entry has a uid => directory in path that was deleted/renamed */
284                                    pam.flushed = pam.flushed + 1;
285                                    ame.segno = 0;
286                                    ame.name_len = 0;
287                                    call thread_to_tail ();
288                                    go to next_pam_entry;
289                               end;
290                          end;
291                     end;
292 next_pam_entry:
293                end;
294           end;
295           pam.flush_level = current_flush_level;
296           return;
297      end update_to_current_flush_level;
298 %page; %include kst;
299 %page; %include pathname_am;
300      end pathname_am;