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;