COMPILATION LISTING OF SEGMENT read_list_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/09/82 0907.4 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /*converted to v2pl1 by A. Downing 12.14.72*/ 12 /* Free format input program, doing conversions as dictated 13* by descriptors of the calling program. 14* re-coded by M. Weaver 28 July 1970 */ 15 16 /* Modified on: 23 September 1971 by Paul Green for new descriptors */ 17 18 read_list_: procedure; /* Arguments to read_list_ are accessed through a based 19* declaration since their number and size are not 20* known at compile time. */ 21 22 dcl 1 arg based, /* Multics argument list structure. */ 23 2 acount bit(18), 24 2 spval bit(18), 25 2 dcount bit(18), 26 2 padding bit(18), 27 2 ptr(100) pointer; 28 29 /* Dummy declarations to refer to arguments after their type is known */ 30 31 dcl strv char(131) based, /* For character strings, fixed and varying */ 32 strvad char(ssize) based, /* For prompting message character strings */ 33 bitv bit(131) based, /* For bit strings, fixed and varying */ 34 fxdv fixed bin(35) based, /* For single precision fixed point input */ 35 fxdvh fixed bin(17) based, /* For other single prec. fixed point numbers */ 36 fxd2v fixed bin(71) based, /* Double precision fixed point */ 37 fltv float bin(27) based, /* Single precision floating point */ 38 flt2v float bin(63) based, /* Double precision floating point */ 39 ptrv pointer based; /* For pointer variables */ 40 41 dcl argct fixed bin, /* Number of arguments in calling sequence. */ 42 argp pointer, /* Holds pointer to argument list */ 43 argpos fixed bin, /* Next argument position to be filled. */ 44 beg fixed bin, /* First non-control argument */ 45 bpos fixed bin, /* index of first char of value */ 46 cannedsw fixed bin, /* Switch to permit printing of canned prompting message. */ 47 cend fixed bin, /* Index of end of conversion scan */ 48 charpos fixed bin, /* Index of next input character to be scanned */ 49 code fixed bin, /* error code */ 50 comsw bit(1) aligned, /* indicates prescence of comma followed by irrelevant chars */ 51 cstart fixed bin, /* Index of start of conversion scan */ 52 cvindex fixed bin, /* Index used during number conversion */ 53 digit fixed bin, /* Holds value of next digit of input string */ 54 fltval float bin(63), /* Holds floating point value during conversion */ 55 fxval fixed bin(71), /* Holds fixed point values during conversion */ 56 i fixed bin, /* index into label array for return from number conversion */ 57 iosw bit(1) aligned, /* Console interaction switch */ 58 j fixed bin, /* no. of relevant chars in bit string */ 59 lset bit(1) int static init("0"b), /* Switch for initializing labels */ 60 neg fixed bin, /* Sign of value being converted */ 61 ndims fixed bin, /* Number of dimensions in array argument */ 62 nl char(1) aligned int static init(" 63 "), /* new-line character */ 64 octal_fix(0: 1) bit(36) aligned based, /* array to pick out the low order word of a double prec. no. */ 65 p ptr, /* Pointer to current argument */ 66 packed bit(1) aligned, /* ="1"b if this argument is packed */ 67 plural char(1) aligned, /* "s" or " " for more grammatical prompting */ 68 promptsw fixed bin, /* Set to 1 if caller provides prompting messages */ 69 ptrbrk(0: 2) fixed bin(17) int static init(124, 40, 41), /* ascii for ptr break chars */ 70 q ptr, /* Pointer to intermediate conversion number */ 71 radix fixed bin, /* Radix of integer conversion */ 72 rbuf char(rcount) based(rbufp), /* Input string */ 73 rbufp pointer, /* Pointer to input buffer */ 74 rcount fixed bin, /* Number of characters read or length of input string */ 75 readbuf char(131) aligned, /* Typewriter input buffer area */ 76 scale fixed bin, /* Arithemetic scale of argument */ 77 (size,ssize) fixed bin(35), /* Arithmetic precision, string size, or number of structure elements */ 78 squosw bit(1) aligned, /* Flag to indicate single quote in string */ 79 stop_at_break bit(1), /* Flag to tell scan of input to stop at a break */ 80 tempc char(1) aligned, /* temporary for looking at a character */ 81 type fixed binary, /* Data type of next argument to be filled */ 82 typemsg char(32), /* Holds an error message appropriate for input type */ 83 up fixed bin, /* Last relevant digit corresponding to radix */ 84 vpos fixed bin, /* index of last char of value */ 85 1 x aligned based(rbufp), /* Structure for scanning input line */ 86 2 c(0: 3) char(1) unaligned; 87 88 dcl retlab(0: 2) label local int static; /* Label array for returning from number conversion routine */ 89 90 dcl com_err_$suppress_name entry(fixed bin,char(*) aligned,char(*) aligned), 91 com_err_ entry options(variable), 92 cu_$arg_list_ptr entry(ptr), 93 cv_float_double_ entry(char(*) aligned,fixed bin,float bin(63)), 94 decode_descriptor_ entry(ptr,fixed bin,fixed bin,bit(1) aligned,fixed bin,fixed bin(35),fixed bin), 95 ioa_ entry options(variable), 96 ioa_$nnl entry options(variable), 97 ios_$read_ptr ext entry(ptr, fixed bin, fixed bin), 98 ios_$resetread entry options(variable); 99 100 dcl (addr,addrel,baseptr,divide,fixed,min,substr,unspec) builtin; 101 102 /* declare added for ios_$resetread */ 103 dcl status_bits bit(72) aligned; 104 105 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 106 107 108 /* Entry points. Locate calling sequence. */ 109 110 111 promptsw = 0; /* No prompting messages provided by user */ 112 cannedsw = 0; /* Canned prompting is suppressed the first time */ 113 go to cmn; 114 115 prompt: entry; 116 promptsw = 1; /* prompting messages are provided */ 117 go to cmn; 118 119 no_prompt: entry; 120 promptsw = 0; /* No prompting messages provided by user */ 121 cannedsw = 2; /* Always suppress canned prompting */ 122 go to cmn; 123 124 scan_string: entry; 125 promptsw = 0; /* No prompting messages provided by user */ 126 cannedsw = 2; /* Always suppress canned prompting */ 127 iosw = "0"b; /* non-interactive entry */ 128 beg = 3; /* third arg is first regular output arg */ 129 go to getap; 130 131 132 cmn: rbufp = addr(readbuf); /* want input to go into a buffer for most entries */ 133 beg = 1; /* most entries don't have control arguments */ 134 iosw = "1"b; /* most entries will interact with concole */ 135 getap: q = addr(digit); /* init q pointer */ 136 call cu_$arg_list_ptr(argp); /* get pointer to caller's argument list */ 137 argct = divide(fixed(argp->arg.acount,18), 2, 17, 0); /* get number of arguments */ 138 charpos = 0; /* prepare to look at first character in input line */ 139 if ^iosw then do; /* get addr and length of input string for $scan_string */ 140 rbufp = argp->arg.ptr(1); /* get pointer to input string */ 141 call decode_descriptor_(argp,1,type,packed,ndims,size,scale); 142 if type = 21 then rcount = size-1; 143 /* fixed length string; get length from it; indexing starts at 0 */ 144 else rcount = addrel(rbufp,-1)->fxdvh - 1; /* varying string; get current length from it*/ 145 146 /* We want to look at the input string through an aligned based structure. In order 147* to do this, if the string is unaligned, we must adjust the pointer to the string 148* and also adjust the offset and length. */ 149 150 up = fixed(substr(addr(rbufp)->bitv,55,9),9); /* isolate bit offset of input ptr */ 151 if up > 0 then do; 152 substr(addr(rbufp)->bitv,55,9) = "0"b; /* zero out any bit offset */ 153 up = divide(up,9,17,0); /* calculate character offset from bit offset */ 154 charpos = charpos + up; /* adjust beginning offset to reflect aligned string */ 155 rcount = rcount + up; /* adjust length to reflect aligned string */ 156 end; 157 end; 158 else rcount = -1; /* for rest of entries, rcount will come from ios_$read_ptr */ 159 160 if ^lset then do; /* initiate label array once per process */ 161 retlab(0) = retlab_0; 162 retlab(1) = retlab_1; 163 retlab(2) = retlab_2; 164 lset = "1"b; 165 end; 166 167 /* Grand loop--fill in caller's arguments, one at a time */ 168 169 170 do argpos = (beg+promptsw) by (1+promptsw) to argct; 171 172 call decode_descriptor_(argp,argpos,type,packed,ndims,size,scale); 173 174 /* locate start of next typed input value */ 175 176 cklth: if charpos > rcount then do; /* we are at end of current input line */ 177 if ^iosw then do; /* can't get any more lines */ 178 argp->arg.ptr(2)->fxdv = argpos-3; /* return number of args filled in */ 179 return; 180 end; 181 else if promptsw = 1 then do; /* print next prompting message */ 182 call decode_descriptor_(argp,argpos-1,0,"0"b,0,ssize,0); 183 if ssize ^= 0 then call ioa_$nnl(argp->arg.ptr(argpos-1)->strvad); 184 end; 185 else if cannedsw = 1 then do; 186 radix = argct-argpos+1; /* put calculation into a temporary */ 187 if radix = 1 then plural = " "; 188 else plural = "s"; 189 call ioa_("^d more input value^a expected",radix,plural); 190 end; 191 else if cannedsw = 0 then cannedsw = 1; /* allow canned prompting messages from now on */ 192 193 read_more: call ios_$read_ptr(rbufp,130,rcount); 194 comsw = "1"b; /* new-line character at beginning of line is treated as a comma */ 195 rcount = rcount - 2; /* discard "new line" character; indexing starts at 0 */ 196 charpos = 0; /* Prepare to look at first character of input line */ 197 end; 198 199 /* When looking for the next value, blanks, tabs, commas and new-line chars are 200* skipped over. Blanks and tabs are ignored. Two consecutive commas, or 2 201* commas separated by blanks and/or tabs indicate that the current parameter 202* position is not to be filled in. */ 203 204 tempc = x.c(charpos); /* copy character into a temporary */ 205 if tempc = " " then go to skipb; /* skip over blanks */ 206 if tempc = " " then do; /* skip over tabs */ 207 skipb: charpos = charpos + 1; 208 go to cklth; 209 end; 210 if tempc = "," then do; /* ",," implies do nothing to corresponding arg */ 211 if comsw then do; 212 charpos = charpos + 1; /* don't want to get into a loop */ 213 go to next_par; 214 end; 215 set_com: comsw = "1"b; /* note passing of comma */ 216 go to skipb; 217 end; 218 if tempc = nl then go to set_com; /* skip over imbedded new-line character */ 219 220 /* The general strategy is as follows. First the type of the next argument is determined and a pointer 221* to it is obtained. For fixed, floating or bit arguments, the input string is scanned until the 222* first break character and then a branch is made to the appropriate conversion section. 223* Pointer input is parsed only once--in the number conversion routine. Character input is parsed once, 224* but with a facility to recognize quotes and to suppress breaks. */ 225 226 p = argp->arg.ptr(argpos); /* get pointer to current argument */ 227 228 comsw = "0"b; /* Have relevant character; forget any previous comma */ 229 bpos = charpos; /* remember beginning of value */ 230 231 if type = 13 then go to ptr_input; 232 if type = 21 then go to char_input; 233 if type = 22 then go to char_input; 234 235 do charpos = charpos to rcount; /* scan to the end of the input string if necessary */ 236 tempc = x.c(charpos); /* copy character into a temporary */ 237 if tempc = " " then go to use_val; /* test for blank */ 238 if tempc = " " then go to use_val; /* test for tab */ 239 if tempc = "," then go to use_val; /* test for comma */ 240 if tempc = nl then go to use_val; /* test for new line */ 241 end; 242 243 use_val: vpos = charpos - 1; /* don't include break character in value */ 244 if type < 3 then go to fixed_input; 245 if type < 5 then go to fpt_input; 246 if type = 19 then go to bit_input; 247 if type = 20 then go to bit_input; 248 249 /* omitted types are: 5-8: complex; 9-10: decimal; 14: offset; 15: label; 16: entry; 23: file; 24: packed ptr. */ 250 251 call com_err_(0,"read_list_","Unhandled data-type ^d for argument ^d. It has been ignored.",type,argpos); 252 go to next_par; 253 254 255 /* Try to interpret next input value as fixed point */ 256 257 fixed_input: 258 cend = vpos; /* normally scan whole value */ 259 tempc = x.c(vpos); 260 if tempc = "b" then do; /* input in binary form */ 261 radix = 2; 262 cend = vpos - 1; /* ignore last character */ 263 end; 264 else if tempc = "o" then do; /* input in octal form */ 265 radix = 8; 266 cend = vpos - 1; /* ignore last character */ 267 end; 268 else radix = 10; /* input in decimal form */ 269 cstart = bpos; 270 typemsg = "an integer"; 271 go to cvint; /* convert the number */ 272 retfx: /* get here only if there were no errors */ 273 if type = 2 then p->fxd2v = fxval; /* double precision case */ 274 /* don't want positive sign to affect 275* single precision octal or binary input */ 276 else if radix ^= 10 & neg > 0 then unspec(p->fxdv) = addr(fxval)->octal_fix(1); 277 else p->fxdv = fxval; /* single precision case; decimal or negative octal/binary value */ 278 go to next_par; 279 280 281 /* Try to interpret next input value as floating point */ 282 283 fpt_input: 284 typemsg = "a real (floating-point) number"; 285 call cv_float_double_(substr(rbuf,bpos+1,vpos-bpos+1),code,fltval); 286 if code ^= 0 then go to illegal; 287 if type = 3 then argp->arg.ptr(argpos)->fltv = fltval; /* single precision */ 288 else argp->arg.ptr(argpos)->flt2v = fltval; /* double precision */ 289 go to next_par; 290 291 292 /* Try to interpret next input value as a pointer variable */ 293 294 ptr_input: 295 radix = 8; /* pointer input is in octal */ 296 cstart = bpos; 297 cend = rcount; /* go till get to break */ 298 typemsg = "an (octal) pointer value"; 299 i = 0; /* set index into label array */ 300 go to cvint; /* start parsing and converting segment number */ 301 retlab_0: /* breaks are checked by number conversion routine */ 302 cstart = cvindex + 1; /* set beginning of word offset scan */ 303 i = 1; 304 go to cvint; 305 retlab_1: 306 cstart = cvindex + 1; /* set beginning of bit offset scan */ 307 i = 2; 308 radix = 10; /* bit offset is in decimal */ 309 go to cvint; 310 retlab_2: 311 charpos = cvindex + 1; /* set for scanning next input value */ 312 /* check range ofbit offset */ 313 if fxval > 35 then do; /* check range of bit offset */ 314 call ioa_("^d is too large for a bit offset in a pointer.",fixed(fxval,35)); 315 beg = -1; 316 go to illegal; 317 end; 318 319 go to next_par; 320 321 322 /* Try to interpret next input value as a bit string */ 323 324 bit_input: 325 typemsg = "a bit string"; 326 if x.c(bpos) ^= """" then go to illegal; /* check to see that value starts with " */ 327 if substr(rbuf,vpos,2) ^= """b" then go to illegal; /* and that it ends with "b */ 328 up = vpos - bpos - 2; /* compute length of string */ 329 j = min(size,up); /* determine number of bits to fill in */ 330 331 do cvindex = 1 to j; 332 tempc = x.c(bpos+cvindex); /* copy next character into a temporary */ 333 if tempc = "1" then substr(p->bitv,cvindex,1) = "1"b; 334 else if tempc = "0" then substr(p->bitv,cvindex,1) = "0"b; 335 else go to illegal; 336 end; 337 338 if j < up then do cvindex = j + 1 to up; /* check rest of input for illegal characters */ 339 tempc = x.c(bpos+cvindex); 340 if tempc ^= "1" then if tempc ^= "0" then go to illegal; 341 end; 342 343 if type = 19 then if j < size 344 then substr(p->bitv,j+1,size-j) = "0"b; /* pad fixed string with zeros */ 345 else; /* no padding needed */ 346 else addrel(p,-1)->fxdv = j; /* set varying string length */ 347 go to next_par; 348 349 350 /* Interpret next input value as a character string */ 351 352 char_input: 353 typemsg = "a character string"; 354 squosw = "0"b; /* init switch to indicate a quote after first character */ 355 stop_at_break = "1"b; /* presume scan goes to first break */ 356 vpos = 0; /* for number of characters inserted in arg */ 357 358 do charpos = charpos to rcount; /* scan to the end of the input string if needed */ 359 tempc = x.c(charpos); /* copy character */ 360 if stop_at_break then do; /* stop at a break unless in a quoted string */ 361 if tempc = " " then go to setl; 362 if tempc = " " then go to setl; /* test for tab */ 363 if tempc = "," then go to setl; 364 if tempc = nl then go to setl; /* test for new-line */ 365 if squosw then go to illegfinch; /* had a single quote not followed by break */ 366 end; 367 368 if tempc = """" then do; /* check for quote mark */ 369 if charpos = bpos /* first char */ then stop_at_break = "0"b; 370 else if charpos = rcount then go to lastquo; /* last char of input line */ 371 else if x.c(charpos+1) = """" then do; /* next char is a quote */ 372 charpos = charpos + 1; /* store only it */ 373 go to storech; 374 end; 375 else do; /* either end of string of illegal */ 376 lastquo: if x.c(bpos) ^= """" then go to illegfinch; /* quotes don't match */ 377 stop_at_break = "1"b; /* breaks are effective again */ 378 squosw = "1"b; /* if next char is not a break, have illegal string */ 379 end; 380 end; 381 else do; /* character is not a quote mark */ 382 storech: vpos = vpos + 1; 383 if vpos <= size then substr(p->strv,vpos,1) = tempc; /* store if there is room */ 384 end; 385 end; /* end of character input loop */ 386 387 if ^stop_at_break then do; /* string started with a quote but didn't end with one */ 388 go to illegal; 389 end; 390 391 setl: 392 if type = 21 then if vpos < size 393 then substr(p->strv,vpos+1,size-vpos) = " "; /* pad fixed string with blanks */ 394 else; /* no padding needed */ 395 else addrel(p,-1)->fxdv = min(size,vpos); /* set current length of varying string */ 396 go to next_par; 397 398 399 /* Illegal syntax detected while converting input value. Comment and try again. */ 400 401 illegfinch: /* finish parsing illegal character string value */ 402 cvindex = charpos; 403 illegfin: /* finish parsing illegal pointer value */ 404 do charpos = cvindex to rcount; /* parse until get to break */ 405 tempc = x.c(charpos); 406 if tempc = " " then go to illegal; /* test for blank */ 407 if tempc = " " then go to illegal; /* test for tab */ 408 if tempc = "," then go to illegal; 409 if tempc = nl then go to illegal; /* test for new-line */ 410 end; 411 412 illegal: if ^iosw then do; /* in non-interactive mode; set code and return */ 413 argp->arg.ptr(2)->fxdv = 2 - argpos; /* here code must be negative */ 414 return; 415 end; 416 417 if beg > 0 then /* tell user what was wrong */ 418 call ioa_("Can't interpret ""^a"" as ^a.",substr(rbuf,bpos+1,charpos-bpos),typemsg); 419 else beg = 1; /* reset so we can get proper messages later */ 420 call ios_$resetread("user_input",status_bits); 421 call com_err_$suppress_name(0,"read_list_","Retype input starting with that value."); 422 rcount = -1; /* discard remainder of this line */ 423 argpos = argpos-(1+promptsw); /* want to re-enter this argument */ 424 go to next_par; 425 426 427 /* routine to convert ascii number to binary */ 428 cvint: 429 up = radix + 47; /* highest digit to look for; 60 octal = 0 */ 430 neg = 1; /* initialize scan */ 431 fxval = 0; 432 digit = 0; 433 434 do cvindex = cstart to cend; 435 q->x.c(3) = rbufp->x.c(cvindex); /* copy next char into a number */ 436 if digit >= 48 then if digit <= up then do; /* could be a digit */ 437 fxval = radix * fxval + (digit - 48); 438 go to end_loop; /* this char was OK; get another */ 439 end; 440 if type = 13 then do; /* are processing a pointer */ 441 if cvindex = cstart then go to illegfin; /* couldn't use any part of tokens */ 442 storeptr: if i = 0 then /* working on segment number */ 443 p->ptrv = baseptr(fxval); 444 else if i = 1 then /* working on offset */ 445 p->ptrv = addrel(p->ptrv,fxval); 446 else if i = 2 then /* working on bit offset */ 447 substr(p->bitv,55,9) = substr(addr(fxval)->bitv,64,9); 448 if cvindex > cend then go to set_ind; /* stopped by end of input string */ 449 if digit ^= ptrbrk(i) then do; /* ptrbrk(1)="|"; ptrbrk(1)="("; ptrbrk(2)=")" */ 450 if i = 2 then go to illegfin; /* bit offset must end with ")" */ 451 if digit ^= 32 /* space */ 452 then if digit ^= 9 /* tab */ 453 then if digit ^= 44 /* comma */ 454 then if digit ^= 10 /* new-line */ 455 then go to illegfin; /* have illegal character */ 456 set_ind: charpos = cvindex + 1; /* set charpos for scanning next input arg */ 457 go to next_par; /* value is already stored in arg */ 458 end; 459 go to retlab(i); 460 end; /* end of pointer processing */ 461 else if cvindex ^= cstart then go to illegal; 462 else do; 463 if digit = 45 then neg = -1; /* minus sign */ 464 else if digit ^= 43 then go to illegal; /* could have a plus sign */ 465 end; 466 end_loop: end; /* end of character scanning for conversion */ 467 468 if type = 13 then /* end of input line */ 469 if i = 2 then go to illegfin; /* bit offset must end with ")" */ 470 else go to storeptr; /* finish up ptr */ 471 if neg < 0 then fxval = -fxval; 472 go to retfx; /* get here only during fixed point conversion */ 473 474 475 /* Argument has been stored, move on to the next one */ 476 477 next_par: 478 end; /* End of grand loop */ 479 480 if promptsw = 1 then if argpos = argct + 1 then do; /* Is the last arg an extra prompting message? */ 481 call decode_descriptor_(argp,argpos-1,0,"0"b,0,ssize,0); 482 if ssize ^= 0 then call ioa_$nnl(argp->arg.ptr(argpos-1)->strvad); 483 end; 484 if ^iosw then argp->arg.ptr(2)->fxdv = argpos - 3; /* return number of args filled in */ 485 return; 486 487 end read_list_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/09/82 0902.5 read_list_.pl1 >dumps>old>recomp>read_list_.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. acount based bit(18) level 2 packed unaligned dcl 22 ref 137 addr builtin function dcl 100 ref 132 135 150 152 276 446 addrel builtin function dcl 100 ref 144 346 395 444 arg based structure level 1 unaligned dcl 22 argct 000100 automatic fixed bin(17,0) dcl 41 set ref 137* 170 186 480 argp 000102 automatic pointer dcl 41 set ref 136* 137 140 141* 172* 178 182* 183 226 287 288 413 481* 482 484 argpos 000104 automatic fixed bin(17,0) dcl 41 set ref 170* 172* 178 182 183 186 226 251* 287 288 413 423* 423* 480 481 482 484 baseptr builtin function dcl 100 ref 442 beg 000105 automatic fixed bin(17,0) dcl 41 set ref 128* 133* 170 315* 417 419* bitv based bit(131) unaligned dcl 31 set ref 150 152* 333* 334* 343* 446* 446 bpos 000106 automatic fixed bin(17,0) dcl 41 set ref 229* 269 285 285 285 285 296 326 328 332 339 369 376 417 417 417 417 c based char(1) array level 2 packed unaligned dcl 41 set ref 204 236 259 326 332 339 359 371 376 405 435* 435 cannedsw 000107 automatic fixed bin(17,0) dcl 41 set ref 112* 121* 126* 185 191 191* cend 000110 automatic fixed bin(17,0) dcl 41 set ref 257* 262* 266* 297* 434 448 charpos 000111 automatic fixed bin(17,0) dcl 41 set ref 138* 154* 154 176 196* 204 207* 207 212* 212 229 235* 235* 236* 243 310* 358* 358* 359 369 370 371 372* 372* 401 403* 405* 417 417 456* code 000112 automatic fixed bin(17,0) dcl 41 set ref 285* 286 com_err_ 000030 constant entry external dcl 90 ref 251 com_err_$suppress_name 000026 constant entry external dcl 90 ref 421 comsw 000113 automatic bit(1) dcl 41 set ref 194* 211 215* 228* cstart 000114 automatic fixed bin(17,0) dcl 41 set ref 269* 296* 301* 305* 434 441 461 cu_$arg_list_ptr 000032 constant entry external dcl 90 ref 136 cv_float_double_ 000034 constant entry external dcl 90 ref 285 cvindex 000115 automatic fixed bin(17,0) dcl 41 set ref 301 305 310 331* 332 333 334* 338* 339* 401* 403 434* 435 441 448 456 461* decode_descriptor_ 000036 constant entry external dcl 90 ref 141 172 182 481 digit 000116 automatic fixed bin(17,0) dcl 41 set ref 135 432* 436 436 437 449 451 451 451 451 463 464 divide builtin function dcl 100 ref 137 153 fixed builtin function dcl 100 ref 137 150 314 314 flt2v based float bin(63) dcl 31 set ref 288* fltv based float bin(27) dcl 31 set ref 287* fltval 000120 automatic float bin(63) dcl 41 set ref 285* 287 288 fxd2v based fixed bin(71,0) dcl 31 set ref 272* fxdv based fixed bin(35,0) dcl 31 set ref 178* 276* 277* 346* 395* 413* 484* fxdvh based fixed bin(17,0) dcl 31 ref 144 fxval 000122 automatic fixed bin(71,0) dcl 41 set ref 272 276 277 313 314 314 431* 437* 437 442 444 446 471* 471 i 000124 automatic fixed bin(17,0) dcl 41 set ref 299* 303* 307* 442 444 446 449 450 459 468 ioa_ 000040 constant entry external dcl 90 ref 189 314 417 ioa_$nnl 000042 constant entry external dcl 90 ref 183 482 ios_$read_ptr 000044 constant entry external dcl 90 ref 193 ios_$resetread 000046 constant entry external dcl 90 ref 420 iosw 000125 automatic bit(1) dcl 41 set ref 127* 134* 139 177 412 484 j 000126 automatic fixed bin(17,0) dcl 41 set ref 329* 331 338 338 343 343 343 346 lset 000010 internal static bit(1) initial unaligned dcl 41 set ref 160 164* min builtin function dcl 100 ref 329 395 ndims 000130 automatic fixed bin(17,0) dcl 41 set ref 141* 172* neg 000127 automatic fixed bin(17,0) dcl 41 set ref 276 430* 463* 471 nl constant char(1) initial dcl 41 ref 218 240 364 409 octal_fix based bit(36) array dcl 41 ref 276 p 000132 automatic pointer dcl 41 set ref 226* 272 276 277 333 334 343 346 383 391 395 442 444 444 446 packed 000134 automatic bit(1) dcl 41 set ref 141* 172* plural 000135 automatic char(1) dcl 41 set ref 187* 188* 189* promptsw 000136 automatic fixed bin(17,0) dcl 41 set ref 111* 116* 120* 125* 170 170 181 423 480 ptr 2 based pointer array level 2 dcl 22 ref 140 178 183 226 287 288 413 482 484 ptrbrk 000000 constant fixed bin(17,0) initial array dcl 41 ref 449 ptrv based pointer dcl 31 set ref 442* 444* 444 q 000140 automatic pointer dcl 41 set ref 135* 435 radix 000142 automatic fixed bin(17,0) dcl 41 set ref 186* 187 189* 261* 265* 268* 276 294* 308* 428 437 rbuf based char unaligned dcl 41 ref 285 285 327 417 417 rbufp 000144 automatic pointer dcl 41 set ref 132* 140* 144 150 152 193* 204 236 259 285 285 326 327 332 339 359 371 376 405 417 417 435 rcount 000146 automatic fixed bin(17,0) dcl 41 set ref 142* 144* 155* 155 158* 176 193* 195* 195 235 285 285 297 327 358 370 403 417 417 422* readbuf 000147 automatic char(131) dcl 41 set ref 132 retlab 000012 internal static label variable local array dcl 88 set ref 161* 162* 163* 459 scale 000210 automatic fixed bin(17,0) dcl 41 set ref 141* 172* size 000211 automatic fixed bin(35,0) dcl 41 set ref 141* 142 172* 329 343 343 383 391 391 395 squosw 000213 automatic bit(1) dcl 41 set ref 354* 365 378* ssize 000212 automatic fixed bin(35,0) dcl 41 set ref 182* 183 183 183 481* 482 482 482 status_bits 000232 automatic bit(72) dcl 103 set ref 420* stop_at_break 000214 automatic bit(1) unaligned dcl 41 set ref 355* 360 369* 377* 387 strv based char(131) unaligned dcl 31 set ref 383* 391* strvad based char unaligned dcl 31 set ref 183* 482* substr builtin function dcl 100 set ref 150 152* 285 285 327 333* 334* 343* 383* 391* 417 417 446* 446 tempc 000215 automatic char(1) dcl 41 set ref 204* 205 206 210 218 236* 237 238 239 240 259* 260 264 332* 333 334 339* 340 340 359* 361 362 363 364 368 383 405* 406 407 408 409 type 000216 automatic fixed bin(17,0) dcl 41 set ref 141* 142 172* 231 232 233 244 245 246 247 251* 272 287 343 391 440 468 typemsg 000217 automatic char(32) unaligned dcl 41 set ref 270* 283* 298* 324* 352* 417* unspec builtin function dcl 100 set ref 276* up 000227 automatic fixed bin(17,0) dcl 41 set ref 150* 151 153* 153 154 155 328* 329 338 338 428* 436 vpos 000230 automatic fixed bin(17,0) dcl 41 set ref 243* 257 259 262 266 285 285 327 328 356* 382* 382 383 383 391 391 391 395 x based structure level 1 dcl 41 NAMES DECLARED BY EXPLICIT CONTEXT. bit_input 001207 constant label dcl 324 ref 246 247 char_input 001346 constant label dcl 352 ref 232 233 cklth 000417 constant label dcl 176 ref 208 cmn 000220 constant label dcl 132 ref 113 117 122 cvint 001670 constant label dcl 428 ref 271 300 304 309 end_loop 002032 constant label dcl 466 ref 438 fixed_input 000754 constant label dcl 257 ref 244 fpt_input 001035 constant label dcl 283 ref 245 getap 000226 constant label dcl 135 ref 129 illegal 001531 constant label dcl 412 ref 286 316 326 327 334 340 388 406 407 408 409 461 464 illegfin 001502 constant label dcl 403 ref 441 450 451 468 illegfinch 001501 constant label dcl 401 ref 365 376 lastquo 001425 constant label dcl 376 ref 370 next_par 002050 constant label dcl 477 ref 213 252 278 289 319 347 396 424 457 no_prompt 000172 constant entry external dcl 119 prompt 000161 constant entry external dcl 115 ptr_input 001121 constant label dcl 294 ref 231 read_list_ 000150 constant entry external dcl 18 read_more 000557 constant label dcl 193 retfx 001014 constant label dcl 272 ref 472 retlab_0 001134 constant label dcl 301 ref 161 retlab_1 001142 constant label dcl 305 ref 162 retlab_2 001152 constant label dcl 310 ref 163 scan_string 000204 constant entry external dcl 124 set_com 000624 constant label dcl 215 ref 218 set_ind 002007 constant label dcl 456 ref 448 setl 001453 constant label dcl 391 ref 361 362 363 364 skipb 000614 constant label dcl 207 ref 205 216 storech 001436 constant label dcl 382 ref 373 storeptr 001737 constant label dcl 442 ref 470 use_val 000677 constant label dcl 243 ref 237 238 239 240 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2310 2360 2147 2320 Length 2550 2147 50 153 141 16 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME read_list_ 228 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 lset read_list_ 000012 retlab read_list_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME read_list_ 000100 argct read_list_ 000102 argp read_list_ 000104 argpos read_list_ 000105 beg read_list_ 000106 bpos read_list_ 000107 cannedsw read_list_ 000110 cend read_list_ 000111 charpos read_list_ 000112 code read_list_ 000113 comsw read_list_ 000114 cstart read_list_ 000115 cvindex read_list_ 000116 digit read_list_ 000120 fltval read_list_ 000122 fxval read_list_ 000124 i read_list_ 000125 iosw read_list_ 000126 j read_list_ 000127 neg read_list_ 000130 ndims read_list_ 000132 p read_list_ 000134 packed read_list_ 000135 plural read_list_ 000136 promptsw read_list_ 000140 q read_list_ 000142 radix read_list_ 000144 rbufp read_list_ 000146 rcount read_list_ 000147 readbuf read_list_ 000210 scale read_list_ 000211 size read_list_ 000212 ssize read_list_ 000213 squosw read_list_ 000214 stop_at_break read_list_ 000215 tempc read_list_ 000216 type read_list_ 000217 typemsg read_list_ 000227 up read_list_ 000230 vpos read_list_ 000232 status_bits read_list_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return mpfx2 shorten_stack ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ com_err_$suppress_name cu_$arg_list_ptr cv_float_double_ decode_descriptor_ ioa_ ioa_$nnl ios_$read_ptr ios_$resetread NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000147 111 000155 112 000156 113 000157 115 000160 116 000166 117 000170 119 000171 120 000177 121 000200 122 000202 124 000203 125 000211 126 000212 127 000214 128 000215 129 000217 132 000220 133 000222 134 000224 135 000226 136 000230 137 000237 138 000243 139 000244 140 000246 141 000251 142 000276 144 000310 150 000315 151 000321 152 000323 153 000325 154 000327 155 000330 157 000331 158 000332 160 000334 161 000337 162 000342 163 000345 164 000350 170 000352 172 000374 176 000417 177 000422 178 000424 179 000430 181 000431 182 000434 183 000467 184 000507 185 000510 186 000513 187 000517 188 000524 189 000526 190 000552 191 000553 193 000557 194 000574 195 000576 196 000600 204 000601 205 000607 206 000612 207 000614 208 000615 210 000616 211 000620 212 000622 213 000623 215 000624 216 000626 218 000627 226 000631 228 000636 229 000637 231 000641 232 000644 233 000646 235 000650 236 000657 237 000664 238 000667 239 000671 240 000673 241 000675 243 000677 244 000701 245 000704 246 000706 247 000710 251 000712 252 000753 257 000754 259 000756 260 000763 261 000766 262 000770 263 000773 264 000774 265 000776 266 001000 267 001003 268 001004 269 001006 270 001010 271 001013 272 001014 276 001022 277 001032 278 001034 283 001035 285 001040 286 001075 287 001100 288 001112 289 001120 294 001121 296 001123 297 001125 298 001127 299 001132 300 001133 301 001134 303 001137 304 001141 305 001142 307 001145 308 001147 309 001151 310 001152 313 001155 314 001161 315 001203 316 001205 319 001206 324 001207 326 001212 327 001220 328 001225 329 001231 331 001235 332 001243 333 001251 334 001262 336 001271 338 001273 339 001306 340 001314 341 001321 343 001323 345 001340 346 001341 347 001345 352 001346 354 001351 355 001352 356 001354 358 001355 359 001364 360 001371 361 001373 362 001376 363 001400 364 001402 365 001404 368 001406 369 001411 370 001415 371 001417 372 001423 373 001424 376 001425 377 001432 378 001434 380 001435 382 001436 383 001437 385 001446 387 001450 388 001452 391 001453 394 001470 395 001471 396 001500 401 001501 403 001502 405 001511 406 001516 407 001521 408 001523 409 001525 410 001527 412 001531 413 001533 414 001537 417 001540 419 001602 420 001605 421 001626 422 001660 423 001662 424 001667 428 001670 430 001673 431 001675 432 001677 434 001700 435 001707 436 001714 437 001721 438 001730 440 001731 441 001734 442 001737 444 001746 446 001756 448 001764 449 001767 450 001773 451 001776 456 002007 457 002012 459 002013 461 002017 463 002022 464 002030 466 002032 468 002034 470 002042 471 002043 472 002047 477 002050 480 002053 481 002062 482 002115 484 002135 485 002143 ----------------------------------------------------------- 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