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 terminate_: proc (a_segptr, a_rsw, a_code);
 15 
 16 /* This procedure provides a variety of entries to remove names and segments
 17    from the RNT and KST.
 18 
 19    Written October 1974 by R. Bratt as a write around for the old terminate
 20 
 21    Last modified:
 22 
 23    R. Bratt 06/03/76 to call find_$finished
 24    M. Weaver 04/77 to ignore code r0_refname and to zero lot entry when appropriate
 25    B. Margulies May 1982 to not trash refnames with noname terminations.
 26    Keith Loepere July 1984 to use the new dc_find.
 27    Keith Loepere November 1984 to rename to terminate_; add auditing support;
 28           also to remove unused directory undetectability.
 29 
 30    -- ->  terminate_$teseg remove the KST entry for a segment given its segment pointer.
 31    USAGE: call terminate_$teseg, call hcs_$terminate_seg (segptr, rsw, code)
 32 
 33    -- ->  terminate_$tefile removes a segments KST entry, given its directory pathname and entry name
 34    USAGE: call terminate_$tefile, call hcs_$terminate_file (dirname, ename, rsw, code);
 35 
 36    -- ->  terminate_$noname removes a single null name from a segment given its segment pointer.
 37    USAGE: call terminate_$noname call hcs_$terminate_noname (segptr, code)
 38 
 39    -- ->  terminate_$name removes a reference name from a segment.
 40    USAGE: call terminate_$name, call hcs_$terminate_name (name, code)
 41    note: these last two entries will also remove the KST entry if they have
 42    deleted the segments last name.
 43 
 44    -- ->  terminate_$id removes a segment from the kst by uid.  It is an
 45    internal interface to be used by delentry.
 46    USAGE: call terminate_$id (uid, rsw, code);
 47 
 48    1) segptr ptr - - - pointer to the segment
 49    2) rsw fixed bin(1) - - - =1 reserve this segment number for later use, = 0 don't bother
 50    3) code fixed bin - - - error code (output)
 51    4) dirname char(*) - - - pathname of superior directory
 52    5) ename char(*) - - - entry name of segment
 53    6) name char(*) - - - reference name of segment
 54    7) uid bit (36) aligned - - - unique identifier of segment
 55 
 56    */
 57 
 58 /* Parameters */
 59 
 60 dcl  a_code                             fixed bin (35) parameter;
 61 dcl  a_dirname                          char (*) parameter;
 62 dcl  a_ename                            char (*) parameter;
 63 dcl  a_name                             char (*) parameter;
 64 dcl  a_rsw                              fixed bin (1) parameter;
 65 dcl  a_segptr                           ptr parameter;
 66 dcl  a_uid                              bit (36) aligned parameter;
 67 
 68 /* Variables */
 69 
 70 dcl  code                               fixed bin (35);
 71 dcl  dirname                            char (168);
 72 dcl  ename                              char (32);
 73 dcl  hash_bucket                        fixed bin (17);
 74 dcl  n_names                            fixed bin;
 75 dcl  refname                            char (32) var;
 76 dcl  rsw                                fixed bin (1);
 77 dcl  segno                              fixed bin (17);
 78 dcl  segptr                             ptr;
 79 dcl  uid                                bit (36) aligned;
 80 
 81 /* External */
 82 
 83 dcl  error_table_$r0_refname            ext fixed bin (35);
 84 dcl  error_table_$root                  ext fixed bin (35);
 85 dcl  error_table_$seg_deleted           ext fixed bin (35);
 86 dcl  pds$stacks                         (0:7) ptr ext;
 87 
 88 /* Misc */
 89 
 90 dcl  (baseno, baseptr, bit, dim, fixed, mod, ptr, rel) builtin;
 91 
 92 /* Entries */
 93 
 94 dcl  level$get                          ext entry () returns (fixed bin);
 95 dcl  lock$dir_unlock                    ext entry (ptr);
 96 dcl  makeunknown_                       ext entry (fixed bin (17), bit (36) aligned, bit (1) aligned, fixed bin (35));
 97 dcl  makeunknown_$protect_names         ext entry (fixed bin, fixed bin, bit (36) aligned, bit (1) aligned, fixed bin (35));
 98 dcl  ref_name_$delete                   ext entry (char (32) varying, fixed bin (17), fixed bin (35));
 99 dcl  ref_name_$delete_segno             ext entry (fixed bin (17), fixed bin (35));
100 dcl  ref_name_$get_count                ext entry (fixed bin (17), fixed bin (17), fixed bin (35));
101 dcl  ref_name_$get_segno                ext entry (char (32) varying, fixed bin (17), fixed bin (35));
102 %page;
103 teseg: entry (a_segptr, a_rsw, a_code);
104 
105           segptr = a_segptr;
106           rsw = a_rsw;
107           segno = fixed (baseno (segptr), 17);
108           call dc_find$obj_terminate_ptr (segptr, ep, code);
109           if code = 0 then call lock$dir_unlock (ptr (ep, 0));
110           if code = error_table_$root then code = 0;
111           if code = error_table_$seg_deleted then code = 0;
112           if code = 0 then call term_seg;
113           a_code = code;
114           return;
115 %page;
116 tefile: entry (a_dirname, a_ename, a_rsw, a_code);
117 
118           dirname = a_dirname;
119           ename = a_ename;
120           rsw = a_rsw;
121           call dc_find$obj_terminate (dirname, ename, DC_FIND_CHASE, ep, code);
122           if code = 0 then do;
123                uid = entry.uid;
124                call dc_find$finished (ptr (ep, 0), "1"b);
125                call term_uid;
126           end;
127           a_code = code;
128           return;
129 %page;
130 noname: entry (a_segptr, a_code);
131 
132           segptr = a_segptr;
133           segno = fixed (baseno (segptr), 17);
134           call dc_find$obj_terminate_ptr (segptr, ep, code);
135           if code = 0 then call lock$dir_unlock (ptr (ep, 0));
136           if code = error_table_$root then code = 0;
137           if code = error_table_$seg_deleted then code = 0;
138           if code = 0 then do;
139                call ref_name_$get_count (segno, n_names, code);
140                if code ^= 0 then                                      /* r0_refname */
141                     n_names = 0;                                      /* no refnames */
142                if n_names > 0 then
143                     call terminate_and_zero_lot$$protect (segno, ""b, n_names, code);
144                else call terminate_and_zero_lot (segno, ""b, code);
145           end;
146           a_code = code;
147           return;
148 %page;
149 name: entry (a_name, a_code);
150 
151           refname = a_name;
152           call ref_name_$get_segno (refname, segno, code);
153           if code = 0 then do;
154                segptr = baseptr (segno);
155                call dc_find$obj_terminate_ptr (segptr, ep, code);
156                if code = 0 then call lock$dir_unlock (ptr (ep, 0));
157                if code = error_table_$root then code = 0;
158                if code = error_table_$seg_deleted then code = 0;
159                if code = 0 then do;
160                     call ref_name_$delete (refname, segno, code);
161                     if code = 0 then call terminate_and_zero_lot (segno, "0"b, (0));
162                end;
163           end;
164           a_code = code;
165           return;
166 %page;
167 id:  entry (a_uid, a_rsw, a_code);                          /* called from hardcore */
168 
169           uid = a_uid;
170           rsw = a_rsw;
171           code = 0;
172           call term_uid;
173           a_code = code;
174           return;
175 %page;
176 term_seg: proc;
177 
178           call ref_name_$delete_segno (segno, code);
179           if (code = 0) | (code = error_table_$r0_refname) then
180                call terminate_and_zero_lot (segno, bit (rsw, 1) || "1"b, code);
181           return;
182      end;
183 
184 term_uid: proc;
185 
186           kstp = pds$kstp;
187           hash_bucket = mod (fixed (uid), dim (kst.uid_hash_bucket, 1));
188           do kstep = ptr (kstp, kst.uid_hash_bucket (hash_bucket))
189                repeat (ptr (kstp, kste.fp)) while (rel (kstep) ^= "0"b);
190                if uid = kste.uid then do;
191                     segno = kste.segno;
192                     call term_seg;
193                     return;
194                end;
195           end;
196           return;
197      end;
198 %page;
199 terminate_and_zero_lot: proc (segnum, switches, ecode);
200 
201 dcl  ecode                              fixed bin (35) parameter;
202 dcl  segnum                             fixed bin (17) parameter;
203 dcl  switches                           bit (36) aligned parameter;
204 
205 dcl  n_names                            fixed bin;
206 dcl  ring                               fixed bin;
207 dcl  zero_lot                           bit (1) aligned;
208 
209           call makeunknown_ (segnum, switches, zero_lot, ecode);
210           go to Join;
211 
212 terminate_and_zero_lot$$protect:
213      entry (segnum, switches, n_names, ecode);
214 
215           call makeunknown_$protect_names (segnum, n_names, switches, zero_lot, ecode);
216           if ecode ^= 0 then return;
217 
218 Join:
219           if zero_lot then do;
220                ring = level$get ();
221 
222                if segnum <= pds$stacks (ring) -> stack_header.cur_lot_size then do;
223                                                             /* don't wipe out locations not in lot, isot */
224                     pds$stacks (ring) -> stack_header.lot_ptr -> lot.lp (segnum) = baseptr (0);
225                     pds$stacks (ring) -> stack_header.isot_ptr -> isot.isp (segnum) = baseptr (0);
226                end;
227           end;
228      end;
229 %page; %include dc_find_dcls;
230 %page; %include dir_entry;
231 %page; %include kst;
232 %page; %include lot;
233 %page; %include stack_header;
234      end;