COMPILATION LISTING OF SEGMENT mrds_rst_semantics Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 10/16/86 1337.3 mst Thu Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 7 8 /****^ HISTORY COMMENTS: 9* 1) change(86-04-03,Spitzer), approve(86-04-03,MCR7311), 10* audit(86-09-02,Blair), install(86-10-16,MR12.0-1187): 11* remove unused dcls. remove PL/1 IO statement. 12* END HISTORY COMMENTS */ 13 14 15 /* -alm 16* -ssl 17* -ct 18* -term 19* -sem mrds_rst_semantics 20* -mla 10 21* -table mrds_rst_parse_table 22* -recover 23* -mark 24* -order 25* 26* 27* 28* 29* 30* 31* 32* 33* 34* 35* 36* 37* 38* 39* 40* 41* 42* 43* 44* 45* 46* 47* 48* 49* 50* 51* 52* 53* 54* 55* 56* 57* 58* 59* -parse */ 60 61 62 63 /* IMPORTANT!!! - - - HOW TO UPDATE THIS SOURCE ************************************************************** 64* 65* This semantic routine interface, the parser, and the scanner 66* were all developed with the aide of the automated "lrk" parser 67* generator tool. (see >udd>LIS>Wardd>MTB_lrk.runout for complete 68* details) The following steps (say in an exec_com) must be done 69* when the total parser or any part is to be modified, in order to 70* insure proper operation. 71* 72* 1) make changes to the grammar and/or pl1 code representing 73* semantics in the "lrk source" mrds_rst_parse.lrk via a text 74* editor. This source looks like this listing, except that the 75* BNF rules, and lrk options are not enclosed as comments, and it 76* is not indented. DO NOT MODIFY mrds_rst_semantics.pl1 as those 77* changes would be lost when lrk is invoked, and would not be 78* reflected in any tables generated. 79* 80* 2) invoke the lrk program to generate 81* 82* a) the semantic routine source as pl1 code in 83* mrds_rst_semantics.pl1 84* from the bnf, control arguments, and pl1 code in the lrk source in 85* mrds_rst_parse.lrk 86* 87* b) parsing tables for the table driven parsing algorithm(an lrk bottom up parser) 88* (the source is in mrds_rst_parse.pl1) 89* from an "lrk source" of backus-naur form grammer (this is in 90* mrds_rst_parse.lrk) via the command line: 91* 92* >udd>LIS>Wardd>lrk mrds_rst_parse 93* 94* the control arguments in the source direct lrk output as follows: 95* "-table mrds_rst_parse_table" will build and initialize the basic lrk 96* parsing table for the parsing algorithm 97* "-sem mrds_rst_semantics" directs semantic output to the appropriate pl1 segment 98* the "-order", and "-recover" control arguments affect error handling during parsing 99* 100* 3) generate the keyword sorted list for the scanner using the 101* kwsl tool. this builds an include file that is a pl1 102* declaration for keyword encodings. the source of keyword 103* synonyms is in mrds_rst_keywords.syn and is in the development 104* library source directory the tool is invoked via the command 105* line: 106* >udd>LIS>Wardd>kwsl mrds_rst_parse mrds_rst_keywords mrds_rst_keywords 107* where arguments 1 to 3 are the lrk source, kwsl 108* source, and include file name 109* 110* 4) generate the error recovery skip table from the lrk tables 111* by the following command line : 112* udd>LIS>Wardd>msd mrds_rst_parse mrds_rst_skip_table 113* where the first argument is the lrk source, the 114* other the include file name 115* 116* 5) generate the error message terminal symbols file via the 117* command line: 118* ted -abort >udd>LIS>Wardd>lrk|hal_dcl mrds_rst_parse mrds_rst_terminals 119* where the first argument is the lrk source, the 120* last the include file name 121* 122* 6) build the ascii to decimal transliteration include file, 123* input is is mrds_rst_translate.mad which may be found in the 124* development library source directory. 125* 126* 7) add include file comment heading/trailing banners via 127* command lines: 128* ted -abort >udd>LIS>Wardd>Wardd|incl_cmt mrds_rst_parse_table 129* ted -abort >udd>LIS>Wardd>Wardd|incl_cmt mrds_rst_skip_table 130* 131* 8) indent and compile the three affected parts of the parser 132* on: 133* mrds_rst_semantics.pl1 134* mrds_rst_parse.pl1 135* mrds_rst_scanner.pl1 136* 137* the modification to the parser is now complete. THE 138* FOLLOWING EXEC COM DOES THE ABOVE TASKS: 139* 140* & indent the lrk source 141* & 142* ted -abort >udd>LIS>Wardd>lrk|ind mrds_rst_parse.lrk 143* & 144* & generate the lrk tables from mrds_rst_parse.lrk source bnf 145* & with control arguments inside that source output is the 146* & mrds_rst_parse object table for the parser the source 147* & mrds_rst_semantics.pl1, and the intermediate lrk results 148* & mrds_rst_parse.result and several mrds_rst_parse.lrk.* segs 149* & with a listing of mrds_rst_parseg.list 150* & 151* >udd>LIS>Wardd>lrk mrds_rst_parse 152* & 153* & generate the keyword sorted list include file from the 154* & mrds_rst_keywords.syn source and the lrk output 155* & mrds_rst_parse.result the output produced is 156* & mrds_rst_keywords.incl.pl1 157* & 158* >udd>LIS>Wardd>kwsl mrds_rst_parse mrds_rst_keywords mrds_rst_keywords 159* & 160* & generate the error skip table include the source is 161* & mrds_rst_parse.result, output is mrds_rst_skip_table.incl.pl1 162* & 163* >udd>LIS>Wardd>msd mrds_rst_parse mrds_rst_skip_table 164* & 165* & generate the terminal symbols include file the source is 166* & mrds_rst_parse.result, output is mrds_rst_terminals.incl.pl1 167* & 168* ted -abort >udd>LIS>Wardd>lrk|hal_dcl mrds_rst_parse mrds_rst_terminals 169* & 170* & build the ascii to decimal transliteration include file input 171* & is mrds_rst_translate.mad, output is 172* & mrds_rst_translate.incl.pl1 173* & 174* ted -abort >udd>LIS>Wardd>Wardd|mad mrds_rst_translate.mad 175* & 176* & put include file headers/trailer comments in this adds the 177* & BEGIN INCLUDE FILE.... and END INCLUDE FILE comments 178* & 179* ted -abort >udd>LIS>Wardd>Wardd|incl_cmt mrds_rst_parse_table 180* ted -abort >udd>LIS>Wardd>Wardd|incl_cmt mrds_rst_skip_table 181* & 182* & compile parser, scanner, and semantics PL1 routines 183* & 184* pl1 mrds_rst_semantics 185* pl1 mrds_rst_parse 186* pl1 mrds_rst_scanner 187* & 188* & get rid of lrk generated segments no longer needed they were 189* & used as intermediate results by lrk and it's tools 190* & 191* dl mrds_rst_parse.lrk.TL 192* dl mrds_rst_parse.lrk.THL 193* dl mrds_rst_parse.lrk.TC 194* dl mrds_rst_parse.lrk.DPDA 195* dl mrds_rst_parse.result 196* 197* ***************************************************************************** */ 198 199 /* ****************************************************** 200* * * 201* * * 202* * Copyright (c) 1972 by Massachusetts Institute of * 203* * Technology and Honeywell Information Systems, Inc. * 204* * * 205* * * 206* ****************************************************** */ 207 208 /* HISTORY: 209* 210* originally written by jim gray - - july 1978 211* 212* Modified by Jim Gray - - Jan. 1980, to add packed decimal 213* capability. 214* 215* 80-12-12 Jim Gray : added -mark control to LRK input 216* file in order to be able to un-reserve keywords for CMDB. Also 217* changed and rules to avoid 218* case so that could run with 6.2 LRK (previously used 5.5). This 219* means that a domain keyword must always be present, even if a 220* define does not add new domains. 221* 222* 223* 81-06-04 Jim Gray : removed unused rules and code, this included 224* blocked file and foreign key statements, the -check option, and 225* the restructuring directives. Also re-did scanner - parser 226* constants according to the new -order statment. 227* 228* 81-10-15 Davids: added rules to allow declarations of the form: 229* . varying char (64) 230* . nonvarying char (64) 231* . varying bit (64) 232* . nonvarying bit (64) 233* Also modified the example ec and explantion before it and 234* justified all the text. 235**/ 236 237 mrds_rst_semantics: procedure (rule, alternate, stkp, ls_top); goto SKIP_ENTRIES; 238 239 mrds_rst_semantics$rule_set: entry (); rule_sw = ^rule_sw; goto return_label; 240 241 /* DESCRIPTION: 242* semantics routines for mrds restructuring 243* it is called by the lrk parser whenever a rule is found to aply 244* giving the rule number, alternate number, the stack pointer, 245* and the current top of the lexical stack 246* a goto the appropiate semantic action is given based on the rule number, 247* and the semantic action routine implements the "meaning" of the parse 248* tree which the lrk parser has determined that the syntax represents. 249* after the action, it returns to the parser. 250* 251* entry mrds_rst_semantics$init should be called first to initialize 252* 253* an alternate entry mrds_rst_semantics$rule_set - allows debug output of rule numbers processed to 254* be switched on or off on succeeding calls, it has no parameters 255**/ 256 257 /* PARAMETERS: 258* rule - - (input) the rule number of the bnf at which the lrk parser 259* has found the syntax to conform to, before the reduction takes place. 260* 261* alternate - - (input) the alternative of this rule which is being used 262* 263* stkp - - (input) the lexical stack pointer 264* 265* ls_top - - (input) current top of the lexical stack 266* 267* rsc_ptr - - (input) for the init entry only, a pointer to the restructure control segment 268**/ 269 270 /* initialization entry */ 271 272 mrds_rst_semantics$init: entry (rsc_ptr); 273 274 static_rsc_ptr = rsc_ptr; 275 rsc.skip_scanner_conversion = OFF; 276 277 call mrds_rst_rsc_alloc (static_rsc_ptr, DIRECTIVE, directive_ptr); 278 rsc_ptr -> rsc.directive_ptr = directive_ptr; 279 directive.type = 0; /* no directive seen yet */ 280 directive.undefine.active = OFF; 281 directive.undefine.seen = OFF; 282 directive.define.active = OFF; 283 directive.define.seen = OFF; 284 directive.redefine.active = OFF; 285 directive.redefine.seen = OFF; 286 287 call mrds_rst_rsc_alloc (static_rsc_ptr, STMT, stmt_ptr); 288 rsc_ptr -> rsc.stmt_ptr = stmt_ptr; 289 do i = 1 by 1 to hbound (stmt_ptr -> stmt, 1); 290 stmt (i).domain.active = OFF; 291 stmt (i).domain.number = 0; 292 stmt (i).attribute.active = OFF; 293 stmt (i).attribute.number = 0; 294 stmt (i).relation.active = OFF; 295 stmt (i).relation.number = 0; 296 stmt (i).file.active = OFF; 297 stmt (i).file.number = 0; 298 stmt (i).foreign_key.active = OFF; 299 stmt (i).foreign_key.number = 0; 300 stmt (i).index.active = OFF; 301 stmt (i).index.number = 0; 302 end; 303 304 max_string_size = mrds_data_$max_string_size; 305 max_fixed_bin_17 = fixed (binary (copy ("1", 17) || "b")); 306 max_fixed_bin_71 = fixed (binary (copy ("1", 71) || "b")); 307 308 db_model_path = rtrim (rsc_ptr -> rsc.temp_dir) || ">db_model"; /* path name for the db_model must be saved */ 309 310 call mrds_rst_rsc_alloc (static_rsc_ptr, TOKEN, name_ptr); /* space for token from stack */ 311 call mrds_rst_rsc_alloc (static_rsc_ptr, TOKEN, temp_source_ptr); /* space for string to be multiplied */ 312 313 goto return_label; 314 315 /* ******************************************************************* 316* 317* normal entry for semantics case structure 318* 319* ****************************************************************** */ 320 321 322 323 SKIP_ENTRIES: ; 324 325 326 327 /* set local versions of parameters */ 328 329 lex_stack_ptr = stkp; 330 stack_top = ls_top; 331 332 /* output the rule about to be executed, if debug switch is on */ 333 334 if ^rule_sw then ; 335 else call ioa_ ("rule ^d", rule); 336 337 /* go do the case that this semantic rule number specifies */ 338 339 goto rule_label (rule); 340 341 /* ************************************************************************** 342* 343* definitions for statements within the directives 344* 345* ************************************************************************** */ 346 347 348 349 /* ::= ! */ 350 351 rule_label (0001): 352 353 /* define and redefine directives are made up of any combination of the six statement keywords 354* followed by the specifications for the items to be newly created 355* or to be given a new definition */ 356 357 goto return_label; 358 359 /* ::= ! */ 360 361 rule_label (0002): 362 363 /* null statement */ 364 365 goto return_label; 366 367 368 /* ::= ! */ 369 370 rule_label (0003): 371 372 /* start of domain delete/define/redefine, set it active */ 373 374 if directive.type = 0 then do; /* no other directive seen */ 375 376 /* cmdb source, set up cmdb seen and active, check that this is a genuine cmdb command */ 377 378 directive.type = CMDB; 379 directive.cmdb.seen = ON; 380 directive.cmdb.active = ON; 381 end; 382 stmt (directive.type).domain.active = ON; 383 goto return_label; 384 385 /* ::= ! */ 386 387 rule_label (0004): 388 389 /* start of attribute delete/define/redefine, set it active */ 390 391 stmt (directive.type).attribute.active = ON; 392 goto return_label; 393 394 /* ::= ! */ 395 396 rule_label (0005): 397 398 /* start of relation delete/define/redefine, set it active */ 399 400 stmt (directive.type).relation.active = ON; 401 goto return_label; 402 403 404 405 /* ::= ! */ 406 407 rule_label (0006): 408 409 /* start of index delete/define/redefine, set it active */ 410 411 stmt (directive.type).index.active = ON; 412 goto return_label; 413 414 /* ************************************************************ 415* 416* all the following rules apply to define and redefine statement lists only 417* 418* ***************************************************************** */ 419 420 421 /* ::= | ! */ 422 423 rule_label (0007): 424 425 /* domain processing complete, set it inactive, after defining default attributes for new domains */ 426 427 call mrds_rst_attribute_cleanup (static_rsc_ptr); 428 stmt (directive.type).domain.active = OFF; 429 goto return_label; 430 431 432 /* ::= ! */ 433 434 rule_label (0008): 435 goto return_label; 436 437 438 /* ::= ! */ 439 440 rule_label (0009): 441 goto return_label; 442 443 444 /* ::= ! */ 445 446 rule_label (0010): 447 448 /* call the semantic handler for domains */ 449 450 call mrds_rst_domain_handler (static_rsc_ptr, domain_list_ptr); 451 stmt (directive.type).domain.number = stmt (directive.type).domain.number + 1; 452 goto return_label; 453 454 455 456 457 /* ::= ! */ 458 459 rule_label (0011): 460 461 /* set up domain structure and get the domain name */ 462 463 call mrds_rst_rsc_alloc (static_rsc_ptr, DOMAIN, domain_list_ptr); 464 call domain_initialize (); 465 call set_declaration_defaults (domain_list_ptr -> domain.descriptor); 466 goto return_label; 467 468 469 /* ::= ! */ 470 471 rule_label (0012): 472 473 /* build descriptor for number, set packing, precision, scale, and type */ 474 475 if aligned then 476 descr_ptr -> descriptor.packed = OFF; 477 else descr_ptr -> descriptor.packed = ON; 478 479 call set_precision_and_scale (); 480 call set_number_type (); 481 goto return_label; 482 483 484 /* ::= ! */ 485 486 rule_label (0013): 487 488 /* build descriptor for character string, set type, packed, and size */ 489 490 call set_string_size_and_packing (); 491 if nonvarying then 492 descr_ptr -> descriptor.type = 21; 493 else descr_ptr -> descriptor.type = 22; 494 goto return_label; 495 496 497 /* ::= ! */ 498 499 rule_label (0014): 500 501 /* build descriptor for bit string, set type, packed, and size */ 502 503 call set_string_size_and_packing (); 504 if nonvarying then 505 descr_ptr -> descriptor.type = 19; 506 else descr_ptr -> descriptor.type = 20; 507 goto return_label; 508 509 domain_initialize: procedure (); 510 511 /* initialize the domain structure */ 512 513 domain_list_ptr -> domain.name = get_name (stack_top, 32); 514 domain_list_ptr -> domain.descriptor = OFF; 515 domain_list_ptr -> domain.varying_avg_length = 0; 516 domain_list_ptr -> domain.options = OFF; 517 domain_list_ptr -> domain.pad = OFF; 518 domain_list_ptr -> domain.check.flag = OFF; 519 domain_list_ptr -> domain.check.pad = OFF; 520 domain_list_ptr -> domain.check.stack_ptr = null (); 521 domain_list_ptr -> domain.check.stack_size = 0; 522 domain_list_ptr -> domain.check_proc.flag = OFF; 523 domain_list_ptr -> domain.check_proc.pad = OFF; 524 domain_list_ptr -> domain.check_proc.path = BLANK; 525 domain_list_ptr -> domain.check_proc.entry = BLANK; 526 domain_list_ptr -> domain.encode_proc.flag = OFF; 527 domain_list_ptr -> domain.encode_proc.pad = OFF; 528 domain_list_ptr -> domain.encode_proc.path = BLANK; 529 domain_list_ptr -> domain.encode_proc.entry = BLANK; 530 domain_list_ptr -> domain.decode_proc.flag = OFF; 531 domain_list_ptr -> domain.decode_proc.pad = OFF; 532 domain_list_ptr -> domain.decode_proc.path = BLANK; 533 domain_list_ptr -> domain.decode_proc.entry = BLANK; 534 domain_list_ptr -> domain.decode_dcl.flag = OFF; 535 domain_list_ptr -> domain.decode_dcl.pad = OFF; 536 domain_list_ptr -> domain.decode_dcl.descriptor = OFF; 537 domain_list_ptr -> domain.line_num = get_line_number (stack_top); 538 539 540 /* set up duplicate check_list option flags */ 541 542 decode_dcl_seen = OFF; 543 decode_proc_seen = OFF; 544 encode_proc_seen = OFF; 545 check_seen = OFF; 546 multiplier = 1; 547 string_average_length = 0; 548 avg_length_seen = OFF; 549 decode_dcl_mesg = ""; 550 551 552 end; 553 554 set_declaration_defaults: procedure (current_descriptor); 555 556 557 /* set up defaults */ 558 559 decimal = OFF; 560 float = OFF; 561 real = ON; 562 aligned = ON; 563 nonvarying = ON; 564 string_length = 1; 565 scale_factor = 0; 566 567 /* set up overlays and descriptor constants */ 568 569 descr_ptr = addr (current_descriptor); 570 571 descr_ptr -> descriptor.version = ON; 572 descr_ptr -> descriptor.number_dims = OFF; /* dimension = 0 */ 573 num_dims = 0; 574 575 /* set up duplication and declaration flags */ 576 577 size_seen = OFF; 578 type_seen = OFF; 579 representation_seen = OFF; 580 base_seen = OFF; 581 precision_seen = OFF; 582 alignment_seen = OFF; 583 fixed_varying_seen = OFF; 584 scale_seen = OFF; 585 586 587 declare current_descriptor bit (36) aligned; /* current descriptor to point to for this declaration */ 588 589 end; 590 591 set_number_type: procedure (); 592 593 /* set data type for number based on float/short/decimal/real attributes */ 594 /* packed decimal data types 43-46, depend on the aligned attribute as well */ 595 596 597 if ^decimal then 598 if real then 599 if ^float then 600 if short then 601 descr_ptr -> descriptor.type = 1; 602 else descr_ptr -> descriptor.type = 2; 603 else if short then 604 descr_ptr -> descriptor.type = 3; 605 else descr_ptr -> descriptor.type = 4; 606 else if ^float then 607 if short then 608 descr_ptr -> descriptor.type = 5; 609 else descr_ptr -> descriptor.type = 6; 610 else if short then 611 descr_ptr -> descriptor.type = 7; 612 else descr_ptr -> descriptor.type = 8; 613 else if real then 614 if ^float then do; 615 if aligned then 616 descr_ptr -> descriptor.type = 9; 617 else descr_ptr -> descriptor.type = 43; 618 end; 619 else do; 620 if aligned then 621 descr_ptr -> descriptor.type = 10; 622 else descr_ptr -> descriptor.type = 44; 623 end; 624 else if ^float then do; 625 if aligned then 626 descr_ptr -> descriptor.type = 11; 627 else descr_ptr -> descriptor.type = 45; 628 end; 629 else do; 630 if aligned then 631 descr_ptr -> descriptor.type = 12; 632 else descr_ptr -> descriptor.type = 46; 633 end; 634 635 end; 636 637 /* ************************************************************* 638* 639* number precision and scale attribute processing 640* 641* ************************************************************ */ 642 643 644 set_precision_and_scale: procedure (); 645 646 /* set default precision or check user values against limits */ 647 648 if ^precision_seen then 649 650 /* no precision given, set defaults */ 651 652 if ^float then 653 if ^decimal then 654 saved_precision = 17; 655 else saved_precision = 7; 656 else if ^decimal then 657 saved_precision = 27; 658 else saved_precision = 10; 659 660 /* check user's precision */ 661 662 else if ^decimal then 663 if ^float then 664 if saved_precision >= 1 & saved_precision <= 71 then ; 665 else do; 666 call ioa_$rs ("^a ^a^a^a^a ^d ^a", message, message_length, 667 "The", decode_dcl_mesg, "declaration of domain """, domain_list_ptr -> domain.name, 668 """ on line", domain_list_ptr -> domain.line_num, 669 "has precision <1 or >71 for fixed binary number, using ""71"" instead."); 670 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, 671 mrds_error_$rst_bad_declaration, (message)); 672 saved_precision = 71; 673 end; 674 else if saved_precision >= 1 & saved_precision <= 63 then ; 675 else do; 676 call ioa_$rs ("^a ^a^a^a^a ^d ^a", message, message_length, 677 "The", decode_dcl_mesg, "declaration of domain """, domain_list_ptr -> domain.name, 678 """ on line", domain_list_ptr -> domain.line_num, 679 "has precision <1 or >63 for float binary number, using ""63"" instead."); 680 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_bad_declaration, (message)); 681 saved_precision = 63; 682 end; 683 else if saved_precision >= 1 & saved_precision <= 59 then ; 684 else do; 685 call ioa_$rs ("^a ^a^a^a^a ^d ^a", message, message_length, 686 "The", decode_dcl_mesg, "declaration of domain """, domain_list_ptr -> domain.name, 687 """ on line", domain_list_ptr -> domain.line_num, 688 "has precision <1 or >59 for a decimal number, using ""59"" instead."); 689 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_bad_declaration, (message)); 690 saved_precision = 59; 691 end; 692 693 descr_ptr -> arith_size.precision = saved_precision; 694 695 696 697 698 699 /* set precision type as short or long */ 700 701 if decimal then ; 702 else if ^float then 703 if saved_precision <= 35 then 704 short = ON; 705 else short = OFF; 706 else if saved_precision <= 27 then 707 short = ON; 708 else short = OFF; 709 710 /* check on the scale factor */ 711 712 if ^(float & scale_seen) then ; 713 else do; 714 call ioa_$rs ("^a ^a^a^a^a ^d ^a", message, message_length, 715 "The", decode_dcl_mesg, "declaration of domain """, domain_list_ptr -> domain.name, 716 """ on line", domain_list_ptr -> domain.line_num, 717 "is declared float, it can not have scale specified, --- the scale is ignored!!"); 718 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_bad_declaration, (message)); 719 scale_factor = 0; 720 end; 721 722 if scale_factor >= -128 & scale_factor <= 127 then ; 723 else do; 724 if scale_factor < 0 then 725 scale_factor = -128; 726 else scale_factor = +127; 727 call ioa_$rs ("^a ^a^a^a^a ^d ^a^d^a", message, message_length, 728 "The", decode_dcl_mesg, "declaration of domain """, domain_list_ptr -> domain.name, 729 """ on line", domain_list_ptr -> domain.line_num, 730 "has a scale factor <-128 or >127, using """, scale_factor, """ instead."); 731 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_bad_declaration, (message)); 732 end; 733 734 descr_ptr -> arith_size.scale = scale_factor; 735 736 end; 737 738 set_string_size_and_packing: procedure (); 739 740 /* check alignment and varying attributes to determine packing, 741* and set size from the string length */ 742 743 if nonvarying then 744 if alignment_seen then ; 745 else aligned = OFF; 746 else if aligned then ; 747 else do; 748 aligned = ON; 749 call ioa_$rs ("^a ^a^a^a^a ^d ^a", message, message_length, 750 "The", decode_dcl_mesg, "declaration of domain """, domain_list_ptr -> domain.name, 751 """ on line", domain_list_ptr -> domain.line_num, 752 "is being corrected, since varying strings must be ""aligned""."); 753 call mrds_rst_error (static_rsc_ptr, 1 /* severity */, mrds_error_$rst_bad_declaration, (message)); 754 end; 755 756 757 if aligned then 758 descr_ptr -> descriptor.packed = OFF; 759 else descr_ptr -> descriptor.packed = ON; 760 761 descr_ptr -> string_size.length = string_length; 762 763 /* for normal declarations(not decode_dcl), and varying strings, remember the average length */ 764 765 if decode_dcl_mesg ^= "" then ; 766 else if ^nonvarying then 767 domain_list_ptr -> domain.varying_avg_length = string_average_length; 768 else if ^avg_length_seen then ; 769 else do; 770 call ioa_$rs ("^a^a ^a^a^a^a ^d^a", message, message_length, 771 "The average length attribute is not allowed with nonvarying strings", 772 ", it is being ignored in the", decode_dcl_mesg, "declaration for domain """, 773 domain_list_ptr -> domain.name, 774 """ on line", domain_list_ptr -> domain.line_num, "."); 775 call mrds_rst_error (static_rsc_ptr, 1 /* severity */, mrds_error_$rst_inconsis_option, (message)); 776 end; 777 778 end; 779 780 /* ********************************************* 781* 782* attributes in number declarations can be in any order 783* duplicates and contradictory attributes are checked for 784* 785* ***************************************** */ 786 787 /* ::= ! */ 788 789 rule_label (0015): 790 goto return_label; 791 792 793 /* ::= ! */ 794 795 rule_label (0016): 796 goto return_label; 797 798 799 /* ::= ! */ 800 801 rule_label (0017): 802 goto return_label; 803 804 805 /* ::= ! */ 806 807 rule_label (0018): 808 809 /* set real attribute */ 810 811 if duplicate ("real or complex", addr (type_seen)) then ; 812 else real = ON; 813 goto return_label; 814 815 816 /* ::= ! */ 817 818 rule_label (0019): 819 820 /* set complex attribute */ 821 822 if duplicate ("real or complex", addr (type_seen)) then ; 823 else real = OFF; 824 goto return_label; 825 826 827 /* ::= ! */ 828 829 rule_label (0020): 830 831 /* set fixed attribute */ 832 833 if duplicate ("float or fixed", addr (representation_seen)) then ; 834 else float = OFF; 835 goto return_label; 836 837 838 /* ::= ! */ 839 840 rule_label (0021): 841 842 /* set float attribute */ 843 844 if duplicate ("float or fixed", addr (representation_seen)) then ; 845 else float = ON; 846 goto return_label; 847 848 849 /* ::= ! */ 850 851 rule_label (0022): 852 853 /* set binary attribute */ 854 855 if duplicate ("binary or decimal", addr (base_seen)) then ; 856 else decimal = OFF; 857 goto return_label; 858 859 860 /* ::= ! */ 861 862 rule_label (0023): 863 864 /* set decimal attribute */ 865 866 if duplicate ("binary or decimal", addr (base_seen)) then ; 867 else decimal = ON; 868 goto return_label; 869 870 871 /* ::= ! */ 872 873 874 rule_label (0024): 875 goto return_label; 876 877 878 /* ::= ! */ 879 880 rule_label (0025): 881 goto return_label; 882 883 /* ::= ! */ 884 885 rule_label (0026): 886 887 /* set positive sign */ 888 889 sign_flag = OFF; 890 goto return_label; 891 892 893 /* ::= ! */ 894 895 rule_label (0027): 896 897 /* set negative sign */ 898 899 sign_flag = ON; 900 goto return_label; 901 902 903 /* ::= ! */ 904 905 rule_label (0028): 906 907 /* set sign positive */ 908 909 sign_flag = OFF; 910 goto return_label; 911 912 /* ::= ! */ 913 914 rule_label (0029): 915 916 /* set precision attribute with scale factor (negative) */ 917 918 if duplicate ("precision", addr (precision_seen)) then ; 919 else do; 920 saved_precision = get_fixed_value (stack_top - 4, max_fixed_bin_71); 921 if sign_flag then 922 scale_factor = -get_fixed_value (stack_top - 1, max_fixed_bin_71); 923 else scale_factor = get_fixed_value (stack_top - 1, max_fixed_bin_71); 924 scale_seen = ON; 925 end; 926 goto return_label; 927 928 929 /* ::= ! */ 930 931 rule_label (0030): 932 933 /* set precision attribute */ 934 935 if duplicate ("precision", addr (precision_seen)) then ; 936 else saved_precision = get_fixed_value (stack_top - 1, max_fixed_bin_71); 937 goto return_label; 938 939 940 /* ::= ! */ 941 942 rule_label (0031): 943 goto return_label; 944 945 946 /* ::= ! */ 947 948 rule_label (0032): 949 950 /* set aligned attribute */ 951 952 if duplicate ("aligned or unaligned", addr (alignment_seen)) then ; 953 else aligned = ON; 954 goto return_label; 955 956 957 /* ::= ! */ 958 959 rule_label (0033): 960 961 /* set unaligned attribute */ 962 963 if duplicate ("aligned or unaligned", addr (alignment_seen)) then ; 964 else aligned = OFF; 965 goto return_label; 966 967 /* ******************************************************* 968* 969* make sure that attributes are not repeated in a declaraion 970* 971* ************************************************************* */ 972 973 974 duplicate: procedure (attribute, flag_ptr) returns (bit (1)); 975 976 /* check to see if this attribute has already been used in this declaration */ 977 978 if ^flag_ptr -> flag_overlay then do; 979 980 /* attribute not yet seen, flag it as seen, return no duplication */ 981 982 flag_ptr -> flag_overlay = ON; 983 duplication = OFF; 984 end; 985 986 else do; 987 988 /* attribute duplicate, issue error, return duplication */ 989 990 duplication = ON; 991 call ioa_$rs ("^a^a^a ^a^a^a^a ^d^a", message, message_length, 992 "The attribute """, attribute, """ appears more than once in the", 993 decode_dcl_mesg, "declaration of domain """, 994 domain_list_ptr -> domain.name, 995 """ on line", domain_list_ptr -> domain.line_num, 996 ", the first occurence will be used."); 997 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_bad_declaration, (message)); 998 end; 999 1000 return (duplication); 1001 1002 declare duplication bit (1); /* ON => this is a previously seen attribute */ 1003 declare flag_ptr ptr; /* pointer to attribute flag */ 1004 declare flag_overlay bit (1) based; /* overlay structure for flag */ 1005 declare attribute char (*); /* attribute name being checked */ 1006 1007 end; 1008 1009 /* *********************************************************************** 1010* 1011* bit and character string declarations can have the attributes in any order 1012* but duplicates will be flagged as errors and ignored 1013* as with number precision and scale, string size is checked for a legal range 1014* 1015* **************************************************************************** */ 1016 1017 1018 /* ::= ! */ 1019 1020 rule_label (0034): 1021 goto return_label; 1022 1023 /* ::= ! */ 1024 1025 rule_label (0035): 1026 if duplicate ("varying or nonvarying", addr (fixed_varying_seen)) then ; 1027 else nonvarying = OFF; 1028 goto return_label; 1029 1030 /* ::= ! */ 1031 1032 rule_label (0036): 1033 if duplicate ("varying or nonvarying", addr (fixed_varying_seen)) then ; 1034 else nonvarying = ON; 1035 goto return_label; 1036 1037 /* ::= ! */ 1038 1039 rule_label (0037): 1040 goto return_label; 1041 1042 1043 /* ::= ! */ 1044 1045 rule_label (0038): 1046 goto return_label; 1047 1048 1049 /* ::= ! */ 1050 1051 rule_label (0039): 1052 goto return_label; 1053 1054 1055 /* ::= ! */ 1056 1057 rule_label (0040): 1058 goto return_label; 1059 1060 1061 /* ::= ! */ 1062 1063 rule_label (0041): 1064 1065 /* set string length attribute(and default average length for normal declarations) */ 1066 1067 if duplicate ("string size", addr (size_seen)) then ; 1068 else do; 1069 temp_number = get_fixed_value (stack_top - 1, max_fixed_bin_71); 1070 call string_size_check (temp_number); 1071 string_length = temp_number; 1072 avg_length_seen = OFF; 1073 if decode_dcl_mesg ^= "" then ; 1074 else string_average_length = string_length; 1075 end; 1076 goto return_label; 1077 1078 1079 /* ::= ! */ 1080 1081 rule_label (0042): 1082 goto return_label; 1083 1084 1085 /* ::= ! */ 1086 1087 rule_label (0043): 1088 1089 /* set varying attribute */ 1090 1091 if duplicate ("varying or nonvarying", addr (fixed_varying_seen)) then ; 1092 else nonvarying = OFF; 1093 goto return_label; 1094 1095 1096 /* ::= ! */ 1097 1098 rule_label (0044): 1099 1100 /* set nonvarying attribute */ 1101 1102 if duplicate ("varying or nonvarying", addr (fixed_varying_seen)) then ; 1103 else nonvarying = ON; 1104 goto return_label; 1105 1106 /* ::= ! */ 1107 1108 rule_label (0045): 1109 goto return_label; 1110 1111 /* ::= ! */ 1112 1113 rule_label (0046): 1114 if duplicate ("varying or nonvarying", addr (fixed_varying_seen)) then ; 1115 else nonvarying = OFF; 1116 goto return_label; 1117 1118 /* ::= ! */ 1119 1120 rule_label (0047): 1121 if duplicate ("varying or nonvarying", addr (fixed_varying_seen)) then ; 1122 else nonvarying = ON; 1123 goto return_label; 1124 1125 string_size_check: procedure (number); 1126 1127 /* make sure number for string length is less than maximum allowable */ 1128 1129 if number <= max_string_size then ; 1130 else do; 1131 1132 call ioa_$rs ("^a^d^a ^d^a ^a^a^a^a ^d^a", message, message_length, 1133 "String size """, number, """ exceeds the maximum allowable length of", 1134 max_string_size, ", using the maximum instead in the", 1135 decode_dcl_mesg, "declaration of domain """, 1136 domain_list_ptr -> domain.name, 1137 """ on line", domain_list_ptr -> domain.line_num, "."); 1138 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_bad_declaration, (message)); 1139 number = max_string_size; 1140 end; 1141 1142 1143 1144 /* fixup unwanted zero values */ 1145 1146 if number ^= 0 then ; 1147 else do; 1148 number = 1; 1149 call ioa_$rs ("^a ^a^a^a^a ^d^a", message, message_length, 1150 "Illegal zero value is being replaced by ""1"" in size attribute of", 1151 decode_dcl_mesg, "declaration for domain """, 1152 domain_list_ptr -> domain.name, 1153 """ on line", domain_list_ptr -> domain.line_num, "."); 1154 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_bad_declaration, (message)); 1155 end; 1156 1157 declare number fixed binary (71); /* number under test as string length */ 1158 1159 end; 1160 1161 /* ***************************************************************** 1162* 1163* the check, check_proc, encode_proc, decode_proc options may be in any order 1164* however, check and check_proc are mutually exclusive options 1165* 1166* ***************************************************************** */ 1167 1168 /* ::= ! */ 1169 1170 rule_label (0048): 1171 1172 /* set options present */ 1173 1174 domain_list_ptr -> domain.options = ON; 1175 goto return_label; 1176 1177 /* ::= ! */ 1178 1179 rule_label (0049): 1180 1181 /* set no options present */ 1182 1183 domain_list_ptr -> domain.options = OFF; 1184 goto return_label; 1185 1186 /* ::= ! */ 1187 1188 rule_label (0050): 1189 goto return_label; 1190 1191 /* ::= ! */ 1192 1193 rule_label (0051): 1194 goto return_label; 1195 1196 /* ::= ! */ 1197 1198 rule_label (0052): 1199 goto return_label; 1200 1201 /* ::= ! */ 1202 1203 rule_label (0053): 1204 goto return_label; 1205 1206 /* ::= ! */ 1207 1208 rule_label (0054): 1209 goto return_label; 1210 1211 /* ::= ! */ 1212 1213 rule_label (0055): 1214 goto return_label; 1215 1216 /* ***************************** 1217* 1218* decode declaration option 1219* 1220* ****************************** */ 1221 1222 1223 /* ::= ! */ 1224 1225 rule_label (0056): 1226 1227 /* decode declaration finished, restore normal declaration pointers */ 1228 1229 descr_ptr = saved_descr_ptr; 1230 decode_dcl_mesg = ""; 1231 1232 /* if a duplicate caused the descriptor to be saved, restore it */ 1233 1234 if ^descriptor_saved then ; 1235 else domain_list_ptr -> domain.decode_dcl.descriptor = saved_decode_descriptor; 1236 goto return_label; 1237 1238 /* ::= ! */ 1239 1240 rule_label (0057): 1241 1242 /* set up for handling a decode declaration, save normal declaration pointers */ 1243 1244 saved_descr_ptr = descr_ptr; 1245 call set_declaration_defaults (domain_list_ptr -> domain.decode_dcl.descriptor); 1246 1247 /* only set this option on if this is not a duplicate 1248* else remember the first declaration seen(via the descriptor) */ 1249 1250 if duplicate ("decode_dcl", addr (decode_dcl_seen)) then do; 1251 descriptor_saved = ON; 1252 saved_decode_descriptor = domain_list_ptr -> domain.decode_dcl.descriptor; 1253 end; 1254 else do; 1255 domain_list_ptr -> domain.decode_dcl.flag = ON; 1256 descriptor_saved = OFF; 1257 end; 1258 1259 /* set up error messages for decode declarations */ 1260 1261 decode_dcl_mesg = "decode_"; 1262 goto return_label; 1263 1264 /* ************************************************ 1265* 1266* gather pathnames and entry names for procedure options 1267* 1268* ************************************************** */ 1269 1270 1271 /* ::= ! */ 1272 1273 rule_label (0058): 1274 1275 /* set up check procedure path and entry names */ 1276 1277 temp_index = stack_top - 1; 1278 call get_check_path_entry (); 1279 goto return_label; 1280 1281 1282 /* ::= ! */ 1283 1284 rule_label (0059): 1285 1286 /* set up check procedure pathname and missing entry name */ 1287 1288 temp_index = stack_top; 1289 call get_check_path_entry (); 1290 goto return_label; 1291 1292 1293 /* ::= ! */ 1294 1295 rule_label (0060): 1296 1297 /* set up encode procedure path and entry names */ 1298 1299 temp_index = stack_top - 1; 1300 call get_encode_path_entry (); 1301 goto return_label; 1302 1303 1304 /* ::= ! */ 1305 1306 rule_label (0061): 1307 1308 /* set up encode pathname and missing entryname */ 1309 1310 temp_index = stack_top; 1311 call get_encode_path_entry (); 1312 goto return_label; 1313 1314 1315 /* ::= ! */ 1316 1317 rule_label (0062): 1318 1319 /* set up decode procedure path and entry names */ 1320 1321 temp_index = stack_top - 1; 1322 call get_decode_path_entry (); 1323 goto return_label; 1324 1325 1326 1327 /* ::= ! */ 1328 1329 rule_label (0063): 1330 1331 /* set up decode procedure pathname and missing entryname */ 1332 1333 temp_index = stack_top; 1334 call get_decode_path_entry (); 1335 goto return_label; 1336 1337 get_check_path_entry: procedure (); 1338 1339 /* get pathname from the stack and entry name if there, 1340* else get entry name from path name. Set this option on */ 1341 1342 if duplicate ("check_proc", addr (check_seen)) then ; 1343 else do; 1344 domain_list_ptr -> domain.check_proc.flag = ON; 1345 domain_list_ptr -> domain.check_proc.path = get_name (temp_index, 168); 1346 if temp_index = stack_top then 1347 domain_list_ptr -> domain.check_proc.entry = get_entry (domain_list_ptr -> domain.check_proc.path); 1348 else domain_list_ptr -> domain.check_proc.entry = get_name (stack_top, 32); 1349 end; 1350 1351 end; 1352 1353 get_encode_path_entry: procedure (); 1354 1355 /* get pathname from the stack and entry name if there, 1356* else get entry name from path name. Set this option on */ 1357 1358 if duplicate ("encode_proc", addr (encode_proc_seen)) then ; 1359 else do; 1360 domain_list_ptr -> domain.encode_proc.flag = ON; 1361 domain_list_ptr -> domain.encode_proc.path = get_name (temp_index, 168); 1362 if temp_index = stack_top then 1363 domain_list_ptr -> domain.encode_proc.entry = 1364 get_entry (domain_list_ptr -> domain.encode_proc.path); 1365 else domain_list_ptr -> domain.encode_proc.entry = get_name (stack_top, 32); 1366 end; 1367 1368 end; 1369 1370 get_decode_path_entry: procedure (); 1371 1372 /* get pathname from the stack and entry name if there, else 1373* get entry name from path name. Set this option on */ 1374 1375 if duplicate ("decode_proc", addr (decode_proc_seen)) then ; 1376 else do; 1377 domain_list_ptr -> domain.decode_proc.flag = ON; 1378 domain_list_ptr -> domain.decode_proc.path = get_name (temp_index, 168); 1379 if temp_index = stack_top then 1380 domain_list_ptr -> domain.decode_proc.entry = 1381 get_entry (domain_list_ptr -> domain.decode_proc.path); 1382 else domain_list_ptr -> domain.decode_proc.entry = get_name (stack_top, 32); 1383 end; 1384 1385 end; 1386 1387 get_entry: procedure (pathname) returns (char (32)); 1388 1389 /* extract the entry name from the pathname */ 1390 1391 if lex_stack_ptr -> lex_stack (stack_top).token_num ^= 0 & search (reverse (pathname), ">") ^= 0 then 1392 1393 /* absolute pathname, extract the rightmost component */ 1394 1395 entry_portion = substr (pathname, length (pathname) - search (reverse (pathname), ">") + 2); 1396 1397 /* either dummy "" or relative pathname, use path as entry name */ 1398 1399 else entry_portion = pathname; 1400 1401 /* make sure the entry name is not too big */ 1402 1403 entry_portion = rtrim (entry_portion); 1404 if length (entry_portion) <= 32 then ; 1405 else do; 1406 call ioa_$rs ("^a^a^a ^d^a", message, message_length, 1407 "The entry name portion exceeds 32 characters in pathname """, pathname, 1408 """ on line", domain_list_ptr -> domain.line_num, 1409 ", it is being truncated to that length!!"); 1410 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_name_too_long, (message)); 1411 end; 1412 1413 entryname = entry_portion; 1414 return (entryname); 1415 1416 declare pathname char (*) aligned; /* absolute or relative pathname */ 1417 declare entryname char (32); /* final extracted entry name */ 1418 declare entry_portion char (168) varying;/* intermediate entry portion */ 1419 1420 end; 1421 1422 /* ************************************************* 1423* 1424* attribute specification processing 1425* 1426* ********************************************** */ 1427 1428 /* ::= ! */ 1429 1430 rule_label (0064): 1431 1432 /* attribute declaration processing complete, set it inactive */ 1433 1434 stmt (directive.type).attribute.active = OFF; 1435 goto return_label; 1436 1437 /* ::= | ! */ 1438 1439 rule_label (0065): 1440 goto return_label; 1441 1442 /* ::= ! */ 1443 1444 rule_label (0066): 1445 1446 /* count the last attribute specification */ 1447 1448 stmt (directive.type).attribute.number = stmt (directive.type).attribute.number + 1; 1449 goto return_label; 1450 1451 /* ::= ! */ 1452 1453 rule_label (0067): 1454 goto return_label; 1455 1456 /* ::= ! */ 1457 1458 rule_label (0068): 1459 1460 /* get the attribute domain pair, and call the semantic routine for this declaration */ 1461 1462 call mrds_rst_rsc_alloc (static_rsc_ptr, ATTRIBUTE_DOMAIN, attribute_list_ptr); 1463 attribute_list_ptr -> attribute_domain.attr = get_name (stack_top - 1, 32); 1464 attribute_list_ptr -> attribute_domain.dom = get_name (stack_top, 32); 1465 attribute_list_ptr -> attribute_domain.line_num = get_line_number (stack_top - 1); 1466 attribute_list_ptr -> attribute_domain.default = OFF; /* defined in source */ 1467 attribute_list_ptr -> attribute_domain.unused = OFF; 1468 1469 call mrds_rst_attribute_handler (static_rsc_ptr, attribute_list_ptr); 1470 stmt (directive.type).attribute.number = stmt (directive.type).attribute.number + 1; 1471 goto return_label; 1472 1473 /* *************************************************** 1474* 1475* relation specification processing 1476* 1477* *********************************************** */ 1478 1479 1480 /* ::= ! */ 1481 1482 rule_label (0069): 1483 1484 /* relation processing complete, set it inactive */ 1485 1486 call mrds_rst_file_cleanup (static_rsc_ptr); 1487 stmt (directive.type).relation.active = OFF; 1488 goto return_label; 1489 1490 1491 /* ::= | ! */ 1492 1493 rule_label (0070): 1494 1495 /* no relation statement, set it inactive */ 1496 1497 stmt (directive.type).relation.active = OFF; 1498 goto return_label; 1499 1500 1501 /* ::= ! */ 1502 1503 rule_label (0071): 1504 goto return_label; 1505 1506 1507 /* ::= ! */ 1508 1509 rule_label (0072): 1510 goto return_label; 1511 1512 1513 /* ::= ! */ 1514 1515 rule_label (0073): 1516 1517 /* relation list built, call the semantic routine for relation declarations */ 1518 1519 if key_order ^= 0 then ; 1520 else call fixup_key_attribute (); 1521 call mrds_rst_relation_handler (static_rsc_ptr, relation_list_ptr); 1522 stmt (directive.type).relation.number = stmt (directive.type).relation.number + 1; 1523 goto return_label; 1524 1525 1526 /* ::= ! */ 1527 1528 rule_label (0074): 1529 1530 /* start relation list, get name from stack */ 1531 1532 call get_relation_name (); 1533 goto return_label; 1534 1535 1536 /* ::= ! */ 1537 1538 rule_label (0075): 1539 goto return_label; 1540 1541 1542 /* ::= ! */ 1543 1544 rule_label (0076): 1545 goto return_label; 1546 1547 1548 /* ::= ! */ 1549 1550 rule_label (0077): 1551 1552 /* get non key attribute for this relation list */ 1553 1554 temp_index = stack_top; 1555 key_attribute = OFF; 1556 call get_relation_attribute (); 1557 goto return_label; 1558 1559 1560 /* ::= ! */ 1561 1562 rule_label (0078): 1563 1564 /* get key attribute for this relation list */ 1565 1566 temp_index = stack_top - 1; 1567 key_attribute = ON; 1568 call get_relation_attribute (); 1569 goto return_label; 1570 1571 1572 fixup_key_attribute: procedure (); 1573 1574 /* assume the first attrubte defined is the key when none given */ 1575 1576 attribute_ptr = relation_list_ptr -> relation.a_ptr; 1577 attribute_ptr -> attribute.pr_key = ON; 1578 attribute_ptr -> attribute.key_order = 1; 1579 1580 call ioa_$rs ("^a^a^a ^d ^a^a^a", message, message_length, 1581 "Relation """, relation_list_ptr -> relation.name, 1582 """ on line", relation_list_ptr -> relation.line_num, 1583 "does not specify any key attributes, assuming """, 1584 attribute_ptr -> attribute.name, """ is a key attribute."); 1585 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_no_key_attr, (message)); 1586 1587 end; 1588 1589 get_relation_name: procedure (); 1590 1591 /* get relation name from stack and build list header */ 1592 1593 call mrds_rst_rsc_alloc (static_rsc_ptr, RELATION, relation_list_ptr); 1594 relation_list_ptr -> relation.a_ptr = null (); 1595 relation_list_ptr -> relation.name = get_name (stack_top, 30); 1596 relation_list_ptr -> relation.max_tup = 0; 1597 relation_list_ptr -> relation.num_items = 0; 1598 relation_list_ptr -> relation.line_num = get_line_number (stack_top); 1599 relation_list_ptr -> relation.unused = OFF; 1600 key_order = 0; 1601 definition_order = 0; 1602 saved_attr_ptr = relation_list_ptr; 1603 1604 end; 1605 1606 get_relation_attribute: procedure (); 1607 1608 /* get attribute name from stack and add it to the relation's list */ 1609 1610 if list_duplicate (ATTRIBUTES, relation_list_ptr -> relation.a_ptr, temp_index, 32) then ; 1611 else do; 1612 call mrds_rst_rsc_alloc (static_rsc_ptr, ATTRIBUTE, attribute_ptr); 1613 attribute.next = null (); 1614 saved_attr_ptr -> attribute.next = attribute_ptr; 1615 attribute.name = get_name (temp_index, 32); 1616 attribute.pr_key = key_attribute; 1617 attribute.pad = OFF; 1618 definition_order = definition_order + 1; 1619 attribute.defn_order = definition_order; 1620 if ^key_attribute then 1621 attribute.key_order = 0; 1622 else do; 1623 key_order = key_order + 1; 1624 attribute.key_order = key_order; 1625 end; 1626 attribute.line_num = get_line_number (temp_index); 1627 relation_list_ptr -> relation.num_items = relation_list_ptr -> relation.num_items + 1; 1628 saved_attr_ptr = attribute_ptr; 1629 end; 1630 1631 end; 1632 1633 /* ****************************************************** 1634* 1635* index specification processing 1636* 1637* ****************************************************** */ 1638 1639 1640 /* ::= ! */ 1641 1642 rule_label (0079): 1643 1644 /* index processing complete, set it inactive */ 1645 1646 stmt (directive.type).index.active = OFF; 1647 goto return_label; 1648 1649 1650 /* ::= | ! */ 1651 1652 rule_label (0080): 1653 1654 /* set index statement inactive */ 1655 1656 stmt (directive.type).index.active = OFF; 1657 goto return_label; 1658 1659 1660 /* ::= ! */ 1661 1662 rule_label (0081): 1663 goto return_label; 1664 1665 1666 /* ::= ! */ 1667 1668 rule_label (0082): 1669 goto return_label; 1670 1671 1672 /* ::= ! */ 1673 1674 rule_label (0083): 1675 1676 /* index definition list complete, go process the definition */ 1677 1678 call mrds_rst_index_handler (static_rsc_ptr, index_list_ptr); 1679 stmt (directive.type).index.number = stmt (directive.type).index.number + 1; 1680 goto return_label; 1681 1682 1683 /* ::= ! */ 1684 1685 rule_label (0084): 1686 1687 /* start a index definition list with the relation name */ 1688 1689 call get_index_relation (); 1690 goto return_label; 1691 1692 1693 /* ::= ! */ 1694 1695 rule_label (0085): 1696 1697 /* add the last attribute to this index definition list */ 1698 1699 call get_index_attribute (); 1700 goto return_label; 1701 1702 1703 /* ::= ! */ 1704 1705 rule_label (0086): 1706 1707 /* add the next attribute to this index definition list */ 1708 1709 call get_index_attribute (); 1710 goto return_label; 1711 1712 1713 1714 1715 /* case statement common exit */ 1716 return_label: 1717 1718 return; 1719 1720 get_index_relation: procedure (); 1721 1722 /* get the relation name and build list head for this index statment */ 1723 1724 call mrds_rst_rsc_alloc (static_rsc_ptr, INDEX, index_list_ptr); 1725 index_list_ptr -> rel_index.i_ptr = null (); 1726 index_list_ptr -> rel_index.rel_name = get_name (stack_top, 32); 1727 index_list_ptr -> rel_index.num_items = 0; 1728 index_list_ptr -> rel_index.unused = OFF; 1729 index_list_ptr -> rel_index.line_num = get_line_number (stack_top); 1730 saved_attr_ptr = index_list_ptr; 1731 1732 end; 1733 1734 get_index_attribute: procedure (); 1735 1736 /* add attribute name to the list for this index */ 1737 1738 if list_duplicate (ATTRIBUTES, index_list_ptr -> rel_index.i_ptr, stack_top, 32) then ; 1739 else do; 1740 call mrds_rst_rsc_alloc (static_rsc_ptr, ITEM, item_ptr); 1741 item.name = get_name (stack_top, 32); 1742 item.next = null (); 1743 item.unused = OFF; 1744 item.line_num = get_line_number (stack_top); 1745 saved_attr_ptr -> item.next = item_ptr; 1746 index_list_ptr -> rel_index.num_items = index_list_ptr -> rel_index.num_items + 1; 1747 saved_attr_ptr = item_ptr; 1748 end; 1749 1750 1751 end; 1752 1753 list_duplicate: procedure (list_type, list_ptr, stack_pos, size) returns (bit (1)); 1754 1755 /* check that the given attribute/relation name appears only once in the 1756* given list. (i.e. attributes in a relation, relations in a file) */ 1757 1758 name_duplicate = OFF; 1759 name = get_name (stack_pos, size); 1760 1761 /* set up list start depending on list type and status */ 1762 1763 if list_type ^= CHILD then 1764 item_ptr = list_ptr; 1765 else if list_ptr = null () then 1766 item_ptr = null (); 1767 else do; 1768 children_ptr = list_ptr; 1769 item_ptr = children_ptr -> children.child_ptr; 1770 end; 1771 1772 /* run through linked list of names, checking for duplicates, until list end */ 1773 1774 do while (item_ptr ^= null ()); 1775 if item_ptr -> item.name ^= name then /* not duplicate, set next list element for list type */ 1776 if list_type ^= CHILD then 1777 item_ptr = item_ptr -> item.next; 1778 else do; 1779 children_ptr = children_ptr -> children.next; 1780 if children_ptr = null () then 1781 item_ptr = null (); 1782 else item_ptr = children_ptr -> children.child_ptr; 1783 end; 1784 1785 else do; /* duplicate found, issue error, quit search */ 1786 name_duplicate = ON; 1787 item_ptr = null (); 1788 if list_type = CHILD then 1789 duplicate_type = "child relation in a foreign key"; 1790 else if list_type = FILE_REL then 1791 duplicate_type = "relation in a file"; 1792 else duplicate_type = "attribute in a relation"; 1793 call ioa_$rs ("^a^a^a ^d ^a ^a^a", message, message_length, 1794 "The name """, name, """ given on line", get_line_number (stack_pos), 1795 "is a duplicate", duplicate_type, ", --- it will be ignored!!"); 1796 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_name_duplicate, (message)); 1797 end; 1798 end; 1799 1800 return (name_duplicate); 1801 1802 declare stack_pos fixed binary; /* stack index for this item */ 1803 declare size fixed binary; /* allowable length of name */ 1804 declare duplicate_type char (36) varying; /* error list message */ 1805 declare list_ptr ptr; /* overlay list pointer */ 1806 declare name char (32); /* name that is to be checked for duplicate */ 1807 declare list_type fixed bin; /* 8 => child relation, 9 => file relation, 10 => attribute */ 1808 declare name_duplicate bit (1); /* ON => name already in list */ 1809 1810 end; 1811 1812 get_name: procedure (stack_pos, name_size) returns (char (*)); 1813 1814 /* return the identifier from the given stack position, 1815* checking that it does not exceed the given size. 1816* Note that "" is used when a missing identifier 1817* has been detected and a dummy inserted for it. */ 1818 1819 length = lex_stack_ptr -> lex_stack (stack_pos).symlen; 1820 name = substr (lex_stack_ptr -> lex_stack (stack_pos).symptr -> source, 1, length); 1821 token_pos = lex_stack_ptr -> lex_stack (stack_pos).token_num; 1822 1823 /* check on the token size */ 1824 1825 if length <= name_size then ; 1826 else do; 1827 length = name_size; 1828 lex_stack_ptr -> lex_stack (stack_pos).symlen = name_size; 1829 call ioa_$rs ("^a^a^a ^d ^a ^d ^a", message, message_length, 1830 "The string """, name, """ in line", get_line_number (stack_pos), 1831 "is longer than", name_size, "characters, it is being truncated at that length."); 1832 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_name_too_long, (message)); 1833 end; 1834 1835 /* if this is the dummy symbol(token_pos = 0), issue a warning, the first time */ 1836 1837 if token_pos ^= 0 then ; 1838 else do; 1839 lex_stack_ptr -> lex_stack (stack_pos).token_num = -1; 1840 call ioa_$rs ("^a^a^a ^d^a", message, message_length, 1841 "The string """, name, """ is being used for a missing token in line", 1842 get_line_number (stack_pos), "."); 1843 call mrds_rst_error (static_rsc_ptr, 1 /* severity */, mrds_error_$rst_bad_semantics, (message)); 1844 end; 1845 1846 name_overlay_ptr = addrel (addr (name), 1); /* point to data portion of varying string */ 1847 1848 return (name_overlay); 1849 1850 1851 declare length fixed binary (24); /* length of token */ 1852 declare name char (mrds_data_$max_string_size) varying based (name_ptr); /* token character string */ 1853 declare name_overlay char (length) based (name_overlay_ptr); /* exact length token to return */ 1854 declare name_overlay_ptr ptr; /* points to data portion */ 1855 declare token_pos fixed binary (24); /* position of token in line */ 1856 declare stack_pos fixed binary; /* index into stack for this identifier */ 1857 declare name_size fixed binary; /* maximum legal size for this token */ 1858 1859 end; 1860 1861 get_fixed_value: procedure (stack_pos, max_value) returns (fixed bin (71)); 1862 1863 /* get a fixed binary value from the stack at the given position */ 1864 1865 if lex_stack_ptr -> lex_stack (stack_pos).token_num ^= 0 then 1866 value = lex_stack_ptr -> lex_stack (stack_pos).val; 1867 1868 else do; 1869 1870 /* token_num = 0 means dummy "" on stack for missing number, 1871* use a fixup value and issue error message */ 1872 1873 value = 1; 1874 lex_stack_ptr -> lex_stack (stack_pos).val = 1; 1875 call ioa_$rs ("^a^d^a ^d^a", message, message_length, 1876 "The value """, value, """ is being used for a missing number in line", 1877 get_line_number (stack_pos), "."); 1878 call mrds_rst_error (static_rsc_ptr, 1 /* severity */, mrds_error_$rst_bad_semantics, (message)); 1879 end; 1880 1881 /* check that the number is within the range of the option */ 1882 1883 if value <= max_value then ; 1884 else do; 1885 call ioa_$rs ("^a^d^a ^d ^a^d^a", message, message_length, 1886 "The value """, value, """ in line", get_line_number (stack_pos), 1887 "exceeds the maximum allowable for this option, using """, max_value, """ instead."); 1888 call mrds_rst_error (static_rsc_ptr, 2 /* severity */, mrds_error_$rst_option_limit, (message)); 1889 value = max_value; 1890 lex_stack_ptr -> lex_stack (stack_pos).val = max_value; 1891 end; 1892 1893 return (value); 1894 1895 declare value fixed binary (71); /* value of number to be returned */ 1896 declare stack_pos fixed binary; /* index into stack for this number */ 1897 declare max_value fixed binary (71); /* largest allowed value */ 1898 1899 end; 1900 1901 get_line_number: procedure (stack_pos) returns (fixed binary (24)); 1902 1903 /* routine to obtain line number from parse stack */ 1904 1905 line_number = lex_stack_ptr -> lex_stack (stack_pos).line; 1906 1907 return (line_number); 1908 1909 1910 declare line_number fixed binary (24); /* value to be returned */ 1911 declare stack_pos fixed binary; /* index into stack for this item */ 1912 1913 end; 1914 1915 declare rule_sw bit (1) static init ("0"b); /* switch for debug output of rule numbers */ 1916 declare saved_attr_ptr ptr internal static; /* last attr pointer */ 1917 declare saved_decode_descriptor bit (36) aligned internal static; /* first given decode_dcl descriptor */ 1918 declare descriptor_saved bit (1) internal static; /* on => the first decode descriptor was saved */ 1919 declare (fixed, addr, search, binary) builtin; /* functions known to pl1 */ 1920 declare stkp ptr; /* lexical stack pointer parameter */ 1921 declare ls_top fixed binary (24); /* parameter for top of stack */ 1922 declare sign_flag bit (1) internal static; /* on => negative value needed */ 1923 declare mrds_error_$rst_no_key_attr fixed binary (35) external; /* no attr given as key in relation */ 1924 declare mrds_error_$rst_option_limit fixed binary (35) external; /* number too large for receiving field */ 1925 declare mrds_error_$rst_name_duplicate fixed binary (35) external; /* dup name in rel/attr or file/rel list */ 1926 declare mrds_error_$rst_bad_declaration fixed binary (35) external; /* error in domain declaration */ 1927 declare mrds_error_$rst_inconsis_option fixed binary (35) external; /* contradictory option */ 1928 declare mrds_error_$rst_name_too_long fixed binary (35) external; /* oversize name error */ 1929 declare mrds_error_$rst_bad_semantics fixed binary (35) external; /* meaning of source may be lost */ 1930 declare EQUAL fixed bin internal static options (constant) init (1); /* = op code */ 1931 declare NOT_EQUAL fixed bin internal static options (constant) init (2); /* ^= op code */ 1932 declare GREATER fixed bin internal static options (constant) init (3); /* > op code */ 1933 declare LESS fixed bin internal static options (constant) init (4); /* < op code */ 1934 declare GREATER_EQUAL fixed bin internal static options (constant) init (5); /* >= op code */ 1935 declare LESS_EQUAL fixed bin internal static options (constant) init (6); /* <= op code */ 1936 declare AND fixed binary internal static options (constant) init (10); /* & op code */ 1937 declare OR fixed binary internal static options (constant) init (20); /* | op code */ 1938 declare NOT fixed binary internal static options (constant) init (30); /* ^ op code */ 1939 declare MINUS fixed binary internal static options (constant) init (40); /* - unary operator code */ 1940 declare DOMAIN_VARIABLE fixed binary internal static options (constant) init (50); /* domain id code */ 1941 declare ELEMENT fixed bin internal static options (constant) init (60); /* code for constant */ 1942 declare OFF bit (1) internal static options (constant) init ("0"b); /* flag reset value */ 1943 declare ON bit (1) internal static options (constant) init ("1"b); /* flag set value */ 1944 declare BLOCKED fixed binary internal static options (constant) init (2); /* code for blocked file type */ 1945 declare UNBLOCKED fixed binary internal static options (constant) init (1); /* code for unblocked file type */ 1946 declare BLANK char (1) internal static options (constant) init (" "); /* blank fill constant */ 1947 declare max_string_size fixed binary (35) internal static; /* descriptor string size limit */ 1948 declare descr_ptr ptr internal static; /* pointer to current descriptor */ 1949 declare saved_descr_ptr ptr internal static; /* normal desc pointer temp storage */ 1950 dcl decode_dcl_mesg char (8) var internal static; /* "" => normal, else decode_dcl declare message */ 1951 declare mrds_rst_rsc_alloc entry (ptr, fixed bin, ptr); /* working area allocation routine */ 1952 declare db_model_path char (168) internal static; /* saved db_model pathname */ 1953 declare ioa_$rs entry options (variable); /* string building routine */ 1954 declare mrds_rst_domain_handler entry (ptr, ptr); /* domain declaration semantic routine */ 1955 declare mrds_rst_attribute_handler entry (ptr, ptr); /* attribute declaration semantic routine */ 1956 declare mrds_rst_relation_handler entry (ptr, ptr); /* relation declaration semantic routine */ 1957 declare mrds_rst_index_handler entry (ptr, ptr); /* index declaration semantic routine */ 1958 declare mrds_rst_file_cleanup entry (ptr); /* undeclared file semantic routine */ 1959 declare mrds_rst_attribute_cleanup entry (ptr); /* domain default attribute routine */ 1960 declare stack_top fixed binary; /* current top of lexical stack */ 1961 declare message char (512) varying;/* error message of specifics */ 1962 declare message_length fixed binary (21); /* length of error message */ 1963 declare mrds_rst_error entry (ptr, fixed binary, fixed binary (35), char (*)); /* error handling routine */ 1964 1965 /* note: changing the declaration of multiplier, requires changing the 1966* code for the rule (the any_to_any parameters) */ 1967 declare multiplier fixed bin (24) internal static aligned; /* string multiplier */ 1968 declare source char (sys_info$max_seg_size) based; /* string overlay for getting tokens */ 1969 declare sys_info$max_seg_size fixed binary (35) external; /* system maximum segment size */ 1970 declare rule fixed binary (24); /* current rule number returned by parser */ 1971 declare alternate fixed binary (24); /* current allternate of rule number */ 1972 declare max_fixed_bin_17 fixed binary (71) internal static; /* largest 17 bit value */ 1973 declare max_fixed_bin_71 fixed binary (71) internal static; /* largest 71 bit value */ 1974 declare static_rsc_ptr ptr internal static; /* pointer to restructure control segment */ 1975 declare index_list_ptr ptr internal static; /* pointer to list of index information */ 1976 declare relation_list_ptr ptr internal static; /* pointer to list of relation information */ 1977 declare attribute_list_ptr ptr internal static; /* pointer to list of attribute information */ 1978 declare domain_list_ptr ptr internal static; /* pointer to list of domain information */ 1979 declare definition_order fixed bin internal static; /* order of attribute definition */ 1980 declare key_order fixed bin internal static; /* order of key attribute definition */ 1981 declare string_length fixed bin (24) internal static; /* size of bit or char string declaration */ 1982 declare string_average_length fixed bin (24) internal static; /* average varying string size */ 1983 declare temp_number fixed binary (71); /* storage for number checks */ 1984 declare i fixed binary; /* index for initialization loop */ 1985 declare saved_precision fixed bin (71) internal static; /* remembered number precision */ 1986 declare scale_factor fixed bin (71) internal static; /* remembered number scale value declaration */ 1987 declare avg_length_seen bit (1) internal static; /* ON => varying average size declared */ 1988 declare size_seen bit (1) internal static; /* on => string size was declared */ 1989 declare decode_proc_seen bit (1) internal static; /* on => decode_proc option was declared */ 1990 declare encode_proc_seen bit (1) internal static; /* on => encode_proc option was declared */ 1991 declare check_seen bit (1) internal static; /* on => check or check_proc option declared */ 1992 declare type_seen bit (1) internal static; /* on => a type was declared */ 1993 declare representation_seen bit (1) internal static; /* on => representation was declared */ 1994 declare base_seen bit (1) internal static; /* on => base was declared */ 1995 declare precision_seen bit (1) internal static; /* on => precision was declared */ 1996 declare alignment_seen bit (1) internal static; /* on => alignment was declared */ 1997 declare fixed_varying_seen bit (1) internal static; /* on => fixed or varying was declared */ 1998 declare scale_seen bit (1) internal static; /* on => scale was declared */ 1999 declare decode_dcl_seen bit (1) internal static; /* on => decode declaration seen */ 2000 declare MULTIPLIER fixed bin internal static options (constant) init (1); /* any to any of multiplier */ 2001 declare A_CONSTANT fixed bin internal static options (constant) init (2); /* any to any of constant */ 2002 declare NUMBER fixed bin internal static options (constant) init (3); /* number constant to convert */ 2003 declare BIT_STRING fixed bin internal static options (constant) init (4); /* bit_string to convert */ 2004 declare CHAR_STRING fixed bin internal static options (constant) init (5); /* char_string to convert */ 2005 declare RMDB fixed bin internal static options (constant) init (5); /* rmdb fixup */ 2006 declare CHILD fixed bin internal static options (constant) init (8); /* child rel dup check */ 2007 declare FILE_REL fixed bin internal static options (constant) init (9); /* file rel dup check */ 2008 declare ATTRIBUTES fixed bin internal static options (constant) init (10); /* attr dup check */ 2009 declare decimal bit (1) internal static; /* on => decimal declared */ 2010 declare real bit (1) internal static; /* on => real declared */ 2011 declare (addrel, hbound, copy, length) builtin; 2012 declare (null, reverse, rtrim, substr) builtin; 2013 declare float bit (1) internal static; /* on => float declared */ 2014 declare aligned bit (1) internal static; /* on => aligned was declared */ 2015 declare nonvarying bit (1) internal static; /* on => nonvarying was declared */ 2016 declare temp_index fixed binary; /* storage for stack position of a token */ 2017 declare key_attribute bit (1); /* on => attribute is part of primary key */ 2018 declare short bit (1) internal static; /* on => short precision */ 2019 declare 1 arith_size unal based, /* overlay for scale and precision fields of descriptor */ 2020 2 unused bit (12), 2021 2 scale fixed bin (11), 2022 2 precision fixed binary (11); /* equivalent to bit(12) */ 2023 declare 1 string_size unal based, /* overlay for size field in descriptor */ 2024 2 unused bit (12), 2025 2 length fixed binary (23); /* equivalent to bit(24) */ 2026 declare name_ptr ptr int static; /* pointer to token space when needed from stack */ 2027 declare temp_source_ptr ptr int static; /* pointer to temp token space when to be multiplied */ 2028 declare ioa_ entry() options(variable); 2029 2030 2031 1 1 /* BEGIN INCLUDE FILE mrds_rst_parse_stack.incl.pl1 jeg 8/8/78 */ 1 2 1 3 declare 1 lex_stack (-5:50) based (lex_stack_ptr), 1 4 2 symptr ptr, /* pointer to terminal symbol in source input */ 1 5 2 symlen fixed binary (24), /* length of terminal symbol in input */ 1 6 2 line fixed binary (24), /* line number in source for this symbol */ 1 7 2 symbol fixed binary (24), /* parser's encoding value for the terminal symbol */ 1 8 2 val fixed binary (71), /* conversion value for numbers */ 1 9 2 float float binary (63), /* conversion value if floating point number */ 1 10 2 line_strt ptr, /* pointer to start of current line */ 1 11 2 line_size fixed binary (24), /* current length of line */ 1 12 2 token_num fixed binary (24) ; /* number of this token in current line, 1 13* 0 if for missing or wrong symbol */ 1 14 1 15 declare lex_stack_ptr ptr ; /* pointer to lexical stack */ 1 16 1 17 declare debug_sw bit (1) static init ("0"b) ; /* on => output debug messages */ 1 18 1 19 dcl 1 p_struct (50) aligned based (p_struct_ptr), 1 20 2 parse_stack fixed bin (24), /* * parse stack */ 1 21 2 parse_stack2 fixed bin (24); /* * copy of parse stack used 1 22* with local error recovery */ 1 23 1 24 dcl p_struct_ptr ptr ; 1 25 1 26 1 27 dcl cur_lex_top (50) fixed bin (24) aligned based (cur_lex_top_ptr) ; /* current lex top stack (with parse_stack) */ 1 28 1 29 declare cur_lex_top_ptr ptr ; 1 30 1 31 1 32 /* END INCLUDE FILE mrds_rst_parse_stack.incl.pl1 */ 1 33 2032 2 1 /* BEGIN INCLUDE FILE mrds_rst_semantics.incl.pl1 jeg 8/31/78 */ 2 2 2 3 /* structure to remember what directives have been seen and are active */ 2 4 2 5 declare 1 directive based (directive_ptr), 2 6 2 type fixed binary, /* stmt structure index for given directive */ 2 7 2 undefine, 2 8 3 active bit (1) unal, 2 9 3 seen bit (1) unal, 2 10 3 pad bit (34) unal, 2 11 2 define, 2 12 3 active bit (1) unal, 2 13 3 seen bit (1) unal, 2 14 3 pad bit (34) unal, 2 15 2 redefine, 2 16 3 active bit (1) unal, 2 17 3 seen bit (1) unal, 2 18 3 pad bit (34) unal, 2 19 2 cmdb, 2 20 3 active bit (1) unal, 2 21 3 seen bit (1) unal, 2 22 3 pad bit (34) unal ; 2 23 2 24 declare directive_ptr ptr internal static ; 2 25 2 26 /* encoding for directive types */ 2 27 2 28 declare UNDEFINE fixed bin internal static options (constant) init (1) ; 2 29 declare DEFINE fixed bin internal static options (constant) init (2) ; 2 30 declare REDEFINE fixed bin internal static options (constant) init (3) ; 2 31 declare CMDB fixed binary internal static options (constant) init (4) ; 2 32 2 33 2 34 /* structure to remember what statements have been seen, are active, 2 35* and how many items are in the statement, and how big the list for the last item was */ 2 36 2 37 declare 1 stmt (4) based (stmt_ptr), 2 38 2 domain, 2 39 3 active bit (1) unal, 2 40 3 pad bit (35) unal, 2 41 3 number fixed binary, 2 42 2 attribute, 2 43 3 active bit (1) unal, 2 44 3 pad bit (35) unal, 2 45 3 number fixed binary, 2 46 2 relation, 2 47 3 active bit (1) unal, 2 48 3 pad bit (35) unal, 2 49 3 number fixed binary, 2 50 2 file, 2 51 3 active bit (1) unal, 2 52 3 pad bit (35) unal, 2 53 3 number fixed binary, 2 54 2 foreign_key, 2 55 3 active bit (1) unal, 2 56 3 pad bit (35) unal, 2 57 3 number fixed binary, 2 58 2 index, 2 59 3 active bit (1) unal, 2 60 3 pad bit (35) unal, 2 61 3 number fixed binary ; 2 62 2 63 /* NOTE: 2 64* active ON => this stmt/directive is currently being processed 2 65* seen ON => this stmt/directive was or is being processed 2 66**/ 2 67 2 68 declare stmt_ptr ptr internal static ; 2 69 2 70 /* END INCLUDE FILE mrds_rst_semantics.incl.pl1 */ 2 71 2033 3 1 /* BEGIN mdbm_descriptor.incl.pl1 -- jaw 5/31/78 */ 3 2 /* modified by Jim Gray - - Nov. 1979, to change type from fixed bin(5) to 3 3* unsigned fixed bin(6), so new packed decimal data types could be handled. 3 4* also the duplicate mrds_descriptor.incl.pl1 was eliminated. */ 3 5 3 6 dcl 1 descriptor based (desc_ptr), /* map of Multics descriptor */ 3 7 2 version bit (1) unal, /* DBM handles vers. 1 only */ 3 8 2 type unsigned fixed bin (6) unal, /* data type */ 3 9 2 packed bit (1) unal, /* on if data item is packed */ 3 10 2 number_dims bit (4) unal, /* dimensions */ 3 11 2 size, /* size for string data */ 3 12 3 scale bit (12) unal, /* scale for num. data */ 3 13 3 precision bit (12) unal, /* prec. for num. data */ 3 14 2 array_info (num_dims), 3 15 3 lower_bound fixed bin (35), /* lower bound of dimension */ 3 16 3 upper_bound fixed bin (35), /* upper bound of dimension */ 3 17 3 multiplier fixed bin (35); /* element separation */ 3 18 3 19 dcl desc_ptr ptr; 3 20 dcl num_dims fixed bin init (0) ; /* more useful form of number_dims */ 3 21 3 22 /* END mdbm_descriptor.incl.pl1 */ 3 23 3 24 2034 4 1 /* BEGIN INCLUDE FILE mrds_rst_rsc.incl.pl1 RDL 7/7/78 */ 4 2 4 3 /* Modified 8/21/78 by RDL */ 4 4 4 5 /* Modified 9/11/78 by RDL to add directive and stmt pointers */ 4 6 4 7 /* Modified 11/4/78 by RDL to add debug,trace,meter switches 4 8* 4 9* Modified 3/29/79 by RDL to change s_seg_info_ptr to source_seg_ptr 4 10* 4 11* Modified by Jim Gray - - Jan. 1980, to add flags to disallow blocked files, forieng keys, and restructuring. 4 12* 4 13* Modified by Jim Gray - - Feb. 1980, to add command level flag for cmdb subroutine interface. 4 14* 4 15* Modified by Jim Gray - - 80-11-06, to add bit for cmdb -secure option. 4 16* 4 17* 81-05-18 Jim Gray : added bit for max_attributes error message, so that 4 18* it would only be issued on first occurence. 4 19* 4 20* 82-08-19 Davids: added the db_type field. 4 21* 4 22* 83-02-18 Mike Kubicar : Removed the db_type field and added the 4 23* db_relation_mode_flags substructure to define the modes applicable 4 24* to the database's relations. Also removed assorted unsed fields 4 25* (names that included the word unused). 4 26* 4 27**/ 4 28 4 29 dcl 1 rsc based (rsc_ptr), /* Restructuring control info */ 4 30 2 rsc_dir char (200), /* pathname of directory containing rsc segment */ 4 31 2 dbp char (168), /* Database absolute path */ 4 32 2 temp_dir char (168), /* Path name of temp restrucuring directory */ 4 33 2 temp_dir_sw bit (1) unal, /* On => temp dir has been created */ 4 34 2 db_quiesced_sw bit (1) unal, /* On => database has been quiesced */ 4 35 2 o_db_open_sw bit (1) unal, /* On => old database has been opened */ 4 36 2 n_db_open_sw bit (1) unal, /* On => temp database is open */ 4 37 2 listing_seg_sw bit (1) unal, /* On => listing segment has been created */ 4 38 2 skip_scanner_conversion bit (1) unal, /* Skip conversion in scanner */ 4 39 2 cmdb_option bit (1) unal, /* ON => this is a cmdb source, not restructuring */ 4 40 2 trace_sw bit (1) unal, /* On -> trace mode in affect */ 4 41 2 debug_sw bit (1) unal, /* On = debug mode (NOT IMPLEMENTED) */ 4 42 2 meter_sw bit (1) unal, /* On = procedures call metering procedure */ 4 43 2 delete_db_sw bit (1) unal, /* On = delete data base in cleanup */ 4 44 2 model_consistent_sw bit (1) unal, /* On => Model is consistent */ 4 45 2 physical_started_sw bit (1) unal, /* On => Physical restructuring started */ 4 46 2 physical_complete_sw bit (1) unal, /* On => Physical restructuring completed */ 4 47 2 model_overflow bit (1) unal, /* ON => model segment area condition occurred */ 4 48 2 max_files bit (1) unal, /* ON => maximum number of files reached */ 4 49 2 allow_foreign_keys bit (1) unal, /* on => allow foreign key statment */ 4 50 2 foreign_key_seen bit (1) unal, /* on => foreign key definition in source */ 4 51 2 allow_blocked_files bit (1) unal, /* on => allow file statement with blocked option */ 4 52 2 blocked_file_seen bit (1) unal, /* on => blocked file definition in source */ 4 53 2 allow_restructuring bit (1) unal, /* on => allow RMDB entry point */ 4 54 2 command_level bit (1) unal, /* on => called from command unal, not subroutine level */ 4 55 2 secure bit (1) unal, /* on => -secure option given for cmdb */ 4 56 2 max_attrs bit (1) unal, /* on => max attrs/rel or max indexes/rel exceeded */ 4 57 2 db_relation_mode_flags, 4 58 3 dm_file_type bit (1) unal, /* on => relations are dm files */ 4 59 3 protection_on bit (1) unal, /* on => relations need transactions */ 4 60 3 concurrency_on bit (1) unal, /* on => concurrency control enabled */ 4 61 3 rollback_on bit (1) unal, /* on => before journalling is enabled */ 4 62 2 severity_high fixed bin, /* Highest severity level error encountered */ 4 63 2 phase fixed bin, /* 000 = init 4 64* 100 = global list init 4 65* 200 = parse 4 66* 300 = physical init 4 67* 400 = physical */ 4 68 2 h_o_seg_info_ls_ptr ptr, /* Pointer to head of old db seg_info list */ 4 69 2 h_n_seg_info_ls_ptr ptr, /* Pointer to head of new db seg_info list */ 4 70 2 h_gfile_ptr ptr, /* Pointer to head of global file list */ 4 71 2 h_gdom_ptr ptr, /* Pointer to head of global domain list */ 4 72 2 h_gattr_ptr ptr, /* Pointer to head of global attribute list */ 4 73 2 h_grel_ptr ptr, /* Pointer to head of global relation list */ 4 74 2 h_glink_ptr ptr, /* Pointer to head of global link list */ 4 75 2 o_dm_ptr ptr, /* Pointer to old data model seg (dm_model ) */ 4 76 2 n_dm_ptr ptr, /* Pointer to temp data model seg */ 4 77 2 o_fn_hdr_ptr ptr, /* Pointer to head of original file list (fn structure) */ 4 78 2 source_seg_ptr ptr, /* Pointer to source_seg */ 4 79 2 listing_iocb_ptr ptr, /* Pointer to listing segment iocb */ 4 80 2 directive_ptr ptr, /* Pointer to directive type str in mrds_rst_semactics.incl.pl1 */ 4 81 2 stmt_ptr ptr, /* Pointer to statement str in mrds_rst_sematics.incl.pl1 */ 4 82 2 trace_metering_iocb_ptr ptr, /* Pointer to seg used by trace and metering */ 4 83 2 tree_node_area_ptr ptr, /* pointer to working storage for tree nodes */ 4 84 2 tree_data, 4 85 3 seg_info_area_ptr ptr, /* seg info working storage area */ 4 86 3 gl_area_ptr ptr, /* global list data work storage area */ 4 87 3 sl_area_ptr ptr, /* sublist data work storage area */ 4 88 2 parse_info_area_ptr ptr, /* parse interface work area storage */ 4 89 2 static_info_area_ptr ptr, /* directive, stmt and other static work storage area */ 4 90 2 variable_length_area_ptr ptr, /* varibale allocates work storage area */ 4 91 2 other_area_ptr ptr, /* unspecified work area storage */ 4 92 2 wa area (sys_info$max_seg_size - fixed (rel (addr (rsc.wa))) + 1); /* Work area */ 4 93 4 94 dcl rsc_ptr ptr; /* Pointer to base of rsc segment */ 4 95 4 96 4 97 4 98 /* END INCLUDE FILE mrds_rst_rsc.incl.pl1 */ 4 99 2035 5 1 /* BEGIN INCLUDE FILE mrds_rst_parse_info.incl.pl1 -- oris, 6/30/78 */ 5 2 /* modified 9/6/78 -- jeg, for lrk parser - cmdb interface */ 5 3 /* modified 12/20/78 - - jeg, to add line number info for handlers */ 5 4 /* modified 3/15/79 - - jeg, to add scanner, semantic, and link handler variables to be allocated in rsc */ 5 5 /* Modified by Jim Gray - - 23-June-80, to separate max_string_size, 5 6* and max_line_size mrds_data_ items. */ 5 7 5 8 5 9 5 10 5 11 declare 1 domain aligned based (domain_ptr), 5 12 2 name char (32), /* name of this domain */ 5 13 2 descriptor bit (36), /* Multics pl1 descriptor for domain type */ 5 14 2 varying_avg_length fixed bin (24), /* average length of varying strings */ 5 15 2 options bit (1) unal, /* ON => some option is present */ 5 16 2 pad bit (35) unal, 5 17 2 check, 5 18 3 flag bit (1) unal, /* ON => check option present */ 5 19 3 pad bit (35) unal, 5 20 3 stack_ptr ptr, /* pointer to postfix stack 5 21* holding boolean expression */ 5 22 3 stack_size fixed binary, /* number of stack elements */ 5 23 2 check_proc, 5 24 3 flag bit (1) unal, /* ON => check_proc option is present */ 5 25 3 pad bit (35) unal, 5 26 3 path char (168), /* check procedure pathname */ 5 27 3 entry char (32), /* check procedure entryname */ 5 28 2 encode_proc, 5 29 3 flag bit (1) unal, /* ON => encode_proc option is present */ 5 30 3 pad bit (35) unal, 5 31 3 path char (168), /* encode procedure pathname */ 5 32 3 entry char (32), /* encode procedure entryname */ 5 33 2 decode_proc, 5 34 3 flag bit (1) unal, /* ON => decode_proc option is present */ 5 35 3 pad bit (35) unal, 5 36 3 path char (168), /* decode procedure pathname */ 5 37 3 entry char (32), /* decode procedure entryname */ 5 38 2 decode_dcl, 5 39 3 flag bit (1) unal, /* ON => decode declaration is present */ 5 40 3 pad bit (35) unal, 5 41 3 descriptor bit (36), /* decode declaration pl1 descriptor */ 5 42 2 line_num fixed bin (24) ; /* line of domain name in source */ 5 43 5 44 5 45 declare domain_ptr ptr ; 5 46 5 47 5 48 5 49 5 50 5 51 dcl 1 relation aligned based (relation_ptr), 5 52 2 a_ptr ptr, /* ptr to attribute list for this relation */ 5 53 2 name char (32), /* relation name */ 5 54 2 max_tup fixed bin, /* maximum tuples for this relation if a blocked file */ 5 55 2 num_items fixed bin, /* number of attributes in this relation */ 5 56 2 unused bit (36) unal, /* future flags */ 5 57 2 line_num fixed bin (24) ; /* line of relation name in source */ 5 58 5 59 5 60 dcl relation_ptr ptr; 5 61 5 62 5 63 dcl 1 attribute aligned based (attribute_ptr), 5 64 2 next ptr, /* ptr to next in list */ 5 65 2 name char (32), /* name of attribute */ 5 66 2 pr_key bit (1) unal, /* ON => part of primary key */ 5 67 2 pad bit (35) unal, 5 68 2 defn_order fixed bin, /* position within the relation */ 5 69 2 key_order fixed bin, /* position within the primary key, if a key */ 5 70 2 line_num fixed bin (24) ; /* line of attribute name in source */ 5 71 5 72 5 73 dcl attribute_ptr ptr; 5 74 5 75 5 76 5 77 dcl 1 attribute_domain aligned based (attdom_ptr), 5 78 2 attr char (32), /* attribute name */ 5 79 2 dom char (32), /* domain name */ 5 80 2 default bit (1) unal, /* on => defined as default attr, not by source */ 5 81 2 unused bit (35) unal, /* future flags */ 5 82 2 line_num fixed bin (24) ; /* line of attribute name in source */ 5 83 5 84 dcl attdom_ptr ptr; /* ptr to attribute_domain structure */ 5 85 5 86 5 87 5 88 5 89 dcl 1 file aligned based (file_ptr), 5 90 2 i_ptr ptr, /* ptr to item containing relation name */ 5 91 2 name char (30), /* file name */ 5 92 2 type fixed bin, /* blocked or unblocked */ 5 93 /* type = 1 => unblocked, 5 94* type = 2 => blocked */ 5 95 2 ppb fixed bin, /* pages per block, if blocked */ 5 96 2 hbh fixed bin, /* hash bucket headers per block */ 5 97 2 block fixed bin, /* blocks per hash bucket headers */ 5 98 2 num_items fixed bin, /* nbr. items -- relations -- in file */ 5 99 2 default bit (1) unal, /* on => defined as default file, not by source */ 5 100 2 unused bit (35) unal, /* future flags */ 5 101 2 line_num fixed bin (24) ; /* line of file name in source */ 5 102 5 103 5 104 dcl file_ptr ptr; /* ptr to file structure */ 5 105 5 106 5 107 dcl 1 rel_index aligned based (index_ptr), 5 108 2 i_ptr ptr, /* ptr. to item containing index attr. name */ 5 109 2 rel_name char (32), /* name of relation being indexed */ 5 110 2 num_items fixed bin, /* nbr. items -- attributes -- indexed for a relation */ 5 111 2 unused bit (36) unal, /* future flags */ 5 112 2 line_num fixed bin (24) ; /* line of relation name in source */ 5 113 5 114 5 115 dcl index_ptr ptr; /* ptr to index structure */ 5 116 5 117 5 118 dcl 1 link aligned based (link_ptr), 5 119 2 parent_ptr ptr, /* ptr to foreign_key structure cont. parent rel. name */ 5 120 2 children_ptr ptr, /* ptr. to list of children names for this link */ 5 121 2 clust_fl bit (1) unal, /* ON => link is clustered in one file */ 5 122 2 pad bit (35) unal, 5 123 2 name char (32), /* name of this link */ 5 124 2 num_children fixed bin, /* number of children for this link's parent */ 5 125 2 line_num fixed bin (24) ; /* line of link name occurence in source */ 5 126 5 127 5 128 dcl link_ptr ptr; /* ptr to link structure */ 5 129 5 130 5 131 dcl 1 children aligned based (children_ptr), 5 132 2 next ptr, /* ptr to next in list */ 5 133 2 child_ptr ptr; /* ptr. to foreign_key struct. containing child rel. name */ 5 134 5 135 5 136 dcl children_ptr ptr; /* ptr to children structure */ 5 137 5 138 5 139 dcl 1 foreign_key aligned based (forkey_ptr), 5 140 2 i_ptr ptr, /* ptr to item list containing foreign key attributes */ 5 141 2 rel_name char (32), /* name of parent/child relation */ 5 142 2 num_items fixed bin, /* nbr of attributes defining this foreign key */ 5 143 2 unused bit (36) unal, /* future flags */ 5 144 2 line_num fixed bin (24) ; /* line of relation occurence in source */ 5 145 5 146 5 147 dcl forkey_ptr ptr; /* ptr to foreign_key structure */ 5 148 5 149 5 150 dcl 1 item aligned based (item_ptr), 5 151 2 next ptr, /* ptr to next item in the list */ 5 152 2 name char (32), /* name of item -- relation name or attribute name */ 5 153 2 unused bit (36) unal, /* future flags */ 5 154 2 line_num fixed bin (24) ; /* line of item occurence in source */ 5 155 5 156 5 157 dcl item_ptr ptr; /* ptr to item structure */ 5 158 5 159 5 160 declare 1 delete_name aligned based (delete_name_ptr), /* overlay for undefine parse information */ 5 161 2 overlay char (32), /* name portion */ 5 162 2 unused bit (36) unal, /* future flags */ 5 163 2 line_num fixed bin (24) ; /* line number of name occurence in source */ 5 164 5 165 declare delete_name_ptr ptr ; 5 166 5 167 /* scanner variables */ 5 168 5 169 declare token char (mrds_data_$max_string_size) varying 5 170 based (accum_token_ptr) ; /* temp store for accumulating the token */ 5 171 declare accum_token_ptr ptr internal static ; /* pointer to allocated accumulator store */ 5 172 declare mrds_data_$max_string_size fixed bin (35) external ; /* max token size in chars */ 5 173 declare mrds_data_$max_line_size fixed bin (35) ext ; /* max output listing line size */ 5 174 declare token_length fixed binary (24) ; /* current length of token */ 5 175 declare output_text char (mrds_data_$max_line_size) varying 5 176 based (output_text_ptr) ; /* body of text for this line in output listing */ 5 177 declare output_text_ptr ptr internal static ; /* pointer to allocated output line storage */ 5 178 declare fixup_token char (token_length) based ; /* saved fixed up version of token */ 5 179 5 180 /* semantic variables */ 5 181 5 182 declare source_size fixed bin (35) ; /* length of source char string for any_to_any */ 5 183 declare string_source_ptr ptr ; /* pointer to source for any_to_any conversion */ 5 184 declare string_source char (source_size) based (string_source_ptr) ; /* storage for expanded string constant */ 5 185 5 186 /* link handler variable */ 5 187 5 188 declare dom_list_ptr ptr ; /* pointer to domain list element */ 5 189 declare 1 dom_list based (dom_list_ptr), /* element of parent attr domain ptr list */ 5 190 2 next ptr, /* pointer to next in order on list */ 5 191 2 attr_name char (32) aligned, /* parent attr's name */ 5 192 2 dom_info_ptr ptr ; /* parent attr's domain ptr */ 5 193 5 194 /* END INCLUDE FILE mrds_rst_parse_info.incl.pl1 */ 5 195 2036 6 1 /* BEGIN INCLUDE FILE mdbm_db_model.incl.pl1 -- jaw, 10/2/78 */ 6 2 6 3 6 4 /****^ HISTORY COMMENTS: 6 5* 1) change(79-02-01,Gray), approve(), audit(), install(): 6 6* modified to save space occupied by model 6 7* 2) change(80-11-03,Gray), approve(), audit(), install(): 6 8* to add mdbm_secured bit in db_model 6 9* 3) change(82-04-09,Davids), approve(), audit(), install(): 6 10* collapsed the following into an unused_offset array: 6 11* chng_before_path_ptr chng_err_path_ptr chng_after_path_ptr 6 12* copy_before_path_ptr copy_err_path_ptr copy_after_path_ptr 6 13* dsply_before_path_pt dsply_err_path_pt dsply_after_path_ptr 6 14* accs_before_path_ptr accs_err_path_ptr accs_after_path_ptr 6 15* unused_1 6 16* Also changed the name of unused_2 to restructuring_history_offset 6 17* and changed the comment on the changer structure to indicate 6 18* that it will contain on database creation information. 6 19* 4) change(82-04-14,Davids), approve(), audit(), install(): 6 20* used one of the unused_offsets to point to a message which indicates 6 21* why the db is inconsistent. The offset will be null when the db is created 6 22* and set the first time the message is used. this is so it will be 6 23* consistent with existing data bases. Also added the message structure. 6 24* 5) change(82-04-28,Davids), approve(), audit(), install(): 6 25* added the undo_request element to the message structure 6 26* 6) change(82-05-04,Davids), approve(), audit(), install(): 6 27* changed unused_offset (12) to last_restructruring_history_offset and 6 28* changed restructuring_history_offset to first_restructuring_history_offset 6 29* 7) change(82-08-19,Davids), approve(), audit(), install(): 6 30* changed the meaning of db_type from 1 => relational and 2 => CODASYL to 6 31* 1 => vfile database and 2 => page_file database. Up to this point all 6 32* database types were equal to 1. 6 33* 8) change(83-02-14,Davids), approve(), audit(), install(): 6 34* changed db_type from a fixed bin unal to a substructure of 18 bit (1) unal 6 35* flags. This will allow information about transactions and dm_file 6 36* concurrency to be independent of the db_type, i.e. vfile or dm_file. The 6 37* change is compatable with all datamodels created by the released version 6 38* of mrds. 6 39* 9) change(83-02-15,Davids), approve(), audit(), install(): 6 40* added the rollback_on flag to the db_type_flags since it appears that you 6 41* can have a dmfile database that requires transactions but does not have any 6 42* journalizing. Also switched the order of the transactions_needed and 6 43* concurrency_on flags - this makes the change compatable with existing 6 44* dmfile databases except when displaying the model since concurrency_on and 6 45* rollback_on will be off in the model even though the dmfile relations had 6 46* them on during creation. 6 47* 10) change(83-02-22,Kubicar), approve(), audit(), install(): 6 48* Removed ctl_file_path_ptr. 6 49* 11) change(85-11-08,Spitzer), approve(85-12-03,MCR7311), 6 50* audit(86-09-02,Blair), install(86-10-16,MR12.0-1187): 6 51* used 1 unused offset for unreferenced attribute linked lists in db_model, 6 52* 1 unused bit flag in domain_info to indicate an unreferenced domain, 1 bit 6 53* in the flag word for rmdb copying. 6 54* END HISTORY COMMENTS */ 6 55 6 56 6 57 /* this include file contains the structures that go into the make up 6 58* of the "db_model" segment in the model for the database. 6 59* in addition there file_model.m segments, 1 for each database file(see mdbm_file_model.incl.pl1) 6 60* 6 61* the db_model structure goes at the base of the segment, and contains items unique to 6 62* the whole databse. in addition, it has an area of size to fill the 6 63* rest of a segment, that holds the lists of files and domains in the database. 6 64* these lists are singly forward linked lists. all "pointers" in the database model 6 65* are maintained as offsets(bit (18)) from the base of the particular model segment 6 66* since actual pointers are process dependent on segment number. 6 67* the remaining structures are first a path_entry one to save pathnames in, 6 68* and the stack_item and constent structures, used to save a boolean 6 69* expression in polish form, with the stack represented by a linked list. 6 70* the final structure is one for identifying the status of version information */ 6 71 6 72 dcl 1 db_model aligned based (dbm_ptr),/* base of db_model segment, allocated once per database */ 6 73 2 version unal fixed bin, /* data base version, currently 4 */ 6 74 2 db_type_flags unal, 6 75 3 copy_good bit (1) unal, /* "1"b => copy of the db_model is the valid copy */ 6 76 3 unused (13) bit (1) unal, 6 77 3 rollback_on bit (1) unal, /* "1"b => before journaling is to be done */ 6 78 3 concurrency_on bit (1) unal, /* "1"b => dm_file concurrency is being used */ 6 79 3 transactions_needed bit (1) unal, /* "1"b => transactions are needed to reference data */ 6 80 3 vfile_type bit (1) unal, /* "1"b => vfile type relations, "0"b => dm_file type relations */ 6 81 2 uniq_sw_name char (32), /* per database unique attach switch name for files */ 6 82 2 consistant bit (1) unal, /* ON => correctly created/restructured database, ok to open */ 6 83 2 mdbm_secured bit (1) unal, /* on => database has been secured */ 6 84 2 reserved bit (34) unal, /* reserved for flags */ 6 85 2 blk_file_id_len unal fixed bin, /* no. bits required for blocked file id. */ 6 86 2 unblk_file_id_len unal fixed bin, /* number of file id bits, unblocked file */ 6 87 2 num_blk_files unal fixed bin, /* number of blocked files defined in db */ 6 88 2 num_unblk_files unal fixed bin, /* number of unblocked files defined in db */ 6 89 2 num_rels unal fixed bin, /* number of relations defined in db. */ 6 90 2 num_domains unal fixed bin, /* number of domains defined */ 6 91 2 num_dyn_links unal fixed bin, /* no. dynamic links defined */ 6 92 2 max_max_tuples unal fixed bin (35), /* maximum max_tuples across all files */ 6 93 2 pad_1 unal fixed bin (35), /* for future use */ 6 94 2 pad_2 unal fixed bin (35), /* for future use */ 6 95 2 version_ptr bit (18), /* offset to version structure */ 6 96 2 file_ptr unal bit (18), /* offset to first in threaded list of file_infos */ 6 97 2 domain_ptr unal bit (18), /* offset to first in list of domain_infos */ 6 98 2 unreferenced_attribute_ptr unal bit (18), /* offset to first in list of unreferenced attr_infos */ 6 99 2 unused_offsets (11) unal bit (18), /* extra offsets if needed */ 6 100 2 last_restructuring_history_offset unal bit (18), /* offset to last restructuring history entry */ 6 101 2 inconsistent_message_offset unal bit (18), /* offset to message indicating why db is inconsistent */ 6 102 2 first_restructuring_history_offset unal bit (18), /* offset to first restructuring history entry */ 6 103 2 changer_ptr unal bit (18), /* offset to information about db creation */ 6 104 2 dbm_area area (sys_info$max_seg_size - fixed (rel (addr (db_model.dbm_area))) - 1); 6 105 6 106 dcl dbm_ptr ptr; 6 107 6 108 /* the files in the database each have a file_info containing 6 109* their name, the file_model for each file is found by initiating the 6 110* segment "file_name.m" (i.e. the file's name with suffix ".m") 6 111* the file_info list is a singly linked list in definition order */ 6 112 6 113 dcl 1 file_info aligned based (fi_ptr), /* list of file names and numbers */ 6 114 2 file_name char (30), /* name of file */ 6 115 2 file_id bit (36), /* id number of file */ 6 116 2 fwd_ptr unal bit (18), /* thread to next in list */ 6 117 2 unused unal bit (18); /* for future expansion */ 6 118 6 119 dcl fi_ptr ptr; 6 120 6 121 /* each domain used in the database will have a domain info saved in the db_model 6 122* segment. it describes the domain of the given name, and it's options. 6 123* the domain_info's form a singly linked list in definition order */ 6 124 6 125 dcl 1 domain_info aligned based (di_ptr), /* one for each domain defined */ 6 126 2 name char (32), /* name of domain */ 6 127 2 db_desc_is_ptr bit (1) unal, /* on if descriptor is pointer to real desc. */ 6 128 2 user_desc_is_ptr bit (1) unal, /* on if user desc is ptr */ 6 129 2 no_conversion bit (1) unal, /* if no conversion allowed */ 6 130 2 procedures_present bit (1) unal, /* on => ids type procedures present */ 6 131 2 unreferenced bit (1) unal, /* on => this domain is not used in any attribute */ 6 132 2 reserved bit (31) unal, 6 133 2 db_desc bit (36), /* desc. for item in db, or ptr to it */ 6 134 2 user_desc bit (36), /* desc. for user-visible attr, or ptr */ 6 135 2 ave_len fixed bin (35), /* average length of varying string */ 6 136 2 nck_items unal fixed bin, /* no. items in check stack */ 6 137 2 fwd_thread unal bit (18), /* offset to next in list */ 6 138 2 check_path_ptr unal bit (18), /* integ. check proc. */ 6 139 2 ck_stack_ptr unal bit (18), /* to check stack */ 6 140 2 encd_path_ptr unal bit (18), /* encode procedure */ 6 141 2 decd_path_ptr unal bit (18), /* decode procedure */ 6 142 2 str_before_path_ptr unal bit (18), /* proc paths and entries */ 6 143 2 str_err_path_ptr unal bit (18), 6 144 2 str_after_path_ptr unal bit (18), 6 145 2 get_before_path_ptr unal bit (18), 6 146 2 get_err_path_ptr unal bit (18), 6 147 2 get_after_path_ptr unal bit (18), 6 148 2 mod_before_path_ptr unal bit (18), 6 149 2 mod_err_path_ptr unal bit (18), 6 150 2 mod_after_path_ptr unal bit (18), 6 151 2 unused_1 unal bit (18), /* for future expansion */ 6 152 2 unused_2 unal bit (18), 6 153 2 changer_ptr unal bit (18); /* pointer to change_id and chane_time structure */ 6 154 6 155 dcl di_ptr ptr; 6 156 6 157 /* information necessary for attributes that are not used in any relation */ 6 158 6 159 dcl 1 unreferenced_attribute aligned based (ua_ptr), 6 160 2 name char (32), /* name of attribute */ 6 161 2 domain_ptr bit (18) unal, /* to domain_info */ 6 162 2 fwd_thread bit (18) unal, /* to next in list */ 6 163 2 unused (2) bit (18) unal; 6 164 6 165 dcl ua_ptr ptr; 6 166 6 167 6 168 /* space saving pathname$entryname structure, to be allocated 6 169* only when a path$entry has to be saved, else only a bit(18) 6 170* offset takes up space in the main model structure */ 6 171 6 172 declare 1 path_entry based (path_entry_ptr), 6 173 2 path char (168), /* pathname portion of desired path$entry */ 6 174 2 entry char (32), /* entryname portion of desired path$entry */ 6 175 2 reserved unal bit (36); /* for future use */ 6 176 6 177 declare path_entry_ptr ptr; 6 178 6 179 6 180 6 181 6 182 6 183 /* declarations for model of postfix stack holding the check option boolean expression 6 184* the following encoding values indicate the corresponding type of stack element 6 185* 6 186* 1 = 6 187* 2 ^= 6 188* 3 > 6 189* 4 < 6 190* 5 >= 6 191* 6 <= 6 192* 6 193* 10 and 6 194* 20 or 6 195* 30 not 6 196* 6 197* 40 - (minus) 6 198* 6 199* 50 domain variable(same name as domain) 6 200* 6 201* 60 constant(number, bit string, or character string) 6 202* 6 203**/ 6 204 6 205 6 206 declare 1 stack_item based (stack_item_ptr), /* element of stack model list */ 6 207 2 next bit (18), /* link to next in list */ 6 208 2 type fixed binary, /* code for this element type */ 6 209 2 value_ptr bit (18); /* pointer to variable holding value, 6 210* if this is a constant element type */ 6 211 6 212 declare stack_item_ptr ptr; /* pointer to a stack element */ 6 213 6 214 6 215 6 216 declare 1 constant based (constant_ptr), /* variable size space for constant's value storage */ 6 217 2 length fixed bin (35), /* length allocated to hold value */ 6 218 2 value bit (alloc_length refer (constant.length)) aligned; /* value for this constant */ 6 219 6 220 declare constant_ptr ptr; /* pointer to constant's value space */ 6 221 6 222 declare alloc_length fixed binary (35) internal static; /* amount of space to allocate for constant's value */ 6 223 6 224 /* version structure, giving status of source for CMDB/RMDB, 6 225* status of model, and status of resultant */ 6 226 6 227 /* version number is in form MM.N.Y 6 228* where MM is the major version number, N is the minor version alteration, 6 229* and Y is the lastest modification to that alteration, 6 230* where M and N represent numbers 0-9, and Y is a letter */ 6 231 6 232 declare 1 version_status unal based (version_status_ptr), 6 233 2 cmdb_rmdb, 6 234 3 major fixed bin, 6 235 3 minor fixed bin, 6 236 3 modification char (4), 6 237 2 model, 6 238 3 major fixed bin, 6 239 3 minor fixed bin, 6 240 3 modification char (4), 6 241 2 resultant, 6 242 3 major fixed bin, 6 243 3 minor fixed bin, 6 244 3 modification char (4); 6 245 6 246 declare version_status_ptr ptr; 6 247 6 248 6 249 /* maintains information only about the db creation */ 6 250 6 251 declare 1 changer unal based (changer_ptr), 6 252 2 id char (32), 6 253 2 time fixed bin (71), 6 254 2 next bit (18); /* to next in the singly linked list */ 6 255 6 256 declare changer_ptr ptr; 6 257 6 258 6 259 dcl 01 message_str unal based (message_str_ptr), /* general purpose structure to hold messages */ 6 260 02 len fixed bin, /* length of the message */ 6 261 02 text char (message_str_len refer (message_str.len)), /* actual message */ 6 262 02 name char (32), /* name of thing that set the message */ 6 263 02 undo_request char (100), /* rmdb request that will undo the operation 6 264* that caused the database to become inconsistent */ 6 265 02 mbz bit (36); /* for possible extensions, like an offset to another message */ 6 266 6 267 dcl message_str_ptr ptr; /* pointer to the message_str structure */ 6 268 6 269 dcl message_str_len fixed bin; /* initail length of the text string in message_str */ 6 270 6 271 /* END INCLUDE FILE mdbm_db_model.incl.pl1 */ 6 272 6 273 2037 7 1 /* BEGIN INCLUDE FILE mrds_rst_struct_types.incl.pl1 - - Jim Gray 2/20/79 */ 7 2 7 3 /* these constants are used to identify structures to be allocated 7 4* to the general purpose allocation routines */ 7 5 7 6 /* HISTORY: 7 7* 82-06-28 Roger Lackey : Removed struct types 52, 53, 54, 55, 56, 57, 58 7 8* Type 25 is no longer used and is handled with special code so bounds of 7 9* array could continue to work */ 7 10 7 11 /* PARSE INFO STRUCTURES */ 7 12 7 13 declare DOMAIN fixed bin internal static options (constant) init (1) ; 7 14 declare ATTRIBUTE_DOMAIN fixed bin internal static options (constant) init (2) ; 7 15 declare RELATION fixed bin internal static options (constant) init (3) ; 7 16 declare ATTRIBUTE fixed bin internal static options (constant) init (4) ; 7 17 declare FILE fixed bin internal static options (constant) init (5) ; 7 18 declare ITEM fixed bin internal static options (constant) init (6) ; 7 19 declare LINK fixed bin internal static options (constant) init (7) ; 7 20 declare FOREIGN_KEY fixed bin internal static options (constant) init (8) ; 7 21 declare CHILDREN fixed bin internal static options (constant) init (9) ; 7 22 declare INDEX fixed bin internal static options (constant) init (10) ; 7 23 declare DELETE_NAME fixed bin internal static options (constant) init (11) ; 7 24 declare DOM_LIST fixed bin internal static options (constant) init (12) ; /* in link handler */ 7 25 7 26 /* SEMANTIC STRUCTURES */ 7 27 7 28 declare DIRECTIVE fixed bin internal static options (constant) init (13) ; 7 29 declare STMT fixed bin internal static options (constant) init (14) ; 7 30 7 31 7 32 /* PARSING STRUCTURES */ 7 33 7 34 declare LEX_STACK fixed bin internal static options (constant) init (15) ; 7 35 declare P_STRUCT fixed bin internal static options (constant) init (16) ; 7 36 declare CUR_LEX_TOP fixed bin internal static options (constant) init (17) ; 7 37 declare FIXUP_TOKEN fixed bin internal static options (constant) init (50) ; /* scanner */ 7 38 declare STRING_SOURCE fixed bin internal static options (constant) init (51) ; /* semantics */ 7 39 declare TOKEN fixed bin internal static options (constant) init (18) ; 7 40 declare OUTPUT_TEXT fixed bin internal static options (constant) init (19) ; 7 41 7 42 7 43 /* DB_MODEL STRUCTURES */ 7 44 7 45 declare DB_MODEL fixed bin internal static options (constant) init (0) ; 7 46 declare FILE_INFO fixed bin internal static options (constant) init (1) ; 7 47 declare DOMAIN_INFO fixed bin internal static options (constant) init (2) ; 7 48 declare PATH_ENTRY fixed bin internal static options (constant) init (3) ; 7 49 declare STACK_ITEM fixed bin internal static options (constant) init (4) ; 7 50 declare CONSTANT fixed bin internal static options (constant) init (30) ; 7 51 declare VERSION_STATUS fixed bin internal static options (constant) init (5) ; 7 52 declare CHANGER fixed bin internal static options (constant) init (6) ; 7 53 7 54 7 55 /* FILE_MODEL STRUCTURES */ 7 56 7 57 declare FILE_MODEL fixed bin internal static options (constant) init (7) ; 7 58 declare REL_INFO fixed bin internal static options (constant) init (8) ; 7 59 declare ATTR_INFO fixed bin internal static options (constant) init (9) ; 7 60 declare PARENT_LINK_INFO fixed bin internal static options (constant) init (10) ; 7 61 declare CHILD_LINK_INFO fixed bin internal static options (constant) init (11) ; 7 62 declare ATTR_LIST fixed bin internal static options (constant) init (12) ; 7 63 declare ATD fixed bin internal static options (constant) init (31) ; 7 64 declare COMP_NO_ARRAY fixed bin internal static options (constant) init (32) ; 7 65 declare SORT_KEY fixed bin internal static options (constant) init (13) ; 7 66 declare DUP_PREV fixed bin internal static options (constant) init (14) ; 7 67 declare SELECT_CHAIN fixed bin internal static options (constant) init (15) ; 7 68 7 69 7 70 /* GLOBAL LIST STRUCTURES */ 7 71 7 72 declare GL fixed bin internal static options (constant) init (20) ; 7 73 declare SL fixed bin internal static options (constant) init (21) ; 7 74 declare SEGINFO fixed bin internal static options (constant) init (22) ; 7 75 declare LIST_OVRLY fixed bin internal static options (constant) init (26) ; 7 76 declare SAVED_CHILD_COUNT fixed bin internal static options (constant) init (24) ; /* in global list build */ 7 77 declare NODE fixed bin internal static options (constant) init (23) ; 7 78 7 79 7 80 /* DISPLAY STRUCTURES */ 7 81 7 82 declare DISPLAY_INFO fixed bin internal static options (constant) init (25) ; 7 83 7 84 /* Remove because nolonger used 82-06-28 7 85* NAME_LIST fixed bin internal static options (constant) init (52) ; 7 86* PAI_ARRAY fixed bin internal static options (constant) init (53) ; 7 87* PAR_LK_ATTR_INFO fixed bin internal static options (constant) init (54) ; 7 88* CAI_ARRAY fixed bin internal static options (constant) init (55) ; 7 89* CHILD_LK_ATTR_INFO fixed bin internal static options (constant) init (56) ; 7 90* NAME_TABLE fixed bin internal static options (constant) init (57) ; 7 91* ATTR_TABLE fixed bin internal static options (constant) init (58) ; 7 92**/ 7 93 7 94 /* END INCULDE FILE mrds_rst_struct_types */ 7 95 2038 2039 2040 2041 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/16/86 1142.9 mrds_rst_semantics.pl1 >special_ldd>install>MR12.0-1187>mrds_rst_semantics.pl1 2032 1 10/14/83 1608.4 mrds_rst_parse_stack.incl.pl1 >ldd>include>mrds_rst_parse_stack.incl.pl1 2033 2 10/14/83 1608.4 mrds_rst_semantics.incl.pl1 >ldd>include>mrds_rst_semantics.incl.pl1 2034 3 10/14/83 1608.6 mdbm_descriptor.incl.pl1 >ldd>include>mdbm_descriptor.incl.pl1 2035 4 10/14/83 1609.1 mrds_rst_rsc.incl.pl1 >ldd>include>mrds_rst_rsc.incl.pl1 2036 5 10/14/83 1608.6 mrds_rst_parse_info.incl.pl1 >ldd>include>mrds_rst_parse_info.incl.pl1 2037 6 10/16/86 1139.3 mdbm_db_model.incl.pl1 >special_ldd>install>MR12.0-1187>mdbm_db_model.incl.pl1 2038 7 10/14/83 1609.0 mrds_rst_struct_types.incl.pl1 >ldd>include>mrds_rst_struct_types.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. ATTRIBUTE 000221 constant fixed bin(17,0) initial dcl 7-16 set ref 1612* ATTRIBUTES 000130 constant fixed bin(17,0) initial dcl 2008 set ref 1610* 1738* ATTRIBUTE_DOMAIN 000217 constant fixed bin(17,0) initial dcl 7-14 set ref 1458* BLANK constant char(1) initial unaligned dcl 1946 ref 524 525 528 529 532 533 CHILD constant fixed bin(17,0) initial dcl 2006 ref 1763 1775 1788 CMDB constant fixed bin(17,0) initial dcl 2-31 ref 378 DIRECTIVE 000126 constant fixed bin(17,0) initial dcl 7-28 set ref 277* DOMAIN 000220 constant fixed bin(17,0) initial dcl 7-13 set ref 459* FILE_REL constant fixed bin(17,0) initial dcl 2007 ref 1790 INDEX 000130 constant fixed bin(17,0) initial dcl 7-22 set ref 1724* ITEM 000127 constant fixed bin(17,0) initial dcl 7-18 set ref 1740* OFF constant bit(1) initial unaligned dcl 1942 ref 275 280 281 282 283 284 285 290 292 294 296 298 300 428 471 514 516 517 518 519 522 523 526 527 530 531 534 535 536 542 543 544 545 548 559 560 572 577 578 579 580 581 582 583 584 705 708 745 757 823 834 856 885 905 964 983 1027 1072 1092 1115 1179 1256 1430 1466 1467 1487 1493 1555 1599 1617 1642 1652 1728 1743 1758 ON constant bit(1) initial unaligned dcl 1943 ref 379 380 382 387 396 407 477 561 562 563 571 702 706 748 759 812 845 867 895 924 953 982 990 1034 1103 1122 1170 1251 1255 1344 1360 1377 1567 1577 1786 RELATION 000222 constant fixed bin(17,0) initial dcl 7-15 set ref 1593* STMT 000216 constant fixed bin(17,0) initial dcl 7-29 set ref 287* TOKEN 000215 constant fixed bin(17,0) initial dcl 7-39 set ref 310* 311* a_ptr based pointer level 2 dcl 5-51 set ref 1576 1594* 1610* active 2 based bit(1) array level 3 in structure "stmt" packed unaligned dcl 2-37 in procedure "mrds_rst_semantics" set ref 292* 387* 1430* active 1 based bit(1) level 3 in structure "directive" packed unaligned dcl 2-5 in procedure "mrds_rst_semantics" set ref 280* active based bit(1) array level 3 in structure "stmt" packed unaligned dcl 2-37 in procedure "mrds_rst_semantics" set ref 290* 382* 428* active 12 based bit(1) array level 3 in structure "stmt" packed unaligned dcl 2-37 in procedure "mrds_rst_semantics" set ref 300* 407* 1642* 1652* active 2 based bit(1) level 3 in structure "directive" packed unaligned dcl 2-5 in procedure "mrds_rst_semantics" set ref 282* active 6 based bit(1) array level 3 in structure "stmt" packed unaligned dcl 2-37 in procedure "mrds_rst_semantics" set ref 296* active 10 based bit(1) array level 3 in structure "stmt" packed unaligned dcl 2-37 in procedure "mrds_rst_semantics" set ref 298* active 4 based bit(1) level 3 in structure "directive" packed unaligned dcl 2-5 in procedure "mrds_rst_semantics" set ref 380* active 3 based bit(1) level 3 in structure "directive" packed unaligned dcl 2-5 in procedure "mrds_rst_semantics" set ref 284* active 4 based bit(1) array level 3 in structure "stmt" packed unaligned dcl 2-37 in procedure "mrds_rst_semantics" set ref 294* 396* 1487* 1493* addr builtin function dcl 1919 ref 569 807 807 818 818 829 829 840 840 851 851 862 862 914 914 931 931 948 948 959 959 1025 1025 1032 1032 1063 1063 1087 1087 1098 1098 1113 1113 1120 1120 1250 1250 1342 1342 1358 1358 1375 1375 1846 addrel builtin function dcl 2011 ref 1846 aligned 000150 internal static bit(1) unaligned dcl 2014 set ref 471 562* 615 620 625 630 745* 746 748* 757 953* 964* alignment_seen 000141 internal static bit(1) unaligned dcl 1996 set ref 582* 743 948 948 959 959 alternate parameter fixed bin(24,0) dcl 1971 ref 237 arith_size based structure level 1 packed unaligned dcl 2019 attr based char(32) level 2 dcl 5-77 set ref 1463* attribute 2 based structure array level 2 in structure "stmt" unaligned dcl 2-37 in procedure "mrds_rst_semantics" attribute based structure level 1 dcl 5-63 in procedure "mrds_rst_semantics" attribute parameter char unaligned dcl 1005 in procedure "duplicate" set ref 974 991* attribute_domain based structure level 1 dcl 5-77 attribute_list_ptr 000114 internal static pointer dcl 1977 set ref 1458* 1463 1464 1465 1466 1467 1469* attribute_ptr 000316 automatic pointer dcl 5-73 set ref 1576* 1577 1578 1580 1612* 1613 1614 1615 1616 1617 1619 1620 1624 1626 1628 avg_length_seen 000130 internal static bit(1) unaligned dcl 1987 set ref 548* 768 1072* base_seen 000137 internal static bit(1) unaligned dcl 1994 set ref 580* 851 851 862 862 binary builtin function dcl 1919 ref 305 306 check 14 based structure level 2 dcl 5-11 check_proc 21 based structure level 2 dcl 5-11 check_seen 000134 internal static bit(1) unaligned dcl 1991 set ref 545* 1342 1342 child_ptr 2 based pointer level 2 dcl 5-131 ref 1769 1782 children based structure level 1 dcl 5-131 children_ptr 000320 automatic pointer dcl 5-136 set ref 1768* 1769 1779* 1779 1780 1782 cmdb 4 based structure level 2 packed unaligned dcl 2-5 copy builtin function dcl 2011 ref 305 306 current_descriptor parameter bit(36) dcl 587 set ref 554 569 db_model_path 000027 internal static char(168) unaligned dcl 1952 set ref 308* decimal 000145 internal static bit(1) unaligned dcl 2009 set ref 559* 597 648 656 662 701 856* 867* decode_dcl 252 based structure level 2 dcl 5-11 decode_dcl_mesg 000024 internal static varying char(8) dcl 1950 set ref 549* 666* 676* 685* 714* 727* 749* 765 770* 991* 1073 1132* 1149* 1230* 1261* decode_dcl_seen 000144 internal static bit(1) unaligned dcl 1999 set ref 542* 1250 1250 decode_proc 167 based structure level 2 dcl 5-11 decode_proc_seen 000132 internal static bit(1) unaligned dcl 1989 set ref 543* 1375 1375 default 20 based bit(1) level 2 packed unaligned dcl 5-77 set ref 1466* define 2 based structure level 2 packed unaligned dcl 2-5 definition_order 000120 internal static fixed bin(17,0) dcl 1979 set ref 1601* 1618* 1618 1619 defn_order 13 based fixed bin(17,0) level 2 dcl 5-63 set ref 1619* descr_ptr 000020 internal static pointer dcl 1948 set ref 471 477 491 493 504 506 569* 571 572 597 602 603 605 606 609 610 612 615 617 620 622 625 627 630 632 693 734 757 759 761 1225* 1240 descriptor 10 based bit(36) level 2 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 465* 514* descriptor based structure level 1 unaligned dcl 3-6 in procedure "mrds_rst_semantics" descriptor 253 based bit(36) level 3 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 536* 1235* 1245* 1252 descriptor_saved 000015 internal static bit(1) unaligned dcl 1918 set ref 1234 1251* 1256* directive based structure level 1 unaligned dcl 2-5 directive_ptr 242 based pointer level 2 in structure "rsc" dcl 4-29 in procedure "mrds_rst_semantics" set ref 278* directive_ptr 000160 internal static pointer dcl 2-24 in procedure "mrds_rst_semantics" set ref 277* 278 279 280 281 282 283 284 285 370 378 379 380 382 387 396 407 428 451 451 1430 1444 1444 1470 1470 1487 1493 1522 1522 1642 1652 1679 1679 dom 10 based char(32) level 2 dcl 5-77 set ref 1464* domain based structure array level 2 in structure "stmt" unaligned dcl 2-37 in procedure "mrds_rst_semantics" domain based structure level 1 dcl 5-11 in procedure "mrds_rst_semantics" domain_list_ptr 000116 internal static pointer dcl 1978 set ref 446* 459* 465 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 666 666 676 676 685 685 714 714 727 727 749 749 766 770 770 991 991 1132 1132 1149 1149 1170 1179 1235 1245 1252 1255 1344 1345 1346 1346 1348 1360 1361 1362 1362 1365 1377 1378 1379 1379 1382 1406 duplicate_type 000560 automatic varying char(36) dcl 1804 set ref 1788* 1790* 1792* 1793* duplication 000370 automatic bit(1) unaligned dcl 1002 set ref 983* 990* 1000 encode_proc 104 based structure level 2 dcl 5-11 encode_proc_seen 000133 internal static bit(1) unaligned dcl 1990 set ref 544* 1358 1358 entry 74 based char(32) level 3 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 525* 1346* 1348* entry 242 based char(32) level 3 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 533* 1379* 1382* entry 157 based char(32) level 3 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 529* 1362* 1365* entry_portion 000440 automatic varying char(168) dcl 1418 set ref 1391* 1399* 1403* 1403 1404 1413 entryname 000430 automatic char(32) unaligned dcl 1417 set ref 1413* 1414 file 6 based structure array level 2 unaligned dcl 2-37 fixed builtin function dcl 1919 ref 305 306 fixed_varying_seen 000142 internal static bit(1) unaligned dcl 1997 set ref 583* 1025 1025 1032 1032 1087 1087 1098 1098 1113 1113 1120 1120 flag 21 based bit(1) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 522* 1344* flag 104 based bit(1) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 526* 1360* flag 14 based bit(1) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 518* flag 252 based bit(1) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 534* 1255* flag 167 based bit(1) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 530* 1377* flag_overlay based bit(1) unaligned dcl 1004 set ref 978 982* flag_ptr parameter pointer dcl 1003 ref 974 978 982 float 000147 internal static bit(1) unaligned dcl 2013 set ref 560* 597 606 613 624 648 662 702 712 834* 845* foreign_key 10 based structure array level 2 unaligned dcl 2-37 hbound builtin function dcl 2011 ref 289 i 000306 automatic fixed bin(17,0) dcl 1984 set ref 289* 290 291 292 293 294 295 296 297 298 299 300 301* i_ptr based pointer level 2 dcl 5-107 set ref 1725* 1738* index 12 based structure array level 2 unaligned dcl 2-37 index_list_ptr 000110 internal static pointer dcl 1975 set ref 1674* 1724* 1725 1726 1727 1728 1729 1730 1738 1746 1746 ioa_ 000226 constant entry external dcl 2028 ref 335 ioa_$rs 000204 constant entry external dcl 1953 ref 666 676 685 714 727 749 770 991 1132 1149 1406 1580 1793 1829 1840 1875 1885 item based structure level 1 dcl 5-150 item_ptr 000322 automatic pointer dcl 5-157 set ref 1740* 1741 1742 1743 1744 1745 1747 1763* 1765* 1769* 1774 1775 1775* 1775 1780* 1782* 1787* key_attribute 000310 automatic bit(1) unaligned dcl 2017 set ref 1555* 1567* 1616 1620 key_order 14 based fixed bin(17,0) level 2 in structure "attribute" dcl 5-63 in procedure "mrds_rst_semantics" set ref 1578* 1620* 1624* key_order 000121 internal static fixed bin(17,0) dcl 1980 in procedure "mrds_rst_semantics" set ref 1515 1600* 1623* 1623 1624 length builtin function dcl 2011 in procedure "mrds_rst_semantics" ref 1391 1404 length 0(12) based fixed bin(23,0) level 2 in structure "string_size" packed unaligned dcl 2023 in procedure "mrds_rst_semantics" set ref 761* length 000100 automatic fixed bin(24,0) dcl 1851 in procedure "get_name" set ref 1819* 1820 1825 1827* 1848 lex_stack based structure array level 1 unaligned dcl 1-3 lex_stack_ptr 000312 automatic pointer dcl 1-15 set ref 329* 1391 1819 1820 1821 1828 1839 1865 1865 1874 1890 1905 line 3 based fixed bin(24,0) array level 2 dcl 1-3 ref 1905 line_num 14 based fixed bin(24,0) level 2 in structure "rel_index" dcl 5-107 in procedure "mrds_rst_semantics" set ref 1729* line_num 13 based fixed bin(24,0) level 2 in structure "item" dcl 5-150 in procedure "mrds_rst_semantics" set ref 1744* line_num 15 based fixed bin(24,0) level 2 in structure "relation" dcl 5-51 in procedure "mrds_rst_semantics" set ref 1580* 1598* line_num 254 based fixed bin(24,0) level 2 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 537* 666* 676* 685* 714* 727* 749* 770* 991* 1132* 1149* 1406* line_num 15 based fixed bin(24,0) level 2 in structure "attribute" dcl 5-63 in procedure "mrds_rst_semantics" set ref 1626* line_num 21 based fixed bin(24,0) level 2 in structure "attribute_domain" dcl 5-77 in procedure "mrds_rst_semantics" set ref 1465* line_number 000100 automatic fixed bin(24,0) dcl 1910 set ref 1905* 1907 list_ptr parameter pointer dcl 1805 ref 1753 1763 1765 1768 list_type parameter fixed bin(17,0) dcl 1807 ref 1753 1763 1775 1788 1790 ls_top parameter fixed bin(24,0) dcl 1921 ref 237 330 max_fixed_bin_17 000102 internal static fixed bin(71,0) dcl 1972 set ref 305* max_fixed_bin_71 000104 internal static fixed bin(71,0) dcl 1973 set ref 306* 920* 921* 923* 936* 1069* max_string_size 000017 internal static fixed bin(35,0) dcl 1947 set ref 304* 1129 1132* 1139 max_tup 12 based fixed bin(17,0) level 2 dcl 5-51 set ref 1596* max_value parameter fixed bin(71,0) dcl 1897 set ref 1861 1883 1885* 1889 1890 message 000101 automatic varying char(512) dcl 1961 set ref 666* 670 676* 680 685* 689 714* 718 727* 731 749* 753 770* 775 991* 997 1132* 1138 1149* 1154 1406* 1410 1580* 1585 1793* 1796 1829* 1832 1840* 1843 1875* 1878 1885* 1888 message_length 000302 automatic fixed bin(21,0) dcl 1962 set ref 666* 676* 685* 714* 727* 749* 770* 991* 1132* 1149* 1406* 1580* 1793* 1829* 1840* 1875* 1885* mrds_data_$max_string_size 000230 external static fixed bin(35,0) dcl 5-172 ref 304 1820 1829 1840 mrds_error_$rst_bad_declaration 000172 external static fixed bin(35,0) dcl 1926 set ref 670* 680* 689* 718* 731* 753* 997* 1138* 1154* mrds_error_$rst_bad_semantics 000200 external static fixed bin(35,0) dcl 1929 set ref 1843* 1878* mrds_error_$rst_inconsis_option 000174 external static fixed bin(35,0) dcl 1927 set ref 775* mrds_error_$rst_name_duplicate 000170 external static fixed bin(35,0) dcl 1925 set ref 1796* mrds_error_$rst_name_too_long 000176 external static fixed bin(35,0) dcl 1928 set ref 1410* 1832* mrds_error_$rst_no_key_attr 000164 external static fixed bin(35,0) dcl 1923 set ref 1585* mrds_error_$rst_option_limit 000166 external static fixed bin(35,0) dcl 1924 set ref 1888* mrds_rst_attribute_cleanup 000220 constant entry external dcl 1959 ref 423 mrds_rst_attribute_handler 000210 constant entry external dcl 1955 ref 1469 mrds_rst_domain_handler 000206 constant entry external dcl 1954 ref 446 mrds_rst_error 000222 constant entry external dcl 1963 ref 670 680 689 718 731 753 775 997 1138 1154 1410 1585 1796 1832 1843 1878 1888 mrds_rst_file_cleanup 000216 constant entry external dcl 1958 ref 1482 mrds_rst_index_handler 000214 constant entry external dcl 1957 ref 1674 mrds_rst_relation_handler 000212 constant entry external dcl 1956 ref 1521 mrds_rst_rsc_alloc 000202 constant entry external dcl 1951 ref 277 287 310 311 459 1458 1593 1612 1724 1740 multiplier 000101 internal static fixed bin(24,0) dcl 1967 set ref 546* name 2 based char(32) level 2 in structure "relation" dcl 5-51 in procedure "mrds_rst_semantics" set ref 1580* 1595* name based varying char dcl 1852 in procedure "get_name" set ref 1820* 1829* 1840* 1846 name 000572 automatic char(32) unaligned dcl 1806 in procedure "list_duplicate" set ref 1759* 1775 1793* name 2 based char(32) level 2 in structure "attribute" dcl 5-63 in procedure "mrds_rst_semantics" set ref 1580* 1615* name 2 based char(32) level 2 in structure "item" dcl 5-150 in procedure "mrds_rst_semantics" set ref 1741* 1775 name based char(32) level 2 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 513* 666* 676* 685* 714* 727* 749* 770* 991* 1132* 1149* name_duplicate 000602 automatic bit(1) unaligned dcl 1808 set ref 1758* 1786* 1800 name_overlay based char unaligned dcl 1853 ref 1848 name_overlay_ptr 000102 automatic pointer dcl 1854 set ref 1846* 1848 name_ptr 000154 internal static pointer dcl 2026 set ref 310* 1820 1829 1840 1846 name_size parameter fixed bin(17,0) dcl 1857 set ref 1812 1825 1827 1828 1829* next based pointer level 2 in structure "children" dcl 5-131 in procedure "mrds_rst_semantics" ref 1779 next based pointer level 2 in structure "attribute" dcl 5-63 in procedure "mrds_rst_semantics" set ref 1613* 1614* next based pointer level 2 in structure "item" dcl 5-150 in procedure "mrds_rst_semantics" set ref 1742* 1745* 1775 nonvarying 000151 internal static bit(1) unaligned dcl 2015 set ref 491 504 563* 743 766 1027* 1034* 1092* 1103* 1115* 1122* null builtin function dcl 2012 ref 520 1594 1613 1725 1742 1765 1765 1774 1780 1780 1787 num_dims 000314 automatic fixed bin(17,0) initial dcl 3-20 set ref 3-20* 573* num_items 12 based fixed bin(17,0) level 2 in structure "rel_index" dcl 5-107 in procedure "mrds_rst_semantics" set ref 1727* 1746* 1746 num_items 13 based fixed bin(17,0) level 2 in structure "relation" dcl 5-51 in procedure "mrds_rst_semantics" set ref 1597* 1627* 1627 number 7 based fixed bin(17,0) array level 3 in structure "stmt" dcl 2-37 in procedure "mrds_rst_semantics" set ref 297* number 1 based fixed bin(17,0) array level 3 in structure "stmt" dcl 2-37 in procedure "mrds_rst_semantics" set ref 291* 451* 451 number parameter fixed bin(71,0) dcl 1157 in procedure "string_size_check" set ref 1125 1129 1132* 1139* 1146 1148* number 5 based fixed bin(17,0) array level 3 in structure "stmt" dcl 2-37 in procedure "mrds_rst_semantics" set ref 295* 1522* 1522 number 11 based fixed bin(17,0) array level 3 in structure "stmt" dcl 2-37 in procedure "mrds_rst_semantics" set ref 299* number 13 based fixed bin(17,0) array level 3 in structure "stmt" dcl 2-37 in procedure "mrds_rst_semantics" set ref 301* 1679* 1679 number 3 based fixed bin(17,0) array level 3 in structure "stmt" dcl 2-37 in procedure "mrds_rst_semantics" set ref 293* 1444* 1444 1470* 1470 number_dims 0(08) based bit(4) level 2 packed unaligned dcl 3-6 set ref 572* options 12 based bit(1) level 2 packed unaligned dcl 5-11 set ref 516* 1170* 1179* packed 0(07) based bit(1) level 2 packed unaligned dcl 3-6 set ref 471* 477* 757* 759* pad 14(01) based bit(35) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 519* pad 104(01) based bit(35) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 527* pad 12(01) based bit(35) level 2 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 517* pad 21(01) based bit(35) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 523* pad 167(01) based bit(35) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 531* pad 252(01) based bit(35) level 3 in structure "domain" packed unaligned dcl 5-11 in procedure "mrds_rst_semantics" set ref 535* pad 12(01) based bit(35) level 2 in structure "attribute" packed unaligned dcl 5-63 in procedure "mrds_rst_semantics" set ref 1617* path 170 based char(168) level 3 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 532* 1378* 1379* path 105 based char(168) level 3 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 528* 1361* 1362* path 22 based char(168) level 3 in structure "domain" dcl 5-11 in procedure "mrds_rst_semantics" set ref 524* 1345* 1346* pathname parameter char dcl 1416 set ref 1387 1391 1391 1391 1391 1399 1406* pr_key 12 based bit(1) level 2 packed unaligned dcl 5-63 set ref 1577* 1616* precision 0(24) based fixed bin(11,0) level 2 packed unaligned dcl 2019 set ref 693* precision_seen 000140 internal static bit(1) unaligned dcl 1995 set ref 581* 648 914 914 931 931 real 000146 internal static bit(1) unaligned dcl 2010 set ref 561* 597 613 812* 823* redefine 3 based structure level 2 packed unaligned dcl 2-5 rel_index based structure level 1 dcl 5-107 rel_name 2 based char(32) level 2 dcl 5-107 set ref 1726* relation based structure level 1 dcl 5-51 in procedure "mrds_rst_semantics" relation 4 based structure array level 2 in structure "stmt" unaligned dcl 2-37 in procedure "mrds_rst_semantics" relation_list_ptr 000112 internal static pointer dcl 1976 set ref 1521* 1576 1580 1580 1593* 1594 1595 1596 1597 1598 1599 1602 1610 1627 1627 representation_seen 000136 internal static bit(1) unaligned dcl 1993 set ref 579* 829 829 840 840 reverse builtin function dcl 2012 ref 1391 1391 rsc based structure level 1 unaligned dcl 4-29 rsc_ptr parameter pointer dcl 4-94 ref 272 274 275 278 288 308 rtrim builtin function dcl 2012 ref 308 1403 rule parameter fixed bin(24,0) dcl 1970 set ref 237 335* 339 rule_sw 000010 internal static bit(1) initial unaligned dcl 1915 set ref 239* 239 334 saved_attr_ptr 000012 internal static pointer dcl 1916 set ref 1602* 1614 1628* 1730* 1745 1747* saved_decode_descriptor 000014 internal static bit(36) dcl 1917 set ref 1235 1252* saved_descr_ptr 000022 internal static pointer dcl 1949 set ref 1225 1240* saved_precision 000124 internal static fixed bin(71,0) dcl 1985 set ref 648* 655* 656* 658* 662 662 672* 674 674 681* 683 683 690* 693 702 706 920* 936* scale 0(12) based fixed bin(11,0) level 2 packed unaligned dcl 2019 set ref 734* scale_factor 000126 internal static fixed bin(71,0) dcl 1986 set ref 565* 719* 722 722 724 724* 726* 727* 734 921* 923* scale_seen 000143 internal static bit(1) unaligned dcl 1998 set ref 584* 712 924* search builtin function dcl 1919 ref 1391 1391 seen 2(01) based bit(1) level 3 in structure "directive" packed unaligned dcl 2-5 in procedure "mrds_rst_semantics" set ref 283* seen 1(01) based bit(1) level 3 in structure "directive" packed unaligned dcl 2-5 in procedure "mrds_rst_semantics" set ref 281* seen 4(01) based bit(1) level 3 in structure "directive" packed unaligned dcl 2-5 in procedure "mrds_rst_semantics" set ref 379* seen 3(01) based bit(1) level 3 in structure "directive" packed unaligned dcl 2-5 in procedure "mrds_rst_semantics" set ref 285* short 000152 internal static bit(1) unaligned dcl 2018 set ref 597 603 606 610 702* 705* 706* 708* sign_flag 000016 internal static bit(1) unaligned dcl 1922 set ref 885* 895* 905* 921 size parameter fixed bin(17,0) dcl 1803 set ref 1753 1759* size_seen 000131 internal static bit(1) unaligned dcl 1988 set ref 577* 1063 1063 skip_scanner_conversion 206(05) based bit(1) level 2 packed unaligned dcl 4-29 set ref 275* source based char unaligned dcl 1968 ref 1820 stack_pos parameter fixed bin(17,0) dcl 1911 in procedure "get_line_number" ref 1901 1905 stack_pos parameter fixed bin(17,0) dcl 1802 in procedure "list_duplicate" set ref 1753 1759* 1793* 1793* stack_pos parameter fixed bin(17,0) dcl 1856 in procedure "get_name" set ref 1812 1819 1820 1821 1828 1829* 1829* 1839 1840* 1840* stack_pos parameter fixed bin(17,0) dcl 1896 in procedure "get_fixed_value" set ref 1861 1865 1865 1874 1875* 1875* 1885* 1885* 1890 stack_ptr 16 based pointer level 3 dcl 5-11 set ref 520* stack_size 20 based fixed bin(17,0) level 3 dcl 5-11 set ref 521* stack_top 000100 automatic fixed bin(17,0) dcl 1960 set ref 330* 513* 537* 920 921 923 936 1069 1273 1284 1295 1306 1317 1329 1346 1348* 1362 1365* 1379 1382* 1391 1463 1464* 1465 1550 1562 1595* 1598* 1726* 1729* 1738* 1741* 1744* static_rsc_ptr 000106 internal static pointer dcl 1974 set ref 274* 277* 287* 310* 311* 423* 446* 459* 670* 680* 689* 718* 731* 753* 775* 997* 1138* 1154* 1410* 1458* 1469* 1482* 1521* 1585* 1593* 1612* 1674* 1724* 1740* 1796* 1832* 1843* 1878* 1888* stkp parameter pointer dcl 1920 ref 237 329 stmt based structure array level 1 unaligned dcl 2-37 set ref 289 stmt_ptr 000162 internal static pointer dcl 2-68 in procedure "mrds_rst_semantics" set ref 287* 288 289 290 291 292 293 294 295 296 297 298 299 300 301 382 387 396 407 428 451 451 1430 1444 1444 1470 1470 1487 1493 1522 1522 1642 1652 1679 1679 stmt_ptr 244 based pointer level 2 in structure "rsc" dcl 4-29 in procedure "mrds_rst_semantics" set ref 288* string_average_length 000123 internal static fixed bin(24,0) dcl 1982 set ref 547* 766 1074* string_length 000122 internal static fixed bin(24,0) dcl 1981 set ref 564* 761 1071* 1074 string_size based structure level 1 packed unaligned dcl 2023 substr builtin function dcl 2012 ref 1391 1820 symlen 2 based fixed bin(24,0) array level 2 dcl 1-3 set ref 1819 1828* symptr based pointer array level 2 dcl 1-3 ref 1820 sys_info$max_seg_size 000224 external static fixed bin(35,0) dcl 1969 ref 1820 temp_dir 134 based char(168) level 2 packed unaligned dcl 4-29 ref 308 temp_index 000307 automatic fixed bin(17,0) dcl 2016 set ref 1273* 1284* 1295* 1306* 1317* 1329* 1345* 1346 1361* 1362 1378* 1379 1550* 1562* 1610* 1615* 1626* temp_number 000304 automatic fixed bin(71,0) dcl 1983 set ref 1069* 1070* 1071 temp_source_ptr 000156 internal static pointer dcl 2027 set ref 311* token_num 15 based fixed bin(24,0) array level 2 dcl 1-3 set ref 1391 1821 1839* 1865 token_pos 000104 automatic fixed bin(24,0) dcl 1855 set ref 1821* 1837 type 0(01) based fixed bin(6,0) level 2 in structure "descriptor" packed unsigned unaligned dcl 3-6 in procedure "mrds_rst_semantics" set ref 491* 493* 504* 506* 597* 602* 603* 605* 606* 609* 610* 612* 615* 617* 620* 622* 625* 627* 630* 632* type based fixed bin(17,0) level 2 in structure "directive" dcl 2-5 in procedure "mrds_rst_semantics" set ref 279* 370 378* 382 387 396 407 428 451 451 1430 1444 1444 1470 1470 1487 1493 1522 1522 1642 1652 1679 1679 type_seen 000135 internal static bit(1) unaligned dcl 1992 set ref 578* 807 807 818 818 undefine 1 based structure level 2 packed unaligned dcl 2-5 unused 20(01) based bit(35) level 2 in structure "attribute_domain" packed unaligned dcl 5-77 in procedure "mrds_rst_semantics" set ref 1467* unused 12 based bit(36) level 2 in structure "item" packed unaligned dcl 5-150 in procedure "mrds_rst_semantics" set ref 1743* unused 14 based bit(36) level 2 in structure "relation" packed unaligned dcl 5-51 in procedure "mrds_rst_semantics" set ref 1599* unused 13 based bit(36) level 2 in structure "rel_index" packed unaligned dcl 5-107 in procedure "mrds_rst_semantics" set ref 1728* val 6 based fixed bin(71,0) array level 2 dcl 1-3 set ref 1865 1874* 1890* value 000612 automatic fixed bin(71,0) dcl 1895 set ref 1865* 1873* 1875* 1883 1885* 1889* 1893 varying_avg_length 11 based fixed bin(24,0) level 2 dcl 5-11 set ref 515* 766* version based bit(1) level 2 packed unaligned dcl 3-6 set ref 571* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. AND internal static fixed bin(17,0) initial dcl 1936 ATD internal static fixed bin(17,0) initial dcl 7-63 ATTR_INFO internal static fixed bin(17,0) initial dcl 7-59 ATTR_LIST internal static fixed bin(17,0) initial dcl 7-62 A_CONSTANT internal static fixed bin(17,0) initial dcl 2001 BIT_STRING internal static fixed bin(17,0) initial dcl 2003 BLOCKED internal static fixed bin(17,0) initial dcl 1944 CHANGER internal static fixed bin(17,0) initial dcl 7-52 CHAR_STRING internal static fixed bin(17,0) initial dcl 2004 CHILDREN internal static fixed bin(17,0) initial dcl 7-21 CHILD_LINK_INFO internal static fixed bin(17,0) initial dcl 7-61 COMP_NO_ARRAY internal static fixed bin(17,0) initial dcl 7-64 CONSTANT internal static fixed bin(17,0) initial dcl 7-50 CUR_LEX_TOP internal static fixed bin(17,0) initial dcl 7-36 DB_MODEL internal static fixed bin(17,0) initial dcl 7-45 DEFINE internal static fixed bin(17,0) initial dcl 2-29 DELETE_NAME internal static fixed bin(17,0) initial dcl 7-23 DISPLAY_INFO internal static fixed bin(17,0) initial dcl 7-82 DOMAIN_INFO internal static fixed bin(17,0) initial dcl 7-47 DOMAIN_VARIABLE internal static fixed bin(17,0) initial dcl 1940 DOM_LIST internal static fixed bin(17,0) initial dcl 7-24 DUP_PREV internal static fixed bin(17,0) initial dcl 7-66 ELEMENT internal static fixed bin(17,0) initial dcl 1941 EQUAL internal static fixed bin(17,0) initial dcl 1930 FILE internal static fixed bin(17,0) initial dcl 7-17 FILE_INFO internal static fixed bin(17,0) initial dcl 7-46 FILE_MODEL internal static fixed bin(17,0) initial dcl 7-57 FIXUP_TOKEN internal static fixed bin(17,0) initial dcl 7-37 FOREIGN_KEY internal static fixed bin(17,0) initial dcl 7-20 GL internal static fixed bin(17,0) initial dcl 7-72 GREATER internal static fixed bin(17,0) initial dcl 1932 GREATER_EQUAL internal static fixed bin(17,0) initial dcl 1934 LESS internal static fixed bin(17,0) initial dcl 1933 LESS_EQUAL internal static fixed bin(17,0) initial dcl 1935 LEX_STACK internal static fixed bin(17,0) initial dcl 7-34 LINK internal static fixed bin(17,0) initial dcl 7-19 LIST_OVRLY internal static fixed bin(17,0) initial dcl 7-75 MINUS internal static fixed bin(17,0) initial dcl 1939 MULTIPLIER internal static fixed bin(17,0) initial dcl 2000 NODE internal static fixed bin(17,0) initial dcl 7-77 NOT internal static fixed bin(17,0) initial dcl 1938 NOT_EQUAL internal static fixed bin(17,0) initial dcl 1931 NUMBER internal static fixed bin(17,0) initial dcl 2002 OR internal static fixed bin(17,0) initial dcl 1937 OUTPUT_TEXT internal static fixed bin(17,0) initial dcl 7-40 PARENT_LINK_INFO internal static fixed bin(17,0) initial dcl 7-60 PATH_ENTRY internal static fixed bin(17,0) initial dcl 7-48 P_STRUCT internal static fixed bin(17,0) initial dcl 7-35 REDEFINE internal static fixed bin(17,0) initial dcl 2-30 REL_INFO internal static fixed bin(17,0) initial dcl 7-58 RMDB internal static fixed bin(17,0) initial dcl 2005 SAVED_CHILD_COUNT internal static fixed bin(17,0) initial dcl 7-76 SEGINFO internal static fixed bin(17,0) initial dcl 7-74 SELECT_CHAIN internal static fixed bin(17,0) initial dcl 7-67 SL internal static fixed bin(17,0) initial dcl 7-73 SORT_KEY internal static fixed bin(17,0) initial dcl 7-65 STACK_ITEM internal static fixed bin(17,0) initial dcl 7-49 STRING_SOURCE internal static fixed bin(17,0) initial dcl 7-38 UNBLOCKED internal static fixed bin(17,0) initial dcl 1945 UNDEFINE internal static fixed bin(17,0) initial dcl 2-28 VERSION_STATUS internal static fixed bin(17,0) initial dcl 7-51 accum_token_ptr internal static pointer dcl 5-171 alloc_length internal static fixed bin(35,0) dcl 6-222 attdom_ptr automatic pointer dcl 5-84 changer based structure level 1 packed unaligned dcl 6-251 changer_ptr automatic pointer dcl 6-256 constant based structure level 1 unaligned dcl 6-216 constant_ptr automatic pointer dcl 6-220 cur_lex_top based fixed bin(24,0) array dcl 1-27 cur_lex_top_ptr automatic pointer dcl 1-29 db_model based structure level 1 dcl 6-72 dbm_ptr automatic pointer dcl 6-106 debug_sw internal static bit(1) initial unaligned dcl 1-17 delete_name based structure level 1 dcl 5-160 delete_name_ptr automatic pointer dcl 5-165 desc_ptr automatic pointer dcl 3-19 di_ptr automatic pointer dcl 6-155 dom_list based structure level 1 unaligned dcl 5-189 dom_list_ptr automatic pointer dcl 5-188 domain_info based structure level 1 dcl 6-125 domain_ptr automatic pointer dcl 5-45 fi_ptr automatic pointer dcl 6-119 file based structure level 1 dcl 5-89 file_info based structure level 1 dcl 6-113 file_ptr automatic pointer dcl 5-104 fixup_token based char unaligned dcl 5-178 foreign_key based structure level 1 dcl 5-139 forkey_ptr automatic pointer dcl 5-147 index_ptr automatic pointer dcl 5-115 link based structure level 1 dcl 5-118 link_ptr automatic pointer dcl 5-128 message_str based structure level 1 packed unaligned dcl 6-259 message_str_len automatic fixed bin(17,0) dcl 6-269 message_str_ptr automatic pointer dcl 6-267 mrds_data_$max_line_size external static fixed bin(35,0) dcl 5-173 output_text based varying char dcl 5-175 output_text_ptr internal static pointer dcl 5-177 p_struct based structure array level 1 dcl 1-19 p_struct_ptr automatic pointer dcl 1-24 path_entry based structure level 1 packed unaligned dcl 6-172 path_entry_ptr automatic pointer dcl 6-177 relation_ptr automatic pointer dcl 5-60 source_size automatic fixed bin(35,0) dcl 5-182 stack_item based structure level 1 unaligned dcl 6-206 stack_item_ptr automatic pointer dcl 6-212 string_source based char unaligned dcl 5-184 string_source_ptr automatic pointer dcl 5-183 token based varying char dcl 5-169 token_length automatic fixed bin(24,0) dcl 5-174 ua_ptr automatic pointer dcl 6-165 unreferenced_attribute based structure level 1 dcl 6-159 version_status based structure level 1 packed unaligned dcl 6-232 version_status_ptr automatic pointer dcl 6-246 NAMES DECLARED BY EXPLICIT CONTEXT. SKIP_ENTRIES 001506 constant label dcl 323 ref 237 domain_initialize 003273 constant entry internal dcl 509 ref 464 duplicate 005416 constant entry internal dcl 974 ref 807 818 829 840 851 862 914 931 948 959 1025 1032 1063 1087 1098 1113 1120 1250 1342 1358 1375 fixup_key_attribute 007122 constant entry internal dcl 1572 ref 1520 get_check_path_entry 006207 constant entry internal dcl 1337 ref 1278 1289 get_decode_path_entry 006512 constant entry internal dcl 1370 ref 1322 1334 get_encode_path_entry 006351 constant entry internal dcl 1353 ref 1300 1311 get_entry 006654 constant entry internal dcl 1387 ref 1346 1362 1379 get_fixed_value 010711 constant entry internal dcl 1861 ref 920 921 923 936 1069 get_index_attribute 007624 constant entry internal dcl 1734 ref 1695 1705 get_index_relation 007533 constant entry internal dcl 1720 ref 1685 get_line_number 011255 constant entry internal dcl 1901 ref 537 1465 1598 1626 1729 1744 1793 1793 1829 1829 1840 1840 1875 1875 1885 1885 get_name 010273 constant entry internal dcl 1812 ref 513 1345 1348 1361 1365 1378 1382 1463 1464 1595 1615 1726 1741 1759 get_relation_attribute 007373 constant entry internal dcl 1606 ref 1556 1568 get_relation_name 007277 constant entry internal dcl 1589 ref 1528 list_duplicate 007744 constant entry internal dcl 1753 ref 1610 1738 mrds_rst_semantics 001173 constant entry external dcl 237 mrds_rst_semantics$init 001221 constant entry external dcl 272 mrds_rst_semantics$rule_set 001203 constant entry external dcl 239 return_label 003272 constant label dcl 1716 ref 239 313 351 361 383 392 401 412 429 434 440 452 466 481 494 507 789 795 801 813 824 835 846 857 868 874 880 890 900 910 926 937 942 954 965 1020 1028 1035 1039 1045 1051 1057 1076 1081 1093 1104 1108 1116 1123 1175 1184 1188 1193 1198 1203 1208 1213 1236 1262 1279 1290 1301 1312 1323 1335 1435 1439 1449 1453 1471 1488 1498 1503 1509 1523 1533 1538 1544 1557 1569 1647 1657 1662 1668 1680 1690 1700 1710 rule_label 000000 constant label array(86) dcl 351 ref 339 set_declaration_defaults 003434 constant entry internal dcl 554 ref 465 1245 set_number_type 003471 constant entry internal dcl 591 ref 480 set_precision_and_scale 003651 constant entry internal dcl 644 ref 479 set_string_size_and_packing 005027 constant entry internal dcl 738 ref 486 499 string_size_check 005632 constant entry internal dcl 1125 ref 1070 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 12302 12534 11741 12312 Length 13376 11741 232 625 340 154 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME mrds_rst_semantics 1854 external procedure is an external procedure. domain_initialize internal procedure shares stack frame of external procedure mrds_rst_semantics. set_declaration_defaults internal procedure shares stack frame of external procedure mrds_rst_semantics. set_number_type internal procedure shares stack frame of external procedure mrds_rst_semantics. set_precision_and_scale internal procedure shares stack frame of external procedure mrds_rst_semantics. set_string_size_and_packing internal procedure shares stack frame of external procedure mrds_rst_semantics. duplicate internal procedure shares stack frame of external procedure mrds_rst_semantics. string_size_check internal procedure shares stack frame of external procedure mrds_rst_semantics. get_check_path_entry internal procedure shares stack frame of external procedure mrds_rst_semantics. get_encode_path_entry internal procedure shares stack frame of external procedure mrds_rst_semantics. get_decode_path_entry internal procedure shares stack frame of external procedure mrds_rst_semantics. get_entry internal procedure shares stack frame of external procedure mrds_rst_semantics. fixup_key_attribute internal procedure shares stack frame of external procedure mrds_rst_semantics. get_relation_name internal procedure shares stack frame of external procedure mrds_rst_semantics. get_relation_attribute internal procedure shares stack frame of external procedure mrds_rst_semantics. get_index_relation internal procedure shares stack frame of external procedure mrds_rst_semantics. get_index_attribute internal procedure shares stack frame of external procedure mrds_rst_semantics. list_duplicate internal procedure shares stack frame of external procedure mrds_rst_semantics. get_name 150 internal procedure uses returns(char(*)) or returns(bit(*)). get_fixed_value internal procedure shares stack frame of external procedure mrds_rst_semantics. get_line_number 65 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 rule_sw mrds_rst_semantics 000012 saved_attr_ptr mrds_rst_semantics 000014 saved_decode_descriptor mrds_rst_semantics 000015 descriptor_saved mrds_rst_semantics 000016 sign_flag mrds_rst_semantics 000017 max_string_size mrds_rst_semantics 000020 descr_ptr mrds_rst_semantics 000022 saved_descr_ptr mrds_rst_semantics 000024 decode_dcl_mesg mrds_rst_semantics 000027 db_model_path mrds_rst_semantics 000101 multiplier mrds_rst_semantics 000102 max_fixed_bin_17 mrds_rst_semantics 000104 max_fixed_bin_71 mrds_rst_semantics 000106 static_rsc_ptr mrds_rst_semantics 000110 index_list_ptr mrds_rst_semantics 000112 relation_list_ptr mrds_rst_semantics 000114 attribute_list_ptr mrds_rst_semantics 000116 domain_list_ptr mrds_rst_semantics 000120 definition_order mrds_rst_semantics 000121 key_order mrds_rst_semantics 000122 string_length mrds_rst_semantics 000123 string_average_length mrds_rst_semantics 000124 saved_precision mrds_rst_semantics 000126 scale_factor mrds_rst_semantics 000130 avg_length_seen mrds_rst_semantics 000131 size_seen mrds_rst_semantics 000132 decode_proc_seen mrds_rst_semantics 000133 encode_proc_seen mrds_rst_semantics 000134 check_seen mrds_rst_semantics 000135 type_seen mrds_rst_semantics 000136 representation_seen mrds_rst_semantics 000137 base_seen mrds_rst_semantics 000140 precision_seen mrds_rst_semantics 000141 alignment_seen mrds_rst_semantics 000142 fixed_varying_seen mrds_rst_semantics 000143 scale_seen mrds_rst_semantics 000144 decode_dcl_seen mrds_rst_semantics 000145 decimal mrds_rst_semantics 000146 real mrds_rst_semantics 000147 float mrds_rst_semantics 000150 aligned mrds_rst_semantics 000151 nonvarying mrds_rst_semantics 000152 short mrds_rst_semantics 000154 name_ptr mrds_rst_semantics 000156 temp_source_ptr mrds_rst_semantics 000160 directive_ptr mrds_rst_semantics 000162 stmt_ptr mrds_rst_semantics STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME get_line_number 000100 line_number get_line_number get_name 000100 length get_name 000102 name_overlay_ptr get_name 000104 token_pos get_name mrds_rst_semantics 000100 stack_top mrds_rst_semantics 000101 message mrds_rst_semantics 000302 message_length mrds_rst_semantics 000304 temp_number mrds_rst_semantics 000306 i mrds_rst_semantics 000307 temp_index mrds_rst_semantics 000310 key_attribute mrds_rst_semantics 000312 lex_stack_ptr mrds_rst_semantics 000314 num_dims mrds_rst_semantics 000316 attribute_ptr mrds_rst_semantics 000320 children_ptr mrds_rst_semantics 000322 item_ptr mrds_rst_semantics 000370 duplication duplicate 000430 entryname get_entry 000440 entry_portion get_entry 000560 duplicate_type list_duplicate 000572 name list_duplicate 000602 name_duplicate list_duplicate 000612 value get_fixed_value THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return_mac shorten_stack ext_entry int_entry int_entry_desc return_chars_eis any_to_any_truncate_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ioa_ ioa_$rs mrds_rst_attribute_cleanup mrds_rst_attribute_handler mrds_rst_domain_handler mrds_rst_error mrds_rst_file_cleanup mrds_rst_index_handler mrds_rst_relation_handler mrds_rst_rsc_alloc THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. mrds_data_$max_string_size mrds_error_$rst_bad_declaration mrds_error_$rst_bad_semantics mrds_error_$rst_inconsis_option mrds_error_$rst_name_duplicate mrds_error_$rst_name_too_long mrds_error_$rst_no_key_attr mrds_error_$rst_option_limit sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 3 20 001163 237 001166 237 001201 239 001202 239 001211 239 001215 272 001216 274 001227 275 001234 277 001240 278 001252 279 001260 280 001261 281 001264 282 001266 283 001270 284 001272 285 001274 287 001276 288 001310 289 001316 290 001323 291 001330 292 001331 293 001332 294 001333 295 001334 296 001335 297 001336 298 001337 299 001340 300 001341 301 001342 302 001343 304 001345 305 001350 306 001376 308 001425 310 001457 311 001472 313 001505 323 001506 329 001507 330 001513 334 001515 335 001521 339 001537 351 001542 361 001543 370 001544 378 001547 379 001551 380 001554 382 001556 383 001563 387 001564 392 001572 396 001573 401 001601 407 001602 412 001610 423 001611 428 001620 429 001626 434 001627 440 001630 446 001631 451 001642 452 001647 459 001650 464 001663 465 001664 466 001674 471 001675 477 001703 479 001705 480 001706 481 001707 486 001710 491 001711 493 001721 494 001725 499 001726 504 001727 506 001737 507 001743 789 001744 795 001745 801 001746 807 001747 812 001765 813 001770 818 001771 823 002007 824 002011 829 002012 834 002030 835 002032 840 002033 845 002051 846 002054 851 002055 856 002072 857 002074 862 002075 867 002112 868 002115 874 002116 880 002117 885 002120 890 002122 895 002123 900 002126 905 002127 910 002131 914 002132 920 002150 921 002166 923 002212 924 002227 926 002232 931 002233 936 002251 937 002267 942 002270 948 002271 953 002311 954 002314 959 002315 964 002335 965 002337 1020 002340 1025 002341 1027 002361 1028 002363 1032 002364 1034 002404 1035 002407 1039 002410 1045 002411 1051 002412 1057 002413 1063 002414 1069 002433 1070 002451 1071 002453 1072 002456 1073 002457 1074 002465 1076 002466 1081 002467 1087 002470 1092 002510 1093 002512 1098 002513 1103 002533 1104 002536 1108 002537 1113 002540 1115 002560 1116 002562 1120 002563 1122 002603 1123 002606 1170 002607 1175 002613 1179 002614 1184 002620 1188 002621 1193 002622 1198 002623 1203 002624 1208 002625 1213 002626 1225 002627 1230 002632 1234 002633 1235 002636 1236 002641 1240 002642 1245 002645 1250 002654 1251 002671 1252 002674 1253 002677 1255 002700 1256 002704 1261 002705 1262 002712 1273 002713 1278 002716 1279 002717 1284 002720 1289 002722 1290 002723 1295 002724 1300 002727 1301 002730 1306 002731 1311 002733 1312 002734 1317 002735 1322 002740 1323 002741 1329 002742 1334 002744 1335 002745 1430 002746 1435 002754 1439 002755 1444 002756 1449 002763 1453 002764 1458 002765 1463 003000 1464 003036 1465 003072 1466 003106 1467 003112 1469 003114 1470 003124 1471 003131 1482 003132 1487 003141 1488 003147 1493 003150 1498 003156 1503 003157 1509 003160 1515 003161 1520 003165 1521 003166 1522 003177 1523 003204 1528 003205 1533 003206 1538 003207 1544 003210 1550 003211 1555 003213 1556 003214 1557 003215 1562 003216 1567 003221 1568 003223 1569 003224 1642 003225 1647 003233 1652 003234 1657 003242 1662 003243 1668 003244 1674 003245 1679 003256 1680 003263 1685 003264 1690 003265 1695 003266 1700 003267 1705 003270 1710 003271 1716 003272 509 003273 513 003274 514 003327 515 003331 516 003332 517 003334 518 003336 519 003340 520 003342 521 003344 522 003346 523 003350 524 003352 525 003355 526 003360 527 003362 528 003364 529 003367 530 003372 531 003374 532 003376 533 003401 534 003404 535 003406 536 003410 537 003411 542 003421 543 003423 544 003424 545 003425 546 003426 547 003430 548 003431 549 003432 552 003433 554 003434 559 003436 560 003440 561 003441 562 003443 563 003444 564 003445 565 003447 569 003451 571 003453 572 003455 573 003457 577 003460 578 003461 579 003462 580 003463 581 003464 582 003465 583 003466 584 003467 589 003470 591 003471 597 003472 602 003510 603 003515 605 003524 606 003531 609 003542 610 003547 612 003556 613 003563 615 003567 617 003576 618 003602 620 003603 622 003612 623 003616 624 003617 625 003621 627 003630 628 003634 630 003635 632 003644 635 003650 644 003651 648 003652 655 003664 656 003667 658 003674 662 003677 666 003714 670 004014 672 004053 673 004057 674 004060 676 004071 680 004171 681 004230 682 004234 683 004235 685 004246 689 004346 690 004405 693 004411 701 004420 702 004423 705 004434 706 004436 708 004445 712 004446 714 004453 718 004553 719 004612 722 004616 724 004630 726 004635 727 004637 731 004756 732 005015 734 005016 736 005026 738 005027 743 005030 745 005036 746 005040 748 005043 749 005045 753 005145 754 005204 757 005205 759 005213 761 005215 765 005224 766 005232 768 005240 770 005243 775 005355 776 005414 778 005415 974 005416 978 005427 982 005436 983 005441 984 005442 990 005443 991 005445 997 005564 998 005623 1000 005624 1125 005632 1129 005634 1132 005642 1138 005772 1139 006031 1146 006037 1148 006043 1149 006045 1154 006146 1155 006205 1159 006206 1337 006207 1342 006210 1344 006227 1345 006233 1346 006266 1348 006314 1349 006347 1351 006350 1353 006351 1358 006352 1360 006370 1361 006374 1362 006427 1365 006455 1366 006510 1368 006511 1370 006512 1375 006513 1377 006532 1378 006536 1379 006571 1382 006617 1383 006652 1385 006653 1387 006654 1391 006665 1399 006730 1403 006740 1404 006756 1406 006762 1410 007050 1411 007107 1413 007110 1414 007114 1572 007122 1576 007123 1577 007127 1578 007131 1580 007133 1585 007236 1587 007275 1589 007277 1593 007300 1594 007313 1595 007316 1596 007351 1597 007353 1598 007354 1599 007364 1600 007367 1601 007370 1602 007371 1604 007372 1606 007373 1610 007374 1612 007421 1613 007434 1614 007436 1615 007441 1616 007473 1617 007500 1618 007502 1619 007504 1620 007506 1623 007512 1624 007513 1626 007515 1627 007525 1628 007530 1631 007532 1720 007533 1724 007534 1725 007547 1726 007552 1727 007605 1728 007607 1729 007610 1730 007620 1732 007623 1734 007624 1738 007625 1740 007652 1741 007665 1742 007717 1743 007722 1744 007724 1745 007734 1746 007737 1747 007741 1751 007743 1753 007744 1758 007746 1759 007747 1763 007777 1765 010010 1768 010017 1769 010022 1774 010024 1775 010030 1779 010044 1780 010047 1782 010056 1783 010060 1786 010061 1787 010063 1788 010065 1790 010077 1792 010107 1793 010114 1796 010223 1797 010262 1798 010263 1800 010264 1812 010272 1819 010300 1820 010310 1821 010321 1825 010324 1827 010331 1828 010333 1829 010334 1832 010456 1833 010516 1837 010517 1839 010522 1840 010532 1843 010634 1844 010674 1846 010675 1848 010702 1861 010711 1865 010713 1873 010725 1874 010727 1875 010731 1878 011023 1879 011062 1883 011063 1885 011070 1888 011200 1889 011237 1890 011243 1893 011251 1901 011254 1905 011262 1907 011271 ----------------------------------------------------------- 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