COMPILATION LISTING OF SEGMENT mrds_dsm_scanner Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/18/85 1021.2 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 mrds_dsm_scanner: 10 procedure (p_mrds_dsm_scanner_info_ptr, p_lex_stack_ptr, p_stack_index, 11 p_code); 12 13 /* 14* ??-??-?? Spratt: written 15* 16* 80-06-28 Spratt: Order the alphanum_token_list by token size, as 17* . was already done in the special_token_list. 18* 19* 81-01-23: Davids: modified internal procedure comment_skip so 20* . that before if calls get_next_char_non_white it 21* . increments mrds_dsm_scanner_info.pos by 1. This caused 22* . comments to really be skiped rather than causing errors 23* . on the finial "/". 24* 25* 81-05-08 Davids: Added a "PROGRAM LOGIC ERROR" clause to sub_err_ 26* . message printed is the mrds_dsm_scanner_info structure 27* . is the wrong version. 28* 29* . added an ioa_ call to report_mds_error to send the error 30* . message to the listing - if a listing is being produced 31* . (listing_iocb_ptr ^= null) 32* 33* 81-05-15 Davids: set p_code explicitly to zero in the init entry. 34* 35* . reformated the call to sub_err_ and added a comment that 36* . the call to sub_err_ never returns 37* 38* . removed unreferenced variables. 39* 40* 81-05-26 Davids: rewrote most of the comment handling code so 41* . that multiple line comments and line numbers are handled 42* . correctly and so comment lines (besides the first line) 43* . are output to the listing. 44* 45* 81-07-21 Jim Gray : added a check for the legal special 46* . characters allowed "(", ")", ",", ";", ":", and "=" so 47* . that any other remaining special characters are detected 48* . as illegal in the scanner, and do not cause a parser 49* . failure. 50* 51* 81-07-24 Davids: added the character "/" to the list of special 52* . characters so that comments will be processed without 53* . errors. the character "*" does not need to be added to 54* . the special list for comment processing because once the 55* . / is found a special check is made to see whether the 56* . next character is an *. 57* 58* 81-09-16 Davids: added the substr builtin so that the code would 59* . compile with -prefix stringrange. Since in execution the 60* . string would be truncated anyway the addition of the 61* . substr will not change the execution behavior. 62* 63* DESCRIPTION: 64* 65* Lexical analyzer or scanner for returning tokens from the data 66* submodel source to the parser. A token may be an identifier, 67* keyword, or end of file. Also returned in mrds_dsm_scanner_info 68* for use by the parser; an integer encoding value identifying the 69* token, pointers to the token in the source, the start of the 70* current line, the line number and length of the token. A line 71* numbered version of the original source can be produced. Comments 72* and white space are skipped over, and any invalid characters are 73* detected. 74* 75* There are two entries: init entry - should be called first for 76* initialization normal entry - for returning tokens from the 77* source 78* 79* Note that the value returned by p_code will currently always be 80* zero. errors will be reported as they are found and an indication 81* that errors have occured will be that 82* mrds_dsm_scanner_info.highest_severity is ^= 0. 83* 84* 85* 86* PARAMETERS: 87* 88* === normal entry === 89* 90* p_mrds_dsm_scanner_info_ptr - - (input) pointer to the info structure for 91* the scanner. 92* 93* p_lex_stack_ptr - - (input) pointer to the lexical stack 94* 95* p_stack_index - - (input) stack element which is hold the returned token, 96* etc. 97* 98* p_code - - (output) an error code describing reason for failure of scanner. 99* 100* lex_stack - - (output) the specified element contains the token pointer, 101* length, encoding, and line number and line start pointer. 102* 103* (output) for the line numbered listing goes to switch pointed to by 104* mrds_dsm_scanner_info.listing_iocb_ptr. 105* 106* === init entry === 107* 108* p_mrds_dsm_scanner_info_ptr - - (input) same as above. 109* 110* p_code - - (output) same as above. 111**/ 112 113 /* PARAMETER */ 114 115 dcl p_stack_index fixed bin; 116 dcl p_lex_stack_ptr ptr; 117 dcl p_code fixed bin (35); 118 dcl p_mrds_dsm_scanner_info_ptr ptr; 119 120 /* AUTOMATIC */ 121 122 dcl current_terminal char (256) varying; 123 dcl current_terminal_and_token_match bit (1) aligned; 124 dcl debug_sw bit (1) aligned; 125 dcl encoding fixed bin (35); 126 dcl message char (256) varying; 127 dcl message_length fixed bin; 128 dcl symbol_found bit (1); 129 dcl alphanum_token_list_ptr ptr; 130 dcl special_token_list_ptr ptr; 131 dcl alphanum_token_list_index fixed bin; 132 dcl special_token_list_index fixed bin; 133 dcl alphanum_token_list_size fixed bin; 134 dcl special_token_list_size fixed bin; 135 dcl line_no_pic pic "zzzzzz9"; 136 dcl work_area_ptr ptr; 137 dcl overlength_token_already_seen bit (1) aligned; 138 139 /* BASED */ 140 141 dcl source_overlay char (sys_info$max_seg_size) based; 142 dcl token char (mrds_dsm_scanner_info.token_length) 143 based (mrds_dsm_scanner_info.token_ptr); 144 dcl work_area area (sys_info$max_seg_size) based (work_area_ptr); 145 dcl 1 alphanum_token_list based (alphanum_token_list_ptr), 146 2 size fixed bin (35), 147 2 index (alphanum_token_list_size refer (alphanum_token_list.size)) 148 fixed bin (35); 149 150 dcl 1 special_token_list based (special_token_list_ptr), 151 2 size fixed bin (35), 152 2 index (special_token_list_size refer (special_token_list.size)) 153 fixed bin (35); 154 dcl char_string (sys_info$max_seg_size) char (1) based; 155 156 /* BUILTIN */ 157 158 dcl substr builtin; 159 dcl reverse builtin; 160 dcl max builtin; 161 dcl string builtin; 162 dcl hbound builtin; 163 dcl null builtin; 164 dcl index builtin; 165 dcl length builtin; 166 dcl verify builtin; 167 dcl addr builtin; 168 dcl ltrim builtin; 169 dcl addrel builtin; 170 171 /* CONSTANT */ 172 173 dcl MYNAME init ("mrds_dsm_scanner") char (16) internal static 174 options (constant); 175 dcl EOF_ENCODING fixed bin internal static options (constant) init (0); 176 dcl WHITESPACE_CHARS char (2) internal static options (constant) 177 init (" "); /* tab and blank. */ 178 dcl ALPHANUM_CHARS char (62) internal static options (constant) 179 init ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"); 180 dcl IDENTIFIER_CHARS char (64) internal static options (constant) 181 init ( 182 "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-_"); 183 dcl SPECIAL_CHARS char (7) init ("(),;:=/"); 184 dcl NL_CHAR char (1) internal static options (constant) init (" 185 "); 186 187 dcl START fixed bin internal static options (constant) init (0); 188 dcl CASE_END fixed bin internal static options (constant) init (7); 189 dcl ALPHANUM_TYPE fixed bin internal static options (constant) init (1); 190 dcl SPECIAL_TYPE fixed bin internal static options (constant) init (2); 191 dcl NL_TYPE fixed bin internal static options (constant) init (3); 192 declare ILLEGAL_TYPE fixed bin int static options (constant) init (5); 193 dcl EOF_TYPE fixed bin internal static options (constant) init (6); 194 dcl WHITESPACE_TYPE fixed bin internal static options (constant) init (4); 195 196 dcl TYPE_NAME_ARRAY (0:7) char (32) varying internal static 197 options (constant) 198 init ("start", "alphanumeric", "special", "newline", "white space", 199 "illegal", "end of file", "case end"); 200 201 /* ENTRY */ 202 203 dcl sub_err_ entry options (variable); 204 dcl ioa_$ioa_switch entry options (variable); 205 dcl ioa_$rs entry options (variable); 206 dcl ioa_ entry options (variable); 207 dcl requote_string_ entry (char (*)) returns (char (*)); 208 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 209 210 /* EXTERNAL */ 211 212 dcl error_table_$unimplemented_version fixed bin (35) ext; 213 dcl sys_info$max_seg_size fixed bin (24) ext; 214 215 /* normal entry */ 216 217 mrds_dsm_scanner_info_ptr = p_mrds_dsm_scanner_info_ptr; 218 if mrds_dsm_scanner_info.version ^= MRDS_DSM_SCANNER_INFO_VERSION_1 then 219 call 220 sub_err_ (error_table_$unimplemented_version, MYNAME, "s", null, 221 (0), 222 "PROGRAM LOGIC ERROR^/The wrong version of the mrds_dsm_scanner_info structure was supplied." 223 ); 224 225 226 227 /* will never return from the call to sub_err_ */ 228 229 debug_sw = mrds_dsm_scanner_info.debug_scanner; 230 lex_stack_ptr = p_lex_stack_ptr; 231 work_area_ptr = mrds_dsm_scanner_info.work_area_ptr; 232 special_token_list_ptr = mrds_dsm_scanner_info.special_token_list_ptr; 233 alphanum_token_list_ptr = mrds_dsm_scanner_info.alphanum_token_list_ptr; 234 p_code = 0; 235 goto state (START); 236 237 /* initialization entry */ 238 239 mrds_dsm_scanner$init: 240 entry (p_mrds_dsm_scanner_info_ptr, p_code); 241 242 p_code = 0; 243 mrds_dsm_scanner_info_ptr = p_mrds_dsm_scanner_info_ptr; 244 work_area_ptr = mrds_dsm_scanner_info.work_area_ptr; 245 call initialize_encoding_information; 246 call 247 get_next_char_init (mrds_dsm_scanner_info.char_ptr, 248 mrds_dsm_scanner_info.type, mrds_dsm_scanner_info.char); 249 250 return; 251 252 /* START */ 253 state (0): /* 254* Using the type code for the current character, go to the appropiate state 255* for that class of tokens, the parser having initialized the current character 256* before the first call, and scanner obtaining the next character to be used 257* when called again before returning to the parser. 258* */ 259 token_length = 0; 260 symbol_found = "0"b; 261 overlength_token_already_seen = "0"b; 262 263 264 /* Loop from start state to the recognition states, while a token is not 265* found, and end of source is not detected. 266**/ 267 268 do while (^symbol_found); 269 270 if debug_sw then 271 call 272 ioa_ ("A^[n^] ^a character (type ^d) at position ^d: ^a", 273 ( 274 index ("aeiouh", 275 substr (TYPE_NAME_ARRAY (mrds_dsm_scanner_info.type), 1, 1)) 276 > 0), TYPE_NAME_ARRAY (mrds_dsm_scanner_info.type), 277 mrds_dsm_scanner_info.type, mrds_dsm_scanner_info.pos, 278 requote_string_ ((mrds_dsm_scanner_info.char))); 279 280 goto state (mrds_dsm_scanner_info.type); 281 282 /* ALPHANUMERIC */ 283 state (1): /* Letter or digit found, accumulate characters that are letters, numbers, 284* underscores, hyphens into an identifier token then make checks for keywords 285* and pathnames that may follow to provide correct parser and scanner encoding. 286* */ 287 call alphanum_handler (); 288 call 289 stack_put (p_lex_stack_ptr, p_stack_index, 290 mrds_dsm_scanner_info.token_count); 291 symbol_found = "1"b; 292 goto state (CASE_END); /* SPECIAL */ 293 294 state (2): /* Special character found, if slash, check for comment else return encoding 295* for the character. 296* */ 297 if ^comment_skip () then do; 298 299 /* not a comment, single character special instead, get it's encoding */ 300 301 call special_handler (); 302 call 303 stack_put (p_lex_stack_ptr, p_stack_index, 304 mrds_dsm_scanner_info.token_count); 305 symbol_found = "1"b; 306 end; 307 goto state (CASE_END); 308 309 /* NL */ 310 state (3): /* new line detected */ 311 call 312 get_next_char_new_line (mrds_dsm_scanner_info.char_ptr, 313 mrds_dsm_scanner_info.type, mrds_dsm_scanner_info.char); 314 symbol_found = "0"b; 315 goto state (CASE_END); 316 317 /* WHITE_SPACE */ 318 state (4): /* white space detected, skip over it */ 319 call 320 get_next_char_non_white (mrds_dsm_scanner_info.char_ptr, 321 mrds_dsm_scanner_info.type, mrds_dsm_scanner_info.char); 322 symbol_found = "0"b; 323 goto state (CASE_END); 324 325 /* ILLEGAL */ 326 state (5): /* illegal character detected */ 327 call 328 ioa_$rs ("^a^a^a ^d ^a ^d^a", message, message_length, 329 "Character """, mrds_dsm_scanner_info.char, 330 """, before token number", mrds_dsm_scanner_info.token_count + 1, 331 "on line", mrds_dsm_scanner_info.line_number, "."); 332 call 333 report_mds_error (1 /* severity */, ILLEGAL_CHAR_ERROR, (message)); 334 call 335 get_next_char (mrds_dsm_scanner_info.char_ptr, 336 mrds_dsm_scanner_info.type, mrds_dsm_scanner_info.char); 337 symbol_found = "0"b; 338 goto state (CASE_END); 339 340 /* EOF */ 341 state (6): /* end of input detected */ 342 encoding = EOF_ENCODING; 343 token_ptr = mrds_dsm_scanner_info.char_ptr; 344 call 345 stack_put (p_lex_stack_ptr, p_stack_index, 346 mrds_dsm_scanner_info.token_count); 347 symbol_found = "1"b; 348 goto state (CASE_END); 349 350 /* CASE_END */ 351 state (7): 352 end; 353 354 if debug_sw then 355 call 356 ioa_ ( 357 "Scanner returns: ^a token on ^a line (encoding of ^d) is ^a", 358 add_cardinal_suffix ((mrds_dsm_scanner_info.token_count)), 359 add_cardinal_suffix ((mrds_dsm_scanner_info.line_number)), 360 encoding, requote_string_ ((token))); 361 362 return; 363 364 stack_put: 365 procedure (p_lex_stack_ptr, p_stack_index, p_token_count); 366 /* START OF DECLARATIONS */ 367 /* Parameter */ 368 369 dcl p_lex_stack_ptr ptr; 370 dcl p_stack_index fixed bin; 371 dcl p_token_count fixed bin (35); 372 373 /* Automatic */ 374 /* Based */ 375 /* Builtin */ 376 /* Controlled */ 377 /* Constant */ 378 /* Entry */ 379 /* External */ 380 /* END OF DECLARATIONS */ 381 382 lex_stack_ptr = p_lex_stack_ptr; 383 384 /* increment the number of tokens seen in this line */ 385 386 p_token_count = p_token_count + 1; 387 388 /* routine to put the token info into the stack */ 389 390 lex_stack (p_stack_index).symptr = mrds_dsm_scanner_info.token_ptr; 391 lex_stack (p_stack_index).symlen = mrds_dsm_scanner_info.token_length; 392 lex_stack (p_stack_index).line = mrds_dsm_scanner_info.line_number; 393 lex_stack (p_stack_index).symbol = encoding; 394 lex_stack (p_stack_index).line_strt = mrds_dsm_scanner_info.line_ptr; 395 lex_stack (p_stack_index).line_size = mrds_dsm_scanner_info.line_length; 396 lex_stack (p_stack_index).token_num = mrds_dsm_scanner_info.token_count; 397 398 end; 399 400 alphanum_handler: 401 procedure (); 402 dcl current_terminal_and_token_match bit (1) aligned; 403 404 405 token_ptr = char_ptr; 406 token_length = 407 verify ( 408 substr (mrds_dsm_scanner_info.source_ptr -> source_overlay, pos, 409 mrds_dsm_scanner_info.source_length), IDENTIFIER_CHARS); 410 if token_length = 0 then do; 411 token_length = 412 mrds_dsm_scanner_info.source_length - mrds_dsm_scanner_info.pos + 1; 413 mrds_dsm_scanner_info.pos = mrds_dsm_scanner_info.source_length + 1; 414 mrds_dsm_scanner_info.char_ptr = null; 415 mrds_dsm_scanner_info.type = EOF_TYPE; 416 end; 417 else do; 418 token_length = token_length - 1; 419 mrds_dsm_scanner_info.pos = token_length + mrds_dsm_scanner_info.pos; 420 mrds_dsm_scanner_info.char_ptr = 421 addr (mrds_dsm_scanner_info.source_ptr 422 -> char_string (mrds_dsm_scanner_info.pos)); 423 mrds_dsm_scanner_info.char = 424 mrds_dsm_scanner_info.source_ptr 425 -> char_string (mrds_dsm_scanner_info.pos); 426 call 427 get_char_type (mrds_dsm_scanner_info.char, 428 mrds_dsm_scanner_info.type); 429 end; 430 431 current_terminal = ""; 432 current_terminal_and_token_match = "0"b; 433 434 do alphanum_token_list_index = 1 435 to hbound (alphanum_token_list.index, 1) 436 while (^current_terminal_and_token_match 437 & token_length 438 <= mrds_dsm_terminals 439 .TL (alphanum_token_list.index (alphanum_token_list_index)).ln); 440 if token_length 441 ^= mrds_dsm_terminals 442 .TL (alphanum_token_list.index (alphanum_token_list_index)).ln then 443 current_terminal_and_token_match = "0"b; 444 else do; 445 current_terminal = 446 substr (string (mrds_dsm_terminals.TC), 447 mrds_dsm_terminals 448 .TL (alphanum_token_list.index (alphanum_token_list_index)).fc, 449 mrds_dsm_terminals 450 .TL (alphanum_token_list.index (alphanum_token_list_index)).ln); 451 current_terminal_and_token_match = (current_terminal = token); 452 end; 453 end; 454 455 if current_terminal_and_token_match then do; 456 encoding = alphanum_token_list.index (alphanum_token_list_index - 1); 457 /* Since the index was incremented before the match was noted, the index for the match is one less than the current value of alphanum_token_list_index. */ 458 459 end; 460 else if mrds_dsm_scanner_info.identifier_encoding = -1 then do; 461 call 462 ioa_$rs ("Unrecognized token: ^a^/On line ^d, token number ^d.", 463 message, message_length, token, mrds_dsm_scanner_info.line_number, 464 mrds_dsm_scanner_info.token_count); 465 call 466 report_mds_error (2 /* severity */, UNRECOGNIZED_TOKEN_ERROR, 467 (message)); 468 end; 469 else do; 470 encoding = mrds_dsm_scanner_info.identifier_encoding; 471 472 end; /* Find encoding for token. Look first in list of alphanumeric terminals. 473* If the token is not there and an identifier terminal encoding is known, 474* use the identifier encoding. 475* */ 476 477 478 end; 479 480 get_char_type: 481 proc (p_char, p_type); 482 dcl p_char char (1) aligned; 483 dcl p_type fixed bin (35); 484 485 if p_char = NL_CHAR then 486 p_type = NL_TYPE; 487 else if index (WHITESPACE_CHARS, p_char) > 0 then 488 p_type = WHITESPACE_TYPE; 489 else if index (ALPHANUM_CHARS, p_char) > 0 then 490 p_type = ALPHANUM_TYPE; 491 else if index (SPECIAL_CHARS, p_char) > 0 then 492 p_type = SPECIAL_TYPE; 493 else p_type = ILLEGAL_TYPE; 494 495 end; 496 497 comment_skip: 498 procedure () returns (bit (1) aligned); 499 500 /* AUTOMATIC */ 501 502 dcl old_pos fixed bin (35); 503 dcl old_char char (1); 504 dcl old_char_ptr ptr; 505 dcl old_type fixed bin; 506 dcl new_line_index fixed bin (35); 507 dcl result bit (1) aligned; 508 dcl end_comment_index fixed bin; 509 510 511 /* check for presence of a comment, return failure if not found */ 512 513 old_type = mrds_dsm_scanner_info.type; 514 old_pos = mrds_dsm_scanner_info.pos; 515 old_char_ptr = mrds_dsm_scanner_info.char_ptr; 516 old_char = mrds_dsm_scanner_info.char; 517 call 518 get_next_char (mrds_dsm_scanner_info.char_ptr, 519 mrds_dsm_scanner_info.type, mrds_dsm_scanner_info.char); 520 if ^(old_char = "/" & mrds_dsm_scanner_info.char = "*") then do; 521 mrds_dsm_scanner_info.char_ptr = old_char_ptr; 522 mrds_dsm_scanner_info.char = old_char; 523 mrds_dsm_scanner_info.type = old_type; 524 mrds_dsm_scanner_info.pos = old_pos; 525 result = "0"b; 526 end; 527 else do; 528 529 /* routine to bypass comments in the source */ 530 531 end_comment_index = 532 index ( 533 substr (mrds_dsm_scanner_info.source_ptr -> source_overlay, 534 mrds_dsm_scanner_info.pos, 535 mrds_dsm_scanner_info.source_length - mrds_dsm_scanner_info.pos + 1) 536 , "*/") + mrds_dsm_scanner_info.pos - 1; 537 if end_comment_index = mrds_dsm_scanner_info.pos - 1 then 538 end_comment_index = mrds_dsm_scanner_info.source_length + 1; 539 540 new_line_index = 541 index ( 542 substr (mrds_dsm_scanner_info.source_ptr -> source_overlay, 543 mrds_dsm_scanner_info.pos, 544 mrds_dsm_scanner_info.source_length - mrds_dsm_scanner_info.pos + 1) 545 , NL_CHAR) + mrds_dsm_scanner_info.pos - 1; 546 547 do while ((new_line_index < end_comment_index) 548 & (mrds_dsm_scanner_info.type ^= EOF_TYPE)); 549 mrds_dsm_scanner_info.pos = new_line_index; 550 call 551 get_next_char_new_line (mrds_dsm_scanner_info.char_ptr, 552 mrds_dsm_scanner_info.type, mrds_dsm_scanner_info.char); 553 new_line_index = 554 index ( 555 substr (mrds_dsm_scanner_info.source_ptr -> source_overlay, 556 mrds_dsm_scanner_info.pos, 557 mrds_dsm_scanner_info.source_length - mrds_dsm_scanner_info.pos 558 + 1), NL_CHAR) + mrds_dsm_scanner_info.pos - 1; 559 end; 560 561 if mrds_dsm_scanner_info.type ^= EOF_TYPE then do; 562 mrds_dsm_scanner_info.pos = end_comment_index + 2; 563 call 564 get_next_char_non_white (mrds_dsm_scanner_info.char_ptr, 565 mrds_dsm_scanner_info.type, mrds_dsm_scanner_info.char); 566 symbol_found = "0"b; 567 result = "1"b; 568 end; 569 else do; /* check for comment error */ 570 call 571 ioa_$rs ("^a ^d^a", message, message_length, 572 "Comment ends line number", line_number, "."); 573 call 574 report_mds_error (2 /* severity */, 575 NO_COMMENT_END_DELIMITER_ERROR, (message)); 576 end; 577 end; 578 579 return (result); 580 581 end; 582 583 special_handler: 584 procedure (); 585 586 current_terminal_and_token_match = "0"b; 587 mrds_dsm_scanner_info.token_ptr = mrds_dsm_scanner_info.char_ptr; 588 589 do special_token_list_index = 1 590 to hbound (special_token_list.index, 1) 591 while (^current_terminal_and_token_match); 592 current_terminal = 593 substr (string (mrds_dsm_terminals.TC), 594 mrds_dsm_terminals 595 .TL (special_token_list.index (special_token_list_index)).fc, 596 mrds_dsm_terminals 597 .TL (special_token_list.index (special_token_list_index)).ln); 598 token_length = 599 mrds_dsm_terminals 600 .TL (special_token_list.index (special_token_list_index)).ln; 601 if token_length 602 > mrds_dsm_scanner_info.source_length - mrds_dsm_scanner_info.pos 603 + 1 then 604 current_terminal_and_token_match = "0"b; 605 else current_terminal_and_token_match = (current_terminal = token); 606 end; 607 608 if current_terminal_and_token_match then do; 609 encoding = special_token_list.index (special_token_list_index - 1); 610 mrds_dsm_scanner_info.pos = 611 mrds_dsm_scanner_info.pos + mrds_dsm_scanner_info.token_length - 1; 612 end; 613 else do; 614 call 615 ioa_$rs ("Special character ^a in line ^d.", message, 616 message_length, mrds_dsm_scanner_info.char, 617 mrds_dsm_scanner_info.line_number); 618 call 619 report_mds_error (4 /* severity */, UNRECOGNIZED_CHARACTER_ERROR, 620 (message)); 621 encoding = EOF_ENCODING; 622 end; 623 call 624 get_next_char (mrds_dsm_scanner_info.char_ptr, 625 mrds_dsm_scanner_info.type, mrds_dsm_scanner_info.char); 626 627 end; 628 629 get_next_character_routine: 630 procedure (); /* dummy entry, not used */ 631 632 /* This procedure has four entry points. 633* get_next_char_init should be called first to set up things 634* get_next_char_new_line is used to advance the current line, output it, and get the first char 635* get_next_char_non_white skips white spaces until a valid character is found 636* get_next_char$get_next_char returns only info about the next char in source 637**/ 638 /* START OF DECLARATIONS */ 639 /* Parameter */ 640 641 dcl p_chr_ptr ptr; 642 dcl p_type fixed bin (35); 643 dcl p_chr_val char (1) aligned; 644 645 /* Automatic */ 646 647 dcl code fixed bin (35); 648 dcl output_text char (256) varying; 649 dcl nonwhite_char_index fixed bin (35); 650 651 /* Based */ 652 653 /* Builtin */ 654 /* Controlled */ 655 /* Constant */ 656 /* Entry */ 657 /* External */ 658 /* END OF DECLARATIONS */ 659 660 661 662 663 /* INIT */ 664 get_next_char_init: 665 entry (p_chr_ptr, p_type, p_chr_val); /* This entry initializes internal stativ values */ 666 667 mrds_dsm_scanner_info.pos = 0; /* Starting position is first character */ 668 mrds_dsm_scanner_info.line_number = 0; 669 670 671 672 /* NEW LINE */ 673 get_next_char_new_line: 674 entry (p_chr_ptr, p_type, p_chr_val); /* entry to advance to next line */ 675 mrds_dsm_scanner_info.pos = mrds_dsm_scanner_info.pos + 1; 676 if mrds_dsm_scanner_info.pos <= mrds_dsm_scanner_info.source_length 677 then do; /* find end of next line */ 678 679 mrds_dsm_scanner_info.line_ptr = 680 addr (mrds_dsm_scanner_info.source_ptr 681 -> char_string (mrds_dsm_scanner_info.pos)); 682 mrds_dsm_scanner_info.line_length = 683 index ( 684 substr (mrds_dsm_scanner_info.line_ptr -> source_overlay, 1, 685 mrds_dsm_scanner_info.source_length - mrds_dsm_scanner_info.pos + 1) 686 , NL_CHAR); 687 if mrds_dsm_scanner_info.line_length = 0 then 688 mrds_dsm_scanner_info.line_length = 689 mrds_dsm_scanner_info.source_length 690 - mrds_dsm_scanner_info.pos + 1; /* segment doesn't end last line with NL */ 691 692 mrds_dsm_scanner_info.line_number = 693 mrds_dsm_scanner_info.line_number + 1; 694 mrds_dsm_scanner_info.token_count = 0; 695 696 if mrds_dsm_scanner_info.listing_iocb_ptr ^= null then do; 697 698 /* listing switch on, output the current line */ 699 700 line_no_pic = mrds_dsm_scanner_info.line_number; 701 output_text = 702 line_no_pic || " " 703 || 704 substr (mrds_dsm_scanner_info.line_ptr -> source_overlay, 1, 705 mrds_dsm_scanner_info.line_length); 706 707 call 708 iox_$put_chars (mrds_dsm_scanner_info.listing_iocb_ptr, 709 addrel (addr (output_text), 1), length (output_text), code); 710 if code ^= 0 then do; 711 call 712 ioa_$rs ("^a ^d ^a", message, message_length, 713 "Error in trying to output line number", 714 mrds_dsm_scanner_info.line_number, "to listing segment"); 715 call 716 report_mds_error (4 /* severity */, LISTING_IO_ERROR, 717 (message)); 718 end; 719 end; 720 p_chr_val = 721 mrds_dsm_scanner_info.source_ptr 722 -> char_string (mrds_dsm_scanner_info.pos); 723 p_chr_ptr = 724 addr (mrds_dsm_scanner_info.source_ptr 725 -> char_string (mrds_dsm_scanner_info.pos)); 726 call get_char_type (p_chr_val, p_type); 727 end; 728 729 else do; 730 p_type = EOF_TYPE; 731 p_chr_val = " "; 732 end; 733 return; 734 735 /* NEXT NON WHITE */ 736 get_next_char_non_white: 737 entry (p_chr_ptr, p_type, p_chr_val); /* This entry skips white space */ 738 739 nonwhite_char_index = 740 verify ( 741 substr (mrds_dsm_scanner_info.source_ptr -> source_overlay, 742 mrds_dsm_scanner_info.pos, 743 mrds_dsm_scanner_info.source_length - mrds_dsm_scanner_info.pos + 1), 744 WHITESPACE_CHARS); 745 746 if nonwhite_char_index > 0 then do; 747 mrds_dsm_scanner_info.pos = 748 mrds_dsm_scanner_info.pos + nonwhite_char_index - 1; 749 p_chr_val = 750 mrds_dsm_scanner_info.source_ptr 751 -> char_string (mrds_dsm_scanner_info.pos); 752 p_chr_ptr = 753 addr (mrds_dsm_scanner_info.source_ptr 754 -> char_string (mrds_dsm_scanner_info.pos)); 755 call get_char_type (p_chr_val, p_type); 756 end; 757 else do; 758 mrds_dsm_scanner_info.pos = mrds_dsm_scanner_info.source_length + 1; 759 p_type = EOF_TYPE; 760 p_chr_val = " "; 761 end; 762 return; /* NEXT CHAR */ 763 get_first_char: 764 get_next_char: 765 entry (p_chr_ptr, p_type, p_chr_val); /* return next character in source */ 766 mrds_dsm_scanner_info.pos = mrds_dsm_scanner_info.pos + 1; 767 768 769 if mrds_dsm_scanner_info.pos <= mrds_dsm_scanner_info.source_length 770 then do; 771 p_chr_val = 772 mrds_dsm_scanner_info.source_ptr 773 -> char_string (mrds_dsm_scanner_info.pos); 774 p_chr_ptr = 775 addr (mrds_dsm_scanner_info.source_ptr 776 -> char_string (mrds_dsm_scanner_info.pos)); 777 call get_char_type (p_chr_val, p_type); 778 end; 779 else do; 780 p_type = EOF_TYPE; 781 p_chr_val = " "; 782 end; 783 return; 784 785 end get_next_character_routine; 786 787 initialize_encoding_information: 788 proc; /* START OF DECLARATIONS */ 789 /* Parameter */ 790 791 /* Automatic */ 792 793 dcl token_list_index fixed bin (35); 794 dcl non_alphanum_char_index fixed bin; 795 dcl special_token_sort_index fixed bin; 796 dcl alphanum_token_sort_index fixed bin; 797 798 /* Based */ 799 /* Builtin */ 800 /* Controlled */ 801 /* Constant */ 802 /* Entry */ 803 /* External */ 804 /* END OF DECLARATIONS */ 805 806 alphanum_token_list_size = hbound (mrds_dsm_terminals.TL, 1); 807 special_token_list_size = hbound (mrds_dsm_terminals.TL, 1); 808 allocate alphanum_token_list in (work_area); 809 allocate special_token_list in (work_area); 810 mrds_dsm_scanner_info.special_token_list_ptr = special_token_list_ptr; 811 mrds_dsm_scanner_info.alphanum_token_list_ptr = alphanum_token_list_ptr; 812 813 alphanum_token_list_index = 0; 814 special_token_list_index = 0; 815 816 do token_list_index = 1 to hbound (mrds_dsm_terminals.TL, 1); 817 current_terminal = 818 substr (string (mrds_dsm_terminals.TC), 819 mrds_dsm_terminals.TL (token_list_index).fc, 820 mrds_dsm_terminals.TL (token_list_index).ln); 821 non_alphanum_char_index = 822 index (ALPHANUM_CHARS, substr (current_terminal, 1, 1)); 823 824 if non_alphanum_char_index > 0 then do; 825 alphanum_token_list_index = alphanum_token_list_index + 1; 826 do alphanum_token_sort_index = alphanum_token_list_index - 1 to 1 827 by -1 828 while (mrds_dsm_terminals.TL (token_list_index).ln 829 > mrds_dsm_terminals 830 .TL (alphanum_token_list.index (alphanum_token_sort_index)).ln); 831 alphanum_token_list.index (alphanum_token_sort_index + 1) = 832 alphanum_token_list.index (alphanum_token_sort_index); 833 end; 834 alphanum_token_list.index (alphanum_token_sort_index + 1) = 835 token_list_index; 836 end; 837 else if current_terminal = "" then 838 mrds_dsm_scanner_info.identifier_encoding = token_list_index; 839 else do; 840 special_token_list_index = special_token_list_index + 1; 841 do special_token_sort_index = special_token_list_index - 1 to 1 842 by -1 843 while (mrds_dsm_terminals.TL (token_list_index).ln 844 > mrds_dsm_terminals 845 .TL (special_token_list.index (special_token_sort_index)).ln); 846 special_token_list.index (special_token_sort_index + 1) = 847 special_token_list.index (special_token_sort_index); 848 end; 849 special_token_list.index (special_token_sort_index + 1) = 850 token_list_index; 851 end; 852 end; 853 alphanum_token_list.size = alphanum_token_list_index; 854 special_token_list.size = special_token_list_index; 855 856 end; 857 858 report_mds_error: 859 proc (p_severity, p_error_code, p_message); 860 861 /* PARAMETER */ 862 863 dcl p_severity fixed bin; 864 dcl p_error_code fixed bin (35); 865 dcl p_message char (*); 866 867 868 mrds_dsm_scanner_info.highest_severity = 869 max (p_severity, mrds_dsm_scanner_info.highest_severity); 870 871 call 872 ioa_$ioa_switch (mrds_dsm_scanner_info.error_iocb_ptr, 873 "^/Severity ^d, ^a^/^a", p_severity, 874 MRDS_DSM_ERROR_MESSAGE (p_error_code), p_message); 875 876 if mrds_dsm_scanner_info.listing_iocb_ptr ^= null () then 877 call 878 ioa_$ioa_switch (mrds_dsm_scanner_info.listing_iocb_ptr, 879 "^/Severity ^d, ^a^/^a", p_severity, 880 MRDS_DSM_ERROR_MESSAGE (p_error_code), p_message); 881 882 end; /* End of report_mds_error. */ 883 884 add_cardinal_suffix: 885 proc (p_num) returns (char (32) varying) options (non_quick); 886 887 /* The options(nonquick) is used to avoid a compiler bug. This procedure is 888* called in a stack extension and should therefore be non-quick. The compiler 889* neglects to make it so, however. 890**/ 891 892 dcl p_num fixed bin (35); 893 dcl num_pic pic "zzzzzzzzzz9"; 894 dcl rev char (2); 895 dcl SUFFIX (0:3) char (2) internal static options (constant) 896 init ("th", "st", "nd", "rd"); 897 dcl idx fixed bin; 898 899 num_pic = p_num; 900 rev = substr (reverse (num_pic), 1, 2); /* CHANGE 81-09-16 */ 901 if rev = "11" | rev = "21" | rev = "31" then 902 idx = 0; 903 else idx = index ("123", substr (rev, 1, 1)); 904 905 return (ltrim (num_pic) || SUFFIX (idx)); 906 end; 907 1 1 /* BEGIN INCLUDE FILE mrds_dsm_parse_stack.incl.pl1 */ 1 2 1 3 /* These structures are used by mrds_dsm_parse, mrds_dsm_scanner, and 1 4*mrds_dsm_semantics. They are very similar to the 1 5*mrds_rst_parse_stack.incl.pl1 structures, the difference being the 1 6*semantics_ptr in the lex_stack in this include file. 1 7* 1 8*Written 12/19/79 by Lindsey L. Spratt 1 9**/ 1 10 declare 1 lex_stack (-5:50) based (lex_stack_ptr), 1 11 2 symptr ptr, /* pointer to terminal symbol in source input */ 1 12 2 symlen fixed binary (24), /* length of terminal symbol in input */ 1 13 2 line fixed binary (24), /* line number in source for this symbol */ 1 14 2 symbol fixed binary (24), /* parser's encoding value for the terminal symbol */ 1 15 2 val fixed binary (71), /* conversion value for numbers */ 1 16 2 float float binary (63), /* conversion value if floating point number */ 1 17 2 semantics_ptr ptr, /* Pointer to arbitrary data, not used by either parse or scan routines.*/ 1 18 2 line_strt ptr, /* pointer to start of current line */ 1 19 2 line_size fixed binary (24), /* current length of line */ 1 20 2 token_num fixed binary (24); /* number of this token in current line, 1 21* 0 if for missing or wrong symbol */ 1 22 1 23 declare lex_stack_ptr ptr; /* pointer to lexical stack */ 1 24 1 25 /* on => output debug messages */ 1 26 1 27 dcl 1 p_struct (50) aligned based (p_struct_ptr), 1 28 2 parse_stack fixed bin (24), /* * parse stack */ 1 29 2 parse_stack2 fixed bin (24); /* * copy of parse stack used 1 30* with local error recovery */ 1 31 1 32 dcl p_struct_ptr ptr; 1 33 1 34 1 35 dcl cur_lex_top (50) fixed bin (24) aligned based (cur_lex_top_ptr); 1 36 /* current lex top stack (with parse_stack) */ 1 37 1 38 declare cur_lex_top_ptr ptr; 1 39 1 40 1 41 /* END INCLUDE FILE mrds_rst_parse_stack.incl.pl1 */ 1 42 908 909 2 1 /* BEGIN INCLUDE FILE - mrds_dsm_scan_info.incl.pl1 */ 2 2 2 3 /* This structure is used to communicate with mrds_dsm_scanner, and to 2 4*maintain information across calls. 2 5* 2 6*Written 12/19/79 by Lindsey L. Spratt 2 7**/ 2 8 2 9 dcl mrds_dsm_scanner_info_ptr 2 10 ptr; 2 11 dcl MRDS_DSM_SCANNER_INFO_VERSION_1 2 12 fixed bin (17) internal static options (constant) init (1); 2 13 2 14 dcl 1 mrds_dsm_scanner_info 2 15 based (mrds_dsm_scanner_info_ptr) aligned, 2 16 2 version fixed bin (35), 2 17 2 flags, 2 18 3 debug_scanner bit (1) unal, 2 19 3 pad bit (35) unal, 2 20 2 work_area_ptr ptr, 2 21 2 source_ptr ptr, 2 22 2 source_length fixed bin (35), 2 23 2 listing_iocb_ptr ptr, 2 24 2 error_iocb_ptr ptr, 2 25 2 identifier_encoding 2 26 fixed bin (35), 2 27 2 special_token_list_ptr 2 28 ptr, 2 29 2 alphanum_token_list_ptr 2 30 ptr, 2 31 2 token_ptr ptr, 2 32 2 token_count fixed bin (35), 2 33 2 token_length fixed bin (35), 2 34 2 line_ptr ptr, 2 35 2 line_length fixed bin (35), 2 36 2 pos fixed bin (35), 2 37 2 char_ptr ptr, 2 38 2 type fixed bin (35), 2 39 2 char char (1), 2 40 2 highest_severity fixed bin, 2 41 2 line_number fixed bin (35); 910 911 3 1 /* BEGIN INCLUDE FILE - mrds_dsm_error_info.incl.pl1 */ 3 2 3 3 /* This include file contains the standard error messages, and named constants 3 4*for error codes which index into the array of messages. 3 5* 3 6*Written 12/19/79 by Lindsey L. Spratt 3 7**/ 3 8 3 9 dcl PARSE_ERROR_RECOVERY fixed bin (35) internal static options (constant) init (1); 3 10 dcl PARSE_NO_RECOVERY fixed bin (35) internal static options (constant) init (2); 3 11 dcl LEX_TOO_MANY fixed bin (35) internal static options (constant) init (3); 3 12 dcl INTERNAL_STACK_OVERFLOW 3 13 fixed bin (35) internal static options (constant) init (4); 3 14 dcl PARSE_TOO_MANY fixed bin (35) internal static options (constant) init (5); 3 15 dcl PARSE_FAILURE fixed bin (35) internal static options (constant) init (6); 3 16 dcl LISTING_IO_ERROR fixed bin (35) internal static options (constant) init (7); 3 17 dcl ILLEGAL_CHAR_ERROR fixed bin (35) internal static options (constant) init (8); 3 18 dcl OVERLENGTH_TOKEN_ERROR fixed bin (35) internal static options (constant) init (9); 3 19 dcl NO_COMMENT_END_DELIMITER_ERROR 3 20 fixed bin (35) internal static options (constant) init (10); 3 21 dcl UNRECOGNIZED_CHARACTER_ERROR 3 22 fixed bin (35) internal static options (constant) init (11); 3 23 dcl UNRECOGNIZED_TOKEN_ERROR 3 24 fixed bin (35) internal static options (constant) init (12); 3 25 dcl DUPLICATE_RELATION_DEF_ERROR 3 26 fixed bin (35) internal static options (constant) init (13); 3 27 3 28 dcl DUPLICATE_ENTRY_ERROR fixed bin (35) internal static options (constant) init (14); 3 29 3 30 3 31 dcl MRDS_DSM_ERROR_MESSAGE (14) char (256) varying internal static options (constant) 3 32 init ("Bad syntax, a correction has been made.", 3 33 "Bad syntax, unable to make a correction.", 3 34 "Translator error, the lexical stack overflowed. Contact system personnel if problem persists." 3 35 , 3 36 "Translator error, an internal stack overflowed. Contact system personnel if problem persists." 3 37 , 3 38 "Translator error, the parse stack overflowed. Contact system personnel if problem persists." 3 39 , "Unable to complete parsing.", "Unable to do I/O on the listing segment switch.", 3 40 "An illegal character has been found in the source.", 3 41 "A token has been found which is too long.", 3 42 "A comment does not have a terminating delimiter.", 3 43 "An unrecognized character has been found.", "An unrecognized token has been found.", 3 44 "Multiple definitions of the same relation have been found, only the first one will be used." 3 45 , "Attempt to multiply specify the same entry, only the first one will be used."); 3 46 3 47 /* END INCLUDE FILE - mrds_dsm_error_info.incl.pl1 */ 912 913 4 1 /* BEGIN INCLUDE FILE mrds_dsm_terminals.incl.pl1 (Davids Multics) 05/29/81 1008.2 mst Fri */ 4 2 dcl 1 mrds_dsm_terminals static internal, 4 3 2 TC (153) char (1) init ( 4 4 "<", "i", "d", "e", "n", "t", "i", "f", "i", "e", "r", ">", ";", ":", 4 5 ",", "(", ")", "=", "r", "e", "l", "a", "t", "i", "o", "n", "a", "t", 4 6 "t", "r", "i", "b", "u", "t", "e", "a", "c", "c", "e", "s", "s", "r", 4 7 "e", "l", "_", "a", "c", "c", "a", "t", "t", "r", "_", "a", "c", "c", 4 8 "d", "e", "f", "a", "u", "l", "t", "i", "n", "w", "i", "t", "h", "d", 4 9 "e", "l", "e", "t", "e", "a", "p", "p", "e", "n", "d", "t", "u", "p", 4 10 "l", "e", "a", "t", "t", "r", "d", "a", "d", "e", "l", "e", "t", "e", 4 11 "_", "t", "u", "p", "l", "e", "a", "p", "p", "e", "n", "d", "_", "t", 4 12 "u", "p", "l", "e", "r", "e", "a", "d", "r", "e", "a", "d", "_", "a", 4 13 "t", "t", "r", "m", "o", "d", "i", "f", "y", "m", "o", "d", "i", "f", 4 14 "y", "_", "a", "t", "t", "r", "n", "u", "l", "l", "n", "r", "m"), 4 15 2 TL (31), 4 16 3 lk fixed bin (24) init ( 4 17 0, 0, 1, (6) 0, 4, (3) 0, 12, 4 18 (3) 0, 9, 14, 15, (4) 0, 24, 0, 0, 20, 4 19 17, 8, 0), 4 20 3 fc fixed bin (24) init ( 4 21 1, 13, 14, 15, 16, 17, 18, 19, 27, 36, 42, 49, 57, 64, 4 22 66, 70, 76, 82, 87, 91, 92, 93, 105, 117, 121, 130, 136, 147, 4 23 151, 152, 153), 4 24 3 ln fixed bin (24) init ( 4 25 12, (6) 1, 8, 9, 6, 7, 8, 7, 2, 4 26 4, 6, 6, 5, 4, 1, 1, 12, 12, 4, 9, 6, 11, 4, 4 27 (3) 1), 4 28 2 THL (0: 30) fixed bin (24) init ( 4 29 0, 31, 30, 19, 0, 0, 6, 0, 0, 25, 7, 21, 5, 26, 4 30 23, 0, 13, 11, 16, 10, 18, 27, 2, 22, 28, 0, 29, 0, 4 31 3, 0, 0); 4 32 4 33 /* END INCLUDE FILE mrds_dsm_terminals.incl.pl1 */ 914 915 916 917 end; 918 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/85 0907.0 mrds_dsm_scanner.pl1 >special_ldd>online>mrds.pbf-04/18/85>mrds_dsm_scanner.pl1 908 1 10/14/83 1608.6 mrds_dsm_parse_stack.incl.pl1 >ldd>include>mrds_dsm_parse_stack.incl.pl1 910 2 10/14/83 1608.9 mrds_dsm_scan_info.incl.pl1 >ldd>include>mrds_dsm_scan_info.incl.pl1 912 3 10/14/83 1608.7 mrds_dsm_error_info.incl.pl1 >ldd>include>mrds_dsm_error_info.incl.pl1 914 4 10/14/83 1608.9 mrds_dsm_terminals.incl.pl1 >ldd>include>mrds_dsm_terminals.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. ALPHANUM_CHARS 002227 constant char(62) initial unaligned dcl 178 ref 489 821 ALPHANUM_TYPE constant fixed bin(17,0) initial dcl 189 ref 489 CASE_END 002206 constant fixed bin(17,0) initial dcl 188 ref 292 307 315 323 338 348 EOF_ENCODING constant fixed bin(17,0) initial dcl 175 ref 341 621 EOF_TYPE constant fixed bin(17,0) initial dcl 193 ref 415 547 561 730 759 780 IDENTIFIER_CHARS 002207 constant char(64) initial unaligned dcl 180 ref 406 ILLEGAL_CHAR_ERROR 002075 constant fixed bin(35,0) initial dcl 3-17 set ref 332* ILLEGAL_TYPE constant fixed bin(17,0) initial dcl 192 ref 493 LISTING_IO_ERROR 002206 constant fixed bin(35,0) initial dcl 3-16 set ref 715* MRDS_DSM_ERROR_MESSAGE 000256 constant varying char(256) initial array dcl 3-31 set ref 871* 876* MRDS_DSM_SCANNER_INFO_VERSION_1 constant fixed bin(17,0) initial dcl 2-11 ref 218 MYNAME 002247 constant char(16) initial unaligned dcl 173 set ref 218* NL_CHAR constant char(1) initial unaligned dcl 184 ref 485 540 553 682 NL_TYPE constant fixed bin(17,0) initial dcl 191 ref 485 NO_COMMENT_END_DELIMITER_ERROR 002262 constant fixed bin(35,0) initial dcl 3-19 set ref 573* SPECIAL_CHARS 000326 automatic char(7) initial unaligned dcl 183 set ref 183* 491 SPECIAL_TYPE constant fixed bin(17,0) initial dcl 190 ref 491 START constant fixed bin(17,0) initial dcl 187 ref 235 SUFFIX 000254 constant char(2) initial array unaligned dcl 895 ref 905 TC 000010 constant char(1) initial array level 2 packed unaligned dcl 4-2 ref 445 592 817 TL 47 000010 constant structure array level 2 unaligned dcl 4-2 ref 806 807 816 TYPE_NAME_ARRAY 002076 constant varying char(32) initial array dcl 196 set ref 270 270* UNRECOGNIZED_CHARACTER_ERROR 002253 constant fixed bin(35,0) initial dcl 3-21 set ref 618* UNRECOGNIZED_TOKEN_ERROR 002074 constant fixed bin(35,0) initial dcl 3-23 set ref 465* WHITESPACE_CHARS 006332 constant char(2) initial unaligned dcl 176 ref 487 739 WHITESPACE_TYPE constant fixed bin(17,0) initial dcl 194 ref 487 addr builtin function dcl 167 ref 420 679 707 707 723 752 774 addrel builtin function dcl 169 ref 707 707 alphanum_token_list based structure level 1 unaligned dcl 145 set ref 808 alphanum_token_list_index 000314 automatic fixed bin(17,0) dcl 131 set ref 434* 434* 440 445 445* 456 813* 825* 825 826 853 alphanum_token_list_ptr 20 based pointer level 2 in structure "mrds_dsm_scanner_info" dcl 2-14 in procedure "mrds_dsm_scanner" set ref 233 811* alphanum_token_list_ptr 000310 automatic pointer dcl 129 in procedure "mrds_dsm_scanner" set ref 233* 434 434 440 445 445 456 808* 811 826 831 831 834 853 alphanum_token_list_size 000316 automatic fixed bin(17,0) dcl 133 set ref 806* 808 808 alphanum_token_sort_index 000533 automatic fixed bin(17,0) dcl 796 set ref 826* 826* 831 831* 834 char 35 based char(1) level 2 dcl 2-14 set ref 246* 270 310* 318* 326* 334* 423* 426* 516 517* 520 522* 550* 563* 614* 623* char_ptr 32 based pointer level 2 dcl 2-14 set ref 246* 310* 318* 334* 343 405 414* 420* 515 517* 521* 550* 563* 587 623* char_string based char(1) array unaligned dcl 154 set ref 420 423 679 720 723 749 752 771 774 code 000416 automatic fixed bin(35,0) dcl 647 set ref 707* 710 current_terminal 000100 automatic varying char(256) dcl 122 set ref 431* 445* 451 592* 605 817* 821 837 current_terminal_and_token_match 000201 automatic bit(1) dcl 123 in procedure "mrds_dsm_scanner" set ref 586* 589 601* 605* 608 current_terminal_and_token_match 000352 automatic bit(1) dcl 402 in procedure "alphanum_handler" set ref 432* 434 440* 451* 455 debug_scanner 1 based bit(1) level 3 packed unaligned dcl 2-14 ref 229 debug_sw 000202 automatic bit(1) dcl 124 set ref 229* 270 354 encoding 000203 automatic fixed bin(35,0) dcl 125 set ref 341* 354* 393 456* 470* 609* 621* end_comment_index 000377 automatic fixed bin(17,0) dcl 508 set ref 531* 537 537* 547 562 error_iocb_ptr 12 based pointer level 2 dcl 2-14 set ref 871* error_table_$unimplemented_version 000024 external static fixed bin(35,0) dcl 212 set ref 218* fc 50 000010 constant fixed bin(24,0) initial array level 3 dcl 4-2 ref 445 592 817 flags 1 based structure level 2 dcl 2-14 hbound builtin function dcl 162 ref 434 589 806 807 816 highest_severity 36 based fixed bin(17,0) level 2 dcl 2-14 set ref 868* 868 identifier_encoding 14 based fixed bin(35,0) level 2 dcl 2-14 set ref 460 470 837* idx 000104 automatic fixed bin(17,0) dcl 897 set ref 901* 903* 905 index builtin function dcl 164 in procedure "mrds_dsm_scanner" ref 270 487 489 491 531 540 553 682 821 903 index 1 based fixed bin(35,0) array level 2 in structure "special_token_list" dcl 150 in procedure "mrds_dsm_scanner" set ref 589 592 592 598 609 841 846* 846 849* index 1 based fixed bin(35,0) array level 2 in structure "alphanum_token_list" dcl 145 in procedure "mrds_dsm_scanner" set ref 434 434 440 445 445 456 826 831* 831 834* ioa_ 000016 constant entry external dcl 206 ref 270 354 ioa_$ioa_switch 000012 constant entry external dcl 204 ref 871 876 ioa_$rs 000014 constant entry external dcl 205 ref 326 461 570 614 711 iox_$put_chars 000022 constant entry external dcl 208 ref 707 length builtin function dcl 165 ref 707 707 lex_stack based structure array level 1 unaligned dcl 1-10 lex_stack_ptr 000330 automatic pointer dcl 1-23 set ref 230* 382* 390 391 392 393 394 395 396 line 3 based fixed bin(24,0) array level 2 dcl 1-10 set ref 392* line_length 30 based fixed bin(35,0) level 2 dcl 2-14 set ref 395 682* 687 687* 701 line_no_pic 000320 automatic picture(7) unaligned dcl 135 set ref 700* 701 line_number 37 based fixed bin(35,0) level 2 dcl 2-14 set ref 326* 354 392 461* 570* 614* 668* 692* 692 700 711* line_ptr 26 based pointer level 2 dcl 2-14 set ref 394 679* 682 701 line_size 16 based fixed bin(24,0) array level 2 dcl 1-10 set ref 395* line_strt 14 based pointer array level 2 dcl 1-10 set ref 394* listing_iocb_ptr 10 based pointer level 2 dcl 2-14 set ref 696 707* 876 876* ln 51 000010 constant fixed bin(24,0) initial array level 3 dcl 4-2 ref 434 440 445 592 598 817 826 826 841 841 ltrim builtin function dcl 168 ref 905 max builtin function dcl 160 ref 868 message 000204 automatic varying char(256) dcl 126 set ref 326* 332 461* 465 570* 573 614* 618 711* 715 message_length 000305 automatic fixed bin(17,0) dcl 127 set ref 326* 461* 570* 614* 711* mrds_dsm_scanner_info based structure level 1 dcl 2-14 mrds_dsm_scanner_info_ptr 000332 automatic pointer dcl 2-9 set ref 217* 218 229 231 232 233 243* 244 246 246 246 253 270 270 270 270 270 280 288 302 310 310 310 318 318 318 326 326 326 334 334 334 343 343 344 354 354 354 354 390 391 392 394 395 396 405 405 406 406 406 406 410 411 411 411 413 413 414 415 418 418 419 419 419 420 420 420 423 423 423 426 426 434 440 451 451 460 461 461 461 461 461 470 513 514 515 516 517 517 517 520 521 522 523 524 531 531 531 531 531 537 537 540 540 540 540 540 547 549 550 550 550 553 553 553 553 553 561 562 563 563 563 570 587 587 598 601 601 601 605 605 610 610 610 614 614 623 623 623 667 668 675 675 676 676 679 679 679 682 682 682 682 687 687 687 687 692 692 694 696 700 701 701 707 711 720 720 723 723 739 739 739 739 747 747 749 749 752 752 758 758 766 766 769 769 771 771 774 774 810 811 837 868 868 871 876 876 mrds_dsm_terminals 000010 constant structure level 1 unaligned dcl 4-2 new_line_index 000375 automatic fixed bin(35,0) dcl 506 set ref 540* 547 549 553* non_alphanum_char_index 000531 automatic fixed bin(17,0) dcl 794 set ref 821* 824 nonwhite_char_index 000520 automatic fixed bin(35,0) dcl 649 set ref 739* 746 747 null builtin function dcl 163 ref 218 218 414 696 876 num_pic 000100 automatic picture(11) unaligned dcl 893 set ref 899* 900 905 old_char 000371 automatic char(1) unaligned dcl 503 set ref 516* 520 522 old_char_ptr 000372 automatic pointer dcl 504 set ref 515* 521 old_pos 000370 automatic fixed bin(35,0) dcl 502 set ref 514* 524 old_type 000374 automatic fixed bin(17,0) dcl 505 set ref 513* 523 output_text 000417 automatic varying char(256) dcl 648 set ref 701* 707 707 707 707 overlength_token_already_seen 000324 automatic bit(1) dcl 137 set ref 261* p_char parameter char(1) dcl 482 ref 480 485 487 489 491 p_chr_ptr parameter pointer dcl 641 set ref 664 673 723* 736 752* 763 763 774* p_chr_val parameter char(1) dcl 643 set ref 664 673 720* 726* 731* 736 749* 755* 760* 763 763 771* 777* 781* p_code parameter fixed bin(35,0) dcl 117 set ref 9 234* 239 242* p_error_code parameter fixed bin(35,0) dcl 864 ref 858 871 876 p_lex_stack_ptr parameter pointer dcl 369 in procedure "stack_put" ref 364 382 p_lex_stack_ptr parameter pointer dcl 116 in procedure "mrds_dsm_scanner" set ref 9 230 288* 302* 344* p_message parameter char unaligned dcl 865 set ref 858 871* 876* p_mrds_dsm_scanner_info_ptr parameter pointer dcl 118 ref 9 217 239 243 p_num parameter fixed bin(35,0) dcl 892 ref 884 899 p_severity parameter fixed bin(17,0) dcl 863 set ref 858 868 871* 876* p_stack_index parameter fixed bin(17,0) dcl 370 in procedure "stack_put" ref 364 390 391 392 393 394 395 396 p_stack_index parameter fixed bin(17,0) dcl 115 in procedure "mrds_dsm_scanner" set ref 9 288* 302* 344* p_token_count parameter fixed bin(35,0) dcl 371 set ref 364 386* 386 p_type parameter fixed bin(35,0) dcl 483 in procedure "get_char_type" set ref 480 485* 487* 489* 491* 493* p_type parameter fixed bin(35,0) dcl 642 in procedure "get_next_character_routine" set ref 664 673 726* 730* 736 755* 759* 763 763 777* 780* pos 31 based fixed bin(35,0) level 2 dcl 2-14 set ref 270* 406 411 413* 419* 419 420 423 514 524* 531 531 531 537 540 540 540 549* 553 553 553 562* 601 610* 610 667* 675* 675 676 679 682 687 720 723 739 739 747* 747 749 752 758* 766* 766 769 771 774 requote_string_ 000020 constant entry external dcl 207 ref 270 354 result 000376 automatic bit(1) dcl 507 set ref 525* 567* 579 rev 000103 automatic char(2) unaligned dcl 894 set ref 900* 901 901 901 903 reverse builtin function dcl 159 ref 900 size based fixed bin(35,0) level 2 in structure "alphanum_token_list" dcl 145 in procedure "mrds_dsm_scanner" set ref 434 808* 853* size based fixed bin(35,0) level 2 in structure "special_token_list" dcl 150 in procedure "mrds_dsm_scanner" set ref 589 809* 854* source_length 6 based fixed bin(35,0) level 2 dcl 2-14 ref 406 411 413 531 537 540 553 601 676 682 687 739 758 769 source_overlay based char unaligned dcl 141 ref 406 531 540 553 682 701 739 source_ptr 4 based pointer level 2 dcl 2-14 ref 406 420 423 531 540 553 679 720 723 739 749 752 771 774 special_token_list based structure level 1 unaligned dcl 150 set ref 809 special_token_list_index 000315 automatic fixed bin(17,0) dcl 132 set ref 589* 592 592 598* 609 814* 840* 840 841 854 special_token_list_ptr 000312 automatic pointer dcl 130 in procedure "mrds_dsm_scanner" set ref 232* 589 592 592 598 609 809* 810 841 846 846 849 854 special_token_list_ptr 16 based pointer level 2 in structure "mrds_dsm_scanner_info" dcl 2-14 in procedure "mrds_dsm_scanner" set ref 232 810* special_token_list_size 000317 automatic fixed bin(17,0) dcl 134 set ref 807* 809 809 special_token_sort_index 000532 automatic fixed bin(17,0) dcl 795 set ref 841* 841* 846 846* 849 string builtin function dcl 161 ref 445 592 817 sub_err_ 000010 constant entry external dcl 203 ref 218 substr builtin function dcl 158 ref 270 406 445 531 540 553 592 682 701 739 817 821 900 903 symbol 4 based fixed bin(24,0) array level 2 dcl 1-10 set ref 393* symbol_found 000306 automatic bit(1) unaligned dcl 128 set ref 260* 268 291* 305* 314* 322* 337* 347* 566* symlen 2 based fixed bin(24,0) array level 2 dcl 1-10 set ref 391* symptr based pointer array level 2 dcl 1-10 set ref 390* sys_info$max_seg_size 000026 external static fixed bin(24,0) dcl 213 ref 406 531 540 553 682 701 739 token based char unaligned dcl 142 set ref 354 451 461* 605 token_count 24 based fixed bin(35,0) level 2 dcl 2-14 set ref 288* 302* 326 344* 354 396 461* 694* token_length 25 based fixed bin(35,0) level 2 dcl 2-14 set ref 253* 354 391 406* 410 411* 418* 418 419 434 440 451 461 461 598* 601 605 610 token_list_index 000530 automatic fixed bin(35,0) dcl 793 set ref 816* 817 817 826 834 837 841 849* token_num 17 based fixed bin(24,0) array level 2 dcl 1-10 set ref 396* token_ptr 22 based pointer level 2 dcl 2-14 set ref 343* 354 390 405* 451 461 587* 605 type 34 based fixed bin(35,0) level 2 dcl 2-14 set ref 246* 270 270 270* 280 310* 318* 334* 415* 426* 513 517* 523* 547 550* 561 563* 623* verify builtin function dcl 166 ref 406 739 version based fixed bin(35,0) level 2 dcl 2-14 ref 218 work_area based area dcl 144 ref 808 809 work_area_ptr 2 based pointer level 2 in structure "mrds_dsm_scanner_info" dcl 2-14 in procedure "mrds_dsm_scanner" ref 231 244 work_area_ptr 000322 automatic pointer dcl 136 in procedure "mrds_dsm_scanner" set ref 231* 244* 808 809 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. DUPLICATE_ENTRY_ERROR internal static fixed bin(35,0) initial dcl 3-28 DUPLICATE_RELATION_DEF_ERROR internal static fixed bin(35,0) initial dcl 3-25 INTERNAL_STACK_OVERFLOW internal static fixed bin(35,0) initial dcl 3-12 LEX_TOO_MANY internal static fixed bin(35,0) initial dcl 3-11 OVERLENGTH_TOKEN_ERROR internal static fixed bin(35,0) initial dcl 3-18 PARSE_ERROR_RECOVERY internal static fixed bin(35,0) initial dcl 3-9 PARSE_FAILURE internal static fixed bin(35,0) initial dcl 3-15 PARSE_NO_RECOVERY internal static fixed bin(35,0) initial dcl 3-10 PARSE_TOO_MANY internal static fixed bin(35,0) initial dcl 3-14 cur_lex_top based fixed bin(24,0) array dcl 1-35 cur_lex_top_ptr automatic pointer dcl 1-38 p_struct based structure array level 1 dcl 1-27 p_struct_ptr automatic pointer dcl 1-32 NAMES DECLARED BY EXPLICIT CONTEXT. add_cardinal_suffix 005610 constant entry internal dcl 884 ref 354 354 alphanum_handler 003462 constant entry internal dcl 400 ref 283 comment_skip 004027 constant entry internal dcl 497 ref 294 get_char_type 003746 constant entry internal dcl 480 ref 426 726 755 777 get_first_char 005206 constant entry internal dcl 763 get_next_char 005203 constant entry internal dcl 763 ref 334 517 623 get_next_char_init 004603 constant entry internal dcl 664 ref 246 get_next_char_new_line 004611 constant entry internal dcl 673 ref 310 550 get_next_char_non_white 005114 constant entry internal dcl 736 ref 318 563 get_next_character_routine 004601 constant entry internal dcl 629 initialize_encoding_information 005251 constant entry internal dcl 787 ref 245 mrds_dsm_scanner 002523 constant entry external dcl 9 mrds_dsm_scanner$init 002635 constant entry external dcl 239 report_mds_error 005452 constant entry internal dcl 858 ref 332 465 573 618 715 special_handler 004370 constant entry internal dcl 583 ref 301 stack_put 003425 constant entry internal dcl 364 ref 288 302 344 state 000000 constant label array(0:7) dcl 253 set ref 235 280 292 307 315 323 338 348 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6514 6544 6334 6524 Length 7050 6334 30 270 157 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME mrds_dsm_scanner 659 external procedure is an external procedure. stack_put internal procedure shares stack frame of external procedure mrds_dsm_scanner. alphanum_handler internal procedure shares stack frame of external procedure mrds_dsm_scanner. get_char_type internal procedure shares stack frame of external procedure mrds_dsm_scanner. comment_skip internal procedure shares stack frame of external procedure mrds_dsm_scanner. special_handler internal procedure shares stack frame of external procedure mrds_dsm_scanner. get_next_character_routine internal procedure shares stack frame of external procedure mrds_dsm_scanner. initialize_encoding_information internal procedure shares stack frame of external procedure mrds_dsm_scanner. report_mds_error 94 internal procedure is called during a stack extension. add_cardinal_suffix 78 internal procedure is declared options(non_quick). STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME add_cardinal_suffix 000100 num_pic add_cardinal_suffix 000103 rev add_cardinal_suffix 000104 idx add_cardinal_suffix mrds_dsm_scanner 000100 current_terminal mrds_dsm_scanner 000201 current_terminal_and_token_match mrds_dsm_scanner 000202 debug_sw mrds_dsm_scanner 000203 encoding mrds_dsm_scanner 000204 message mrds_dsm_scanner 000305 message_length mrds_dsm_scanner 000306 symbol_found mrds_dsm_scanner 000310 alphanum_token_list_ptr mrds_dsm_scanner 000312 special_token_list_ptr mrds_dsm_scanner 000314 alphanum_token_list_index mrds_dsm_scanner 000315 special_token_list_index mrds_dsm_scanner 000316 alphanum_token_list_size mrds_dsm_scanner 000317 special_token_list_size mrds_dsm_scanner 000320 line_no_pic mrds_dsm_scanner 000322 work_area_ptr mrds_dsm_scanner 000324 overlength_token_already_seen mrds_dsm_scanner 000326 SPECIAL_CHARS mrds_dsm_scanner 000330 lex_stack_ptr mrds_dsm_scanner 000332 mrds_dsm_scanner_info_ptr mrds_dsm_scanner 000352 current_terminal_and_token_match alphanum_handler 000370 old_pos comment_skip 000371 old_char comment_skip 000372 old_char_ptr comment_skip 000374 old_type comment_skip 000375 new_line_index comment_skip 000376 result comment_skip 000377 end_comment_index comment_skip 000416 code get_next_character_routine 000417 output_text get_next_character_routine 000520 nonwhite_char_index get_next_character_routine 000530 token_list_index initialize_encoding_information 000531 non_alphanum_char_index initialize_encoding_information 000532 special_token_sort_index initialize_encoding_information 000533 alphanum_token_sort_index initialize_encoding_information THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_this return shorten_stack ext_entry int_entry int_entry_desc reverse_cs set_cs_eis alloc_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_ ioa_$ioa_switch ioa_$rs iox_$put_chars requote_string_ sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$unimplemented_version sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 183 002512 9 002516 217 002534 218 002540 229 002610 230 002614 231 002620 232 002622 233 002624 234 002626 235 002627 239 002631 242 002646 243 002647 244 002653 245 002655 246 002656 250 002671 253 002672 260 002674 261 002675 268 002676 270 002700 280 003001 283 003005 288 003006 291 003022 292 003024 294 003026 301 003033 302 003034 305 003050 307 003052 310 003054 314 003067 315 003070 318 003072 322 003105 323 003106 326 003110 332 003213 334 003245 337 003261 338 003262 341 003264 343 003266 344 003272 347 003305 348 003307 351 003311 354 003312 362 003423 364 003425 382 003427 386 003432 390 003436 391 003443 392 003447 393 003451 394 003453 395 003455 396 003457 398 003461 400 003462 405 003463 406 003467 410 003504 411 003505 413 003514 414 003520 415 003522 416 003524 418 003525 419 003533 420 003537 423 003543 426 003551 431 003561 432 003562 434 003563 440 003604 445 003610 451 003621 453 003631 455 003633 456 003635 459 003641 460 003642 461 003646 465 003710 468 003742 470 003744 478 003745 480 003746 485 003750 487 003760 489 003774 491 004010 493 004024 495 004026 497 004027 513 004031 514 004034 515 004036 516 004040 517 004043 520 004055 521 004065 522 004070 523 004072 524 004074 525 004076 526 004077 531 004100 537 004125 540 004143 547 004164 549 004173 550 004175 553 004207 559 004234 561 004235 562 004241 563 004244 566 004256 567 004257 568 004261 570 004262 573 004331 576 004363 579 004364 583 004370 586 004371 587 004372 589 004376 592 004407 598 004423 601 004426 605 004443 606 004453 608 004455 609 004457 610 004462 612 004472 614 004473 618 004530 621 004562 623 004565 627 004600 629 004601 664 004602 667 004605 668 004607 673 004610 675 004613 676 004620 679 004622 682 004627 687 004643 692 004653 694 004657 696 004660 700 004664 701 004674 707 004725 710 004752 711 004754 715 005025 718 005057 720 005060 723 005071 726 005075 727 005105 730 005106 731 005111 733 005113 736 005114 739 005116 746 005136 747 005137 749 005146 752 005154 755 005160 756 005170 758 005171 759 005175 760 005200 762 005202 763 005203 766 005210 769 005215 771 005217 774 005226 777 005232 778 005242 780 005243 781 005246 783 005250 787 005251 806 005252 807 005254 808 005255 809 005265 810 005275 811 005277 813 005301 814 005302 816 005303 817 005311 821 005324 824 005335 825 005336 826 005337 831 005357 833 005362 834 005365 836 005371 837 005372 840 005403 841 005404 846 005425 848 005430 849 005433 852 005437 853 005444 854 005446 856 005450 858 005451 868 005465 871 005475 876 005535 882 005606 884 005607 899 005615 900 005626 901 005637 903 005650 905 005661 ----------------------------------------------------------- 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