COMPILATION LISTING OF SEGMENT file Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 1032.4 mst Sat Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* *********************************************************** */ 8 /* File System Interface Module. */ 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 file: /* For multisegment file, read delimiters. */ 19 procedure; 20 21 /* Modified 13 August 1972, M J Grady. */ 22 /* Modified July 1973 by E. Stone to work for both 64k and 256k MSFs */ 23 /* Modified September 1974 by E. Stone to pass expand_path_ a maximum of 168 char pathname */ 24 /* Modified 750915 by PG and MJG to eliminate incorrect validation of arguments to read */ 25 26 /* internal static */ 27 28 dcl (reading initial ("0"b), 29 writing initial ("1"b)) bit (1) aligned internal static; 30 31 /* declarations */ 32 33 dcl (ioname1, type, ioname3, mode4) character (*); 34 dcl status5 bit (72) aligned; 35 dcl get_system_free_area_ entry returns (ptr); 36 dcl free_area area based (fareap), 37 fareap ptr init (null) int static; 38 dcl pibp6 pointer; 39 dcl (buffer_bit_offset, /* Bit offsets and lengths. */ 40 bits_requested, 41 total_bits, 42 seg_bit_offset, 43 bits_to_move, 44 bits_moved, 45 current_bit) fixed binary (24); 46 dcl (ptrbit2, /* Temporaries for pointer manipulation. */ 47 ptrbit3, 48 offset) fixed binary (35); 49 dcl (buffer, /* Pointer to workspace. */ 50 p, /* Pointer to file control block. */ 51 sp, /* Pointer to status string. */ 52 seg) pointer; /* Pointer to file segment. */ 53 dcl base fixed binary; /* Base of incremental bit search. */ 54 dcl byte bit (9) aligned; /* Temporary for element during short delimiter search. */ 55 dcl mode character (4) aligned; /* Copy of mode string. */ 56 dcl no_delimiter bit (1) aligned; /* Flag to show we found a delimiter. */ 57 dcl pointer_name character (8) aligned; /* Copy of pointer names. */ 58 dcl (i, j) fixed bin (24), /* Index. */ 59 (comp, /* component number for test. */ 60 switch) fixed binary; 61 dcl code fixed binary (35); /* error code for routines. */ 62 dcl temp bit (72) aligned; /* Temporary for delimiter search. */ 63 dcl infinity static fixed binary (35) initial (34359738367); /* 2 .P. 35 - 1 */ 64 dcl bits_per_seg fixed bin (24); 65 dcl (error_table_$badcall, 66 error_table_$boundviol, 67 error_table_$change_first, 68 error_table_$invalid_backspace_read, 69 error_table_$invalid_elsize, 70 error_table_$invalid_read, 71 error_table_$invalid_seek_last_bound, 72 error_table_$invalid_setdelim, 73 error_table_$invalid_write, 74 error_table_$negative_nelem, 75 error_table_$ionmat, /* Ioname already attached. */ 76 error_table_$negative_offset, 77 error_table_$new_offset_negative, 78 error_table_$no_room_for_dsb, /* Can't allocate file control block. */ 79 error_table_$too_many_read_delimiters, 80 error_table_$undefined_order_request, 81 error_table_$undefined_ptrname) external fixed binary (35); 82 dcl string based bit (9437184) aligned; /* Overlay of segment and workspace (buffer). */ 83 dcl chars based character (1048576) aligned; /* Segment overlay for fast delimiter searches. */ 84 dcl char1 character (1) aligned; /* Copy of delimiter table element. */ 85 dcl 1 status based aligned, /* I/O system status string. */ 86 2 code fixed binary (35), /* Overall error code. */ 87 2 successful bit (4) unaligned, /* Logical/physical initiation/termination. */ 88 2 transaction_terminated bit (1) unaligned, /* No further status change. */ 89 2 unassigned bit (4) unaligned, 90 2 end_of_data bit (1) unaligned, /* Obvious. */ 91 2 pad bit (5) unaligned, 92 2 ioname_detached bit (1) unaligned, /* .. */ 93 2 pad2 bit (2) unaligned, 94 2 transaction_index bit (18) unaligned; /* IO system transaction index. */ 95 dcl file_util$attach_file entry (pointer, fixed binary (35)); 96 dcl file_util$detach_file entry (pointer, fixed binary (35)); 97 dcl file_util$find_seg_ptr entry (pointer, bit (1) aligned, fixed binary, pointer, fixed binary (35)); 98 99 dcl (add, addr, addrel, bit, divide, fixed, index, length, min, mod, multiply, null, rel, substr, unspec) builtin; 100 101 dcl 1 fcb static aligned like pib; /* First file control block, allocated at translation time */ 102 103 /* Additional file control blocks, allocated as needed. */ 1 1 /* BEGIN INCLUDE FILE ... file_pib.incl.pl1 ... last modified July 1973 */ 1 2 1 3 dcl 1 pib aligned based, 1 4 2 outer_module_name char (32), /* Our name. */ 1 5 2 device_name_list ptr, /* Pointer to list of attached ioname2's. */ 1 6 2 device_name aligned, /* Bead containing original ioname2 for IOS. */ 1 7 3 next_device ptr, /* Chaining pointer. */ 1 8 3 name_size fixed bin (24), /* Length of string. */ 1 9 3 name_string char (168), /* Original ioname2. */ 1 10 2 dir_name char (168), /* Path name of directory containing file. */ 1 11 2 entry_name char (32), /* Entry name of file. */ 1 12 2 bits_per_segment fixed bin (24), /* Maximum number of bits per segment. */ 1 13 2 (busy, r, w, level, changed) bit (1) unaligned, /* Packed status bits. */ 1 14 2 extra bit (31) unaligned, 1 15 2 elsize fixed bin (24), 1 16 2 readbit fixed bin (35), 1 17 2 writebit fixed bin (35), 1 18 2 lastbit fixed bin (35), 1 19 2 highbit fixed bin (35), 1 20 2 boundbit fixed bin (35), 1 21 2 lastcomp fixed bin, /* component number for current seg */ 1 22 2 lastseg ptr, /* ptr to current seg */ 1 23 2 fcb_ptr ptr, /* fcb ptr for msf_manager_ */ 1 24 2 seg (0: 9) aligned, /* Memory for up to 10 segment numbers. */ 1 25 3 no bit (18) unaligned, /* Segment number. */ 1 26 3 used bit (1) unaligned, /* Flagged when read or written. */ 1 27 3 key bit (17) unaligned, /* Suffix of segment name. */ 1 28 2 search_type fixed bin, /* Type of delimiter search which may be employed. */ 1 29 2 nreads fixed bin, /* Number of read delimiters. */ 1 30 2 readlist bit (720), /* Any number of delimiters. */ 1 31 2 call fixed bin; /* File system call whose error was last reflected. */ 1 32 1 33 /* END INCLUDE FILE ... file_pib.incl.pl1 */ 104 105 106 107 dcl (msegp, mbufp) ptr, 108 (msegoff, mbufoff, mmove) fixed bin (24), 109 mchrarray (0:1) char (1) based, 110 mwords (mmove) fixed bin (35) aligned based, 111 mchars char (1000) based aligned; 112 113 /* */ 114 file_attach: /* entry to attach file. */ 115 entry (ioname1, type, ioname3, mode4, status5, pibp6); 116 sp = addr (status5); /* Set up pointer to status string. */ 117 if pibp6 ^= null then /* Is this name already attached? */ 118 do; /* Yes. */ 119 code = error_table_$ionmat; /* Set error code. */ 120 go to set_detached_bit; /* Give up. */ 121 end; 122 if fareap = null then 123 fareap = get_system_free_area_ (); /* get area to alloc in */ 124 if fcb.busy then /* Is the first block in use? */ 125 do; /* Yes. */ 126 allocate pib in (free_area) set (p); /* Get another. */ 127 if p = null then /* Successful? */ 128 do; /* No. */ 129 code = error_table_$no_room_for_dsb; /* Set error code. */ 130 go to set_detached_bit; /* Give up. */ 131 end; 132 end; 133 else 134 p = addr (fcb); /* Use internal block. */ 135 /* Insert path name of file into control block. */ 136 p -> pib.device_name.name_size = min (length (ioname3), length (p -> pib.device_name.name_string)); 137 p -> pib.device_name.name_string = ioname3; /* .. */ 138 mode = mode4; /* Copy mode string. */ 139 p -> pib.r, p -> pib.w = ""b; /* Clear both permission flags. */ 140 if mode = "r " then /* Read only? */ 141 p -> pib.r = "1"b; /* Yes, set read permission flag. */ 142 if mode = "w " then /* Write only? */ 143 p -> pib.w = "1"b; /* Yes, set write permission flag. */ 144 if p -> pib.r | p -> pib.w then go to mode_out; /* If any set now jump out. */ 145 146 if index (mode4, "read") = 0 147 & index (mode4, "write") = 0 148 then do; 149 p -> pib.r, p -> pib.w = "1"b; 150 go to mode_out; 151 end; 152 153 i = index (mode4, "read"); 154 if i ^= 0 then do; 155 if i > 1 then 156 if substr (mode4, i-1, 1) ^= "^" 157 then p -> pib.r = "1"b; /* set read on */ 158 else; 159 else p -> pib.r = "1"b; 160 end; 161 162 i = index (mode4, "write"); 163 if i ^= 0 then do; 164 if i > 1 then 165 if substr (mode4, i-1, 1) ^= "^" 166 then p -> pib.w = "1"b; /* set write on */ 167 else; 168 else p -> pib.w = "1"b; /* also set write */ 169 end; 170 171 mode_out: 172 call file_util$attach_file (p, code); /* Initialize data block. */ 173 if code ^= 0 then /* Successful? */ 174 go to delete_fcb; /* No, deallocate the control block. */ 175 p -> pib.outer_module_name = type; /* Insert our name. */ 176 p -> pib.device_name_list = addr (p -> pib.device_name); /* Insert pointer for IOS. */ 177 p -> pib.device_name.next_device = null; /* Clear pointer to next list bead. */ 178 p -> pib.busy = "1"b; /* Mark block as in use. */ 179 pibp6 = p; /* Give pointer to block to IOS. */ 180 go to good; /* Attach successfully completed. */ 181 /* */ 182 file_detach: 183 entry (pibp1, ioname2, disposal, status4); 184 dcl pibp1 pointer; 185 dcl (ioname2, disposal) character (*); 186 dcl status4 bit (72) aligned; 187 188 p = pibp1; 189 sp = addr (status4); 190 call file_util$detach_file (p, code); /* Clean up and free data block. */ 191 if code = 0 then /* Successful? */ 192 go to delete_fcb; /* Yes, deallocate control block. */ 193 if disposal ^= "h" then /* No, are we requested to hold the control block? */ 194 do; /* No. */ 195 delete_fcb: p -> pib.busy = ""b; /* Clear the use flag. */ 196 if p ^= addr (fcb) then /* Is it the original block? */ 197 free p -> pib in (free_area); /* No, return it to free storage. */ 198 sp -> status.ioname_detached = "1"b; /* Set detached bit. */ 199 end; 200 if code ^= 0 then /* Which exit should we take? */ 201 go to bad; /* Erroneous operation, report code. */ 202 go to good; 203 /* */ 204 file_order: 205 entry (pibp1, request, argptr, status4); 206 dcl request character (*) aligned; /* The name of the request. */ 207 dcl argptr pointer; /* Pointer to arguments. */ 208 209 sp = addr (status4); /* Get pointer to status string. */ 210 p = pibp1; /* Copy pointer to control block. */ 211 if request = "backspace_read" then /* Examine request name. */ 212 do; /* This is it. */ 213 if ^ p -> pib.r then /* Is file readable? */ 214 do; /* No. */ 215 code = error_table_$invalid_read; /* Set error code. */ 216 go to bad; /* Give error return. */ 217 end; 218 if argptr ^= null then /* No arguments. */ 219 do; /* But some supplied. */ 220 code = error_table_$badcall; /* Set error code. */ 221 go to bad; /* Give error return. */ 222 end; 223 if p -> pib.nreads = 0 then /* Are there any delimiters? */ 224 do; /* No. */ 225 scan (0): scan_none: code = error_table_$invalid_backspace_read; /* No, set error code. */ 226 go to bad; /* Return to caller. */ 227 end; 228 p -> pib.readbit = add (p -> pib.readbit, - 2 * p -> pib.elsize, 35, 0); /* Back up two bytes. */ 229 try_scan: if p -> pib.readbit <= 0 then /* At beginning of file? */ 230 do; /* Yes. */ 231 p -> pib.readbit = 0; /* Make sure nonnegative. */ 232 go to good; /* Give normal return. */ 233 end; 234 bits_per_seg = p -> pib.bits_per_segment; 235 seg_bit_offset = mod (p -> pib.readbit, bits_per_seg); /* Get offset in current segment. */ 236 comp = divide (p -> pib.readbit, bits_per_seg, 17, 0); /* get component number */ 237 if comp ^= p -> pib.lastcomp then do; /* check to see if same as last time. */ 238 call file_util$find_seg_ptr (p, (reading), comp, seg, code); /* Get segment. */ 239 if code ^= 0 then /* Successful? */ 240 go to bad; /* Give error return. */ 241 p -> pib.lastcomp = comp; /* set new component number. */ 242 p -> pib.lastseg = seg; /* save new seg number */ 243 end; 244 else seg = p -> pib.lastseg; /* else set seg to be same as last time. */ 245 do current_bit = seg_bit_offset by - p -> pib.elsize to 0; /* Scan backwards. */ 246 temp = substr (seg -> string, current_bit + 1, p -> pib.elsize); /* Extract one byte. */ 247 go to scan (p -> pib.search_type); /* Dispatch to proper scan. */ 248 249 scan (2): scan_bit_table: if substr (p -> pib.readlist, fixed (substr (temp, 1, 9), 9) + 1, 1) then /* Is this a break? */ 250 go to scan_done; /* Yes, terminate the scan. */ 251 go to scan_loop; /* No, get next. */ 252 253 scan (1): scan_1_char: /* Can't handle special case; treat as packed. */ 254 scan (3): scan_packed: j = 0; /* Reset array index. */ 255 do i = 1 to p -> pib.nreads; /* Compare with each delimiter. */ 256 if temp = substr (p -> pib.readlist, j + 1, p -> pib.elsize) then /* Does this match? */ 257 go to scan_done; /* Yes, stop. */ 258 j = j + p -> pib.elsize; /* Bump array index. */ 259 end; 260 scan_loop: end; 261 /* Adjust read pointer to end of previous segment. */ 262 p -> pib.readbit = add (p -> pib.readbit, - seg_bit_offset - p -> pib.elsize, 35, 0); 263 go to try_scan; /* Go check for file beginning, get next segment. */ 264 265 /* Adjust read pointer to place we found. */ 266 scan_done: p -> pib.readbit = add (p -> pib.readbit, - seg_bit_offset + current_bit + p -> pib.elsize, 35, 0); 267 go to good; /* Give normal return. */ 268 end; 269 if request = "call" then /* Is request for file system call? */ 270 do; /* Yes. */ 271 argptr -> status.code = p -> pib.call; /* Give it to caller. */ 272 go to good; /* Return to caller. */ 273 end; 274 code = error_table_$undefined_order_request; /* Unrecognized request. */ 275 go to bad; /* Give error return. */ 276 /* */ 277 file_getsize: 278 entry (pibp1, elsize, status3); 279 dcl elsize fixed binary (24); 280 dcl status3 bit (72) aligned; 281 282 p = pibp1; 283 sp = addr (status3); 284 elsize = p -> pib.elsize; 285 go to good; 286 287 file_setsize: 288 entry (pibp1, elsize, status3); 289 290 p = pibp1; 291 sp = addr (status3); 292 if elsize < 1 then 293 do; 294 code = error_table_$invalid_elsize; 295 go to bad; 296 end; 297 bits_per_seg = p -> pib.bits_per_segment; 298 if elsize > bits_per_seg then /* Is it too big? */ 299 do; /* Yes. */ 300 code = error_table_$invalid_elsize; /* Set code. */ 301 go to bad; /* Give error return. */ 302 end; 303 p -> pib.elsize = elsize; 304 /* Round pointers to integral element. */ 305 call round (p -> pib.readbit); 306 call round (p -> pib.writebit); 307 call round (p -> pib.lastbit); 308 call round (p -> pib.highbit); 309 call round (p -> pib.boundbit); 310 p -> pib.search_type, p -> pib.nreads = 0; /* Flush any read delimiters. */ 311 go to good; 312 /* */ 313 file_read: 314 entry (pibp1, workspace, offset3, nelem, nelemt, status6); 315 dcl workspace pointer; 316 dcl (offset3, nelem, nelemt) fixed binary (24); 317 dcl status6 bit (72) aligned; 318 319 p = pibp1; 320 sp = addr (status6); 321 nelemt, total_bits = 0; /* Nothing transmitted yet. */ 322 if ^ p -> pib.r then 323 do; /* Improper mode. */ 324 code = error_table_$invalid_read; /* Give error return. */ 325 go to bad; 326 end; 327 buffer = workspace; /* Copy workspace pointer. */ 328 buffer_bit_offset = multiply (offset3, p -> pib.elsize, 24, 0); /* Copy workspace offset. */ 329 if buffer_bit_offset < 0 then /* It must be non-negative. */ 330 do; /* Bad offset. */ 331 code = error_table_$negative_offset; /* Give error return. */ 332 go to bad; 333 end; 334 bits_requested = multiply (nelem, p -> pib.elsize, 24, 0); /* Copy number of elements desired. */ 335 if bits_requested < 0 then /* It, too must be non-negative. */ 336 do; /* Bad buffer size. */ 337 code = error_table_$negative_nelem; /* Give error return. */ 338 go to bad; 339 end; 340 bits_per_seg = p -> pib.bits_per_segment; 341 call round (p -> pib.lastbit); /* Round last pointer to element boundary. */ 342 no_delimiter = "1"b; /* Set flag for retry. */ 343 try_read: seg_bit_offset = mod (p -> pib.readbit, bits_per_seg); /* Get bit offset in current segment. */ 344 bits_to_move = min (add (p -> pib.lastbit, - p -> pib.readbit, 35, 0), bits_requested); /* Get bits to move. */ 345 bits_moved = min (bits_per_seg - seg_bit_offset, bits_to_move); /* Get bits we can move out of cur seg. */ 346 comp = divide (p -> pib.readbit, bits_per_seg, 17, 0); /* get component number */ 347 if comp ^= p -> pib.lastcomp then do; /* check to see if same as last time. */ 348 call file_util$find_seg_ptr (p, (reading), comp, seg, code); /* Get segment. */ 349 if code ^= 0 then go to good; /* Not an error...this is an EOF condition */ 350 p -> pib.lastcomp = comp; /* set new component number. */ 351 p -> pib.lastseg = seg; /* save new seg number */ 352 end; 353 else seg = p -> pib.lastseg; /* else set seg to be same as last time. */ 354 go to read (p -> pib.search_type); /* Dispatch to proper delimiter search. */ 355 356 read (2): /* READ BIT TABLE */ 357 current_bit = 0; /* Reset bit count. */ 358 do while (current_bit < bits_moved); /* Fill buffer if possible. */ 359 /* Move one byte for comparison. */ 360 byte = substr (seg -> string, seg_bit_offset + current_bit + 1, p -> pib.elsize); 361 current_bit = current_bit + p -> pib.elsize; /* Count the element. */ 362 if substr (p -> pib.readlist, fixed (byte, 9) + 1, 1) then /* Is this it? */ 363 go to read_delimiter_found; /* Yes. */ 364 end; 365 go to read_move; /* Go move the entire string. */ 366 367 read (3): /* READ PACKED */ 368 current_bit = 0; /* Reset bit count. */ 369 do while (current_bit < bits_moved); /* Fill buffer if possible. */ 370 /* Move one byte for comparison. */ 371 temp = substr (seg -> string, seg_bit_offset + current_bit + 1, p -> pib.elsize); 372 current_bit = current_bit + p -> pib.elsize; /* Count the element. */ 373 j = 0; /* Reset array index. */ 374 do i = 1 to p -> pib.nreads; /* Search the delimiter list. */ 375 if temp = substr (p -> pib.readlist, j + 1, p -> pib.elsize) then /* Is this it? */ 376 go to read_delimiter_found; /* Yes. */ 377 j = j + p -> pib.elsize; /* Update array index. */ 378 end; 379 end; 380 go to read_move; /* Go move the entire string. */ 381 382 read (1): /* READ 1 CHAR */ 383 i = divide (seg_bit_offset, 9, 17, 0); /* Compute index of first character in file segment. */ 384 j = divide (bits_moved, 9, 17, 0); /* Compute length of rest of segment in characters. */ 385 unspec (char1) = substr (p -> pib.readlist, 1, 9); /* Copy the delimiter. */ 386 current_bit = 9 * index (substr (seg -> chars, i + 1, j), char1); /* Look for the break. */ 387 if current_bit ^= 0 then /* Any found? */ 388 do; /* Yes. */ 389 read_delimiter_found: 390 no_delimiter = ""b; /* Clear flag. */ 391 bits_moved = current_bit; /* Correct size of move. */ 392 end; 393 read (0): /* Case of no read delimiters. */ 394 read_move: 395 if p -> pib.elsize = 36 then do; 396 msegoff = divide (seg_bit_offset, p -> pib.elsize, 24, 0); 397 msegp = addrel (seg, msegoff); 398 mbufoff = divide (buffer_bit_offset, p -> pib.elsize, 24, 0); 399 mbufp = addrel (buffer, mbufoff); 400 mmove = divide (bits_moved, p -> pib.elsize, 24, 0); 401 mbufp -> mwords = msegp -> mwords; 402 end; 403 else if p -> pib.elsize = 9 then do; 404 msegoff = divide (seg_bit_offset, p -> pib.elsize, 24, 0); 405 mbufoff = divide (buffer_bit_offset, p -> pib.elsize, 24, 0); 406 mmove = divide (bits_moved, p -> pib.elsize, 24, 0); 407 substr (buffer -> mchars, mbufoff+1, mmove) = substr (seg -> mchars, msegoff+1, mmove); 408 end; 409 else do; 410 substr (buffer -> string, buffer_bit_offset + 1, bits_moved) = 411 substr (seg -> string, seg_bit_offset + 1, bits_moved); 412 end; 413 total_bits = total_bits + bits_moved; /* Count total bits transmitted. */ 414 nelemt = divide (total_bits, p -> pib.elsize, 24, 0); 415 p -> pib.readbit = add (p -> pib.readbit, bits_moved, 35, 0); 416 if no_delimiter then /* Was the delimiter found? */ 417 if bits_moved < bits_to_move then /* No, is more data in other segment? */ 418 do; /* Yes. */ 419 buffer_bit_offset = buffer_bit_offset + bits_moved; /* Move up in buffer. */ 420 bits_requested = bits_requested - bits_moved; /* Decrease "demand". */ 421 go to try_read; /* Go try again. */ 422 end; 423 go to good; 424 /* */ 425 file_write: 426 entry (pibp1, workspace, offset3, nelem, nelemt, status6); 427 428 p = pibp1; 429 sp = addr (status6); 430 nelemt, total_bits = 0; /* Clear for accumulation of bits transmitted. */ 431 if ^ p -> pib.w then 432 do; /* Improper mode. */ 433 code = error_table_$invalid_write; /* Give error return. */ 434 go to bad; 435 end; 436 buffer = workspace; /* Copy pointer to caller's buffer. */ 437 buffer_bit_offset = multiply (offset3, p -> pib.elsize, 24, 0); 438 if buffer_bit_offset < 0 then /* Check range. */ 439 do; /* Bad. */ 440 code = error_table_$negative_offset; /* Set up code. */ 441 go to bad; /* Give error return. */ 442 end; 443 bits_requested = multiply (nelem, p -> pib.elsize, 24, 0); 444 if bits_requested < 0 then /* Check range. */ 445 do; /* Bad. */ 446 code = error_table_$negative_nelem; /* Set up code. */ 447 go to bad; /* Give error return. */ 448 end; 449 bits_per_seg = p -> pib.bits_per_segment; 450 /* Might we get bounds fault accessing buffer? */ 451 if fixed (rel (buffer), 18) * 36 + buffer_bit_offset + bits_requested > bits_per_seg then 452 do; /* Yes. */ 453 code = error_table_$boundviol; /* Off end of buffer. */ 454 go to bad; /* Give error return. */ 455 end; 456 call round (p -> pib.writebit); /* Round write pointer to element boundary. */ 457 try_write: 458 seg_bit_offset = mod (p -> pib.writebit, bits_per_seg); /* Get offset in current segment. */ 459 bits_to_move = min (add (p -> pib.boundbit, - p -> pib.writebit, 35, 0), bits_requested); 460 bits_moved = min (bits_per_seg - seg_bit_offset, bits_to_move); /* Get bits we can move. */ 461 comp = divide (p -> pib.writebit, bits_per_seg, 17, 0); /* get component number */ 462 if comp ^= p -> pib.lastcomp then do; /* check to see if same as last time. */ 463 call file_util$find_seg_ptr (p, (writing), comp, seg, code); /* Get segment. */ 464 if code ^= 0 then /* Successful? */ 465 go to bad; /* Give error return. */ 466 p -> pib.lastcomp = comp; /* set new component number. */ 467 p -> pib.lastseg = seg; /* save new seg number */ 468 end; 469 else seg = p -> pib.lastseg; /* else set seg to be same as last time. */ 470 if p -> pib.elsize = 36 then do; 471 msegoff = divide (seg_bit_offset, p -> pib.elsize, 24, 0); 472 msegp = addrel (seg, msegoff); 473 mbufoff = divide (buffer_bit_offset, p -> pib.elsize, 24, 0); 474 mbufp = addrel (buffer, mbufoff); 475 mmove = divide (bits_moved, p -> pib.elsize, 24, 0); 476 msegp -> mwords = mbufp -> mwords; 477 end; 478 else if p -> pib.elsize = 9 then do; 479 msegoff = divide (seg_bit_offset, p -> pib.elsize, 24, 0); 480 mbufoff = divide (buffer_bit_offset, p -> pib.elsize, 24, 0); 481 mmove = divide (bits_moved, p -> pib.elsize, 24, 0); 482 substr (seg -> mchars, msegoff+1, mmove) = substr (buffer -> mchars, mbufoff+1, mmove); 483 end; 484 else do; 485 substr (seg -> string, seg_bit_offset + 1, bits_moved) = 486 substr (buffer -> string, buffer_bit_offset + 1, bits_moved); 487 end; 488 total_bits = total_bits + bits_moved; /* Count this batch. */ 489 nelemt = divide (total_bits, p -> pib.elsize, 24, 0); 490 p -> pib.writebit = add (p -> pib.writebit, bits_moved, 35, 0); 491 if p -> pib.writebit > p -> pib.lastbit then /* Was file size increased? */ 492 do; /* Yes. */ 493 p -> pib.lastbit = p -> pib.writebit; /* Increase pointer to indicate it. */ 494 p -> pib.highbit = p -> pib.lastbit; /* set high water mark */ 495 p -> pib.changed = "1"b; /* Mark it for setting bit count. */ 496 end; 497 if bits_moved < bits_to_move then /* Is more data in other segment? */ 498 do; /* Yes. */ 499 buffer_bit_offset = buffer_bit_offset + bits_moved; /* Move up in buffer. */ 500 bits_requested = bits_requested - bits_moved; /* Decrease "demand". */ 501 go to try_write; /* Go try again. */ 502 end; 503 go to good; 504 /* */ 505 file_setdelim: 506 entry (pibp1, nbreaks, breaklist, nreads, readlist, status6); 507 dcl nbreaks, nreads; /* Numbers of elements. */ 508 dcl (breaklist, readlist) bit (*) aligned; 509 510 sp = addr (status6); /* Get pointer to status string. */ 511 p = pibp1; /* Copy pointer to control data. */ 512 if p -> pib.elsize > length (temp) then /* Will delimiter search work? */ 513 do; /* No. */ 514 code = error_table_$invalid_setdelim; /* Refuse call. */ 515 go to bad; 516 end; 517 bits_per_seg = p -> pib.bits_per_segment; 518 if mod (bits_per_seg, p -> pib.elsize) ^= 0 then /* Will elements span segment boundaries? */ 519 do; /* Yes, delimiter search will not always work. */ 520 code = error_table_$invalid_setdelim; /* Give error code. */ 521 go to bad; /* Refuse call. */ 522 end; 523 if nreads < 0 then /* Check validity. */ 524 do; /* Bad. */ 525 code = error_table_$badcall; /* Refuse call. */ 526 go to bad; 527 end; 528 if p -> pib.elsize > 9 then /* Will we have to store the bytes? */ 529 do; /* Yes. */ 530 total_bits = nreads * p -> pib.elsize; /* Compute number of bits required. */ 531 if total_bits > length (p -> pib.readlist) then /* Make sure not too many. */ 532 do; /* Bad. */ 533 code = error_table_$too_many_read_delimiters; /* Refuse call. */ 534 go to bad; 535 end; 536 end; 537 p -> pib.nreads = nreads; /* Save the total number of delimiters. */ 538 if p -> pib.nreads = 1 then /* Is there only one? */ 539 if p -> pib.elsize = 9 then /* Is it a character? */ 540 do; /* Yes, special case. */ 541 p -> pib.search_type = 1; /* Set dispatch code. */ 542 substr (p -> pib.readlist, 1, 9) = substr (readlist, 1, 9); /* Copy the character. */ 543 go to good; /* Return to caller. */ 544 end; 545 if p -> pib.nreads = 0 then /* Are there no delimiters specified? */ 546 do; /* Yes. */ 547 p -> pib.search_type = 0; /* Set up dispatch code. */ 548 end; 549 else 550 if p -> pib.elsize > 9 then /* Must we use packed array? */ 551 do; /* Yes. */ 552 p -> pib.search_type = 3; /* Remember dispatch code. */ 553 substr (p -> pib.readlist, 1, total_bits) = substr (readlist, 1, total_bits); /* Copy the string. */ 554 end; 555 else /* Element size less than 9 bits. */ 556 do; /* We may use bit table. */ 557 p -> pib.search_type = 2; /* Set dispatch code. */ 558 p -> pib.readlist = ""b; /* Clear the table. */ 559 j = 0; /* Set up index of first delimiter. */ 560 do i = 1 to p -> pib.nreads; /* Start copy loop. */ 561 byte = substr (readlist, j + 1, p -> pib.elsize); /* Extract the byte. */ 562 substr (p -> pib.readlist, fixed (byte, 9) + 1, 1) = "1"b; /* Mark the table entry. */ 563 j = j + p -> pib.elsize; /* Move index to next delimiter. */ 564 end; 565 end; 566 go to good; /* Give happy return. */ 567 /* */ 568 file_getdelim: 569 entry (pibp1, nbreaks, breaklist, nreads, readlist, status6); 570 571 sp = addr (status6); /* Get pointer to status string. */ 572 p = pibp1; /* Copy pointer to control data. */ 573 nbreaks = 0; /* We have no break characters. */ 574 go to get (p -> pib.search_type); /* Dispatch on delimiter code. */ 575 576 get (0): get_none: /* Case of no delimiters. */ 577 nreads = 0; /* Set caller's count. */ 578 go to good; /* Return to caller. */ 579 580 get (1): get_1_char: /* Special case. */ 581 nreads = 1; /* Give caller number of delimiters. */ 582 substr (readlist, 1, 9) = substr (p -> pib.readlist, 1, 9); /* Give caller the character. */ 583 go to good; /* Return to caller. */ 584 585 get (2): get_bit_table: /* Case of 256-entry bit table. */ 586 base, j = 0; /* Reset bit and byte indices. */ 587 do nreads = 0 by 1; /* Count bytes returned. */ 588 i = index (substr (p -> pib.readlist, base + 1), "1"b); /* Find next marked entry. */ 589 if i = 0 then /* No more? */ 590 go to good; /* Return to caller. */ 591 substr (readlist, j + 1, p -> pib.elsize) = bit (base + i - 1, 9); /* Form matching code. */ 592 j = j + p -> pib.elsize; /* Update output array index. */ 593 base = base + i; /* Update search base. */ 594 end; 595 go to good; /* Return to caller. */ 596 597 get (3): get_packed: /* Case of packed array of bytes. */ 598 nreads = p -> pib.nreads; /* Give caller the number of read delimiters. */ 599 total_bits = p -> pib.nreads * p -> pib.elsize; /* Compute number of bits required. */ 600 substr (readlist, 1, total_bits) = substr (p -> pib.readlist, 1, total_bits); /* Give them to caller. */ 601 go to good; /* Give happy return. */ 602 /* */ 603 file_seek: 604 entry (pibp1, ptrname2, ptrname3, offset4, status5); 605 dcl (ptrname2, ptrname3) character (*); 606 dcl offset4 fixed binary (35); 607 608 p = pibp1; 609 sp = addr (status5); 610 pointer_name = ptrname3; /* Copy name of reference pointer. */ 611 call pointerdecode (pointer_name, ptrbit3, switch); 612 if switch = 0 then /* Was name recognizable? */ 613 do; 614 code = error_table_$undefined_ptrname; /* Unrecognizable ptrname3. */ 615 go to bad; 616 end; 617 offset = add (ptrbit3, multiply (offset4, p -> pib.elsize, 35, 0), 35, 0); /* Compute new pointer value. */ 618 if offset < 0 then 619 do; 620 code = error_table_$new_offset_negative; /* Resultant offset improper. */ 621 go to bad; 622 end; 623 pointer_name = ptrname2; /* Copy name of pointer to be set. */ 624 call pointerdecode (pointer_name, ptrbit2, switch); 625 go to seek (switch); /* Dispatch on pointer name. */ 626 627 seek (0): seek_0: 628 code = error_table_$undefined_ptrname; /* Improper ptrname2. */ 629 go to bad; 630 631 seek (1): seek_first: 632 code = error_table_$change_first; /* Attempt to change value of first pointer. */ 633 go to bad; /* Give error return. */ 634 635 seek (2): seek_read: 636 if ^ p -> pib.r then /* Do we have read permission? */ 637 do; /* No. */ 638 code = error_table_$invalid_read; /* Set Error code. */ 639 go to bad; /* Give error return. */ 640 end; 641 p -> pib.readbit = min (offset, p -> pib.lastbit); 642 go to good; 643 644 seek (3): seek_write: 645 if ^ p -> pib.w then /* Do we have write permission? */ 646 do; /* No. */ 647 code = error_table_$invalid_write; /* Set error code. */ 648 go to bad; /* Give error return. */ 649 end; 650 p -> pib.writebit = min (offset, p -> pib.lastbit); 651 go to good; 652 653 seek (4): seek_last: 654 if ^ p -> pib.w then /* May we write on this file? */ 655 do; /* No. */ 656 if offset > p -> pib.highbit then do; 657 code = error_table_$invalid_seek_last_bound; /* Give error return. */ 658 go to bad; 659 end; 660 p -> pib.lastbit = offset; 661 go to good; 662 end; 663 p -> pib.lastbit = min (offset, p -> pib.boundbit); 664 p -> pib.highbit = p -> pib.lastbit; 665 go to truncate; 666 667 seek (5): seek_bound: 668 if ^ p -> pib.w then /* Do we have write permission? */ 669 do; /* No. */ 670 code = error_table_$invalid_seek_last_bound; /* Give error return. */ 671 go to bad; 672 end; 673 p -> pib.boundbit = offset; 674 if p -> pib.lastbit > offset then /* Does change to bound necessitate change to last? */ 675 do; /* Yes. */ 676 p -> pib.lastbit = offset; /* Perform necessary truncation. */ 677 truncate: p -> pib.changed = "1"b; /* Mark for later setting bit count. */ 678 end; 679 /* Truncate read, write pointers if necessary. */ 680 p -> pib.readbit = min (p -> pib.readbit, p -> pib.lastbit); 681 p -> pib.writebit = min (p -> pib.writebit, p -> pib.lastbit); 682 go to good; 683 /* */ 684 file_tell: 685 entry (pibp1, ptrname2, ptrname3, offset4, status5); 686 687 p = pibp1; 688 sp = addr (status5); 689 pointer_name = ptrname3; /* Copy name of reference pointer. */ 690 call pointerdecode (pointer_name, ptrbit3, switch); 691 if switch = 0 then /* Was name recognizable? */ 692 do; 693 code = error_table_$undefined_ptrname; /* Unrecognizable ptrname3. */ 694 go to bad; /* Give error return. */ 695 end; 696 pointer_name = ptrname2; /* Copy name of pointer whose value is wanted. */ 697 call pointerdecode (pointer_name, ptrbit2, switch); 698 if switch = 0 then /* Was name recognizable? */ 699 do; 700 code = error_table_$undefined_ptrname; /* Unrecognizable ptrname2. */ 701 go to bad; /* Give error return. */ 702 end; 703 offset4 = divide (add (ptrbit2, - ptrbit3, 35, 0), p -> pib.elsize, 35, 0); 704 go to good; 705 /* */ 706 set_detached_bit: 707 sp -> status.ioname_detached = "1"b; /* Indicate detachment. */ 708 bad: sp -> status.code = code; 709 go to done; 710 711 good: sp -> status.successful = "1111"b; /* Indicate initiation/termination. */ 712 sp -> status.code = 0; /* set return code to zero */ 713 done: sp -> status.transaction_terminated = "1"b; /* Indicate we are done. */ 714 if sp -> status.ioname_detached then /* Was this a detach call? */ 715 return; 716 if p -> pib.readbit >= p -> pib.lastbit then 717 sp -> status.end_of_data = "1"b; /* Set EOF indicator. */ 718 return; /* Return to caller. */ 719 /* */ 720 pointerdecode: /* Procedure to decode pointer name. */ 721 procedure (pointername, pointerbit, switch); /* Returns pointer value and dispatch index. */ 722 dcl pointername character (8) aligned; /* Symbolic pointer name. */ 723 dcl pointerbit fixed binary (35); /* Returned value of the pointer. */ 724 dcl switch fixed binary; /* Label index. */ 725 726 if pointername = "first " then 727 do; 728 pointerbit = 0; 729 switch = 1; 730 end; 731 else 732 if pointername = "read " then 733 do; 734 pointerbit = p -> pib.readbit; 735 switch = 2; 736 end; 737 else 738 if pointername = "write " then 739 do; 740 call round (p -> pib.writebit); /* Round write pointer to integral element. */ 741 pointerbit = p -> pib.writebit; 742 switch = 3; 743 end; 744 else 745 if pointername = "last " then 746 do; 747 call round (p -> pib.lastbit); /* Round last pointer to integral elements. */ 748 pointerbit = p -> pib.lastbit; 749 switch = 4; 750 end; 751 else 752 if pointername = "bound " then 753 do; 754 pointerbit = p -> pib.boundbit; 755 switch = 5; 756 end; 757 else 758 pointerbit, switch = 0; 759 end pointerdecode; /* Return to caller. */ 760 /* */ 761 round: procedure (offset); /* Procedure to round subject to upper limit. */ 762 dcl offset fixed binary (35); /* Bit offset in file. */ 763 dcl (overage, underage) fixed binary (24); /* Element size and errors. */ 764 765 overage = mod (offset, p -> pib.elsize); /* Calculate amount of offset over integral elements. */ 766 if overage ^= 0 then /* If zero, we are OK. */ 767 do; 768 underage = p -> pib.elsize - overage; /* Get amount of increase necessary. */ 769 if add (infinity, - offset, 35, 0) >= underage then /* Is there room for increase? */ 770 offset = add (offset, underage, 35, 0); /* Yes, round up. */ 771 else 772 offset = add (offset, - overage, 35, 0); /* No, truncate down. */ 773 end; 774 end round; 775 end file; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0800.0 file.pl1 >spec>install>1110>file.pl1 104 1 05/06/74 1741.2 file_pib.incl.pl1 >ldd>include>file_pib.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. add builtin function dcl 99 ref 228 262 266 344 415 459 490 617 703 769 769 771 addr builtin function dcl 99 ref 116 133 176 189 196 209 283 291 320 429 510 571 609 688 addrel builtin function dcl 99 ref 397 399 472 474 argptr parameter pointer dcl 207 ref 204 218 271 base 000122 automatic fixed bin(17,0) dcl 53 set ref 585* 588 591 593* 593 bit builtin function dcl 99 ref 591 bits_moved 000105 automatic fixed bin(24,0) dcl 39 set ref 345* 358 369 384 391* 400 406 410 410 413 415 416 419 420 460* 475 481 485 485 488 490 497 499 500 bits_per_seg 000140 automatic fixed bin(24,0) dcl 64 set ref 234* 235 236 297* 298 340* 343 345 346 449* 451 457 460 461 517* 518 bits_per_segment 151 based fixed bin(24,0) level 2 dcl 1-3 ref 234 297 340 449 517 bits_requested 000101 automatic fixed bin(24,0) dcl 39 set ref 334* 335 344 420* 420 443* 444 451 459 500* 500 bits_to_move 000104 automatic fixed bin(24,0) dcl 39 set ref 344* 345 416 459* 460 497 boundbit 160 based fixed bin(35,0) level 2 dcl 1-3 set ref 309* 459 663 673* 754 breaklist parameter bit dcl 508 ref 505 568 buffer 000112 automatic pointer dcl 49 set ref 327* 399 407 410 436* 451 474 482 485 buffer_bit_offset 000100 automatic fixed bin(24,0) dcl 39 set ref 328* 329 398 405 410 419* 419 437* 438 451 473 480 485 499* 499 busy 152 000012 internal static bit(1) level 2 in structure "fcb" packed packed unaligned dcl 101 in procedure "file" set ref 124 busy 152 based bit(1) level 2 in structure "pib" packed packed unaligned dcl 1-3 in procedure "file" set ref 178* 195* byte 000123 automatic bit(9) dcl 54 set ref 360* 362 561* 562 call 226 based fixed bin(17,0) level 2 dcl 1-3 ref 271 changed 152(04) based bit(1) level 2 packed packed unaligned dcl 1-3 set ref 495* 677* char1 000141 automatic char(1) dcl 84 set ref 385* 386 chars based char(1048576) dcl 83 ref 386 code 000134 automatic fixed bin(35,0) dcl 61 in procedure "file" set ref 119* 129* 171* 173 190* 191 200 215* 220* 225* 238* 239 274* 294* 300* 324* 331* 337* 348* 349 433* 440* 446* 453* 463* 464 514* 520* 525* 533* 614* 620* 627* 631* 638* 647* 657* 670* 693* 700* 708 code based fixed bin(35,0) level 2 in structure "status" dcl 85 in procedure "file" set ref 271* 708* 712* comp 000132 automatic fixed bin(17,0) dcl 58 set ref 236* 237 238* 241 346* 347 348* 350 461* 462 463* 466 current_bit 000106 automatic fixed bin(24,0) dcl 39 set ref 245* 246* 266 356* 358 360 361* 361 367* 369 371 372* 372 386* 387 391 device_name 12 based structure level 2 dcl 1-3 set ref 176 device_name_list 10 based pointer level 2 dcl 1-3 set ref 176* disposal parameter char packed unaligned dcl 185 ref 182 193 divide builtin function dcl 99 ref 236 346 382 384 396 398 400 404 405 406 414 461 471 473 475 479 480 481 489 703 elsize 153 based fixed bin(24,0) level 2 in structure "pib" dcl 1-3 in procedure "file" set ref 228 245 246 256 258 262 266 284 303* 328 334 360 361 371 372 375 377 393 396 398 400 403 404 405 406 414 437 443 470 471 473 475 478 479 480 481 489 512 518 528 530 538 549 561 563 591 592 599 617 703 765 768 elsize parameter fixed bin(24,0) dcl 279 in procedure "file" set ref 277 284* 287 292 298 303 end_of_data 1(09) based bit(1) level 2 packed packed unaligned dcl 85 set ref 716* error_table_$badcall 000244 external static fixed bin(35,0) dcl 65 ref 220 525 error_table_$boundviol 000246 external static fixed bin(35,0) dcl 65 ref 453 error_table_$change_first 000250 external static fixed bin(35,0) dcl 65 ref 631 error_table_$invalid_backspace_read 000252 external static fixed bin(35,0) dcl 65 ref 225 error_table_$invalid_elsize 000254 external static fixed bin(35,0) dcl 65 ref 294 300 error_table_$invalid_read 000256 external static fixed bin(35,0) dcl 65 ref 215 324 638 error_table_$invalid_seek_last_bound 000260 external static fixed bin(35,0) dcl 65 ref 657 670 error_table_$invalid_setdelim 000262 external static fixed bin(35,0) dcl 65 ref 514 520 error_table_$invalid_write 000264 external static fixed bin(35,0) dcl 65 ref 433 647 error_table_$ionmat 000270 external static fixed bin(35,0) dcl 65 ref 119 error_table_$negative_nelem 000266 external static fixed bin(35,0) dcl 65 ref 337 446 error_table_$negative_offset 000272 external static fixed bin(35,0) dcl 65 ref 331 440 error_table_$new_offset_negative 000274 external static fixed bin(35,0) dcl 65 ref 620 error_table_$no_room_for_dsb 000276 external static fixed bin(35,0) dcl 65 ref 129 error_table_$too_many_read_delimiters 000300 external static fixed bin(35,0) dcl 65 ref 533 error_table_$undefined_order_request 000302 external static fixed bin(35,0) dcl 65 ref 274 error_table_$undefined_ptrname 000304 external static fixed bin(35,0) dcl 65 ref 614 627 693 700 fareap 000010 internal static pointer initial dcl 36 set ref 122 122* 126 196 fcb 000012 internal static structure level 1 dcl 101 set ref 133 196 file_util$attach_file 000306 constant entry external dcl 95 ref 171 file_util$detach_file 000310 constant entry external dcl 96 ref 190 file_util$find_seg_ptr 000312 constant entry external dcl 97 ref 238 348 463 fixed builtin function dcl 99 ref 249 362 451 562 free_area based area(1024) dcl 36 ref 126 196 get_system_free_area_ 000242 constant entry external dcl 35 ref 122 highbit 157 based fixed bin(35,0) level 2 dcl 1-3 set ref 308* 494* 656 664* i 000130 automatic fixed bin(24,0) dcl 58 set ref 153* 154 155 155 162* 163 164 164 255* 374* 382* 386 560* 588* 589 591 593 index builtin function dcl 99 ref 146 146 153 162 386 588 infinity 000022 constant fixed bin(35,0) initial dcl 63 ref 769 ioname1 parameter char packed unaligned dcl 33 ref 114 ioname2 parameter char packed unaligned dcl 185 ref 182 ioname3 parameter char packed unaligned dcl 33 ref 114 136 137 ioname_detached 1(15) based bit(1) level 2 packed packed unaligned dcl 85 set ref 198* 706* 714 j 000131 automatic fixed bin(24,0) dcl 58 set ref 253* 256 258* 258 373* 375 377* 377 384* 386 559* 561 563* 563 585* 591 592* 592 lastbit 156 based fixed bin(35,0) level 2 dcl 1-3 set ref 307* 341* 344 491 493* 494 641 650 660* 663* 664 674 676* 680 681 716 747* 748 lastcomp 161 based fixed bin(17,0) level 2 dcl 1-3 set ref 237 241* 347 350* 462 466* lastseg 162 based pointer level 2 dcl 1-3 set ref 242* 244 351* 353 467* 469 length builtin function dcl 99 ref 136 136 512 531 mbufoff 000147 automatic fixed bin(24,0) dcl 107 set ref 398* 399 405* 407 473* 474 480* 482 mbufp 000144 automatic pointer dcl 107 set ref 399* 401 474* 476 mchars based char(1000) dcl 107 set ref 407* 407 482* 482 min builtin function dcl 99 ref 136 344 345 459 460 641 650 663 680 681 mmove 000150 automatic fixed bin(24,0) dcl 107 set ref 400* 401 406* 407 407 475* 476 481* 482 482 mod builtin function dcl 99 ref 235 343 457 518 765 mode 000124 automatic char(4) dcl 55 set ref 138* 140 142 mode4 parameter char packed unaligned dcl 33 ref 114 138 146 146 153 155 162 164 msegoff 000146 automatic fixed bin(24,0) dcl 107 set ref 396* 397 404* 407 471* 472 479* 482 msegp 000142 automatic pointer dcl 107 set ref 397* 401 472* 476 multiply builtin function dcl 99 ref 328 334 437 443 617 mwords based fixed bin(35,0) array dcl 107 set ref 401* 401 476* 476 name_size 14 based fixed bin(24,0) level 3 dcl 1-3 set ref 136* name_string 15 based char(168) level 3 dcl 1-3 set ref 136 137* nbreaks parameter fixed bin(17,0) dcl 507 set ref 505 568 573* nelem parameter fixed bin(24,0) dcl 316 ref 313 334 425 443 nelemt parameter fixed bin(24,0) dcl 316 set ref 313 321* 414* 425 430* 489* next_device 12 based pointer level 3 dcl 1-3 set ref 177* no_delimiter 000125 automatic bit(1) dcl 56 set ref 342* 389* 416 nreads parameter fixed bin(17,0) dcl 507 in procedure "file" set ref 505 523 530 537 568 576* 580* 587* 597* nreads 201 based fixed bin(17,0) level 2 in structure "pib" dcl 1-3 in procedure "file" set ref 223 255 310* 374 537* 538 545 560 597 599 null builtin function dcl 99 ref 117 122 127 177 218 offset 000111 automatic fixed bin(35,0) dcl 46 in procedure "file" set ref 617* 618 641 650 656 660 663 673 674 676 offset parameter fixed bin(35,0) dcl 762 in procedure "round" set ref 761 765 769 769* 769 771* 771 offset3 parameter fixed bin(24,0) dcl 316 ref 313 328 425 437 offset4 parameter fixed bin(35,0) dcl 606 set ref 603 617 684 703* outer_module_name based char(32) level 2 dcl 1-3 set ref 175* overage 000172 automatic fixed bin(24,0) dcl 763 set ref 765* 766 768 771 p 000114 automatic pointer dcl 49 set ref 126* 127 133* 136 136 137 139 139 140 142 144 144 149 149 155 159 164 168 171* 175 176 176 177 178 179 188* 190* 195 196 196 210* 213 223 228 228 228 229 231 234 235 236 237 238* 241 242 244 245 246 247 249 255 256 256 258 262 262 262 266 266 266 271 282* 284 290* 297 303 305 306 307 308 309 310 310 319* 322 328 334 340 341 343 344 344 346 347 348* 350 351 353 354 360 361 362 371 372 374 375 375 377 385 393 396 398 400 403 404 405 406 414 415 415 428* 431 437 443 449 456 457 459 459 461 462 463* 466 467 469 470 471 473 475 478 479 480 481 489 490 490 491 491 493 493 494 494 495 511* 512 517 518 528 530 531 537 538 538 541 542 545 547 549 552 553 557 558 560 561 562 563 572* 574 582 588 591 592 597 599 599 600 608* 617 635 641 641 644 650 650 653 656 660 663 663 664 664 667 673 674 676 677 680 680 680 681 681 681 687* 703 716 716 734 740 741 747 748 754 765 768 pib based structure level 1 dcl 1-3 set ref 126 196 pibp1 parameter pointer dcl 184 ref 182 188 204 210 277 282 287 290 313 319 425 428 505 511 568 572 603 608 684 687 pibp6 parameter pointer dcl 38 set ref 114 117 179* pointer_name 000126 automatic char(8) dcl 57 set ref 610* 611* 623* 624* 689* 690* 696* 697* pointerbit parameter fixed bin(35,0) dcl 723 set ref 720 728* 734* 741* 748* 754* 757* pointername parameter char(8) dcl 722 ref 720 726 731 737 744 751 ptrbit2 000107 automatic fixed bin(35,0) dcl 46 set ref 624* 697* 703 ptrbit3 000110 automatic fixed bin(35,0) dcl 46 set ref 611* 617 690* 703 ptrname2 parameter char packed unaligned dcl 605 ref 603 623 684 696 ptrname3 parameter char packed unaligned dcl 605 ref 603 610 684 689 r 152(01) based bit(1) level 2 packed packed unaligned dcl 1-3 set ref 139* 140* 144 149* 155* 159* 213 322 635 readbit 154 based fixed bin(35,0) level 2 dcl 1-3 set ref 228* 228 229 231* 235 236 262* 262 266* 266 305* 343 344 346 415* 415 641* 680* 680 716 734 reading constant bit(1) initial dcl 28 ref 238 348 readlist parameter bit dcl 508 in procedure "file" set ref 505 542 553 561 568 582* 591* 600* readlist 202 based bit(720) level 2 in structure "pib" dcl 1-3 in procedure "file" set ref 249 256 362 375 385 531 542* 553* 558* 562* 582 588 600 rel builtin function dcl 99 ref 451 request parameter char dcl 206 ref 204 211 269 search_type 200 based fixed bin(17,0) level 2 dcl 1-3 set ref 247 310* 354 541* 547* 552* 557* 574 seg 000120 automatic pointer dcl 49 set ref 238* 242 244* 246 348* 351 353* 360 371 386 397 407 410 463* 467 469* 472 482 485 seg_bit_offset 000103 automatic fixed bin(24,0) dcl 39 set ref 235* 245 262 266 343* 345 360 371 382 396 404 410 457* 460 471 479 485 sp 000116 automatic pointer dcl 49 set ref 116* 189* 198 209* 283* 291* 320* 429* 510* 571* 609* 688* 706 708 711 712 713 714 716 status based structure level 1 dcl 85 status3 parameter bit(72) dcl 280 set ref 277 283 287 291 status4 parameter bit(72) dcl 186 set ref 182 189 204 209 status5 parameter bit(72) dcl 34 set ref 114 116 603 609 684 688 status6 parameter bit(72) dcl 317 set ref 313 320 425 429 505 510 568 571 string based bit(9437184) dcl 82 set ref 246 360 371 410* 410 485* 485 substr builtin function dcl 99 set ref 155 164 246 249 249 256 360 362 371 375 385 386 407* 407 410* 410 482* 482 485* 485 542* 542 553* 553 561 562* 582* 582 588 591* 600* 600 successful 1 based bit(4) level 2 packed packed unaligned dcl 85 set ref 711* switch parameter fixed bin(17,0) dcl 724 in procedure "pointerdecode" set ref 720 729* 735* 742* 749* 755* 757* switch 000133 automatic fixed bin(17,0) dcl 58 in procedure "file" set ref 611* 612 624* 625 690* 691 697* 698 temp 000136 automatic bit(72) dcl 62 set ref 246* 249 256 371* 375 512 total_bits 000102 automatic fixed bin(24,0) dcl 39 set ref 321* 413* 413 414 430* 488* 488 489 530* 531 553 553 599* 600 600 transaction_terminated 1(04) based bit(1) level 2 packed packed unaligned dcl 85 set ref 713* type parameter char packed unaligned dcl 33 ref 114 175 underage 000173 automatic fixed bin(24,0) dcl 763 set ref 768* 769 769 unspec builtin function dcl 99 set ref 385* w 152(02) based bit(1) level 2 packed packed unaligned dcl 1-3 set ref 139* 142* 144 149* 164* 168* 431 644 653 667 workspace parameter pointer dcl 315 ref 313 327 425 436 writebit 155 based fixed bin(35,0) level 2 dcl 1-3 set ref 306* 456* 457 459 461 490* 490 491 493 650* 681* 681 740* 741 writing constant bit(1) initial dcl 28 ref 463 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. mchrarray based char(1) array packed unaligned dcl 107 NAMES DECLARED BY EXPLICIT CONTEXT. bad 002575 constant label dcl 708 ref 200 216 221 226 239 275 295 301 325 332 338 434 441 447 454 464 515 521 526 534 615 621 629 633 639 648 658 671 694 701 delete_fcb 000434 constant label dcl 195 ref 173 191 done 002603 constant label dcl 713 ref 709 file 000063 constant entry external dcl 18 file_attach 000077 constant entry external dcl 114 file_detach 000364 constant entry external dcl 182 file_getdelim 002144 constant entry external dcl 568 file_getsize 000733 constant entry external dcl 277 file_order 000463 constant entry external dcl 204 file_read 001063 constant entry external dcl 313 file_seek 002267 constant entry external dcl 603 file_setdelim 001760 constant entry external dcl 505 file_setsize 000753 constant entry external dcl 287 file_tell 002502 constant entry external dcl 684 file_write 001463 constant entry external dcl 425 get 000010 constant label array(0:3) dcl 576 ref 574 get_1_char 002177 constant label dcl 580 get_bit_table 002205 constant label dcl 585 get_none 002175 constant label dcl 576 get_packed 002250 constant label dcl 597 good 002577 constant label dcl 711 ref 180 202 232 267 272 285 311 349 423 503 543 566 578 583 589 595 601 642 651 661 682 704 mode_out 000325 constant label dcl 171 ref 144 150 pointerdecode 002620 constant entry internal dcl 720 ref 611 624 690 697 read 000004 constant label array(0:3) dcl 356 ref 354 read_delimiter_found 001345 constant label dcl 389 ref 362 375 read_move 001350 constant label dcl 393 ref 365 380 round 002716 constant entry internal dcl 761 ref 305 306 307 308 309 341 456 740 747 scan 000000 constant label array(0:3) dcl 225 ref 247 scan_1_char 000652 constant label dcl 253 scan_bit_table 000643 constant label dcl 249 scan_done 000705 constant label dcl 266 ref 249 256 scan_loop 000675 constant label dcl 260 ref 251 scan_none 000533 constant label dcl 225 scan_packed 000652 constant label dcl 253 seek 000014 constant label array(0:5) dcl 627 ref 625 seek_0 002356 constant label dcl 627 seek_bound 002446 constant label dcl 667 seek_first 002362 constant label dcl 631 seek_last 002422 constant label dcl 653 seek_read 002366 constant label dcl 635 seek_write 002404 constant label dcl 644 set_detached_bit 002572 constant label dcl 706 ref 120 130 truncate 002463 constant label dcl 677 ref 665 try_read 001144 constant label dcl 343 ref 421 try_scan 000542 constant label dcl 229 ref 263 try_write 001555 constant label dcl 457 ref 501 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3364 3700 2772 3374 Length 4154 2772 314 237 372 232 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME file 162 external procedure is an external procedure. pointerdecode internal procedure shares stack frame of external procedure file. round internal procedure shares stack frame of external procedure file. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 fareap file 000012 fcb file STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME file 000100 buffer_bit_offset file 000101 bits_requested file 000102 total_bits file 000103 seg_bit_offset file 000104 bits_to_move file 000105 bits_moved file 000106 current_bit file 000107 ptrbit2 file 000110 ptrbit3 file 000111 offset file 000112 buffer file 000114 p file 000116 sp file 000120 seg file 000122 base file 000123 byte file 000124 mode file 000125 no_delimiter file 000126 pointer_name file 000130 i file 000131 j file 000132 comp file 000133 switch file 000134 code file 000136 temp file 000140 bits_per_seg file 000141 char1 file 000142 msegp file 000144 mbufp file 000146 msegoff file 000147 mbufoff file 000150 mmove file 000172 overage round 000173 underage round THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return_mac mdfx1 ext_entry ext_entry_desc set_chars_eis index_chars_eis index_bs_1_eis op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. file_util$attach_file file_util$detach_file file_util$find_seg_ptr get_system_free_area_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badcall error_table_$boundviol error_table_$change_first error_table_$invalid_backspace_read error_table_$invalid_elsize error_table_$invalid_read error_table_$invalid_seek_last_bound error_table_$invalid_setdelim error_table_$invalid_write error_table_$ionmat error_table_$negative_nelem error_table_$negative_offset error_table_$new_offset_negative error_table_$no_room_for_dsb error_table_$too_many_read_delimiters error_table_$undefined_order_request error_table_$undefined_ptrname LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000062 114 000070 116 000131 117 000134 119 000140 120 000142 122 000143 124 000155 126 000161 127 000167 129 000173 130 000176 132 000177 133 000200 136 000202 137 000210 138 000216 139 000223 140 000227 142 000234 144 000241 146 000244 149 000264 150 000270 153 000271 154 000273 155 000274 158 000304 159 000305 162 000307 163 000311 164 000312 167 000322 168 000323 171 000325 173 000336 175 000340 176 000347 177 000351 178 000353 179 000355 180 000356 182 000357 188 000404 189 000410 190 000412 191 000423 193 000425 195 000434 196 000437 198 000450 200 000453 202 000455 204 000456 209 000476 210 000501 211 000504 213 000512 215 000515 216 000520 218 000521 220 000525 221 000530 223 000531 225 000533 226 000536 228 000537 229 000542 231 000545 232 000546 234 000547 235 000551 236 000555 237 000560 238 000562 239 000603 241 000605 242 000610 243 000612 244 000613 245 000615 246 000632 247 000641 249 000643 251 000651 253 000652 255 000653 256 000663 258 000672 259 000673 260 000675 262 000700 263 000704 266 000705 267 000712 269 000713 271 000717 272 000722 274 000723 275 000726 277 000727 282 000740 283 000744 284 000746 285 000750 287 000751 290 000760 291 000764 292 000766 294 000771 295 000774 297 000775 298 000777 300 001001 301 001004 303 001005 305 001007 306 001015 307 001024 308 001033 309 001042 310 001051 311 001054 313 001055 319 001070 320 001074 321 001076 322 001100 324 001103 325 001106 327 001107 328 001112 329 001115 331 001116 332 001121 334 001122 335 001125 337 001126 338 001131 340 001132 341 001134 342 001142 343 001144 344 001151 345 001157 346 001165 347 001170 348 001172 349 001213 350 001215 351 001220 352 001222 353 001223 354 001225 356 001227 358 001230 360 001233 361 001243 362 001245 364 001253 365 001254 367 001255 369 001256 371 001261 372 001270 373 001272 374 001273 375 001303 377 001312 378 001313 379 001315 380 001316 382 001317 384 001322 385 001325 386 001330 387 001344 389 001345 391 001346 393 001350 396 001354 397 001357 398 001362 399 001365 400 001370 401 001373 402 001377 403 001400 404 001402 405 001405 406 001410 407 001413 408 001425 410 001426 413 001440 414 001442 415 001446 416 001450 419 001454 420 001455 421 001457 423 001460 425 001461 428 001470 429 001474 430 001476 431 001500 433 001503 434 001506 436 001507 437 001512 438 001515 440 001516 441 001521 443 001522 444 001525 446 001526 447 001531 449 001532 451 001534 453 001543 454 001546 456 001547 457 001555 459 001562 460 001570 461 001576 462 001601 463 001603 464 001624 466 001626 467 001631 468 001633 469 001634 470 001636 471 001641 472 001644 473 001647 474 001652 475 001655 476 001660 477 001664 478 001665 479 001667 480 001672 481 001675 482 001700 483 001711 485 001712 488 001723 489 001725 490 001731 491 001733 493 001736 494 001737 495 001740 497 001742 499 001745 500 001746 501 001750 503 001751 505 001752 510 002000 511 002003 512 002006 514 002011 515 002014 517 002015 518 002017 520 002022 521 002025 523 002026 525 002030 526 002033 528 002034 530 002037 531 002041 533 002043 534 002046 537 002047 538 002051 541 002056 542 002060 543 002062 545 002063 547 002065 548 002066 549 002067 552 002072 553 002074 554 002101 557 002102 558 002104 559 002107 560 002110 561 002117 562 002130 563 002135 564 002137 566 002141 568 002142 571 002164 572 002167 573 002172 574 002173 576 002175 578 002176 580 002177 582 002201 583 002204 585 002205 587 002207 588 002210 589 002221 591 002222 592 002241 593 002243 594 002245 595 002247 597 002250 599 002252 600 002255 601 002261 603 002262 608 002307 609 002313 610 002315 611 002322 612 002324 614 002326 615 002331 617 002332 618 002340 620 002341 621 002344 623 002345 624 002352 625 002354 627 002356 629 002361 631 002362 633 002365 635 002366 638 002372 639 002375 641 002376 642 002403 644 002404 647 002410 648 002413 650 002414 651 002421 653 002422 656 002426 657 002431 658 002434 660 002435 661 002436 663 002437 664 002444 665 002445 667 002446 670 002452 671 002455 673 002456 674 002460 676 002462 677 002463 680 002465 681 002472 682 002477 684 002500 687 002522 688 002526 689 002530 690 002535 691 002537 693 002541 694 002544 696 002545 697 002553 698 002555 700 002557 701 002562 703 002563 704 002571 706 002572 708 002575 709 002576 711 002577 712 002602 713 002603 714 002606 716 002611 718 002617 720 002620 726 002622 728 002627 729 002630 730 002632 731 002633 734 002635 735 002640 736 002642 737 002643 740 002645 741 002654 742 002660 743 002662 744 002663 747 002665 748 002674 749 002700 750 002702 751 002703 754 002705 755 002710 756 002712 757 002713 759 002715 761 002716 765 002720 766 002725 768 002726 769 002731 771 002741 774 002743 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved