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 
 14 fs_alloc: proc;                                             /* Procedure to allocate things. */
 15 
 16 /*
 17    NAME:  fs_alloc
 18 
 19    This program is a general purpose file system allocation proceedure.
 20 
 21    ENTRY: fs_alloc$init
 22 
 23    This entry is called once per allocation area to set up the sizes of elements
 24    to be allocated and the size of the area.
 25 
 26    USAGE: call fs_alloc$init (areap, areasize, arrayp, nosize);
 27 
 28    1) areap (pointer)                             pointer to the area to be initialized (Input)
 29    2) areasize (fixed bin (17))                   size of the area to be initialized (Input)
 30    3) arrayp (pointer)                            pointer to  an arry  of sizes of elements which
 31    may be allocated in the area (Input)
 32    4) nosize (fixed bin (17))           number of different sizes to be allocated (Input)
 33 
 34    ENTRY: fs_alloc$alloc
 35 
 36    This entry is called to allocate space in the area.
 37 
 38    USAGE: call fs_alloc$alloc (areap, size, ptr);
 39 
 40    1) areap (pointer)                             pointer to the base of the area where space is
 41    to be allocated (Input)
 42    2) size (fixed bin (17))                       size of space to allocate (Input)
 43    3) ptr (pointer)                     pointer to the allocated space (Output)
 44 
 45    NOTE:  The argument ptr is null if space cannot be allocated.
 46    All allocation is done mod 2 and starts on an even word boundary.
 47 
 48    ENTRY: fs_alloc$free
 49 
 50    This entry is called to free previously allocated space.
 51 
 52    USAGE: call fs_alloc$free (areap, size, ptr);
 53 
 54    The arguments are as for the alloc entry except that here ptr is input.
 55 
 56    */
 57 /* Modified 3/77 by S.E. Barr to clear the size/type word in blocks that are freed. This prevents the salvager
 58    from recovering these blocks later. */
 59 /* Modified 07/77 by THVV for bad_dir_ check */
 60 
 61 
 62 dcl  arrayp ptr,
 63      nbits fixed bin,
 64     (size, nsizes) fixed bin (17);
 65 
 66 % include dir_allocation_area;
 67 
 68 dcl  last_free_rp bit (18) based (arrayp) aligned;
 69 dcl  clear bit (nbits) aligned based;
 70 dcl  ia (100) fixed bin (17) aligned based (arrayp);
 71 dcl  word (2) bit (36) aligned based;                       /* 2nd word of all blocks contains size/type fields */
 72 
 73 
 74 dcl  i fixed bin (17);                                      /* convenient index */
 75 
 76 
 77 dcl (addr, bin, divide, null, ptr, rel) builtin;
 78 dcl bad_dir_ condition;
 79 
 80 
 81 init:     entry (ap, s, arp, ns);                           /* Entry to init. the area. */
 82 
 83 dcl (ap, arp) ptr,
 84     (s, ns) fixed bin (17);
 85 
 86           areap = ap;                                       /* Copy args. */
 87           size = s;
 88           arrayp = arp;
 89           nsizes = ns;
 90 
 91           do i = 1 to nsizes;                               /* Loop over all slots. */
 92                areap -> area.array (i).size = arrayp -> ia (i); /* Set size in area. */
 93                areap -> area.array (i).fptr = "0"b;         /* Clear free pointer. */
 94           end;
 95           areap -> area.nsizes = nsizes;                    /* Set number of diff. sizes to allocate. */
 96           areap -> area.lw = bin (rel (areap), 18) + size -1; /* Set rel. ptr to last good word. */
 97           areap -> area.lu = divide (bin (rel (addr (areap -> area.array (nsizes+1))), 18)+1, 2, 17, 0) * 2;
 98                                                             /* Set rel. ptr to next good even word. */
 99           return;
100 
101 alloc:    entry (ap, s, rp);                                /* Entry to allocate some things. */
102 
103 dcl  rp ptr;
104 
105           size = s;                                         /* Copy args. */
106           areap = ap;
107 
108 allocate:
109           do i = 1 to areap -> area.nsizes;                 /* Loop over all size slots. */
110                if areap -> area.array (i).size = size then do; /* Look for right one. */
111                     if areap -> area.array (i).fptr then do; /* See if one is free. */
112                          rp = ptr (areap, areap -> area.array (i).fptr); /* Set return ptr. */
113                          areap -> area.array (i).fptr = rp -> last_free_rp; /* Rethread free list. */
114                     end;
115                     else do;                                /* Nothing free..get more. */
116                          if areap -> area.lu + size - 1 > areap -> area.lw
117                               then do;                      /* return null ptr if empty */
118                               rp = null;
119                               return;
120                          end;
121                          else do;
122                               rp = ptr (areap, areap -> area.lu); /* Set return ptr to enw space. */
123                               areap -> area.lu = areap -> area.lu + divide (size+1, 2, 17, 0) * 2;
124                                                                       /* Bump last used ptr. */
125                          end;
126                     end;
127 
128                     nbits = size * 36;                      /* Clear newly allocated words. */
129                     rp -> clear = "0"b;                     /* Best way to zero out space - Sept 1974 */
130                     return;
131                end;
132           end;
133           signal bad_dir_;                                  /* Used to crash system here with illegal allocation */
134 
135 free:     entry (ap, s, rp);                                /* Entry to free up space. */
136 
137           areap = ap;                                       /* Copy args. */
138           size = s;
139 
140           do i = 1 to areap -> area.nsizes;                 /* Look for right slot. */
141                if areap -> area.array (i).size = size then do; /* ... */
142                     rp -> last_free_rp = areap -> area.array (i).fptr; /* Thread onto free list. */
143                     areap -> area.array (i).fptr = rel (rp);
144                     rp -> word (2) = "0"b;
145                     return;
146                end;
147           end;
148           signal bad_dir_;                                  /* used to crash system with illegal freeing */
149 
150      end fs_alloc;