COMPILATION LISTING OF SEGMENT linus_lila_from Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 07/29/86 1003.0 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 linus_lila_from: 19 proc (lcb_ptr, lsh_ptr, td_ptr, code); 20 21 /* DESCRIPTION: 22* 23* This procedure translates the FROM clause of a LILA block into a tuple 24* variable and relation name which can be added to a MRDS -range clause. 25* 26* 27* 28* HISTORY: 29* 30* 77-07-01 J. A. Weeldreyer: Initially written. 31* 32* 78-02-01 J. A. Weeldreyer: Modified to correctly recognize tables and row 33* designators defined in outer blocks. 34* 35* 78-07-01 J. A. Weeldreyer: Modified to assign generated variables to all 36* tables in from list. 37* 38* 79-02-01 J. C. C. Jagernauth: Modified to access version 4 resultant 39* information. 40* 41* 80-01-08 Rickie E. Brinegar: Modified to pass linus_lila_alloc_lit a ptr to 42* a descriptor instead of an assign_ descriptor type and eliminate the assign_ 43* length parameter. 44* 45* 80-04-13 Rickie E. Brinegar: Modified to use a work area defined on 46* lcb.lila_area_ptr instead of getting system free area. 47* 48* 80-09-15 Rickie E. Brinegar: Modified to use linus_rel_array instead of 49* dsl_$get_rslt_info. 50* 51* 81-02-03 Rickie E. Brinegar: The rel builtin was added to the declarations. 52* Modified to use the new linus_rel_array structure. 53* 54* 81-10-07 Rickie E. Brinegar: Changed to set ls_header.from_token to "1"b 55* on entry and reset ls_header.from_token to "0"b on exit. This is in 56* response to TR11628. 57* 58**/ 59 1 1 /* BEGIN INCLUDE FILE linus_lcb.incl.pl1 -- jaw 8/30/77 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(86-04-23,Dupuis), approve(86-05-23,MCR7188), audit(86-07-23,GWMay), 1 7* install(86-07-29,MR12.0-1106): 1 8* Added general_work_area_ptr and renamed sfr_ptr to 1 9* force_retrieve_scope_ptr. 1 10* END HISTORY COMMENTS */ 1 11 1 12 1 13 /* HISTORY: 1 14* 1 15* 78-09-29 J. C. C. Jagernauth: Modified for MR7.0. 1 16* 1 17* 81-05-11 Rickie E. Brinegar: added security bit and andministrator bit as 1 18* a part of the attribute level control work. 1 19* 1 20* 81-06-17 Rickie E. Brinegar: deleted the sd_ptr as a part of removing the 1 21* scope_data structure from LINUS. LINUS now depends totally on MRDS for 1 22* scope information. 1 23* 1 24* 81-11-11 Rickie E. Brinegar: added the timing bit and three fields for 1 25* retaining various vcpu times to be collected when in timing mode. The 1 26* times to be collected are: LINUS parsing time, LINUS processing time, and 1 27* MRDS processing time. 1 28* 1 29* 82-01-15 DJ Schimke: Added the build_increment and build_start fields as 1 30* part of the line numbering implementation. This allows for possible later 1 31* LINUS control of the build defaults. 1 32* 1 33* 82-03-01 Paul W. Benjamin: Removed linus_prompt_chars_ptr, as that 1 34* information is now retained by ssu_. Removed parse_timer as no longer 1 35* meaningful. Added linus_version. Added iteration bit. Added 6 entry 1 36* variables for ssu_ replaceable procedures. Added actual_input_iocbp. 1 37* 1 38* 82-06-23 Al Dupuis: Added subsystem_control_info_ptr, 1 39* subsystem_invocation_level, and selection_expression_identifier. 1 40* 1 41* 82-08-26 DJ Schimke: Added report_control_info_ptr, and 1 42* table_control_info_ptr. 1 43* 1 44* 82-10-19 DJ Schimke: Added ssu_abort_line. 1 45* 1 46* 83-06-06 Bert Moberg: Added print_search_order (pso) and no_optimize (no_ot) 1 47* 1 48* 83-04-07 DJ Schimke: Added temp_seg_info_ptr. 1 49* 1 50* 83-08-26 Al Dupuis: Added query_temp_segment_ptr. 1 51**/ 1 52 1 53 dcl 1 lcb aligned based (lcb_ptr), /* LINUS control block */ 1 54 2 db_index fixed bin (35), /* index of open data base, or 0 */ 1 55 2 rb_len fixed bin (21), /* length of request buffer */ 1 56 2 lila_count fixed bin (35), /* number of LILA text lines */ 1 57 2 lila_chars fixed bin (35), /* number of LILA source test chars */ 1 58 2 trans_id fixed bin (35), /* used by checkpoint and rollback facilities (MR7.0) */ 1 59 2 lila_fn char (32) unal, /* entry name of lila data file */ 1 60 2 prompt_flag bit (1) unal, /* on if in prompt mode */ 1 61 2 test_flag bit (1) unal, /* on if in test mode */ 1 62 2 new_version bit (1) unal init (1), /* on for new version data base (MR7.0) */ 1 63 2 secured_db bit (1) unal, /* on if the db is in a secure state */ 1 64 2 administrator bit (1) unal, /* on if the user is a db administrator */ 1 65 2 timing_mode bit (1) unal, /* on if timing is to be done */ 1 66 2 iteration bit (1) unal, /* interpret parens as iteration sets */ 1 67 2 pso_flag bit (1) unal, /* add print_search_order to select */ 1 68 2 no_ot_flag bit (1) unal, /* add no_optimize to select */ 1 69 2 reserved bit (27) unal, 1 70 2 liocb_ptr ptr, /* iocb ptr for lila file */ 1 71 2 rb_ptr ptr, /* ptr to request buffer */ 1 72 2 is_ptr ptr, /* iocb ptr for currentinput stream switch */ 1 73 2 cal_ptr ptr, /* ptr to current arg list for invoke (or null) */ 1 74 2 ttn_ptr ptr, /* pointer to table info structure */ 1 75 2 force_retrieve_scope_info_ptr ptr, /* structure pointer to force retrieve scope operation */ 1 76 2 lv_ptr ptr, /* pointer linus variables */ 1 77 2 si_ptr ptr, /* pointer to select_info structure */ 1 78 2 setfi_ptr ptr, /* pointer to set function information */ 1 79 2 sclfi_ptr ptr, /* pointer to user declared scalar fun. names */ 1 80 2 ivs_ptr ptr, /* pointer to stack of invoke iocb pointers */ 1 81 2 lit_ptr ptr, /* pointer to literal pool */ 1 82 2 lvv_ptr ptr, /* pointer to linus variable alloc. pool */ 1 83 2 rd_ptr ptr, /* point to readied files mode information (MR7.0) */ 1 84 2 rt_ptr ptr, /* point to table of relation names and their readied modes 1 85* (MR7.0) */ 1 86 2 actual_input_iocbp ptr, /* ptr to input while in macros */ 1 87 2 lila_promp_chars_ptr ptr, /* pointer to the prompt characters for lila */ 1 88 2 linus_area_ptr ptr, /* LINUS temporary segment pointer */ 1 89 2 lila_area_ptr ptr, /* LILA temporary segment pointer */ 1 90 2 i_o_area_ptr ptr, /* temporary segment pointer used by write, print, create_list */ 1 91 2 rel_array_ptr ptr, /* ptr to array of names rslt info structure 1 92* for current lila expression */ 1 93 2 unused_timer float bin (63), /* future expansion */ 1 94 2 request_time float bin (63), /* How much request time was spent 1 95* in LINUS. (-1 = user has just enabled 1 96* timing, do not report) */ 1 97 2 mrds_time float bin (63), /* How much time was spent in MRDS */ 1 98 2 build_increment fixed bin, /* default increment for build mode */ 1 99 2 build_start fixed bin, /* default start count for build mode */ 1 100 2 linus_version char (4), /* current version of LINUS */ 1 101 2 subsystem_control_info_ptr ptr, /* the same ptr passed by ssu_ to each request procedure */ 1 102 2 subsystem_invocation_level fixed bin, /* identifies this invocation of LINUS */ 1 103 2 selection_expression_identifier fixed bin, /* identifies the current processed selection expression */ 1 104 2 report_control_info_ptr ptr, /* pointer to linus_report_control_info structure */ 1 105 2 table_control_info_ptr ptr, /* pointer to linus_table control structure */ 1 106 2 temp_seg_info_ptr ptr, /* pointer to linus_temp_seg_mgr control structure */ 1 107 2 query_temp_segment_ptr ptr, /* points to temp seg used for manipulating query */ 1 108 2 general_work_area_ptr ptr, /* a freeing area for general use */ 1 109 2 word_pad (6) bit (36) unal, 1 110 /* procedures that will be optionally */ 1 111 /* replaced by the user. Saved so they */ 1 112 /* can be reinstated if desired. */ 1 113 2 ssu_abort_line entry options (variable), 1 114 2 ssu_post_request_line variable entry (ptr), 1 115 2 ssu_pre_request_line variable entry (ptr), 1 116 1 117 2 curr_lit_offset fixed bin (35), /* index of first free bit in lit. pool */ 1 118 2 curr_lv_val_offset fixed bin (35), /* index of first free bit lv. val. pool */ 1 119 2 static_area area (sys_info$max_seg_size - fixed (rel (addr (lcb.static_area))) + 1); 1 120 1 121 dcl lcb_ptr ptr; 1 122 1 123 /* END INCLUDE FILE linus_lcb.incl.pl1 */ 60 61 2 1 /* BEGIN INCLUDE FILE linus_ls_block.incl.pl1 -- jaw 8/7/78 */ 2 2 2 3 dcl 1 ls_block aligned based (lsb_ptr), /* lila stack frame for outer lila block */ 3 1 /* BEGIN INCLUDE FILE linus_ls_common.incl.pl1 -- jaw 7/12/77 */ 3 2 3 3 2 type fixed bin, /* type of frame: 3 4* 1 => header, 3 5* 2 => set value, 3 6* 3 => lila set, 3 7* 4 => lila block */ 3 8 2 back_ptr ptr, /* pointer to previous frame */ 3 9 2 fwd_ptr ptr, /* pointer to next frame */ 3 10 3 11 /* END INCLUDE FILE linus_ls_common.incl.pl1 */ 2 4 2 5 2 reserved bit (36) unal, 2 6 2 ib_level fixed bin, /* current depth of inner blocks */ 2 7 2 nrs_chars fixed bin, /* total chars. in range strings */ 2 8 2 nritems fixed bin, /* current number of range items */ 2 9 2 range_items (linus_data_$max_range_items), 2 10 3 tup_var char (32) var, /* name of linus tuple variable */ 2 11 3 mrds_var char (32) var, /* name of mrds tuple variable */ 2 12 3 rel_name char (32) var, /* name of relation */ 2 13 3 rel_index fixed bin (35), /* rel. index if temp tab */ 2 14 3 level fixed bin, /* level of block generating item */ 2 15 3 arg_ptr ptr, 2 16 3 desc_ptr ptr, 2 17 2 nselects fixed bin, /* number of select items currently defined */ 2 18 2 sel_items (mrds_data_$max_select_items) char (mrds_data_$max_token_size) var, /* the mrds select items */ 2 19 2 nprops fixed bin, /* number of operators in pred stack */ 2 20 2 pred_op_stack (linus_data_$max_pred_stack_size), 2 21 3 key fixed bin (17) unal, 2 22 3 p_cnt fixed bin (17) unal, /* current paren count */ 2 23 2 pred_pcnt fixed bin, /* current paren. count in predicate */ 2 24 2 term_op fixed bin, /* rel. op. for current term */ 2 25 2 nterms fixed bin, /* no. of terms currently in term stack */ 2 26 2 dflt_ritem fixed bin, /* index of range item to be used for default */ 2 27 2 nrange_args fixed bin, /* no. of args for temp rel indexes */ 2 28 2 rs_hd_ptr ptr, /* pointer to head of range strings */ 2 29 2 term_hd_ptr ptr, /* pointer to top item in term stack */ 2 30 2 leaf_ptr (2) ptr; /* ptr to mrds block for each leaf of current term */ 2 31 2 32 dcl lsb_ptr ptr; 2 33 2 34 /* END INCLUDE FILE linus_ls_block.incl.pl1 */ 62 63 4 1 /* BEGIN INCLUDE FILE linus_ls_header.incl.pl1 -- jaw 7/28/77 */ 4 2 4 3 dcl 1 ls_header aligned based (lsh_ptr), /* header for LILA stack */ 5 1 /* BEGIN INCLUDE FILE linus_ls_common.incl.pl1 -- jaw 7/12/77 */ 5 2 5 3 2 type fixed bin, /* type of frame: 5 4* 1 => header, 5 5* 2 => set value, 5 6* 3 => lila set, 5 7* 4 => lila block */ 5 8 2 back_ptr ptr, /* pointer to previous frame */ 5 9 2 fwd_ptr ptr, /* pointer to next frame */ 5 10 5 11 /* END INCLUDE FILE linus_ls_common.incl.pl1 */ 4 4 4 5 2 cur_ptr ptr, /* pointer to current frame */ 4 6 2 src_ptr ptr, /* pointer to LILA source string */ 4 7 2 trans_failed bit (1) unal, /* on if translate failed */ 4 8 2 from_token bit (1) unal, /* on if the calling routine is linus_lila_from */ 4 9 2 reserved bit (34) unal, 4 10 2 cur_pos fixed bin (35), /* current position in source string */ 4 11 2 line_data (0 : lcb.lila_count), /* data for each source line */ 4 12 3 lno char (4), /* line number */ 4 13 3 last_char fixed bin (35); /* index of last char */ 4 14 4 15 dcl lsh_ptr ptr; 4 16 4 17 /* END INCLUDE FILE linus_ls_header.incl.pl1 */ 64 65 6 1 /* BEGIN INCLUDE FILE linus_ls_set.incl.pl1 -- jaw 7/27/78 */ 6 2 6 3 dcl 1 ls_set aligned based (lss_ptr), /* lila stack frame for lila set */ 7 1 /* BEGIN INCLUDE FILE linus_ls_common.incl.pl1 -- jaw 7/12/77 */ 7 2 7 3 2 type fixed bin, /* type of frame: 7 4* 1 => header, 7 5* 2 => set value, 7 6* 3 => lila set, 7 7* 4 => lila block */ 7 8 2 back_ptr ptr, /* pointer to previous frame */ 7 9 2 fwd_ptr ptr, /* pointer to next frame */ 7 10 7 11 /* END INCLUDE FILE linus_ls_common.incl.pl1 */ 6 4 6 5 2 nselects fixed bin, /* number of items selected */ 6 6 2 nblocks fixed bin, /* number of lila blocks in stack */ 6 7 2 nops fixed bin, /* number of set operators in stack */ 6 8 2 op_stack (linus_data_$max_set_stack_size), /* the set op stack */ 6 9 3 br_cnt fixed bin (17) unal, /* bracket count of oper. */ 6 10 3 key fixed bin (17) unal, /* token key of operator */ 6 11 2 br_cnt fixed bin, /* current bracket count */ 6 12 2 dup_flag bit (1) unal, /* on if DUP encountered */ 6 13 2 unique_flag bit (1) unal, /* on if UNIQUE encountered */ 6 14 2 rb_flag bit (1) unal, /* on if right bracket allowed */ 6 15 2 lb_flag bit (1) unal, /* on if left bracket allowed */ 6 16 2 setop_flag bit (1) unal, /* on if set op allowed */ 6 17 2 select_flag bit (1) unal, /* on if lila block allowed */ 6 18 2 end_flag bit (1) unal, /* on if end of set allowed */ 6 19 2 first_block bit (1) unal, /* on if no lila block yet processed */ 6 20 2 inv_setop bit (1) unal, /* on if a lila block cannot be included in a set oper. */ 6 21 2 reserved bit (9) unal, 6 22 2 var_ind fixed bin (17) unal, /* number for next generated variable */ 6 23 2 domain_info (mrds_data_$max_select_items), /* domain info for each selected attr. */ 6 24 3 name char (32), /* domain name */ 6 25 3 bit_length fixed bin (35), /* bit length of domain */ 6 26 3 desc bit (36), /* descriptor for domain */ 6 27 3 assn_ptr ptr, /* ptr to receiving field for this attr. */ 6 28 3 assn_type fixed bin, /* assign_ type code for this domain */ 6 29 3 assn_len fixed bin (35), /* assign_ length for this domain */ 6 30 2 si_ptr ptr, /* pointer to select info structure */ 6 31 2 blk_hd_ptr ptr; /* pointer to top item of block stack */ 6 32 6 33 dcl lss_ptr ptr; 6 34 6 35 /* END INCLUDE FILE linus_ls_set.incl.pl1 */ 66 67 8 1 /* BEGIN INCLUDE FILE -- linus_rel_array.incl.pl1 -- reb 09/09/80 8 2* 8 3* 80-09-09 Rickie E. Brinegar: Initially written. 8 4* 8 5* 81-01-29 Rickie E. Brinegar: changed to comform to standards for include 8 6* files. 8 7* 8 8**/ 8 9 8 10 dcl 1 linus_rel_array based (linus_rel_array_ptr), 8 11 2 num_of_rels fixed bin, 8 12 2 rels (num_of_rels_init refer (linus_rel_array.num_of_rels)), 8 13 3 rel_name char (32), 8 14 3 rslt_info_ptr ptr; 8 15 8 16 dcl linus_rel_array_ptr ptr; 8 17 8 18 dcl num_of_rels_init fixed bin init (0); 8 19 8 20 /* END INCLUDE FILE linus_rel_array.incl.pl1 */ 8 21 68 69 9 1 /* BEGIN INCLUDE FILE linus_temp_tab_names.incl.pl1 -- jaw 6/16/77 */ 9 2 9 3 dcl temp_tab_names (mrds_data_$max_temp_rels) char (32) based (ttn_ptr); /* names of temp rels in slot corr. to rel. index */ 9 4 9 5 dcl ttn_ptr ptr; 9 6 9 7 /* END INCLUDE FILE linus_temp_tab_names.incl.pl1 */ 70 71 10 1 /* BEGIN INCLUDE FILE linus_token_data.incl.pl1 -- jaw 8/7/78 */ 10 2 10 3 dcl 1 token_data aligned based (td_ptr), /* data for lila tokens */ 10 4 2 key fixed bin (17) unal, /* key of token */ 10 5 2 must_free bit (1) unal, /* on if value must be freed */ 10 6 2 temp_tab bit (1) unal, /* on if temporary table */ 10 7 2 reserved bit (16) unal, 10 8 2 mvar char (32) var, /* mrds variable if identifier */ 10 9 2 lvar char (32) var, /* linus variable if identifier */ 10 10 2 length fixed bin (35), /* char length of token value */ 10 11 2 t_ptr ptr; /* points to token value */ 10 12 10 13 dcl ((NULL init (0)), 10 14 (RP init (1)), 10 15 (COL_SPEC init (2)), 10 16 (LINUS_VAR init (3)), 10 17 (CONST init (4)), 10 18 (SET_FN init (5)), 10 19 (SCAL_FN init (6)), 10 20 (LP init (7)), 10 21 (STAR init (8)), 10 22 (DIV init (9)), 10 23 (PLUS init (10)), 10 24 (MINUS init (11)), 10 25 (TAB_NAME init (12)), 10 26 (ROW_TAB_PAIR init (13)), 10 27 (UNION init (14)), 10 28 (INTER init (15)), 10 29 (DIFFER init (16)), 10 30 (ROW_DES init (17)), 10 31 (LB init (18)), 10 32 (RB init (19)), 10 33 (SELECT init (20)), 10 34 (NOT init (21)), 10 35 (AND init (22)), 10 36 (OR init (23)), 10 37 (EQ init (24)), 10 38 (NE init (25)), 10 39 (GT init (26)), 10 40 (GE init (27)), 10 41 (LT init (28)), 10 42 (LE init (29)), 10 43 (FROM init (30)), 10 44 (WHERE init (31)), 10 45 (DUP init (32)), 10 46 (UNIQUE init (33)), 10 47 (COMMA init (34))) fixed bin int static options (constant); 10 48 10 49 dcl td_ptr ptr; 10 50 10 51 /* END INCLUDE FILE linus_token_data.incl.pl1 */ 72 73 11 1 /* BEGIN INCLUDE FILE mrds_rslt_info.incl.pl1 rgl 07/22/77 */ 11 2 11 3 /* Modified by R. Lackey 09/20/76 to handle inverted attributes */ 11 4 11 5 /* Modified by D. Woodka 06/28/82 to fix size condition */ 11 6 11 7 dcl 1 rslt_info aligned based (rslt_ptr), /* resultant information description */ 11 8 2 num_attr fixed bin, /* number of attributes in view */ 11 9 2 num_key_attr fixed bin, /* number of key attributes in data relation */ 11 10 2 key_length fixed bin (35), /* length in bits of key portion of tuple */ 11 11 2 retrieve bit (1) unal, /* retrieve permitted = "1"b */ 11 12 2 modify bit (1) unal, /* modify permitted = "1"b */ 11 13 2 store bit (1) unal, /* store permitted = "1"b */ 11 14 2 delete bit (1) unal, /* delete permitted = "1"b */ 11 15 2 total_key bit (1) unal, /* on if view includes the total key */ 11 16 2 inversion bit (1) unal, /* On if this view contains any inverted attributes */ 11 17 2 reserved bit (30) unal, /* reserved for future use */ 11 18 2 attr (rslt_alloc refer (rslt_info.num_attr)), /* per attribute info */ 11 19 3 attr_name char (32), /* name of attribute */ 11 20 3 domain_name char (32), /* name of underlying domain */ 11 21 3 attr_length fixed bin (18), /* length of attribute data in bits */ 11 22 3 attr_index fixed bin (24), /* index to bit_offset in dbcbrw */ 11 23 3 descriptor bit (36) aligned, /* attribute description */ 11 24 3 key_flag bit (1) unal, /* key attribute = "1"b */ 11 25 3 inver_flag bit (1) unal, /* On if this attribute is inverted */ 11 26 3 unused bit (34) unal, /* reserved for future use */ 11 27 3 key_attr_order fixed bin, /* order no. of this key attr. */ 11 28 3 inver_iocb_index fixed bin; /* Index to inversion iocb in dbcbw */ 11 29 11 30 11 31 11 32 dcl rslt_ptr ptr; 11 33 11 34 dcl rslt_alloc fixed bin; 11 35 11 36 /* END INCLUDE FILE mrds_rslt_info.incl.pl1 */ 11 37 74 75 76 dcl ( 77 code, /* Output: status code */ 78 icode 79 ) fixed bin (35); /* internal status code */ 80 dcl gen_var char (6); /* generated variable */ 81 dcl i fixed bin; /* internal index */ 82 dcl token char (token_data.length) based (token_data.t_ptr); 83 /* value of token */ 84 dcl tab_found bit (1); 85 86 dcl FB35_DESC bit (36) int static options (constant) 87 init ("100000100000000000000000000000100011"b); 88 89 dcl ( 90 linus_data_$max_pred_stack_size, 91 linus_data_$max_range_items, 92 linus_data_$max_set_stack_size, 93 linus_error_$cant_alloc_lit, 94 linus_error_$no_from, 95 linus_error_$no_table_list, 96 linus_error_$range_ovfl, 97 linus_error_$undef_tab, 98 mrds_data_$max_select_items, 99 mrds_data_$max_temp_rels, 100 mrds_data_$max_token_size, 101 sys_info$max_seg_size 102 ) fixed bin (35) ext; 103 104 dcl (addr, fixed, index, null, rel, substr) builtin; 105 106 dcl linus_lila_alloc_lit entry (ptr, ptr, ptr, fixed bin (35)); 107 dcl linus_lila_error entry (ptr, ptr, fixed bin (35), char (*)); 108 dcl linus_lila_get_token entry (ptr, ptr, fixed bin (35), ptr, fixed bin (35)); 109 110 ls_header.from_token = "1"b; 111 linus_rel_array_ptr = lcb.rel_array_ptr; 112 lsb_ptr = ls_header.cur_ptr; /* init */ 113 lss_ptr = ls_block.back_ptr; 114 if token_data.key = NULL then do; /* must get new token */ 115 call 116 linus_lila_get_token (lcb_ptr, lsh_ptr, ls_header.cur_pos, td_ptr, 117 icode); 118 if icode ^= 0 then 119 call linus_lila_error (lcb_ptr, lsh_ptr, icode, ""); 120 end; 121 if token_data.key ^= FROM then /* must have from keyword */ 122 call 123 linus_lila_error (lcb_ptr, lsh_ptr, linus_error_$no_from, token); 124 call 125 linus_lila_get_token (lcb_ptr, lsh_ptr, ls_header.cur_pos, td_ptr, 126 icode); 127 if icode ^= 0 then 128 call linus_lila_error (lcb_ptr, lsh_ptr, icode, ""); 129 /* get first item in from list */ 130 131 tab_found = "0"b; /* init */ 132 do while (token_data.key = ROW_TAB_PAIR | token_data.key = TAB_NAME 133 | token_data.key = ROW_DES | token_data.key = COL_SPEC); 134 /* loop through table list */ 135 tab_found = "1"b; /* remember found at least one table */ 136 if token_data.key = ROW_TAB_PAIR then do; /* is a table list */ 137 i = index (token, ":"); /* find separater */ 138 call 139 add_range_item (substr (token, 1, i - 1), 140 substr (token, 1, i - 1), substr (token, i + 1)); 141 end; /* if row tab pair */ 142 else if token_data.key = TAB_NAME then do; /* if table name */ 143 call make_var; /* generate variable */ 144 call add_range_item (token, gen_var, token); /* add to range list */ 145 end; 146 else if token_data.key = COL_SPEC then do; /* if column spec. */ 147 i = index (token, "."); /* isolate column name */ 148 call check_rel_name (substr (token, i + 1, token_data.length - i)); 149 /* see if col. name is a table */ 150 call make_var; 151 call 152 add_range_item (substr (token, i + 1, token_data.length - i), 153 gen_var, substr (token, i + 1, token_data.length - i)); 154 end; /* if column spec. */ 155 else do; /* if row desig. */ 156 call check_rel_name (token); /* see if relation name */ 157 call make_var; 158 call add_range_item (token, gen_var, token); 159 end; /* if row desig. */ 160 call 161 linus_lila_get_token (lcb_ptr, lsh_ptr, ls_header.cur_pos, td_ptr, 162 icode); 163 if icode ^= 0 then 164 call linus_lila_error (lcb_ptr, lsh_ptr, icode, ""); 165 /* get first token after list */ 166 end; /* table list loop */ 167 168 if ^tab_found then /* if found no table */ 169 call 170 linus_lila_error (lcb_ptr, lsh_ptr, linus_error_$no_table_list, 171 token); /* if no table list or name */ 172 173 code = 0; /* made it */ 174 175 exit: 176 ls_header.from_token = "0"b; 177 return; 178 179 make_var: 180 proc; 181 182 /* Procedure to generate tuple variable when not explecitily specified */ 183 184 dcl char_num pic "99999"; 185 186 ls_set.var_ind = ls_set.var_ind + 1; 187 char_num = ls_set.var_ind; 188 gen_var = "V" || char_num; 189 190 end make_var; 191 192 check_rel_name: 193 proc (rel_name); 194 195 /* Procedure to validate a relation name; does not return if not valid */ 196 197 dcl rel_name char (*); 198 dcl (i, j) fixed bin; 199 200 do j = 1 to linus_rel_array.num_of_rels 201 while (linus_rel_array.rels.rel_name (j) ^= rel_name); 202 end; 203 if j > linus_rel_array.num_of_rels then do; /* not in db., check temp rels. */ 204 205 if lcb.ttn_ptr = null then /* no temps defined */ 206 call 207 linus_lila_error (lcb_ptr, lsh_ptr, linus_error_$undef_tab, 208 token); 209 ttn_ptr = lcb.ttn_ptr; 210 do i = 1 to mrds_data_$max_temp_rels 211 while (temp_tab_names (i) ^= token); /* search temp table names */ 212 end; 213 if i > mrds_data_$max_temp_rels then /* not found */ 214 call 215 linus_lila_error (lcb_ptr, lsh_ptr, linus_error_$undef_tab, 216 token); 217 end; /* checking temp rels */ 218 219 end check_rel_name; 220 221 add_range_item: 222 proc (lvar, mvar, rel); 223 224 /* Procedure to create a range item, given a tup.var and relation */ 225 226 dcl l_ptr ptr; 227 dcl (lvar, mvar, rel) char (*); 228 dcl i fixed bin; 229 dcl fb35 fixed bin (35) based; 230 dcl bit_len fixed bin (35); 231 232 if ls_block.nritems >= linus_data_$max_range_items then 233 /* if will overflow */ 234 call 235 linus_lila_error (lcb_ptr, lsh_ptr, linus_error_$range_ovfl, 236 token); 237 ls_block.nritems = ls_block.nritems + 1; /* incr. item count */ 238 ls_block.range_items.tup_var (ls_block.nritems) = lvar; 239 /* store var name */ 240 ls_block.range_items.mrds_var (ls_block.nritems) = mvar; 241 ls_block.range_items.level (ls_block.nritems) = ls_block.ib_level; 242 if token_data.temp_tab then do; /* if is temp table */ 243 ls_block.range_items.rel_name (ls_block.nritems) = ".V."; 244 ttn_ptr = lcb.ttn_ptr; 245 do i = 1 to mrds_data_$max_temp_rels while (temp_tab_names (i) ^= rel); 246 end; /* search for tab name */ 247 call linus_lila_alloc_lit (lcb_ptr, addr (FB35_DESC), l_ptr, bit_len); 248 /* alloc fixed bin(lcb_ptr, bit_len) */ 249 if l_ptr = null then 250 call 251 linus_lila_error (lcb_ptr, lsh_ptr, 252 linus_error_$cant_alloc_lit, rel); 253 ls_block.range_items.rel_index (ls_block.nritems), l_ptr -> fb35 = i; 254 /* fill in temp rel index */ 255 ls_block.nrange_args = ls_block.nrange_args + 1; /* cant overflow because nritems checked */ 256 ls_block.range_items.arg_ptr (ls_block.nritems) = l_ptr; 257 ls_block.range_items.desc_ptr (ls_block.nritems) = addr (FB35_DESC); 258 end; /* if temp table */ 259 else do; 260 ls_block.range_items.rel_name (ls_block.nritems) = rel; 261 ls_block.range_items.rel_index (ls_block.nritems) = 0; 262 ls_block.range_items.arg_ptr (ls_block.nritems), 263 ls_block.range_items.desc_ptr (ls_block.nritems) = null; 264 end; 265 ls_block.dflt_ritem = ls_block.nritems; /* update current default */ 266 267 end add_range_item; 268 269 end linus_lila_from; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/29/86 0939.9 linus_lila_from.pl1 >special_ldd>install>MR12.0-1106>linus_lila_from.pl1 60 1 07/29/86 0937.8 linus_lcb.incl.pl1 >special_ldd>install>MR12.0-1106>linus_lcb.incl.pl1 62 2 03/27/82 0434.5 linus_ls_block.incl.pl1 >ldd>include>linus_ls_block.incl.pl1 2-4 3 03/27/82 0434.5 linus_ls_common.incl.pl1 >ldd>include>linus_ls_common.incl.pl1 64 4 11/23/82 1327.2 linus_ls_header.incl.pl1 >ldd>include>linus_ls_header.incl.pl1 4-4 5 03/27/82 0434.5 linus_ls_common.incl.pl1 >ldd>include>linus_ls_common.incl.pl1 66 6 03/27/82 0434.5 linus_ls_set.incl.pl1 >ldd>include>linus_ls_set.incl.pl1 6-4 7 03/27/82 0434.5 linus_ls_common.incl.pl1 >ldd>include>linus_ls_common.incl.pl1 68 8 03/27/82 0434.5 linus_rel_array.incl.pl1 >ldd>include>linus_rel_array.incl.pl1 70 9 03/27/82 0434.5 linus_temp_tab_names.incl.pl1 >ldd>include>linus_temp_tab_names.incl.pl1 72 10 03/27/82 0434.5 linus_token_data.incl.pl1 >ldd>include>linus_token_data.incl.pl1 74 11 10/14/83 1609.0 mrds_rslt_info.incl.pl1 >ldd>include>mrds_rslt_info.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. COL_SPEC constant fixed bin(17,0) initial dcl 10-13 ref 132 146 FB35_DESC 000005 constant bit(36) initial unaligned dcl 86 set ref 247 247 257 FROM constant fixed bin(17,0) initial dcl 10-13 ref 121 NULL constant fixed bin(17,0) initial dcl 10-13 ref 114 ROW_DES constant fixed bin(17,0) initial dcl 10-13 ref 132 ROW_TAB_PAIR constant fixed bin(17,0) initial dcl 10-13 ref 132 136 TAB_NAME constant fixed bin(17,0) initial dcl 10-13 ref 132 142 addr builtin function dcl 104 ref 247 247 257 arg_ptr 50 based pointer array level 3 dcl 2-3 set ref 256* 262* back_ptr 2 based pointer level 2 dcl 2-3 ref 113 bit_len 000103 automatic fixed bin(35,0) dcl 230 set ref 247* char_num 000126 automatic picture(5) unaligned dcl 184 set ref 187* 188 code parameter fixed bin(35,0) dcl 76 set ref 18 173* cur_pos 13 based fixed bin(35,0) level 2 dcl 4-3 set ref 115* 124* 160* cur_ptr 6 based pointer level 2 dcl 4-3 ref 112 desc_ptr 52 based pointer array level 3 dcl 2-3 set ref 257* 262* dflt_ritem based fixed bin(17,0) level 2 dcl 2-3 set ref 265* fb35 based fixed bin(35,0) dcl 229 set ref 253* from_token 12(01) based bit(1) level 2 packed unaligned dcl 4-3 set ref 110* 175* gen_var 000114 automatic char(6) unaligned dcl 80 set ref 144* 151* 158* 188* i 000100 automatic fixed bin(17,0) dcl 198 in procedure "check_rel_name" set ref 210* 210* 213 i 000116 automatic fixed bin(17,0) dcl 81 in procedure "linus_lila_from" set ref 137* 138 138 138 138 138 138 147* 148 148 148 148 151 151 151 151 151 151 151 151 i 000102 automatic fixed bin(17,0) dcl 228 in procedure "add_range_item" set ref 245* 245* 253 ib_level 7 based fixed bin(17,0) level 2 dcl 2-3 ref 241 icode 000112 automatic fixed bin(35,0) dcl 76 set ref 115* 118 118* 124* 127 127* 160* 163 163* index builtin function dcl 104 ref 137 147 j 000101 automatic fixed bin(17,0) dcl 198 set ref 200* 200* 203 key based fixed bin(17,0) level 2 packed unaligned dcl 10-3 ref 114 121 132 132 132 132 136 142 146 l_ptr 000100 automatic pointer dcl 226 set ref 247* 249 253 256 lcb based structure level 1 dcl 1-53 lcb_ptr parameter pointer dcl 1-121 set ref 18 111 115* 118* 121* 124* 127* 160* 163* 168* 205 205* 209 213* 232* 244 247* 249* length 23 based fixed bin(35,0) level 2 dcl 10-3 ref 121 121 137 138 138 138 138 138 138 144 144 144 144 147 148 148 148 148 151 151 151 151 151 151 151 151 156 156 158 158 158 158 168 168 205 205 210 213 213 232 232 level 46 based fixed bin(17,0) array level 3 dcl 2-3 set ref 241* linus_data_$max_pred_stack_size 000010 external static fixed bin(35,0) dcl 89 ref 255 255 265 linus_data_$max_range_items 000012 external static fixed bin(35,0) dcl 89 ref 232 255 255 265 linus_data_$max_set_stack_size 000014 external static fixed bin(35,0) dcl 89 ref 186 186 187 linus_error_$cant_alloc_lit 000016 external static fixed bin(35,0) dcl 89 set ref 249* linus_error_$no_from 000020 external static fixed bin(35,0) dcl 89 set ref 121* linus_error_$no_table_list 000022 external static fixed bin(35,0) dcl 89 set ref 168* linus_error_$range_ovfl 000024 external static fixed bin(35,0) dcl 89 set ref 232* linus_error_$undef_tab 000026 external static fixed bin(35,0) dcl 89 set ref 205* 213* linus_lila_alloc_lit 000036 constant entry external dcl 106 ref 247 linus_lila_error 000040 constant entry external dcl 107 ref 118 121 127 163 168 205 213 232 249 linus_lila_get_token 000042 constant entry external dcl 108 ref 115 124 160 linus_rel_array based structure level 1 unaligned dcl 8-10 linus_rel_array_ptr 000104 automatic pointer dcl 8-16 set ref 111* 200 200 203 ls_block based structure level 1 dcl 2-3 ls_header based structure level 1 dcl 4-3 ls_set based structure level 1 dcl 6-3 lsb_ptr 000100 automatic pointer dcl 2-32 set ref 112* 113 232 237 237 238 238 240 240 241 241 241 243 243 253 253 255 255 256 256 257 257 260 260 261 261 262 262 262 262 265 265 lsh_ptr parameter pointer dcl 4-15 set ref 18 110 112 115* 115 118* 121* 124* 124 127* 160* 160 163* 168* 175 205* 213* 232* 249* lss_ptr 000102 automatic pointer dcl 6-33 set ref 113* 186 186 187 lvar parameter char unaligned dcl 227 ref 221 238 mrds_data_$max_select_items 000030 external static fixed bin(35,0) dcl 89 ref 255 255 265 mrds_data_$max_temp_rels 000032 external static fixed bin(35,0) dcl 89 ref 210 213 245 mrds_data_$max_token_size 000034 external static fixed bin(35,0) dcl 89 ref 255 255 265 mrds_var 23 based varying char(32) array level 3 dcl 2-3 set ref 240* mvar parameter char unaligned dcl 227 ref 221 240 nrange_args based fixed bin(17,0) level 2 dcl 2-3 set ref 255* 255 nritems 11 based fixed bin(17,0) level 2 dcl 2-3 set ref 232 237* 237 238 240 241 243 253 256 257 260 261 262 262 265 null builtin function dcl 104 ref 205 249 262 num_of_rels based fixed bin(17,0) level 2 dcl 8-10 ref 200 203 num_of_rels_init 000106 automatic fixed bin(17,0) initial dcl 8-18 set ref 8-18* range_items 12 based structure array level 2 dcl 2-3 rel parameter char unaligned dcl 227 set ref 221 245 249* 260 rel_array_ptr 66 based pointer level 2 dcl 1-53 ref 111 rel_index 45 based fixed bin(35,0) array level 3 dcl 2-3 set ref 253* 261* rel_name parameter char unaligned dcl 197 in procedure "check_rel_name" ref 192 200 rel_name 2 based char(32) array level 3 in structure "linus_rel_array" packed unaligned dcl 8-10 in procedure "linus_lila_from" ref 200 rel_name 34 based varying char(32) array level 3 in structure "ls_block" dcl 2-3 in procedure "linus_lila_from" set ref 243* 260* rels 2 based structure array level 2 unaligned dcl 8-10 substr builtin function dcl 104 ref 138 138 138 138 138 138 148 148 151 151 151 151 t_ptr 24 based pointer level 2 dcl 10-3 ref 121 137 138 138 138 138 138 138 144 144 147 148 148 151 151 151 151 156 158 158 168 205 210 213 232 tab_found 000117 automatic bit(1) unaligned dcl 84 set ref 131* 135* 168 td_ptr parameter pointer dcl 10-49 set ref 18 114 115* 121 121 121 121 124* 132 132 132 132 136 137 137 138 138 138 138 138 138 138 138 138 138 138 138 142 144 144 144 144 144 144 146 147 147 148 148 148 148 148 148 151 151 151 151 151 151 151 151 151 151 151 151 156 156 156 158 158 158 158 158 158 160* 168 168 168 205 205 205 210 210 213 213 213 232 232 232 242 temp_tab 0(19) based bit(1) level 2 packed unaligned dcl 10-3 ref 242 temp_tab_names based char(32) array unaligned dcl 9-3 ref 210 245 token based char unaligned dcl 82 set ref 121* 137 138 138 138 138 138 138 144* 144* 147 148 148 151 151 151 151 156* 158* 158* 168* 205* 210 213* 232* token_data based structure level 1 dcl 10-3 ttn_ptr 26 based pointer level 2 in structure "lcb" dcl 1-53 in procedure "linus_lila_from" ref 205 209 244 ttn_ptr 000110 automatic pointer dcl 9-5 in procedure "linus_lila_from" set ref 209* 210 244* 245 tup_var 12 based varying char(32) array level 3 dcl 2-3 set ref 238* var_ind based fixed bin(17,0) level 2 packed unaligned dcl 6-3 set ref 186* 186 187 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. AND internal static fixed bin(17,0) initial dcl 10-13 COMMA internal static fixed bin(17,0) initial dcl 10-13 CONST internal static fixed bin(17,0) initial dcl 10-13 DIFFER internal static fixed bin(17,0) initial dcl 10-13 DIV internal static fixed bin(17,0) initial dcl 10-13 DUP internal static fixed bin(17,0) initial dcl 10-13 EQ internal static fixed bin(17,0) initial dcl 10-13 GE internal static fixed bin(17,0) initial dcl 10-13 GT internal static fixed bin(17,0) initial dcl 10-13 INTER internal static fixed bin(17,0) initial dcl 10-13 LB internal static fixed bin(17,0) initial dcl 10-13 LE internal static fixed bin(17,0) initial dcl 10-13 LINUS_VAR internal static fixed bin(17,0) initial dcl 10-13 LP internal static fixed bin(17,0) initial dcl 10-13 LT internal static fixed bin(17,0) initial dcl 10-13 MINUS internal static fixed bin(17,0) initial dcl 10-13 NE internal static fixed bin(17,0) initial dcl 10-13 NOT internal static fixed bin(17,0) initial dcl 10-13 OR internal static fixed bin(17,0) initial dcl 10-13 PLUS internal static fixed bin(17,0) initial dcl 10-13 RB internal static fixed bin(17,0) initial dcl 10-13 RP internal static fixed bin(17,0) initial dcl 10-13 SCAL_FN internal static fixed bin(17,0) initial dcl 10-13 SELECT internal static fixed bin(17,0) initial dcl 10-13 SET_FN internal static fixed bin(17,0) initial dcl 10-13 STAR internal static fixed bin(17,0) initial dcl 10-13 UNION internal static fixed bin(17,0) initial dcl 10-13 UNIQUE internal static fixed bin(17,0) initial dcl 10-13 WHERE internal static fixed bin(17,0) initial dcl 10-13 fixed builtin function dcl 104 rel builtin function dcl 104 rslt_alloc automatic fixed bin(17,0) dcl 11-34 rslt_info based structure level 1 dcl 11-7 rslt_ptr automatic pointer dcl 11-32 sys_info$max_seg_size external static fixed bin(35,0) dcl 89 NAMES DECLARED BY EXPLICIT CONTEXT. add_range_item 001117 constant entry internal dcl 221 ref 138 144 151 158 check_rel_name 000714 constant entry internal dcl 192 ref 148 156 exit 000654 constant label dcl 175 linus_lila_from 000017 constant entry external dcl 18 make_var 000661 constant entry internal dcl 179 ref 143 150 157 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1714 1760 1470 1724 Length 2422 1470 44 426 223 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_lila_from 134 external procedure is an external procedure. make_var internal procedure shares stack frame of external procedure linus_lila_from. check_rel_name 88 internal procedure is called during a stack extension. add_range_item 94 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME add_range_item 000100 l_ptr add_range_item 000102 i add_range_item 000103 bit_len add_range_item check_rel_name 000100 i check_rel_name 000101 j check_rel_name linus_lila_from 000100 lsb_ptr linus_lila_from 000102 lss_ptr linus_lila_from 000104 linus_rel_array_ptr linus_lila_from 000106 num_of_rels_init linus_lila_from 000110 ttn_ptr linus_lila_from 000112 icode linus_lila_from 000114 gen_var linus_lila_from 000116 i linus_lila_from 000117 tab_found linus_lila_from 000126 char_num make_var THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out call_int_this_desc return shorten_stack ext_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. linus_lila_alloc_lit linus_lila_error linus_lila_get_token THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. linus_data_$max_pred_stack_size linus_data_$max_range_items linus_data_$max_set_stack_size linus_error_$cant_alloc_lit linus_error_$no_from linus_error_$no_table_list linus_error_$range_ovfl linus_error_$undef_tab mrds_data_$max_select_items mrds_data_$max_temp_rels mrds_data_$max_token_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000012 8 18 000024 110 000025 111 000032 112 000036 113 000040 114 000042 115 000046 118 000064 121 000113 124 000151 127 000173 131 000222 132 000223 135 000241 136 000243 137 000245 138 000261 141 000331 142 000333 143 000335 144 000336 145 000367 146 000370 147 000372 148 000406 150 000430 151 000432 154 000476 156 000500 157 000514 158 000515 160 000546 163 000570 166 000617 168 000620 173 000652 175 000654 177 000660 179 000661 186 000662 187 000674 188 000705 190 000712 192 000713 200 000727 202 000752 203 000754 205 000760 209 001020 210 001026 212 001055 213 001057 219 001115 221 001116 232 001144 237 001202 238 001205 240 001223 241 001236 242 001241 243 001246 244 001255 245 001261 246 001304 247 001306 249 001327 253 001363 255 001375 256 001413 257 001417 258 001421 260 001422 261 001440 262 001442 265 001445 267 001465 ----------------------------------------------------------- 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