COMPILATION LISTING OF SEGMENT linus_dtt Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1112.91_Tue_mdt 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_dtt: 19 proc (sci_ptr, lcb_ptr); 20 21 22 /* DESCRIPTION: 23* 24* Temporary tables are defined by calling dsl_define_temp_rel. This procedure 25* will identify key columns and insert a "*" in the select_info structure as 26* required. 27* 28* 29* 30* HISTORY: 31* 32* 77-06-01 J. C. C. Jagernauth: Initially written. 33* 34* 80-04-14 Rickie E. Brinegar: Modified to use a work area defined on 35* lcb.linus_area_ptr instead of getting system free area. 36* 37* 80-12-02 Rickie E. Brinegar: Entry points db_on and db_off added. 38* 39* 81-02-05 Rickie E. Brinegar: Changed to check the temporary relation name 40* against the permanent relation names and to not allow the temporary relation 41* name to duplicate a permanent relation name. 42* 43* 81-02-17 Rickie E. Brinegar: Added return statement for main entry. This 44* had been neglected when the db_(on off) entry points were added. 45* 46* 81-02-20 Rickie E. Brinegar: Changed the calls to mdb_display_value_ to be 47* calls to mdb_display_data_value$ptr. The latter allows more than 256 48* characters to be displayed. 49* 50* 81-07-15 Rickie E. Brinegar: Removed useless cleanup condition handler. 51* 52* 81-10-09 Rickie E. Brinegar: Modified to look for a the key attribute name 53* with a space concatenated on the end of it to guarantee that it does not 54* put the astericks in the middle of another string. This is in response to 55* TR11720. 56* 57* 81-11-13 Rickie E. Brinegar: Added the timing of the dsl entries. 58* 59* 82-02-10 Paul W. Benjamin: ssu_ conversion 60* 61* 83-08-30 Bert Moberg: Added call to linus_translate_query$auto if no current 62* select expression is available 63* 64**/ 65 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 */ 66 67 2 1 /* BEGIN INCLUDE FILE linus_char_argl.incl.pl1 -- jaw 2/11/77 */ 2 2 2 3 /* HISTORY: 2 4* 2 5* 82-02-05 Paul W. Benjamin: Changed arg_len to fixed bin (21). 2 6* 2 7**/ 2 8 2 9 dcl 1 char_argl aligned based (ca_ptr), /* structure for general char. arg. list */ 2 10 2 nargs fixed bin, /* number of args */ 2 11 2 arg (nargs_init refer (char_argl.nargs)), 2 12 3 arg_ptr ptr, /* ptr to first char. of arg */ 2 13 3 arg_len fixed bin (21); /* no. of chars. in arg */ 2 14 2 15 dcl ca_ptr ptr; 2 16 dcl nargs_init fixed bin; 2 17 2 18 /* END INCLUDE FILE linus_char_argl.incl.pl1 */ 68 69 3 1 /* BEGIN INCLUDE FILE linus_select_info.incl.pl1 */ 3 2 /* History: 77-07-29 J. A. Weeldreyer: Originally written. 3 3* Modified: 82-18-82 Dave Schimke: Added user_item.table_name 3 4**/ 3 5 dcl 1 select_info aligned based (si_ptr), /* info from LILA select clause */ 3 6 2 set_fn bit (1) unal, /* on if set fn to be applied */ 3 7 2 se_flags unal, /* flags pertaining to selection expr. */ 3 8 3 val_ret bit (1) unal, /* valid for retrieval */ 3 9 3 val_dtt bit (1) unal, /* valid for define_temp_table */ 3 10 3 val_del bit (1) unal, /* valid for delete */ 3 11 3 val_mod bit (1) unal, /* valid for modify */ 3 12 2 dup_flag bit (1) unal, /* on if dup explic. spec. somewhere */ 3 13 2 unique_flag bit (1) unal, /* on if unique explic. spec. somewhere */ 3 14 2 pad bit (29) unal, /* reserved */ 3 15 2 prior_sf_ptr ptr, /* pointer to set fns for prior eval. */ 3 16 2 se_ptr ptr, /* pointer to mrds selection expression */ 3 17 2 sel_items_ptr ptr, /* pointer to list of selected items */ 3 18 2 sel_items_len fixed bin, /* length in characters of list of selected items */ 3 19 2 se_len fixed bin (35), /* length of mrds sel. expr. */ 3 20 2 nsv_alloc fixed bin, /* no. of se. vals aloc. */ 3 21 2 nmi_alloc fixed bin, /* no. of mrds items alloc. */ 3 22 2 nui_alloc fixed bin, /* no. of user items alloc. */ 3 23 2 nsevals fixed bin, /* number of selection expr. vaules */ 3 24 2 n_mrds_items fixed bin, /* no. of items in mrds select list */ 3 25 2 n_user_items fixed bin, /* no. of items user will see */ 3 26 2 se_vals (nsv_init refer (select_info.nsv_alloc)), 3 27 3 arg_ptr ptr, 3 28 3 desc_ptr ptr, 3 29 2 mrds_item (nmi_init refer (select_info.nmi_alloc)), /* mrds select items */ 3 30 3 arg_ptr ptr, /* pointer to receiving field */ 3 31 3 bit_len fixed bin (35), /* bit length of receiving field */ 3 32 3 desc bit (36), /* descriptor for receiving field */ 3 33 3 assn_type fixed bin, /* type code for assign_ */ 3 34 3 assn_len fixed bin (35), /* length for assign_ */ 3 35 2 user_item (nui_init refer (select_info.nui_alloc)), /* user select item */ 3 36 3 name char (32) var, /* name for col. header */ 3 37 3 table_name char (32) var, /* name of containing linus table */ 3 38 3 item_type fixed bin, /* indicates type of item: 3 39* 1 => raw mrds, 3 40* 2 => expr. */ 3 41 3 rslt_desc bit (36), /* descriptor for expr. result */ 3 42 3 rslt_bit_len fixed bin (35), /* bit length of expr. result */ 3 43 3 rslt_assn_ptr ptr, /* pointer to expr. result storage loc. */ 3 44 3 rslt_assn_type fixed bin, /* assign_ type code of expr. result */ 3 45 3 rslt_assn_len fixed bin (35), /* assign_ length for expr. result */ 3 46 3 item_ptr ptr; /* pointer to item or expr. or applied set_func. structure */ 3 47 3 48 dcl (nsv_init, nmi_init, nui_init) fixed bin; 3 49 dcl si_ptr ptr; 3 50 3 51 /* END INCLUDE FILE linus_select_info.incl.pl1 */ 70 71 4 1 /* BEGIN INCLUDE FILE linus_arg_list.incl.pl1 -- jccj 4/15/77 */ 4 2 4 3 dcl 1 char_desc aligned based (char_ptr), /* Structure for character descriptors */ 4 4 2 fb_desc bit (36) aligned init ("100000100000000000000000000000100011"b), /* Fixed bin descriptor */ 4 5 2 n_chars fixed bin, 4 6 2 arr (n_chars_init refer (char_desc.n_chars)), 4 7 3 const bit (12) unal init ("101010100000"b), /* Constant part */ 4 8 3 var bit (24) unal; /* Variable part */ 4 9 4 10 dcl char_ptr ptr; 4 11 dcl n_chars_init fixed bin; 4 12 4 13 /* END INCLUDE FILE linus_arg_list.incl.pl1 */ 72 73 5 1 /* BEGIN mdbm_arg_list.incl.pl1 -- jaw 5/31/78 */ 5 2 /* the duplicate mrds_arg_list.incl.pl1 was eliminated by Jim Gray, Nov. 1979 */ 5 3 5 4 /* layout of argument list for IDS and DBM entries with options (variable) */ 5 5 5 6 dcl 1 arg_list based (al_ptr), 5 7 2 arg_count fixed bin (17) unal, /* 2 * no. of args. */ 5 8 2 code fixed bin (17) unal, /* 4 => normal, 8 => special */ 5 9 2 desc_count fixed bin (17) unal, /* 2 * no. of descriptors */ 5 10 2 pad fixed bin (17) unal, /* must be 0 */ 5 11 2 arg_des_ptr (num_ptrs) ptr; /* argument/descriptor pointer */ 5 12 5 13 dcl al_ptr ptr; 5 14 dcl num_ptrs fixed bin; 5 15 5 16 /* END mdbm_arg_list.incl.pl1 */ 5 17 74 75 6 1 /* BEGIN INCLUDE FILE linus_temp_tab_names.incl.pl1 -- jaw 6/16/77 */ 6 2 6 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 */ 6 4 6 5 dcl ttn_ptr ptr; 6 6 6 7 /* END INCLUDE FILE linus_temp_tab_names.incl.pl1 */ 76 77 78 dcl sci_ptr ptr; /* for ssu_ */ 79 80 dcl KEY char (1) options (constant) int static init ("*"); 81 82 dcl sel_items char (select_info.sel_items_len) 83 based (select_info.sel_items_ptr); 84 dcl table_name char (char_argl.arg.arg_len (1)) 85 based (char_argl.arg.arg_ptr (1)); 86 dcl temp_char char (mrds_data_$max_token_size + 1) varying; 87 dcl tmp_char char (char_argl.arg.arg_len (i)) 88 based (char_argl.arg.arg_ptr (i)); 89 90 dcl 1 arg_len_bits based, 91 2 pad bit (12) unal, 92 2 length bit (24); /* Length of argument for arg_list */ 93 94 dcl (test, val_key) bit (1); 95 96 dcl debug_switch bit (1) int static init ("0"b); 97 98 dcl ( 99 e_ptr init (null), 100 env_ptr init (null), 101 rslt_ptr init (null) 102 ) ptr; 103 104 dcl (addr, char, fixed, index, length, null, rel, rtrim, substr, vclock) 105 builtin; 106 107 dcl cleanup condition; 108 109 dcl (code, icode, rel_index, out_code) fixed bin (35); 110 111 dcl (curr_pos, desc, i, l) fixed bin; 112 113 dcl initial_mrds_vclock float bin (63); 114 115 dcl ( 116 linus_data_$dtt_id, 117 linus_error_$dtt_key_select, 118 linus_error_$dtt_max_tabs, 119 linus_error_$dtt_no_key, 120 linus_error_$dtt_not_valid, 121 linus_error_$no_db, 122 linus_error_$no_input_arg, 123 linus_error_$table_exist, 124 mrds_data_$max_temp_rels, 125 mrds_data_$max_token_size, 126 mrds_error_$undef_rel, 127 sys_info$max_seg_size 128 ) fixed bin (35) ext; 129 130 dcl cu_$generate_call entry (entry, ptr); 131 dcl dsl_$define_temp_rel entry options (variable); 132 dcl dsl_$get_rslt_info 133 entry (fixed bin (35), char (*), ptr, ptr, fixed bin (35)); 134 dcl ioa_ entry options (variable); 135 dcl linus_convert_code entry (fixed bin (35), fixed bin (35), fixed bin (35)); 136 dcl linus_translate_query$auto entry (ptr, ptr); 137 dcl mdb_display_data_value$ptr entry (ptr, ptr); 138 dcl ssu_$abort_line entry options (variable); 139 dcl ssu_$arg_count entry (ptr, fixed bin); 140 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); 141 dcl work_area area (sys_info$max_seg_size) based (lcb.linus_area_ptr); 142 143 val_key = "0"b; 144 al_ptr, ca_ptr, char_ptr = null; 145 146 icode, code = 0; 147 148 if lcb.db_index = 0 then 149 call error (linus_error_$no_db, ""); 150 else do; 151 call ssu_$arg_count (sci_ptr, nargs_init); 152 if nargs_init = 0 153 then call error (linus_error_$no_input_arg, ""); 154 end; 155 allocate char_argl in (lcb.static_area); 156 on cleanup begin; 157 if ca_ptr ^= null 158 then free char_argl; 159 end; 160 do i = 1 to nargs_init; 161 call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i)); 162 end; 163 if char_argl.nargs <= 1 then 164 call error (linus_error_$dtt_no_key, ""); 165 if lcb.si_ptr = null then call linus_translate_query$auto (sci_ptr, lcb_ptr); /* try translating it */ 166 if lcb.si_ptr = null then return; /* No good? Oh, well */ 167 si_ptr = lcb.si_ptr; /* Activate select_info structure */ 168 if ^select_info.se_flags.val_dtt then 169 call error (linus_error_$dtt_not_valid, ""); 170 if lcb.timing_mode then 171 initial_mrds_vclock = vclock; 172 call 173 dsl_$get_rslt_info (lcb.db_index, table_name, lcb.linus_area_ptr, 174 rslt_ptr, icode); 175 if lcb.timing_mode then 176 lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock; 177 if icode = 0 then 178 icode = linus_error_$table_exist; 179 if icode ^= mrds_error_$undef_rel then 180 call error (icode, table_name); 181 do i = 2 to char_argl.nargs; 182 if char_argl.arg_len (i) > mrds_data_$max_token_size then 183 call 184 error (linus_error_$dtt_key_select, 185 "^/" || tmp_char || " is longer than " 186 || char (mrds_data_$max_token_size) || " characters."); 187 temp_char = rtrim (tmp_char) || " "; 188 curr_pos = 1; 189 test = "0"b; 190 do while (curr_pos <= select_info.sel_items_len & ^test); 191 curr_pos = index (sel_items, temp_char); 192 if curr_pos > 0 then do; 193 curr_pos = curr_pos + length (temp_char) - 2; /* -1 for the added space and 194* -1 for the add producing a value one to large */ 195 val_key = "1"b; 196 test = "1"b; 197 if select_info.sel_items_len > curr_pos then 198 sel_items = /* replace the blank following the attribute */ 199 substr (sel_items, 1, curr_pos) || KEY 200 || substr (sel_items, curr_pos + 2); 201 else sel_items = substr (sel_items, 1, curr_pos) || KEY; 202 end; 203 else call error (linus_error_$dtt_key_select, "^/" || tmp_char); 204 end; 205 end; 206 207 if ^val_key then 208 call error (linus_error_$dtt_key_select, ""); 209 210 rel_index = 0; /* Init for mrds define temp rel */ 211 if lcb.ttn_ptr ^= null then do; 212 ttn_ptr = lcb.ttn_ptr; 213 do l = 1 to mrds_data_$max_temp_rels; 214 if temp_tab_names (l) = table_name then 215 rel_index = l; /* redefine temporary tables */ 216 end; 217 end; 218 else do; 219 allocate temp_tab_names in (lcb.static_area); 220 lcb.ttn_ptr = ttn_ptr; 221 do i = 1 to mrds_data_$max_temp_rels; 222 temp_tab_names (i) = ""; 223 end; 224 end; 225 desc = 4 + select_info.nsevals; /* There are 4 (+ se_vals) arguments in the call 226* to define temp rel */ 227 num_ptrs = desc * 2; /* Number of pointers in arg_list */ 228 allocate arg_list in (work_area); /* System standard arg_list */ 229 arg_list.arg_des_ptr (desc) = addr (icode); /* Pointer to return code */ 230 n_chars_init = 1; /* Number to allocate */ 231 allocate char_desc in (work_area); /* Character descriptors */ 232 233 arg_list.arg_des_ptr (num_ptrs) = addr (char_desc.fb_desc); 234 /* Return code descriptor */ 235 arg_list.arg_des_ptr (1) = addr (lcb.db_index); /* Data base index */ 236 arg_list.arg_des_ptr (desc + 1) = addr (char_desc.fb_desc); 237 /* Data base index descriptor */ 238 arg_list.arg_count, arg_list.desc_count = num_ptrs; /* Initialize argument list header */ 239 arg_list.code = 4; 240 arg_list.pad = 0; 241 242 /* Fill in remainder of arg_list */ 243 char_desc.arr.var (1) = addr (select_info.se_len) -> arg_len_bits.length; 244 /* Get length of selection expression */ 245 arg_list.arg_des_ptr (2) = select_info.se_ptr; /* Pointer to selection expression */ 246 arg_list.arg_des_ptr (desc + 2) = addr (char_desc.arr (1)); 247 /* Selection expression descriptor */ 248 arg_list.arg_des_ptr (desc - 1) = addr (rel_index); /* Index returned by define_temp_rel */ 249 arg_list.arg_des_ptr (num_ptrs - 1) = addr (char_desc.fb_desc); 250 /* Index descriptor */ 251 if select_info.nsevals ^= 0 then 252 do l = 1 to select_info.nsevals; 253 arg_list.arg_des_ptr (2 + l) = select_info.se_vals.arg_ptr (l); 254 arg_list.arg_des_ptr (2 + l + desc) = select_info.se_vals.desc_ptr (l); 255 end; 256 257 if debug_switch then do; 258 call ioa_ ("Selection expression:"); 259 call 260 mdb_display_data_value$ptr (select_info.se_ptr, 261 addr (char_desc.arr (1))); 262 end; 263 264 if lcb.timing_mode then 265 initial_mrds_vclock = vclock; 266 call cu_$generate_call (dsl_$define_temp_rel, al_ptr); /* Call define_temp_rel */ 267 if lcb.timing_mode then 268 lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock; 269 if rel_index > mrds_data_$max_temp_rels then 270 call error (linus_error_$dtt_max_tabs, ""); 271 if icode = 0 then 272 temp_tab_names (rel_index) = table_name; /* Save temporary table name */ 273 else call error (icode, ""); 274 do i = 2 to char_argl.nargs; 275 if char_argl.arg_len (i) > mrds_data_$max_token_size then 276 call 277 error (linus_error_$dtt_key_select, 278 "^/" || tmp_char || " is longer than " 279 || char (mrds_data_$max_token_size) || " characters."); 280 temp_char = rtrim (tmp_char) || "*"; 281 curr_pos = 1; 282 test = "0"b; 283 curr_pos = index (sel_items, temp_char); 284 if curr_pos > 0 then do; 285 curr_pos = curr_pos + length (temp_char) - 2; /* -1 for the added "*" and 286* -1 for the add producing a value one to large */ 287 if select_info.sel_items_len > curr_pos then 288 sel_items = /* replace the "*" following the attribute */ 289 substr (sel_items, 1, curr_pos) || " " 290 || substr (sel_items, curr_pos + 2); 291 else sel_items = substr (sel_items, 1, curr_pos) || " "; 292 end; 293 else call error (linus_error_$dtt_key_select, "^/" || tmp_char); 294 end; 295 296 if ca_ptr ^= null 297 then free char_argl; 298 return; 299 300 db_on: 301 entry; 302 303 /* Usage: 304* 305* linus_dtt$db_on 306* 307* Turns on a switch which cause the value of the current selection 308* expression to be displayed at the terminal. 309**/ 310 311 debug_switch = "1"b; 312 return; 313 314 db_off: 315 entry; 316 317 /* Usage: 318* 319* linus_dtt$db_off 320* 321* Turns off the switch shich causes the value of the current 322* selection expression to be displayed at the terminal. 323**/ 324 325 debug_switch = "0"b; 326 return; 327 328 error: 329 proc (err_code, string); 330 331 dcl err_code fixed bin (35); 332 dcl string char (*); 333 334 if ca_ptr ^= null 335 then free char_argl; 336 call linus_convert_code (err_code, out_code, linus_data_$dtt_id); 337 call ssu_$abort_line (sci_ptr, out_code, string); 338 339 end error; 340 341 end linus_dtt; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/00 1112.9 linus_dtt.pl1 >udd>sm>ds>w>ml>linus_dtt.pl1 66 1 07/29/86 1248.4 linus_lcb.incl.pl1 >ldd>incl>linus_lcb.incl.pl1 68 2 11/23/82 1427.3 linus_char_argl.incl.pl1 >ldd>incl>linus_char_argl.incl.pl1 70 3 09/16/83 1438.0 linus_select_info.incl.pl1 >ldd>incl>linus_select_info.incl.pl1 72 4 03/27/82 0534.5 linus_arg_list.incl.pl1 >ldd>incl>linus_arg_list.incl.pl1 74 5 10/14/83 1709.0 mdbm_arg_list.incl.pl1 >ldd>incl>mdbm_arg_list.incl.pl1 76 6 03/27/82 0534.5 linus_temp_tab_names.incl.pl1 >ldd>incl>linus_temp_tab_names.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. KEY 002112 constant char(1) initial packed unaligned dcl 80 ref 197 201 addr builtin function dcl 104 ref 229 233 235 236 243 246 248 249 259 259 al_ptr 000112 automatic pointer dcl 5-13 set ref 144* 228* 229 233 235 236 238 238 239 240 245 246 248 249 253 254 266* arg 2 based structure array level 2 dcl 2-9 arg_count based fixed bin(17,0) level 2 packed packed unaligned dcl 5-6 set ref 238* arg_des_ptr 2 based pointer array level 2 dcl 5-6 set ref 229* 233* 235* 236* 245* 246* 248* 249* 253* 254* arg_len 4 based fixed bin(21,0) array level 3 dcl 2-9 set ref 161* 172 172 179 179 182 182 187 203 214 271 275 275 280 293 arg_len_bits based structure level 1 packed packed unaligned dcl 90 arg_list based structure level 1 unaligned dcl 5-6 set ref 228 arg_ptr 20 based pointer array level 3 in structure "select_info" dcl 3-5 in procedure "linus_dtt" ref 253 arg_ptr 2 based pointer array level 3 in structure "char_argl" dcl 2-9 in procedure "linus_dtt" set ref 161* 172 179 182 187 203 214 271 275 280 293 arr 2 based structure array level 2 dcl 4-3 set ref 246 259 259 ca_ptr 000100 automatic pointer dcl 2-15 set ref 144* 155* 157 157 161 161 163 172 172 172 179 179 179 181 182 182 182 187 187 203 203 214 214 271 271 274 275 275 275 280 280 293 293 296 296 334 334 char builtin function dcl 104 ref 182 275 char_argl based structure level 1 dcl 2-9 set ref 155 157 296 334 char_desc based structure level 1 dcl 4-3 set ref 231 char_ptr 000106 automatic pointer dcl 4-10 set ref 144* 231* 233 236 243 246 249 259 259 cleanup 000130 stack reference condition dcl 107 ref 156 code 0(18) based fixed bin(17,0) level 2 in structure "arg_list" packed packed unaligned dcl 5-6 in procedure "linus_dtt" set ref 239* code 000136 automatic fixed bin(35,0) dcl 109 in procedure "linus_dtt" set ref 146* const 2 based bit(12) initial array level 3 packed packed unaligned dcl 4-3 set ref 231* cu_$generate_call 000040 constant entry external dcl 130 ref 266 curr_pos 000142 automatic fixed bin(17,0) dcl 111 set ref 188* 190 191* 192 193* 193 197 197 197 201 281* 283* 284 285* 285 287 287 287 291 db_index based fixed bin(35,0) level 2 dcl 1-53 set ref 148 172* 235 debug_switch 000010 internal static bit(1) initial packed unaligned dcl 96 set ref 257 311* 325* desc 000143 automatic fixed bin(17,0) dcl 111 set ref 225* 227 229 236 246 248 254 desc_count 1 based fixed bin(17,0) level 2 packed packed unaligned dcl 5-6 set ref 238* desc_ptr 22 based pointer array level 3 dcl 3-5 ref 254 dsl_$define_temp_rel 000042 constant entry external dcl 131 ref 266 266 dsl_$get_rslt_info 000044 constant entry external dcl 132 ref 172 e_ptr 000122 automatic pointer initial dcl 98 set ref 98* env_ptr 000124 automatic pointer initial dcl 98 set ref 98* err_code parameter fixed bin(35,0) dcl 331 set ref 328 336* fb_desc based bit(36) initial level 2 dcl 4-3 set ref 231* 233 236 249 i 000144 automatic fixed bin(17,0) dcl 111 set ref 160* 161* 161 161* 181* 182 182 182 187 187 203 203* 221* 222* 274* 275 275 275 280 280 293 293* icode 000137 automatic fixed bin(35,0) dcl 109 set ref 146* 172* 177 177* 179 179* 229 271 273* index builtin function dcl 104 ref 191 283 initial_mrds_vclock 000146 automatic float bin(63) dcl 113 set ref 170* 175 264* 267 ioa_ 000046 constant entry external dcl 134 ref 258 l 000145 automatic fixed bin(17,0) dcl 111 set ref 213* 214 214* 251* 253 253 254 254* lcb based structure level 1 dcl 1-53 lcb_ptr parameter pointer dcl 1-121 set ref 18 148 155 165 165* 166 167 170 172 172 175 175 175 211 212 219 220 228 231 235 264 267 267 267 length 0(12) based bit(24) level 2 in structure "arg_len_bits" packed packed unaligned dcl 90 in procedure "linus_dtt" ref 243 length builtin function dcl 104 in procedure "linus_dtt" ref 193 285 linus_area_ptr 60 based pointer level 2 dcl 1-53 set ref 172* 228 231 linus_convert_code 000050 constant entry external dcl 135 ref 336 linus_data_$dtt_id 000012 external static fixed bin(35,0) dcl 115 set ref 336* linus_error_$dtt_key_select 000014 external static fixed bin(35,0) dcl 115 set ref 182* 203* 207* 275* 293* linus_error_$dtt_max_tabs 000016 external static fixed bin(35,0) dcl 115 set ref 269* linus_error_$dtt_no_key 000020 external static fixed bin(35,0) dcl 115 set ref 163* linus_error_$dtt_not_valid 000022 external static fixed bin(35,0) dcl 115 set ref 168* linus_error_$no_db 000024 external static fixed bin(35,0) dcl 115 set ref 148* linus_error_$no_input_arg 000026 external static fixed bin(35,0) dcl 115 set ref 152* linus_error_$table_exist 000030 external static fixed bin(35,0) dcl 115 ref 177 linus_translate_query$auto 000052 constant entry external dcl 136 ref 165 mdb_display_data_value$ptr 000054 constant entry external dcl 137 ref 259 mrds_data_$max_temp_rels 000032 external static fixed bin(35,0) dcl 115 ref 213 219 221 269 mrds_data_$max_token_size 000034 external static fixed bin(35,0) dcl 115 ref 86 182 182 275 275 mrds_error_$undef_rel 000036 external static fixed bin(35,0) dcl 115 ref 179 mrds_time 74 based float bin(63) level 2 dcl 1-53 set ref 175* 175 267* 267 n_chars 1 based fixed bin(17,0) level 2 dcl 4-3 set ref 231* n_chars_init 000110 automatic fixed bin(17,0) dcl 4-11 set ref 230* 231 231 nargs based fixed bin(17,0) level 2 dcl 2-9 set ref 155* 157 163 181 274 296 334 nargs_init 000102 automatic fixed bin(17,0) dcl 2-16 set ref 151* 152 155 155 160 nsevals 15 based fixed bin(17,0) level 2 dcl 3-5 ref 225 251 251 null builtin function dcl 104 ref 98 98 98 144 157 165 166 211 296 334 num_ptrs 000114 automatic fixed bin(17,0) dcl 5-14 set ref 227* 228 233 238 249 out_code 000141 automatic fixed bin(35,0) dcl 109 set ref 336* 337* pad 1(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 5-6 set ref 240* rel_index 000140 automatic fixed bin(35,0) dcl 109 set ref 210* 214* 248 269 271 rslt_ptr 000126 automatic pointer initial dcl 98 set ref 98* 172* rtrim builtin function dcl 104 ref 187 280 sci_ptr parameter pointer dcl 78 set ref 18 151* 161* 165* 337* se_flags 0(01) based structure level 2 packed packed unaligned dcl 3-5 se_len 11 based fixed bin(35,0) level 2 dcl 3-5 set ref 243 se_ptr 4 based pointer level 2 dcl 3-5 set ref 245 259* se_vals 20 based structure array level 2 dcl 3-5 sel_items based char packed unaligned dcl 82 set ref 191 197* 197 197 201* 201 283 287* 287 287 291* 291 sel_items_len 10 based fixed bin(17,0) level 2 dcl 3-5 ref 190 191 197 197 197 197 201 201 283 287 287 287 287 291 291 sel_items_ptr 6 based pointer level 2 dcl 3-5 ref 191 197 197 197 201 201 283 287 287 287 291 291 select_info based structure level 1 dcl 3-5 si_ptr 34 based pointer level 2 in structure "lcb" dcl 1-53 in procedure "linus_dtt" ref 165 166 167 si_ptr 000104 automatic pointer dcl 3-49 in procedure "linus_dtt" set ref 167* 168 190 191 191 197 197 197 197 197 197 197 201 201 201 201 225 243 245 251 251 253 254 259 283 283 287 287 287 287 287 287 287 291 291 291 291 ssu_$abort_line 000056 constant entry external dcl 138 ref 337 ssu_$arg_count 000060 constant entry external dcl 139 ref 151 ssu_$arg_ptr 000062 constant entry external dcl 140 ref 161 static_area 144 based area level 2 dcl 1-53 ref 155 219 string parameter char packed unaligned dcl 332 set ref 328 337* substr builtin function dcl 104 ref 197 197 201 287 287 291 table_name based char packed unaligned dcl 84 set ref 172* 179* 214 271 temp_char 000120 automatic varying char dcl 86 set ref 187* 191 193 280* 283 285 temp_tab_names based char(32) array packed unaligned dcl 6-3 set ref 214 219 222* 271* test 000120 automatic bit(1) packed unaligned dcl 94 set ref 189* 190 196* 282* timing_mode 15(05) based bit(1) level 2 packed packed unaligned dcl 1-53 ref 170 175 264 267 tmp_char based char packed unaligned dcl 87 ref 182 187 203 275 280 293 ttn_ptr 26 based pointer level 2 in structure "lcb" dcl 1-53 in procedure "linus_dtt" set ref 211 212 220* ttn_ptr 000116 automatic pointer dcl 6-5 in procedure "linus_dtt" set ref 212* 214 219* 220 222 271 val_dtt 0(02) based bit(1) level 3 packed packed unaligned dcl 3-5 ref 168 val_key 000121 automatic bit(1) packed unaligned dcl 94 set ref 143* 195* 207 var 2(12) based bit(24) array level 3 packed packed unaligned dcl 4-3 set ref 243* vclock builtin function dcl 104 ref 170 175 264 267 work_area based area dcl 141 ref 228 231 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. fixed builtin function dcl 104 nmi_init automatic fixed bin(17,0) dcl 3-48 nsv_init automatic fixed bin(17,0) dcl 3-48 nui_init automatic fixed bin(17,0) dcl 3-48 rel builtin function dcl 104 sys_info$max_seg_size external static fixed bin(35,0) dcl 115 NAMES DECLARED BY EXPLICIT CONTEXT. db_off 002003 constant entry external dcl 314 db_on 001770 constant entry external dcl 300 error 002015 constant entry internal dcl 328 ref 148 152 163 168 179 182 203 207 269 273 275 293 linus_dtt 000055 constant entry external dcl 18 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2426 2512 2115 2436 Length 3042 2115 64 314 311 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_dtt 158 external procedure is an external procedure. on unit on line 156 64 on unit error 88 internal procedure is called during a stack extension. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 debug_switch linus_dtt STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_dtt 000100 ca_ptr linus_dtt 000102 nargs_init linus_dtt 000104 si_ptr linus_dtt 000106 char_ptr linus_dtt 000110 n_chars_init linus_dtt 000112 al_ptr linus_dtt 000114 num_ptrs linus_dtt 000116 ttn_ptr linus_dtt 000120 test linus_dtt 000120 temp_char linus_dtt 000121 val_key linus_dtt 000122 e_ptr linus_dtt 000124 env_ptr linus_dtt 000126 rslt_ptr linus_dtt 000136 code linus_dtt 000137 icode linus_dtt 000140 rel_index linus_dtt 000141 out_code linus_dtt 000142 curr_pos linus_dtt 000143 desc linus_dtt 000144 i linus_dtt 000145 l linus_dtt 000146 initial_mrds_vclock linus_dtt THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc return_mac alloc_auto_adj enable_op shorten_stack ext_entry int_entry int_entry_desc set_chars_eis index_chars_eis op_alloc_ op_freen_ vclock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$generate_call dsl_$define_temp_rel dsl_$get_rslt_info ioa_ linus_convert_code linus_translate_query$auto mdb_display_data_value$ptr ssu_$abort_line ssu_$arg_count ssu_$arg_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. linus_data_$dtt_id linus_error_$dtt_key_select linus_error_$dtt_max_tabs linus_error_$dtt_no_key linus_error_$dtt_not_valid linus_error_$no_db linus_error_$no_input_arg linus_error_$table_exist mrds_data_$max_temp_rels mrds_data_$max_token_size mrds_error_$undef_rel LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 86 000030 98 000043 18 000051 143 000063 144 000064 146 000070 148 000072 151 000114 152 000125 155 000144 156 000160 157 000174 159 000206 160 000207 161 000217 162 000237 163 000241 165 000261 166 000301 167 000310 168 000312 170 000332 172 000344 175 000377 177 000413 179 000420 181 000443 182 000453 187 000554 188 000616 189 000621 190 000622 191 000630 192 000640 193 000641 195 000644 196 000646 197 000647 201 000714 202 000733 203 000735 204 000774 205 000776 207 001000 210 001017 211 001020 212 001027 213 001031 214 001041 216 001056 217 001060 219 001061 220 001073 221 001077 222 001107 223 001115 225 001117 227 001123 228 001125 229 001137 230 001143 231 001145 233 001170 235 001174 236 001201 238 001206 239 001216 240 001220 243 001222 245 001225 246 001227 248 001231 249 001233 251 001235 253 001245 254 001255 255 001265 257 001267 258 001272 259 001305 264 001322 266 001334 267 001351 269 001365 271 001405 273 001422 274 001436 275 001445 280 001546 281 001610 282 001613 283 001614 284 001624 285 001626 287 001631 291 001676 292 001716 293 001720 294 001752 296 001755 298 001766 300 001767 311 001776 312 002001 314 002002 325 002011 326 002013 328 002014 334 002030 336 002042 337 002057 339 002104 ----------------------------------------------------------- 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