COMPILATION LISTING OF SEGMENT library_descriptor_compiler Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 03/17/86 1455.0 mst Mon Options: optimize map 1 2 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 4 /* */ 5 /* COMPILED OUTPUT OF SEGMENT library_descriptor_compiler.rd */ 6 /* Compiled by: reduction_compiler, Version 2.5 of Oct 21, 1985 */ 7 /* Compiled on: 03/17/86 1455.0 mst Mon */ 8 /* */ 9 /* * * * * * * * * * * * * * * * * * * * * * * */ 10 11 /* *********************************************************** 12* * * 13* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 14* * * 15* * Copyright (c) 1972 by Massachusetts Institute of * 16* * Technology and Honeywell Information Systems, Inc. * 17* * * 18* *********************************************************** */ 19 20 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 21 /* */ 22 /* Name: library_descriptor_compiler, ldc */ 23 /* */ 24 /* This command accepts as input a library descriptor source segment, and creates */ 25 /* as output an ALM segment which can be compiled into a binary data base which is a */ 26 /* library descriptor segment. This data base is used by the library_info, library_map, */ 27 /* and library_print commands (among others), and is part of the Multics Library */ 28 /* Maintenance System. */ 29 /* */ 30 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 31 32 33 /* HISTORY COMMENTS: 34* 1) change(74-07-04,GDixon), approve(), audit(), 35* install(86-03-17,MR12.0-1032): 36* Version 1.0-- 37* Created initial version of the program. 38* 2) change(75-02-28,GDixon), approve(), audit(), 39* install(86-03-17,MR12.0-1032): 40* Version 2.0-- 41* Remove Global keywords; make root keyword more flexible; 42* rename it to Root 43* 3) change(75-12-01,GDixon), approve(), audit(), 44* install(86-03-17,MR12.0-1032): 45* Version 2.1-- 46* a) Change 'Define: default value;' stmt to 'Define: commands;'. 47* b) Make commands unsupported unless named explicitly 48* in 'Define:commands;' stmt. 49* c) Accept the singular keywords, 'library name' and 'search name'. 50* 4) change(76-05-25,GDixon), approve(), audit(), 51* install(86-03-17,MR12.0-1032): 52* Version 3.0-- 53* Reorganize name structures contained in library descriptor to put the 54* names for each entity into a separate, self-defining structure. 55* 5) change(77-01-17,GDixon), approve(), audit(), 56* install(86-03-17,MR12.0-1032): 57* Version 3.1-- 58* Insure that the ALM labels chosen to link root definitions with root 59* names are unique for each root. 60* 6) change(84-09-08,GDixon), approve(), audit(), 61* install(86-03-17,MR12.0-1032): 62* Version 3.2-- 63* a) accommodate change to lex_string_ handling of quoted strings by adding 64* the relative syntax function to replace an absolute 65* syntax function of "". 66* b) add support for per-process date/time format in header comment of the 67* compiled library descriptor. 68* 7) change(86-01-14,GDixon), approve(86-02-06,MCR7336), 69* audit(86-02-11,Dickson), install(86-02-11,MR12.0-1015): 70* Version 3.3-- 71* corrects a bug which prevents library root names from having 72* more than two components. 73* END HISTORY COMMENTS */ 74 75 76 /*++ 77*BEGIN / Descriptor : ; / LEX(2) [obj_desc.name = token_value] LEX(2) 78* descriptor_begin / descriptor_body \ 79*2 / Descriptor / ERROR(1) descriptor_begin NEXT_STMT / BEGIN \ 80*3 / / ERROR(2) / stop \ 81*4 / / ERROR(3) descriptor_begin / \ 82* 83*descriptor_body 84*5 / Root : / LEX(2) root_begin PUSH(root_body) / names \ 85*6 / Root / ERROR(4) NEXT_STMT root_begin / root_body \ 86*7 / Define : commands ; / [Icommand = 0] NEXT_STMT / command_block \ 87*8 / Define : / ERROR(7) NEXT_STMT / descriptor_body \ 88*9 / Define / ERROR(1) NEXT_STMT / descriptor_body \ 89*10 / End : ; / NEXT_STMT / end \ 90*11 / End : ; / ERROR(6) NEXT_STMT / end \ 91*12 / End / ERROR(1) NEXT_STMT / end \ 92*13 / / ERROR(8) NEXT_STMT / descriptor_body \ 93*14 / / ERROR(9) / stop \ 94* 95*names / ; / LEX / STACK_POP \ 96*16 / ( / new_element(Pfirst_name_elements) LEX / name_elements \ 97*17 / ( / new_element(Pfirst_name_elements) LEX / name_elements \ 98*18 / / set_name LEX / names \ 99*19 / / ERROR(12) LEX / names \ 100*20 / / ERROR(13) / stop \ 101* 102*name_elements 103*21 / ) . ( / new_element(name_elements.Pnext) LEX(3) / name_elements \ 104*22 / ) . ( / new_element(name_elements.Pnext) LEX(3) / name_elements \ 105*23 / ) / combine_elements(Pfirst_name_elements,"") 106* [Pname = addr(obj_root_name)] LEX / names \ 107*24 / ; / combine_elements(Pfirst_name_elements,"") 108* ERROR(11) [Pname = addr(obj_root_name)] LEX / STACK_POP \ 109*25 / / set_element LEX / name_elements \ 110*26 / / set_element LEX / name_elements \ 111*27 / / ERROR(12) LEX / name_elements \ 112*28 / / ERROR(13) / stop \ 113* 114*root_body / path : ; / LEX(2) [obj_root.path = token_value] LEX(2) / root_body \ 115*30 / path : ; / ERROR(15) NEXT_STMT / root_body \ 116*31 / path / ERROR(1) NEXT_STMT / root_body \ 117*32 / type : archive ; / LEX(4) [obj_root.type = Tarchive] / root_body \ 118*33 / type : directory ; / LEX(4) / root_body \ 119*34 / type : / LEX(2) ERROR(38) NEXT_STMT / root_body \ 120*35 / type / ERROR(1) NEXT_STMT / root_body \ 121*36 / search procedure : ; / LEX(3) [search_proc.ename = ename] 122* LEX(2) / root_body \ 123*37 / search procedure : ; / ERROR(5) NEXT_STMT / root_body \ 124*38 / search / ERROR(1) NEXT_STMT / root_body \ 125*39 / / root_end / descriptor_body \ 126*40 / / ERROR(9) / stop \ 127* 128*command_block 129*41 / command : ; / LEX(4) [Scommand = "1"b] command_begin / default_value \ 130*42 / unsupported command : ; 131* / LEX(5) [Scommand = "0"b] command_begin / command_block \ 132*43 / library / ERROR(35) NEXT_STMT / command_block \ 133*44 / search / ERROR(36) NEXT_STMT / command_block \ 134*45 / command : ; / LEX(2) ERROR(25) NEXT_STMT / command_block \ 135*46 / unsupported command : ; / LEX(3) ERROR(25) NEXT_STMT / command_block \ 136*47 / / / descriptor_body \ 137*48 / / ERROR(9) / stop \ 138* 139*default_value 140*49 / library names : / / library_names \ 141*50 / library name : / / library_names \ 142*51 / search names : / / search_names \ 143*52 / search name : / / search_names \ 144*53 / / command_end / command_block \ 145*54 / / / command_block \ 146*library_names 147*55 / / [Pname = addr(obj_dflt_lib_names)] 148* [Pobj_star_code = addr(obj_dflt_lib_codes)] 149* LEX(3) PUSH(default_value) / starname \ 150*search_names 151*56 / / [Pname = addr(obj_dflt_search_names)] 152* [Pobj_star_code = addr(obj_dflt_search_codes)] 153* LEX(3) PUSH(default_value) / starname \ 154* 155*starnames / ; / LEX / STACK_POP \ 156*starname / / set_name set_obj_star_code LEX / starnames \ 157*59 / ; / ERROR(10) NEXT_STMT / STACK_POP \ 158*60 / / ERROR(12) LEX / starnames \ 159*61 / / ERROR(13) / STACK_POP \ 160* 161*end / / / stop \ 162*63 / / ERROR(17) / stop \ 163* 164*stop / / compile_descriptor / RETURN \ 165* ++*/ 166 167 library_descriptor_compiler: 168 ldc: procedure; 169 170 dcl /* automatic variables */ 171 Icommand fixed bin, /* index of the command in command default values */ 172 /* struc. */ 173 Larg fixed bin, /* length of an input argument. */ 174 Lin fixed bin(21), /* length of input segment (in chars). */ 175 Lout fixed bin(21), /* length of output segment (in chars). */ 176 Nargs fixed bin, /* number of input arguments. */ 177 /* to definition of root just being parsed. */ 178 Pacl_out ptr, /* ptr to ACL struc for output segment. */ 179 Parg ptr, /* ptr to an input argument. */ 180 Pfirst_name_elements ptr, /* ptr to the first name elements structure. */ 181 Pin ptr, /* ptr to the input segment. */ 182 Pname ptr, /* ptr to the current name structure. */ 183 /* the library names struc, when forming */ 184 /* full names assoc with current root. */ 185 Pname_elements ptr, /* ptr to current name elements structure. */ 186 Pobj_dflt_lib_codes ptr, /* ptr to the object default library starcodes. */ 187 Pobj_dflt_lib_names ptr, /* ptr to the object default library names struc. */ 188 Pobj_dflt_search_codes ptr, /* ptr to the object default search starcodes. */ 189 Pobj_dflt_search_names ptr, /* ptr to the object default search names struc. */ 190 Pobj_root ptr, /* ptr to the current object root struc. */ 191 Pobj_root_array ptr, /* ptr to the object root struc. */ 192 Pobj_root_name ptr, /* ptr to the object root names struc. */ 193 Pobj_search_proc ptr, /* ptr to the object search procedure struc. */ 194 Pobj_star_code ptr, /* ptr to the current object star code struc. */ 195 Pout ptr, /* ptr to the output segment. */ 196 Ptemp_seg ptr, /* ptr to our temporary segment. */ 197 Scommand bit(1) aligned, /* switch: on if command indicated by Icommand is */ 198 /* "supported" in object command default values*/ 199 Sreject_root bit(1) aligned, /* switch: on if root definition is to be rejected*/ 200 bc_in fixed bin(24), /* length of input segment (in bits). */ 201 cleanup condition, 202 code fixed bin(35), /* a status code. */ 203 compilation_date char(52), /* date/time output segment was compiled. */ 204 dir_in char(168), /* dir part of path name of input segment. */ 205 dir_out char(168), /* dir part of path name of output segment. */ 206 ent_in char(32), /* ent part of path name of input segment. */ 207 ent_out char(32), /* ent part of path name of output segment. */ 208 entry_point char(70), /* an ALM format entry point name. */ 209 entry_point_name char(65) varying, /* a PL/I format entry point name. */ 210 1 ename aligned, /* current entry point name. */ 211 2 ref char(32), /* reference name */ 212 2 ent char(32), /* entry name */ 213 (i, j, k) fixed bin, /* do-group indices. */ 214 215 1 obj_command_dflt_values (dimension (command_name,1)) 216 aligned, /* object command default values structure. */ 217 2 S unaligned, /* switches: */ 218 3 supported bit(1), /* this command is supported. */ 219 2 lib_names, /* library names to be used if none specified. */ 220 3 Ifirst fixed bin, 221 3 Ilast fixed bin, /* indices of first/last name in table. */ 222 2 search_names, /* search names to be used if none specified. */ 223 3 Ifirst fixed bin, 224 3 Ilast fixed bin, 225 1 obj_desc, /* object descriptor. */ 226 2 name char(32) init ("default_descriptor"), 227 path char(168) aligned, /* a path name temporary. */ 228 1 search_proc aligned, /* struc for the local search procedure. */ 229 2 ename, 230 3 ref char(32), /* reference name of search proc entry point. */ 231 3 ent char(32), /* entry name of search proc entry point. */ 232 starcode fixed bin(35), /* return code from check_star_name_$entry. */ 233 temp_name char(32), /* a name temporary. */ 234 temp_name30 char(30) varying; /* another name temporary. */ 235 236 dcl /* based variables */ 237 arg char(Larg) based (Parg), 238 /* an input argument. */ 239 1 name aligned based (Pname), 240 /* the name structure. */ 241 2 M fixed bin, /* maximum number of names struc will hold. */ 242 2 N fixed bin, /* current number of names in struc. */ 243 2 ERROR fixed bin, /* error message to print when struc overflows.*/ 244 2 V (0 refer (name.N)) char(32) varying aligned, 245 /* array of names. */ 246 1 name_elements aligned based (Pname_elements), 247 /* temp storage for elements of a compound name. */ 248 2 header, 249 3 Pnext ptr, /* ptr to next name element structure. */ 250 3 M fixed bin, /* maximum number of names struc will hold. */ 251 3 N fixed bin, /* current number of names in struc. */ 252 3 ERROR fixed bin, /* error message to print when struc overflows*/ 253 2 V (50 refer (name_elements.N)) 254 char(32) varying, /* array of name elements. */ 255 1 obj_dflt_lib_codes aligned based (Pobj_dflt_lib_codes), 256 /* return codes from check_star_name_$entry for */ 257 /* names on a 'library names' statement in a */ 258 /* 'Define: commands;' block. */ 259 2 M fixed bin, /* maximum no of codes structure will hold. */ 260 2 N fixed bin, /* current no of codes in structure. */ 261 2 C (100 refer (obj_dflt_lib_codes.M)) 262 fixed bin, /* array of codes. */ 263 1 obj_dflt_lib_names aligned based (Pobj_dflt_lib_names), 264 /* names on a 'library names' statement in a */ 265 /* 'Define: commands;' block. */ 266 2 M fixed bin, /* maximum no of names structure will hold. */ 267 2 N fixed bin, /* current no of names in structure. */ 268 2 ERROR fixed bin, /* error message to print when struc overflows.*/ 269 2 V (100 refer (obj_dflt_lib_names.M)) 270 char(32) varying, /* array of names. */ 271 272 1 obj_dflt_search_codes aligned based (Pobj_dflt_search_codes), 273 /* return codes from check_star_name_$entry for */ 274 /* names on a 'search names' statement in a */ 275 /* 'Define: commands;' block. */ 276 2 M fixed bin, /* maximum no of codes structure will hold. */ 277 2 N fixed bin, /* current no of codes in structure. */ 278 2 C (100 refer (obj_dflt_search_codes.M)) 279 fixed bin, /* array of codes. */ 280 1 obj_dflt_search_names aligned based (Pobj_dflt_search_names), 281 /* names on a 'search names' statement. */ 282 2 M fixed bin, /* maximum no of names structure will hold. */ 283 2 N fixed bin, /* current no of names in structure. */ 284 2 ERROR fixed bin, /* error message to print when struc overflows.*/ 285 2 V (100 refer (obj_dflt_search_names.M)) 286 char(32) varying, /* array of names. */ 287 1 obj_root aligned based (Pobj_root), 288 /* object root definition structure. */ 289 2 name, /* root names: */ 290 3 Ifirst fixed bin, /* index of first name in list. */ 291 3 Ilast fixed bin, /* index of last name in object root names. */ 292 3 label char(30) varying, /* ALM label used to reference root names. */ 293 2 path char(168) varying, /* path name of defined root. */ 294 2 search_proc, /* entry point of procedure for searching root.*/ 295 3 I fixed bin, /* index of search procedure in obj table. */ 296 2 type fixed bin, /* root type. 2 = directory, 4 = archive */ 297 2 Pstmt ptr, /* ptr to root statement's descriptor. */ 298 1 obj_root_array aligned based (Pobj_root_array), 299 /* array of object root definition structures. */ 300 2 M fixed bin, /* maximum number of root definitions which */ 301 /* the struc will hold. */ 302 2 N fixed bin, /* the current number of root definitions. */ 303 2 obj_root (100 refer (obj_root_array.M)) /* the root definition structures. */ 304 like obj_root, 305 1 obj_root_name aligned based (Pobj_root_name), 306 /* full names of all of the roots defined so far. */ 307 2 M fixed bin, /* maximum number of names struc will hold. */ 308 2 N fixed bin, /* current number of names in structure. */ 309 2 ERROR fixed bin, /* error message to print when struc overflows.*/ 310 2 V (5000 refer (obj_root_name.M)) 311 char(32) varying, /* array of names. */ 312 1 obj_search_proc aligned based (Pobj_search_proc), 313 /* entry points on the 'search procedure' stmt */ 314 /* of a root definition. */ 315 2 M fixed bin, /* maximum no. of entry points struc will hold.*/ 316 2 N fixed bin, /* current no of entry points in struc. */ 317 2 ename (30 refer (obj_search_proc.M)), /* array of entry point names. */ 318 3 ref char(32), /* reference name part of entry point name. */ 319 3 ent char(32), /* entry part of entry point name. */ 320 1 obj_star_code aligned based (Pobj_star_code), 321 /* the star code structure. */ 322 2 M fixed bin, /* maximum no of codes structure will hold. */ 323 2 N fixed bin, /* current no of codes in structure. */ 324 2 C (0 refer (obj_star_code.N)) 325 fixed bin(35), /* array of codes. */ 326 out char(Lout) based (Pout), 327 /* overlay for the _r_e_m_a_i_n_d_e_r of the output segment*/ 328 stmt_array (stmt.Lvalue) char(1) based (stmt.Pvalue), 329 /* character array overlay for stmt_value. */ 330 stmt_part char(j) based (stmt.Pvalue); 331 /* partial overlay for stmt_value. */ 332 333 dcl (addr, addrel, dimension, divide, index, length, null, search, size, substr, verify) 334 builtin; 335 336 dcl /* entries */ 337 backup_name_ entry (char(*)) returns (char(32)), 338 check_star_name_$entry entry (char(*), fixed bin(35)), 339 check_star_name_$path entry (char(*), fixed bin(35)), 340 clock_ entry returns (fixed bin(71)), 341 com_err_ entry options(variable), 342 cu_$arg_count entry returns (fixed bin), 343 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin(35)), 344 date_time_$format entry (char(*), fixed bin(71), char(*), char(*)) returns(char(250) var), 345 decode_entryname_ entry (char(*), char(32) aligned, char(32) aligned), 346 expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin(35)), 347 get_wdir_ entry returns (char(168) aligned), 348 hcs_$truncate_seg entry (ptr, fixed bin, fixed bin(35)), 349 initiate_file_ entry (char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35)), 350 lex_string_$lex entry (ptr, fixed bin(21), fixed bin(21), ptr, bit(*) aligned, 351 char(*) aligned, char(*) aligned, char(*) aligned, char(*) aligned, 352 char(*) aligned, char(*) aligned varying, char(*) aligned varying, 353 char(*) aligned varying, char(*) aligned varying, 354 ptr, ptr, fixed bin(35)), 355 lex_string_$init_lex_delims entry (char(*) aligned, char(*) aligned, char(*) aligned, char(*) aligned, 356 char(*) aligned, bit(*) aligned, char(*) aligned varying, 357 char(*) aligned varying, char(*) aligned varying, 358 char(*) aligned varying), 359 lex_error_ entry options(variable), 360 suffixed_name_$make entry (char(*), char(*), char(32), fixed bin(35)), 361 suffixed_name_$new_suffix entry (char(*), char(*), char(*), char(32), fixed bin(35)), 362 terminate_file_ entry (ptr, fixed bin(24), bit(*), fixed bin(35)), 363 translator_temp_$get_segment entry (char(*), ptr, fixed bin(35)), 364 translator_temp_$release_all_segments 365 entry (ptr, fixed bin(35)), 366 tssi_$clean_up_segment entry (ptr), 367 tssi_$finish_segment entry (ptr, fixed bin(35), bit(36) aligned, ptr, fixed bin(35)), 368 tssi_$get_segment entry (char(*), char(*), ptr, ptr, fixed bin(35)); 369 370 dcl /* static variables */ 371 MLout fixed bin(21) int static init (0), 372 /* maximum length of an output segment (in chars).*/ 373 NL char(1) int static options(constant) init (" 374 "), 375 NP char(1) int static options(constant) init (" "), 376 /* a new-page character. */ 377 breaks char(7) varying aligned int static options(constant) init (" :() 378 "), /* SP HT : ( ) NL NP */ 379 /* list of break characters. */ 380 (error_table_$badopt, 381 error_table_$fatal_error, 382 error_table_$noentry, 383 error_table_$no_makeknown, 384 error_table_$wrong_no_of_args) 385 fixed bin(35) ext static, 386 ignored_breaks char(4) varying aligned int static options(constant) init (" 387 "), /* SP HT NL NP */ 388 /* list of ignored break characters. */ 389 lex_control_chars char(128) varying aligned int static, 390 lex_delims char(128) varying aligned int static init (""), 391 /* lex_string_ control information. */ 392 proc char(32) aligned int static options(constant) 393 init ("library_descriptor_compiler"), 394 ring_no pic "9" int static init(8), 395 /* current ring number. */ 396 sys_info$max_seg_size fixed bin(35) ext static; 397 398 dcl 1 error_control_table (38) aligned int static options(constant), 399 /* error message text and specifications. */ 400 /* 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 */ 401 /*16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 */ 402 /*31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 */ 403 2 severity fixed bin(17) unaligned init ( 404 2, 3, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 405 2, 2, 2, 2, 4, 2, 2, 2, 2, 2, 4, 2, 2, 2, 2, 406 2, 3, 4, 4, 2, 2, 3, 2), 407 2 Soutput_stmt bit(1) unaligned init ( 408 "1"b, "0"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "0"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 409 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, 410 "1"b, "0"b, "1"b, "0"b, "1"b, "1"b, "0"b, "1"b), 411 2 message char(252) varying init ( 412 /* 1 */ 413 "A '^a' statement has an invalid format. The statement has been 414 ignored.", 415 /* 2 */ 416 "There are no statements in the library descriptor source segment.", 417 /* 3 */ 418 "The first statement is not a 'Descriptor' statement. A name of 419 default_descriptor has been assumed.", 420 /* 4 */ 421 "A '^a' statement has an invalid format. A ^a statement 422 without a name list has been assumed.", 423 /* 5 */ 424 "An invalid entry name has been given in a '^a' 425 statement. The statement has been ignored.", 426 /* 6 */ 427 "The name used in the 'Descriptor' statement was not used in 428 the 'End' statement. The proper name has been assumed.", 429 /* 7 */ 430 "A 'Define' statement contains an invalid keyword. Only 431 'Define: commands;' may be given. The statement has been ignored.", 432 /* 8 */ 433 "An unknown or misplaced statement has been encountered. 434 It has been ignored.", 435 /* 9 */ 436 "The final 'End' statement is missing from the library descriptor 437 source. One has been assumed.", 438 /* 10 */ 439 "A name list ends when a name is expected.", 440 /* 11 */ 441 "A Root name list ends when a right parenthesis ()) is expected. 442 The list will be processed as if the parenthesis were present.", 443 /* 12 */ 444 "An invalid name, '^a', has been encountered in a name list. 445 It has been ignored.", 446 /* 13 */ 447 "The library descriptor source ends in the middle of a statement. 448 Also, it does not end with an 'End' statement.", 449 /* 14 */ 450 "An unexpected string, '^a', was found in a list when a comma (,), 451 or a semi-colon (;) was expected. The remainder of the list 452 has been ignored.", 453 /* 15 */ 454 "An invalid absolute path name was specified in a '^a' statement. 455 The statement will be ignored.", 456 /* 16 */ 457 "", 458 /* 17 */ 459 "Symbols appear after the 'End' statement. These symbols 460 will be ignored.", 461 /* 18 */ 462 "Restriction: only ^d library names can be specified after 463 a 'Define: commands;' statement. Name '^a' has been ignored.", 464 /* 19 */ 465 "Restriction: only ^d search names can be specified after 466 a 'Define: commands;' statement. Search name '^a' has been ignored.", 467 /* 20 */ 468 "Restriction: the total number of library root names 469 cannot exceed ^d. Name '^a' and all root names which 470 follow are in excess of this number.", 471 /* 21 */ 472 "Restriction: only ^d elements of a compound root name 473 may be defined. Name element '^a' has been ignored.", 474 /* 22 */ 475 "", 476 /* 23 */ 477 "Restriction: only ^d names can be defined for 478 the roots of the library. Name '^a' has been ignored.", 479 /* 24 */ 480 "", 481 /* 25 */ 482 "'^a' is an invalid command name. This statement has been 483 ignored.", 484 /* 26 */ 485 "Restriction: only ^d roots can be defined. The following 486 root definition, and any which follow it, are in excess of 487 this number.", 488 /* 27 */ 489 "No '^a' statement was given in the definition of a root. 490 The root definition has been ignored.", 491 /* 28 */ 492 "No '^a' statement was given in the definition of a root. 493 The definition has been ignored.", 494 /* 29 */ 495 "A full root name is longer than 32 characters. Full name 496 '^a' will be ignored.", 497 /* 30 */ 498 "A full root name formed from a library name and a name on 499 the root statement has already been specified for another 500 root. The name '^a' will be ignored.", 501 /* 31 */ 502 "No legal full root names were defined for a root. The root 503 definition will be ignored.", 504 /* 32 */ 505 "The library descriptor source does not end with a complete 506 statement.", 507 /* 33 */ 508 "Restriction: only ^d unique search procedures can be defined. 509 Search procedure '^a$^a' has been ignored.", 510 /* 34 */ 511 "Restriction: the library descriptor is too large, causing 512 the output segment to overflow.", 513 /* 35 */ 514 "A 'library names' statement appears after a 'Define: commands;' 515 statement, but before a 'command' or 'unsupported command' 516 statement. The 'library names' statement has been ignored.", 517 /* 36 */ 518 "A 'search names' statement appears after a 'Define: commands;' 519 statement, but before a 'command' or 'unsupported command' 520 statement. The 'search names' statement has been ignored.", 521 /* 37 */ 522 "No legal root definitions appear in the library descriptor 523 source segment.", 524 /* 38 */ 525 "An invalid root type '^a' appears in the 'type' statement 526 of a root definition. A type of directory has been assumed."), 527 2 brief_message char(40) varying init ( 528 /* 1 */ 529 "Bad '^a' stmt ignored.", 530 /* 2 */ 531 "No source stmts.", 532 /* 3 */ 533 "'Descriptor' stmt missing.", 534 /* 4 */ 535 "Bad '^a' stmt.", 536 /* 5 */ 537 "Bad entry name ignored.", 538 /* 6 */ 539 "Bad name in 'End' stmt.", 540 /* 7 */ 541 "Bad 'Define' keyword ignored.", 542 /* 8 */ 543 "Bad stmt.", 544 /* 9 */ 545 "'End' stmt missing.", 546 /* 10 */ 547 "Name list ends too soon.", 548 /* 11 */ 549 "Missing ) in name list.", 550 /* 12 */ 551 "Bad name, '^a' ignored.", 552 /* 13 */ 553 "Bad end of source.", 554 /* 14 */ 555 "Bad '^a'. List skipped.", 556 /* 15 */ 557 "Bad absolute path ignored.", 558 /* 16 */ 559 "", 560 /* 17 */ 561 "Symbols after 'End' ignored.", 562 /* 18 - 24 */ 563 (7)(1)">^d names. '^a' ignored.", 564 /* 25 */ 565 "Bad command name '^a' ignored.", 566 /* 26 */ 567 ">^d roots. Roots ignored.", 568 /* 27 */ 569 "Root '^a' missing. Root ignored.", 570 /* 28 */ 571 "Root '^a' missing. Root ignored.", 572 /* 29 */ 573 "Root name '^a' too long.", 574 /* 30 */ 575 "Root name '^a' duplicated.", 576 /* 31 */ 577 "No legal names. Root ignored.", 578 /* 32 */ 579 "Incomplete statement.", 580 /* 33 */ 581 ">^d search procs. '^a$^a' ignored.", 582 /* 34 */ 583 "Object segment overflow.", 584 /* 35 */ 585 "Missing 'command' stmt.", 586 /* 36 */ 587 "Missing 'command' stmt.", 588 /* 37 */ 589 "No legal root definitions.", 590 /* 38 */ 591 "Bad root type '^a'. Directory assumed."); 592 593 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 594 595 596 Nargs = cu_$arg_count(); /* complain if <1 or >2 arguments. */ 597 if Nargs < 1 then go to wnoa; 598 if Nargs > 2 then go to wnoa; 599 call cu_$arg_ptr (1, Parg, Larg, code); /* get path name of input segment. */ 600 call expand_path_ (Parg, Larg, addr(dir_in), addr(ent_in), code); 601 if code ^= 0 then go to bad_path; /* expand path name to absolute form. */ 602 call suffixed_name_$make (ent_in, "ld", ent_in, code); 603 if code ^= 0 then go to bad_input; /* make sure entry name is properly suffixed. */ 604 call suffixed_name_$new_suffix (ent_in, "ld", "alm", ent_out, code); 605 if code ^= 0 then go to bad_output_name; /* insure name of output segment is suffixed OK. */ 606 dir_out = get_wdir_(); /* put output segment in working directory. */ 607 608 if Nargs > 1 then do; /* process any control argument. */ 609 call cu_$arg_ptr (2, Parg, Larg, code); 610 if arg = "-bf" then 611 SERROR_CONTROL = "01"b; 612 else if arg = "-brief" then 613 SERROR_CONTROL = "01"b; 614 else if arg = "-lg" then 615 SERROR_CONTROL = "10"b; 616 else if arg = "-long" then 617 SERROR_CONTROL = "10"b; 618 else 619 go to badopt; 620 end; 621 622 Ptemp_seg = null; /* initialize pointers used by cleanup on unit. */ 623 Pin = null; 624 Pout = null; 625 on cleanup call cleaner; /* cleanup temp seg, initiated segments when req'd*/ 626 627 cleaner: procedure; /* This is a cleanup procedure. */ 628 if Ptemp_seg ^= null then 629 call translator_temp_$release_all_segments (Ptemp_seg, 0); 630 if Pin ^= null then 631 call terminate_file_ (Pin, 0, TERM_FILE_TERM, 0); 632 /* terminate source segment. */ 633 if Pout ^= null then /* clean up out segment. */ 634 call tssi_$clean_up_segment (Pacl_out); 635 end cleaner; 636 637 call initiate_file_ (dir_in, ent_in, R_ACCESS, Pin, bc_in, code); 638 if Pin = null then go to bad_input; /* initiate source segment. */ 639 Lin = divide (bc_in, 9, 35, 0); /* convert bit count to char count. */ 640 call translator_temp_$get_segment ((proc), Ptemp_seg, code); 641 if code ^= 0 then go to bad_area; 642 643 call tssi_$get_segment (dir_out, ent_out, Pout, Pacl_out, code); 644 if code ^= 0 then go to bad_output; /* get ptr to output segment. */ 645 if MLout = 0 then /* initialize limit on max. chars in output seg. */ 646 MLout = sys_info$max_seg_size * 4; 647 648 Pfirst_name_elements = null; 649 Pstmt, Pthis_token = null; /* start out with no input tokens. */ 650 if length(lex_delims) = 0 then /* initialize static variables used by lex_string_*/ 651 call lex_string_$init_lex_delims ("""", """", "/*", "*/", ";", "10"b, breaks, ignored_breaks, 652 lex_delims, lex_control_chars); 653 call lex_string_$lex (Pin, Lin, 0, Ptemp_seg, "1000"b, """", """", "/*", "*/", ";", 654 breaks, ignored_breaks, lex_delims, lex_control_chars, null, Pthis_token, code); 655 if code ^= 0 then call ERROR(32); /* parse input into tokens. */ 656 if Pthis_token = null then go to RETURN; /* a really fatal error occurred in parsing. */ 657 code = 0; /* clear error code for use below. */ 658 call SEMANTIC_ANALYSIS(); /* This one call does all the work. */ 659 RETURN: if MERROR_SEVERITY > 2 then do; /* Fatal error? No output created. */ 660 Lout = 0; 661 if code = 0 then 662 code = error_table_$fatal_error; 663 end; 664 if Lout = 0 then /* error if output segment has zero length. */ 665 call hcs_$truncate_seg (Pout, 0, 0); /* even tho char count is zero, truncate to free */ 666 /* records used by output segment. */ 667 call tssi_$finish_segment (Pout, Lout * 9, "1000"b, Pacl_out, 0); 668 Pout = null; /* finish up now. */ 669 call cleaner; /* clean up areas, initiated source. */ 670 if code ^= 0 then go to error; /* report any errors to user. */ 671 return; /* That's All Folks! */ 672 673 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 674 675 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 676 677 wnoa: call com_err_ (error_table_$wrong_no_of_args, proc, 678 "^/Calling sequence:^-library_descriptor_compiler pathname -option- 679 where pathname is:^-the relative path name of the library descriptor source segment. 680 option is:^--long | -lg | -brief | -bf"); 681 return; 682 683 badopt: call com_err_ (error_table_$badopt, proc, arg); 684 return; 685 686 bad_path: 687 call com_err_ (code, proc, " ^R^a^B", arg); 688 return; 689 690 bad_input: 691 if code = error_table_$no_makeknown then code = error_table_$noentry; 692 call com_err_ (code, proc, " ^R^a>^a^B", dir_in, ent_in); 693 return; 694 695 bad_output_name: 696 call suffixed_name_$new_suffix (ent_in, "ld", "", ent_out, 0); 697 call com_err_ (code, proc, "^a.alm^/While creating the entry name for the output segment.", ent_out); 698 return; 699 700 bad_output: 701 call com_err_ (code, proc, "^/While creating the output segment (^R^a>^a>B).", dir_out, ent_out); 702 call cleaner; 703 return; 704 705 error: call com_err_ (code, proc, "^/No output segment will be generated."); 706 return; 707 708 bad_area: call com_err_ (code, proc, "^/While creating a temporary segment in the process directory."); 709 call cleaner; 710 return; 711 712 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 713 714 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 715 /* */ 716 /* T O K E N R E Q U I R E M E N T F U N C T I O N S */ 717 /* */ 718 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 719 720 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 721 722 723 absolute_pathname: procedure returns (bit(1) aligned); /* This token requirement function determines */ 724 /* whether the current token is an absolute path. */ 725 726 dcl (Igreater, Inext_greater, Lentryname) 727 fixed bin; 728 729 if token.Lvalue > 0 then 730 if token.Lvalue <= 168 then 731 if search (token_value, "<") = 0 then 732 if substr (token_value,1,1) = ">" then do; 733 Igreater = 1; 734 do while (Igreater < token.Lvalue); 735 Inext_greater = index(substr(token_value,Igreater+1),">"); 736 if Inext_greater = 0 then 737 Inext_greater = token.Lvalue - (Igreater - 1); 738 Lentryname = Inext_greater - 1; 739 if Lentryname = 0 then 740 go to reject; 741 if Lentryname > 32 then 742 go to reject; 743 Igreater = Igreater + Inext_greater; 744 end; 745 call check_star_name_$path (token_value, code); 746 if code = 0 then 747 return ("1"b); 748 end; 749 reject: return ("0"b); 750 751 end absolute_pathname; 752 753 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 754 755 756 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 757 758 command_name_: procedure returns (bit(1) aligned); /* This token requirement function checks that a */ 759 /* token names one of the library maintenance */ 760 /* commands (eg, those commands which can use the */ 761 /* library descriptor). */ 762 763 dcl i fixed bin; /* a do-group index. */ 764 765 do i = 1 to dimension (command_name,1) while (token_value ^= command_name(i)); 766 end; /* see if token matches a command name. */ 767 if i > dimension (command_name,1) then do; /* if not, see about command name abbreviation. */ 768 do i = 1 to dimension (command_abbrev,1) while (token_value ^= command_abbrev(i)); 769 end; 770 if i > dimension (command_abbrev,1) then 771 return ("0"b); /* no match. Oh, well. */ 772 end; 773 Icommand = i; /* save index of command for later use. */ 774 return ("1"b); 775 776 end command_name_; 777 778 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 779 780 781 descriptor_name: procedure returns (bit(1) aligned); /* This token requirement function checks that the*/ 782 /* library descriptor name given in an 'End' */ 783 /* statement is the same as that given in a */ 784 /* 'Descriptor' statement. */ 785 if token_value = obj_desc.name then 786 return ("1"b); 787 else 788 return ("0"b); 789 790 end descriptor_name; 791 792 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 793 794 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 795 796 797 entryname: procedure returns (bit(1) aligned); /* This token requirement function checks that */ 798 /* a reference to a procedure entry point has a */ 799 /* correct format. Acceptable formats are: */ 800 /* reference_name$entry_point_name */ 801 /* reference_name (equivalent to */ 802 /* reference_name$reference_name) */ 803 /* It decodes the input name into its two parts */ 804 /* and stores these in the ename structure. */ 805 806 dcl Idollar fixed bin; 807 808 if token.Lvalue > 0 then 809 if token.Lvalue <= 65 then do; 810 Idollar = index (token_value, "$"); 811 if Idollar = 0 then 812 Idollar = token.Lvalue; 813 else 814 Idollar = Idollar - 1; 815 if Idollar <= 32 then 816 if verify (substr(token_value,1,1),"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz") 817 = 0 then 818 if verify (token_value,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_$") 819 = 0 then do; 820 call decode_entryname_ (token_value, ename.ref, ename.ent); 821 if ename.ent ^= "" then 822 return("1"b); /* exclude case of reference_name$ */ 823 end; 824 end; 825 return("0"b); 826 827 end entryname; 828 829 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 830 831 832 starname: procedure returns (bit(1) aligned); /* This token requirement function checks that a */ 833 /* token is a valid storage system entry name */ 834 /* which may be a star name. */ 835 if token.Lvalue > 0 then 836 if token.Lvalue <= 32 then do; 837 call check_star_name_$entry (token_value, starcode); 838 if starcode = 0 then 839 return("1"b); 840 if starcode = 1 then 841 return("1"b); 842 if starcode = 2 then 843 return("1"b); 844 end; /* save starcode for use by set_obj_star_code. */ 845 return("0"b); 846 847 end starname; 848 849 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 850 851 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 852 853 854 valid_name: procedure returns (bit(1) aligned); /* This token requirement function checks that a */ 855 /* library name, library group name, or root */ 856 /* name is valid. */ 857 858 if token.Lvalue > 0 then 859 if token.Lvalue <= 32 then 860 if search (token_value, "(),;<>*?%=") = 0 then 861 return("1"b); 862 return("0"b); 863 864 865 null_string_name: 866 entry returns(bit(1) aligned); 867 868 if token.S.quoted_string & 869 token.Lvalue = 0 then 870 return("1"b); 871 return("0"b); 872 873 end valid_name; 874 875 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 876 877 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 878 /* */ 879 /* A C T I O N R O U T I N E S */ 880 /* */ 881 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 882 883 884 combine_elements: procedure(Pname_elements_, name_sofar); /* This action routine combines the sets of name */ 885 /* elements from a compound root name into */ 886 /* complete root names. */ 887 888 dcl Pname_elements_ ptr, /* ptr to name_elements structure at this level */ 889 /* of recursion. */ 890 name_sofar char(100) varying, /* part of a complete name constructed so far. */ 891 1 name_elements_ based(Pname_elements_), 892 2 header like name_elements.header, 893 2 V (50 refer (name_elements_.N)) 894 char(32) varying, 895 /* copy of name_elements structure based upon */ 896 /* our input argument. */ 897 i fixed bin, /* a do-group index. */ 898 l fixed bin; /* length of name so far, on entrance. */ 899 900 l = length(name_sofar); /* record original length of input for reuse later*/ 901 do i = 1 to name_elements_.N; /* index through all names at this recursion level*/ 902 if name_elements_.V(i) = "" then; /* use name_sofar if our name element is null. */ 903 else if name_sofar = "" then /* use just our element if name_sofar is null. */ 904 name_sofar = name_elements_.V(i); 905 else name_sofar = name_sofar || "." || name_elements_.V(i); 906 907 if name_elements_.Pnext = null then do; /* Case 1: no additional element structures. */ 908 add_name: /* add the name to obj_root_name list. */ 909 if name_sofar = "" then; /* do nothing with complete names which are null*/ 910 else if length(name_sofar) > 32 then /* check for complete names which are too long. */ 911 call lex_error_ (29, SERROR_PRINTED(29), (error_control_table(29).severity), 912 MERROR_SEVERITY, obj_root.Pstmt, null, SERROR_CONTROL, 913 (error_control_table(29).message), (error_control_table(29).brief_message), 914 name_sofar); 915 else if obj_root_name.N = obj_root_name.M then 916 call lex_error_ (obj_root_name.ERROR, SERROR_PRINTED(obj_root_name.ERROR), 917 (error_control_table(obj_root_name.ERROR).severity), MERROR_SEVERITY, 918 obj_root.Pstmt, null, SERROR_CONTROL, 919 (error_control_table(obj_root_name.ERROR).message), 920 (error_control_table(obj_root_name.ERROR).brief_message), 921 obj_root_name.M, name_sofar); /* complain if obj_root_name list is full. */ 922 else do; 923 obj_root_name.N = obj_root_name.N + 1; 924 obj_root_name.V(obj_root_name.N) = name_sofar; 925 end; 926 end; 927 928 else if name_elements_.Pnext -> name_elements_.N = 0 then 929 go to add_name; /* Case 2: there is a next name element struc, */ 930 /* but no names in it. */ 931 else /* Case 3: there are more element structures. */ 932 call combine_elements (name_elements_.Pnext, name_sofar); 933 name_sofar = substr(name_sofar,1,l); /* reset to original value on input to this */ 934 end; /* level of the subroutine. */ 935 936 end combine_elements; 937 938 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 939 940 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 941 942 command_begin: procedure; /* This action routine performs the prologue */ 943 /* functions necessary for defining command */ 944 /* default values. */ 945 946 obj_command_dflt_values(Icommand).S.supported = Scommand; 947 /* record whether or not command is supported. */ 948 if Scommand then do; /* if supported, initialize library name and */ 949 /* search name lists. */ 950 obj_command_dflt_values(Icommand).lib_names.Ifirst = obj_dflt_lib_names.N + 1; 951 obj_command_dflt_values(Icommand).lib_names.Ilast = obj_dflt_lib_names.N; 952 obj_command_dflt_values(Icommand).search_names.Ifirst = obj_dflt_search_names.N + 1; 953 obj_command_dflt_values(Icommand).search_names.Ilast = obj_dflt_search_names.N; 954 end; 955 956 end command_begin; 957 958 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 959 960 961 command_end: procedure; /* This action routine performs epilogue */ 962 /* functions necessary to complete the definition */ 963 /* of command default values. */ 964 965 if Icommand = 0 then /* ignore bad definition block. */ 966 return; 967 obj_command_dflt_values(Icommand).lib_names.Ilast = obj_dflt_lib_names.N; 968 obj_command_dflt_values(Icommand).search_names.Ilast = obj_dflt_search_names.N; 969 /* set upper bounds of name lists. */ 970 971 end command_end; 972 973 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 974 975 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 976 977 compile_descriptor: procedure; /* This action routine converts the information */ 978 /* in the tables filled in by other action rtns */ 979 /* into ALM code which is written into the output */ 980 /* segment. */ 981 982 if obj_root_array.N = 0 then /* don't generate output if no roots defined. */ 983 call ERROR(37); 984 if MERROR_SEVERITY > 2 then /* don't go any further if a fatal error occurred.*/ 985 return; 986 Lout = MLout; /* start out with an empty output segment */ 987 /* (all of the segment remaining). */ 988 989 /* output header. */ 990 call OUT(" 991 ""* * * * * * * * * * * * * * * * * * * * * * * *"" 992 ""* *"" 993 ""* COMPILED OUTPUT FROM SEGMENT "); 994 call OUT(ent_in); 995 call OUT(" *"" 996 ""* Compiled by: library_descriptor_compiler, *"" 997 ""* Version 3.3 of January 14, 1986 *"" 998 ""* Compiled on: "); 999 compilation_date = date_time_$format ("date_time", clock_(), "", ""); 1000 call OUT(compilation_date); 1001 call OUT("*"" 1002 ""* Refer to: lib_descriptor_.incl.pl1 *"" 1003 ""* for a declaration of entries in this database *"" 1004 ""* *"" 1005 ""* * * * * * * * * * * * * * * * * * * * * * * *"""); 1006 1007 /* output name and descriptor segdef. */ 1008 call OUT(" 1009 1010 name "); 1011 call OUT(obj_desc.name); 1012 call OUT(" 1013 segdef descriptor"); 1014 1015 /* output descriptor structure. */ 1016 call OUT(" 1017 1018 descriptor: "" 1 descriptor, 1019 dec 2 "" 2 version, 1020 aci """); 1021 call OUT(obj_desc.name); 1022 call OUT(""" "" 2 name, 1023 "" 2 command_default_values, 1024 vfd 18/0,18/command_default_values "" 3 O,"); 1025 call OUT(" 1026 "" 2 roots, 1027 vfd 18/0,18/roots "" 3 O;"); 1028 1029 /* output command_default_values structure. */ 1030 call OUT(" 1031 "" "); 1032 call OUT(NP); 1033 call OUT(" 1034 even 1035 command_default_values: "" 1 command_default_values,"); 1036 call OUT (" 1037 dec "); 1038 call OUTN(dimension(command_name,1)); 1039 call OUT (" "" 2 N, 1040 "" 2 group ("); 1041 call OUTVN (dimension(command_name,1)); 1042 call OUT (")"); 1043 do i = 1 to dimension(command_name,1); 1044 call OUT(", 1045 "" 3 S,/* ("); 1046 call OUTVN(i); 1047 call OUT(": "); 1048 call OUTV(command_name(i)); 1049 call OUT(") */ 1050 oct "); 1051 if obj_command_dflt_values(i).S.supported then 1052 call OUT("000000000000"); 1053 else 1054 call OUT("400000000000"); 1055 call OUT (" "" 4 unsupported, 1056 "" 3 library_names, 1057 vfd 18/0,18/library_names_"); 1058 call OUTVN(i); 1059 call OUT (" "" 4 O, 1060 "" 3 search_names, 1061 vfd 18/0,18/search_names_"); 1062 call OUTVN (i); 1063 call OUT (" "" 4 O"); 1064 end; 1065 call OUT(";"); 1066 1067 /* output default library names arrays. */ 1068 call OUT(" 1069 "" "); 1070 call OUT(NP); 1071 do i = 1 to dimension(command_name,1); 1072 call OUT (" 1073 even 1074 library_names_"); 1075 call OUTVN(i); 1076 call OUT 1077 (": "" "); 1078 call OUTV(command_name(i)); 1079 call OUT (" 1080 "" 1 library_names, 1081 dec "); 1082 j = obj_command_dflt_values(i).lib_names.Ilast - 1083 obj_command_dflt_values(i).lib_names.Ifirst + 1; 1084 call OUTVN (j); 1085 call OUT (" "" 2 N, 1086 "" 2 group ("); 1087 call OUTVN(j); 1088 call OUT (")"); 1089 do j = obj_command_dflt_values(i).lib_names.Ifirst 1090 to obj_command_dflt_values(i).lib_names.Ilast by 1; 1091 call OUT (", 1092 aci """); 1093 temp_name = obj_dflt_lib_names.V(j); 1094 call OUT(temp_name); 1095 call OUT (""" "" 3 V, 1096 dec "); 1097 call OUTVN (obj_dflt_lib_codes.C(j)); 1098 call OUT 1099 (" "" 3 C"); 1100 end; 1101 call OUT ("; 1102 "); 1103 end; 1104 1105 /* output default search names arrays. */ 1106 call OUT(" 1107 "" "); 1108 call OUT(NP); 1109 do i = 1 to dimension(command_name,1); 1110 call OUT (" 1111 even 1112 search_names_"); 1113 call OUTVN(i); 1114 call OUT 1115 (": "" "); 1116 call OUTV(command_name(i)); 1117 call OUT (" 1118 "" 1 search_names, 1119 dec "); 1120 j = obj_command_dflt_values(i).search_names.Ilast - 1121 obj_command_dflt_values(i).search_names.Ifirst + 1; 1122 call OUTVN (j); 1123 call OUT (" "" 2 N, 1124 "" 2 group ("); 1125 call OUTVN(j); 1126 call OUT (")"); 1127 do j = obj_command_dflt_values(i).search_names.Ifirst 1128 to obj_command_dflt_values(i).search_names.Ilast by 1; 1129 call OUT (", 1130 aci """); 1131 temp_name = obj_dflt_search_names.V(j); 1132 call OUT(temp_name); 1133 call OUT (""" "" 3 V, 1134 dec "); 1135 call OUTVN (obj_dflt_search_codes.C(j)); 1136 call OUT 1137 (" "" 3 C"); 1138 end; 1139 call OUT ("; 1140 "); 1141 end; 1142 1143 /* output root definition structure. */ 1144 call OUT(" 1145 "" "); 1146 call OUT(NP); 1147 call OUT(" 1148 even 1149 roots: "" 1 roots, 1150 dec "); 1151 call OUTN (obj_root_array.N); 1152 call OUT (" "" 2 N, 1153 "" 2 root ("); 1154 call OUTVN (obj_root_array.N); 1155 call OUT(")"); 1156 do i = 1 to obj_root_array.N; 1157 call OUT(", 1158 "" 1159 "" "); 1160 Pobj_root = addr(obj_root_array.obj_root(i)); 1161 Pstmt = obj_root.Pstmt; 1162 j = index(stmt_value, NL); 1163 do while (j > 0); 1164 call OUT (stmt_part); 1165 call OUT (""" "); 1166 stmt.Pvalue = addr(stmt_array(j+1)); 1167 stmt.Lvalue = stmt.Lvalue - j; 1168 j = index (stmt_value, NL); 1169 end; 1170 call OUT (stmt_value); 1171 call OUT (" 1172 even "" ("); 1173 call OUTVN(i); 1174 call OUT(") 1175 "" 3 name, 1176 vfd 18/0,18/."); 1177 temp_name30 = ""; /* find a unique, 30 char root name to use as */ 1178 /* label on list of root names. */ 1179 do j = obj_root.name.Ifirst to obj_root.name.Ilast; 1180 if length(obj_root_name.V(j)) <= 30 then do; 1181 temp_name30 = obj_root_name.V(j); /* save 1st possibility, in case none unique. */ 1182 do k = 1 to i-1; 1183 if obj_root_array.obj_root(k).name.label = obj_root_name.V(j) then go to NAME_DUP; 1184 end; 1185 go to NAME_FOUND; 1186 end; 1187 NAME_DUP: end; 1188 if temp_name30 = "" then /* no names short enough. */ 1189 temp_name30 = obj_root_name.V(obj_root.name.Ifirst); 1190 do k = 1 to i-1; /* make chosen name unique. */ 1191 if obj_root_array.obj_root(k).name.label = temp_name30 then do; 1192 temp_name30 = substr(backup_name_ (":." || temp_name30),3); 1193 temp_name30 = substr(temp_name30,1,length(temp_name30)+1-verify(reverse(temp_name30)," ")); 1194 end; 1195 end; 1196 NAME_FOUND: obj_root.name.label = temp_name30; 1197 call OUTV(temp_name30); 1198 call OUT (" 1199 "" 4 O, 1200 dec "); 1201 call OUTN(length(obj_root.path)); 1202 call OUT(" "" 3 path, 1203 aci """); 1204 path = obj_root.path; /* assign output path to fixed-length char string.*/ 1205 do j = 1 to 129 by 32; /* output path name in 32 char ch. */ 1206 call OUT(substr(path,j,32)); 1207 call OUT(""" 1208 aci """); 1209 end; 1210 call OUT(substr(path,161,8)); 1211 call OUT(""" 1212 dec "); 1213 call OUTN(obj_root.type); 1214 call OUT(" "" 3 type, 1215 dec "); 1216 j = obj_root.search_proc.I; 1217 entry_point = obj_search_proc.ename.ref(j); 1218 entry_point_name = substr(entry_point,1,length(entry_point) + 1 - verify(reverse(entry_point)," ")); 1219 if obj_search_proc.ename.ent(j) ^= "" then do; 1220 entry_point_name = entry_point_name || "$"; 1221 entry_point = obj_search_proc.ename.ent(j); 1222 entry_point_name = entry_point_name || 1223 substr(entry_point,1,length(entry_point) + 1 - verify(reverse(entry_point)," ")); 1224 end; 1225 call OUTN (length(entry_point_name)); 1226 call OUT (" "" 3 search_proc_name, 1227 aci """); 1228 entry_point = entry_point_name; 1229 call OUT (substr(entry_point,1,68)); 1230 call OUT (""" 1231 even 1232 itp bp,search_procs+("); 1233 call OUTVN(obj_root.search_proc.I); 1234 call OUT("*2)-* 1235 its -1,1 "" 3 search_proc"); 1236 end; 1237 call OUT(";"); 1238 1239 /* output root names arrays. */ 1240 call OUT(" 1241 "" "); 1242 call OUT(NP); 1243 do i = 1 to obj_root_array.N; 1244 call OUT (" 1245 even 1246 ."); 1247 Pobj_root = addr (obj_root_array.obj_root(i)); 1248 call OUTV (obj_root.name.label); 1249 call OUT (": 1250 "" 1 root_names, 1251 dec "); 1252 j = obj_root.name.Ilast - obj_root.name.Ifirst + 1; 1253 call OUTVN (j); 1254 call OUT (" "" 2 N, 1255 "" 2 root_name ("); 1256 call OUTVN(j); 1257 call OUT (");"); 1258 do j = obj_root.name.Ifirst to obj_root.name.Ilast by 1; 1259 call OUT (" 1260 aci """); 1261 temp_name = obj_root_name.V(j); 1262 call OUT(temp_name); 1263 call OUT (""""); 1264 end; 1265 end; 1266 1267 1268 /* output the search procedure transfer vector. */ 1269 call OUT(" 1270 "" "); 1271 call OUT(NP); 1272 call OUT(" 1273 even 1274 search_procs: "" search procedure transfer vector 1275 dec 0 1276 dec 0"); 1277 do i = 1 to obj_search_proc.N; 1278 call OUT(" 1279 getlp "" /* ("); 1280 call OUTVN(i); 1281 call OUT(") */ 1282 tra "); 1283 entry_point = obj_search_proc.ename.ref(i); 1284 entry_point_name = "<" || 1285 substr (entry_point,1,length(entry_point) + 1 - verify(reverse(entry_point)," ")) || ">"; 1286 if obj_search_proc.ename.ent(i) = "" then 1287 entry_point_name = entry_point_name || "|0"; 1288 else do; 1289 entry_point = obj_search_proc.ename.ent(i); 1290 entry_point_name = entry_point_name || "|[" || 1291 substr(entry_point,1,length(entry_point)+1-verify(reverse(entry_point)," ")) || "]"; 1292 end; 1293 call OUTV(entry_point_name); 1294 end; 1295 1296 call OUT(" 1297 1298 end 1299 "); 1300 1301 Lout = MLout - Lout; /* convert Lout to a count of _u_s_e_d chars in output*/ 1302 1303 end compile_descriptor; 1304 1305 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1306 1307 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1308 1309 1310 descriptor_begin: procedure; /* This procedure performs prologue functions */ 1311 /* for the library descriptor compiler. */ 1312 1313 Pobj_dflt_lib_codes = allocate(Ptemp_seg, size(obj_dflt_lib_codes)); 1314 obj_dflt_lib_codes.M = 100; 1315 Pobj_dflt_search_codes = allocate(Ptemp_seg, size(obj_dflt_search_codes)); 1316 obj_dflt_search_codes.M = 100; 1317 Pobj_dflt_lib_names = allocate(Ptemp_seg, size(obj_dflt_lib_names)); 1318 obj_dflt_lib_names.M = 100; 1319 Pobj_dflt_search_names = allocate(Ptemp_seg, size(obj_dflt_search_names)); 1320 obj_dflt_search_names.M = 100; 1321 Pobj_root_name = allocate(Ptemp_seg, size(obj_root_name)); 1322 obj_root_name.M = 5000; 1323 Pobj_root_array = allocate(Ptemp_seg, size(obj_root_array)); 1324 obj_root_array.M = 100; 1325 Pobj_search_proc = allocate(Ptemp_seg, size(obj_search_proc)); 1326 obj_search_proc.M = 30; 1327 1328 obj_dflt_lib_codes.N = 0; /* initialize star code structures. */ 1329 obj_dflt_search_codes.N = 0; 1330 1331 Pname_elements = null; /* initialize name structures. */ 1332 obj_dflt_lib_names.N = 0; 1333 obj_dflt_lib_names.ERROR = 18; 1334 obj_dflt_search_names.N = 0; 1335 obj_dflt_search_names.ERROR = 19; 1336 obj_root_name.N = 0; 1337 1338 obj_root_array.N = 0; /* initialize the array of object roots. */ 1339 obj_search_proc.N = 0; /* initialize the array of search procedures. */ 1340 1341 do i = 1 to dimension (obj_command_dflt_values,1);/* initialize command defaults structure. */ 1342 obj_command_dflt_values(i).S.supported = "0"b; 1343 obj_command_dflt_values(i).lib_names.Ifirst = 0; 1344 obj_command_dflt_values(i).lib_names.Ilast = -1; 1345 obj_command_dflt_values(i).search_names.Ifirst = 0; 1346 obj_command_dflt_values(i).search_names.Ilast = -1; 1347 end; 1348 1349 end descriptor_begin; 1350 1351 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1352 1353 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1354 1355 1356 1357 new_element: procedure(Pname_elements_next); /* This action routine gets space for the next */ 1358 /* set of name elements in a compound name. */ 1359 1360 dcl Pname_elements_next ptr, /* Pointer to the next name_elements structure. */ 1361 1 name_elements_next based(Pname_elements_next), 1362 2 header like name_elements.header, 1363 2 V (50 refer (name_elements_next.N)) 1364 char(32) varying; 1365 1366 if Pname_elements_next = null then do; /* If no next structure has been allocated, do it.*/ 1367 Pname_elements_next = allocate(Ptemp_seg, size(name_elements_next)); 1368 name_elements_next.M = 50; 1369 name_elements_next.ERROR = 21; 1370 name_elements_next.Pnext = null; 1371 end; 1372 name_elements_next.N = 0; /* there are no names in this new list yet. */ 1373 if name_elements_next.Pnext^= null then /* initialize next next name_elements strucuture */ 1374 name_elements_next.Pnext -> name_elements_next.N = 0; 1375 /* if any. */ 1376 Pname_elements = addr(name_elements_next); /* set current name_elements structure to one we */ 1377 /* just allocated. */ 1378 Pname = addr(name_elements_next.M); /* set set_elements structure pointer to next */ 1379 /* name_elements_next structure. */ 1380 end new_element; 1381 1382 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1383 1384 root_begin: procedure; /* This action routine performs prologue functions*/ 1385 /* necessary prior to defining a new root. */ 1386 1387 if obj_root_array.N = obj_root_array.M then do; /* complain if no more roots can be defined. */ 1388 call lex_error_ (26, SERROR_PRINTED(26), (error_control_table(26).severity), MERROR_SEVERITY, 1389 obj_root.Pstmt, null, SERROR_CONTROL, (error_control_table(26).message), 1390 (error_control_table(26).brief_message), obj_root_array.M); 1391 go to RETURN; 1392 end; 1393 obj_root_array.N = obj_root_array.N + 1; /* address the next root. */ 1394 Pobj_root = addr(obj_root_array.obj_root(obj_root_array.N)); 1395 1396 obj_root.path = ""; /* initialize the root. */ 1397 search_proc.ename.ref = ""; 1398 search_proc.ename.ent = ""; 1399 obj_root.search_proc.I = 0; 1400 1401 obj_root.type = Tdirectory; /* assume root is a directory, by default. */ 1402 obj_root.Pstmt = token.Pstmt; /* save pointer to root's statement descriptor. */ 1403 /* This will be used in error messages. */ 1404 1405 Pname = addr(obj_root_name); 1406 obj_root.name.Ifirst = obj_root_name.N+1; /* save index of first name for this root. */ 1407 1408 end root_begin; 1409 1410 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1411 1412 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1413 1414 1415 root_end: procedure; /* This action routine perform epilogue functions */ 1416 /* necessary to defining a root. */ 1417 /* Steps include: insuring that definition is */ 1418 /* consistent and complete; applying defaults to */ 1419 /* unspecified values; constructing the root's */ 1420 /* list of full names. */ 1421 1422 Sreject_root = "0"b; 1423 if obj_root.path = "" then do; /* complain if path name unspecified. */ 1424 call lex_error_ (27, SERROR_PRINTED(27), (error_control_table(27).severity), MERROR_SEVERITY, 1425 obj_root.Pstmt, null, SERROR_CONTROL, (error_control_table(27).message), 1426 (error_control_table(27).brief_message), "path"); 1427 Sreject_root = "1"b; 1428 end; 1429 if search_proc.ename.ref = "" then do; /* complain if search procedure unspecified. */ 1430 call lex_error_ (27, SERROR_PRINTED(27), (error_control_table(27).severity), MERROR_SEVERITY, 1431 obj_root.Pstmt, null, SERROR_CONTROL, (error_control_table(27).message), 1432 (error_control_table(27).brief_message), "search procedure"); 1433 Sreject_root = "1"b; 1434 end; 1435 1436 do i = 1 to obj_search_proc.N; /* add search procedure to table. */ 1437 if search_proc.ename.ref = obj_search_proc.ename(i).ref then 1438 if search_proc.ename.ent = obj_search_proc.ename(i).ent then 1439 go to already_there; 1440 end; 1441 if i > obj_search_proc.M then do; /* complain if the table is full. */ 1442 call lex_error_ (33, SERROR_PRINTED(33), (error_control_table(33).severity), MERROR_SEVERITY, 1443 obj_root.Pstmt, null, SERROR_CONTROL, (error_control_table(33).message), 1444 (error_control_table(33).brief_message), obj_search_proc.M, search_proc.ename.ref, 1445 search_proc.ename.ent); 1446 go to RETURN; 1447 end; 1448 obj_search_proc.N = i; 1449 obj_search_proc.ename(i) = search_proc.ename; 1450 already_there: 1451 obj_root.search_proc.I = i; /* fill table index into root structure. */ 1452 1453 obj_root.name.Ilast = obj_root_name.N; /* set upper bound on root's name list. */ 1454 if obj_root.name.Ifirst > obj_root.name.Ilast then do; 1455 /* complain if no legal names found for root. */ 1456 call lex_error_ (31, SERROR_PRINTED(31), (error_control_table(31).severity), MERROR_SEVERITY, 1457 obj_root.Pstmt, null, SERROR_CONTROL, (error_control_table(31).message), 1458 (error_control_table(31).brief_message)); 1459 Sreject_root = "1"b; 1460 end; 1461 1462 if Sreject_root then do; /* some error requires that we reject this root. */ 1463 obj_root_name.N = obj_root.name.Ifirst - 1; /* ignore any root names which were defined. */ 1464 obj_root_array.N = obj_root_array.N - 1; /* ignore the root. */ 1465 end; 1466 1467 end root_end; 1468 1469 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1470 1471 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1472 1473 1474 set_element: 1475 set_name: procedure; /* This action routine adds a name to the current */ 1476 /* name list. */ 1477 1478 if name.N = name.M then /* make sure there is room for another name. */ 1479 call lex_error_ (name.ERROR, SERROR_PRINTED(name.ERROR), (error_control_table(name.ERROR).severity), 1480 MERROR_SEVERITY, addrel(token.Pstmt,0), null, SERROR_CONTROL, 1481 (error_control_table(name.ERROR).message), (error_control_table(name.ERROR).brief_message), 1482 name.M, token_value); 1483 else do; 1484 name.N = name.N + 1; 1485 name.V(name.N) = token_value; /* add name to the table. */ 1486 end; 1487 1488 end set_name; 1489 1490 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1491 1492 1493 set_obj_star_code: procedure; /* This action routine adds a starcode to the */ 1494 /* current starcode list. */ 1495 1496 if obj_star_code.N = obj_star_code.M then; /* list full; message already printed by set_name.*/ 1497 else do; 1498 obj_star_code.N = obj_star_code.N + 1; 1499 obj_star_code.C(obj_star_code.N) = starcode; 1500 end; 1501 1502 end set_obj_star_code; 1503 1504 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1505 1506 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1507 /* */ 1508 /* O U T P U T R O U T I N E S */ 1509 /* */ 1510 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1511 1512 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1513 1514 1515 OUT: procedure (value); /* This procedure outputs a character string into */ 1516 /* the output segment. */ 1517 1518 dcl value char(*); /* character string to be output. */ 1519 1520 if length(value) > Lout then do; /* if no room for string in output seg, quit. */ 1521 call ERROR(34); 1522 go to RETURN; 1523 end; 1524 substr (out, 1, length(value)) = value; 1525 Pout = addr (substr (out, length(value)+1)); 1526 Lout = Lout - length(value); 1527 1528 end OUT; 1529 1530 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1531 1532 1533 OUTV: procedure (value); /* This procedure outputs a character string into */ 1534 /* the output segment. */ 1535 1536 dcl value char(*) varying; /* character string to be output. */ 1537 1538 if length(value) > Lout then do; /* if no room for string in output seg, quit. */ 1539 call ERROR(34); 1540 go to RETURN; 1541 end; 1542 substr (out, 1, length(value)) = value; 1543 Pout = addr (substr (out, length(value)+1)); 1544 Lout = Lout - length(value); 1545 1546 end OUTV; 1547 1548 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1549 1550 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1551 1552 1553 OUTN: procedure (N); /* This procedure outputs a number into the */ 1554 /* output segment. */ 1555 1556 dcl N fixed bin, /* Number to be output. */ 1557 Nchar pic "---9"; /* character string representation of the number. */ 1558 1559 Nchar = N; 1560 if length(Nchar) > Lout then do; /* make sure number will fit in output segment. */ 1561 call ERROR(34); 1562 go to RETURN; 1563 end; 1564 substr (out, 1, length(Nchar)) = Nchar; 1565 Pout = addr (substr (out, length(Nchar)+1)); 1566 Lout = Lout - length(Nchar); 1567 1568 end OUTN; 1569 1570 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1571 1572 OUTVN: procedure(N); /* This procedure outputs a number, stripped of */ 1573 /* any leading spaces, into the output segment. */ 1574 1575 dcl N fixed bin, /* number to be output. */ 1576 Nchar pic "---9", /* character string representation of the number. */ 1577 Isignificant fixed bin; /* index of first significant character of number.*/ 1578 1579 Nchar = N; /* convert number to character representation. */ 1580 Isignificant = verify (Nchar," "); /* get index of first significant character. */ 1581 call OUT(substr(Nchar,Isignificant)); /* output significant digits of the number. */ 1582 1583 end OUTVN; 1584 1585 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1586 1587 1 1 /* BEGINNING OF: translator_temp_alloc.incl.pl1 * * * * * * * * * * * * * * * * */ 1 2 1 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1 4 /* */ 1 5 /* N__a_m_e: translator_temp_alloc.incl.pl1 */ 1 6 /* */ 1 7 /* This include segment allocates space in a translator's temporary segment. It */ 1 8 /* contains a complete space allocation function 'allocate' which can be a quick PL/I */ 1 9 /* internal procedure in the program which includes this include segment. The temporary */ 1 10 /* segment should be one obtained by using the translator_temp_ subroutine. */ 1 11 /* */ 1 12 /* S__t_a_t_u_s */ 1 13 /* */ 1 14 /* 0) Created by: G. C. Dixon in January, 1975. */ 1 15 /* 1) Modified by: G. C. Dixon in February, 1981 - use limit area structure. */ 1 16 /* */ 1 17 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1 18 1 19 1 20 1 21 allocate: procedure (Parea, ANwords) returns (ptr); 1 22 1 23 dcl Parea ptr, /* ptr to the temporary segment. (In) */ 1 24 ANwords fixed bin; /* number of words to be allocated. (In) */ 1 25 1 26 dcl Nwords fixed bin, /* number of words to be allocated, rounded up */ 1 27 /* to a 0 mod 2 quantity. */ 1 28 P ptr, /* a temporary pointer. */ 1 29 code fixed bin(35), /* a status code. */ 1 30 (mod, null, ptr) builtin; 1 31 1 32 dcl 1 area based (Parea), 1 33 2 Pfirst_temp_seg ptr unal, /* ptr to first temp seg of a group. */ 1 34 2 Ofree fixed bin(35), /* offset of next free word in temp seg. */ 1 35 2 Lfree fixed bin(35); /* length of remaining free space in temp seg. */ 1 36 1 37 dcl translator_temp_$get_next_segment 1 38 entry (ptr, ptr, fixed bin(35)); 1 39 1 40 Nwords = ANwords + mod (ANwords, 2); /* round up word count to 0 + mod 2 quantity. */ 1 41 if Nwords > Lfree then do; /* handle area overflow. */ 1 42 call translator_temp_$get_next_segment (Parea, P, code); 1 43 if P = null then return (null); 1 44 Parea = P; 1 45 if Nwords > area.Lfree then return (null); 1 46 end; 1 47 P = ptr (Parea, area.Ofree); /* get pointer to next free word of area. */ 1 48 area.Ofree = area.Ofree + Nwords; /* increase offset of remaining free space. */ 1 49 area.Lfree = area.Lfree - Nwords; /* decrease length of remaining free space. */ 1 50 return (P); 1 51 1 52 end allocate; 1 53 1 54 /* END OF: translator_temp_alloc.incl.pl1 * * * * * * * * * * * * * * * * */ 1588 1589 2 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 2 2* 2 3* Values for the "access mode" argument so often used in hardcore 2 4* James R. Davis 26 Jan 81 MCR 4844 2 5* Added constants for SM access 4/28/82 Jay Pattin 2 6* Added text strings 03/19/85 Chris Jones 2 7**/ 2 8 2 9 2 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 2 11 dcl ( 2 12 N_ACCESS init ("000"b), 2 13 R_ACCESS init ("100"b), 2 14 E_ACCESS init ("010"b), 2 15 W_ACCESS init ("001"b), 2 16 RE_ACCESS init ("110"b), 2 17 REW_ACCESS init ("111"b), 2 18 RW_ACCESS init ("101"b), 2 19 S_ACCESS init ("100"b), 2 20 M_ACCESS init ("010"b), 2 21 A_ACCESS init ("001"b), 2 22 SA_ACCESS init ("101"b), 2 23 SM_ACCESS init ("110"b), 2 24 SMA_ACCESS init ("111"b) 2 25 ) bit (3) internal static options (constant); 2 26 2 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 2 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 2 29 2 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 2 31 static options (constant); 2 32 2 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 2 34 static options (constant); 2 35 2 36 dcl ( 2 37 N_ACCESS_BIN init (00000b), 2 38 R_ACCESS_BIN init (01000b), 2 39 E_ACCESS_BIN init (00100b), 2 40 W_ACCESS_BIN init (00010b), 2 41 RW_ACCESS_BIN init (01010b), 2 42 RE_ACCESS_BIN init (01100b), 2 43 REW_ACCESS_BIN init (01110b), 2 44 S_ACCESS_BIN init (01000b), 2 45 M_ACCESS_BIN init (00010b), 2 46 A_ACCESS_BIN init (00001b), 2 47 SA_ACCESS_BIN init (01001b), 2 48 SM_ACCESS_BIN init (01010b), 2 49 SMA_ACCESS_BIN init (01011b) 2 50 ) fixed bin (5) internal static options (constant); 2 51 2 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 1590 1591 3 1 /* START OF: lib_descriptor_.incl.pl1 * * * * * * * * * * * * * * * * */ 3 2 3 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 3 4 /* */ 3 5 /* N__a_m_e: lib_descriptor_.incl.pl1 */ 3 6 /* */ 3 7 /* This include segment defines the structures which are included in the library */ 3 8 /* descriptor segments used as data bases by Multics library maintenance tools. */ 3 9 /* */ 3 10 /* S__t_a_t_u_s */ 3 11 /* */ 3 12 /* 0) Created by: G. C. Dixon in April, 1974. */ 3 13 /* 1) Modified by: G. C. Dixon in May, 1976. */ 3 14 /* */ 3 15 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 3 16 3 17 dcl 1 descriptor aligned based (P.descriptor), 3 18 /* structure which defines the location within */ 3 19 /* the descriptor of description aggregates. */ 3 20 2 version fixed bin, /* version number of this descriptor. (= 2) */ 3 21 2 name char(32), /* name of this descriptor. */ 3 22 2 command_default_values, /* aggregate: default values to be used for */ 3 23 /* commands which reference the descriptor. */ 3 24 3 O fixed bin(19), /* offset of aggregate from P.descriptor. */ 3 25 2 roots, /* aggregate: root nodes of the library. */ 3 26 3 O fixed bin(19); /* offset of aggregate from P.descriptor. */ 3 27 dcl Vdescriptor_2 fixed bin int static options(constant) init (2); 3 28 3 29 dcl 1 command_default_values based (P.command_default_values), 3 30 /* array of structures which defines the */ 3 31 /* default values which are applied to */ 3 32 /* each command which uses the library */ 3 33 /* descriptor. There is one array element */ 3 34 /* for each command. */ 3 35 2 N fixed bin, /* count of commands. */ 3 36 2 group (0 refer (command_default_values.N)), /* array of structures. */ 3 37 3 S unaligned, /* switches: */ 3 38 4 unsupported bit(1), /* on if the command described by this */ 3 39 /* element of the array of structures is */ 3 40 /* _n_o_t supported by this descriptor. */ 3 41 3 library_names, /* names of the default libraries which are to */ 3 42 /* be used for this command, if the user */ 3 43 /* omits the library name. */ 3 44 4 O fixed bin(19), /* offset of the names structure. */ 3 45 3 search_names, /* star names which identify the library */ 3 46 /* entries to be search for, if the user */ 3 47 /* omits the search name. */ 3 48 4 O fixed bin(19); /* offset of the names structure. */ 3 49 3 50 dcl 1 library_names based (Plibrary_names), 3 51 /* array of default library names for one command.*/ 3 52 2 N fixed bin, /* count of names. */ 3 53 2 group (0 refer (library_names.N)), /* array of names. */ 3 54 3 V char(32) aligned, /* a name. */ 3 55 3 C fixed bin(35); /* code from check_star_name_$entry for name. */ 3 56 3 57 dcl 1 search_names based (Psearch_names), 3 58 /* array of default search names for one command. */ 3 59 2 N fixed bin, /* count of names. */ 3 60 2 group (0 refer (search_names.N)), /* array of names. */ 3 61 3 V char(32) aligned, /* a name. */ 3 62 3 C fixed bin(35); /* code from check_star_name_$entry for name. */ 3 63 4 1 /* START OF: lib_commands_.incl.pl1 * * * * * * * * * * * * * * * * */ 4 2 4 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 4 4 /* */ 4 5 /* N__a_m_e: lib_commands_.incl.pl1 */ 4 6 /* */ 4 7 /* This include segment defines the names of all commands which use library */ 4 8 /* descriptor segments. These descriptor segments are the data base of the Multics */ 4 9 /* library maintenance tools. As such, the commands are referred to collectively as */ 4 10 /* library descriptor commands. The include segment also defines the command index value */ 4 11 /* associated with each command. This is used to index into some of the arrays of the */ 4 12 /* library descriptor. */ 4 13 /* */ 4 14 /* S__t_a_t_u_s */ 4 15 /* */ 4 16 /* 0) Created by: G. C. Dixon in January, 1975 */ 4 17 /* */ 4 18 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 4 19 4 20 4 21 dcl library_info fixed bin int static init (1), 4 22 library_map fixed bin int static init (2), 4 23 library_print fixed bin int static init (3), 4 24 library_fetch fixed bin int static init (4), 4 25 library_cleanup fixed bin int static init (5); 4 26 /* index into command_default_values of info */ 4 27 /* structure for commands which reference the */ 4 28 /* library descriptor. */ 4 29 dcl command_name (5) char(16) varying int static options(constant) init ( 4 30 "library_info", "library_map", "library_print", 4 31 "library_fetch", "library_cleanup"), 4 32 command_abbrev (5) char(4) varying int static options(constant) init ( 4 33 "li", "lm", "lpr", "lf", "lcln"); 4 34 /* names and abbreviations of lib maint. commands.*/ 4 35 4 36 /* END OF: lib_commands_.incl.pl1 * * * * * * * * * * * * * * * * */ 3 64 3 65 3 66 dcl 1 roots based (P.roots), /* array of structures, each structure of which */ 3 67 /* defines the names, absolute path name, type,*/ 3 68 /* and search procedure for a root of the */ 3 69 /* library defined by this descriptor. */ 3 70 2 N fixed bin, /* count of roots */ 3 71 2 root (0 refer (roots.N)), /* array of roots. */ 3 72 3 name, /* names by which this root may be referenced. */ 3 73 4 O fixed bin(19), /* offset of name array. */ 3 74 3 path char(168) varying, /* absolute path name of the root directory or */ 3 75 /* archive segment. */ 3 76 3 type fixed bin, /* type of root. 2 = directory, 4 = archive. */ 3 77 3 search_proc_name char(65) varying, /* name of procedure used to search root. */ 3 78 3 search_proc entry (ptr, char(168) varying, ptr, bit(72) aligned, bit(36) aligned, 3 79 fixed bin, fixed bin, ptr, entry, 3 80 ptr, ptr, fixed bin(35)) variable; 3 81 /* entry point of the program which knows how */ 3 82 /* to search for library entries in this */ 3 83 /* root. */ 3 84 3 85 dcl 1 root_names based (Proot_names), 3 86 /* array of root names for one root. */ 3 87 2 N fixed bin, /* count of names. */ 3 88 2 root_name (0 refer (root_names.N)) /* array of names. */ 3 89 char(32); 3 90 3 91 dcl 1 P aligned, /* structure containing pointers to the aggregates*/ 3 92 /* defined above. */ 3 93 2 descriptor ptr, 3 94 2 command_default_values ptr, 3 95 2 roots ptr, 3 96 Plibrary_names ptr, 3 97 Psearch_names ptr, 3 98 Proot_names ptr; 3 99 3 100 /* END OF: lib_descriptor_.incl.pl1 * * * * * * * * * * * * * * * * */ 1592 1593 5 1 /* START OF: lib_node_.incl.pl1 * * * * * * * * * * * * * * * * */ 5 2 5 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 4 /* */ 5 5 /* N__a_m_e: lib_node_.incl.pl1 */ 5 6 /* */ 5 7 /* This include segment defines the structures which form the tree of status nodes */ 5 8 /* created by lib_get_tree_. Each node of the tree is associated with a directory */ 5 9 /* entry or an archive component. The node lists the attributes of that entry, which is */ 5 10 /* called the node target. */ 5 11 /* */ 5 12 /* S__t_a_t_u_s */ 5 13 /* */ 5 14 /* 0) Created: May, 1973 by G. C. Dixon */ 5 15 /* 1) Modified: Aug, 1973 by G. C. Dixon - standardize descriptor format. */ 5 16 /* 2) Modified: Oct, 1973 by G. C. Dixon - add object_info_ descriptor. */ 5 17 /* 3) Modified: Apr, 1975 by G. C. Dixon - add ACL and IACL descriptors. */ 5 18 /* 4) Modified: Oct, 1975 by G. C. Dixon - additional status info added. */ 5 19 /* */ 5 20 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 21 5 22 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 23 /* */ 5 24 /* The structure of each node whose target is a link is shown below. The */ 5 25 /* structure of nodes for other types of targets is shown on the next page. Note that */ 5 26 /* both types of nodes are the same length. */ 5 27 /* */ 5 28 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 29 5 30 dcl 1 link_node based (Pnode), /* node of a status tree. */ 5 31 2 Pparent ptr, /* ptr to: parent node (previous tree level). */ 5 32 2 PD ptr, /* ptr to: descriptor chain attached to node. */ 5 33 2 Svalid bit(72) aligned, /* switches: node data which is valid. */ 5 34 2 Sreq bit(72) aligned, /* switches: node data which is req'd for output.*/ 5 35 /* (= node.Svalid & Srequirements) */ 5 36 2 T fixed bin(35), /* attribute: type of node target. */ 5 37 2 switches unaligned, 5 38 3 Smode bit(3), /* attribute: user's access mode to entry. */ 5 39 3 Sprev_mode bit(3), /* attribute: user's previous access mode to the */ 5 40 /* entry before lib_access_mode_$set. */ 5 41 3 pad bit(22), 5 42 3 Smaster_dir bit(1), /* attribute: master directory */ 5 43 3 Stpd bit(1), /* attribute: transparent (never on) paging device*/ 5 44 3 Ssafety bit(1), /* attribute: safety switch. */ 5 45 3 Saim_security_oos bit(1), /* attribute: security out-of-service. */ 5 46 3 Saim_audit bit(1), /* attribute: AIM audit use of node target. */ 5 47 3 Saim_multiple_class bit(1), /* attribute: AIM multiple class segment. */ 5 48 3 Sterminal_account bit(1), /* attribute: if on, records charged against quota*/ 5 49 /* in this directory; if off, records*/ 5 50 /* charged against 1st superior */ 5 51 /* directory with switch on. */ 5 52 3 Sterminal_account_dir bit(1), /* attribute: like Sterminal_account for dir quota*/ 5 53 3 Scopy bit(1), /* attribute: copy-on-write switch. */ 5 54 2 unique_id bit(36), /* attribute: unique identifier. */ 5 55 2 author char(32) varying, /* attribute: author of node target. */ 5 56 2 dtem bit(36), /* attribute: date-time attributes modified. */ 5 57 2 dtd bit(36), /* attribute: date-time node target dumped. */ 5 58 5 59 /* From here on, link_nodes differ from nodes */ 5 60 /* for other types of node targets. */ 5 61 2 link_target char(168) varying; /* attribute: target pathname of the link. */ 5 62 5 63 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 64 /* */ 5 65 /* The structure of nodes for other types of node targets is shown below. */ 5 66 /* */ 5 67 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 68 5 69 dcl 1 node based (Pnode), /* node of a status tree. */ 5 70 2 Pparent ptr, /* ptr to: parent node (previous tree level). */ 5 71 2 PD ptr, /* ptr to: descriptor chain attached to node. */ 5 72 2 Svalid bit(72) aligned, /* switches: node data which is valid. */ 5 73 2 Sreq bit(72) aligned, /* switches: node data which is req'd for output.*/ 5 74 /* (= node.Svalid & Srequirements) */ 5 75 2 T fixed bin(35), /* attribute: type of node target. */ 5 76 2 switches unaligned, 5 77 3 Smode bit(3), /* attribute: user's access mode to entry. */ 5 78 3 Sprev_mode bit(3), /* attribute: user's previous access mode to the */ 5 79 /* entry before lib_access_mode_$set. */ 5 80 3 pad bit(22), 5 81 3 Smaster_dir bit(1), /* attribute: master directory */ 5 82 3 Stpd bit(1), /* attribute: transparent (never on) paging device*/ 5 83 3 Ssafety bit(1), /* attribute: safety switch. */ 5 84 3 Saim_security_oos bit(1), /* attribute: security out-of-service. */ 5 85 3 Saim_audit bit(1), /* attribute: AIM audit use of node target. */ 5 86 3 Saim_multiple_class bit(1), /* attribute: AIM multiple class segment. */ 5 87 3 Sterminal_account bit(1), /* attribute: if on, records charged against quota*/ 5 88 /* in this directory; if off, records*/ 5 89 /* charged against 1st superior */ 5 90 /* directory with switch on. */ 5 91 3 Sterminal_account_dir bit(1), /* attribute: like Sterminal_account for dir quota*/ 5 92 3 Scopy bit(1), /* attribute: copy-on-write switch. */ 5 93 2 unique_id bit(36), /* attribute: unique identifier. */ 5 94 2 author char(32) varying, /* attribute: author of node target. */ 5 95 2 dtem bit(36), /* attribute: date-time attributes modified. */ 5 96 2 dtd bit(36), /* attribute: date-time node target dumped. */ 5 97 5 98 /* From here on, other nodes differ from */ 5 99 /* link_nodes. */ 5 100 2 dtm bit(36), /* attribute: date-time node target modified. */ 5 101 2 dtu bit(36), /* attribute: date-time node target last used. */ 5 102 2 rb (3) fixed bin(3), /* attribute: ring brackets. */ 5 103 2 pad1 (1) fixed bin, 5 104 2 access_class bit(72) aligned, /* attribute: access class assoc. with entry. */ 5 105 2 records_used fixed bin(35), /* attribute: storage used, in records. */ 5 106 2 current_length fixed bin(35), /* attribute: length, in records. */ 5 107 2 max_length fixed bin(35), /* attribute: maximum length. */ 5 108 2 msf_indicator fixed bin(35), /* attribute: msf indicator. */ 5 109 2 bit_count fixed bin(35), /* attribute: bit count. */ 5 110 2 bit_count_author char(32) varying, /* attribute: bit count/msf indicator author. */ 5 111 2 offset fixed bin(35), /* attribute: offset, in words, of an archive */ 5 112 /* component from the base of archive.*/ 5 113 2 entry_bound fixed bin(35), /* attribute: entry limit for calls to a gate. */ 5 114 2 segment, /* group: segment quota information for a dir. */ 5 115 3 quota fixed bin(35), /* attribute: quota set. */ 5 116 3 quota_used fixed bin(35), /* attribute: quota used. */ 5 117 3 trp fixed bin(71), /* attribute: time-record product. */ 5 118 3 dttrp bit(36), /* attribute: date-time time-record product last */ 5 119 /* updated. */ 5 120 3 Ninf_quota fixed bin(35), /* attribute: number of immediately-inferior */ 5 121 /* directories with Sterminal_account */ 5 122 /* on. */ 5 123 2 directory, /* group: directory quota information for a dir. */ 5 124 3 quota fixed bin(35), /* attribute: quota set. */ 5 125 3 quota_used fixed bin(35), /* attribute: quota used. */ 5 126 3 trp fixed bin(71), /* attribute: time-record product. */ 5 127 3 dttrp bit(36), /* attribute: date-time time-record product last */ 5 128 /* updated. */ 5 129 3 Ninf_quota fixed bin(35), /* attribute: number of immediately-inferior */ 5 130 /* directories with Sterminal_account */ 5 131 /* on. */ 5 132 2 pvid bit(36), /* attribute: physical volume id. */ 5 133 2 lvid bit(36), /* attribute: logical volume id. */ 5 134 2 pad2 (5) fixed bin, 5 135 Pnode ptr; /* ptr to: a tree node. */ 5 136 5 137 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 138 /* */ 5 139 /* The descriptors attached to each node of the tree describe the variable-sized */ 5 140 /* attributes of the directory entry or archive component associated with the node. */ 5 141 /* Each descriptor must begin with a header shown in structure D below. The following */ 5 142 /* descriptors are the only ones that have been defined. */ 5 143 /* */ 5 144 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 145 5 146 dcl 1 D based (PD), /* Header common to all descriptors. */ 5 147 2 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 148 2 version fixed bin(17) unal, /* descriptor: version number. */ 5 149 2 T fixed bin, /* descriptor: type of descriptor. */ 5 150 2 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 151 PD ptr; /* ptr to: a descriptor. */ 5 152 5 153 dcl 1 Dacl based (PDacl), /* a segment ACL descriptor. */ 5 154 2 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 155 2 version fixed bin(17) unal, /* descriptor: version number = 1. */ 5 156 2 T fixed bin, /* descriptor: type = Tacl. */ 5 157 2 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 158 2 C fixed bin(35), /* attribute: error code from filling descriptor. */ 5 159 2 N fixed bin, /* attribute: number of ACL entries. */ 5 160 2 acls (Nacls refer (Dacl.N)), /* attribute: ACL entries. */ 5 161 3 access_name char(32), /* attribute: access name associated with entry. */ 5 162 3 modes bit(36), /* attribute: access modes associated with entry. */ 5 163 3 zero_pad bit(36), 5 164 3 status_code fixed bin(35), /* attribute: status code associated with entry. */ 5 165 Nacls fixed bin, /* temporary: number of entries in ACL descriptor.*/ 5 166 PDacl ptr, /* ptr to: a segment ACL descriptor. */ 5 167 Vacl_1 fixed bin int static options(constant) init (1), 5 168 /* version: version of ACL descriptor. */ 5 169 Tacl fixed bin int static options(constant) init (7); 5 170 /* attribute: type of a segment ACL descriptor. */ 5 171 5 172 dcl 1 Ddir_acl based (PDdir_acl), /* a directory ACL descriptor. */ 5 173 2 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 174 2 version fixed bin(17) unal, /* descriptor: version number = 1. */ 5 175 2 T fixed bin, /* descriptor: type = Tdir_acl. */ 5 176 2 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 177 2 C fixed bin(35), /* attribute: error code from filling descriptor. */ 5 178 2 N fixed bin, /* attribute: number of ACL entries. */ 5 179 2 acls (Ndir_acls refer (Ddir_acl.N)), /* attribute: ACL entries. */ 5 180 3 access_name char(32), /* attribute: access name associated with entry. */ 5 181 3 dir_modes bit(36), /* attribute: access modes associated with entry. */ 5 182 3 status_code fixed bin(35), /* attribute: status code associated with entry. */ 5 183 Ndir_acls fixed bin, /* temporary: number of entries in ACL descriptor.*/ 5 184 PDdir_acl ptr, /* ptr to: a directory ACL descriptor. */ 5 185 Vdir_acl_1 fixed bin int static options(constant) init (1), 5 186 /* version: version of directory ACL descriptor.*/ 5 187 Tdir_acl fixed bin int static options(constant) init (8); 5 188 /* attribute: type of a directory ACL descriptor. */ 5 189 5 190 dcl 1 Ddir_iacl based (PDdir_iacl), /* a directory IACL descriptor. */ 5 191 2 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 192 2 version fixed bin(17) unal, /* descriptor: version number = 1. */ 5 193 2 T fixed bin, /* descriptor: type = Tdir_iacl. */ 5 194 2 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 195 2 C fixed bin(35), /* attribute: error code from filling descriptor. */ 5 196 2 N fixed bin, /* attribute: number of ACL entries. */ 5 197 2 Iring (0:7) fixed bin, /* attribute: index of first ACLe in each ring. */ 5 198 2 Nring (0:7) fixed bin, /* attribute: number of ACL entries in each ring. */ 5 199 2 acls (Ndir_iacls refer (Ddir_iacl.N)), /* attribute: ACL entries. */ 5 200 3 access_name char(32), /* attribute: access name associated with entry. */ 5 201 3 dir_modes bit(36), /* attribute: access modes associated with entry. */ 5 202 3 status_code fixed bin(35), /* attribute: status code associated with entry. */ 5 203 Ndir_iacls fixed bin, /* temporary: number of entries in IACL descriptor*/ 5 204 PDdir_iacl ptr, /* ptr to: a directory IACL descriptor. */ 5 205 Vdir_iacl_1 fixed bin int static options(constant) init (1), 5 206 /* version: version of dir IACL descriptor. */ 5 207 Tdir_iacl fixed bin int static options(constant) init (9); 5 208 5 209 dcl 1 Diacl based (PDiacl), /* a segment IACL descriptor. */ 5 210 2 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 211 2 version fixed bin(17) unal, /* descriptor: version number = 1. */ 5 212 2 T fixed bin, /* descriptor: type = Tiacl. */ 5 213 2 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 214 2 C fixed bin(35), /* attribute: error code from filling descriptor. */ 5 215 2 N fixed bin, /* attribute: number of ACL entries. */ 5 216 2 Iring (0:7) fixed bin, /* attribute: index of first ACLe in each ring. */ 5 217 2 Nring (0:7) fixed bin, /* attribute: number of ACL entries in each ring. */ 5 218 2 acls (Niacls refer (Diacl.N)), /* attribute: ACL entries. */ 5 219 3 access_name char(32), /* attribute: access name associated with entry. */ 5 220 3 modes bit(36), /* attribute: access modes associated with entry. */ 5 221 3 zero_pad bit(36), 5 222 3 status_code fixed bin(35), /* attribute: status code associated with entry. */ 5 223 Niacls fixed bin, /* temporary: number of entries in IACL descriptor*/ 5 224 PDiacl ptr, /* ptr to: a segment IACL descriptor. */ 5 225 Viacl_1 fixed bin int static options(constant) init (1), 5 226 /* version: version of segment IACL descriptor. */ 5 227 Tiacl fixed bin int static options(constant) init (10); 5 228 /* attribute: type of a segment IACL descriptor. */ 5 229 5 230 dcl 1 Dnames based (PDnames), /* name attribute descriptor. */ 5 231 2 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 232 2 version fixed bin(17) unal, /* descriptor: version number = 1. */ 5 233 2 T fixed bin, /* descriptor: type = Tnames. */ 5 234 2 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 235 2 N fixed bin, /* attribute: number of names. */ 5 236 2 names (Nnames refer (Dnames.N)) 5 237 char(32), /* attribute: names. */ 5 238 Nnames fixed bin, /* temporary: number of names in name descriptor. */ 5 239 PDnames ptr, /* ptr to: a name descriptor. */ 5 240 Vnames_1 fixed bin int static options(constant) init (1), 5 241 /* version: version of names descriptor. */ 5 242 Tnames fixed bin int static options(constant) init (1); 5 243 /* attribute: type of a name descriptor. */ 5 244 5 245 dcl 1 Dnodes based (PDnodes), /* descriptor for array of immediately-inferior */ 5 246 /* nodes. */ 5 247 2 header, 5 248 3 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 249 3 version fixed bin(17) unal, /* descriptor: version number = 1. */ 5 250 3 T fixed bin, /* descriptor: type = Tnodes. */ 5 251 3 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 252 3 C fixed bin(35), /* attribute: error code from filling array. */ 5 253 3 N fixed bin, /* attribute: number of nodes in node array. */ 5 254 2 nodes (Nnodes refer (Dnodes.N)) /* attribute: node array */ 5 255 like node, 5 256 Nnodes fixed bin, /* temporary: number of nodes in node array. */ 5 257 PDnodes ptr, /* ptr to: a node array descriptor. */ 5 258 Vnodes_1 fixed bin int static options(constant) init (1), 5 259 /* version: version of nodes descriptor. */ 5 260 Tnodes fixed bin int static options(constant) init (2); 5 261 /* attribute: type of a node descriptor. */ 5 262 5 263 dcl 1 Dobj based (PDobj), /* an object_info_ descriptor. */ 5 264 2 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 265 2 version fixed bin(17) unal, /* descriptor: version number = 1. */ 5 266 2 T fixed bin, /* descriptor: type = Tobj. */ 5 267 2 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 268 2 info, 5 269 3 Otext fixed bin(35), /* attribute: offset of text. */ 5 270 3 Odefinitions fixed bin(35), /* attribute: offset of definitions. */ 5 271 3 Olink fixed bin(35), /* attribute: offset of linkage section. */ 5 272 3 Ostatic fixed bin(35), /* attribute: offset of static section. */ 5 273 3 Osymbols fixed bin(35), /* attribute: offset of symbol section. */ 5 274 3 Obreaks fixed bin(35), /* attribute: offset of break map. */ 5 275 3 Ltext fixed bin(35), /* attribute: length of text, in words. */ 5 276 3 Ldefinitions fixed bin(35), /* attribute: length of definitions, in words. */ 5 277 3 Llink fixed bin(35), /* attribute: length of linkage section, in words.*/ 5 278 3 Lstatic fixed bin(35), /* attribute: length of static section, in words. */ 5 279 3 Lsymbols fixed bin(35), /* attribute: length of symbol section, in words. */ 5 280 3 Lbreaks fixed bin(35), /* attribute: length of break map, in words. */ 5 281 3 format aligned, 5 282 4 old_format bit(1) unal, /* attribute: segment is in old format. */ 5 283 4 bound bit(1) unal, /* attribute: a bound segment. */ 5 284 4 relocatable bit(1) unal, /* attribute: object is relocatable. */ 5 285 4 procedure bit(1) unal, /* attribute: executable procedure. */ 5 286 4 standard bit(1) unal, /* attribute: standard object segment. */ 5 287 4 gate bit(1) unal, /* attribute: gate procedure. */ 5 288 4 separate_static bit(1) unal, /* attribute: proc has separate static section. */ 5 289 4 links_in_text bit(1) unal, /* attribute: proc has links in text section. */ 5 290 4 pad bit(28) unal, 5 291 3 entry_bound fixed bin(35), /* attribute: entry point bound for a gate. */ 5 292 3 Otext_links fixed bin(35), /* attribute: offset of first link in text section*/ 5 293 3 compiler char(8), /* attribute: compiler of this object segment. */ 5 294 3 compile_time fixed bin(71), /* attribute: date/time of compilation. */ 5 295 3 userid char(32), /* attribute: id of user who compiled segment. */ 5 296 3 cversion, /* attribite: compiler version string. */ 5 297 4 O fixed bin(17) unal, /* offset */ 5 298 4 L fixed bin(17) unal, /* length */ 5 299 3 comment, /* attribute: compiler-generated comment. */ 5 300 4 O fixed bin(17) unal, /* offset */ 5 301 4 L fixed bin(17) unal, /* length */ 5 302 3 Osource fixed bin(35), /* attribute: offset of source map. */ 5 303 2 cversion char(64) varying, /* attribute: compiler version number */ 5 304 2 comment char(64) varying, /* attribute: compiler's comment info */ 5 305 PDobj ptr, /* ptr to: an object_info_ descriptor. */ 5 306 Vobj_1 fixed bin int static options(constant) init (1), 5 307 /* version: version of object_info_ descriptor. */ 5 308 Tobj fixed bin int static options(constant) init (3); 5 309 /* attribute: type of a node descriptor. */ 5 310 5 311 dcl 1 Dsearch_proc based (PDsearch_proc), 5 312 /* library root search_proc attribute descriptor. */ 5 313 2 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 314 2 version fixed bin(17) unal, /* descriptor: version number = 1. */ 5 315 2 T fixed bin, /* descriptor: type = Tsearch_proc. */ 5 316 2 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 317 2 search_proc char(65) varying, /* attribute: name of library search procedure. */ 5 318 PDsearch_proc ptr, /* ptr to: a search_proc info descriptor. */ 5 319 Vsearch_proc_1 fixed bin int static options(constant) init (1), 5 320 /* version: version of search_proc info descrip.*/ 5 321 Tsearch_proc fixed bin int static options(constant) init (5); 5 322 /* attribute: type of a search_proc descriptor. */ 5 323 5 324 dcl 1 Duser based (PDuser), /* user attribute descriptor. */ 5 325 2 length fixed bin(17) unal, /* descriptor: length, in words. */ 5 326 2 version fixed bin(17) unal, /* descriptor: version number = 1. */ 5 327 2 T fixed bin, /* descriptor: type = Tuser. */ 5 328 2 Pnext ptr, /* ptr to: next descriptor attached to node. */ 5 329 2 label char(18), /* attribute: label to be used for this field in */ 5 330 /* output. */ 5 331 2 L fixed bin, /* attribute: length of user info string. */ 5 332 2 info char(Luser refer (Duser.L)), 5 333 /* attribute: user info string. */ 5 334 Luser fixed bin, /* temporary: length of user info string. */ 5 335 PDuser ptr, /* ptr to: a user info descriptor. */ 5 336 Vuser_1 fixed bin int static options(constant) init (1), 5 337 /* version: version of user info descriptor. */ 5 338 Tuser fixed bin int static options(constant) init (6); 5 339 /* attribute: type of a user descriptor. */ 5 340 6 1 /* START OF: lib_Svalid_req_.incl.pl1 * * * * * * * * * * * * * * * * */ 6 2 6 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 6 4 /* */ 6 5 /* N__a_m_e: lib_Svalid_req_.incl.pl1 */ 6 6 /* */ 6 7 /* This include segment defines the switches which request/validate the fields */ 6 8 /* in a status node produced by lib_get_tree_. This segment, lib_Scontrol_.incl.pl1, */ 6 9 /* and lib_args_.incl.pl1 define the complete set of structures required as input to */ 6 10 /* the lib_descriptor_ subroutine. This subroutine is called by all of the library */ 6 11 /* descriptor commands to obtain information about entries in a library. */ 6 12 /* */ 6 13 /* If a switch is on, then the corresponding information in the node is valid, or */ 6 14 /* is requested for output. */ 6 15 /* */ 6 16 /* S__t_a_t_u_s */ 6 17 /* */ 6 18 /* 0) Created on: April 8, 1975 by G. C. Dixon */ 6 19 /* */ 6 20 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 6 21 6 22 6 23 dcl 1 Svalid_req aligned based, 6 24 2 primary_name bit(1) unal, /* switch: output includes primary name */ 6 25 2 matching_names bit(1) unal, /* switch: output includes matching names */ 6 26 2 names bit(1) unal, /* switch: output includes all names */ 6 27 6 28 2 pathname bit(1) unal, /* switch: output include pathname of node target */ 6 29 2 kids bit(1) unal, /* switch: children nodes (inferior) exist */ 6 30 2 kids_error bit(1) unal, /* switch: error occurred obtaining kid's info */ 6 31 6 32 2 type bit(1) unal, /* switch: type */ 6 33 2 mode bit(1) unal, /* switch: user's access mode to node target */ 6 34 2 safety bit(1) unal, /* switch: safety switch setting */ 6 35 6 36 2 aim bit(1) unal, /* switch: Access Isolation Mechanism switches */ 6 37 2 copy bit(1) unal, /* switch: copy-on-write switch setting */ 6 38 2 unique_id bit(1) unal, /* switch: unique identifier */ 6 39 6 40 2 author bit(1) unal, /* switch: author of node target */ 6 41 2 dtem bit(1) unal, /* switch: date attributes modified */ 6 42 2 dtd bit(1) unal, /* switch: date dumped */ 6 43 6 44 2 link_target bit(1) unal, /* switch: target pathname of link node */ 6 45 2 dtm bit(1) unal, /* switch: date modified */ 6 46 2 dtu bit(1) unal, /* switch: date used */ 6 47 6 48 2 rb bit(1) unal, /* switch: ring brackets */ 6 49 2 access_class bit(1) unal, /* switch: AIM access class */ 6 50 2 records_used bit(1) unal, /* switch: records used */ 6 51 6 52 2 current_length bit(1) unal, /* switch: current length */ 6 53 2 max_length bit(1) unal, /* switch: maximum length */ 6 54 2 msf_indicator bit(1) unal, /* switch: count of MSF components. */ 6 55 6 56 2 bit_count bit(1) unal, /* switch: bit count */ 6 57 2 bit_count_author bit(1) unal, /* switch: bit count author. */ 6 58 2 offset bit(1) unal, /* switch: offset from segment base */ 6 59 6 60 2 entry_bound bit(1) unal, /* switch: call limit for gate node */ 6 61 2 lvid bit(1) unal, /* switch: logical volume id */ 6 62 2 pvid bit(1) unal, /* switch: physical volume id */ 6 63 6 64 2 quota bit(1) unal, /* switch: directory quota information */ 6 65 2 acl bit(1) unal, /* switch: ACL */ 6 66 2 iacl bit(1) unal, /* switch: initial ACLs */ 6 67 6 68 2 dtc bit(1) unal, /* switch: date-time compiled */ 6 69 2 compiler_name bit(1) unal, /* switch: name of compiler */ 6 70 2 compiler_version bit(1) unal, /* switch: compiler version number */ 6 71 6 72 2 compiler_options bit(1) unal, /* switch: compiler options info */ 6 73 2 object_info bit(1) unal, /* switch: other object segment info */ 6 74 2 not_ascii bit(1) unal, /* switch: contents is not printable */ 6 75 6 76 2 user bit(1) unal, /* switch: user-defined node information */ 6 77 2 root_search_proc bit(1) unal, /* switch: root search procedure info. */ 6 78 2 prev_mode bit(1) unal, /* switch: user's previous acces mode set. */ 6 79 2 pad bit(26) unal, 6 80 6 81 2 delete bit(1) unal, /* switch: on (for lcln) if node to be deleted. */ 6 82 6 83 2 cross_ref bit(1) unal, /* switch: cross-reference all names */ 6 84 2 level bit(1) unal, /* switch: output status tree level number */ 6 85 2 new_line bit(1) unal; /* switch: output begins with newline char */ 6 86 6 87 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 6 88 /* */ 6 89 /* The following declarations define a series of bit strings to be overlaid by */ 6 90 /* structures which are exactly like Svalid_req above, except for their level 1 name. */ 6 91 /* These structures are used throughout the library descriptor commands and subroutines. */ 6 92 /* */ 6 93 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 6 94 6 95 6 96 dcl 1 S aligned based (addr(Srequirements)) like Svalid_req, 6 97 Srequirements bit(72) aligned; 6 98 6 99 /* END OF: lib_Svalid_req_.incl.pl1 * * * * * * * * * * * * * * * * */ 5 341 5 342 5 343 dcl 1 Svalid aligned based(addr(node.Svalid)) like Svalid_req, 5 344 1 Sreq aligned based(addr(node.Sreq)) like Svalid_req; 5 345 7 1 /* START OF: lib_Scontrol_.incl.pl1 * * * * * * * * * * * * * * * * */ 7 2 7 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 7 4 /* */ 7 5 /* N__a_m_e: lib_Scontrol_.incl.pl1 */ 7 6 /* */ 7 7 /* This include segment defines the control switches used by library descriptor */ 7 8 /* commands and subroutines. These switches control the amount of information which is */ 7 9 /* attached to each node of the tree by lib_get_tree_. This segment, lib_args_.incl.pl1, */ 7 10 /* and lib_Svalid_req_.incl.pl1 define the complete set of structures required as input */ 7 11 /* to the lib_descriptor_ subroutine. */ 7 12 /* */ 7 13 /* S__t_a_t_u_s */ 7 14 /* */ 7 15 /* 0) Created on: April 8, 1975 by G. C. Dixon */ 7 16 /* 1) Modified on: October 24, 1983 by Jim Lippard to add page_length, first_match */ 7 17 /* */ 7 18 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 7 19 7 20 dcl 1 Sc aligned based (addr (Scontrol)), 7 21 2 acl bit(1) unal, /* switch: return ACL for library entries. */ 7 22 2 all_status bit(1) unal, /* switch: return extra status information. */ 7 23 2 chase bit(1) unal, /* switch: link entries are to be chased. */ 7 24 7 25 2 check_archive bit(1) unal, /* switch: see if contents of entry is archive. */ 7 26 2 check_ascii bit(1) unal, /* switch: see if contents of entry is ascii. */ 7 27 2 components bit(1) unal, /* switch: return info about parent of terminal */ 7 28 /* nodes of the tree, and about all the */ 7 29 /* nodes below the parent. */ 7 30 7 31 2 container bit(1) unal, /* switch: return info about parent of terminal */ 7 32 /* nodes of the tree. */ 7 33 2 default bit(1) unal, /* switch: use default requirement switch settings*/ 7 34 2 iacl bit(1) unal, /* switch: return initial ACLs for library entries*/ 7 35 7 36 2 object_info bit(1) unal, /* switch: return object info for object segments.*/ 7 37 2 quota bit(1) unal, /* switch: return quota information. */ 7 38 2 retain bit(1) unal, /* switch: print information about nodes awaiting */ 7 39 /* deletion. */ 7 40 7 41 2 pad bit(10) unal, 7 42 7 43 2 first_match bit(1) unal, /* switch: stop after first match */ 7 44 2 page_length bit(1) unal, /* switch: page length of output */ 7 45 7 46 2 delete bit(1) unal, /* switch: delete library entries */ 7 47 2 descriptor bit(1) unal, /* switch: library descriptor */ 7 48 2 exclude bit(1) unal, /* switch: exclusion search names. */ 7 49 7 50 2 footing bit(1) unal, /* switch: footing for output pages. */ 7 51 2 heading bit(1) unal, /* switch: heading for 1st output page. */ 7 52 2 into_path bit(1) unal, /* switch: path into which entries are fetched. */ 7 53 7 54 2 library bit(1) unal, /* switch: library names */ 7 55 2 list bit(1) unal, /* switch: list library entries */ 7 56 2 long bit(1) unal, /* switch: long output format required. */ 7 57 7 58 2 output_file bit(1) unal, /* switch: pathname of output file */ 7 59 2 search_names bit(1) unal, /* switch: search names */ 7 60 2 time bit(1) unal, /* switch: grace time for deletion of entries. */ 7 61 Scontrol bit(36) aligned; /* switches: aligned copy of control switches. */ 7 62 7 63 /* END OF: lib_Scontrol_.incl.pl1 * * * * * * * * * * * * * * * * */ 5 346 5 347 5 348 5 349 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 350 /* */ 5 351 /* The following entry type attributes have been defined. Note that the types */ 5 352 /* for segments, archive components, and msf components all have the characteristic */ 5 353 /* that: mod (type, 2) = 1; */ 5 354 /* */ 5 355 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 356 5 357 5 358 dcl (Tlink init (0), 5 359 Tsegment init (1), 5 360 Tdirectory init (2), 5 361 Tmsf init (3), 5 362 Tmsf_comp init (4), 5 363 Tarchive init (5), 5 364 Tarchive_comp init (6)) fixed bin(17) int static options(constant); 5 365 5 366 5 367 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 368 /* */ 5 369 /* The following character string arrays identify each entry type attribute by name. */ 5 370 /* Both brief and long string arrays are provided. */ 5 371 /* */ 5 372 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 5 373 5 374 dcl node_type (0:6) char(32) varying aligned int static options(constant) init ( 5 375 "link", 5 376 "segment", 5 377 "directory", 5 378 "multisegment file", 5 379 "multi-segment file component", 5 380 "archive", 5 381 "archive component"), 5 382 brief_node_type (0:6) char(12) varying aligned int static options(constant) init ( 5 383 "link", 5 384 "segment", 5 385 "directory", 5 386 "msf", 5 387 "msf comp", 5 388 "archive", 5 389 "arch comp"); 5 390 5 391 5 392 /* END OF: lib_node_.incl.pl1 * * * * * * * * * * * * * * * * */ 1594 1595 8 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 8 2 /* format: style2,^inddcls,idind32 */ 8 3 8 4 declare 1 terminate_file_switches based, 8 5 2 truncate bit (1) unaligned, 8 6 2 set_bc bit (1) unaligned, 8 7 2 terminate bit (1) unaligned, 8 8 2 force_write bit (1) unaligned, 8 9 2 delete bit (1) unaligned; 8 10 8 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 8 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 8 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 8 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 8 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 8 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 8 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 8 18 8 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 1596 1597 1598 1599 dcl TRACING bit(1) aligned int static init("0"b); 1600 1601 9 1 /* START OF: rdc_start_.incl.pl1 * * * * * * */ 9 2 9 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 9 4 /* */ 9 5 /* N__a_m_e: rdc_start_.incl.pl1 */ 9 6 /* */ 9 7 /* This include segment is used by compilers generated by the */ 9 8 /* reduction_compiler. Such compilers include a SEMANTIC_ANALYSIS */ 9 9 /* subroutine generated by the reduction_compiler. This subroutine */ 9 10 /* compares a chain of input tokens with token requirements */ 9 11 /* specified in reductions. This include segment declares the */ 9 12 /* structure of the input tokens (which are generated by lex_string_),*/ 9 13 /* defines the beginning of the SEMANTIC_ANALYSIS procedure, and */ 9 14 /* declares Pthis_token, a global pointer variable which points to */ 9 15 /* the "current" token being referenced by SEMANTIC_ANALYSIS. */ 9 16 /* */ 9 17 /* S__t_a_t_u_s */ 9 18 /* */ 9 19 /* 0) Created: April, 1974 by G. C. Dixon */ 9 20 /* */ 9 21 /* * * * * * * * * * * * * * * * * * * * * * * */ 9 22 9 23 dcl Pthis_token ptr; /* ptr to the "current" token being acted upon. */ 9 24 10 1 /* START OF: lex_descriptors_.incl.pl1 * * * * * * */ 10 2 10 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 10 4 /* */ 10 5 /* Name: lex_descriptors_.incl.pl1 */ 10 6 /* */ 10 7 /* This include segment defines the structure of the token */ 10 8 /* descriptor, statement descriptor, and comment descriptor created */ 10 9 /* by the lex_string_ program. */ 10 10 /* */ 10 11 /* Status: */ 10 12 /* */ 10 13 /* 0) Created: Dec, 1973 by G. C. Dixon */ 10 14 /* */ 10 15 /* * * * * * * * * * * * * * * * * * * * * * * */ 10 16 10 17 10 18 10 19 10 20 dcl 10 21 1 comment aligned based (Pcomment), 10 22 /* descriptor for a comment. */ 10 23 2 group1 unaligned, 10 24 3 version fixed bin(17), /* comment descriptor version. */ 10 25 3 size fixed bin(17), /* comment descriptor size (in words). */ 10 26 2 Pnext ptr unal, /* ptr to next comment descriptor. */ 10 27 2 Plast ptr unal, /* ptr to last comment descriptor. */ 10 28 2 Pvalue ptr unal, /* ptr to comment. */ 10 29 2 Lvalue fixed bin(18), /* length of comment. */ 10 30 2 group2 unaligned, 10 31 3 line_no fixed bin(17), /* line no of line containing comment. */ 10 32 3 S, /* switches: */ 10 33 4 before_stmt bit(1), /* comment is before 1st token of stmt. */ 10 34 4 contiguous bit(1), /* no tokens between this and last comment. */ 10 35 4 pad bit(16), 10 36 comment_value char(comment.Lvalue) based (comment.Pvalue), 10 37 /* body of comment. */ 10 38 Pcomment ptr; /* ptr to comment descriptor. */ 10 39 10 40 dcl 10 41 1 stmt aligned based (Pstmt), 10 42 /* descriptor for a statement. */ 10 43 2 group1 unaligned, 10 44 3 version fixed bin(17), /* statement descriptor version. */ 10 45 3 size fixed bin(17), /* statement descriptor size (in words). */ 10 46 2 Pnext ptr unal, /* ptr to next statement descriptor. */ 10 47 2 Plast ptr unal, /* ptr to last statement descriptor. */ 10 48 2 Pvalue ptr unal, /* ptr to statement. */ 10 49 2 Lvalue fixed bin(18), /* length of statement. */ 10 50 2 Pfirst_token ptr unal, /* ptr to 1st token of statement. */ 10 51 2 Plast_token ptr unal, /* ptr to last token of statement. */ 10 52 2 Pcomments ptr unal, /* ptr to comments in statement. */ 10 53 2 Puser ptr unal, /* user-defined ptr. */ 10 54 2 group2 unaligned, 10 55 3 Ntokens fixed bin(17), /* number of tokens in statement. */ 10 56 3 line_no fixed bin(17), /* line no of line on which statement begins. */ 10 57 3 Istmt_in_line fixed bin(17), /* number of stmts in line containing this stmt. */ 10 58 /* (the number includes this stmt.) */ 10 59 3 semant_type fixed bin(17), /* semantic type of the statement. */ 10 60 3 S, /* switches: */ 10 61 4 error_in_stmt bit(1), /* stmt contains a syntactic error. */ 10 62 4 output_in_err_msg bit(1), /* stmt has been output in previous error message.*/ 10 63 4 pad bit(34), 10 64 stmt_value char(stmt.Lvalue) based (stmt.Pvalue), 10 65 /* text of the statement. */ 10 66 Pstmt ptr; /* ptr to a stmt descriptor. */ 10 67 10 68 dcl 10 69 1 token aligned based (Ptoken), 10 70 /* descriptor for a token. */ 10 71 2 group1 unaligned, 10 72 3 version fixed bin(17), /* token descriptor version. */ 10 73 3 size fixed bin(17), /* token descriptor size (in words). */ 10 74 2 Pnext ptr unal, /* ptr to next token descriptor. */ 10 75 2 Plast ptr unal, /* ptr to last token descriptor. */ 10 76 2 Pvalue ptr unal, /* ptr to token. */ 10 77 2 Lvalue fixed bin(18), /* length of token. */ 10 78 2 Pstmt ptr unal, /* ptr to descriptor of stmt containing token. */ 10 79 2 Psemant ptr unal, /* ptr to descriptor(s) of token's semantic value.*/ 10 80 2 group2 unaligned, 10 81 3 Itoken_in_stmt fixed bin(17), /* position of token within its statement. */ 10 82 3 line_no fixed bin(17), /* line number of the line containing the token. */ 10 83 3 Nvalue fixed bin(35), /* numeric value of decimal-integer tokens. */ 10 84 3 S, /* switches: */ 10 85 4 end_of_stmt bit(1), /* token is an end-of-stmt token. */ 10 86 4 quoted_string bit(1), /* token is a quoted string. */ 10 87 4 quotes_in_string bit(1), /* on if quote-close delimiters appear in quoted */ 10 88 /* string (as doubled quotes on input.) */ 10 89 4 quotes_doubled bit(1), /* on if quotes in the string are doubled after */ 10 90 /* string has been lexed into a token. */ 10 91 4 pad2 bit(32), 10 92 token_value char(token.Lvalue) based (token.Pvalue), 10 93 /* value of the token. */ 10 94 Ptoken ptr; /* ptr to a token descriptor. */ 10 95 10 96 /* END OF: lex_descriptors_.incl.pl1 * * * * * * */ 9 25 9 26 9 27 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 9 28 9 29 9 30 SEMANTIC_ANALYSIS: procedure; /* procedure which analyzes the syntax and */ 9 31 /* semantics of the tokens in the input list. */ 9 32 9 33 dcl /* automatic variables */ 9 34 LTOKEN_REQD_VALUE fixed bin(18), /* length of a token requirement. */ 9 35 NRED fixed bin, /* number of the reduction tokens are being */ 9 36 /* compared to. */ 9 37 PRED ptr, /* ptr to the reduction tokens are being */ 9 38 /* compared to. */ 9 39 PTOKEN_REQD ptr, /* ptr to token requirement descriptor associated */ 9 40 /* with reduction tokens are being compared to. */ 9 41 PTOKEN_REQD_VALUE ptr, /* ptr to a token requirement. */ 9 42 STOKEN_FCN bit(1) aligned, /* return value from a relative syntax function. */ 9 43 CODE fixed bin(35), /* an error code. */ 9 44 I fixed bin, /* a do-group index. */ 9 45 NUMBER fixed bin(35); /* fixed binary representation of a decimal */ 9 46 /* number character string. */ 9 47 9 48 dcl /* based variables */ 9 49 1 RED aligned based (PRED), 9 50 /* descriptor for reduction tokens are being */ 9 51 /* compared to. */ 9 52 2 TOKEN_REQD unaligned, 9 53 3 IFIRST fixed bin(17) unal, /* index of first token requirement. */ 9 54 3 ILAST fixed bin(17) unal, /* index of last token requirement associated */ 9 55 /* with this reduction. */ 9 56 1 TOKEN_REQD aligned based (PTOKEN_REQD), 9 57 /* a token requirement descriptor. */ 9 58 2 FORM fixed bin(17) unal, /* form of the token requirement: */ 9 59 /* -1 = relative token requirement function; */ 9 60 /* TYPE = index of the particular token */ 9 61 /* function in the token_fcn array. */ 9 62 /* 0 = built-in token requirement function; */ 9 63 /* TYPE = as defined below. */ 9 64 /* >0 = absolute token requirement: */ 9 65 /* FORM = index(TOKEN_STRINGS,TOKEN_REQD); */ 9 66 /* TYPE = length(TOKEN_REQD); */ 9 67 2 TYPE fixed bin(17) unal, /* TYPE of built-in token requirement function: */ 9 68 /* 1 = compile test to see if input token */ 9 69 /* chain is exhausted (). */ 9 70 /* 2 = compile test for any token value */ 9 71 /* (). */ 9 72 /* 3 = compile test for a PL/I identifier */ 9 73 /* () of 32 or fewer characters. */ 9 74 /* 4 = compile test for token which is a */ 9 75 /* . */ 9 76 /* 5 = compile test for token which is a single */ 9 77 /* backspace character (). */ 9 78 /* 6 = compile test for a token which is a */ 9 79 /* . */ 9 80 9 81 1 TOKEN_REQD_STRING aligned based (PTOKEN_REQD), 9 82 /* overlay for an absolute token requirement */ 9 83 /* descriptor. */ 9 84 2 I fixed bin(17) unal, /* index into list of token strings of the */ 9 85 /* absolute token string assoc w/ descriptor. */ 9 86 2 L fixed bin(17) unal, /* length of the absolute token string. */ 9 87 TOKEN_REQD_VALUE char(LTOKEN_REQD_VALUE) based (PTOKEN_REQD_VALUE); 9 88 /* absolute token string which token is reqd */ 9 89 /* to match in order for tokens which are */ 9 90 /* "current" on the list to match the reduction. */ 9 91 9 92 dcl /* builtin functions */ 9 93 (addr, max, null, search, substr, verify) 9 94 builtin; 9 95 9 96 dcl /* entries */ 9 97 cv_dec_check_ entry (char(*), fixed bin(35)) returns (fixed bin(35)); 9 98 9 99 dcl /* static variables */ 9 100 BACKSPACE char(1) aligned int static init (""); 9 101 9 102 /* END OF: rdc_start_.incl.pl1 * * * * * * */ 1602 1603 1604 dcl DIRECTION fixed bin init(+1); /* direction in which tokens compared. */ 1605 dcl STACK (10) fixed bin, /* reduction label stack. */ 1606 STACK_DEPTH fixed bin init (0); /* index into STACK. */ 1607 1608 1609 dcl 1 REDUCTION (64) unaligned based (addr (REDUCTIONS)), 1610 /* object reductions. */ 1611 2 TOKEN_REQD, 1612 3 IFIRST fixed bin(17), /* index of first required token. */ 1613 3 ILAST fixed bin(17), /* index of last required token. */ 1614 1615 REDUCTIONS (128) fixed bin(17) unaligned internal static options(constant) initial ( 1616 1, 4, /* 1/ Descriptor : ; */ 1617 1, 1, /* 2/ Descriptor */ 1618 5, 5, /* 3/ */ 1619 6, 6, /* 4/ */ 1620 7, 8, /* 5/ Root : */ 1621 7, 7, /* 6/ Root */ 1622 9, 12, /* 7/ Define : commands ; */ 1623 13, 15, /* 8/ Define : */ 1624 9, 9, /* 9/ Define */ 1625 16, 19, /* 10/ End : ; */ 1626 20, 23, /* 11/ End : ; */ 1627 16, 16, /* 12/ End */ 1628 6, 6, /* 13/ */ 1629 5, 5, /* 14/ */ 1630 4, 4, /* 15/ ; */ 1631 24, 25, /* 16/ ( */ 1632 26, 27, /* 17/ ( */ 1633 25, 25, /* 18/ */ 1634 6, 6, /* 19/ */ 1635 5, 5, /* 20/ */ 1636 28, 31, /* 21/ ) . ( */ 1637 32, 35, /* 22/ ) . ( */ 1638 28, 28, /* 23/ ) */ 1639 4, 4, /* 24/ ; */ 1640 25, 25, /* 25/ */ 1641 27, 27, /* 26/ */ 1642 6, 6, /* 27/ */ 1643 5, 5, /* 28/ */ 1644 36, 39, /* 29/ path : ; */ 1645 40, 43, /* 30/ path : ; */ 1646 36, 36, /* 31/ path */ 1647 44, 47, /* 32/ type : archive ; */ 1648 48, 51, /* 33/ type : directory ; */ 1649 52, 54, /* 34/ type : */ 1650 44, 44, /* 35/ type */ 1651 55, 59, /* 36/ search procedure : ; */ 1652 60, 64, /* 37/ search procedure : ; */ 1653 55, 55, /* 38/ search */ 1654 6, 6, /* 39/ */ 1655 5, 5, /* 40/ */ 1656 65, 68, /* 41/ command : ; */ 1657 69, 73, /* 42/ unsupported command : ; */ 1658 74, 74, /* 43/ library */ 1659 55, 55, /* 44/ search */ 1660 75, 78, /* 45/ command : ; */ 1661 79, 83, /* 46/ unsupported command : ; */ 1662 6, 6, /* 47/ */ 1663 5, 5, /* 48/ */ 1664 84, 86, /* 49/ library names : */ 1665 87, 89, /* 50/ library name : */ 1666 90, 92, /* 51/ search names : */ 1667 93, 95, /* 52/ search name : */ 1668 6, 6, /* 53/ */ 1669 5, 5, /* 54/ */ 1670 96, 95, /* 55/ */ 1671 96, 95, /* 56/ */ 1672 4, 4, /* 57/ ; */ 1673 96, 96, /* 58/ */ 1674 4, 4, /* 59/ ; */ 1675 6, 6, /* 60/ */ 1676 5, 5, /* 61/ */ 1677 5, 5, /* 62/ */ 1678 6, 6, /* 63/ */ 1679 97, 96); /* 64/ */ 1680 1681 dcl 1 TOKEN_REQUIREMENT (96) unaligned based (addr (TOKEN_REQUIREMENTS)), 1682 /* object token requirements. */ 1683 2 FORM fixed bin(17), /* form of the token requirement: */ 1684 /* -1 = relative token requirement function; */ 1685 /* TYPE = index of the particular token */ 1686 /* function in the token_fcn array. */ 1687 /* 0 = built-in token requirement function; */ 1688 /* TYPE = as defined below. */ 1689 /* >0 = absolute token requirement: */ 1690 /* FORM = index(TOKEN_STRINGS,TOKEN_REQD); */ 1691 /* TYPE = length(TOKEN_REQD); */ 1692 2 TYPE fixed bin(17) unal, /* type of the built-in token requirement */ 1693 /* function: */ 1694 /* 1 = compile test to see if input token */ 1695 /* chain is exhausted (). */ 1696 /* 2 = compile test for any token value */ 1697 /* (). */ 1698 /* 3 = compile test for a PL/I identifier */ 1699 /* () of 32 or fewer characters. */ 1700 /* 4 = compile test for token which is a */ 1701 /* . */ 1702 /* 5 = compile test for token which is a single */ 1703 /* backspace character (). */ 1704 /* 6 = compile test for a token which is a */ 1705 /* . */ 1706 1707 TOKEN_REQUIREMENTS (192) fixed bin(17) unaligned internal static options(constant) initial ( 1708 1, 10, 11, 1, 0, 3, 12, 1, 0, 1, 0, 2, 13, 4, 1709 11, 1, 17, 6, 11, 1, 23, 8, 12, 1, 17, 6, 11, 1, 1710 0, 2, 31, 3, 11, 1, -1, 1, 12, 1, 31, 3, 11, 1, 1711 0, 3, 12, 1, 34, 1, -1, 2, 34, 1, -1, 3, 35, 1, 1712 36, 1, 34, 1, -1, 2, 35, 1, 36, 1, 34, 1, -1, 3, 1713 37, 4, 11, 1, -1, 4, 12, 1, 37, 4, 11, 1, 0, 2, 1714 12, 1, 41, 4, 11, 1, 45, 7, 12, 1, 41, 4, 11, 1, 1715 52, 9, 12, 1, 41, 4, 11, 1, 0, 2, 61, 6, 67, 9, 1716 11, 1, -1, 5, 12, 1, 61, 6, 67, 9, 11, 1, 0, 2, 1717 12, 1, 23, 7, 11, 1, -1, 6, 12, 1, 76, 11, 23, 7, 1718 11, 1, -1, 6, 12, 1, 87, 7, 23, 7, 11, 1, 0, 2, 1719 12, 1, 76, 11, 23, 7, 11, 1, 0, 2, 12, 1, 87, 7, 1720 94, 5, 11, 1, 87, 7, 94, 4, 11, 1, 61, 6, 94, 5, 1721 11, 1, 61, 6, 94, 4, 11, 1, -1, 7); 1722 1723 1724 dcl TOKEN_STRINGS char(98) aligned based (addr (TOKEN_STRING_ARRAYS)), 1725 /* object token values. */ 1726 TOKEN_STRING_ARRAYS (1) char(100) aligned internal static options(constant) initial ( 1727 "Descriptor:;RootDefinecommandsEnd().pathtypearchivedirectorysearchprocedureunsupportedlibrarynames"); 1728 1729 /* START OF: rdc_end_.incl.pl1 * * * * * * * * * * * * * * * * */ 11 2 11 3 11 4 /****^ HISTORY COMMENTS: 11 5* 1) change(86-02-14,GWMay), approve(), audit(), install(): 11 6* old history comments: 11 7* 0) Created: April, 1974 by G. C. Dixon 11 8* 1) Modified: Feb, 1975 by G. C. Dixon 11 9* a) support for Version 2.0 of reduction_compiler. 11 10* 2) Modified: Feb, 1981 by G. C. Dixon 11 11* a) support for Version 2.2 of reduction_compiler 11 12* 3) Modified: Aug, 1983 by G. C. Dixon - support for Version 2.3 of 11 13* reductions command. 11 14* 2) change(86-03-04,GDixon), approve(86-03-04,MCR7362), audit(86-03-17,GWMay), 11 15* install(86-03-17,MR12.0-1032): 11 16* Changed how the PUSH DOWN LANGUAGE (SPDL) definition of is 11 17* implemented to avoid references through a null pointer. The two 11 18* accepted uses are: 11 19* 11 20* / / ... / ... \ 11 21* A 11 22* | 11 23* Pthis_token (points to top of push down stack) 11 24* 11 25* which checks to see if the push down stack is totally exhausted (ie, 11 26* Ptoken = null); and: 11 27* 11 28* / SPEC1 ... SPECN / ... / ... \ 11 29* A 11 30* | 11 31* Pthis_token (points to top of push down stack) 11 32* 11 33* which checks to see whether SPECN is topmost on the push down stack 11 34* AND is the final token in the input list. 11 35* END HISTORY COMMENTS */ 11 36 11 37 11 38 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 11 39 /* */ 11 40 /* NAME: rdc_end_.incl.pl1 */ 11 41 /* */ 11 42 /* This include segment is used by compilers generated by the reduction_compiler. */ 11 43 /* Such compilers include a SEMANTIC_ANALYSIS subroutine generated by the */ 11 44 /* reduction_compiler. This subroutine compares a chain of input tokens with token */ 11 45 /* requirements specified in reductions. The code in this include segment performs the */ 11 46 /* actual comparisons. This code is the middle part of the SEMANTIC_ANALYSIS procedure. */ 11 47 /* */ 11 48 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 11 49 11 50 TRACING = TRACING; /* Kludge to prevent pl1 from making TRACING */ 11 51 /* options(constant) because it is never set. */ 11 52 NRED = 1; 11 53 go to RD_TEST_REDUCTION; 11 54 11 55 RD_NEXT_REDUCTION: 11 56 NRED = NRED + 1; 11 57 11 58 RD_TEST_REDUCTION: 11 59 PRED = addr(REDUCTION(NRED)); 11 60 Ptoken = Pthis_token; 11 61 11 62 do I = RED.TOKEN_REQD.IFIRST to RED.TOKEN_REQD.ILAST by DIRECTION; 11 63 PTOKEN_REQD = addr(TOKEN_REQUIREMENT(I)); 11 64 if Ptoken = null then do; 11 65 if TOKEN_REQD.FORM = 0 then /* No more tokens. Only matches spec. */ 11 66 if TOKEN_REQD.TYPE = 1 then 11 67 go to RD_TEST_TOKEN(1); 11 68 go to RD_NEXT_REDUCTION; 11 69 end; 11 70 if TOKEN_REQD.FORM = 0 then do; /* built-in syntax function. */ 11 71 go to RD_TEST_TOKEN(TOKEN_REQD.TYPE); 11 72 11 73 RD_TEST_TOKEN(1): if SPDL then /* */ 11 74 /* In push-down-language, there are 2 */ 11 75 /* interpretations of . */ 11 76 if RED.TOKEN_REQD.IFIRST = RED.TOKEN_REQD.ILAST & 11 77 Ptoken = null then /* When is only spec, the spec asks */ 11 78 go to RD_MATCH_NO_TOKEN; /* "Is push down stack empty (all input gone)?" */ 11 79 else if RED.TOKEN_REQD.IFIRST^= RED.TOKEN_REQD.ILAST & 11 80 RED.TOKEN_REQD.IFIRST = I & 11 81 token.Pnext = null then /* For SPEC1 ... SPECN , the spec asks */ 11 82 go to RD_MATCH_NO_TOKEN; /* "Are the topmost tokens on stack SPEC1 - SPECN,*/ 11 83 /* and is SPECN the final input token?" */ 11 84 else go to RD_NEXT_REDUCTION; /* Those are the only two defs allowed in push */ 11 85 /* down language mode for . */ 11 86 else if Ptoken = null then 11 87 go to RD_MATCH_NO_TOKEN; 11 88 go to RD_NEXT_REDUCTION; 11 89 11 90 RD_TEST_TOKEN(2): go to RD_MATCH; /* */ 11 91 11 92 RD_TEST_TOKEN(3): if token.Lvalue > 0 & /* */ 11 93 token.Lvalue <= 32 & ^token.S.quoted_string then 11 94 if search(substr(token_value,1,1),"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz") 11 95 > 0 then 11 96 if verify(token_value,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_$") 11 97 = 0 then 11 98 go to RD_MATCH; 11 99 go to RD_NEXT_REDUCTION; 11 100 11 101 RD_TEST_TOKEN(4): /* */ 11 102 if token.Nvalue ^= 0 then /* token already determined to be a number. */ 11 103 go to RD_MATCH; 11 104 if token.S.quoted_string then 11 105 go to RD_NEXT_REDUCTION; 11 106 NUMBER = cv_dec_check_ (token_value, CODE); 11 107 if CODE = 0 then do; 11 108 token.Nvalue = NUMBER; 11 109 go to RD_MATCH; 11 110 end; 11 111 go to RD_NEXT_REDUCTION; 11 112 11 113 RD_TEST_TOKEN(5): if token.Lvalue = 1 then /* */ 11 114 if token_value = BACKSPACE & ^token.S.quoted_string then 11 115 go to RD_MATCH; 11 116 go to RD_NEXT_REDUCTION; 11 117 11 118 RD_TEST_TOKEN(6): if token.S.quoted_string then /* */ 11 119 go to RD_MATCH; 11 120 go to RD_NEXT_REDUCTION; 11 121 end; 11 122 11 123 else if TOKEN_REQD.FORM > 0 then do; /* absolute syntax specification. */ 11 124 if token.S.quoted_string then 11 125 go to RD_NEXT_REDUCTION; 11 126 PTOKEN_REQD_VALUE = addr(substr(TOKEN_STRINGS,TOKEN_REQD_STRING.I)); 11 127 LTOKEN_REQD_VALUE = TOKEN_REQD_STRING.L; 11 128 if token_value = TOKEN_REQD_VALUE then 11 129 go to RD_MATCH; 11 130 go to RD_NEXT_REDUCTION; 11 131 end; 11 132 11 133 /* END OF: rdc_end_.incl.pl1 * * * * * * * * * * * * * * * * */ 1729 1730 1731 else do; /* relative syntax function. */ 1732 go to RD_TOKEN_FCN(TOKEN_REQD.TYPE); 1733 1734 RD_TOKEN_FCN(1): STOKEN_FCN = descriptor_name(); 1735 go to RD_TEST_RESULT; 1736 RD_TOKEN_FCN(2): STOKEN_FCN = valid_name(); 1737 go to RD_TEST_RESULT; 1738 RD_TOKEN_FCN(3): STOKEN_FCN = null_string_name(); 1739 go to RD_TEST_RESULT; 1740 RD_TOKEN_FCN(4): STOKEN_FCN = absolute_pathname(); 1741 go to RD_TEST_RESULT; 1742 RD_TOKEN_FCN(5): STOKEN_FCN = entryname(); 1743 go to RD_TEST_RESULT; 1744 RD_TOKEN_FCN(6): STOKEN_FCN = command_name_(); 1745 go to RD_TEST_RESULT; 1746 RD_TOKEN_FCN(7): STOKEN_FCN = starname(); 1747 go to RD_TEST_RESULT; 1748 1749 RD_TEST_RESULT: if STOKEN_FCN then go to RD_MATCH; 1750 else go to RD_NEXT_REDUCTION; 1751 end; 1752 1753 RD_MATCH: Ptoken = token.Pnext; 1754 RD_MATCH_NO_TOKEN: 1755 end; 1756 Ptoken = Pthis_token; 1757 go to RD_ACTION(NRED); 1758 1759 /* START OF: rdc_stack_fcns_.incl.pl1 * * * * * * */ 12 2 12 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 12 4 /* */ 12 5 /* N__a_m_e: rdc_stack_fcns_.incl.pl1 */ 12 6 /* */ 12 7 /* This include segment is used by compilers generated by the */ 12 8 /* reduction_compiler. It includes code for manipulating the */ 12 9 /* reduction label stack. */ 12 10 /* */ 12 11 /* S__t_a_t_u_s */ 12 12 /* */ 12 13 /* 0) Created: April, 1974 by G. C. Dixon */ 12 14 /* */ 12 15 /* * * * * * * * * * * * * * * * * * * * * * * */ 12 16 12 17 RD_STACK: if STACK_DEPTH > 0 then do; 12 18 NRED = STACK (STACK_DEPTH); 12 19 go to RD_TEST_REDUCTION; 12 20 end; 12 21 else 12 22 go to RD_NEXT_REDUCTION; 12 23 12 24 RD_STACK_POP: 12 25 if STACK_DEPTH > 0 then do; 12 26 NRED = STACK (STACK_DEPTH); 12 27 STACK_DEPTH = max (STACK_DEPTH-1, 0); 12 28 go to RD_TEST_REDUCTION; 12 29 end; 12 30 else 12 31 go to RD_NEXT_REDUCTION; 12 32 12 33 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 12 34 12 35 12 36 PUSH: procedure (N); /* invoked to push reduction number 'N' onto */ 12 37 /* the reduction stack. */ 12 38 dcl N fixed bin; 12 39 12 40 dcl (addr, dimension, length, null) 12 41 builtin; 12 42 12 43 dcl cu_$cl entry, 12 44 iox_$put_chars entry (ptr, ptr, fixed bin, fixed bin(35)), 12 45 iox_$error_output ptr ext static, 12 46 lex_error_ entry options(variable); 12 47 12 48 dcl brief_error char(4) varying initial ("") int static, 12 49 long_error char(234) varying int static init( 12 50 "An internal stack (the reduction stack) has overflowed. 12 51 The translation has failed. Contact translator maintenance 12 52 personnel for assistance. 12 53 Processing reduction: ^d 12 54 Reduction being stacked: ^d 12 55 Maximum stack depth: ^d"), 12 56 non_restart_error char(33) int static init ("Translation cannot be restarted. 12 57 "); 12 58 12 59 if STACK_DEPTH >= dimension (STACK, 1) then do; 12 60 call lex_error_ (0, "0"b, 4, 0, null, null, "11"b, long_error, brief_error, NRED, N, 12 61 dimension(STACK,1)); 12 62 get_to_cl: call cu_$cl(); 12 63 call iox_$put_chars (iox_$error_output, addr(non_restart_error), length(non_restart_error), 0); 12 64 go to get_to_cl; 12 65 end; /* stack overflow is a non-recoverable error. */ 12 66 else 12 67 STACK_DEPTH = STACK_DEPTH + 1; 12 68 STACK (STACK_DEPTH) = N; 12 69 12 70 end PUSH; 12 71 12 72 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 12 73 12 74 /* END OF: rdc_stack_fcns_.incl.pl1 * * * * * * */ 1759 1760 1761 1762 RD_ACTION(1): /* / */ 1763 call LEX ( 2 ); 1764 obj_desc.name = token_value; 1765 call LEX ( 2 ); 1766 call descriptor_begin(); 1767 NRED = 5; 1768 go to RD_TEST_REDUCTION; /* / descriptor_body \ */ 1769 1770 RD_ACTION(2): /* / */ 1771 call ERROR ( 1 ); 1772 call descriptor_begin(); 1773 call NEXT_STMT(); 1774 NRED = 1; 1775 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 1776 1777 RD_ACTION(3): /* / */ 1778 call ERROR ( 2 ); 1779 NRED = 64; 1780 go to RD_TEST_REDUCTION; /* / stop \ */ 1781 1782 RD_ACTION(4): /* / */ 1783 call ERROR ( 3 ); 1784 call descriptor_begin(); 1785 go to RD_NEXT_REDUCTION; /* / \ */ 1786 1787 RD_ACTION(5): /* / */ 1788 call LEX ( 2 ); 1789 call root_begin(); 1790 call PUSH(29); /* PUSH(root_body) */ 1791 NRED = 15; 1792 go to RD_TEST_REDUCTION; /* / names \ */ 1793 1794 RD_ACTION(6): /* / */ 1795 call ERROR ( 4 ); 1796 call NEXT_STMT(); 1797 call root_begin(); 1798 NRED = 29; 1799 go to RD_TEST_REDUCTION; /* / root_body \ */ 1800 1801 RD_ACTION(7): /* / */ 1802 Icommand = 0; 1803 call NEXT_STMT(); 1804 NRED = 41; 1805 go to RD_TEST_REDUCTION; /* / command_block \ */ 1806 1807 RD_ACTION(8): /* / */ 1808 call ERROR ( 7 ); 1809 call NEXT_STMT(); 1810 NRED = 5; 1811 go to RD_TEST_REDUCTION; /* / descriptor_body \ */ 1812 1813 RD_ACTION(9): /* / */ 1814 call ERROR ( 1 ); 1815 call NEXT_STMT(); 1816 NRED = 5; 1817 go to RD_TEST_REDUCTION; /* / descriptor_body \ */ 1818 1819 RD_ACTION(10): /* / */ 1820 call NEXT_STMT(); 1821 NRED = 62; 1822 go to RD_TEST_REDUCTION; /* / end \ */ 1823 1824 RD_ACTION(11): /* / */ 1825 call ERROR ( 6 ); 1826 call NEXT_STMT(); 1827 NRED = 62; 1828 go to RD_TEST_REDUCTION; /* / end \ */ 1829 1830 RD_ACTION(12): /* / */ 1831 call ERROR ( 1 ); 1832 call NEXT_STMT(); 1833 NRED = 62; 1834 go to RD_TEST_REDUCTION; /* / end \ */ 1835 1836 RD_ACTION(13): /* / */ 1837 call ERROR ( 8 ); 1838 call NEXT_STMT(); 1839 NRED = 5; 1840 go to RD_TEST_REDUCTION; /* / descriptor_body \ */ 1841 1842 RD_ACTION(14): /* / */ 1843 call ERROR ( 9 ); 1844 NRED = 64; 1845 go to RD_TEST_REDUCTION; /* / stop \ */ 1846 1847 RD_ACTION(15): /* / */ 1848 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1849 go to RD_STACK_POP; /* / STACK_POP \ */ 1850 1851 RD_ACTION(16): /* / */ 1852 call new_element ( Pfirst_name_elements ); 1853 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1854 NRED = 21; 1855 go to RD_TEST_REDUCTION; /* / name_elements \ */ 1856 1857 RD_ACTION(17): /* / */ 1858 call new_element ( Pfirst_name_elements ); 1859 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1860 NRED = 21; 1861 go to RD_TEST_REDUCTION; /* / name_elements \ */ 1862 1863 RD_ACTION(18): /* / */ 1864 call set_name(); 1865 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1866 NRED = 15; 1867 go to RD_TEST_REDUCTION; /* / names \ */ 1868 1869 RD_ACTION(19): /* / */ 1870 call ERROR ( 12 ); 1871 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1872 NRED = 15; 1873 go to RD_TEST_REDUCTION; /* / names \ */ 1874 1875 RD_ACTION(20): /* / */ 1876 call ERROR ( 13 ); 1877 NRED = 64; 1878 go to RD_TEST_REDUCTION; /* / stop \ */ 1879 1880 RD_ACTION(21): /* / */ 1881 call new_element ( name_elements.Pnext ); 1882 call LEX ( 3 ); 1883 NRED = 21; 1884 go to RD_TEST_REDUCTION; /* / name_elements \ */ 1885 1886 RD_ACTION(22): /* / */ 1887 call new_element ( name_elements.Pnext ); 1888 call LEX ( 3 ); 1889 NRED = 21; 1890 go to RD_TEST_REDUCTION; /* / name_elements \ */ 1891 1892 RD_ACTION(23): /* / */ 1893 call combine_elements ( Pfirst_name_elements, "" ); 1894 Pname = addr ( obj_root_name ); 1895 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1896 NRED = 15; 1897 go to RD_TEST_REDUCTION; /* / names \ */ 1898 1899 RD_ACTION(24): /* / */ 1900 call combine_elements ( Pfirst_name_elements, "" ); 1901 call ERROR ( 11 ); 1902 Pname = addr ( obj_root_name ); 1903 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1904 go to RD_STACK_POP; /* / STACK_POP \ */ 1905 1906 RD_ACTION(25): /* / */ 1907 call set_element(); 1908 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1909 NRED = 21; 1910 go to RD_TEST_REDUCTION; /* / name_elements \ */ 1911 1912 RD_ACTION(26): /* / */ 1913 call set_element(); 1914 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1915 NRED = 21; 1916 go to RD_TEST_REDUCTION; /* / name_elements \ */ 1917 1918 RD_ACTION(27): /* / */ 1919 call ERROR ( 12 ); 1920 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 1921 NRED = 21; 1922 go to RD_TEST_REDUCTION; /* / name_elements \ */ 1923 1924 RD_ACTION(28): /* / */ 1925 call ERROR ( 13 ); 1926 NRED = 64; 1927 go to RD_TEST_REDUCTION; /* / stop \ */ 1928 1929 RD_ACTION(29): /* / */ 1930 call LEX ( 2 ); 1931 obj_root.path = token_value; 1932 call LEX ( 2 ); 1933 NRED = 29; 1934 go to RD_TEST_REDUCTION; /* / root_body \ */ 1935 1936 RD_ACTION(30): /* / */ 1937 call ERROR ( 15 ); 1938 call NEXT_STMT(); 1939 NRED = 29; 1940 go to RD_TEST_REDUCTION; /* / root_body \ */ 1941 1942 RD_ACTION(31): /* / */ 1943 call ERROR ( 1 ); 1944 call NEXT_STMT(); 1945 NRED = 29; 1946 go to RD_TEST_REDUCTION; /* / root_body \ */ 1947 1948 RD_ACTION(32): /* / */ 1949 call LEX ( 4 ); 1950 obj_root.type = Tarchive; 1951 NRED = 29; 1952 go to RD_TEST_REDUCTION; /* / root_body \ */ 1953 1954 RD_ACTION(33): /* / */ 1955 call LEX ( 4 ); 1956 NRED = 29; 1957 go to RD_TEST_REDUCTION; /* / root_body \ */ 1958 1959 RD_ACTION(34): /* / */ 1960 call LEX ( 2 ); 1961 call ERROR ( 38 ); 1962 call NEXT_STMT(); 1963 NRED = 29; 1964 go to RD_TEST_REDUCTION; /* / root_body \ */ 1965 1966 RD_ACTION(35): /* / */ 1967 call ERROR ( 1 ); 1968 call NEXT_STMT(); 1969 NRED = 29; 1970 go to RD_TEST_REDUCTION; /* / root_body \ */ 1971 1972 RD_ACTION(36): /* / */ 1973 call LEX ( 3 ); 1974 search_proc.ename = ename; 1975 call LEX ( 2 ); 1976 NRED = 29; 1977 go to RD_TEST_REDUCTION; /* / root_body \ */ 1978 1979 RD_ACTION(37): /* / */ 1980 call ERROR ( 5 ); 1981 call NEXT_STMT(); 1982 NRED = 29; 1983 go to RD_TEST_REDUCTION; /* / root_body \ */ 1984 1985 RD_ACTION(38): /* / */ 1986 call ERROR ( 1 ); 1987 call NEXT_STMT(); 1988 NRED = 29; 1989 go to RD_TEST_REDUCTION; /* / root_body \ */ 1990 1991 RD_ACTION(39): /* / */ 1992 call root_end(); 1993 NRED = 5; 1994 go to RD_TEST_REDUCTION; /* / descriptor_body \ */ 1995 1996 RD_ACTION(40): /* / */ 1997 call ERROR ( 9 ); 1998 NRED = 64; 1999 go to RD_TEST_REDUCTION; /* / stop \ */ 2000 2001 RD_ACTION(41): /* / */ 2002 call LEX ( 4 ); 2003 Scommand = "1"b; 2004 call command_begin(); 2005 NRED = 49; 2006 go to RD_TEST_REDUCTION; /* / default_value \ */ 2007 2008 RD_ACTION(42): /* / */ 2009 call LEX ( 5 ); 2010 Scommand = "0"b; 2011 call command_begin(); 2012 NRED = 41; 2013 go to RD_TEST_REDUCTION; /* / command_block \ */ 2014 2015 RD_ACTION(43): /* / */ 2016 call ERROR ( 35 ); 2017 call NEXT_STMT(); 2018 NRED = 41; 2019 go to RD_TEST_REDUCTION; /* / command_block \ */ 2020 2021 RD_ACTION(44): /* / */ 2022 call ERROR ( 36 ); 2023 call NEXT_STMT(); 2024 NRED = 41; 2025 go to RD_TEST_REDUCTION; /* / command_block \ */ 2026 2027 RD_ACTION(45): /* / */ 2028 call LEX ( 2 ); 2029 call ERROR ( 25 ); 2030 call NEXT_STMT(); 2031 NRED = 41; 2032 go to RD_TEST_REDUCTION; /* / command_block \ */ 2033 2034 RD_ACTION(46): /* / */ 2035 call LEX ( 3 ); 2036 call ERROR ( 25 ); 2037 call NEXT_STMT(); 2038 NRED = 41; 2039 go to RD_TEST_REDUCTION; /* / command_block \ */ 2040 2041 RD_ACTION(47): /* / */ 2042 NRED = 5; 2043 go to RD_TEST_REDUCTION; /* / descriptor_body \ */ 2044 2045 RD_ACTION(48): /* / */ 2046 call ERROR ( 9 ); 2047 NRED = 64; 2048 go to RD_TEST_REDUCTION; /* / stop \ */ 2049 2050 RD_ACTION(49): /* / */ 2051 NRED = 55; 2052 go to RD_TEST_REDUCTION; /* / library_names \ */ 2053 2054 RD_ACTION(50): /* / */ 2055 NRED = 55; 2056 go to RD_TEST_REDUCTION; /* / library_names \ */ 2057 2058 RD_ACTION(51): /* / */ 2059 NRED = 56; 2060 go to RD_TEST_REDUCTION; /* / search_names \ */ 2061 2062 RD_ACTION(52): /* / */ 2063 NRED = 56; 2064 go to RD_TEST_REDUCTION; /* / search_names \ */ 2065 2066 RD_ACTION(53): /* / */ 2067 call command_end(); 2068 NRED = 41; 2069 go to RD_TEST_REDUCTION; /* / command_block \ */ 2070 2071 RD_ACTION(54): /* / */ 2072 NRED = 41; 2073 go to RD_TEST_REDUCTION; /* / command_block \ */ 2074 2075 RD_ACTION(55): /* / */ 2076 Pname = addr ( obj_dflt_lib_names ); 2077 Pobj_star_code = addr ( obj_dflt_lib_codes ); 2078 call LEX ( 3 ); 2079 call PUSH(49); /* PUSH(default_value) */ 2080 NRED = 58; 2081 go to RD_TEST_REDUCTION; /* / starname \ */ 2082 2083 RD_ACTION(56): /* / */ 2084 Pname = addr ( obj_dflt_search_names ); 2085 Pobj_star_code = addr ( obj_dflt_search_codes ); 2086 call LEX ( 3 ); 2087 call PUSH(49); /* PUSH(default_value) */ 2088 NRED = 58; 2089 go to RD_TEST_REDUCTION; /* / starname \ */ 2090 2091 RD_ACTION(57): /* / */ 2092 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 2093 go to RD_STACK_POP; /* / STACK_POP \ */ 2094 2095 RD_ACTION(58): /* / */ 2096 call set_name(); 2097 call set_obj_star_code(); 2098 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 2099 NRED = 57; 2100 go to RD_TEST_REDUCTION; /* / starnames \ */ 2101 2102 RD_ACTION(59): /* / */ 2103 call ERROR ( 10 ); 2104 call NEXT_STMT(); 2105 go to RD_STACK_POP; /* / STACK_POP \ */ 2106 2107 RD_ACTION(60): /* / */ 2108 call ERROR ( 12 ); 2109 Ptoken, Pthis_token = Pthis_token -> token.Pnext; /* LEX */ 2110 NRED = 57; 2111 go to RD_TEST_REDUCTION; /* / starnames \ */ 2112 2113 RD_ACTION(61): /* / */ 2114 call ERROR ( 13 ); 2115 go to RD_STACK_POP; /* / STACK_POP \ */ 2116 2117 RD_ACTION(62): /* / */ 2118 NRED = 64; 2119 go to RD_TEST_REDUCTION; /* / stop \ */ 2120 2121 RD_ACTION(63): /* / */ 2122 call ERROR ( 17 ); 2123 NRED = 64; 2124 go to RD_TEST_REDUCTION; /* / stop \ */ 2125 2126 RD_ACTION(64): /* / */ 2127 call compile_descriptor(); 2128 return; /* / RETURN \ */ 2129 2130 2131 end SEMANTIC_ANALYSIS; 2132 2133 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 2134 2135 dcl SPDL bit(1) aligned init ("0"b); 2136 /* off: This compiler parses a non-PUSH DOWN */ 2137 /* LANGUAGE. */ 2138 /* START OF: rdc_lex_.incl.pl1 * * * * * * * * * * * * * * * * */ 13 2 13 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 13 4 /* */ 13 5 /* N__a_m_e: rdc_lex_.incl.pl1 */ 13 6 /* */ 13 7 /* This include segment is used by compilers generated by the reduction_compiler. */ 13 8 /* It contains the LEX subroutine which is used to manipulate the pointer to the */ 13 9 /* "current" token, Pthis_token. */ 13 10 /* */ 13 11 /* E__n_t_r_y: LEX */ 13 12 /* */ 13 13 /* This entry makes the |_nth|-next (or -preceding) token the "current" token, where */ 13 14 /* _n is its positive (or negative) input argument. */ 13 15 /* */ 13 16 /* U__s_a_g_e */ 13 17 /* */ 13 18 /* call LEX(n); */ 13 19 /* */ 13 20 /* 1) n is the number of the token to be made the "current" token, relative to the */ 13 21 /* token identified by Pthis_token (the present "current" token). If n is */ 13 22 /* positive, the nth token following the "current" token made "current". If n */ 13 23 /* is negative, the nth token preceding the "current" token is made "current". */ 13 24 /* */ 13 25 /* S__t_a_t_u_s */ 13 26 /* */ 13 27 /* 0) Created by: G. C. Dixon in February, 1975 */ 13 28 /* */ 13 29 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 13 30 13 31 LEX: procedure (n); 13 32 13 33 dcl n fixed bin, 13 34 i fixed bin; 13 35 13 36 Ptoken = Pthis_token; /* do everything relative to "current" token. */ 13 37 if Ptoken = null then return; /* can't lex if token list exhausted. */ 13 38 if n >= 0 then do; /* new "current" token will follow present one. */ 13 39 do i = 1 to n while (token.Pnext ^= null); /* find new "current" token, taking care not to */ 13 40 Ptoken = token.Pnext; /* run off end of token list. */ 13 41 end; 13 42 if ^SPDL then if i <= n then Ptoken = null; /* if not in 'PUSH DOWN LANGUAGE' mode, allow */ 13 43 /* running off end of token list. */ 13 44 end; 13 45 else /* new "current" token precedes present one. */ 13 46 do i = -1 to n by -1 while (token.Plast ^= null); 13 47 Ptoken = token.Plast; 13 48 end; 13 49 Pthis_token = Ptoken; /* simple wasn't it. */ 13 50 13 51 end LEX; 13 52 13 53 /* END OF: rdc_lex_.incl.pl1 * * * * * * * * * * * * * * * * */ 2138 2139 2140 /* START OF: rdc_error_.incl.pl1 * * * * * * * * * * * * * * * * */ 14 2 14 3 dcl MERROR_SEVERITY fixed bin init (0), /* Severity of highest-severity error. */ 14 4 SERROR_CONTROL bit(2) init ("00"b),/* Global switches control error message format. */ 14 5 SERROR_PRINTED (dimension (error_control_table,1)) 14 6 bit(1) unaligned init ((dimension (error_control_table,1))(1)"0"b), 14 7 /* Array bit is on if corresponding error message */ 14 8 /* in error_control_table has already been printed*/ 14 9 MIN_PRINT_SEVERITY fixed bin init (0), /* Mimimum severity message that will be printed */ 14 10 PRINT_SEVERITY_CONTROL bit(2) init ("11"b);/* Action if severity < MIN_PRINT_SEVERITY */ 14 11 14 12 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 14 13 /* */ 14 14 /* N__a_m_e: rdc_error_.incl.pl1 */ 14 15 /* */ 14 16 /* This include segment is used by compilers generated by the reduction_compiler. */ 14 17 /* It defines a procedure which the compilers can use to print error messages. */ 14 18 /* */ 14 19 /* E__n_t_r_y: ERROR */ 14 20 /* */ 14 21 /* Given an error number, this procedure prints a corresponding error message. */ 14 22 /* The message is stored in a compiler-defined error_control_table, along with an integer */ 14 23 /* which specifies the severity level of the error, and a switch which specifies whether */ 14 24 /* the source statement in which the error occurred (if any) should be printed after the */ 14 25 /* error message. The printing of the error message may be supressed for all messages */ 14 26 /* having a severity less than a specified (MIN_PRINT_SEVERITY) value. The ERROR */ 14 27 /* procedure calls the lex_error_ subroutine to perform the formatting and printing of */ 14 28 /* the error message. */ 14 29 /* */ 14 30 /* U__s_a_g_e */ 14 31 /* */ 14 32 /* call ERROR (error_number); */ 14 33 /* */ 14 34 /* 1) error_number is the index of one of the structures in the error_control_table */ 14 35 /* which defines the error message to be printed. */ 14 36 /* */ 14 37 /* N__o_t_e_s */ 14 38 /* */ 14 39 /* The format of the error_control_table is shown below. */ 14 40 /* */ 14 41 /* dcl 1 error_control_table (2) aligned internal static, */ 14 42 /* 2 severity fixed bin(17) unaligned init (2,3), */ 14 43 /* 2 Soutput_stmt bit(1) unaligned initial ("0"b,"1"b), */ 14 44 /* 2 message char(252) varying initial ( */ 14 45 /* "The reduction source segment does not contain any reductions.", */ 14 46 /* "Reduction label '^a' is invalid."), */ 14 47 /* 2 brief_message char(100) varying initial ( */ 14 48 /* "", "'^a'"); */ 14 49 /* */ 14 50 /* error_control_table is an array of structures, with one array element per error. */ 14 51 /* Each structure contains: a severity level for the error; a switch which specifies */ 14 52 /* whether the source statement being processed should be output after the error message; */ 14 53 /* the long form of the error message text; and the brief form of the error message text.*/ 14 54 /* The dimension of the error_control_table array of structures, and the lengths of */ 14 55 /* message (long message) and brief_message (brief message), are compiler-defined. */ 14 56 /* structures and the lengths of the message and brief_message are compiler-defined. */ 14 57 /* The only requirement is that the messages be 256 characters or less in length. */ 14 58 /* (Remember that the longest character string which can be used in an initial attribute */ 14 59 /* is 254 characters in length.) */ 14 60 /* */ 14 61 /* The severity number causes the error message to be preceded by a herald which */ 14 62 /* includes one of the following prefixes: */ 14 63 /* */ 14 64 /* _s_e_v _p_r_e_f_i_x _e_x_p_l_a_n_a_t_i_o_n */ 14 65 /* 0 = COMMENT - this is a comment. */ 14 66 /* 1 = WARNING - a possible error has been detected. The */ 14 67 /* compiler will still generate an object segment. */ 14 68 /* 2 = ERROR - a probable error has been detected. The */ 14 69 /* compiler will still generate an object segment. */ 14 70 /* 3 = FATAL ERROR - an error has been detected which is so severe */ 14 71 /* that no object segment will be generated. */ 14 72 /* 4 = TRANSLATOR ERROR - an error has been detected in the operation of */ 14 73 /* the compiler or translator. No object segment */ 14 74 /* will be generated. */ 14 75 /* */ 14 76 /* Full error messages are of the form: */ 14 77 /* */ 14 78 /* _p_r_e_f_i_x _e_r_r_o_r__n_u_m_b_e_r, SEVERITY _s_e_v_e_r_i_t_y IN STATEMENT _n OF LINE _m */ 14 79 /* _t_e_x_t__o_f__e_r_r_o_r__m_e_s_s_a_g_e */ 14 80 /* SOURCE: */ 14 81 /* _s_o_u_r_c_e__s_t_a_t_e_m_e_n_t */ 14 82 /* */ 14 83 /* If only one statement appears in line _m, then "STATEMENT _n OF" is omitted. */ 14 84 /* If the source statement has been printed in a previous error message, it is omitted. */ 14 85 /* */ 14 86 /* The reduction compiler declares a bit string, SERROR_CONTROL, which controls the */ 14 87 /* text of an error message. The compiler may set this bit string, as shown below. */ 14 88 /* */ 14 89 /* SERROR_CONTROL _m_e_a_n_i_n_g */ 14 90 /* "00"b the first time a particular error occurs, the long message */ 14 91 /* is printed; the brief message is used in subsequent */ 14 92 /* occurrences of that error. */ 14 93 /* "10"b or "11"b the long error message is always used. */ 14 94 /* "01"b the brief error message is always used. */ 14 95 /* The initial value of SERROR_CONTROL is "00"b. */ 14 96 /* */ 14 97 /* The reduction_compiler creates a declaration for SERROR_PRINTED, an array */ 14 98 /* of switches (one per error). The switch corresponding to a particular error is */ 14 99 /* turned on whenever the error message is printed. This allows lex_error_ to detect */ 14 100 /* subsequent occurrences of that same error. */ 14 101 /* */ 14 102 /* The reduction_compiler creates MERROR_SEVERITY, a fixed bin(17) integer */ 14 103 /* in which the severity of the highest-severity error encountered is maintained. */ 14 104 /* The compiler may reference this integer. */ 14 105 /* */ 14 106 /* The reduction_compiler creates MIN_PRINT_SEVERITY, a fixed bin (17) integer */ 14 107 /* which controls the printing of error messages by the ERROR procedure. */ 14 108 /* Errors having a severity less than MIN_PRINT_SEVERITY will not cause lex_error_ to be */ 14 109 /* and no error will be printed. The behaviour of the ERROR procedure for such errors */ 14 110 /* is controlled by the value of PRINT_SEVERITY_CONTROL, described below. */ 14 111 /* The compiler may set the value of MIN_PRINT_SEVERITY; its initial value is 0. */ 14 112 14 113 /* */ 14 114 /* The reduction_compiler declares a bit string, PRINT_SEVERITY_CONTROL, which */ 14 115 /* controls the updating of MERROR_SEVERITY and SERROR_PRINTED when the severity of an */ 14 116 /* error is less than MIN_PRINT_SEVERITY. In such cases, the lex_error_ procedure is not */ 14 117 /* invoked, and the ERROR procedure must update these values as though lex_error_ were */ 14 118 /* called. The compiler may set this bit string, as shown below. */ 14 119 /* */ 14 120 /* PRINT_SEVERITY_CONTROL _m_e_a_n_i_n_g */ 14 121 /* "00"b update neither SERROR_PRINTED nor MERROR_SEVERITY. */ 14 122 /* "01"b update SERROR_PRINTED to reflect the error. */ 14 123 /* "10"b update MERROR_SEVERITY to reflect the error severity. */ 14 124 /* "11"b update SERROR_PRINTED and MERROR_SEVERITY appropriately. */ 14 125 /*The initial value of PRINT_SEVERITY_CONTROL is "11"b. */ 14 126 /* */ 14 127 /* The ERROR procedure is simple to use, but it does limit the flexibility of the */ 14 128 /* error message. A compiler action routine can output more flexible error messages */ 14 129 /* by calling lex_error_ directly. See lex_error_ documentation for more details. */ 14 130 /* */ 14 131 /* S__t_a_t_u_s */ 14 132 /* */ 14 133 /* 0) Created: April, 1974 by G. C. Dixon */ 14 134 /* 1) Modified: April, 1982 by E. N. Kittlitz. Added MIN_PRINT_SEVERITY, */ 14 135 /* PRINT_SEVERITY_CONTROL. */ 14 136 /* */ 14 137 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 14 138 14 139 ERROR: procedure (Nerror); 14 140 14 141 dcl Nerror fixed bin; /* Number of the error which was detected. (In) */ 14 142 14 143 dcl Pstmt ptr, 14 144 1 erring_token aligned based (Perring_token) like token, 14 145 Perring_token ptr, 14 146 erring_token_value char(erring_token.Lvalue) based (erring_token.Pvalue); 14 147 14 148 dcl (max, null) builtin; 14 149 14 150 dcl lex_error_ entry options (variable); 14 151 14 152 14 153 if error_control_table.severity(Nerror) < MIN_PRINT_SEVERITY then do; /* don't print */ 14 154 if PRINT_SEVERITY_CONTROL & "1"b then /* update MERROR_SEVERITY */ 14 155 MERROR_SEVERITY = max (MERROR_SEVERITY, error_control_table.severity(Nerror)); 14 156 if PRINT_SEVERITY_CONTROL & "01"b then /* update SERROR_PRINTED */ 14 157 SERROR_PRINTED(Nerror) = "1"b; 14 158 return; 14 159 end; 14 160 Perring_token = Pthis_token; /* address the current erring_token. */ 14 161 if error_control_table.Soutput_stmt(Nerror) then 14 162 if Perring_token = null then 14 163 Pstmt = null; 14 164 else 14 165 Pstmt = erring_token.Pstmt; /* address the statement descriptor. */ 14 166 else 14 167 Pstmt = null; 14 168 if Perring_token = null then 14 169 call lex_error_ (Nerror, SERROR_PRINTED(Nerror), (error_control_table.severity(Nerror)), 14 170 MERROR_SEVERITY, Pstmt, Perring_token, SERROR_CONTROL, (error_control_table.message(Nerror)), 14 171 (error_control_table.brief_message(Nerror))); 14 172 else 14 173 call lex_error_ (Nerror, SERROR_PRINTED(Nerror), (error_control_table.severity(Nerror)), 14 174 MERROR_SEVERITY, Pstmt, Perring_token, SERROR_CONTROL, (error_control_table.message(Nerror)), 14 175 (error_control_table.brief_message(Nerror)), erring_token_value, erring_token_value, erring_token_value); 14 176 14 177 end ERROR; 14 178 14 179 /* END OF: rdc_error_.incl.pl1 * * * * * * * * * * * * * * * * */ 2140 2141 2142 /* START OF: rdc_next_stmt_.incl.pl1 * * * * * * */ 15 2 15 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 15 4 /* */ 15 5 /* N__a_m_e: rdc_next_stmt_.incl.pl1 */ 15 6 /* */ 15 7 /* This include segment is used by compilers generated by the */ 15 8 /* reduction_compiler. It includes a procedure which shifts the */ 15 9 /* compilation process to the next source statement. */ 15 10 /* */ 15 11 /* S__t_a_t_u_s */ 15 12 /* */ 15 13 /* 0) Created: April, 1974 by G. C. Dixon */ 15 14 /* */ 15 15 /* * * * * * * * * * * * * * * * * * * * * * * */ 15 16 15 17 15 18 NEXT_STMT: procedure; /* invoked to begin parsing the next statement of */ 15 19 /* the input tokens. */ 15 20 15 21 dcl null builtin, 15 22 Ssearching bit(1) aligned; 15 23 15 24 Ptoken = Pthis_token; /* make sure these pointers are the same. */ 15 25 Pstmt = token.Pstmt; /* address "current" statement's descriptor. */ 15 26 Ssearching = "1"b; /* start scanning forward for next statement. */ 15 27 do while (Ssearching & token.Pnext ^= null); 15 28 Ptoken = token.Pnext; 15 29 if token.Pstmt = Pstmt then; 15 30 else Ssearching = "0"b; 15 31 end; 15 32 if token.Pstmt = Pstmt then /* if there is no next statement, and */ 15 33 if SPDL then /* in PUSH DOWN LANGUAGE mode, can't run off */ 15 34 Ptoken = Ptoken; /* end of input list. */ 15 35 else Ptoken, Pthis_token = null; /* otherwise, input list exhausted. */ 15 36 else Pthis_token = Ptoken; /* normally, next statement exists and Ptoken */ 15 37 /* points to its 1st _n_o_n-__d_e_l_e_t_e_d token. */ 15 38 15 39 end NEXT_STMT; 15 40 15 41 /* END OF: rdc_next_stmt_.incl.pl1 * * * * * * */ 2142 2143 2144 end library_descriptor_compiler; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/17/86 1455.0 library_descriptor_compiler.pl1 >spec>install>1032>library_descriptor_compiler.pl1 1588 1 07/22/81 2045.0 translator_temp_alloc.incl.pl1 >ldd>include>translator_temp_alloc.incl.pl1 1590 2 04/11/85 1452.6 access_mode_values.incl.pl1 >ldd>include>access_mode_values.incl.pl1 1592 3 02/28/77 1409.3 lib_descriptor_.incl.pl1 >ldd>include>lib_descriptor_.incl.pl1 3-64 4 02/28/77 1409.3 lib_commands_.incl.pl1 >ldd>include>lib_commands_.incl.pl1 1594 5 08/16/79 1752.9 lib_node_.incl.pl1 >ldd>include>lib_node_.incl.pl1 5-341 6 02/28/77 1409.3 lib_Svalid_req_.incl.pl1 >ldd>include>lib_Svalid_req_.incl.pl1 5-346 7 02/16/84 0928.6 lib_Scontrol_.incl.pl1 >ldd>include>lib_Scontrol_.incl.pl1 1596 8 04/06/83 1239.4 terminate_file.incl.pl1 >ldd>include>terminate_file.incl.pl1 1602 9 04/18/75 1242.4 rdc_start_.incl.pl1 >ldd>include>rdc_start_.incl.pl1 9-25 10 04/18/75 1242.4 lex_descriptors_.incl.pl1 >ldd>include>lex_descriptors_.incl.pl1 1729 11 03/17/86 1404.9 rdc_end_.incl.pl1 >spec>install>1032>rdc_end_.incl.pl1 1759 12 04/18/75 1242.4 rdc_stack_fcns_.incl.pl1 >ldd>include>rdc_stack_fcns_.incl.pl1 2138 13 04/18/75 1242.4 rdc_lex_.incl.pl1 >ldd>include>rdc_lex_.incl.pl1 2140 14 08/15/83 1511.7 rdc_error_.incl.pl1 >ldd>include>rdc_error_.incl.pl1 2142 15 04/18/75 1242.4 rdc_next_stmt_.incl.pl1 >ldd>include>rdc_next_stmt_.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. ANwords parameter fixed bin(17,0) dcl 1-23 ref 1-21 1-40 1-40 BACKSPACE 023004 constant char(1) initial dcl 9-99 ref 11-113 C 2 based fixed bin(35,0) array level 2 in structure "obj_star_code" dcl 236 in procedure "ldc" set ref 1499* C 2 based fixed bin(17,0) array level 2 in structure "obj_dflt_search_codes" dcl 236 in procedure "ldc" set ref 1135* C 2 based fixed bin(17,0) array level 2 in structure "obj_dflt_lib_codes" dcl 236 in procedure "ldc" set ref 1097* CODE 001051 automatic fixed bin(35,0) dcl 9-33 set ref 11-106* 11-107 DIRECTION 001054 automatic fixed bin(17,0) initial dcl 1604 set ref 11-62 1604* ERROR 2 based fixed bin(17,0) level 2 in structure "obj_root_name" dcl 236 in procedure "ldc" set ref 915* 915 915 915 915 ERROR 2 based fixed bin(17,0) level 2 in structure "obj_dflt_search_names" dcl 236 in procedure "ldc" set ref 1335* ERROR 2 based fixed bin(17,0) level 2 in structure "obj_dflt_lib_names" dcl 236 in procedure "ldc" set ref 1333* ERROR 4 based fixed bin(17,0) level 3 in structure "name_elements_next" dcl 1360 in procedure "new_element" set ref 1369* ERROR 2 based fixed bin(17,0) level 2 in structure "name" dcl 236 in procedure "ldc" set ref 1478* 1478 1478 1478 1478 FORM based fixed bin(17,0) level 2 packed unaligned dcl 9-48 ref 11-65 11-70 11-123 I 66 based fixed bin(17,0) level 3 in structure "obj_root" dcl 236 in procedure "ldc" set ref 1216 1233* 1399* 1450* I based fixed bin(17,0) level 2 in structure "TOKEN_REQD_STRING" packed unaligned dcl 9-48 in procedure "SEMANTIC_ANALYSIS" ref 11-126 I 001052 automatic fixed bin(17,0) dcl 9-33 in procedure "SEMANTIC_ANALYSIS" set ref 11-62* 11-63 11-79* IFIRST based fixed bin(17,0) level 3 packed unaligned dcl 9-48 ref 11-62 11-73 11-79 11-79 ILAST 0(18) based fixed bin(17,0) level 3 packed unaligned dcl 9-48 ref 11-62 11-73 11-79 Icommand 000100 automatic fixed bin(17,0) dcl 170 set ref 773* 946 950 951 952 953 965 967 968 1801* Idollar 000646 automatic fixed bin(17,0) dcl 806 set ref 810* 811 811* 813* 813 815 Ifirst 1 000433 automatic fixed bin(17,0) array level 3 in structure "obj_command_dflt_values" dcl 170 in procedure "ldc" set ref 950* 1082 1089 1343* Ifirst 3 000433 automatic fixed bin(17,0) array level 3 in structure "obj_command_dflt_values" dcl 170 in procedure "ldc" set ref 952* 1120 1127 1345* Ifirst based fixed bin(17,0) level 3 in structure "obj_root" dcl 236 in procedure "ldc" set ref 1179 1188 1252 1258 1406* 1454 1463 Igreater 000616 automatic fixed bin(17,0) dcl 726 set ref 733* 734 735 736 743* 743 Ilast 4 000433 automatic fixed bin(17,0) array level 3 in structure "obj_command_dflt_values" dcl 170 in procedure "ldc" set ref 953* 968* 1120 1127 1346* Ilast 1 based fixed bin(17,0) level 3 in structure "obj_root" dcl 236 in procedure "ldc" set ref 1179 1252 1258 1453* 1454 Ilast 2 000433 automatic fixed bin(17,0) array level 3 in structure "obj_command_dflt_values" dcl 170 in procedure "ldc" set ref 951* 967* 1082 1089 1344* Inext_greater 000617 automatic fixed bin(17,0) dcl 726 set ref 735* 736 736* 738 743 Isignificant 001015 automatic fixed bin(17,0) dcl 1575 set ref 1580* 1581 1581 L 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 9-48 ref 11-127 LTOKEN_REQD_VALUE 001040 automatic fixed bin(18,0) dcl 9-33 set ref 11-127* 11-128 Larg 000101 automatic fixed bin(17,0) dcl 170 set ref 599* 600* 609* 610 612 614 616 683 683 686 686 Lentryname 000620 automatic fixed bin(17,0) dcl 726 set ref 738* 739 741 Lfree 2 based fixed bin(35,0) level 2 dcl 1-32 set ref 1-41 1-45 1-49* 1-49 Lin 000102 automatic fixed bin(21,0) dcl 170 set ref 639* 653* Lout 000103 automatic fixed bin(21,0) dcl 170 set ref 660* 664 667 986* 1301* 1301 1520 1524 1525 1526* 1526 1538 1542 1543 1544* 1544 1560 1564 1565 1566* 1566 Lvalue 4 based fixed bin(18,0) level 2 in structure "erring_token" dcl 14-143 in procedure "ERROR" ref 14-172 14-172 14-172 14-172 14-172 14-172 Lvalue 4 based fixed bin(18,0) level 2 in structure "token" dcl 10-68 in procedure "ldc" ref 729 729 729 729 734 735 736 745 745 765 768 785 808 808 810 811 815 815 820 820 835 835 837 837 858 858 858 868 1478 1478 1485 11-92 11-92 11-92 11-92 11-106 11-106 11-113 11-113 11-128 1764 1931 Lvalue 4 based fixed bin(18,0) level 2 in structure "stmt" dcl 10-40 in procedure "ldc" set ref 1162 1167* 1167 1168 1170 1170 M based fixed bin(17,0) level 2 in structure "obj_dflt_search_codes" dcl 236 in procedure "ldc" set ref 1316* M based fixed bin(17,0) level 2 in structure "name" dcl 236 in procedure "ldc" set ref 1478 1478* M based fixed bin(17,0) level 2 in structure "obj_search_proc" dcl 236 in procedure "ldc" set ref 1326* 1441 1442* M 2 based fixed bin(17,0) level 3 in structure "name_elements_next" dcl 1360 in procedure "new_element" set ref 1368* 1378 M based fixed bin(17,0) level 2 in structure "obj_star_code" dcl 236 in procedure "ldc" ref 1496 M based fixed bin(17,0) level 2 in structure "obj_root_array" dcl 236 in procedure "ldc" set ref 1324* 1387 1388* M based fixed bin(17,0) level 2 in structure "obj_dflt_lib_names" dcl 236 in procedure "ldc" set ref 1318* M based fixed bin(17,0) level 2 in structure "obj_root_name" dcl 236 in procedure "ldc" set ref 915 915* 1322* M based fixed bin(17,0) level 2 in structure "obj_dflt_search_names" dcl 236 in procedure "ldc" set ref 1320* M based fixed bin(17,0) level 2 in structure "obj_dflt_lib_codes" dcl 236 in procedure "ldc" set ref 1314* MERROR_SEVERITY 000567 automatic fixed bin(17,0) initial dcl 14-3 set ref 659 14-3* 910* 915* 984 1388* 1424* 1430* 1442* 1456* 1478* 14-154* 14-154 14-168* 14-172* MIN_PRINT_SEVERITY 000571 automatic fixed bin(17,0) initial dcl 14-3 set ref 14-3* 14-153 MLout 000010 internal static fixed bin(21,0) initial dcl 370 set ref 645 645* 986 1301 N 1 based fixed bin(17,0) level 2 in structure "name" dcl 236 in procedure "ldc" set ref 1478 1484* 1484 1485 N 3 based fixed bin(17,0) level 3 in structure "name_elements_next" dcl 1360 in procedure "new_element" set ref 1372* 1373* N 1 based fixed bin(17,0) level 2 in structure "obj_star_code" dcl 236 in procedure "ldc" set ref 1496 1498* 1498 1499 N 1 based fixed bin(17,0) level 2 in structure "obj_root_array" dcl 236 in procedure "ldc" set ref 982 1151* 1154* 1156 1243 1338* 1387 1393* 1393 1394 1464* 1464 N parameter fixed bin(17,0) dcl 1575 in procedure "OUTVN" ref 1572 1579 N 1 based fixed bin(17,0) level 2 in structure "obj_dflt_search_names" dcl 236 in procedure "ldc" set ref 952 953 968 1334* N 1 based fixed bin(17,0) level 2 in structure "obj_dflt_search_codes" dcl 236 in procedure "ldc" set ref 1329* N 1 based fixed bin(17,0) level 2 in structure "obj_search_proc" dcl 236 in procedure "ldc" set ref 1277 1339* 1436 1448* N 1 based fixed bin(17,0) level 2 in structure "obj_dflt_lib_names" dcl 236 in procedure "ldc" set ref 950 951 967 1332* N parameter fixed bin(17,0) dcl 12-38 in procedure "PUSH" set ref 12-36 12-60* 12-68 N 3 based fixed bin(17,0) level 3 in structure "name_elements_" dcl 888 in procedure "combine_elements" ref 901 928 N parameter fixed bin(17,0) dcl 1556 in procedure "OUTN" ref 1553 1559 N 1 based fixed bin(17,0) level 2 in structure "obj_dflt_lib_codes" dcl 236 in procedure "ldc" set ref 1328* N 1 based fixed bin(17,0) level 2 in structure "obj_root_name" dcl 236 in procedure "ldc" set ref 915 923* 923 924 1336* 1406 1453 1463* NL constant char(1) initial unaligned dcl 370 ref 1162 1168 NP 006177 constant char(1) initial unaligned dcl 370 set ref 1032* 1070* 1108* 1146* 1242* 1271* NRED 001041 automatic fixed bin(17,0) dcl 9-33 set ref 11-52* 11-55* 11-55 11-58 1757 12-18* 12-26* 1767* 1774* 1779* 1791* 1798* 1804* 1810* 1816* 1821* 1827* 1833* 1839* 1844* 1854* 1860* 1866* 1872* 1877* 1883* 1889* 1896* 1909* 1915* 1921* 1926* 1933* 1939* 1945* 1951* 1956* 1963* 1969* 1976* 1982* 1988* 1993* 1998* 2005* 2012* 2018* 2024* 2031* 2038* 2041* 2047* 2050* 2054* 2058* 2062* 2068* 2071* 2080* 2088* 2099* 2110* 2117* 2123* 12-60* NUMBER 001053 automatic fixed bin(35,0) dcl 9-33 set ref 11-106* 11-108 Nargs 000104 automatic fixed bin(17,0) dcl 170 set ref 596* 597 598 608 Nchar 001014 automatic picture(4) unaligned dcl 1575 in procedure "OUTVN" set ref 1579* 1580 1581 1581 Nchar 001004 automatic picture(4) unaligned dcl 1556 in procedure "OUTN" set ref 1559* 1560 1564 1564 1565 1566 Nerror parameter fixed bin(17,0) dcl 14-141 set ref 14-139 14-153 14-154 14-156 14-161 14-168* 14-168 14-168 14-168 14-168 14-172* 14-172 14-172 14-172 14-172 Nvalue 10 based fixed bin(35,0) level 3 packed unaligned dcl 10-68 set ref 11-101 11-108* Nwords 001024 automatic fixed bin(17,0) dcl 1-26 set ref 1-40* 1-41 1-45 1-48 1-49 Ofree 1 based fixed bin(35,0) level 2 dcl 1-32 set ref 1-47 1-48* 1-48 P 001026 automatic pointer dcl 1-26 set ref 1-42* 1-43 1-44 1-47* 1-50 PRED 001042 automatic pointer dcl 9-33 set ref 11-58* 11-62 11-62 11-73 11-73 11-79 11-79 11-79 PRINT_SEVERITY_CONTROL 000572 automatic bit(2) initial unaligned dcl 14-3 set ref 14-3* 14-154 14-156 PTOKEN_REQD 001044 automatic pointer dcl 9-33 set ref 11-63* 11-65 11-65 11-70 11-71 11-123 11-126 11-127 1732 PTOKEN_REQD_VALUE 001046 automatic pointer dcl 9-33 set ref 11-126* 11-128 Pacl_out 000106 automatic pointer dcl 170 set ref 633* 643* 667* Parea parameter pointer dcl 1-23 set ref 1-21 1-41 1-42* 1-44* 1-45 1-47 1-47 1-48 1-48 1-49 1-49 Parg 000110 automatic pointer dcl 170 set ref 599* 600* 609* 610 612 614 616 683 686 Perring_token 000102 automatic pointer dcl 14-143 set ref 14-160* 14-161 14-164 14-168 14-168* 14-172* 14-172 14-172 14-172 14-172 14-172 14-172 14-172 14-172 14-172 Pfirst_name_elements 000112 automatic pointer dcl 170 set ref 648* 1851* 1857* 1892* 1899* Pin 000114 automatic pointer dcl 170 set ref 623* 630 630* 637* 638 653* Plast 2 based pointer level 2 packed unaligned dcl 10-68 ref 13-45 13-47 Pname 000116 automatic pointer dcl 170 set ref 1378* 1405* 1478 1478 1478 1478 1478 1478 1478 1478 1484 1484 1485 1485 1894* 1902* 2075* 2083* Pname_elements 000120 automatic pointer dcl 170 set ref 1331* 1376* 1880 1886 Pname_elements_ parameter pointer dcl 888 ref 884 901 902 903 905 907 928 931 Pname_elements_next parameter pointer dcl 1360 set ref 1357 1366 1367* 1367 1367 1368 1369 1370 1372 1373 1373 1376 1378 Pnext based pointer level 3 in structure "name_elements" dcl 236 in procedure "ldc" set ref 1880* 1886* Pnext 1 based pointer level 2 in structure "token" packed unaligned dcl 10-68 in procedure "ldc" ref 11-79 1753 1847 1853 1859 1865 1871 1895 1903 1908 1914 1920 2091 2098 2109 13-39 13-40 15-27 15-28 Pnext based pointer level 3 in structure "name_elements_next" dcl 1360 in procedure "new_element" set ref 1370* 1373 1373 Pnext based pointer level 3 in structure "name_elements_" dcl 888 in procedure "combine_elements" set ref 907 928 931* Pobj_dflt_lib_codes 000122 automatic pointer dcl 170 set ref 1097 1313* 1313 1313 1314 1328 2077 Pobj_dflt_lib_names 000124 automatic pointer dcl 170 set ref 950 951 967 1093 1317* 1317 1317 1318 1332 1333 2075 Pobj_dflt_search_codes 000126 automatic pointer dcl 170 set ref 1135 1315* 1315 1315 1316 1329 2085 Pobj_dflt_search_names 000130 automatic pointer dcl 170 set ref 952 953 968 1131 1319* 1319 1319 1320 1334 1335 2083 Pobj_root 000132 automatic pointer dcl 170 set ref 910 915 1160* 1161 1179 1179 1188 1196 1201 1201 1204 1213 1216 1233 1247* 1248 1252 1252 1258 1258 1388 1394* 1396 1399 1401 1402 1406 1423 1424 1430 1442 1450 1453 1454 1454 1456 1463 1931 1950 Pobj_root_array 000134 automatic pointer dcl 170 set ref 982 1151 1154 1156 1160 1183 1191 1243 1247 1323* 1323 1323 1324 1338 1387 1387 1388 1393 1393 1394 1394 1464 1464 Pobj_root_name 000136 automatic pointer dcl 170 set ref 915 915 915 915 915 915 915 915 923 923 924 924 1180 1181 1183 1188 1261 1321* 1321 1321 1322 1336 1405 1406 1453 1463 1894 1902 Pobj_search_proc 000140 automatic pointer dcl 170 set ref 1217 1219 1221 1277 1283 1286 1289 1325* 1325 1325 1326 1339 1436 1437 1437 1441 1442 1448 1449 Pobj_star_code 000142 automatic pointer dcl 170 set ref 1496 1496 1498 1498 1499 1499 2077* 2085* Pout 000144 automatic pointer dcl 170 set ref 624* 633 643* 664* 667* 668* 1524 1525* 1525 1542 1543* 1543 1564 1565* 1565 Pstmt 5 based pointer level 2 in structure "token" packed unaligned dcl 10-68 in procedure "ldc" ref 1402 1478 1478 15-25 15-29 15-32 Pstmt 70 based pointer level 2 in structure "obj_root" dcl 236 in procedure "ldc" set ref 910* 915* 1161 1388* 1402* 1424* 1430* 1442* 1456* Pstmt 5 based pointer level 2 in structure "erring_token" packed unaligned dcl 14-143 in procedure "ERROR" ref 14-164 Pstmt 000562 automatic pointer dcl 10-40 in procedure "ldc" set ref 649* 1161* 1162 1162 1164 1166 1166 1167 1167 1168 1168 1170 1170 1170 15-25* 15-29 15-32 Pstmt 000100 automatic pointer dcl 14-143 in procedure "ERROR" set ref 14-161* 14-164* 14-166* 14-168* 14-172* Ptemp_seg 000146 automatic pointer dcl 170 set ref 622* 628 628* 640* 653* 1313* 1315* 1317* 1319* 1321* 1323* 1325* 1367* Pthis_token 000560 automatic pointer dcl 9-23 set ref 649* 653* 656 11-60 1756 1847 1847* 1853 1853* 1859 1859* 1865 1865* 1871 1871* 1895 1895* 1903 1903* 1908 1908* 1914 1914* 1920 1920* 2091 2091* 2098 2098* 2109 2109* 13-36 13-49* 14-160 15-24 15-35* 15-36* Ptoken 000564 automatic pointer dcl 10-68 set ref 729 729 729 729 729 729 734 735 735 736 745 745 745 765 765 768 768 785 785 808 808 810 810 811 815 815 815 815 820 820 820 835 835 837 837 837 858 858 858 858 868 868 1402 1478 1478 1478 1478 1478 1485 1485 11-60* 11-64 11-73 11-79 11-86 11-92 11-92 11-92 11-92 11-92 11-92 11-92 11-101 11-104 11-106 11-106 11-106 11-108 11-113 11-113 11-113 11-113 11-118 11-124 11-128 11-128 1753* 1753 1756* 1764 1764 1847* 1853* 1859* 1865* 1871* 1895* 1903* 1908* 1914* 1920* 1931 1931 2091* 2098* 2109* 13-36* 13-37 13-39 13-40* 13-40 13-42* 13-45 13-47* 13-47 13-49 15-24* 15-25 15-27 15-28* 15-28 15-29 15-32 15-32* 15-32 15-35* 15-36 Pvalue 3 based pointer level 2 in structure "erring_token" packed unaligned dcl 14-143 in procedure "ERROR" ref 14-172 14-172 14-172 Pvalue 3 based pointer level 2 in structure "stmt" packed unaligned dcl 10-40 in procedure "ldc" set ref 1162 1164 1166* 1166 1168 1170 Pvalue 3 based pointer level 2 in structure "token" packed unaligned dcl 10-68 in procedure "ldc" ref 729 729 735 745 765 768 785 810 815 815 820 837 858 1478 1485 11-92 11-92 11-106 11-113 11-128 1764 1931 RED based structure level 1 dcl 9-48 REDUCTION based structure array level 1 packed unaligned dcl 1609 set ref 11-58 REDUCTIONS 006016 constant fixed bin(17,0) initial array unaligned dcl 1609 set ref 11-58 R_ACCESS 006300 constant bit(3) initial unaligned dcl 2-11 set ref 637* S 000433 automatic structure array level 2 in structure "obj_command_dflt_values" packed unaligned dcl 170 in procedure "ldc" S 11 based structure level 3 in structure "token" packed unaligned dcl 10-68 in procedure "ldc" SERROR_CONTROL 000570 automatic bit(2) initial unaligned dcl 14-3 set ref 610* 612* 614* 616* 14-3* 910* 915* 1388* 1424* 1430* 1442* 1456* 1478* 14-168* 14-172* SERROR_PRINTED 000571 automatic bit(1) initial array unaligned dcl 14-3 set ref 14-3* 910* 915* 1388* 1424* 1430* 1442* 1456* 1478* 14-156* 14-168* 14-172* SPDL 000566 automatic bit(1) initial dcl 2135 set ref 2135* 11-73 13-42 15-32 STACK 001055 automatic fixed bin(17,0) array dcl 1605 set ref 12-18 12-26 12-59 12-60 12-60 12-68* STACK_DEPTH 001067 automatic fixed bin(17,0) initial dcl 1605 set ref 12-17 12-18 12-24 12-26 12-27* 12-27 1605* 12-59 12-66* 12-66 12-68 STOKEN_FCN 001050 automatic bit(1) dcl 9-33 set ref 1734* 1736* 1738* 1740* 1742* 1744* 1746* 1749 Scommand 000150 automatic bit(1) dcl 170 set ref 946 948 2003* 2010* Soutput_stmt 0(18) 000000 constant bit(1) initial array level 2 packed unaligned dcl 398 ref 14-161 Sreject_root 000151 automatic bit(1) dcl 170 set ref 1422* 1427* 1433* 1459* 1462 Ssearching 001142 automatic bit(1) dcl 15-21 set ref 15-26* 15-27 15-30* Svalid_req based structure level 1 dcl 6-23 TERM_FILE_TERM 006116 constant bit(3) initial unaligned dcl 8-14 set ref 630* TOKEN_REQD based structure level 2 in structure "RED" packed unaligned dcl 9-48 in procedure "SEMANTIC_ANALYSIS" TOKEN_REQD based structure level 1 dcl 9-48 in procedure "SEMANTIC_ANALYSIS" TOKEN_REQD_STRING based structure level 1 dcl 9-48 TOKEN_REQD_VALUE based char unaligned dcl 9-48 ref 11-128 TOKEN_REQUIREMENT based structure array level 1 packed unaligned dcl 1681 set ref 11-63 TOKEN_REQUIREMENTS 005656 constant fixed bin(17,0) initial array unaligned dcl 1681 set ref 11-63 TOKEN_STRINGS based char(98) dcl 1724 set ref 11-126 TOKEN_STRING_ARRAYS 005625 constant char(100) initial array dcl 1724 set ref 11-126 TRACING 000113 internal static bit(1) initial dcl 1599 set ref 11-50* 11-50 TYPE 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 9-48 ref 11-65 11-71 1732 Tarchive constant fixed bin(17,0) initial dcl 5-358 ref 1950 Tdirectory constant fixed bin(17,0) initial dcl 5-358 ref 1401 V 3 based varying char(32) array level 2 in structure "obj_dflt_lib_names" dcl 236 in procedure "ldc" set ref 1093 V 5 based varying char(32) array level 2 in structure "name_elements_" dcl 888 in procedure "combine_elements" ref 902 903 905 V 3 based varying char(32) array level 2 in structure "name" dcl 236 in procedure "ldc" set ref 1485* V 3 based varying char(32) array level 2 in structure "obj_root_name" dcl 236 in procedure "ldc" set ref 924* 1180 1181 1183 1188 1261 V 3 based varying char(32) array level 2 in structure "obj_dflt_search_names" dcl 236 in procedure "ldc" set ref 1131 addr builtin function dcl 333 in procedure "ldc" ref 600 600 600 600 1160 1166 1247 1376 1378 1394 1405 1525 1543 1565 addr builtin function dcl 12-40 in procedure "PUSH" ref 12-63 12-63 addr builtin function dcl 9-92 in procedure "SEMANTIC_ANALYSIS" ref 11-58 11-58 11-63 11-63 11-126 11-126 1894 1902 2075 2077 2083 2085 addrel builtin function dcl 333 ref 1478 1478 area based structure level 1 unaligned dcl 1-32 arg based char unaligned dcl 236 set ref 610 612 614 616 683* 686* backup_name_ 000224 constant entry external dcl 336 ref 1192 bc_in 000152 automatic fixed bin(24,0) dcl 170 set ref 637* 639 breaks 006174 constant varying char(7) initial dcl 370 set ref 650* 653* brief_error 000114 internal static varying char(4) initial dcl 12-48 set ref 12-60* brief_message 101 000000 constant varying char(40) initial array level 2 dcl 398 ref 910 915 1388 1424 1430 1442 1456 1478 14-168 14-172 check_star_name_$entry 000226 constant entry external dcl 336 ref 837 check_star_name_$path 000230 constant entry external dcl 336 ref 745 cleanup 000154 stack reference condition dcl 170 ref 625 clock_ 000232 constant entry external dcl 336 ref 999 999 code 001030 automatic fixed bin(35,0) dcl 1-26 in procedure "allocate" set ref 1-42* code 000162 automatic fixed bin(35,0) dcl 170 in procedure "ldc" set ref 599* 600* 601 602* 603 604* 605 609* 637* 640* 641 643* 644 653* 655 657* 661 661* 670 686* 690 690* 692* 697* 700* 705* 708* 745* 746 com_err_ 000234 constant entry external dcl 336 ref 677 683 686 692 697 700 705 708 command_abbrev 006117 constant varying char(4) initial array dcl 4-29 ref 768 768 770 command_name 006131 constant varying char(16) initial array dcl 4-29 set ref 170 765 765 767 1038 1038 1041 1041 1043 1048* 1071 1078* 1109 1116* compilation_date 000163 automatic char(52) unaligned dcl 170 set ref 999* 1000* cu_$arg_count 000236 constant entry external dcl 336 ref 596 cu_$arg_ptr 000240 constant entry external dcl 336 ref 599 609 cu_$cl 000324 constant entry external dcl 12-43 ref 12-62 cv_dec_check_ 000322 constant entry external dcl 9-96 ref 11-106 date_time_$format 000242 constant entry external dcl 336 ref 999 decode_entryname_ 000244 constant entry external dcl 336 ref 820 dimension builtin function dcl 333 in procedure "ldc" ref 170 14-3 14-3 765 767 768 770 1038 1038 1041 1041 1043 1071 1109 1341 dimension builtin function dcl 12-40 in procedure "PUSH" ref 12-59 12-60 12-60 dir_in 000200 automatic char(168) unaligned dcl 170 set ref 600 600 637* 692* dir_out 000252 automatic char(168) unaligned dcl 170 set ref 606* 643* 700* divide builtin function dcl 333 ref 639 ename 000515 automatic structure level 2 in structure "search_proc" dcl 170 in procedure "ldc" set ref 1449 1974* ename 000410 automatic structure level 1 dcl 170 in procedure "ldc" set ref 1974 ename 2 based structure array level 2 in structure "obj_search_proc" dcl 236 in procedure "ldc" set ref 1449* ent 12 based char(32) array level 3 in structure "obj_search_proc" dcl 236 in procedure "ldc" set ref 1219 1221 1286 1289 1437 ent 10 000410 automatic char(32) level 2 in structure "ename" dcl 170 in procedure "ldc" set ref 820* 821 ent 10 000515 automatic char(32) level 3 in structure "search_proc" dcl 170 in procedure "ldc" set ref 1398* 1437 1442* ent_in 000324 automatic char(32) unaligned dcl 170 set ref 600 600 602* 602* 604* 637* 692* 695* 994* ent_out 000334 automatic char(32) unaligned dcl 170 set ref 604* 643* 695* 697* 700* entry_point 000344 automatic char(70) unaligned dcl 170 set ref 1217* 1218 1218 1218 1221* 1222 1222 1222 1228* 1229 1229 1283* 1284 1284 1284 1289* 1290 1290 1290 entry_point_name 000366 automatic varying char(65) dcl 170 set ref 1218* 1220* 1220 1222* 1222 1225 1225 1228 1284* 1286* 1286 1290* 1290 1293* erring_token based structure level 1 dcl 14-143 erring_token_value based char unaligned dcl 14-143 set ref 14-172* 14-172* 14-172* error_control_table 000000 constant structure array level 1 dcl 398 ref 14-3 14-3 error_table_$badopt 000304 external static fixed bin(35,0) dcl 370 set ref 683* error_table_$fatal_error 000306 external static fixed bin(35,0) dcl 370 ref 661 error_table_$no_makeknown 000312 external static fixed bin(35,0) dcl 370 ref 690 error_table_$noentry 000310 external static fixed bin(35,0) dcl 370 ref 690 error_table_$wrong_no_of_args 000314 external static fixed bin(35,0) dcl 370 set ref 677* expand_path_ 000246 constant entry external dcl 336 ref 600 get_wdir_ 000250 constant entry external dcl 336 ref 606 group2 7 based structure level 2 packed unaligned dcl 10-68 hcs_$truncate_seg 000252 constant entry external dcl 336 ref 664 header based structure level 2 in structure "name_elements_next" unaligned dcl 1360 in procedure "new_element" header based structure level 2 in structure "name_elements_" unaligned dcl 888 in procedure "combine_elements" header based structure level 2 in structure "name_elements" dcl 236 in procedure "ldc" i 000430 automatic fixed bin(17,0) dcl 170 in procedure "ldc" set ref 1043* 1046* 1048 1051 1058* 1062* 1071* 1075* 1078 1082 1082 1089 1089* 1109* 1113* 1116 1120 1120 1127 1127* 1156* 1160 1173* 1182 1190* 1243* 1247* 1277* 1280* 1283 1286 1289* 1341* 1342 1343 1344 1345 1346* 1436* 1437 1437* 1441 1448 1449 1450 i 000630 automatic fixed bin(17,0) dcl 763 in procedure "command_name_" set ref 765* 765* 767 768* 768* 770 773 i 000100 automatic fixed bin(17,0) dcl 888 in procedure "combine_elements" set ref 901* 902 903 905* i 001130 automatic fixed bin(17,0) dcl 13-33 in procedure "LEX" set ref 13-39* 13-42 13-45* ignored_breaks 006172 constant varying char(4) initial dcl 370 set ref 650* 653* index builtin function dcl 333 ref 735 810 1162 1168 initiate_file_ 000254 constant entry external dcl 336 ref 637 iox_$error_output 000330 external static pointer dcl 12-43 set ref 12-63* iox_$put_chars 000326 constant entry external dcl 12-43 ref 12-63 j 000431 automatic fixed bin(17,0) dcl 170 set ref 1082* 1084* 1087* 1089* 1093 1097* 1120* 1122* 1125* 1127* 1131 1135* 1162* 1163 1164 1164 1166 1167 1168* 1179* 1180 1181 1183* 1205* 1206 1206* 1216* 1217 1219 1221 1252* 1253* 1256* 1258* 1261* k 000432 automatic fixed bin(17,0) dcl 170 set ref 1182* 1183* 1190* 1191* l 000101 automatic fixed bin(17,0) dcl 888 set ref 900* 933 label 2 based varying char(30) level 3 in structure "obj_root" dcl 236 in procedure "ldc" set ref 1196* 1248* label 4 based varying char(30) array level 4 in structure "obj_root_array" dcl 236 in procedure "ldc" set ref 1183 1191 length builtin function dcl 333 in procedure "ldc" ref 650 900 910 1180 1193 1201 1201 1218 1222 1225 1225 1284 1290 1520 1524 1525 1526 1538 1542 1543 1544 1560 1564 1565 1566 length builtin function dcl 12-40 in procedure "PUSH" ref 12-63 12-63 lex_control_chars 000011 internal static varying char(128) dcl 370 set ref 650* 653* lex_delims 000052 internal static varying char(128) initial dcl 370 set ref 650 650* 653* lex_error_ 000332 constant entry external dcl 12-43 in procedure "PUSH" ref 12-60 lex_error_ 000262 constant entry external dcl 336 in procedure "ldc" ref 910 915 1388 1424 1430 1442 1456 1478 lex_error_ 000334 constant entry external dcl 14-150 in procedure "ERROR" ref 14-168 14-172 lex_string_$init_lex_delims 000260 constant entry external dcl 336 ref 650 lex_string_$lex 000256 constant entry external dcl 336 ref 653 lib_names 1 000433 automatic structure array level 2 dcl 170 long_error 000116 internal static varying char(234) initial dcl 12-48 set ref 12-60* max builtin function dcl 9-92 in procedure "SEMANTIC_ANALYSIS" ref 12-27 max builtin function dcl 14-148 in procedure "ERROR" ref 14-154 message 1 000000 constant varying char(252) initial array level 2 dcl 398 ref 910 915 1388 1424 1430 1442 1456 1478 14-168 14-172 mod builtin function dcl 1-26 ref 1-40 n parameter fixed bin(17,0) dcl 13-33 ref 13-31 13-38 13-39 13-42 13-45 name 000433 automatic char(32) initial level 2 in structure "obj_desc" packed unaligned dcl 170 in procedure "ldc" set ref 170* 785 1011* 1021* 1764* name based structure level 2 in structure "obj_root" dcl 236 in procedure "ldc" name based structure level 1 dcl 236 in procedure "ldc" name 2 based structure array level 3 in structure "obj_root_array" dcl 236 in procedure "ldc" name_elements based structure level 1 dcl 236 name_elements_ based structure level 1 unaligned dcl 888 name_elements_next based structure level 1 unaligned dcl 1360 set ref 1367 1367 1376 name_sofar parameter varying char(100) dcl 888 set ref 884 900 903 903* 905* 905 908 910 910* 915* 924 931* 933* 933 node based structure level 1 unaligned dcl 5-69 non_restart_error 000212 internal static char(33) initial unaligned dcl 12-48 set ref 12-63 12-63 12-63 12-63 null builtin function dcl 12-40 in procedure "PUSH" ref 12-60 12-60 12-60 12-60 null builtin function dcl 15-21 in procedure "NEXT_STMT" ref 15-27 15-35 null builtin function dcl 14-148 in procedure "ERROR" ref 14-161 14-161 14-166 14-168 null builtin function dcl 333 in procedure "ldc" ref 622 623 624 628 630 633 638 648 649 653 653 656 668 907 910 910 915 915 1331 1366 1370 1373 1388 1388 1424 1424 1430 1430 1442 1442 1456 1456 1478 1478 13-37 13-39 13-42 13-45 null builtin function dcl 1-26 in procedure "allocate" ref 1-43 1-43 1-45 null builtin function dcl 9-92 in procedure "SEMANTIC_ANALYSIS" ref 11-64 11-73 11-79 11-86 obj_command_dflt_values 000433 automatic structure array level 1 dcl 170 set ref 1341 obj_desc 000433 automatic structure level 1 packed unaligned dcl 170 obj_dflt_lib_codes based structure level 1 dcl 236 set ref 1313 1313 2077 obj_dflt_lib_names based structure level 1 dcl 236 set ref 1317 1317 2075 obj_dflt_search_codes based structure level 1 dcl 236 set ref 1315 1315 2085 obj_dflt_search_names based structure level 1 dcl 236 set ref 1319 1319 2083 obj_root based structure level 1 dcl 236 in procedure "ldc" obj_root 2 based structure array level 2 in structure "obj_root_array" dcl 236 in procedure "ldc" set ref 1160 1247 1394 obj_root_array based structure level 1 dcl 236 set ref 1323 1323 obj_root_name based structure level 1 dcl 236 set ref 1321 1321 1405 1894 1902 obj_search_proc based structure level 1 dcl 236 set ref 1325 1325 obj_star_code based structure level 1 dcl 236 out based char unaligned dcl 236 set ref 1524* 1525 1542* 1543 1564* 1565 path 13 based varying char(168) level 2 in structure "obj_root" dcl 236 in procedure "ldc" set ref 1201 1201 1204 1396* 1423 1931* path 000443 automatic char(168) dcl 170 in procedure "ldc" set ref 1204* 1206 1206 1210 1210 proc 006162 constant char(32) initial dcl 370 set ref 640 677* 683* 686* 692* 697* 700* 705* 708* ptr builtin function dcl 1-26 ref 1-47 quoted_string 11(01) based bit(1) level 4 packed unaligned dcl 10-68 ref 868 11-92 11-104 11-113 11-118 11-124 ref 000515 automatic char(32) level 3 in structure "search_proc" dcl 170 in procedure "ldc" set ref 1397* 1429 1437 1442* ref 000410 automatic char(32) level 2 in structure "ename" dcl 170 in procedure "ldc" set ref 820* ref 2 based char(32) array level 3 in structure "obj_search_proc" dcl 236 in procedure "ldc" set ref 1217 1283 1437 search builtin function dcl 333 in procedure "ldc" ref 729 858 search builtin function dcl 9-92 in procedure "SEMANTIC_ANALYSIS" ref 11-92 search_names 3 000433 automatic structure array level 2 dcl 170 search_proc 000515 automatic structure level 1 dcl 170 in procedure "ldc" search_proc 66 based structure level 2 in structure "obj_root" dcl 236 in procedure "ldc" severity 000000 constant fixed bin(17,0) initial array level 2 packed unaligned dcl 398 ref 910 915 1388 1424 1430 1442 1456 1478 14-153 14-154 14-168 14-172 size builtin function dcl 333 ref 1313 1313 1315 1315 1317 1317 1319 1319 1321 1321 1323 1323 1325 1325 1367 1367 starcode 000535 automatic fixed bin(35,0) dcl 170 set ref 837* 838 840 842 1499 stmt based structure level 1 dcl 10-40 stmt_array based char(1) array unaligned dcl 236 set ref 1166 stmt_part based char unaligned dcl 236 set ref 1164* stmt_value based char unaligned dcl 10-40 set ref 1162 1168 1170* substr builtin function dcl 9-92 in procedure "SEMANTIC_ANALYSIS" ref 11-92 11-126 substr builtin function dcl 333 in procedure "ldc" set ref 729 735 815 933 1192 1193 1206 1206 1210 1210 1218 1222 1229 1229 1284 1290 1524* 1525 1542* 1543 1564* 1565 1581 1581 suffixed_name_$make 000264 constant entry external dcl 336 ref 602 suffixed_name_$new_suffix 000266 constant entry external dcl 336 ref 604 695 supported 000433 automatic bit(1) array level 3 packed unaligned dcl 170 set ref 946* 1051 1342* sys_info$max_seg_size 000316 external static fixed bin(35,0) dcl 370 ref 645 temp_name 000536 automatic char(32) unaligned dcl 170 set ref 1093* 1094* 1131* 1132* 1261* 1262* temp_name30 000546 automatic varying char(30) dcl 170 set ref 1177* 1181* 1188 1188* 1191 1192* 1192 1193* 1193 1193 1193 1196 1197* terminate_file_ 000270 constant entry external dcl 336 ref 630 token based structure level 1 dcl 10-68 token_value based char unaligned dcl 10-68 set ref 729 729 735 745* 765 768 785 810 815 815 820* 837* 858 1478* 1485 11-92 11-92 11-106* 11-113 11-128 1764 1931 translator_temp_$get_next_segment 000320 constant entry external dcl 1-37 ref 1-42 translator_temp_$get_segment 000272 constant entry external dcl 336 ref 640 translator_temp_$release_all_segments 000274 constant entry external dcl 336 ref 628 tssi_$clean_up_segment 000276 constant entry external dcl 336 ref 633 tssi_$finish_segment 000300 constant entry external dcl 336 ref 667 tssi_$get_segment 000302 constant entry external dcl 336 ref 643 type 67 based fixed bin(17,0) level 2 dcl 236 set ref 1213* 1401* 1950* value parameter varying char dcl 1536 in procedure "OUTV" ref 1533 1538 1542 1542 1543 1544 value parameter char unaligned dcl 1518 in procedure "OUT" ref 1515 1520 1524 1524 1525 1526 verify builtin function dcl 9-92 in procedure "SEMANTIC_ANALYSIS" ref 11-92 verify builtin function dcl 333 in procedure "ldc" ref 815 815 1193 1218 1222 1284 1290 1580 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. A_ACCESS internal static bit(3) initial unaligned dcl 2-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 D based structure level 1 unaligned dcl 5-146 DIR_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 2-33 Dacl based structure level 1 unaligned dcl 5-153 Ddir_acl based structure level 1 unaligned dcl 5-172 Ddir_iacl based structure level 1 unaligned dcl 5-190 Diacl based structure level 1 unaligned dcl 5-209 Dnames based structure level 1 unaligned dcl 5-230 Dnodes based structure level 1 unaligned dcl 5-245 Dobj based structure level 1 unaligned dcl 5-263 Dsearch_proc based structure level 1 unaligned dcl 5-311 Duser based structure level 1 unaligned dcl 5-324 E_ACCESS internal static bit(3) initial unaligned dcl 2-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 Luser automatic fixed bin(17,0) dcl 5-324 M_ACCESS internal static bit(3) initial unaligned dcl 2-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 N_ACCESS internal static bit(3) initial unaligned dcl 2-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 Nacls automatic fixed bin(17,0) dcl 5-153 Ndir_acls automatic fixed bin(17,0) dcl 5-172 Ndir_iacls automatic fixed bin(17,0) dcl 5-190 Niacls automatic fixed bin(17,0) dcl 5-209 Nnames automatic fixed bin(17,0) dcl 5-230 Nnodes automatic fixed bin(17,0) dcl 5-245 P automatic structure level 1 dcl 3-91 PD automatic pointer dcl 5-146 PDacl automatic pointer dcl 5-153 PDdir_acl automatic pointer dcl 5-172 PDdir_iacl automatic pointer dcl 5-190 PDiacl automatic pointer dcl 5-209 PDnames automatic pointer dcl 5-230 PDnodes automatic pointer dcl 5-245 PDobj automatic pointer dcl 5-263 PDsearch_proc automatic pointer dcl 5-311 PDuser automatic pointer dcl 5-324 Pcomment automatic pointer dcl 10-20 Plibrary_names automatic pointer dcl 3-91 Pnode automatic pointer dcl 5-69 Proot_names automatic pointer dcl 3-91 Psearch_names automatic pointer dcl 3-91 REW_ACCESS internal static bit(3) initial unaligned dcl 2-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 RE_ACCESS internal static bit(3) initial unaligned dcl 2-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 RW_ACCESS internal static bit(3) initial unaligned dcl 2-11 RW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 S based structure level 1 dcl 6-96 SA_ACCESS internal static bit(3) initial unaligned dcl 2-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 2-30 SMA_ACCESS internal static bit(3) initial unaligned dcl 2-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 SM_ACCESS internal static bit(3) initial unaligned dcl 2-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 S_ACCESS internal static bit(3) initial unaligned dcl 2-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 Sc based structure level 1 dcl 7-20 Scontrol automatic bit(36) dcl 7-20 Sreq based structure level 1 dcl 5-343 Srequirements automatic bit(72) dcl 6-96 Svalid based structure level 1 dcl 5-343 TERM_FILE_BC internal static bit(2) initial unaligned dcl 8-12 TERM_FILE_DELETE internal static bit(5) initial unaligned dcl 8-17 TERM_FILE_FORCE_WRITE internal static bit(4) initial unaligned dcl 8-16 TERM_FILE_TRUNC internal static bit(1) initial unaligned dcl 8-11 TERM_FILE_TRUNC_BC internal static bit(2) initial unaligned dcl 8-13 TERM_FILE_TRUNC_BC_TERM internal static bit(3) initial unaligned dcl 8-15 Tacl internal static fixed bin(17,0) initial dcl 5-153 Tarchive_comp internal static fixed bin(17,0) initial dcl 5-358 Tdir_acl internal static fixed bin(17,0) initial dcl 5-172 Tdir_iacl internal static fixed bin(17,0) initial dcl 5-190 Tiacl internal static fixed bin(17,0) initial dcl 5-209 Tlink internal static fixed bin(17,0) initial dcl 5-358 Tmsf internal static fixed bin(17,0) initial dcl 5-358 Tmsf_comp internal static fixed bin(17,0) initial dcl 5-358 Tnames internal static fixed bin(17,0) initial dcl 5-230 Tnodes internal static fixed bin(17,0) initial dcl 5-245 Tobj internal static fixed bin(17,0) initial dcl 5-263 Tsearch_proc internal static fixed bin(17,0) initial dcl 5-311 Tsegment internal static fixed bin(17,0) initial dcl 5-358 Tuser internal static fixed bin(17,0) initial dcl 5-324 Vacl_1 internal static fixed bin(17,0) initial dcl 5-153 Vdescriptor_2 internal static fixed bin(17,0) initial dcl 3-27 Vdir_acl_1 internal static fixed bin(17,0) initial dcl 5-172 Vdir_iacl_1 internal static fixed bin(17,0) initial dcl 5-190 Viacl_1 internal static fixed bin(17,0) initial dcl 5-209 Vnames_1 internal static fixed bin(17,0) initial dcl 5-230 Vnodes_1 internal static fixed bin(17,0) initial dcl 5-245 Vobj_1 internal static fixed bin(17,0) initial dcl 5-263 Vsearch_proc_1 internal static fixed bin(17,0) initial dcl 5-311 Vuser_1 internal static fixed bin(17,0) initial dcl 5-324 W_ACCESS internal static bit(3) initial unaligned dcl 2-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 2-36 brief_node_type internal static varying char(12) initial array dcl 5-374 command_default_values based structure level 1 unaligned dcl 3-29 comment based structure level 1 dcl 10-20 comment_value based char unaligned dcl 10-20 descriptor based structure level 1 dcl 3-17 library_cleanup internal static fixed bin(17,0) initial dcl 4-21 library_fetch internal static fixed bin(17,0) initial dcl 4-21 library_info internal static fixed bin(17,0) initial dcl 4-21 library_map internal static fixed bin(17,0) initial dcl 4-21 library_names based structure level 1 unaligned dcl 3-50 library_print internal static fixed bin(17,0) initial dcl 4-21 link_node based structure level 1 unaligned dcl 5-30 node_type internal static varying char(32) initial array dcl 5-374 ring_no internal static picture(1) initial unaligned dcl 370 root_names based structure level 1 unaligned dcl 3-85 roots based structure level 1 unaligned dcl 3-66 search_names based structure level 1 unaligned dcl 3-57 terminate_file_switches based structure level 1 packed unaligned dcl 8-4 NAMES DECLARED BY EXPLICIT CONTEXT. ERROR 021462 constant entry internal dcl 14-139 ref 655 982 1521 1539 1561 1770 1777 1782 1794 1807 1813 1824 1830 1836 1842 1869 1875 1901 1918 1924 1936 1942 1961 1966 1979 1985 1996 2015 2021 2029 2036 2045 2102 2107 2113 2121 LEX 021374 constant entry internal dcl 13-31 ref 1762 1765 1787 1882 1888 1929 1932 1948 1954 1959 1972 1975 2001 2008 2027 2034 2078 2086 NAME_DUP 014314 constant label dcl 1187 ref 1183 NAME_FOUND 014446 constant label dcl 1196 set ref 1185 NEXT_STMT 021774 constant entry internal dcl 15-18 ref 1773 1796 1803 1809 1815 1819 1826 1832 1838 1938 1944 1962 1968 1981 1987 2017 2023 2030 2037 2104 OUT 017076 constant entry internal dcl 1515 ref 990 994 995 1000 1001 1008 1011 1012 1016 1021 1022 1025 1030 1032 1033 1036 1039 1042 1044 1047 1049 1051 1053 1055 1059 1063 1065 1068 1070 1072 1076 1079 1085 1088 1091 1094 1095 1098 1101 1106 1108 1110 1114 1117 1123 1126 1129 1132 1133 1136 1139 1144 1146 1147 1152 1155 1157 1164 1165 1170 1171 1174 1198 1202 1206 1207 1210 1211 1214 1226 1229 1230 1234 1237 1240 1242 1244 1249 1254 1257 1259 1262 1263 1269 1271 1272 1278 1281 1296 1581 OUTN 017206 constant entry internal dcl 1553 ref 1038 1151 1201 1213 1225 OUTV 017144 constant entry internal dcl 1533 ref 1048 1078 1116 1197 1248 1293 OUTVN 017245 constant entry internal dcl 1572 ref 1041 1046 1058 1062 1075 1084 1087 1097 1113 1122 1125 1135 1154 1173 1233 1253 1256 1280 PUSH 021233 constant entry internal dcl 12-36 ref 1790 2079 2087 RD_ACTION 005525 constant label array(64) dcl 1762 ref 1757 RD_MATCH 017743 constant label dcl 1753 ref 11-90 11-92 11-101 11-109 11-113 11-118 11-128 1749 RD_MATCH_NO_TOKEN 017746 constant label dcl 1754 ref 11-73 11-79 11-86 RD_NEXT_REDUCTION 017425 constant label dcl 11-55 ref 11-68 11-84 11-88 11-99 11-104 11-111 11-116 11-120 11-124 11-130 1750 12-17 12-24 1785 RD_STACK 017755 constant label dcl 12-17 RD_STACK_POP 017762 constant label dcl 12-24 ref 1849 1904 2093 2105 2115 RD_TEST_REDUCTION 017426 constant label dcl 11-58 ref 11-53 12-19 12-28 1768 1775 1780 1792 1799 1805 1811 1817 1822 1828 1834 1840 1845 1855 1861 1867 1873 1878 1884 1890 1897 1910 1916 1922 1927 1934 1940 1946 1952 1957 1964 1970 1977 1983 1989 1994 1999 2006 2013 2019 2025 2032 2039 2043 2048 2052 2056 2060 2064 2069 2073 2081 2089 2100 2111 2119 2124 RD_TEST_RESULT 017737 constant label dcl 1749 ref 1735 1737 1739 1741 1743 1745 1747 RD_TEST_TOKEN 005510 constant label array(6) dcl 11-73 ref 11-65 11-71 RD_TOKEN_FCN 005516 constant label array(7) dcl 1734 ref 1732 RETURN 010404 constant label dcl 659 ref 656 1391 1446 1522 1540 1562 SEMANTIC_ANALYSIS 017414 constant entry internal dcl 9-30 ref 658 absolute_pathname 011142 constant entry internal dcl 723 ref 1740 add_name 011743 constant label dcl 908 ref 928 allocate 017317 constant entry internal dcl 1-21 ref 1313 1315 1317 1319 1321 1323 1325 1367 already_there 016556 constant label dcl 1450 ref 1437 bad_area 011014 constant label dcl 708 ref 641 bad_input 010577 constant label dcl 690 ref 603 638 bad_output 010726 constant label dcl 700 ref 644 bad_output_name 010642 constant label dcl 695 set ref 605 bad_path 010544 constant label dcl 686 ref 601 badopt 010517 constant label dcl 683 ref 616 cleaner 011046 constant entry internal dcl 627 ref 625 669 702 709 combine_elements 011627 constant entry internal dcl 884 ref 931 1892 1899 command_begin 012257 constant entry internal dcl 942 ref 2004 2011 command_end 012310 constant entry internal dcl 961 ref 2066 command_name_ 011264 constant entry internal dcl 758 ref 1744 compile_descriptor 012326 constant entry internal dcl 977 ref 2126 descriptor_begin 015576 constant entry internal dcl 1310 ref 1766 1772 1784 descriptor_name 011351 constant entry internal dcl 781 ref 1734 entryname 011370 constant entry internal dcl 797 ref 1742 error 010767 constant label dcl 705 set ref 670 get_to_cl 021337 constant label dcl 12-62 ref 12-64 ldc 007506 constant entry external dcl 167 library_descriptor_compiler 007516 constant entry external dcl 167 new_element 015724 constant entry internal dcl 1357 ref 1851 1857 1880 1886 null_string_name 011607 constant entry internal dcl 865 ref 1738 reject 011261 constant label dcl 749 ref 739 741 root_begin 015777 constant entry internal dcl 1384 ref 1789 1797 root_end 016141 constant entry internal dcl 1415 ref 1991 set_element 016703 constant entry internal dcl 1474 ref 1906 1912 set_name 016701 constant entry internal dcl 1474 ref 1863 2095 set_obj_star_code 017062 constant entry internal dcl 1493 ref 2097 starname 011504 constant entry internal dcl 832 ref 1746 valid_name 011560 constant entry internal dcl 854 ref 1736 wnoa 010472 constant label dcl 677 ref 597 598 NAME DECLARED BY CONTEXT OR IMPLICATION. reverse builtin function ref 1193 1218 1222 1284 1290 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 23512 24050 23021 23522 Length 24674 23021 336 607 471 214 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ldc 1426 external procedure is an external procedure. on unit on line 625 64 on unit cleaner 90 internal procedure is called by several nonquick procedures. absolute_pathname internal procedure shares stack frame of external procedure ldc. command_name_ internal procedure shares stack frame of external procedure ldc. descriptor_name internal procedure shares stack frame of external procedure ldc. entryname internal procedure shares stack frame of external procedure ldc. starname internal procedure shares stack frame of external procedure ldc. valid_name internal procedure shares stack frame of external procedure ldc. combine_elements 182 internal procedure calls itself recursively. command_begin internal procedure shares stack frame of external procedure ldc. command_end internal procedure shares stack frame of external procedure ldc. compile_descriptor internal procedure shares stack frame of external procedure ldc. descriptor_begin internal procedure shares stack frame of external procedure ldc. new_element internal procedure shares stack frame of external procedure ldc. root_begin internal procedure shares stack frame of external procedure ldc. root_end internal procedure shares stack frame of external procedure ldc. set_name internal procedure shares stack frame of external procedure ldc. set_obj_star_code internal procedure shares stack frame of external procedure ldc. OUT 72 internal procedure is called during a stack extension. OUTV internal procedure shares stack frame of external procedure ldc. OUTN internal procedure shares stack frame of external procedure ldc. OUTVN internal procedure shares stack frame of external procedure ldc. allocate internal procedure shares stack frame of external procedure ldc. SEMANTIC_ANALYSIS internal procedure shares stack frame of external procedure ldc. PUSH internal procedure shares stack frame of external procedure ldc. LEX internal procedure shares stack frame of external procedure ldc. ERROR 186 internal procedure is called by several nonquick procedures. NEXT_STMT internal procedure shares stack frame of external procedure ldc. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 MLout ldc 000011 lex_control_chars ldc 000052 lex_delims ldc 000113 TRACING ldc 000114 brief_error PUSH 000116 long_error PUSH 000212 non_restart_error PUSH STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ERROR 000100 Pstmt ERROR 000102 Perring_token ERROR combine_elements 000100 i combine_elements 000101 l combine_elements ldc 000100 Icommand ldc 000101 Larg ldc 000102 Lin ldc 000103 Lout ldc 000104 Nargs ldc 000106 Pacl_out ldc 000110 Parg ldc 000112 Pfirst_name_elements ldc 000114 Pin ldc 000116 Pname ldc 000120 Pname_elements ldc 000122 Pobj_dflt_lib_codes ldc 000124 Pobj_dflt_lib_names ldc 000126 Pobj_dflt_search_codes ldc 000130 Pobj_dflt_search_names ldc 000132 Pobj_root ldc 000134 Pobj_root_array ldc 000136 Pobj_root_name ldc 000140 Pobj_search_proc ldc 000142 Pobj_star_code ldc 000144 Pout ldc 000146 Ptemp_seg ldc 000150 Scommand ldc 000151 Sreject_root ldc 000152 bc_in ldc 000162 code ldc 000163 compilation_date ldc 000200 dir_in ldc 000252 dir_out ldc 000324 ent_in ldc 000334 ent_out ldc 000344 entry_point ldc 000366 entry_point_name ldc 000410 ename ldc 000430 i ldc 000431 j ldc 000432 k ldc 000433 obj_command_dflt_values ldc 000433 obj_desc ldc 000443 path ldc 000515 search_proc ldc 000535 starcode ldc 000536 temp_name ldc 000546 temp_name30 ldc 000560 Pthis_token ldc 000562 Pstmt ldc 000564 Ptoken ldc 000566 SPDL ldc 000567 MERROR_SEVERITY ldc 000570 SERROR_CONTROL ldc 000571 MIN_PRINT_SEVERITY ldc 000571 SERROR_PRINTED ldc 000572 PRINT_SEVERITY_CONTROL ldc 000616 Igreater absolute_pathname 000617 Inext_greater absolute_pathname 000620 Lentryname absolute_pathname 000630 i command_name_ 000646 Idollar entryname 001004 Nchar OUTN 001014 Nchar OUTVN 001015 Isignificant OUTVN 001024 Nwords allocate 001026 P allocate 001030 code allocate 001040 LTOKEN_REQD_VALUE SEMANTIC_ANALYSIS 001041 NRED SEMANTIC_ANALYSIS 001042 PRED SEMANTIC_ANALYSIS 001044 PTOKEN_REQD SEMANTIC_ANALYSIS 001046 PTOKEN_REQD_VALUE SEMANTIC_ANALYSIS 001050 STOKEN_FCN SEMANTIC_ANALYSIS 001051 CODE SEMANTIC_ANALYSIS 001052 I SEMANTIC_ANALYSIS 001053 NUMBER SEMANTIC_ANALYSIS 001054 DIRECTION SEMANTIC_ANALYSIS 001055 STACK SEMANTIC_ANALYSIS 001067 STACK_DEPTH SEMANTIC_ANALYSIS 001130 i LEX 001142 Ssearching NEXT_STMT THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs unpk_to_pk cat_realloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return tra_ext alloc_auto_adj mod_fx1 enable shorten_stack ext_entry int_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. backup_name_ check_star_name_$entry check_star_name_$path clock_ com_err_ cu_$arg_count cu_$arg_ptr cu_$cl cv_dec_check_ date_time_$format decode_entryname_ expand_path_ get_wdir_ hcs_$truncate_seg initiate_file_ iox_$put_chars lex_error_ lex_error_ lex_error_ lex_string_$init_lex_delims lex_string_$lex suffixed_name_$make suffixed_name_$new_suffix terminate_file_ translator_temp_$get_next_segment translator_temp_$get_segment translator_temp_$release_all_segments tssi_$clean_up_segment tssi_$finish_segment tssi_$get_segment THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$fatal_error error_table_$no_makeknown error_table_$noentry error_table_$wrong_no_of_args iox_$error_output sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 170 007436 2135 007446 14 3 007447 910 007501 167 007505 596 007524 597 007533 598 007536 599 007540 600 007557 601 007602 602 007604 603 007632 604 007634 605 007670 606 007672 608 007704 609 007707 610 007726 612 007741 614 007752 616 007763 622 007773 623 007775 624 007776 625 007777 637 010021 638 010056 639 010062 640 010065 641 010111 643 010113 644 010143 645 010145 648 010153 649 010155 650 010160 653 010245 655 010364 656 010376 657 010402 658 010403 659 010404 660 010407 661 010410 664 010415 667 010434 668 010461 669 010463 670 010467 671 010471 677 010472 681 010516 683 010517 684 010543 686 010544 688 010576 690 010577 692 010605 693 010641 695 010642 697 010675 698 010725 700 010726 702 010762 703 010766 705 010767 706 011013 708 011014 709 011040 710 011044 627 011045 628 011053 630 011071 633 011125 635 011141 723 011142 729 011144 733 011170 734 011172 735 011176 736 011213 738 011222 739 011224 741 011225 743 011227 744 011231 745 011232 746 011253 749 011261 758 011264 765 011266 766 011306 767 011310 768 011313 769 011334 770 011336 773 011344 774 011345 781 011351 785 011353 787 011366 797 011370 808 011372 810 011377 811 011411 813 011416 815 011420 820 011446 821 011471 825 011501 832 011504 835 011506 837 011513 838 011533 840 011541 842 011547 845 011555 854 011560 858 011562 862 011605 865 011607 868 011611 871 011623 884 011626 900 011634 901 011640 902 011651 903 011665 905 011701 907 011736 908 011743 910 011753 915 012063 922 012210 923 012211 924 012213 926 012230 928 012231 931 012234 933 012245 934 012254 936 012256 942 012257 946 012260 948 012267 950 012272 951 012277 952 012301 953 012305 956 012307 961 012310 965 012311 967 012314 968 012322 971 012325 977 012326 982 012327 984 012342 986 012346 990 012351 994 012364 995 012374 999 012407 1000 012456 1001 012466 1008 012501 1011 012513 1012 012523 1016 012541 1021 012554 1022 012564 1025 012577 1030 012612 1032 012627 1033 012637 1036 012652 1038 012664 1039 012670 1041 012703 1042 012707 1043 012721 1044 012727 1046 012745 1047 012747 1048 012761 1049 012773 1051 013007 1053 013033 1055 013050 1058 013063 1059 013065 1062 013100 1063 013102 1064 013120 1065 013122 1068 013134 1070 013151 1071 013161 1072 013167 1075 013205 1076 013207 1078 013221 1079 013233 1082 013246 1084 013256 1085 013260 1087 013273 1088 013275 1089 013307 1091 013323 1093 013335 1094 013345 1095 013355 1097 013370 1098 013400 1100 013416 1101 013420 1103 013432 1106 013434 1108 013451 1109 013461 1110 013467 1113 013505 1114 013507 1116 013521 1117 013533 1120 013546 1122 013556 1123 013560 1125 013573 1126 013575 1127 013607 1129 013623 1131 013635 1132 013645 1133 013655 1135 013670 1136 013700 1138 013716 1139 013720 1141 013732 1144 013734 1146 013751 1147 013761 1151 013774 1152 014003 1154 014016 1155 014025 1156 014037 1157 014047 1160 014061 1161 014066 1162 014070 1163 014103 1164 014106 1165 014122 1166 014134 1167 014143 1168 014145 1169 014160 1170 014161 1171 014176 1173 014214 1174 014216 1177 014231 1179 014232 1180 014243 1181 014251 1182 014263 1183 014273 1184 014311 1185 014313 1187 014314 1188 014316 1190 014340 1191 014351 1192 014362 1193 014421 1195 014444 1196 014446 1197 014454 1198 014457 1201 014472 1202 014477 1204 014515 1205 014522 1206 014527 1207 014542 1209 014554 1210 014557 1211 014572 1213 014604 1214 014613 1216 014631 1217 014634 1218 014642 1219 014667 1220 014676 1221 014705 1222 014710 1225 014737 1226 014743 1228 014756 1229 014762 1230 014775 1233 015010 1234 015017 1236 015032 1237 015034 1240 015046 1242 015063 1243 015073 1244 015103 1247 015115 1248 015122 1249 015132 1252 015145 1253 015152 1254 015154 1256 015167 1257 015171 1258 015203 1259 015213 1261 015225 1262 015235 1263 015245 1264 015257 1265 015261 1269 015263 1271 015300 1272 015310 1277 015323 1278 015333 1280 015346 1281 015350 1283 015364 1284 015373 1286 015443 1289 015466 1290 015471 1292 015552 1293 015553 1294 015556 1296 015560 1301 015572 1303 015575 1310 015576 1313 015577 1314 015604 1315 015606 1316 015612 1317 015614 1318 015621 1319 015623 1320 015627 1321 015631 1322 015635 1323 015637 1324 015643 1325 015645 1326 015651 1328 015653 1329 015655 1331 015657 1332 015661 1333 015663 1334 015665 1335 015667 1336 015671 1338 015673 1339 015675 1341 015677 1342 015707 1343 015713 1344 015714 1345 015717 1346 015720 1347 015721 1349 015723 1357 015724 1366 015726 1367 015732 1368 015747 1369 015754 1370 015756 1372 015760 1373 015764 1376 015772 1378 015774 1380 015776 1384 015777 1387 016000 1388 016004 1391 016106 1393 016110 1394 016111 1396 016115 1397 016116 1398 016121 1399 016124 1401 016125 1402 016127 1405 016132 1406 016134 1408 016140 1415 016141 1422 016142 1423 016143 1424 016151 1427 016255 1429 016260 1430 016264 1433 016375 1436 016400 1437 016411 1440 016427 1441 016431 1442 016433 1446 016544 1448 016546 1449 016550 1450 016556 1453 016561 1454 016564 1456 016566 1459 016664 1462 016667 1463 016671 1464 016675 1467 016700 1474 016701 1478 016704 1483 017040 1484 017041 1485 017042 1488 017061 1493 017062 1496 017063 1498 017070 1499 017071 1502 017074 1515 017075 1520 017111 1521 017114 1522 017125 1524 017130 1525 017136 1526 017141 1528 017143 1533 017144 1538 017155 1539 017162 1540 017172 1542 017173 1543 017200 1544 017203 1546 017205 1553 017206 1559 017210 1560 017220 1561 017223 1562 017233 1564 017234 1565 017240 1566 017242 1568 017244 1572 017245 1579 017247 1580 017257 1581 017271 1583 017315 1 21 017317 1 40 017321 1 41 017327 1 42 017333 1 43 017346 1 44 017356 1 45 017361 1 47 017371 1 48 017400 1 49 017404 1 50 017412 9 30 017414 1604 017415 1605 017417 11 50 017420 11 52 017423 11 53 017424 11 55 017425 11 58 017426 11 60 017431 11 62 017433 11 63 017456 11 64 017461 11 65 017465 11 68 017475 11 70 017476 11 71 017502 11 73 017504 11 79 017523 11 84 017534 11 86 017535 11 88 017541 11 90 017542 11 92 017543 11 99 017577 11 101 017600 11 104 017603 11 106 017606 11 107 017632 11 108 017634 11 109 017637 11 111 017640 11 113 017641 11 116 017655 11 118 017656 11 120 017662 11 123 017663 11 124 017664 11 126 017670 11 127 017675 11 128 017701 11 130 017707 1732 017710 1734 017712 1735 017714 1736 017715 1737 017717 1738 017720 1739 017722 1740 017723 1741 017725 1742 017726 1743 017730 1744 017731 1745 017733 1746 017734 1747 017736 1749 017737 1750 017742 1753 017743 1754 017746 1756 017751 1757 017753 12 17 017755 12 18 017757 12 19 017761 12 24 017762 12 26 017764 12 27 017766 12 28 017774 1762 017775 1764 020001 1765 020010 1766 020014 1767 020015 1768 020017 1770 020020 1772 020030 1773 020031 1774 020032 1775 020034 1777 020035 1779 020045 1780 020047 1782 020050 1784 020060 1785 020061 1787 020062 1789 020066 1790 020067 1791 020073 1792 020075 1794 020076 1796 020106 1797 020107 1798 020110 1799 020112 1801 020113 1803 020114 1804 020115 1805 020117 1807 020120 1809 020130 1810 020131 1811 020133 1813 020134 1815 020144 1816 020145 1817 020147 1819 020150 1821 020151 1822 020153 1824 020154 1826 020164 1827 020165 1828 020167 1830 020170 1832 020200 1833 020201 1834 020203 1836 020204 1838 020214 1839 020215 1840 020217 1842 020220 1844 020230 1845 020232 1847 020233 1849 020236 1851 020237 1853 020241 1854 020245 1855 020247 1857 020250 1859 020252 1860 020256 1861 020260 1863 020261 1865 020262 1866 020266 1867 020270 1869 020271 1871 020301 1872 020305 1873 020307 1875 020310 1877 020320 1878 020322 1880 020323 1882 020331 1883 020335 1884 020337 1886 020340 1888 020346 1889 020352 1890 020354 1892 020355 1894 020366 1895 020370 1896 020374 1897 020376 1899 020377 1901 020410 1902 020420 1903 020422 1904 020426 1906 020427 1908 020430 1909 020434 1910 020436 1912 020437 1914 020440 1915 020444 1916 020446 1918 020447 1920 020457 1921 020463 1922 020465 1924 020466 1926 020476 1927 020500 1929 020501 1931 020505 1932 020521 1933 020525 1934 020527 1936 020530 1938 020540 1939 020541 1940 020543 1942 020544 1944 020554 1945 020555 1946 020557 1948 020560 1950 020564 1951 020567 1952 020571 1954 020572 1956 020576 1957 020600 1959 020601 1961 020605 1962 020615 1963 020616 1964 020620 1966 020621 1968 020631 1969 020632 1970 020634 1972 020635 1974 020641 1975 020644 1976 020650 1977 020652 1979 020653 1981 020663 1982 020664 1983 020666 1985 020667 1987 020677 1988 020700 1989 020702 1991 020703 1993 020704 1994 020706 1996 020707 1998 020717 1999 020721 2001 020722 2003 020726 2004 020730 2005 020731 2006 020733 2008 020734 2010 020740 2011 020741 2012 020742 2013 020744 2015 020745 2017 020755 2018 020756 2019 020760 2021 020761 2023 020771 2024 020772 2025 020774 2027 020775 2029 021001 2030 021011 2031 021012 2032 021014 2034 021015 2036 021021 2037 021031 2038 021032 2039 021034 2041 021035 2043 021037 2045 021040 2047 021050 2048 021052 2050 021053 2052 021055 2054 021056 2056 021060 2058 021061 2060 021063 2062 021064 2064 021066 2066 021067 2068 021070 2069 021072 2071 021073 2073 021075 2075 021076 2077 021100 2078 021102 2079 021106 2080 021112 2081 021114 2083 021115 2085 021117 2086 021121 2087 021125 2088 021131 2089 021133 2091 021134 2093 021137 2095 021140 2097 021141 2098 021142 2099 021146 2100 021150 2102 021151 2104 021161 2105 021162 2107 021163 2109 021173 2110 021177 2111 021201 2113 021202 2115 021212 2117 021213 2119 021215 2121 021216 2123 021226 2124 021230 2126 021231 2128 021232 12 36 021233 12 59 021235 12 60 021240 12 62 021337 12 63 021344 12 64 021366 12 66 021367 12 68 021370 12 70 021373 13 31 021374 13 36 021376 13 37 021400 13 38 021405 13 39 021407 13 40 021421 13 41 021423 13 42 021425 13 44 021435 13 45 021436 13 47 021451 13 48 021453 13 49 021456 13 51 021460 14 139 021461 14 153 021467 14 154 021501 14 156 021510 14 158 021517 14 160 021520 14 161 021522 14 164 021535 14 166 021541 14 168 021543 14 172 021645 14 177 021772 15 18 021774 15 24 021775 15 25 021777 15 26 022002 15 27 022004 15 28 022012 15 29 022014 15 30 022021 15 31 022022 15 32 022023 15 35 022034 15 36 022040 15 39 022041 ----------------------------------------------------------- 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