COMPILATION LISTING OF SEGMENT get_entry_point_dcl_ Compiled by: Multics PL/I Compiler, Release 30, of February 16, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 04/19/88 0838.0 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 16 /****^ HISTORY COMMENTS: 17* 1) change(84-12-30,Ranzenbach), approve(86-03-12,MCR7144), 18* audit(86-03-12,GWMay), install(86-05-01,MR12.0-1051): 19* added support for archive component pathnames and repairs for: 20* phx09270 - handle trailing blanks in arg. 21* phx09340 - "" 22* phx09592 - Illegal PL/I coding. 23* 2) change(88-01-01,Gilcrease), approve(88-02-01,MCR7836), 24* audit(88-03-17,RBarstad), install(88-04-19,MR12.2-1040): 25* Make error_table_ produce same out as >sl1>error_table_. 26* Allow argument as ask_$ask_ = ask_ and in .dcl file. 27* END HISTORY COMMENTS */ 28 29 30 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 31 /* */ 32 /* Name: get_entry_point_dcl_ */ 33 /* */ 34 /* This program obtains PL/I declare attributes for external procedure entry points, */ 35 /* and for error_table_ codes and other, system-wide external data. The program obtains */ 36 /* the entry point dcl attributes from two sources: data files declaring all unusual */ 37 /* procedure entry points (ALM segments, procedures written as subroutines but used as */ 38 /* functions, etc) and system-wide data values (eg, sys_info$max_seg_size); the */ 39 /* argument descriptors included in the procedure entry point itself which describe the */ 40 /* entry point parameters. */ 41 /* */ 42 /* The data files declaring unusual entries are found via the "declare" search list. */ 43 /* The user may set this search list (via add_search_paths, etc) to use his own data */ 44 /* segments, or may use the default data file which get_entry_point_dcl_ sets to pl1.dcl */ 45 /* in its referencing dir if no declare search list has been set. */ 46 /* */ 47 /* The data files contain two kinds of entries, procedure entry point declarations */ 48 /* and user-defined abbreviations used by EMACS in PL/I mode. Each entry appears on a */ 49 /* separate line. Procedure entries have the form: */ 50 /* */ 51 /* proc_name declaration */ 52 /* */ 53 /* For example: */ 54 /* */ 55 /* ioa_ entry options (variable) */ 56 /* */ 57 /* Note that the declaration does NOT end with a ; character. System data entries are */ 58 /* declared in a similar manner. For example */ 59 /* */ 60 /* iox_$user_output ptr external static */ 61 /* */ 62 /* EMACS PL/I mode abbreviation entries have the form */ 63 /* */ 64 /* abbrev_name ==> abbrev_value */ 65 /* */ 66 /* For example: */ 67 /* */ 68 /* fb ==> fixed bin */ 69 /* cond ==> condition */ 70 /* */ 71 /* Abbreviation entries are processed only by the $emacs entry, not */ 72 /* by get_entry_point_dcl_. */ 73 /* */ 74 /* Entry: get_entry_point_dcl_ */ 75 /* */ 76 /* This entry point returns the declaration for an external value, either from one */ 77 /* of the data files, or by using the parameter argument descriptors associated with the */ 78 /* procedure entry point. It special cases error_table_ values by always returning */ 79 /* 'fixed bin(35) ext static' for them. For example, given the name iox_$put_chars, it */ 80 /* might return */ 81 /* */ 82 /* entry (ptr, ptr, fixed bin(21), fixed bin(35)) */ 83 /* */ 84 /* Usage */ 85 /* */ 86 /* dcl get_entry_point_dcl_ entry (char(*), fixed bin, fixed bin, */ 87 /* char(*) varying, char(32) varying, fixed bin(35)); */ 88 /* */ 89 /* call get_entry_point_dcl_ (name, dcl_style, line_length, dcl, type, code); */ 90 /* */ 91 /* where */ 92 /* 1. name */ 93 /* is the name of the external entry point or data item whose declaration must be */ 94 /* obtained. (Input) */ 95 /* */ 96 /* 2. dcl_style */ 97 /* is the style of indentation to be performed for the name. */ 98 /* (Input) */ 99 /* 0 = no indentation, entire dcl on a single line */ 100 /* 1 = indentation as for the indent command */ 101 /* 2 = indentation as preferred by Gary Dixon */ 102 /* */ 103 /* 3. line_length */ 104 /* is maximum length lines in return value are allowed to grow when indentation is */ 105 /* performed. (Input) */ 106 /* */ 107 /* 4. dcl is the declaration which was obtained. (Output) */ 108 /* */ 109 /* 5. type */ 110 /* is the type of declaration. In the current implementation, this is always a */ 111 /* null string. */ 112 /* */ 113 /* 6. code */ 114 /* is a standard status code describing any failure to obtain the declaration. */ 115 /* */ 116 /* Entry: get_entry_point_dcl_$emacs */ 117 /* */ 118 /* dcl get_entry_point_dcl_$emacs entry (char(*), fixed bin, fixed bin, */ 119 /* char(*) var, char(32) var, char(100) var); */ 120 /* */ 121 /* call get_entry_point_dcl_$emacs (name, dcl_type, line_length, dcl, type, error); */ 122 /* */ 123 /* where: */ 124 /* */ 125 /* 1. - 4. */ 126 /* are as above. */ 127 /* */ 128 /* 5. type */ 129 /* is "abbrev" if an abbreviation was found, and "" otherwise. (Output) */ 130 /* */ 131 /* 6. error */ 132 /* is a converted error code (if an error occurred), or a description of how the */ 133 /* declaration was obtained, if not found in one of the data files. (Output) */ 134 /* */ 135 /* Status */ 136 /* */ 137 /* 0) Created May, 1979 by Gary C. Dixon */ 138 /* 1) Modified Jan, 1981 by G. C. Dixon - handle non-system error table codes. */ 139 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 140 141 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 142 143 144 get_entry_point_dcl_: 145 procedure (arg, dcl_style, line_length, ret, type, Acode); 146 147 Semacs = FALSE; 148 Acode = 0; 149 go to COMMON; 150 151 emacs: entry (arg, dcl_style, line_length, ret, type, error); 152 153 Semacs = TRUE; 154 error = ""; 155 go to COMMON; 156 157 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 158 159 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 160 161 162 dcl arg char(*), 163 dcl_style fixed bin, 164 line_length fixed bin, 165 ret char(*) varying, 166 type char(32) varying, 167 error char(100) varying, 168 Acode fixed bin(35); 169 170 dcl 171 (Idir, Ihunt, Istart_of_line) fixed bin, 172 Iparen_depth fixed bin, 173 Lfile fixed bin(21), 174 (Lparm, Lword) fixed bin, 175 (Ldcl_begin, Lindent, Ipos) fixed bin, 176 Nsearch_paths fixed bin, 177 (Pfile, Pparm, Pseg, Pword) ptr, 178 Semacs bit(1), 179 Serror_table bit(1), 180 bc fixed bin(24), 181 cleanup condition, 182 code fixed bin(35), 183 component char(32), 184 dir char(168), 185 ent char(32), 186 long char(100), 187 result char(2000) varying, 188 short char(8); 189 190 dcl 191 area area based(Parea), 192 file char(Lfile) based(Pfile), 193 file_ch (Lfile) char(1) based(Pfile), 194 parm char(Lparm) based(Pparm), 195 word char(Lword) based(Pword); 196 197 dcl (addr, addrel, before, codeptr, copy, divide, index, length, ltrim, mod, 198 null, ptr, rel, reverse, rtrim, search, substr, verify) 199 builtin; 200 201 dcl convert_status_code_ entry (fixed bin(35), char(8), char(100)), 202 expand_pathname_$component entry (char(*), char(*), char(*), char(*), fixed bin(35)), 203 get_system_free_area_ entry returns (ptr), 204 initiate_file_$component entry (char(*), char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35)), 205 search_paths_$get entry (char(*), bit(36), char(*), ptr, ptr, fixed bin, ptr, 206 fixed bin(35)), 207 terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35)); 208 209 dcl (error_table_$new_search_list, 210 error_table_$nodescr, 211 error_table_$no_search_list, 212 error_table_$zero_length_seg) fixed bin(35) ext static; 213 214 dcl 215 (FALSE init("0"b), 216 TRUE init("1"b)) bit(1) int static options(constant), 217 HT char(1) int static options(constant) init(" "), 218 HT_SP char(2) int static options(constant) init(" "), 219 HT_SP_NL char(3) int static options(constant) init(" 220 "), 221 NL char(1) int static options(constant) init(" 222 "), 223 Parea ptr int static init(null), 224 SP char(1) int static options(constant) init(" "); 225 226 227 228 229 230 231 232 233 COMMON: ret = ""; /* Initialize return values. */ 234 type = ""; 235 236 Pseg = null; /* Prepare for cleanup on unit. */ 237 sl_info_p = null; 238 239 on cleanup call janitor(); 240 result = ""; /* No result found so far. */ 241 242 if Parea = null then 243 Parea = get_system_free_area_(); 244 245 call search_paths_$get ("declare", sl_control_default, "", null(), 246 Parea, sl_info_version_1, sl_info_p, code); 247 if code = error_table_$no_search_list then 248 Nsearch_paths = 0; 249 else if code = error_table_$new_search_list | code = 0 then 250 Nsearch_paths = sl_info.num_paths; 251 else if code ^= 0 then go to ERROR; 252 253 if index (arg, "$") ^= 0 then do; /* is arg in form "frog_$frog_"? */ 254 if substr (arg, 1, index (arg, "$") - 1) = 255 substr (arg, index (arg, "$") + 1, length (rtrim (arg)) - index (arg, "$")) 256 then do Ihunt = index (arg, "$") to length (rtrim (arg)); 257 substr (arg, Ihunt, 1) = " "; /* clear "$frog_" */ 258 end; 259 end; 260 261 do Idir = 1 to Nsearch_paths while(result = ""); 262 /* In each segment identified in the search */ 263 dir, ent, component = ""; 264 call expand_pathname_$component (sl_info.paths(Idir).pathname, dir, ent, component, code); 265 call initiate_file_$component (dir, ent, component, R_ACCESS, Pseg, bc, code); 266 if Pseg ^= null then do; 267 Pfile = Pseg; /* Address the segment. */ 268 Lfile = divide(bc, 9, 24, 0); 269 do while(Lfile > 0 & result = ""); 270 Ihunt = index(file, rtrim(arg)); /* Make quick check to see if any hope at all */ 271 if Ihunt = 0 then /* of finding entry point dcl, or abbrev. */ 272 Lfile = 0; 273 else do; 274 Istart_of_line = index(reverse(substr(file,1,Ihunt-1)),NL); 275 if Istart_of_line > 0 then do;/* Address potential matching line. */ 276 Pfile = addr(file_ch(Ihunt-Istart_of_line+1)); 277 Lfile = Lfile - (Ihunt-Istart_of_line); 278 end; /* Toss away stuff preceding matching line. */ 279 call find_word_and_skip(); /* If first word on line names entry point or */ 280 if word_equal_arg () then do; /* abbrev we want, then EUREKA! */ 281 call skip_whitespace(); /* Skip whitespace following name. */ 282 result = rest_of_line(); /* Assume entry point dcl, make dcl the result. */ 283 call find_word_and_skip(); 284 if word = "==>" then /* But check for an EMACS abbrev. */ 285 if Semacs then do; /* If looking for EMACS abbrev's, we've found it. */ 286 type = "abbrev"; 287 error = "abbrev"; 288 call skip_whitespace(); 289 result = rest_of_line(); 290 end; 291 else result = ""; /* Other, continue looking since matching EMACS */ 292 end; /* abbrev does not signify end of search for */ 293 /* an entry point dcl. */ 294 call skip_line(); 295 end; 296 end; 297 call terminate_file_ (Pseg, 0, TERM_FILE_TERM, code); 298 Pseg = null; /* Done looking at this seg. */ 299 end; 300 end; 301 302 if result = "" then do; /* dcl or abbrev not found in dcl segs. */ 303 call get_entry_point_dcl_from_desc (rtrim(arg), result, Serror_table, code); 304 if code ^= 0 then do; /* Check the entry point descriptors. */ 305 ERROR: if Semacs then do; /* Be kind to emacs, do error code conversion. */ 306 call convert_status_code_ (code, short, long); 307 error = rtrim(long); 308 end; 309 else Acode = code; 310 end; 311 else if Semacs then do; /* Tell EMACS user how declaration was found. */ 312 if Serror_table then 313 error = "dcl error_table_ code"; 314 else do; 315 Pfile = addrel(addr(result),1); /* To do this, overlay result so we can use the */ 316 Lfile = length(result); /* find_word_and_skip primitive. */ 317 call find_word_and_skip(); 318 if word = "entry()" then /* entry() ==> all parm descriptors valid. */ 319 error = "dcl via parm descriptors"; 320 else if word = "entry" then do; 321 call find_word_and_skip(); 322 if word = "options(variable)" then 323 error = "no parm descriptors available"; 324 else error = "dcl via parm descriptors"; 325 end; 326 else error = "dcl via parm descriptors"; 327 end; 328 end; 329 end; 330 331 if result = "" then; 332 else if type = "abbrev" then /* Output abbrev's as they stand. */ 333 ret = result; 334 335 else if dcl_style = 0 then /* No formatting dcl style. */ 336 ret = result; 337 else do; /* Split non-abbrev's across lines, etc. */ 338 339 if dcl_style = 1 then do; /* dcl style used by indent. */ 340 Ipos = 6; 341 Ldcl_begin = Ipos + length(arg) + 1; 342 Lindent = 11; 343 end; 344 else do; /* dcl style used by Gary Dixon. */ 345 Ipos = 11; 346 Ldcl_begin = 41; 347 Lindent = 46; 348 end; 349 Ipos = Ipos + length(arg); /* Record current line position. */ 350 if Ipos >= Ldcl_begin then do; /* Entry point name already beyond the dcl */ 351 ret = ret || NL; /* indent column. Skip to next line. */ 352 Ipos = 1; 353 end; 354 if Ipos < Ldcl_begin then do; /* Skip out to dcl column. */ 355 ret = ret || whitespace_to_pos (Ldcl_begin); 356 Ipos = Ldcl_begin; 357 end; 358 if length(result) + Ipos <= line_length then 359 ret = ret || result; /* Handle simple case first. */ 360 else do; /* The dcl is too long to fit on one line. */ 361 Pfile = addrel(addr(result),1); /* Address the dcl. */ 362 Lfile = length(result); 363 Iparen_depth = 0; /* Prepare find_parm_and_skip for use. */ 364 do while (Lfile > 0); /* Add successive parameter descriptors to line */ 365 call find_parm_and_skip(); /* until they no longer fit. Then, skip */ 366 /* to next line. Continue until all of dcl */ 367 /* processed. */ 368 if Ipos + length(parm) <= line_length then do; 369 ret = ret || parm; 370 Ipos = Ipos + length(parm); 371 end; 372 else do; 373 ret = ret || NL; 374 Ipos = 1; 375 ret = ret || whitespace_to_pos(Lindent); 376 Ipos = Lindent; 377 ret = ret || ltrim(parm); 378 Ipos = Ipos + length(ltrim(parm)); 379 end; 380 end; 381 end; 382 end; 383 call janitor(); 384 return; 385 386 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 387 388 word_equal_arg: proc returns (bit (1)); /* special-case "frog_$frog_" */ 389 390 if index (word, "$") ^= 0 then 391 if substr (word, 1, index (word, "$") - 1) = 392 substr (word, index (word, "$") + 1, Lword - index (word, "$")) then 393 return (rtrim (arg) = substr (word, 1, index (word, "$") - 1 )); 394 395 return (rtrim (arg) = word); 396 397 end word_equal_arg; 398 399 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 400 401 402 find_parm_and_skip: /* Simple heuristic to find next parm desc. */ 403 proc; /* Parm ends with first , or ) not inside of (). */ 404 405 dcl (Idelim) fixed bin, 406 Sparm_not_found bit(1), 407 ch char(1); 408 409 Pparm = Pfile; 410 Lparm = 0; 411 Sparm_not_found = TRUE; 412 do while(Sparm_not_found); 413 Idelim = search(file,"(),"); 414 if Idelim = 0 then do; 415 Lparm = Lfile; 416 Lfile = 0; 417 Sparm_not_found = FALSE; 418 end; 419 else do; 420 ch = substr(file,Idelim); 421 if ch = "(" then 422 Iparen_depth = Iparen_depth + 1; 423 else if ch = ")" & Iparen_depth = 1 then do; 424 Iparen_depth = 0; 425 Sparm_not_found = FALSE; 426 end; 427 else if ch = ")" then 428 Iparen_depth = Iparen_depth - 1; 429 else if Iparen_depth = 1 then 430 Sparm_not_found = FALSE; 431 Lparm = Lparm + Idelim; 432 if Idelim = Lfile then 433 Lfile = 0; 434 else do; 435 Pfile = addr(file_ch(Idelim+1)); 436 Lfile = Lfile - Idelim; 437 end; 438 end; 439 end; 440 end find_parm_and_skip; 441 442 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 443 444 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 445 446 447 find_word_and_skip: 448 proc; 449 450 dcl Iwhite fixed bin; 451 452 Iwhite = verify (file, HT_SP); 453 if Iwhite = 0 then do; /* Remainder of file is whitespace. */ 454 Lfile = 0; 455 Pword = Pfile; 456 Lword = 0; 457 end; 458 else do; 459 if Iwhite > 1 then do; 460 Pfile = addr(file_ch(Iwhite)); 461 Lfile = Lfile - (Iwhite-1); 462 end; 463 Pword = Pfile; 464 Lword = search (file, HT_SP_NL); 465 if Lword = 0 then do; 466 Lword = Lfile; 467 Lfile = 0; 468 end; 469 else do; 470 Lword = Lword - 1; 471 Pfile = addr(file_ch(Lword+1)); 472 Lfile = Lfile - Lword; 473 end; 474 end; 475 476 end find_word_and_skip; 477 478 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 479 480 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 481 482 483 get_entry_point_dcl_from_desc: 484 proc (Aep_name, Aret, Serror_table, Acode); 485 486 dcl Aep_name char(*), /* Name of entry point to be declared. */ 487 Aret char(*) varying, /* Declaration of entry point. (Out) */ 488 Serror_table bit(1), /* On if entry point is an error table code. (Out)*/ 489 Acode fixed bin(35); /* Status code. */ 490 491 dcl Eproc entry variable options(variable), 492 Nproc_args fixed bin, 493 Pproc ptr, 494 Pproc_desc (100) ptr, 495 ec_Pproc ptr, 496 code fixed bin(35), 497 i fixed bin; 498 499 dcl Ppacked ptr unal based; 500 501 dcl cv_entry_ entry (char(*), ptr, fixed bin(35)) returns(entry), 502 cv_ptr_ entry (char(*), fixed bin(35)) returns(ptr), 503 cv_ptr_$terminate entry (ptr), 504 get_pl1_parm_desc_string_ entry (ptr, char(*) var, fixed bin(35)), 505 get_entry_arg_descs_$info entry (ptr, fixed bin, (*) ptr, ptr, fixed bin(35)); 506 507 edi.version = entry_desc_info_version_2; /* Get entry point parameter descriptors. */ 508 edi.object_ptr = null; 509 edi.bit_count = 0; 510 511 if index (Aep_name, "::") = 0 then do; /* non-archive component path... */ 512 Eproc = cv_entry_ (Aep_name, null(), Acode); /* Convert entry point name to entry constant. */ 513 if Acode ^= 0 then return; 514 Pproc = codeptr(Eproc); /* Turn entry constant into a ptr. */ 515 end; 516 else do; /* the archive component case... */ 517 Pproc = cv_ptr_ (Aep_name, Acode); /* no sense snapping links... */ 518 if Acode ^= 0 then return; 519 dir, ent, component = ""; 520 call expand_pathname_$component (before (Aep_name, "$"), dir, ent, component, Acode); 521 if Acode ^= 0 then return; 522 call initiate_file_$component (dir, ent, component, R_ACCESS, edi.object_ptr, edi.bit_count, Acode); 523 if edi.object_ptr = null then return; 524 end; 525 526 Aret = ""; 527 call get_entry_arg_descs_$info (Pproc, Nproc_args, Pproc_desc, addr(edi), Acode); 528 529 if Acode = error_table_$nodescr then do; 530 if index (Aep_name, "error_table_$") ^= 0 then do; 531 Aret = Aret || "fixed bin(35) ext static"; 532 Acode = 0; /* Check for error_table_ Acodes. */ 533 Serror_table = TRUE; 534 end; 535 536 else do; /* Handle no args case. */ 537 Acode = 0; 538 go to NO_ARGS; 539 end; 540 end; 541 542 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 543 /* */ 544 /* Hueristic for determining if entry point is in a non-system error table: */ 545 /* */ 546 /* Non-system error tables have messages in the text pointed to by error table codes */ 547 /* really packed pointers) which are stored in the linkage section for the error */ 548 /* table. At first reference to the table, the linker copies the linkage template for */ 549 /* the table into the combined_linkage area, and a first_ref trap proc gets invoked to */ 550 /* set the segment numbers in all of the packed pointers to the segno of the text */ 551 /* section. */ 552 /* */ 553 /* (1) get_entry_parm_descs_ returns error_table_$zero_length_seg for such beasties, */ 554 /* perhaps because they do not contain any entry points into their text section (ie, */ 555 /* all entry points are into the linkage section. */ 556 /* (2) For this return code, the call to cv_entry_ above will have returned a pointer to */ 557 /* the error code (packed ptr in the linkage section) corresponding to the error */ 558 /* table entry. This code points to the text of the error message. */ 559 /* (3) cv_ptr_ on the other hand, returns a pointer to the error code which appears in */ 560 /* the linkage section template (contained in the error table segment itself). */ 561 /* (4) Thus, it is reasonably safe to assume entry to be a non-system error table if: */ 562 /* baseno(cv_entry_(ep) -> packed_ptr) = baseno(cv_ptr_(ep)); */ 563 /* rel(cv_entry_(ep) -> packed_ptr) = rel(cv_ptr_(ep)); */ 564 /* The above conditions are prima facia evidence that a trap proc was invoked to */ 565 /* change the left half-word of the linkage template for the entry point to the */ 566 /* segment number. Only non-system error tables do this, to best of my knowledge. */ 567 /* */ 568 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 569 570 else if Acode = error_table_$zero_length_seg then do; 571 ec_Pproc = cv_ptr_ (Aep_name, code); 572 if ec_Pproc ^= null then do; 573 if Pproc -> Ppacked = ptr(ec_Pproc, rel(ec_Pproc -> Ppacked)) then do; 574 Aret = Aret || "fixed bin(35) ext static"; 575 Acode = 0; 576 Serror_table = TRUE; 577 end; 578 call cv_ptr_$terminate (ec_Pproc); 579 end; 580 else return; 581 end; 582 else if Acode ^= 0 then return; /* Diagnose unknown error. */ 583 else if Nproc_args = 0 then do; /* Check for no args. */ 584 NO_ARGS: if edi.flags.variable then /* Proc says it is options(variable), so */ 585 /* include entry() indicating we are sure. */ 586 Aret = Aret || "entry() options(variable)"; 587 else Aret = Aret || "entry options(variable)";/* Proc does not say options(variable), but */ 588 /* many commands/af do not have */ 589 /* options(variable) in their proc/entry stmt.*/ 590 end; /* So, use entry w/o () to indicate we're not */ 591 /* sure. */ 592 593 else do; /* Proc has declared args. */ 594 do i = 1 to Nproc_args while (Pproc_desc(i) = null); 595 end; /* Check for old procedure with declared arg */ 596 if i > Nproc_args then go to NO_ARGS; /* count, but no arg descriptors. */ 597 598 if Nproc_args = 1 & edi.flags.function then 599 Aret = Aret || "entry("; 600 else Aret = Aret || "entry ("; 601 602 if edi.flags.function then /* Check for functions. */ 603 Nproc_args = Nproc_args - 1; /* Exclude return arg from parm list. */ 604 605 do i = 1 to Nproc_args; /* Put parms in the parm list. */ 606 call get_pl1_parm_desc_string_ (Pproc_desc(i), Aret, Acode); 607 if Acode ^= 0 then return; 608 Aret = Aret || ", "; 609 end; 610 611 if Nproc_args > 0 then 612 Aret = substr(Aret, 1, length(Aret)-2); /* Remove trailing ", " after last arg. */ 613 if edi.flags.function then do; /* Handle function subcase. */ 614 Aret = Aret || ") returns("; 615 call get_pl1_parm_desc_string_ (Pproc_desc(i), Aret, Acode); 616 if Acode ^= 0 then return; 617 Aret = Aret || ")"; 618 end; 619 else do; /* Handle subroutine subcase. */ 620 if edi.flags.variable then do; /* Handle options(variable) subroutine. */ 621 Aret = Aret || ") options(variable)"; 622 end; 623 else Aret = Aret || ")"; 624 end; 625 end; 626 627 end get_entry_point_dcl_from_desc; 628 629 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 630 631 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 632 633 634 janitor: proc(); 635 636 if Pseg ^= null then do; 637 call terminate_file_ (Pseg, 0, TERM_FILE_TERM, code); 638 Pseg = null; 639 end; 640 if sl_info_p ^= null then 641 free sl_info in (area); 642 end; 643 644 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 645 646 647 rest_of_line: 648 proc() returns (char(*)); 649 650 dcl Inl fixed bin, 651 Lrest fixed bin, 652 Prest ptr, 653 rest char(Lrest) based(Prest); 654 655 Inl = index(file, NL); 656 if Inl = 0 then 657 Inl = Lfile + 1; 658 Prest = Pfile; 659 Lrest = Inl - 1; 660 return (rest); 661 662 end rest_of_line; 663 664 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 665 666 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 667 668 669 skip_line: 670 proc(); 671 672 dcl Inl fixed bin; 673 674 Inl = index(file, NL); 675 if Inl = 0 | Inl = Lfile then 676 Lfile = 0; 677 else do; 678 Pfile = addr(file_ch(Inl+1)); 679 Lfile = Lfile - Inl; 680 end; 681 682 end skip_line; 683 684 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 685 686 687 skip_whitespace: 688 proc; 689 690 dcl Iwhite fixed bin; 691 692 Iwhite = verify (file, HT_SP); 693 if Iwhite = 0 then 694 Lfile = 0; 695 else if Iwhite > 1 then do; 696 Pfile = addr(file_ch(Iwhite)); 697 Lfile = Lfile - (Iwhite-1); 698 end; 699 700 end skip_whitespace; 701 702 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 703 704 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 705 706 707 whitespace_to_pos: 708 proc (Inew_pos) returns(char(*)); 709 710 dcl Inew_pos fixed bin; 711 712 dcl (Ispace, Itab) fixed bin; 713 714 if Inew_pos <= Ipos then /* Already at or beyond desired position. */ 715 return (""); /* Do nothing. */ 716 else do; 717 Ispace = mod(Inew_pos-1, 10); 718 Itab = divide (Inew_pos - Ispace - Ipos + 9, 10, 17, 0); 719 if Itab = 0 then 720 Ispace = Inew_pos - Ipos; 721 return (copy(HT, Itab) || copy(SP, Ispace)); 722 end; 723 724 end whitespace_to_pos; 725 726 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * **/ 727 1 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 1 2* 1 3* Values for the "access mode" argument so often used in hardcore 1 4* James R. Davis 26 Jan 81 MCR 4844 1 5* Added constants for SM access 4/28/82 Jay Pattin 1 6* Added text strings 03/19/85 Chris Jones 1 7**/ 1 8 1 9 1 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 1 11 dcl ( 1 12 N_ACCESS init ("000"b), 1 13 R_ACCESS init ("100"b), 1 14 E_ACCESS init ("010"b), 1 15 W_ACCESS init ("001"b), 1 16 RE_ACCESS init ("110"b), 1 17 REW_ACCESS init ("111"b), 1 18 RW_ACCESS init ("101"b), 1 19 S_ACCESS init ("100"b), 1 20 M_ACCESS init ("010"b), 1 21 A_ACCESS init ("001"b), 1 22 SA_ACCESS init ("101"b), 1 23 SM_ACCESS init ("110"b), 1 24 SMA_ACCESS init ("111"b) 1 25 ) bit (3) internal static options (constant); 1 26 1 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 1 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 1 29 1 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 1 31 static options (constant); 1 32 1 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 1 34 static options (constant); 1 35 1 36 dcl ( 1 37 N_ACCESS_BIN init (00000b), 1 38 R_ACCESS_BIN init (01000b), 1 39 E_ACCESS_BIN init (00100b), 1 40 W_ACCESS_BIN init (00010b), 1 41 RW_ACCESS_BIN init (01010b), 1 42 RE_ACCESS_BIN init (01100b), 1 43 REW_ACCESS_BIN init (01110b), 1 44 S_ACCESS_BIN init (01000b), 1 45 M_ACCESS_BIN init (00010b), 1 46 A_ACCESS_BIN init (00001b), 1 47 SA_ACCESS_BIN init (01001b), 1 48 SM_ACCESS_BIN init (01010b), 1 49 SMA_ACCESS_BIN init (01011b) 1 50 ) fixed bin (5) internal static options (constant); 1 51 1 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 728 729 2 1 /* START OF: entry_desc_info.incl.pl1 * * * * * * * * * * * * * * * * */ 2 2 2 3 2 4 2 5 /****^ HISTORY COMMENTS: 2 6* 1) change(84-11-29,Ranzenbach), approve(86-03-12,MCR7144), 2 7* audit(86-03-12,GWMay), install(86-05-01,MR12.0-1051): 2 8* for version 2. This version allows the caller to specify a pointer to 2 9* the beginning of the offset and its bit count. This allows the 2 10* processing of archive components. 2 11* 2 12* NOTICE: 2 13* All applications which use this structure should be converted to 2 14* use version 2. Version 1 can be retained by setting the version to 2 15* a value of 1. The constant entry_desc_info_version_1 has been 2 16* removed from the file. 2 17* END HISTORY COMMENTS */ 2 18 2 19 2 20 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2 21 /* */ 2 22 /* Name: entry_desc_info.incl.pl1 */ 2 23 /* */ 2 24 /* This include file is used by get_entry_arg_desc_$info, $text_only_info and their */ 2 25 /* callers. It declares the flag bits obtained from the entry sequence of a procedure */ 2 26 /* entry point. */ 2 27 /* */ 2 28 /* Status */ 2 29 /* */ 2 30 /* 0) Created in May, 1979 by G. C. Dixon */ 2 31 /* */ 2 32 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2 33 2 34 dcl 1 entry_desc_info aligned based(entry_desc_info_ptr), 2 35 2 version fixed bin, /* version number of this structure (= 2) */ 2 36 2 flags, 2 37 2 38 (3 basic_indicator, /* on if this is a BASIC program. */ 2 39 3 revision_1, /* on if program entry has stuff added after 5/75 */ 2 40 3 has_descriptors, /* on if entry point had valid parm. descriptors */ 2 41 3 variable, /* on if entry point takes undefined no. of args */ 2 42 3 function) /* on if entry point is a function */ 2 43 bit(1) unaligned, 2 44 3 pad bit(13) unaligned, 2 45 /* version 2 fields follow */ 2 46 2 object_ptr ptr, /* -> beginning of object segment... (INPUT) */ 2 47 2 bit_count fixed bin (24); /* bit count of object... (INPUT) */ 2 48 2 49 dcl entry_desc_info_version_2 fixed bin int static options(constant) init(2), 2 50 entry_desc_info_ptr ptr; 2 51 2 52 /* END OF: entry_desc_info.incl.pl1 * * * * * * * * * * * * * * * * */ 730 731 732 dcl 1 edi aligned like entry_desc_info; 733 3 1 /* BEGIN INCLUDE FILE . . . sl_info.incl.pl1 */ 3 2 3 3 3 4 3 5 /****^ HISTORY COMMENTS: 3 6* 1) change(87-11-16,Lippard), approve(87-12-21,MCR7822), 3 7* audit(88-02-09,Blair), install(88-02-16,MR12.2-1023): 3 8* Modified to add INITIATED_SEGS type. 3 9* 2) change(87-11-19,Lippard), approve(87-12-21,MCR7822), 3 10* audit(88-02-09,Blair), install(88-02-16,MR12.2-1023): 3 11* Added uid to sl_info structure. 3 12* END HISTORY COMMENTS */ 3 13 3 14 3 15 declare 1 sl_info aligned based (sl_info_p), 3 16 2 version fixed binary, /* Must be 1 */ 3 17 2 num_paths fixed binary, /* Number of search paths */ 3 18 2 change_index_p pointer, /* Pointer to search list's update count */ 3 19 2 change_index fixed binary (71), /* This search list's update count */ 3 20 2 pad1 (6) bit (36), /* Must be zero */ 3 21 2 paths (sl_info_num_paths refer (sl_info.num_paths)), 3 22 3 type fixed binary, /* Type of search path */ 3 23 3 code fixed binary (35), /* Standard status code of search path */ 3 24 3 uid bit (36), /* Unique ID */ 3 25 3 pathname char (168) unaligned; /* Search pathname */ 3 26 3 27 declare sl_info_num_paths fixed binary; 3 28 declare sl_info_p pointer; 3 29 declare sl_info_version_1 fixed binary internal static options (constant) initial (1); 3 30 3 31 /* Keyword Types */ 3 32 3 33 declare ABSOLUTE_PATH fixed binary internal static options (constant) initial (0); 3 34 declare UNEXPANDED_PATH fixed binary internal static options (constant) initial (1); 3 35 declare REFERENCING_DIR fixed binary internal static options (constant) initial (3); 3 36 declare WORKING_DIR fixed binary internal static options (constant) initial (4); 3 37 declare PROCESS_DIR fixed binary internal static options (constant) initial (5); 3 38 declare HOME_DIR fixed binary internal static options (constant) initial (6); 3 39 declare INITIATED_SEGS fixed binary internal static options (constant) initial (7); 3 40 3 41 /* END INCLUDE FILE . . . sl_info.incl.pl1 */ 734 735 4 1 /* BEGIN INCLUDE FILE . . . sl_control_s.incl.pl1 */ 4 2 4 3 declare 1 sl_control_s unaligned based (addr (sl_control)), 4 4 2 af_pathname bit (1), /* "1"b => expand active functions */ 4 5 2 pad1 bit (1), /* Must be zero */ 4 6 2 key_ref_dir bit (1), /* "1"b => expand -referencing_dir keyword */ 4 7 2 key_work_dir bit (1), /* "1"b => expand -working_dir keyword */ 4 8 2 key_proc_dir bit (1), /* "1"b => expand -process_dir keyword */ 4 9 2 key_home_dir bit (1), /* "1"b => expand -home_dir keyword */ 4 10 2 pad2 bit (30); /* Must be zero */ 4 11 4 12 declare sl_control bit (36); 4 13 declare sl_control_default bit (36) internal static options (constant) initial ("101111"b); 4 14 4 15 /* END INCLUDE FILE . . . sl_control_s.incl.pl1 */ 736 737 5 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 5 2 /* format: style2,^inddcls,idind32 */ 5 3 5 4 declare 1 terminate_file_switches based, 5 5 2 truncate bit (1) unaligned, 5 6 2 set_bc bit (1) unaligned, 5 7 2 terminate bit (1) unaligned, 5 8 2 force_write bit (1) unaligned, 5 9 2 delete bit (1) unaligned; 5 10 5 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 5 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 5 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 5 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 5 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 5 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 5 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 5 18 5 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 738 739 740 end get_entry_point_dcl_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/19/88 0838.0 get_entry_point_dcl_.pl1 >spec>install>1040>get_entry_point_dcl_.pl1 728 1 04/11/85 1452.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.incl.pl1 730 2 05/01/86 0849.8 entry_desc_info.incl.pl1 >ldd>include>entry_desc_info.incl.pl1 734 3 02/18/88 2023.8 sl_info.incl.pl1 >ldd>include>sl_info.incl.pl1 736 4 01/09/79 1617.9 sl_control_s.incl.pl1 >ldd>include>sl_control_s.incl.pl1 738 5 04/06/83 1239.4 terminate_file.incl.pl1 >ldd>include>terminate_file.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. Acode parameter fixed bin(35,0) dcl 162 in procedure "get_entry_point_dcl_" set ref 144 148* 309* Acode parameter fixed bin(35,0) dcl 486 in procedure "get_entry_point_dcl_from_desc" set ref 483 512* 513 517* 518 520* 521 522* 527* 529 532* 537* 570 575* 582 606* 607 615* 616 Aep_name parameter char packed unaligned dcl 486 set ref 483 511 512* 517* 520 520 530 571* Aret parameter varying char dcl 486 set ref 483 526* 531* 531 574* 574 584* 584 587* 587 598* 598 600* 600 606* 608* 608 611* 611 611 614* 614 615* 617* 617 621* 621 623* 623 Eproc 000100 automatic entry variable dcl 491 set ref 512* 514 FALSE constant bit(1) initial packed unaligned dcl 214 ref 147 417 425 429 HT constant char(1) initial packed unaligned dcl 214 ref 721 HT_SP constant char(2) initial packed unaligned dcl 214 ref 452 692 HT_SP_NL 000002 constant char(3) initial packed unaligned dcl 214 ref 464 Idelim 001300 automatic fixed bin(17,0) dcl 405 set ref 413* 414 420 431 432 435 436 Idir 000100 automatic fixed bin(17,0) dcl 170 set ref 261* 264* Ihunt 000101 automatic fixed bin(17,0) dcl 170 set ref 254* 257* 270* 271 274 276 277 Inew_pos parameter fixed bin(17,0) dcl 710 ref 707 714 717 718 719 Inl 001322 automatic fixed bin(17,0) dcl 672 in procedure "skip_line" set ref 674* 675 675 678 679 Inl 000100 automatic fixed bin(17,0) dcl 650 in procedure "rest_of_line" set ref 655* 656 656* 659 Iparen_depth 000103 automatic fixed bin(17,0) dcl 170 set ref 363* 421* 421 423 424* 427* 427 429 Ipos 000111 automatic fixed bin(17,0) dcl 170 set ref 340* 341 345* 349* 349 350 352* 354 356* 358 368 370* 370 374* 376* 378* 378 714 718 719 Ispace 000100 automatic fixed bin(17,0) dcl 712 set ref 717* 718 719* 721 Istart_of_line 000102 automatic fixed bin(17,0) dcl 170 set ref 274* 275 276 277 Itab 000101 automatic fixed bin(17,0) dcl 712 set ref 718* 719 721 Iwhite 001332 automatic fixed bin(17,0) dcl 690 in procedure "skip_whitespace" set ref 692* 693 695 696 697 Iwhite 001312 automatic fixed bin(17,0) dcl 450 in procedure "find_word_and_skip" set ref 452* 453 459 460 461 Ldcl_begin 000107 automatic fixed bin(17,0) dcl 170 set ref 341* 346* 350 354 355* 356 Lfile 000104 automatic fixed bin(21,0) dcl 170 set ref 268* 269 270 271* 274 277* 277 316* 362* 364 413 415 416* 420 432 432* 436* 436 452 454* 461* 461 464 466 467* 472* 472 655 656 674 675 675* 679* 679 692 693* 697* 697 Lindent 000110 automatic fixed bin(17,0) dcl 170 set ref 342* 347* 375* 376 Lparm 000105 automatic fixed bin(17,0) dcl 170 set ref 368 369 370 377 378 410* 415* 431* 431 Lrest 000101 automatic fixed bin(17,0) dcl 650 set ref 659* 660 Lword 000106 automatic fixed bin(17,0) dcl 170 set ref 284 318 320 322 390 390 390 390 390 390 390 390 390 395 456* 464* 465 466* 470* 470 471 472 NL 004252 constant char(1) initial packed unaligned dcl 214 ref 274 351 373 655 674 Nproc_args 000104 automatic fixed bin(17,0) dcl 491 set ref 527* 583 594 596 598 602* 602 605 611 Nsearch_paths 000112 automatic fixed bin(17,0) dcl 170 set ref 247* 249* 261 Parea 000010 internal static pointer initial dcl 214 set ref 242 242* 245* 640 Pfile 000114 automatic pointer dcl 170 set ref 267* 270 274 276* 276 315* 361* 409 413 420 435* 435 452 455 460* 460 463 464 471* 471 655 658 674 678* 678 692 696* 696 Ppacked based pointer packed unaligned dcl 499 ref 573 573 Pparm 000116 automatic pointer dcl 170 set ref 368 369 370 377 378 409* Pproc 000106 automatic pointer dcl 491 set ref 514* 517* 527* 573 Pproc_desc 000110 automatic pointer array dcl 491 set ref 527* 594 606* 615* Prest 000102 automatic pointer dcl 650 set ref 658* 660 Pseg 000120 automatic pointer dcl 170 set ref 236* 265* 266 267 297* 298* 636 637* 638* Pword 000122 automatic pointer dcl 170 set ref 284 318 320 322 390 390 390 390 390 390 390 390 395 455* 463* R_ACCESS 000003 constant bit(3) initial packed unaligned dcl 1-11 set ref 265* 522* SP constant char(1) initial packed unaligned dcl 214 ref 721 Semacs 000124 automatic bit(1) packed unaligned dcl 170 set ref 147* 153* 284 305 311 Serror_table 000125 automatic bit(1) packed unaligned dcl 170 in procedure "get_entry_point_dcl_" set ref 303* 312 Serror_table parameter bit(1) packed unaligned dcl 486 in procedure "get_entry_point_dcl_from_desc" set ref 483 533* 576* Sparm_not_found 001301 automatic bit(1) packed unaligned dcl 405 set ref 411* 412 417* 425* 429* TERM_FILE_TERM 000000 constant bit(3) initial packed unaligned dcl 5-14 set ref 297* 637* TRUE 000003 constant bit(1) initial packed unaligned dcl 214 ref 153 411 533 576 addr builtin function dcl 197 ref 276 315 361 435 460 471 527 527 678 696 addrel builtin function dcl 197 ref 315 361 area based area(1024) dcl 190 ref 640 arg parameter char packed unaligned dcl 162 set ref 144 151 253 254 254 254 254 254 254 254 254 257* 270 303 303 341 349 390 395 bc 000126 automatic fixed bin(24,0) dcl 170 set ref 265* 268 before builtin function dcl 197 ref 520 520 bit_count 4 001252 automatic fixed bin(24,0) level 2 dcl 732 set ref 509* 522* ch 001302 automatic char(1) packed unaligned dcl 405 set ref 420* 421 423 427 cleanup 000130 stack reference condition dcl 170 ref 239 code 000136 automatic fixed bin(35,0) dcl 170 in procedure "get_entry_point_dcl_" set ref 245* 247 249 249 251 264* 265* 297* 303* 304 306* 309 637* code 000422 automatic fixed bin(35,0) dcl 491 in procedure "get_entry_point_dcl_from_desc" set ref 571* codeptr builtin function dcl 197 ref 514 component 000137 automatic char(32) packed unaligned dcl 170 set ref 263* 264* 265* 519* 520* 522* convert_status_code_ 000012 constant entry external dcl 201 ref 306 copy builtin function dcl 197 ref 721 721 cv_entry_ 000036 constant entry external dcl 501 ref 512 cv_ptr_ 000040 constant entry external dcl 501 ref 517 571 cv_ptr_$terminate 000042 constant entry external dcl 501 ref 578 dcl_style parameter fixed bin(17,0) dcl 162 ref 144 151 335 339 dir 000147 automatic char(168) packed unaligned dcl 170 set ref 263* 264* 265* 519* 520* 522* divide builtin function dcl 197 ref 268 718 ec_Pproc 000420 automatic pointer dcl 491 set ref 571* 572 573 573 578* edi 001252 automatic structure level 1 dcl 732 set ref 527 527 ent 000221 automatic char(32) packed unaligned dcl 170 set ref 263* 264* 265* 519* 520* 522* entry_desc_info based structure level 1 dcl 2-34 entry_desc_info_version_2 constant fixed bin(17,0) initial dcl 2-49 ref 507 error parameter varying char(100) dcl 162 set ref 151 154* 287* 307* 312* 318* 322* 324* 326* error_table_$new_search_list 000026 external static fixed bin(35,0) dcl 209 ref 249 error_table_$no_search_list 000032 external static fixed bin(35,0) dcl 209 ref 247 error_table_$nodescr 000030 external static fixed bin(35,0) dcl 209 ref 529 error_table_$zero_length_seg 000034 external static fixed bin(35,0) dcl 209 ref 570 expand_pathname_$component 000014 constant entry external dcl 201 ref 264 520 file based char packed unaligned dcl 190 ref 270 274 413 420 452 464 655 674 692 file_ch based char(1) array packed unaligned dcl 190 set ref 276 435 460 471 678 696 flags 1 001252 automatic structure level 2 dcl 732 function 1(04) 001252 automatic bit(1) level 3 packed packed unaligned dcl 732 set ref 598 602 613 get_entry_arg_descs_$info 000046 constant entry external dcl 501 ref 527 get_pl1_parm_desc_string_ 000044 constant entry external dcl 501 ref 606 615 get_system_free_area_ 000016 constant entry external dcl 201 ref 242 i 000423 automatic fixed bin(17,0) dcl 491 set ref 594* 594* 596 605* 606* 615 index builtin function dcl 197 ref 253 254 254 254 254 270 274 390 390 390 390 390 511 530 655 674 initiate_file_$component 000020 constant entry external dcl 201 ref 265 522 length builtin function dcl 197 ref 254 254 316 341 349 358 362 368 370 378 611 line_length parameter fixed bin(17,0) dcl 162 ref 144 151 358 368 long 000231 automatic char(100) packed unaligned dcl 170 set ref 306* 307 ltrim builtin function dcl 197 ref 377 378 mod builtin function dcl 197 ref 717 null builtin function dcl 197 ref 236 237 242 245 245 266 298 508 512 512 523 572 594 636 638 640 num_paths 1 based fixed bin(17,0) level 2 dcl 3-15 ref 249 640 object_ptr 2 001252 automatic pointer level 2 dcl 732 set ref 508* 522* 523 parm based char packed unaligned dcl 190 ref 368 369 370 377 378 pathname 17 based char(168) array level 3 packed packed unaligned dcl 3-15 set ref 264* paths 14 based structure array level 2 dcl 3-15 ptr builtin function dcl 197 ref 573 rel builtin function dcl 197 ref 573 rest based char packed unaligned dcl 650 ref 660 result 000262 automatic varying char(2000) dcl 170 set ref 240* 261 269 282* 289* 291* 302 303* 315 316 331 332 335 358 358 361 362 ret parameter varying char dcl 162 set ref 144 151 233* 332* 335* 351* 351 355* 355 358* 358 369* 369 373* 373 375* 375 377* 377 reverse builtin function dcl 197 ref 274 rtrim builtin function dcl 197 ref 254 254 270 303 303 307 390 395 search builtin function dcl 197 ref 413 464 search_paths_$get 000022 constant entry external dcl 201 ref 245 short 001250 automatic char(8) packed unaligned dcl 170 set ref 306* sl_control_default 000001 constant bit(36) initial packed unaligned dcl 4-13 set ref 245* sl_info based structure level 1 dcl 3-15 set ref 640 sl_info_p 001260 automatic pointer dcl 3-28 set ref 237* 245* 249 264 640 640 sl_info_version_1 000030 constant fixed bin(17,0) initial dcl 3-29 set ref 245* substr builtin function dcl 197 set ref 254 254 257* 274 390 390 390 420 611 terminate_file_ 000024 constant entry external dcl 201 ref 297 637 type parameter varying char(32) dcl 162 set ref 144 151 234* 286* 332 variable 1(03) 001252 automatic bit(1) level 3 packed packed unaligned dcl 732 set ref 584 620 verify builtin function dcl 197 ref 452 692 version 001252 automatic fixed bin(17,0) level 2 dcl 732 set ref 507* word based char packed unaligned dcl 190 ref 284 318 320 322 390 390 390 390 390 390 390 390 395 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ABSOLUTE_PATH internal static fixed bin(17,0) initial dcl 3-33 A_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-33 E_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 HOME_DIR internal static fixed bin(17,0) initial dcl 3-38 INITIATED_SEGS internal static fixed bin(17,0) initial dcl 3-39 M_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 N_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 PROCESS_DIR internal static fixed bin(17,0) initial dcl 3-37 REFERENCING_DIR internal static fixed bin(17,0) initial dcl 3-35 REW_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RE_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 RW_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 RW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array packed unaligned dcl 1-30 SMA_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 SM_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 S_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 TERM_FILE_BC internal static bit(2) initial packed unaligned dcl 5-12 TERM_FILE_DELETE internal static bit(5) initial packed unaligned dcl 5-17 TERM_FILE_FORCE_WRITE internal static bit(4) initial packed unaligned dcl 5-16 TERM_FILE_TRUNC internal static bit(1) initial packed unaligned dcl 5-11 TERM_FILE_TRUNC_BC internal static bit(2) initial packed unaligned dcl 5-13 TERM_FILE_TRUNC_BC_TERM internal static bit(3) initial packed unaligned dcl 5-15 UNEXPANDED_PATH internal static fixed bin(17,0) initial dcl 3-34 WORKING_DIR internal static fixed bin(17,0) initial dcl 3-36 W_ACCESS internal static bit(3) initial packed unaligned dcl 1-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 1-36 entry_desc_info_ptr automatic pointer dcl 2-49 sl_control automatic bit(36) packed unaligned dcl 4-12 sl_control_s based structure level 1 packed packed unaligned dcl 4-3 sl_info_num_paths automatic fixed bin(17,0) dcl 3-27 terminate_file_switches based structure level 1 packed packed unaligned dcl 5-4 NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 000242 constant label dcl 233 ref 149 155 ERROR 001124 constant label dcl 305 ref 251 NO_ARGS 002625 constant label dcl 584 ref 538 596 emacs 000214 constant entry external dcl 151 find_parm_and_skip 001745 constant entry internal dcl 402 ref 365 find_word_and_skip 002054 constant entry internal dcl 447 ref 279 283 317 321 get_entry_point_dcl_ 000162 constant entry external dcl 144 get_entry_point_dcl_from_desc 002144 constant entry internal dcl 483 ref 303 janitor 003152 constant entry internal dcl 634 ref 239 383 rest_of_line 003230 constant entry internal dcl 647 ref 282 289 skip_line 003267 constant entry internal dcl 669 ref 294 skip_whitespace 003316 constant entry internal dcl 687 ref 281 288 whitespace_to_pos 003352 constant entry internal dcl 707 ref 355 375 word_equal_arg 001634 constant entry internal dcl 388 ref 280 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4546 4616 4256 4556 Length 5132 4256 50 300 270 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME get_entry_point_dcl_ 788 external procedure is an external procedure. on unit on line 239 64 on unit word_equal_arg internal procedure shares stack frame of external procedure get_entry_point_dcl_. find_parm_and_skip internal procedure shares stack frame of external procedure get_entry_point_dcl_. find_word_and_skip internal procedure shares stack frame of external procedure get_entry_point_dcl_. get_entry_point_dcl_from_desc 354 internal procedure is called during a stack extension. janitor 84 internal procedure is called by several nonquick procedures. rest_of_line 68 internal procedure uses returns(char(*)) or returns(bit(*)). skip_line internal procedure shares stack frame of external procedure get_entry_point_dcl_. skip_whitespace internal procedure shares stack frame of external procedure get_entry_point_dcl_. whitespace_to_pos 70 internal procedure uses returns(char(*)) or returns(bit(*)). STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 Parea get_entry_point_dcl_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME get_entry_point_dcl_ 000100 Idir get_entry_point_dcl_ 000101 Ihunt get_entry_point_dcl_ 000102 Istart_of_line get_entry_point_dcl_ 000103 Iparen_depth get_entry_point_dcl_ 000104 Lfile get_entry_point_dcl_ 000105 Lparm get_entry_point_dcl_ 000106 Lword get_entry_point_dcl_ 000107 Ldcl_begin get_entry_point_dcl_ 000110 Lindent get_entry_point_dcl_ 000111 Ipos get_entry_point_dcl_ 000112 Nsearch_paths get_entry_point_dcl_ 000114 Pfile get_entry_point_dcl_ 000116 Pparm get_entry_point_dcl_ 000120 Pseg get_entry_point_dcl_ 000122 Pword get_entry_point_dcl_ 000124 Semacs get_entry_point_dcl_ 000125 Serror_table get_entry_point_dcl_ 000126 bc get_entry_point_dcl_ 000136 code get_entry_point_dcl_ 000137 component get_entry_point_dcl_ 000147 dir get_entry_point_dcl_ 000221 ent get_entry_point_dcl_ 000231 long get_entry_point_dcl_ 000262 result get_entry_point_dcl_ 001250 short get_entry_point_dcl_ 001252 edi get_entry_point_dcl_ 001260 sl_info_p get_entry_point_dcl_ 001300 Idelim find_parm_and_skip 001301 Sparm_not_found find_parm_and_skip 001302 ch find_parm_and_skip 001312 Iwhite find_word_and_skip 001322 Inl skip_line 001332 Iwhite skip_whitespace get_entry_point_dcl_from_desc 000100 Eproc get_entry_point_dcl_from_desc 000104 Nproc_args get_entry_point_dcl_from_desc 000106 Pproc get_entry_point_dcl_from_desc 000110 Pproc_desc get_entry_point_dcl_from_desc 000420 ec_Pproc get_entry_point_dcl_from_desc 000422 code get_entry_point_dcl_from_desc 000423 i get_entry_point_dcl_from_desc rest_of_line 000100 Inl rest_of_line 000101 Lrest rest_of_line 000102 Prest rest_of_line whitespace_to_pos 000100 Ispace whitespace_to_pos 000101 Itab whitespace_to_pos THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp unpk_to_pk cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return_mac mdfx1 enable_op shorten_stack ext_entry_desc int_entry int_entry_desc set_chars_eis index_chars_eis return_chars_eis op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. convert_status_code_ cv_entry_ cv_ptr_ cv_ptr_$terminate expand_pathname_$component get_entry_arg_descs_$info get_pl1_parm_desc_string_ get_system_free_area_ initiate_file_$component search_paths_$get terminate_file_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$new_search_list error_table_$no_search_list error_table_$nodescr error_table_$zero_length_seg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 144 000154 147 000202 148 000203 149 000205 151 000206 153 000234 154 000236 155 000241 233 000242 234 000245 236 000247 237 000251 239 000252 240 000274 242 000275 245 000310 247 000357 249 000365 251 000375 253 000376 254 000412 257 000451 258 000456 261 000460 263 000474 264 000505 265 000542 266 000602 267 000606 268 000610 269 000613 270 000623 271 000647 274 000652 275 000666 276 000667 277 000674 279 000677 280 000700 281 000705 282 000706 283 000732 284 000734 286 000744 287 000753 288 000761 289 000762 290 001006 291 001010 294 001011 296 001012 297 001013 298 001041 300 001043 302 001045 303 001052 304 001121 305 001124 306 001126 307 001141 308 001163 309 001164 310 001166 311 001167 312 001171 315 001204 316 001210 317 001212 318 001214 320 001232 321 001236 322 001237 324 001255 325 001264 326 001265 331 001274 332 001302 335 001323 339 001337 340 001341 341 001343 342 001346 343 001350 345 001351 346 001353 347 001355 349 001357 350 001361 351 001364 352 001374 354 001376 355 001400 356 001436 358 001441 361 001460 362 001464 363 001466 364 001467 365 001473 368 001474 369 001501 370 001515 371 001517 373 001520 374 001530 375 001532 376 001570 377 001573 378 001624 380 001626 383 001627 384 001633 388 001634 390 001636 395 001717 402 001745 409 001746 410 001750 411 001751 412 001753 413 001756 414 001772 415 001773 416 001775 417 001776 418 001777 420 002000 421 002011 423 002016 424 002023 425 002024 426 002025 427 002026 429 002033 431 002037 432 002041 435 002045 436 002050 439 002052 440 002053 447 002054 452 002055 453 002071 454 002072 455 002073 456 002074 457 002075 459 002076 460 002100 461 002104 463 002110 464 002112 465 002125 466 002126 467 002130 468 002131 470 002132 471 002134 472 002140 476 002142 483 002143 507 002164 508 002167 509 002171 511 002172 512 002206 513 002235 514 002240 515 002242 517 002243 518 002263 519 002266 520 002300 521 002346 522 002352 523 002413 526 002420 527 002423 529 002456 530 002463 531 002472 532 002505 533 002506 534 002512 537 002513 538 002514 540 002515 570 002516 571 002520 572 002541 573 002545 574 002566 575 002602 576 002603 578 002607 579 002616 580 002617 581 002620 582 002621 583 002623 584 002625 587 002646 590 002662 594 002663 595 002676 596 002700 598 002703 600 002731 602 002745 605 002751 606 002761 607 003005 608 003010 609 003023 611 003025 613 003037 614 003043 615 003057 616 003103 617 003106 618 003116 620 003117 621 003122 622 003136 623 003137 627 003150 634 003151 636 003157 637 003164 638 003211 640 003214 642 003226 647 003227 655 003235 656 003251 658 003255 659 003256 660 003260 669 003267 674 003270 675 003303 678 003310 679 003313 682 003315 687 003316 692 003317 693 003333 695 003336 696 003340 697 003344 700 003350 707 003351 714 003357 717 003374 718 003400 719 003406 721 003412 ----------------------------------------------------------- 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