COMPILATION LISTING OF SEGMENT linus_list_db Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 07/29/86 1005.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_list_db: 19 proc (sci_ptr, lcb_ptr); 20 21 /* DESCRIPTION: 22* 23* Procedure to list selected information about the currently open data base. 24* Available information includes the database pathname, the opening mode, 25* table names, and column information. 26* 27* 28* 29* HISTORY: 30* 31* 77-08-01 J. A. Weeldreyer: Initially written. 32* 33* 77-11-01 J. A. Weeldreyer: Modified to set correct defaults. 34* 35* 78-09-01 J. C. C. Jagernauth: Modified for MR7.0. 36* 37* 80-06-01 Jim Gray : Modified to correct argument handling for the -table 38* option, and to force on the -name option with it, so that it makes semantic 39* sense, and also so that it can detect unknown relation names. The ability 40* to detect, and issue a message about no temp tables currently defined was 41* added. Also, opening modes are now display when -pathname is acked for, as 42* in the old linus. This was done by adding open_mode to mrds_dbcb.incl.pl1 43* changing mrds_dsl_open, mrds_dsl_init_res, and adding a parameter to 44* dsl_$get_pn. 45* 46* 81-05-12 Rickie E. Brinegar: Modified to only display domain names for 47* administrator if the database is secured. 48* 49* 81-06-18 Rickie E. Brinegar: Modified to not check the database version. 50* 51* 81-11-13 Rickie E. Brinegar: Added timing of dsl_ and mdbm_util_ entries. 52* 53* 82-02-08 Paul W. Benjamin: ssu_ conversion. 54* 55* 82-06-21 Al Dupuis: Removed a meaningless comment as requested by audit team 56* who audited ssu_ conversion. 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_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 */ 62 63 3 1 /* BEGIN INCLUDE FILE linus_temp_tab_names.incl.pl1 -- jaw 6/16/77 */ 3 2 3 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 */ 3 4 3 5 dcl ttn_ptr ptr; 3 6 3 7 /* END INCLUDE FILE linus_temp_tab_names.incl.pl1 */ 64 65 4 1 /* BEGIN INCLUDE FILE mrds_model_relations.incl.pl1 4 2* 4 3* Created October, 1975 for release in MR 4.0 */ 4 4 4 5 dcl 1 model_relations based (mr_ptr), /* structure to return names of all relations in a model */ 4 6 2 nrels fixed bin (10), /* number of relations */ 4 7 2 relation_name (num_relations_alloc refer (model_relations.nrels)) char (32); /* relation names */ 4 8 4 9 dcl num_relations_alloc fixed bin (10); /* number of relations in model for allocation purposes */ 4 10 4 11 dcl mr_ptr ptr; 4 12 4 13 /* END INCLUDE FILE mrds_model_relations.incl.pl1 */ 4 14 66 67 5 1 /* BEGIN INCLUDE FILE mrds_rslt_info.incl.pl1 rgl 07/22/77 */ 5 2 5 3 /* Modified by R. Lackey 09/20/76 to handle inverted attributes */ 5 4 5 5 /* Modified by D. Woodka 06/28/82 to fix size condition */ 5 6 5 7 dcl 1 rslt_info aligned based (rslt_ptr), /* resultant information description */ 5 8 2 num_attr fixed bin, /* number of attributes in view */ 5 9 2 num_key_attr fixed bin, /* number of key attributes in data relation */ 5 10 2 key_length fixed bin (35), /* length in bits of key portion of tuple */ 5 11 2 retrieve bit (1) unal, /* retrieve permitted = "1"b */ 5 12 2 modify bit (1) unal, /* modify permitted = "1"b */ 5 13 2 store bit (1) unal, /* store permitted = "1"b */ 5 14 2 delete bit (1) unal, /* delete permitted = "1"b */ 5 15 2 total_key bit (1) unal, /* on if view includes the total key */ 5 16 2 inversion bit (1) unal, /* On if this view contains any inverted attributes */ 5 17 2 reserved bit (30) unal, /* reserved for future use */ 5 18 2 attr (rslt_alloc refer (rslt_info.num_attr)), /* per attribute info */ 5 19 3 attr_name char (32), /* name of attribute */ 5 20 3 domain_name char (32), /* name of underlying domain */ 5 21 3 attr_length fixed bin (18), /* length of attribute data in bits */ 5 22 3 attr_index fixed bin (24), /* index to bit_offset in dbcbrw */ 5 23 3 descriptor bit (36) aligned, /* attribute description */ 5 24 3 key_flag bit (1) unal, /* key attribute = "1"b */ 5 25 3 inver_flag bit (1) unal, /* On if this attribute is inverted */ 5 26 3 unused bit (34) unal, /* reserved for future use */ 5 27 3 key_attr_order fixed bin, /* order no. of this key attr. */ 5 28 3 inver_iocb_index fixed bin; /* Index to inversion iocb in dbcbw */ 5 29 5 30 5 31 5 32 dcl rslt_ptr ptr; 5 33 5 34 dcl rslt_alloc fixed bin; 5 35 5 36 /* END INCLUDE FILE mrds_rslt_info.incl.pl1 */ 5 37 68 69 70 dcl sci_ptr ptr; /* for ssu_ */ 71 72 dcl ( 73 code, 74 icode 75 ) fixed bin (35); /* internal status code */ 76 77 dcl (i, j, k) fixed bin; 78 79 dcl initial_mrds_vclock float bin (63); 80 81 dcl ( 82 lg_flag, /* -long */ 83 nm_flag, /* -names */ 84 perm_flag, /* -perm */ 85 pn_flag, /* -pathname */ 86 rels_left, /* on => relation names left for -table */ 87 tb_flag, /* -table */ 88 temp_flag, /* -temp */ 89 tn_flag 90 ) bit (1) unal; /* -table_names */ 91 92 dcl ( 93 pmr_ptr init (null), /* perm mr_ptr */ 94 tmr_ptr init (null) 95 ) ptr; /* temp mr_ptr */ 96 97 dcl arg char (char_argl.arg.arg_len (i)) based (char_argl.arg.arg_ptr (i)); 98 dcl db_path char (168) var; 99 dcl desc char (120) varying; 100 dcl open_mode char (20); 101 dcl type char (10) varying; 102 dcl work_area area (sys_info$max_seg_size) based (lcb.linus_area_ptr); 103 104 dcl ( 105 linus_data_$ldb_id, 106 linus_error_$incons_args, 107 linus_error_$inv_arg, 108 linus_error_$no_db, 109 linus_error_$no_tab, 110 mrds_data_$max_temp_rels, 111 mrds_error_$invalid_db_index, /* caused by closed database */ 112 sys_info$max_seg_size 113 ) ext fixed bin (35); 114 115 dcl (addr, before, fixed, null, rel, substr, vclock) builtin; 116 117 dcl dsl_$get_pn 118 entry (fixed bin (35), char (168) var, char (20), fixed bin (35)); 119 dcl dsl_$get_rslt_info 120 entry (fixed bin (35), char (*), ptr, ptr, fixed bin (35)); 121 dcl dsl_$get_rslt_rels entry (fixed bin (35), ptr, ptr, fixed bin (35)); 122 dcl dsl_$get_temp_info 123 entry (fixed bin (35), fixed bin (35), ptr, ptr, fixed bin (35)); 124 dcl ioa_ entry options (variable); 125 dcl linus_convert_code entry (fixed bin (35), fixed bin (35), fixed bin (35)); 126 dcl mdbm_util_$display_descriptor entry (ptr) returns (char (120) varying); 127 dcl mdbm_util_$trim_descriptor entry (char (120) varying) returns (char (*)); 128 dcl ssu_$abort_line entry options (variable); 129 dcl ssu_$arg_count entry (ptr, fixed bin); 130 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); 131 132 code = 0; 133 134 mr_ptr, rslt_ptr, ca_ptr = null; 135 136 if lcb.db_index = 0 then 137 call error (linus_error_$no_db, ""); /* must have open db. */ 138 139 call ssu_$arg_count (sci_ptr, nargs_init); 140 141 if nargs_init = 0 then do; /* no args, set defaults */ 142 tn_flag, /* -table_names, -pathname -perm -temp */ 143 pn_flag, perm_flag, temp_flag = "1"b; 144 tb_flag, nm_flag, lg_flag = "0"b; 145 end; /* if no args */ 146 147 else do; /* process user args */ 148 149 tn_flag, /* init flags to off */ 150 pn_flag, perm_flag, temp_flag, tb_flag, nm_flag, lg_flag = "0"b; 151 152 allocate char_argl in (lcb.static_area); 153 do i = 1 to nargs_init; 154 call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i)); 155 end; 156 i = 1; 157 do while (i <= char_argl.nargs); /* main arg processing loop */ 158 159 if arg = "-pn" | arg = "-pathname" then do; 160 pn_flag = "1"b; 161 i = i + 1; 162 end; 163 else if arg = "-table_names" then do; 164 tn_flag = "1"b; 165 i = i + 1; 166 end; 167 else if arg = "-names" then do; 168 nm_flag = "1"b; 169 i = i + 1; 170 end; 171 else if arg = "-temp" then do; 172 temp_flag = "1"b; 173 i = i + 1; 174 end; 175 else if arg = "-perm" then do; 176 perm_flag = "1"b; 177 i = i + 1; 178 end; 179 else if arg = "-lg" | arg = "-long" then do; 180 lg_flag = "1"b; 181 i = i + 1; 182 end; 183 else if arg = "-tb" | arg = "-table" then do; 184 tb_flag = "1"b; 185 num_relations_alloc = char_argl.nargs - i; /* init model rels struct. */ 186 alloc model_relations set (mr_ptr) in (work_area); 187 model_relations.nrels = 0; 188 rels_left = "1"b; 189 i = i + 1; 190 do while (rels_left); 191 if i > char_argl.nargs then 192 rels_left = "0"b; 193 else if substr (arg, 1, 1) = "-" then 194 rels_left = "0"b; 195 else do; 196 model_relations.nrels = model_relations.nrels + 1; 197 /* add table name to list */ 198 model_relations.relation_name (model_relations.nrels) = 199 arg; 200 i = i + 1; 201 end; 202 end; 203 if model_relations.nrels <= 0 then 204 call error (linus_error_$no_tab, ""); 205 end; /* if -table */ 206 else call error (linus_error_$inv_arg, arg); 207 end; /* control arg loop */ 208 209 if ^tb_flag & ^perm_flag & ^temp_flag & (nm_flag | lg_flag | tn_flag) 210 then do; /* if tables not given */ 211 perm_flag = "1"b; 212 temp_flag = "1"b; /* give him everything */ 213 end; 214 if (perm_flag | temp_flag) & ^tn_flag & ^tb_flag & ^nm_flag & ^lg_flag 215 then /* type info not given */ 216 tn_flag = "1"b; /* default to table names */ 217 if tn_flag & nm_flag then /* check for inconsistencies */ 218 call error (linus_error_$incons_args, "-table_names and -names"); 219 if tn_flag & lg_flag then 220 call error (linus_error_$incons_args, "-table_names and -long"); 221 if nm_flag & lg_flag then 222 call error (linus_error_$incons_args, "-names and -long"); 223 end; /* checking user specified args */ 224 225 if tb_flag & ^lg_flag then 226 nm_flag = "1"b; 227 if tb_flag then 228 tn_flag = "0"b; 229 230 if mr_ptr = null then /* do we need to supply tab. names */ 231 if perm_flag | temp_flag then do; /* yes */ 232 233 if perm_flag then do; /* need db. table names */ 234 if lcb.timing_mode then 235 initial_mrds_vclock = vclock; 236 call 237 dsl_$get_rslt_rels (lcb.db_index, lcb.linus_area_ptr, 238 pmr_ptr, icode); 239 if lcb.timing_mode then 240 lcb.mrds_time = 241 lcb.mrds_time + vclock - initial_mrds_vclock; 242 if icode ^= 0 then 243 call error (icode, ""); 244 end; /* getting db. tab names */ 245 if temp_flag then /* need temp tab names */ 246 if lcb.ttn_ptr ^= null then do; /* if temps defined */ 247 ttn_ptr = lcb.ttn_ptr; 248 num_relations_alloc = mrds_data_$max_temp_rels; 249 allocate model_relations in (work_area) set (tmr_ptr); 250 tmr_ptr -> model_relations.nrels = 0; 251 do i = 1 to mrds_data_$max_temp_rels; /* look for defined tables */ 252 if temp_tab_names (i) ^= "" then do; 253 /* copy those found */ 254 tmr_ptr -> model_relations.nrels = 255 tmr_ptr -> model_relations.nrels + 1; 256 tmr_ptr 257 -> model_relations 258 . 259 relation_name (tmr_ptr -> model_relations.nrels) 260 = temp_tab_names (i); 261 end; 262 end; /* copy loop */ 263 264 if tmr_ptr -> model_relations.nrels = 0 then 265 tmr_ptr = null;/* since lcb.ttn_ptr not nulled on close */ 266 end; /* if temps defined */ 267 268 if pmr_ptr ^= null then /* consolidate the lists */ 269 if tmr_ptr ^= null then do; 270 num_relations_alloc = 271 pmr_ptr -> model_relations.nrels 272 + tmr_ptr -> model_relations.nrels; 273 allocate model_relations in (work_area); 274 do i = 1 to pmr_ptr -> model_relations.nrels; 275 model_relations.relation_name (i) = 276 pmr_ptr -> model_relations.relation_name (i); 277 end; 278 do i = 1 to tmr_ptr -> model_relations.nrels; 279 model_relations 280 . 281 relation_name (pmr_ptr -> model_relations.nrels + i) 282 = tmr_ptr -> model_relations.relation_name (i); 283 end; 284 end; 285 else do; 286 mr_ptr = pmr_ptr; 287 pmr_ptr = null; 288 end; 289 else if tmr_ptr ^= null then do; 290 mr_ptr = tmr_ptr; 291 tmr_ptr = null; 292 end; 293 end; /* specifying tables */ 294 295 296 if pn_flag then do; /* get pathname and mode */ 297 if lcb.timing_mode then 298 initial_mrds_vclock = vclock; 299 call dsl_$get_pn (lcb.db_index, db_path, open_mode, icode); 300 if lcb.timing_mode then 301 lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock; 302 if icode ^= 0 then 303 call error (icode, ""); 304 call ioa_ ("^/^a^/^a", db_path, open_mode); 305 end; /* pathname and mode */ 306 307 if mr_ptr = null then do; 308 if temp_flag then 309 call ioa_ ("^/No temp tables defined."); 310 end; 311 else do; /* if need table info */ 312 313 if tn_flag then /* write table names header */ 314 call ioa_ ("^/TABLE^/"); 315 if nm_flag then /* write names only header */ 316 call ioa_ ("^/^10aCOLUMN^/", "TABLE"); 317 else if lg_flag then /* write long header */ 318 call 319 ioa_ ("^/^10a^10a^23a^[^20a^;^s^20x^]TYPE^/", "TABLE", 320 "COLUMN", "DECLARATION", (^lcb.secured_db | lcb.administrator), 321 "DOMAIN"); 322 323 do i = 1 to model_relations.nrels; /* major table list loop */ 324 325 j = mrds_data_$max_temp_rels + 1; 326 if lcb.ttn_ptr ^= null then do; /* if temps defined */ 327 ttn_ptr = lcb.ttn_ptr; 328 do j = 1 to mrds_data_$max_temp_rels 329 while (temp_tab_names (j) 330 ^= model_relations.relation_name (i)); 331 end; /* see if temp. tab. */ 332 end; 333 334 if j <= mrds_data_$max_temp_rels then do; /* if temp tab */ 335 if tn_flag then /* wants name only */ 336 call ioa_ ("^a", model_relations.relation_name (i)); 337 else do; /* needs column info too */ 338 if lcb.timing_mode then 339 initial_mrds_vclock = vclock; 340 call 341 dsl_$get_temp_info (lcb.db_index, (j), lcb.linus_area_ptr, 342 rslt_ptr, icode); 343 if lcb.timing_mode then 344 lcb.mrds_time = 345 lcb.mrds_time + vclock - initial_mrds_vclock; 346 if icode ^= 0 then 347 call 348 ioa_ ("^33aUnable to obtain additional information.", 349 model_relations.relation_name (i)); 350 else do; /* got column info */ 351 call 352 ioa_ ("^a (temp)", 353 before (model_relations.relation_name (i), " ")); 354 /* write out rel. name */ 355 if nm_flag then /* wants names only */ 356 do k = 1 to rslt_info.num_attr; 357 call ioa_ ("^10x^a", rslt_info.attr.attr_name (k)); 358 /* write out all attr names */ 359 end; /* names only */ 360 else call write_attr_lines; /* wants long info */ 361 end; /* if obtained attr info */ 362 end; /* if needs column info */ 363 end; /* if temp table */ 364 365 else do; /* is database relation */ 366 367 if tn_flag then /* if just name */ 368 call ioa_ ("^a", model_relations.relation_name (i)); 369 else do; /* wants attr info */ 370 if lcb.timing_mode then 371 initial_mrds_vclock = vclock; 372 call 373 dsl_$get_rslt_info (lcb.db_index, 374 model_relations.relation_name (i), lcb.linus_area_ptr, 375 rslt_ptr, icode); 376 if lcb.timing_mode then 377 lcb.mrds_time = 378 lcb.mrds_time + vclock - initial_mrds_vclock; 379 if icode ^= 0 then /* couldnt get info */ 380 if icode = mrds_error_$invalid_db_index then 381 call error (icode, ""); 382 else call 383 ioa_ ("^33aUnknown table name given.", 384 model_relations.relation_name (i)); 385 else do; /* got the relation info */ 386 call 387 ioa_ ("^a (perm)", 388 before (model_relations.relation_name (i), " ")); 389 if nm_flag then /* wants names only */ 390 do k = 1 to rslt_info.num_attr; /* write out attr names */ 391 call ioa_ ("^10x^a", rslt_info.attr.attr_name (k)); 392 end; /* attr names */ 393 else call write_attr_lines; 394 end; /* writtind attr info */ 395 end; /* if got relation info */ 396 end; /* if db. relation */ 397 end; /* major table list loop */ 398 399 end; /* if had relations specified */ 400 401 call ioa_ (" "); /* finish off with null line */ 402 code = 0; 403 if ca_ptr ^= null 404 then free char_argl; 405 return; 406 407 write_attr_lines: 408 proc; 409 410 /* write out long info for all attributes */ 411 412 do k = 1 to rslt_info.num_attr; 413 if lcb.timing_mode then 414 initial_mrds_vclock = vclock; 415 desc = 416 mdbm_util_$display_descriptor (addr (rslt_info.attr (k).descriptor)) 417 ; 418 desc = mdbm_util_$trim_descriptor (desc); 419 if lcb.timing_mode then 420 lcb.mrds_time = lcb.mrds_time + vclock - initial_mrds_vclock; 421 if rslt_info.attr.key_flag (k) then 422 type = "key"; 423 else type = "data"; 424 if rslt_info.attr.inver_flag (k) then 425 type = type || " index"; 426 call 427 ioa_ ("^10x^33a^[^a^;^s^]^/^20x^43a^a", 428 rslt_info.attr.attr_name (k), (^lcb.secured_db | lcb.administrator), 429 rslt_info.attr.domain_name (k), desc, type); 430 end; 431 432 end write_attr_lines; 433 434 error: 435 proc (cd, msg); 436 437 /* error procedure to write message and clean up */ 438 439 dcl (cd, ucd) fixed bin (35); 440 dcl msg char (*); 441 442 if ca_ptr ^= null 443 then free char_argl; 444 call linus_convert_code (cd, ucd, linus_data_$ldb_id); 445 code = 0; 446 call ssu_$abort_line (sci_ptr, ucd, msg); 447 448 end error; 449 450 end linus_list_db; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/29/86 0940.0 linus_list_db.pl1 >special_ldd>install>MR12.0-1106>linus_list_db.pl1 60 1 07/29/86 0937.8 linus_lcb.incl.pl1 >special_ldd>install>MR12.0-1106>linus_lcb.incl.pl1 62 2 11/23/82 1327.3 linus_char_argl.incl.pl1 >ldd>include>linus_char_argl.incl.pl1 64 3 03/27/82 0434.5 linus_temp_tab_names.incl.pl1 >ldd>include>linus_temp_tab_names.incl.pl1 66 4 10/14/83 1608.4 mrds_model_relations.incl.pl1 >ldd>include>mrds_model_relations.incl.pl1 68 5 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. addr builtin function dcl 115 ref 415 415 administrator 15(04) based bit(1) level 2 packed unaligned dcl 1-53 ref 317 426 arg 2 based structure array level 2 in structure "char_argl" dcl 2-9 in procedure "linus_list_db" arg based char unaligned dcl 97 in procedure "linus_list_db" set ref 159 159 163 167 171 175 179 179 183 183 193 198 206* arg_len 4 based fixed bin(21,0) array level 3 dcl 2-9 set ref 154* 159 159 163 167 171 175 179 179 183 183 193 198 206 206 arg_ptr 2 based pointer array level 3 dcl 2-9 set ref 154* 159 159 163 167 171 175 179 179 183 183 193 198 206 attr 4 based structure array level 2 dcl 5-7 attr_name 4 based char(32) array level 3 dcl 5-7 set ref 357* 391* 426* before builtin function dcl 115 ref 351 351 386 386 ca_ptr 000100 automatic pointer dcl 2-15 set ref 134* 152* 154 154 157 159 159 159 159 163 163 167 167 171 171 175 175 179 179 179 179 183 183 183 183 185 191 193 193 198 198 206 206 206 403 403 442 442 cd parameter fixed bin(35,0) dcl 439 set ref 434 444* char_argl based structure level 1 dcl 2-9 set ref 152 403 442 code 000114 automatic fixed bin(35,0) dcl 72 set ref 132* 402* 445* db_index based fixed bin(35,0) level 2 dcl 1-53 set ref 136 236* 299* 340* 372* db_path 000140 automatic varying char(168) dcl 98 set ref 299* 304* desc 000213 automatic varying char(120) dcl 99 set ref 415* 418* 418* 426* descriptor 26 based bit(36) array level 3 dcl 5-7 set ref 415 415 domain_name 14 based char(32) array level 3 dcl 5-7 set ref 426* dsl_$get_pn 000026 constant entry external dcl 117 ref 299 dsl_$get_rslt_info 000030 constant entry external dcl 119 ref 372 dsl_$get_rslt_rels 000032 constant entry external dcl 121 ref 236 dsl_$get_temp_info 000034 constant entry external dcl 122 ref 340 i 000116 automatic fixed bin(17,0) dcl 77 set ref 153* 154* 154 154* 156* 157 159 159 159 159 161* 161 163 163 165* 165 167 167 169* 169 171 171 173* 173 175 175 177* 177 179 179 179 179 181* 181 183 183 183 183 185 189* 189 191 193 193 198 198 200* 200 206 206 206 251* 252 256* 274* 275 275* 278* 279 279* 323* 328 335 346 351 351 367 372 382 386 386* icode 000115 automatic fixed bin(35,0) dcl 72 set ref 236* 242 242* 299* 302 302* 340* 346 372* 379 379 379* initial_mrds_vclock 000122 automatic float bin(63) dcl 79 set ref 234* 239 297* 300 338* 343 370* 376 413* 419 inver_flag 27(01) based bit(1) array level 3 packed unaligned dcl 5-7 ref 424 ioa_ 000036 constant entry external dcl 124 ref 304 308 313 315 317 335 346 351 357 367 382 386 391 401 426 j 000117 automatic fixed bin(17,0) dcl 77 set ref 325* 328* 328* 334 340 k 000120 automatic fixed bin(17,0) dcl 77 set ref 355* 357* 389* 391* 412* 415 415 421 424 426 426* key_flag 27 based bit(1) array level 3 packed unaligned dcl 5-7 ref 421 lcb based structure level 1 dcl 1-53 lcb_ptr parameter pointer dcl 1-121 ref 18 136 152 186 234 236 236 239 239 239 245 247 249 273 297 299 300 300 300 317 317 326 327 338 340 340 343 343 343 370 372 372 376 376 376 413 419 419 419 426 426 lg_flag 000124 automatic bit(1) unaligned dcl 81 set ref 144* 149* 180* 209 214 219 221 225 317 linus_area_ptr 60 based pointer level 2 dcl 1-53 set ref 186 236* 249 273 340* 372* linus_convert_code 000040 constant entry external dcl 125 ref 444 linus_data_$ldb_id 000010 external static fixed bin(35,0) dcl 104 set ref 444* linus_error_$incons_args 000012 external static fixed bin(35,0) dcl 104 set ref 217* 219* 221* linus_error_$inv_arg 000014 external static fixed bin(35,0) dcl 104 set ref 206* linus_error_$no_db 000016 external static fixed bin(35,0) dcl 104 set ref 136* linus_error_$no_tab 000020 external static fixed bin(35,0) dcl 104 set ref 203* mdbm_util_$display_descriptor 000042 constant entry external dcl 126 ref 415 mdbm_util_$trim_descriptor 000044 constant entry external dcl 127 ref 418 model_relations based structure level 1 unaligned dcl 4-5 set ref 186 249 273 mr_ptr 000110 automatic pointer dcl 4-11 set ref 134* 186* 187 196 196 198 198 203 230 273* 275 279 286* 290* 307 323 328 335 346 351 351 367 372 382 386 386 mrds_data_$max_temp_rels 000022 external static fixed bin(35,0) dcl 104 ref 248 251 325 328 334 mrds_error_$invalid_db_index 000024 external static fixed bin(35,0) dcl 104 ref 379 mrds_time 74 based float bin(63) level 2 dcl 1-53 set ref 239* 239 300* 300 343* 343 376* 376 419* 419 msg parameter char unaligned dcl 440 set ref 434 446* nargs based fixed bin(17,0) level 2 dcl 2-9 set ref 152* 157 185 191 403 442 nargs_init 000102 automatic fixed bin(17,0) dcl 2-16 set ref 139* 141 152 152 153 nm_flag 000125 automatic bit(1) unaligned dcl 81 set ref 144* 149* 168* 209 214 217 221 225* 315 355 389 nrels based fixed bin(10,0) level 2 dcl 4-5 set ref 186* 187* 196* 196 198 203 249* 250* 254* 254 256 264 270 270 273* 274 278 279 323 null builtin function dcl 115 ref 92 92 134 230 245 264 268 268 287 289 291 307 326 403 442 num_attr based fixed bin(17,0) level 2 dcl 5-7 ref 355 389 412 num_relations_alloc 000106 automatic fixed bin(10,0) dcl 4-9 set ref 185* 186 186 248* 249 249 270* 273 273 open_mode 000252 automatic char(20) unaligned dcl 100 set ref 299* 304* perm_flag 000126 automatic bit(1) unaligned dcl 81 set ref 142* 149* 176* 209 211* 214 230 233 pmr_ptr 000134 automatic pointer initial dcl 92 set ref 92* 236* 268 270 274 275 279 286 287* pn_flag 000127 automatic bit(1) unaligned dcl 81 set ref 142* 149* 160* 296 relation_name 1 based char(32) array level 2 packed unaligned dcl 4-5 set ref 198* 256* 275* 275 279* 279 328 335* 346* 351 351 367* 372* 382* 386 386 rels_left 000130 automatic bit(1) unaligned dcl 81 set ref 188* 190 191* 193* rslt_info based structure level 1 dcl 5-7 rslt_ptr 000112 automatic pointer dcl 5-32 set ref 134* 340* 355 357 372* 389 391 412 415 415 421 424 426 426 sci_ptr parameter pointer dcl 70 set ref 18 139* 154* 446* secured_db 15(03) based bit(1) level 2 packed unaligned dcl 1-53 ref 317 426 ssu_$abort_line 000046 constant entry external dcl 128 ref 446 ssu_$arg_count 000050 constant entry external dcl 129 ref 139 ssu_$arg_ptr 000052 constant entry external dcl 130 ref 154 static_area 144 based area level 2 dcl 1-53 ref 152 substr builtin function dcl 115 ref 193 tb_flag 000131 automatic bit(1) unaligned dcl 81 set ref 144* 149* 184* 209 214 225 227 temp_flag 000132 automatic bit(1) unaligned dcl 81 set ref 142* 149* 172* 209 212* 214 230 245 308 temp_tab_names based char(32) array unaligned dcl 3-3 ref 252 256 328 timing_mode 15(05) based bit(1) level 2 packed unaligned dcl 1-53 ref 234 239 297 300 338 343 370 376 413 419 tmr_ptr 000136 automatic pointer initial dcl 92 set ref 92* 249* 250 254 254 256 256 264 264* 268 270 278 279 289 290 291* tn_flag 000133 automatic bit(1) unaligned dcl 81 set ref 142* 149* 164* 209 214 214* 217 219 227* 313 335 367 ttn_ptr 26 based pointer level 2 in structure "lcb" dcl 1-53 in procedure "linus_list_db" ref 245 247 326 327 ttn_ptr 000104 automatic pointer dcl 3-5 in procedure "linus_list_db" set ref 247* 252 256 327* 328 type 000257 automatic varying char(10) dcl 101 set ref 421* 423* 424* 424 426* ucd 000312 automatic fixed bin(35,0) dcl 439 set ref 444* 446* vclock builtin function dcl 115 ref 234 239 297 300 338 343 370 376 413 419 work_area based area dcl 102 ref 186 249 273 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. fixed builtin function dcl 115 rel builtin function dcl 115 rslt_alloc automatic fixed bin(17,0) dcl 5-34 sys_info$max_seg_size external static fixed bin(35,0) dcl 104 NAMES DECLARED BY EXPLICIT CONTEXT. error 002606 constant entry internal dcl 434 ref 136 203 206 217 219 221 242 302 379 linus_list_db 000217 constant entry external dcl 18 write_attr_lines 002365 constant entry internal dcl 407 ref 360 393 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3136 3212 2705 3146 Length 3540 2705 54 312 231 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_list_db 348 external procedure is an external procedure. write_attr_lines internal procedure shares stack frame of external procedure linus_list_db. error internal procedure shares stack frame of external procedure linus_list_db. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_list_db 000100 ca_ptr linus_list_db 000102 nargs_init linus_list_db 000104 ttn_ptr linus_list_db 000106 num_relations_alloc linus_list_db 000110 mr_ptr linus_list_db 000112 rslt_ptr linus_list_db 000114 code linus_list_db 000115 icode linus_list_db 000116 i linus_list_db 000117 j linus_list_db 000120 k linus_list_db 000122 initial_mrds_vclock linus_list_db 000124 lg_flag linus_list_db 000125 nm_flag linus_list_db 000126 perm_flag linus_list_db 000127 pn_flag linus_list_db 000130 rels_left linus_list_db 000131 tb_flag linus_list_db 000132 temp_flag linus_list_db 000133 tn_flag linus_list_db 000134 pmr_ptr linus_list_db 000136 tmr_ptr linus_list_db 000140 db_path linus_list_db 000213 desc linus_list_db 000252 open_mode linus_list_db 000257 type linus_list_db 000312 ucd error THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry alloc_based free_based vclock THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. dsl_$get_pn dsl_$get_rslt_info dsl_$get_rslt_rels dsl_$get_temp_info ioa_ linus_convert_code mdbm_util_$display_descriptor mdbm_util_$trim_descriptor ssu_$abort_line ssu_$arg_count ssu_$arg_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. linus_data_$ldb_id linus_error_$incons_args linus_error_$inv_arg linus_error_$no_db linus_error_$no_tab mrds_data_$max_temp_rels mrds_error_$invalid_db_index LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000213 92 000224 132 000227 134 000230 136 000234 139 000254 141 000266 142 000270 144 000275 145 000300 149 000301 152 000310 153 000324 154 000333 155 000353 156 000355 157 000357 159 000363 160 000400 161 000402 162 000403 163 000404 164 000410 165 000412 166 000413 167 000414 168 000420 169 000422 170 000423 171 000424 172 000430 173 000432 174 000433 175 000434 176 000440 177 000442 178 000443 179 000444 180 000454 181 000456 182 000457 183 000460 184 000470 185 000472 186 000475 187 000511 188 000512 189 000514 190 000515 191 000520 193 000525 196 000537 198 000540 200 000551 202 000552 203 000553 205 000572 206 000573 207 000613 209 000614 211 000632 212 000634 214 000635 217 000653 219 000702 221 000731 225 000756 227 000764 230 000767 233 000777 234 001001 236 001013 239 001030 242 001044 245 001051 247 001062 248 001064 249 001067 250 001103 251 001104 252 001115 254 001125 256 001126 262 001135 264 001137 268 001143 270 001153 273 001156 274 001172 275 001201 277 001211 278 001213 279 001223 283 001237 284 001241 286 001242 287 001244 288 001246 289 001247 290 001253 291 001255 296 001257 297 001261 299 001273 300 001310 302 001324 304 001331 307 001354 308 001360 310 001376 313 001377 315 001417 317 001445 323 001535 325 001545 326 001552 327 001561 328 001563 331 001607 334 001611 335 001615 338 001643 340 001655 343 001676 346 001712 351 001742 355 002012 357 002025 359 002051 360 002054 363 002055 367 002056 370 002104 372 002116 376 002153 379 002167 382 002200 386 002224 389 002273 391 002305 392 002331 393 002334 397 002335 401 002337 402 002352 403 002353 405 002364 407 002365 412 002366 413 002375 415 002407 418 002425 419 002456 421 002473 423 002505 424 002511 426 002526 430 002603 432 002605 434 002606 442 002617 444 002630 445 002644 446 002645 448 002671 ----------------------------------------------------------- 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