1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1983 *
  6         *                                                         *
  7         *********************************************************** */
  8 slt_manager:
  9      procedure;
 10 
 11 /* SLT manager for Collection 1 Initialization. */
 12 /* Written November 1982 by C. Hornig */
 13 /* Modified January 1983 by K. Loepere to build and use name ht */
 14 
 15 dcl  Header_ptr ptr parameter;
 16 
 17 dcl  name_table$ external;
 18 dcl  slt$ external;
 19 
 20 dcl  hash_index_ entry (ptr, fixed bin (35), fixed bin (35), fixed bin (35))
 21      returns (fixed bin (35));
 22 
 23 dcl  (tsltep, tnamep, tpathp, taclp) ptr;
 24 dcl  segment_no fixed bin (15);
 25 dcl  namex fixed bin;
 26 dcl  hash_value fixed bin;              /* what name hashes to */
 27 dcl  name_num fixed bin;                /* loop index for names */
 28 dcl 1 name_entry aligned like segnam.names based (name_entry_ptr);
 29 dcl  name_entry_ptr ptr;
 30 
 31 dcl  size builtin;
 32 %page;
 33 build_entry:
 34      entry (Header_ptr) returns (ptr);
 35 
 36           names_ptr = addr (name_table$);                   /* establish addressability */
 37           sltp = addr (slt$);
 38 
 39           tsltep = Header_ptr;                              /* header begins with SLTE */
 40           tnamep = addrel (tsltep, size (tsltep -> slte));  /* followed by names */
 41 
 42           if tsltep -> slte.branch_required then do;        /* and (optionally) path and ACL */
 43                tpathp = addrel (tnamep, currentsize (tnamep -> segnam));
 44                taclp = addr (tpathp -> path.acls);
 45                end;
 46 
 47           if tsltep -> slte.init_seg                        /* pick a segment number */
 48           then segment_no, slt.last_init_seg = slt.last_init_seg + 1;
 49           else segment_no, slt.last_sup_seg = slt.last_sup_seg + 1;
 50 
 51           sltep = addr (slt.seg (segment_no));              /* use this from now on */
 52           slte = tsltep -> slte;                            /* copy in the SLTE */
 53           slte_uns.segno = segment_no;                      /* save the segment number */
 54 
 55           namep = allocate_nt (currentsize (tnamep -> segnam));
 56                                                             /* allocate space for a name */
 57           segnam.count = tnamep -> segnam.count;            /* set the count */
 58           segnam = tnamep -> segnam;                        /* copy the rest */
 59           slte.names_ptr = rel (namep);                     /* set up ptr in SLTE */
 60 
 61           if slte.branch_required then do;                  /* more work */
 62                pathp = allocate_nt (currentsize (tpathp -> path) - 1);
 63                                                             /* space for the pathname */
 64                path.size = tpathp -> path.size;
 65                path = tpathp -> path;
 66                slte.path_ptr = rel (pathp);
 67 
 68                if slte.acl_provided then do;
 69                     aclp = allocate_nt (currentsize (taclp -> acls));
 70                                                             /* and for ACL's */
 71                     acls.count = taclp -> acls.count;
 72                     acls = taclp -> acls;
 73                     end;
 74                end;
 75 
 76           do name_num = 1 to segnam.count;                  /* hash in names */
 77                hash_value = hash_index_ (addr (segnam.names (name_num).name),
 78                     length (segnam.names (name_num).name), 0,
 79                     dimension (name_seg.ht, 1));
 80                segnam.names (name_num).hp = name_seg.ht (hash_value);  /* thread in list */
 81                name_seg.ht (hash_value) = rel (addr (segnam.names (name_num)));
 82                segnam.names (name_num).segno = bit (fixed (segment_no, 12), 12);
 83           end;
 84 
 85           return (baseptr (segment_no));
 86 
 87 /* * * * * * * * * ALLOCATE_NT * * * * * * * * */
 88 
 89 allocate_nt:
 90      procedure (Words) returns (ptr);
 91 
 92 dcl  Words fixed bin;
 93 dcl  ntp ptr;
 94 
 95           ntp = ptr (names_ptr, name_seg.next_loc);
 96           name_seg.next_loc = rel (addrel (ntp, Words));
 97           return (ntp);
 98      end allocate_nt;
 99 %page;
100 /* * * * * * * * * * GET_SEG_PTR * * * ** * * * * */
101 
102 get_seg_ptr:
103      entry (Name) returns (ptr);
104 
105 dcl  Name char (32) aligned parameter;
106 
107           sltp = addr (slt$);
108           names_ptr = addr (name_table$);
109 
110           hash_value = hash_index_ (addr (Name), length (Name), 0,
111                dimension (name_seg.ht, 1));
112           do name_entry_ptr = ptr (names_ptr, name_seg.ht (hash_value))
113                repeat (ptr (names_ptr, name_entry.hp))
114                     while (rel (name_entry_ptr)); /* scan down names that hash alike */
115                if name_entry.name = Name then return (baseptr (fixed (name_entry.segno, 12)));  /* until (if) we find actual match */
116           end;
117           return (null ());
118 %page;
119 %include slt;
120 %include slte;
121 
122      end slt_manager;