COMPILATION LISTING OF SEGMENT linus_modify Compiled by: Multics PL/I Compiler, Release 33a, of May 30, 1990 Compiled at: ACTC Technologies Inc. Compiled on: 10/14/90 0919.1 mdt Sun Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1990 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 /****^ HISTORY COMMENTS: 15* 1) change(90-04-06,Leskiw), approve(90-10-05,MCR8202), 16* audit(90-10-11,Bubric), install(90-10-14,MR12.4-1039): 17* Changes calls to assign_round_ from assign_ so that rounding is performed 18* on input values from user. 19* END HISTORY COMMENTS */ 20 21 22 linus_modify: 23 proc (sci_ptr, lcb_ptr); 24 25 /* DESCRIPTION: 26* 27* This request modifies selected data in the data base. Data to be modified 28* must be contained within one table, and key columns cannot be modified. 29* 30* 31* 32* HISTORY: 33* 34* 77-05-01 J. C. C. Jagernauth: Initially written. 35* 36* 78-11-01 J. C. C. Jagernauth: Modified to improve expression parsing. 37* This request now does all quote stripping and all expressions are required 38* to be parenthesized. 39* 40* 80-02-05 Rickie E. Brinegar: Modified to permit null strings as arguments 41* for character and varying bit string modifies. 42* 43* 80-02-06 Rickie E. Brinegar: Modified to initialize sel_info.se_vals so 44* that .V. arguments would be passed to mrds. 45* 46* 80-03-14 Rickie E. Brinegar: Modified to use a work area defined on 47* lcb.linus_area_ptr instead of getting system free area. 48* 49* 80-08-15 Rickie E. Brinegar: Modified to fix some varying character string 50* code to permit modifies of varying character strings. 51* 52* 81-02-02 Rickie E. Brinegar: The declaration for the internal static 53* debug_switch was moved from db_on entry to the main entry. 54* 55* 81-02-20 Rickie E. Brinegar: Changed the calls to mdb_display_value_ to be 56* calls to mdb_display_data_value$ptr. The latter allows more than 256 57* characters to be displayed. 58* 59* 81-06-25 Rickie E. Brinegar: Changed to not attempt to use linus_variables 60* when the linus variable list pointer is null. This is in response to TR 61* 10194. 62* 63* 81-07-10 Rickie E. Brinegar: Modified to not assign values to 64* sel_info.mrds_items until after all expressions have been evaluated. This 65* permits the use of multiple column specs in a expression, and avoids a 66* Halloween effect. 67* 68* 81-07-13 Rickie E. Brinegar: Removed trapping of the conversion condition. 69* This is done in the linus module. 70* 71* 81-07-14 Rickie E. Brinegar: Removed the useless cleanup handler and 72* unreferenced variables. 73* 74* 81-09-28 Davids: Changed the check for "!" from a substr to an index in the 75* not_expr proc. 76* 77* 81-11-16 Rickie E. Brinegar: changed the call to cu_$gen_call to a call to 78* cu_$generate_call and added the timing of the calls to dsl_$modify and 79* dsl_$retrieve. 80* 81* 82-02-10 Paul W. Benjamin: ssu_ conversion. This program ranks with the 82* invoke request in the magnitude of the headaches that it caused in the 83* conversion. It allows its input to contain parens. This convention caused 84* the creation of the 'iteration mode'. Further, it expected a parenthesized 85* list to be a single argument. With iteration on (not the default at this 86* time) there is no problem, as the user had to quote the argument to get the 87* parens in anyway, but with iteration off, the parenthesized list may well 88* be several arguments. Some rather clumsy code was implemented herein to 89* get around that particular problem. 90* 91* 82-06-23 Dave J. Schimke: cleaned up the code associated with the above 92* mentioned conversion (from a parenthesized list to a single argument). 93* This was done to clarify the code and remove standards violations. 94* 95* 82-07-02 Dave J. Schimke: Added simple_arg to fix a stringrange_error. 96* 97* 82-09-03 Dave Schimke: Added a call to dsl_$get_pn to get the opening 98* mode and report an error if user tries to modify with a retrieval opening. 99* Declared mode, db_path, dsl_$get_path, and linus_error_$update_not_valid. 100* This is in response to phx 13742. 101* 102* 82-10-13 Dave Schimke: Added call to linus_table$async_retrieval before the 103* first retrieve to keep linus_table from getting lost when loading in the 104* incremental mode. 105* 106* 83-01-11 Dave Schimke: Replaced calls to linus_ok_response with calls to 107* linus_query. Deleted references to error_table_$long_record, out_code, 108* nread, buff_len, and linus_data_$m_id. Declared input, linus_query, prompt, 109* prompt_len, linus_query$yes_no, and length. This is an fix for the ssu 110* conversion which broke input from the terminal during a linus macro and 111* answers TRs 12445 & 13342 (linus 73). Also changed arg_len_bits.length to 112* arg_len_bits.len. 113* 114* 83-08-30 Bert Moberg: Added call to linus_translate_query$auto if no current 115* select expression is available 116**/ 117 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 */ 118 119 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 */ 120 121 3 1 /* BEGIN INCLUDE FILE linus_variables.incl.pl1 -- jaw 7/19/77 */ 3 2 3 3 dcl 1 variables aligned based (lv_ptr), /* info for all variables */ 3 4 2 nvars_alloc fixed bin, /* no. var. slots alloc. */ 3 5 2 nvars fixed bin, /* no. of variables currently defined */ 3 6 2 var_info (nvars_init refer (variables.nvars_alloc)), 3 7 3 name char (32), /* name of variable */ 3 8 3 var_ptr ptr, /* ptr to curr. value */ 3 9 3 bit_len fixed bin (35), /* bit length of current value */ 3 10 3 assn_type fixed bin, /* assign_ type code of current value */ 3 11 3 assn_len fixed bin (35), /* assign_ length of current value */ 3 12 3 desc bit (36); /* descrptor of current value */ 3 13 3 14 dcl lv_ptr ptr; 3 15 dcl nvars_init fixed bin; 3 16 3 17 /* END INCLUDE FILE linus_variables.incl.pl1 */ 122 123 4 1 /* BEGIN INCLUDE FILE linus_select_info.incl.pl1 */ 4 2 /* History: 77-07-29 J. A. Weeldreyer: Originally written. 4 3* Modified: 82-18-82 Dave Schimke: Added user_item.table_name 4 4**/ 4 5 dcl 1 select_info aligned based (si_ptr), /* info from LILA select clause */ 4 6 2 set_fn bit (1) unal, /* on if set fn to be applied */ 4 7 2 se_flags unal, /* flags pertaining to selection expr. */ 4 8 3 val_ret bit (1) unal, /* valid for retrieval */ 4 9 3 val_dtt bit (1) unal, /* valid for define_temp_table */ 4 10 3 val_del bit (1) unal, /* valid for delete */ 4 11 3 val_mod bit (1) unal, /* valid for modify */ 4 12 2 dup_flag bit (1) unal, /* on if dup explic. spec. somewhere */ 4 13 2 unique_flag bit (1) unal, /* on if unique explic. spec. somewhere */ 4 14 2 pad bit (29) unal, /* reserved */ 4 15 2 prior_sf_ptr ptr, /* pointer to set fns for prior eval. */ 4 16 2 se_ptr ptr, /* pointer to mrds selection expression */ 4 17 2 sel_items_ptr ptr, /* pointer to list of selected items */ 4 18 2 sel_items_len fixed bin, /* length in characters of list of selected items */ 4 19 2 se_len fixed bin (35), /* length of mrds sel. expr. */ 4 20 2 nsv_alloc fixed bin, /* no. of se. vals aloc. */ 4 21 2 nmi_alloc fixed bin, /* no. of mrds items alloc. */ 4 22 2 nui_alloc fixed bin, /* no. of user items alloc. */ 4 23 2 nsevals fixed bin, /* number of selection expr. vaules */ 4 24 2 n_mrds_items fixed bin, /* no. of items in mrds select list */ 4 25 2 n_user_items fixed bin, /* no. of items user will see */ 4 26 2 se_vals (nsv_init refer (select_info.nsv_alloc)), 4 27 3 arg_ptr ptr, 4 28 3 desc_ptr ptr, 4 29 2 mrds_item (nmi_init refer (select_info.nmi_alloc)), /* mrds select items */ 4 30 3 arg_ptr ptr, /* pointer to receiving field */ 4 31 3 bit_len fixed bin (35), /* bit length of receiving field */ 4 32 3 desc bit (36), /* descriptor for receiving field */ 4 33 3 assn_type fixed bin, /* type code for assign_ */ 4 34 3 assn_len fixed bin (35), /* length for assign_ */ 4 35 2 user_item (nui_init refer (select_info.nui_alloc)), /* user select item */ 4 36 3 name char (32) var, /* name for col. header */ 4 37 3 table_name char (32) var, /* name of containing linus table */ 4 38 3 item_type fixed bin, /* indicates type of item: 4 39* 1 => raw mrds, 4 40* 2 => expr. */ 4 41 3 rslt_desc bit (36), /* descriptor for expr. result */ 4 42 3 rslt_bit_len fixed bin (35), /* bit length of expr. result */ 4 43 3 rslt_assn_ptr ptr, /* pointer to expr. result storage loc. */ 4 44 3 rslt_assn_type fixed bin, /* assign_ type code of expr. result */ 4 45 3 rslt_assn_len fixed bin (35), /* assign_ length for expr. result */ 4 46 3 item_ptr ptr; /* pointer to item or expr. or applied set_func. structure */ 4 47 4 48 dcl (nsv_init, nmi_init, nui_init) fixed bin; 4 49 dcl si_ptr ptr; 4 50 4 51 /* END INCLUDE FILE linus_select_info.incl.pl1 */ 124 125 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 126 127 6 1 /* BEGIN INCLUDE FILE linus_arg_list.incl.pl1 -- jccj 4/15/77 */ 6 2 6 3 dcl 1 char_desc aligned based (char_ptr), /* Structure for character descriptors */ 6 4 2 fb_desc bit (36) aligned init ("100000100000000000000000000000100011"b), /* Fixed bin descriptor */ 6 5 2 n_chars fixed bin, 6 6 2 arr (n_chars_init refer (char_desc.n_chars)), 6 7 3 const bit (12) unal init ("101010100000"b), /* Constant part */ 6 8 3 var bit (24) unal; /* Variable part */ 6 9 6 10 dcl char_ptr ptr; 6 11 dcl n_chars_init fixed bin; 6 12 6 13 /* END INCLUDE FILE linus_arg_list.incl.pl1 */ 128 129 7 1 /* BEGIN INCLUDE FILE linus_token_data.incl.pl1 -- jaw 8/7/78 */ 7 2 7 3 dcl 1 token_data aligned based (td_ptr), /* data for lila tokens */ 7 4 2 key fixed bin (17) unal, /* key of token */ 7 5 2 must_free bit (1) unal, /* on if value must be freed */ 7 6 2 temp_tab bit (1) unal, /* on if temporary table */ 7 7 2 reserved bit (16) unal, 7 8 2 mvar char (32) var, /* mrds variable if identifier */ 7 9 2 lvar char (32) var, /* linus variable if identifier */ 7 10 2 length fixed bin (35), /* char length of token value */ 7 11 2 t_ptr ptr; /* points to token value */ 7 12 7 13 dcl ((NULL init (0)), 7 14 (RP init (1)), 7 15 (COL_SPEC init (2)), 7 16 (LINUS_VAR init (3)), 7 17 (CONST init (4)), 7 18 (SET_FN init (5)), 7 19 (SCAL_FN init (6)), 7 20 (LP init (7)), 7 21 (STAR init (8)), 7 22 (DIV init (9)), 7 23 (PLUS init (10)), 7 24 (MINUS init (11)), 7 25 (TAB_NAME init (12)), 7 26 (ROW_TAB_PAIR init (13)), 7 27 (UNION init (14)), 7 28 (INTER init (15)), 7 29 (DIFFER init (16)), 7 30 (ROW_DES init (17)), 7 31 (LB init (18)), 7 32 (RB init (19)), 7 33 (SELECT init (20)), 7 34 (NOT init (21)), 7 35 (AND init (22)), 7 36 (OR init (23)), 7 37 (EQ init (24)), 7 38 (NE init (25)), 7 39 (GT init (26)), 7 40 (GE init (27)), 7 41 (LT init (28)), 7 42 (LE init (29)), 7 43 (FROM init (30)), 7 44 (WHERE init (31)), 7 45 (DUP init (32)), 7 46 (UNIQUE init (33)), 7 47 (COMMA init (34))) fixed bin int static options (constant); 7 48 7 49 dcl td_ptr ptr; 7 50 7 51 /* END INCLUDE FILE linus_token_data.incl.pl1 */ 130 131 8 1 /* BEGIN INCLUDE FILE linus_expession.incl.pl1 -- jaw 6/29/77 */ 8 2 8 3 dcl 1 expression aligned based (ex_ptr), /* internal representation of an 8 4* arithmetic expr. Is in postfix polish form. */ 8 5 2 rslt_desc bit (36), /* descriptor for result */ 8 6 2 nelems fixed bin, /* no. of operators + no of operands */ 8 7 2 elem (nelems_init refer (expression.nelems)), 8 8 3 type fixed bin (4) unal, /* 1 => constant 8 9* 2 => linus variable 8 10* 3 => scalar function 8 11* 4 => set function 8 12* 5 => not used 8 13* 6 => data base item 8 14* 15 => operator */ 8 15 3 op_code fixed bin (3) unal, /* 1 => add 8 16* 2 => subtract 8 17* 3 => multiply 8 18* 4 => divide */ 8 19 3 reserved bit (27) unal, 8 20 3 desc bit (36), /* descriptor for item */ 8 21 3 bit_length fixed bin (35), /* bit length of item */ 8 22 3 assn_ptr ptr, /* assign_ pointer to item */ 8 23 3 assn_type fixed bin, /* assign_ type code for item */ 8 24 3 assn_len fixed bin (35), /* assign_ length for this item */ 8 25 3 fn_ptr ptr; /* pointer to function structure */ 8 26 8 27 dcl ex_ptr ptr; 8 28 dcl nelems_init fixed bin; 8 29 8 30 /* END INCLUDE FILE linus_expression.incl.pl1 */ 132 133 134 dcl sci_ptr ptr; /* for ssu_ */ 135 136 dcl 1 sel_info aligned based (sel_ptr) like select_info; 137 dcl C_R char (1) int static options (constant) init (" 138 "); 139 dcl DATA_BASE fixed bin (3) int static options (constant) init (6); 140 dcl EXPR fixed bin (2) int static options (constant) init (2); 141 dcl debug_switch bit (1) int static init ("0"b); 142 143 dcl 1 arg_len_bits based, 144 2 pad bit (12) unal, 145 2 len bit (24) unal; /* Length of argument to be passed in system standard arg list */ 146 147 dcl combined_arg_idx (linus_data_$max_req_args) bit (1) 148 based (combined_arg_idx_ptr); /* map of allocated combined_args */ 149 dcl combined_arg char 150 (mod_ch_argl.arg.arg_len (mod_ch_argl.nargs)) based; /* parenthesized list */ 151 152 dcl input_arg char (char_argl.arg.arg_len (input_arg_num)) 153 based (char_argl.arg.arg_ptr (input_arg_num)); /* template for arg in char_argl */ 154 dcl input_buffer (linus_data_$buff_len) char (1) based (in_buf_ptr); 155 /* Max length of input buffer */ 156 dcl input char(linus_data_$buff_len) var; 157 dcl prompt char(40) var; 158 dcl prompt_len fixed bin; 159 160 dcl mod_buf char (mb_len) based (mb_ptr); 161 dcl mod_curr char (linus_data_$buff_len); 162 dcl sel_expr char (sel_info.se_len) based (sel_info.se_ptr); 163 dcl tmp_buf char (tb_len) based (tb_ptr); 164 dcl tmp_char char (mod_ch_argl.arg.arg_len (i)) 165 based (mod_ch_argl.arg.arg_ptr (i)); 166 167 dcl (interactive, expr_found, bf_flag, yes_no_flag, found_end_paren, simple_arg) bit (1); 168 169 dcl offset (10) bit (1) based; 170 171 dcl (ano_curr_len, caller, desc, i, in_buf_index, input_arg_num, k, l, m, 172 mb_len, source_type, tb_len, temp) fixed bin; 173 174 dcl initial_mrds_vclock float bin (63); 175 dcl db_path char (168) var; 176 dcl mode char (20); 177 178 dcl ANOTHER char (8) init ("-another"); 179 dcl CURRENT char (8) init ("-current"); 180 dcl NL char(1) int static options (constant) init (" 181 "); 182 183 dcl (code, icode, mod_lit_offset, source_len) fixed bin (35); 184 185 dcl cleanup condition; 186 187 dcl (addr, addrel, after, before, fixed, index, length, null, rel, rtrim, string, substr, unspec, vclock) 188 builtin; 189 190 dcl ( 191 interactive_ptr init (null), 192 in_buf_ptr init (null), 193 mb_ptr init (null), 194 tb_ptr init (null), 195 mod_ch_ptr init (null), 196 destination_ptr init (null), 197 start_ptr init (null), 198 mod_lit_ptr init (null), 199 arg_l_ptr init (null), 200 re_ptr init (null), 201 sel_ptr init (null), 202 renv_ptr init (null), 203 e_ptr init (null), 204 env_ptr init (null), 205 combined_arg_idx_ptr init (null) 206 ) ptr; 207 208 dcl 1 arg_l like arg_list based (arg_l_ptr); 209 210 dcl ( 211 linus_data_$buff_len, 212 linus_data_$max_req_args, 213 linus_error_$bad_num_args, 214 linus_error_$linus_var_not_defined, 215 linus_error_$mod_not_valid, 216 linus_error_$no_db, 217 linus_error_$null_input, 218 linus_error_$unbal_parens, 219 linus_error_$update_not_allowed, 220 mrds_error_$tuple_not_found, 221 sys_info$max_seg_size 222 ) fixed bin (35) ext; 223 224 dcl 1 mod_ch_argl aligned based (mod_ch_ptr), /* like char_argl */ 225 2 nargs fixed bin, 226 2 arg (nargs_init refer (mod_ch_argl.nargs)), 227 3 arg_ptr ptr, 228 3 arg_len fixed bin; 229 230 dcl work_area area (sys_info$max_seg_size) based (lcb.linus_area_ptr); 231 232 dcl assign_round_ 233 entry (ptr, fixed bin, fixed bin (35), ptr, fixed bin, fixed bin (35)); 234 dcl cu_$generate_call entry (entry, ptr); 235 dcl dsl_$get_pn entry (fixed bin (35), char (168) var, char (20), fixed bin (35)); 236 dcl dsl_$modify entry options (variable); 237 dcl dsl_$retrieve entry options (variable); 238 dcl ioa_ entry options (variable); 239 dcl ioa_$nnl entry options (variable); 240 dcl ioa_$rsnnl entry() options(variable); 241 dcl linus_eval_expr 242 entry (ptr, ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 243 dcl linus_modify_build_expr_tab 244 entry (ptr, ptr, fixed bin, fixed bin, ptr, ptr, fixed bin (35), ptr, 245 fixed bin (35)); 246 dcl linus_query entry (ptr, char(*) var, char(*) var); /* Linus subroutines */ 247 dcl linus_query$yes_no entry (ptr,bit(1), char(*) var); 248 dcl linus_table$async_retrieval 249 entry (ptr, fixed bin (35)); 250 dcl linus_translate_query$auto entry (ptr, ptr); 251 dcl mdb_display_data_value$ptr entry (ptr, ptr); 252 253 dcl ( 254 mdbm_util_$character_data_class, 255 mdbm_util_$varying_data_class 256 ) entry (ptr) returns (bit (1)); 257 dcl ssu_$abort_line entry options (variable); 258 dcl ssu_$arg_count entry (ptr, fixed bin); 259 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); 260 261 mod_lit_ptr, sel_ptr, mod_ch_ptr, arg_l_ptr, ex_ptr, char_ptr, mb_ptr, 262 in_buf_ptr, ca_ptr, al_ptr = null; 263 264 mb_len, icode, code = 0; 265 ano_curr_len = 8; 266 in_buf_index = 1; 267 yes_no_flag = "1"b; 268 interactive, expr_found, bf_flag = "0"b; 269 source_type = 42; 270 caller = 1; 271 nargs_init = linus_data_$max_req_args; 272 allocate mod_ch_argl in (work_area); 273 allocate token_data in (work_area); 274 token_data.mvar, token_data.lvar = ""; 275 mod_ch_argl.nargs = 0; 276 277 if lcb.db_index = 0 then 278 call error (linus_error_$no_db); 279 call dsl_$get_pn (lcb.db_index, db_path, mode, code); 280 if substr (mode, 1, 9) = "retrieval" | substr (mode, 11, 9) = "retrieval" then 281 call error (linus_error_$update_not_allowed); 282 if lcb.si_ptr = null then call linus_translate_query$auto (sci_ptr, lcb_ptr); /* try translating it */ 283 if lcb.si_ptr = null then return; /* No good? Oh, well */ 284 285 si_ptr = lcb.si_ptr; 286 nsv_init = select_info.nsevals; 287 nmi_init = select_info.n_mrds_items; 288 nui_init = select_info.n_user_items; 289 allocate sel_info in (work_area); 290 destination_ptr = sel_ptr; 291 292 sel_info.se_flags.val_mod = select_info.se_flags.val_mod; 293 /* init sel_info */ 294 sel_info.se_ptr = select_info.se_ptr; 295 sel_info.se_len = select_info.se_len; 296 sel_info.nsevals = select_info.nsevals; 297 sel_info.n_mrds_items = select_info.n_mrds_items; 298 sel_info.n_user_items = select_info.n_user_items; 299 do i = 1 to sel_info.nsevals; 300 sel_info.se_vals.arg_ptr (i) = select_info.se_vals.arg_ptr (i); 301 sel_info.se_vals.desc_ptr (i) = select_info.se_vals.desc_ptr (i); 302 end; 303 do i = 1 to sel_info.n_mrds_items; 304 sel_info.mrds_item.arg_ptr (i) = select_info.mrds_item.arg_ptr (i); 305 sel_info.mrds_item.bit_len (i) = select_info.mrds_item.bit_len (i); 306 sel_info.mrds_item.desc (i) = select_info.mrds_item.desc (i); 307 sel_info.mrds_item.assn_type (i) = select_info.mrds_item.assn_type (i); 308 sel_info.mrds_item.assn_len (i) = select_info.mrds_item.assn_len (i); 309 end; 310 do i = 1 to sel_info.n_user_items; 311 sel_info.user_item.name (i) = select_info.user_item.name (i); 312 sel_info.user_item.item_type (i) = select_info.user_item.item_type (i); 313 sel_info.user_item.rslt_desc (i) = select_info.mrds_item.desc (i); 314 sel_info.user_item.item_ptr (i) = select_info.user_item.item_ptr (i); 315 end; 316 lv_ptr = lcb.lv_ptr; /* Init linus_variables pointer */ 317 if ^sel_info.se_flags.val_mod then 318 call error (linus_error_$mod_not_valid); 319 in_buf_ptr = null; 320 call ssu_$arg_count (sci_ptr, nargs_init); 321 if nargs_init = 0 then /* No arguments passed */ 322 call interactive_modify; /* Data must be obtained interactively */ 323 else do; 324 allocate char_argl in (lcb.static_area); 325 on cleanup begin; 326 if ca_ptr ^= null 327 then free char_argl; 328 if combined_arg_idx_ptr ^= null 329 then do i = 1 to linus_data_$max_req_args; 330 if combined_arg_idx (i) 331 then free mod_ch_argl.arg.arg_ptr (i) -> combined_arg; 332 end; 333 end; 334 do i = 1 to nargs_init; 335 call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i)); 336 end; 337 338 /* The following do-group exists solely for the purpose of putting multiple args 339* that comprise a parenthesized list into a new, single argument. It is only 340* a problem when the user has iteration-mode off. If it is on, the user has to 341* quote a parenthesized list in which case it is a single argument anyway. The 342* programmer was suffering from a singular lack of creativity when this was 343* done. Works, though. 344**/ 345 if ^lcb.iteration 346 then do; 347 mod_ch_argl.nargs = 0; 348 do i = 1 to nargs_init; 349 simple_arg = "0"b; 350 input_arg_num = i; 351 if (char_argl.arg.arg_len (i) = 0) 352 then simple_arg = "1"b; 353 else if (substr (input_arg, 1, 1) = "(") & (substr (input_arg, char_argl.arg.arg_len (i), 1) ^= ")") 354 then do; /* beginning of parenthesized list */ 355 found_end_paren = "0"b; 356 do k = i to nargs_init while (^found_end_paren); 357 input_arg_num = k; 358 if substr (input_arg, char_argl.arg.arg_len (k), 1) = ")" 359 then do; /* when ending paren found */ 360 found_end_paren = "1"b; 361 mod_ch_argl.nargs = mod_ch_argl.nargs + 1; 362 mod_ch_argl.arg.arg_len (mod_ch_argl.nargs) = 0; 363 do l = i to k; /* accumulate lengths */ 364 mod_ch_argl.arg.arg_len (mod_ch_argl.nargs) 365 = mod_ch_argl.arg.arg_len (mod_ch_argl.nargs) 366 + char_argl.arg.arg_len (l) + 1; 367 end; 368 mod_ch_argl.arg.arg_len (mod_ch_argl.nargs) 369 = mod_ch_argl.arg.arg_len (mod_ch_argl.nargs) - 1; 370 if combined_arg_idx_ptr = null 371 then do; 372 allocate combined_arg_idx in (lcb.static_area); 373 unspec (combined_arg_idx) = "0"b; 374 end; 375 allocate combined_arg set (mod_ch_argl.arg.arg_ptr (mod_ch_argl.nargs)) in (lcb.static_area); 376 combined_arg_idx (mod_ch_argl.nargs) = "1"b; 377 mod_ch_argl.arg.arg_ptr (mod_ch_argl.nargs) -> combined_arg = ""; 378 do l = i to k; /* create new arg_list */ 379 input_arg_num = l; 380 if l = i 381 then mod_ch_argl.arg.arg_ptr (mod_ch_argl.nargs) -> combined_arg 382 = input_arg; 383 else mod_ch_argl.arg.arg_ptr (mod_ch_argl.nargs) -> combined_arg = 384 rtrim (mod_ch_argl.arg.arg_ptr (mod_ch_argl.nargs) -> combined_arg) || " " || input_arg; 385 end; 386 end; 387 end; 388 389 if found_end_paren = "0"b 390 then call error (linus_error_$unbal_parens); 391 else i = k; 392 end; /* end parenthesized list */ 393 else simple_arg = "1"b; 394 if (simple_arg) then do; /* vanilla argument */ 395 mod_ch_argl.nargs = mod_ch_argl.nargs + 1; 396 mod_ch_argl.arg.arg_len (mod_ch_argl.nargs) = char_argl.arg.arg_len (i); 397 mod_ch_argl.arg.arg_ptr (mod_ch_argl.nargs) = char_argl.arg.arg_ptr (i); 398 end; 399 end; 400 end; 401 else mod_ch_argl = char_argl; /* iteration on */ 402 403 i = mod_ch_argl.nargs; /* is last input arg "-bf" ? */ 404 if tmp_char = "-brief" | tmp_char = "-bf" then do; 405 bf_flag = "1"b; /* brief mode */ 406 mod_ch_argl.nargs = mod_ch_argl.nargs - 1; /* Remove "-brief" or "-bf" from char argl */ 407 end; 408 if mod_ch_argl.nargs = 0 then 409 call interactive_modify; 410 else do; 411 412 /* place input arguments in buffer to be used by this request only */ 413 do i = 1 to mod_ch_argl.nargs; 414 mb_len = mb_len + mod_ch_argl.arg_len (i) + 1; 415 end; 416 mb_len = mb_len + 1; /* for carriage return */ 417 allocate mod_buf in (work_area); 418 mod_buf = ""; 419 tb_ptr = mb_ptr; 420 do i = 1 to mod_ch_argl.nargs; 421 tb_len = mod_ch_argl.arg_len (i); 422 tmp_buf = tmp_char; 423 mod_ch_argl.arg_ptr (i) = tb_ptr; 424 do k = 1 to tb_len + 1; /* bump ptr into the output buffer */ 425 tb_ptr = addr (tb_ptr -> offset (10)); 426 end; 427 end; 428 tb_len = 1; 429 tmp_buf = C_R; /* place carriage return at end of line */ 430 431 call bf_modify; 432 end; 433 end; 434 435 if ca_ptr ^= null 436 then free char_argl; 437 if combined_arg_idx_ptr ^= null 438 then do i = 1 to linus_data_$max_req_args; 439 if combined_arg_idx (i) 440 then free mod_ch_argl.arg.arg_ptr (i) -> combined_arg; 441 end; 442 return; 443 444 db_on: 445 entry; 446 447 /* Usage: 448* linus_modify$db_on 449* 450* Turns on a switch which causes the value of the current 451* selection expression to be displayed at the terminal. 452**/ 453 454 debug_switch = "1"b; 455 return; 456 457 db_off: 458 entry; 459 460 /* Usage: 461* linus_modify$db_off 462* 463* Turns off the switch which causes the value of the current 464* selection expression to be displayed at the terminal. 465**/ 466 467 debug_switch = "0"b; 468 return; 469 470 interactive_modify: 471 proc; 472 473 call ioa_ (""); 474 interactive = "1"b; 475 allocate input_buffer in (work_area); 476 do l = 1 to sel_info.n_user_items; 477 interactive_ptr = addr (input_buffer (in_buf_index)); 478 call ioa_$rsnnl (" ^a? ", prompt, prompt_len, sel_info.user_item.name (l)); 479 call linus_query (lcb_ptr, input, prompt); 480 substr (string(input_buffer), in_buf_index, length (input)) = input; 481 mod_ch_argl.nargs = mod_ch_argl.nargs + 1; /* Increment number of arguments */ 482 mod_ch_argl.arg.arg_len (mod_ch_argl.nargs) = length (input); 483 /* Set attribute length */ 484 mod_ch_argl.arg.arg_ptr (mod_ch_argl.nargs) = interactive_ptr; 485 /* Set pointer of attribute value or 486* expression */ 487 i = mod_ch_argl.nargs; 488 in_buf_index = in_buf_index + mod_ch_argl.arg.arg_len (i) + 1; /* Set up for next input */ 489 substr (input_buffer (in_buf_index - 1), 1, 1) = " "; 490 end; 491 substr (input_buffer (in_buf_index - 1), 1, 1) = C_R; 492 call bf_modify; 493 494 end interactive_modify; 495 496 497 498 verbose_modify: 499 proc; 500 501 do i = 1 to sel_info.n_user_items; 502 call ioa_$nnl ("^/^a = ^a", sel_info.user_item.name (i), tmp_char); 503 end; 504 505 end verbose_modify; 506 507 bf_modify: 508 proc; /* modify data base */ 509 510 dcl var_expr bit (1); 511 512 if mod_ch_argl.nargs ^= sel_info.n_user_items /* must be one mod arg for every user item */ 513 then call error (linus_error_$bad_num_args); 514 515 call parse_expr; 516 517 if ^bf_flag then do; 518 call verbose_modify; 519 call linus_query$yes_no (lcb_ptr, yes_no_flag, NL||" OK? "); 520 end; 521 522 if yes_no_flag then do; 523 if ^expr_found then 524 call const_mod; 525 526 else do; /* expression found */ 527 var_expr = "0"b; 528 do l = 1 to sel_info.n_user_items; 529 if sel_info.user_item.item_type (l) = EXPR then do; 530 ex_ptr = sel_info.user_item.item_ptr (l); 531 do i = 1 to expression.nelems; /* find number of database items */ 532 if expression.elem.type (i) = DATA_BASE then 533 var_expr = "1"b; 534 end; 535 if ^var_expr then /* expression has constant result */ 536 call 537 linus_eval_expr (lcb_ptr, 538 sel_info.user_item.item_ptr (l), destination_ptr, 539 caller, l, icode); 540 end; 541 end; 542 if ^var_expr then /* expression has constant result */ 543 call const_mod; 544 else do; /* expression result varies with each tuple */ 545 call set_up; 546 call expr_set_up; 547 do while (icode = 0); 548 do l = 1 to sel_info.n_user_items; 549 if sel_info.user_item.item_type (l) = EXPR then 550 call 551 linus_eval_expr (lcb_ptr, 552 sel_info.user_item.item_ptr (l), destination_ptr, 553 caller, l, icode); 554 end; 555 do l = 1 to sel_info.n_user_items; 556 if sel_info.user_item.item_type (l) = EXPR then 557 call 558 assign_round_ (sel_info.mrds_item.arg_ptr (l), 559 sel_info.mrds_item.assn_type (l), 560 sel_info.mrds_item.assn_len (l), 561 sel_info.user_item.rslt_assn_ptr (l), 562 sel_info.user_item.rslt_assn_type (l), 563 sel_info.user_item.rslt_assn_len (l)); 564 else call not_expr; 565 end; 566 if icode = 0 then do; 567 call bump_var_ptrs; /* increment (by 1) varying argument descriptor pointers */ 568 if lcb.timing_mode then 569 initial_mrds_vclock = vclock; 570 call cu_$generate_call (dsl_$modify, al_ptr); 571 /* modify current */ 572 if lcb.timing_mode then 573 lcb.mrds_time = 574 lcb.mrds_time + (vclock - initial_mrds_vclock); 575 if icode = 0 then do; 576 call reset_var_ptrs; /* decrement (by 1) varying argument descriptor pointers */ 577 call linus_table$async_retrieval (lcb_ptr, code); 578 if icode ^= 0 then 579 call error (icode); 580 if lcb.timing_mode then 581 initial_mrds_vclock = vclock; 582 call cu_$generate_call (dsl_$retrieve, arg_l_ptr); 583 /* retrieve another */ 584 if lcb.timing_mode then 585 lcb.mrds_time = 586 lcb.mrds_time + (vclock - initial_mrds_vclock); 587 end; 588 end; 589 end; 590 if icode ^= mrds_error_$tuple_not_found then 591 call error (icode); 592 end; 593 end; 594 end; 595 596 const_mod: 597 proc; 598 599 call set_up; 600 do l = 1 to sel_info.n_user_items; 601 if sel_info.user_item.item_type (l) = EXPR then 602 call 603 assign_round_ (sel_info.mrds_item.arg_ptr (l), 604 sel_info.mrds_item.assn_type (l), 605 sel_info.mrds_item.assn_len (l), 606 sel_info.user_item.rslt_assn_ptr (l), 607 sel_info.user_item.rslt_assn_type (l), 608 sel_info.user_item.rslt_assn_len (l)); 609 else call not_expr; 610 end; 611 call bump_var_ptrs; /* increment (by 1) varying argument descriptor pointers */ 612 if lcb.timing_mode then 613 initial_mrds_vclock = vclock; 614 call cu_$generate_call (dsl_$modify, al_ptr); /* Call to MRDS modify */ 615 if lcb.timing_mode then 616 lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock); 617 call reset_var_ptrs; /* decrement (by 1) varying argument descriptor pointers */ 618 if icode ^= 0 then 619 call error (icode); 620 621 end const_mod; 622 623 bump_var_ptrs: 624 proc; 625 626 /* increment (by 1) the varying argument descriptor pointers in arg_list */ 627 628 dcl (i, k) fixed bin; 629 630 desc = arg_list.arg_count / 2; /* number of descriptors */ 631 do i = 1 to desc; 632 k = desc + i; /* point to descriptor */ 633 if mdbm_util_$varying_data_class (arg_list.arg_des_ptr (k)) then 634 arg_list.arg_des_ptr (i) = addrel (arg_list.arg_des_ptr (i), +1); 635 end; 636 637 end bump_var_ptrs; 638 639 640 reset_var_ptrs: 641 proc; 642 643 /* increment (by 1) the varying argument descriptor pointers in arg_list */ 644 645 dcl (i, k) fixed bin; 646 647 desc = arg_list.arg_count / 2; /* number of descriptors */ 648 do i = 1 to desc; 649 k = desc + i; /* point to descriptor */ 650 if mdbm_util_$varying_data_class (arg_list.arg_des_ptr (k)) then 651 arg_list.arg_des_ptr (i) = addrel (arg_list.arg_des_ptr (i), -1); 652 end; 653 654 end reset_var_ptrs; 655 656 not_expr: 657 proc; /* set items that are not expressions */ 658 659 dcl tmp_char char (mod_ch_argl.arg.arg_len (l)) 660 based (mod_ch_argl.arg.arg_ptr (l)); 661 662 if sel_info.user_item.item_type (l) ^= EXPR then do; 663 if tmp_char = "" 664 & 665 ^ 666 mdbm_util_$character_data_class (addr (sel_info.mrds_item.desc (l))) 667 & 668 ^mdbm_util_$varying_data_class (addr (sel_info.mrds_item.desc (l))) 669 then call error (linus_error_$null_input); /* check for null items */ 670 if index (tmp_char, "!") = 1 then do; /* Process LINUS VARIABLES? */ 671 if lv_ptr = null then 672 call error (linus_error_$linus_var_not_defined); 673 do m = 1 to variables.nvars 674 while (variables.var_info.name (m) ^= substr (tmp_char, 2)); 675 end; 676 if m > variables.nvars then 677 call error (linus_error_$linus_var_not_defined); 678 else call 679 assign_round_ (sel_info.mrds_item.arg_ptr (l), 680 sel_info.mrds_item.assn_type (l), 681 sel_info.mrds_item.assn_len (l), 682 variables.var_info.var_ptr (m), 683 variables.var_info.assn_type (m), 684 variables.var_info.assn_len (m)); 685 end; 686 else do; 687 if tmp_char ^= sel_info.user_item.name (l) then do; 688 source_len = mod_ch_argl.arg.arg_len (l); /* Used in call to assign_round_ */ 689 call 690 assign_round_ (sel_info.mrds_item.arg_ptr (l), 691 sel_info.mrds_item.assn_type (l), 692 sel_info.mrds_item.assn_len (l), mod_ch_argl.arg.arg_ptr (l), 693 source_type, source_len); 694 end; 695 end; 696 end; 697 698 end not_expr; 699 700 set_up: 701 proc; /* common for all types of modify */ 702 703 n_chars_init = 2; /* Number for allocate */ 704 allocate char_desc in (work_area); /* Character descriptor */ 705 char_desc.arr.const (2) = char_desc.arr.const (1); 706 desc = sel_info.n_mrds_items + sel_info.nsevals + 3; /* Offset for descriptors */ 707 num_ptrs = desc * 2; /* Number of pointers to be passed in arg_list */ 708 allocate arg_list in (work_area); /* System standard argument list */ 709 allocate arg_l in (work_area); 710 arg_list.arg_des_ptr (desc) = addr (icode); /* Pointer to icode */ 711 712 arg_list.arg_des_ptr (num_ptrs) = addr (char_desc.fb_desc); 713 /* Return code descriptor */ 714 arg_list.arg_des_ptr (1) = addr (lcb.db_index); /* Data base index */ 715 arg_list.arg_des_ptr (desc + 1) = addr (char_desc.fb_desc); 716 /* Data base index descriptor */ 717 arg_list.arg_count, arg_list.desc_count = num_ptrs; /* Initialize argument list header */ 718 arg_list.code = 4; 719 arg_list.pad = 0; 720 721 char_desc.arr.var (1), char_desc.arr.var (2) = 722 addr (sel_info.se_len) -> arg_len_bits.len; 723 arg_list.arg_des_ptr (2) = sel_info.se_ptr; 724 arg_list.arg_des_ptr (desc + 2) = addr (char_desc.arr (2)); 725 if debug_switch then do; 726 call ioa_ ("Selection expression:"); 727 728 /* 81-02-20 Rickie E. Brinegar: Start changes ****************************** */ 729 730 call 731 mdb_display_data_value$ptr (select_info.se_ptr, 732 addr (char_desc.arr (1))); 733 734 /* 81-02-20 Rickie E. Brinegar: End changes ******************************** */ 735 736 end; /* if debug_switch */ 737 if sel_info.nsevals ^= 0 then 738 do l = 1 to sel_info.nsevals; 739 arg_list.arg_des_ptr (2 + l) = sel_info.se_vals.arg_ptr (l); 740 arg_list.arg_des_ptr (2 + l + desc) = sel_info.se_vals.desc_ptr (l); 741 end; 742 i = 1; /* mrds items index */ 743 do l = 3 + sel_info.nsevals 744 to 2 + sel_info.n_mrds_items + sel_info.nsevals; /* use sel_info.data */ 745 arg_list.arg_des_ptr (l) = sel_info.mrds_item.arg_ptr (i); 746 arg_list.arg_des_ptr (l + desc) = addr (sel_info.mrds_item.desc (i)); 747 i = i + 1; 748 end; 749 arg_l = arg_list; 750 arg_l.arg_des_ptr (desc + 2) = addr (char_desc.arr (1)); 751 752 end set_up; 753 754 755 expr_set_up: 756 proc; /* called if expression was found */ 757 758 sel_expr = 759 before (sel_expr, "-select") || "-select -dup" 760 || substr (after (sel_expr, "-select"), 6); /* must modify duplicates */ 761 call linus_table$async_retrieval (lcb_ptr, code); 762 if icode ^= 0 then 763 call error (icode); 764 if lcb.timing_mode then 765 initial_mrds_vclock = vclock; 766 call cu_$generate_call (dsl_$retrieve, arg_l_ptr); 767 if lcb.timing_mode then 768 lcb.mrds_time = lcb.mrds_time + (vclock - initial_mrds_vclock); 769 sel_expr = 770 before (sel_expr, "-dup") || " " || after (sel_expr, "-dup"); 771 /* remove "-dup" for modify "-current" */ 772 if icode ^= 0 then 773 call error (icode); 774 char_desc.arr.var (1) = addr (ano_curr_len) -> arg_len_bits.len; 775 arg_l.arg_des_ptr (2) = addr (ANOTHER); /* for another retrieve */ 776 l = index (sel_expr, "-select"); 777 i = index (sel_expr, "-where") - 1; 778 if i <= 0 then 779 i = sel_info.se_len; /* no where clause exists */ 780 temp = i - l + 1; 781 mod_curr = CURRENT || substr (sel_expr, l + 7, temp - 7); 782 temp = temp + 1; 783 char_desc.arr.var (2) = addr (temp) -> arg_len_bits.len; 784 arg_list.arg_des_ptr (2) = addr (mod_curr); /* for current modify */ 785 786 end expr_set_up; 787 788 end bf_modify; 789 790 parse_expr: 791 proc; /* parse expression and build the modify expression table */ 792 793 expr_found = "0"b; 794 do i = 1 to mod_ch_argl.nargs; 795 if index (tmp_char, "(") = 1 then do; /* process expression */ 796 expr_found = "1"b; 797 call 798 linus_modify_build_expr_tab (lcb_ptr, 799 mod_ch_argl.arg.arg_ptr (i), mod_ch_argl.arg.arg_len (i), i, 800 td_ptr, mod_lit_ptr, mod_lit_offset, sel_ptr, icode); 801 if icode ^= 0 then 802 call error (icode); 803 sel_info.user_item.item_type (i) = EXPR; 804 end; 805 end; 806 807 end parse_expr; 808 809 error: 810 proc (err_code); 811 812 dcl err_code fixed bin (35); 813 814 if ca_ptr ^= null 815 then free char_argl; 816 if combined_arg_idx_ptr ^= null 817 then do i = 1 to linus_data_$max_req_args; 818 if combined_arg_idx (i) 819 then free mod_ch_argl.arg.arg_ptr (i) -> combined_arg; 820 end; 821 call ssu_$abort_line (sci_ptr, err_code); 822 823 end error; 824 end linus_modify; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/14/90 0915.0 linus_modify.pl1 >spec>install>1039>linus_modify.pl1 118 1 07/29/86 1248.4 linus_lcb.incl.pl1 >ldd>include>linus_lcb.incl.pl1 120 2 11/23/82 1427.3 linus_char_argl.incl.pl1 >ldd>include>linus_char_argl.incl.pl1 122 3 03/27/82 0534.5 linus_variables.incl.pl1 >ldd>include>linus_variables.incl.pl1 124 4 09/16/83 1438.0 linus_select_info.incl.pl1 >ldd>include>linus_select_info.incl.pl1 126 5 10/14/83 1709.0 mdbm_arg_list.incl.pl1 >ldd>include>mdbm_arg_list.incl.pl1 128 6 03/27/82 0534.5 linus_arg_list.incl.pl1 >ldd>include>linus_arg_list.incl.pl1 130 7 03/27/82 0534.5 linus_token_data.incl.pl1 >ldd>include>linus_token_data.incl.pl1 132 8 03/27/82 0534.5 linus_expression.incl.pl1 >ldd>include>linus_expression.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. ANOTHER 000252 automatic char(8) initial packed unaligned dcl 178 set ref 178* 775 CURRENT 000254 automatic char(8) initial packed unaligned dcl 179 set ref 179* 781 C_R 005000 constant char(1) initial packed unaligned dcl 137 ref 429 491 DATA_BASE constant fixed bin(3,0) initial dcl 139 ref 532 EXPR constant fixed bin(2,0) initial dcl 140 ref 529 549 556 601 662 803 NL constant char(1) initial packed unaligned dcl 180 ref 519 addr builtin function dcl 187 ref 425 477 663 663 663 663 710 712 714 715 721 724 730 730 746 750 774 775 783 784 addrel builtin function dcl 187 ref 633 650 after builtin function dcl 187 ref 758 769 al_ptr 000114 automatic pointer dcl 5-13 set ref 261* 570* 614* 630 633 633 633 647 650 650 650 708* 710 712 714 715 717 717 718 719 723 724 739 740 745 746 749 784 ano_curr_len 000152 automatic fixed bin(17,0) dcl 171 set ref 265* 774 arg 2 based structure array level 2 in structure "mod_ch_argl" dcl 224 in procedure "linus_modify" arg 2 based structure array level 2 in structure "char_argl" dcl 2-9 in procedure "linus_modify" arg_count based fixed bin(17,0) level 2 packed packed unaligned dcl 5-6 set ref 630 647 717* arg_des_ptr 2 based pointer array level 2 in structure "arg_list" dcl 5-6 in procedure "linus_modify" set ref 633* 633* 633 650* 650* 650 710* 712* 714* 715* 723* 724* 739* 740* 745* 746* 784* arg_des_ptr 2 based pointer array level 2 in structure "arg_l" dcl 208 in procedure "linus_modify" set ref 750* 775* arg_l based structure level 1 unaligned dcl 208 set ref 709 749* arg_l_ptr 000310 automatic pointer initial dcl 190 set ref 190* 261* 582* 709* 749 750 766* 775 arg_len 4 based fixed bin(17,0) array level 3 in structure "mod_ch_argl" dcl 224 in procedure "linus_modify" set ref 330 330 362* 364* 364 368* 368 375 375 377 380 383 383 396* 404 404 414 421 422 439 439 482* 488 502 502 663 670 673 687 688 795 797* 818 818 arg_len 4 based fixed bin(21,0) array level 3 in structure "char_argl" dcl 2-9 in procedure "linus_modify" set ref 335* 351 353 353 353 358 358 364 380 383 396 arg_len_bits based structure level 1 packed packed unaligned dcl 143 arg_list based structure level 1 unaligned dcl 5-6 set ref 708 749 arg_ptr based pointer array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 304* 556* 601* 678* 689* 745 arg_ptr 20 based pointer array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 300 arg_ptr 20 based pointer array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 300* 739 arg_ptr 2 based pointer array level 3 in structure "char_argl" dcl 2-9 in procedure "linus_modify" set ref 335* 353 353 358 380 383 397 arg_ptr 2 based pointer array level 3 in structure "mod_ch_argl" dcl 224 in procedure "linus_modify" set ref 330 375* 377 380 383 383 397* 404 404 422 423* 439 484* 502 663 670 673 687 689* 795 797* 818 arg_ptr based pointer array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 304 arr 2 based structure array level 2 dcl 6-3 set ref 724 730 730 750 assign_round_ 000036 constant entry external dcl 232 ref 556 601 678 689 assn_len 16 based fixed bin(35,0) array level 3 in structure "variables" dcl 3-3 in procedure "linus_modify" set ref 678* assn_len based fixed bin(35,0) array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 308 assn_len based fixed bin(35,0) array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 308* 556* 601* 678* 689* assn_type based fixed bin(17,0) array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 307 assn_type based fixed bin(17,0) array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 307* 556* 601* 678* 689* assn_type 15 based fixed bin(17,0) array level 3 in structure "variables" dcl 3-3 in procedure "linus_modify" set ref 678* before builtin function dcl 187 ref 758 769 bf_flag 000146 automatic bit(1) packed unaligned dcl 167 set ref 268* 405* 517 bit_len based fixed bin(35,0) array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 305 bit_len based fixed bin(35,0) array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 305* ca_ptr 000100 automatic pointer dcl 2-15 set ref 261* 324* 326 326 335 335 351 353 353 353 353 353 358 358 358 364 380 380 383 383 396 397 401 435 435 814 814 caller 000153 automatic fixed bin(17,0) dcl 171 set ref 270* 535* 549* char_argl based structure level 1 dcl 2-9 set ref 324 326 401 435 814 char_desc based structure level 1 dcl 6-3 set ref 704 char_ptr 000120 automatic pointer dcl 6-10 set ref 261* 704* 705 705 712 715 721 721 724 730 730 750 774 783 cleanup 000262 stack reference condition dcl 185 ref 325 code 0(18) based fixed bin(17,0) level 2 in structure "arg_list" packed packed unaligned dcl 5-6 in procedure "linus_modify" set ref 718* code 000256 automatic fixed bin(35,0) dcl 183 in procedure "linus_modify" set ref 264* 279* 577* 761* combined_arg based char packed unaligned dcl 149 set ref 330 375 377* 380* 383* 383 439 818 combined_arg_idx based bit(1) array packed unaligned dcl 147 set ref 330 372 373* 376* 439 818 combined_arg_idx_ptr 000324 automatic pointer initial dcl 190 set ref 190* 328 330 370 372* 373 376 437 439 816 818 const 2 based bit(12) initial array level 3 packed packed unaligned dcl 6-3 set ref 704* 705* 705 cu_$generate_call 000040 constant entry external dcl 234 ref 570 582 614 766 db_index based fixed bin(35,0) level 2 dcl 1-53 set ref 277 279* 714 db_path 000172 automatic varying char(168) dcl 175 set ref 279* debug_switch 000010 internal static bit(1) initial packed unaligned dcl 141 set ref 454* 467* 725 desc based bit(36) array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 306* 663 663 663 663 746 desc 000154 automatic fixed bin(17,0) dcl 171 in procedure "linus_modify" set ref 630* 631 632 647* 648 649 706* 707 710 715 724 740 746 750 desc based bit(36) array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 306 313 desc_count 1 based fixed bin(17,0) level 2 packed packed unaligned dcl 5-6 set ref 717* desc_ptr 22 based pointer array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 301 desc_ptr 22 based pointer array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 301* 740 destination_ptr 000302 automatic pointer initial dcl 190 set ref 190* 290* 535* 549* dsl_$get_pn 000042 constant entry external dcl 235 ref 279 dsl_$modify 000044 constant entry external dcl 236 ref 570 570 614 614 dsl_$retrieve 000046 constant entry external dcl 237 ref 582 582 766 766 e_ptr 000320 automatic pointer initial dcl 190 set ref 190* elem 2 based structure array level 2 dcl 8-3 env_ptr 000322 automatic pointer initial dcl 190 set ref 190* err_code parameter fixed bin(35,0) dcl 812 set ref 809 821* ex_ptr 000126 automatic pointer dcl 8-27 set ref 261* 530* 531 532 expr_found 000145 automatic bit(1) packed unaligned dcl 167 set ref 268* 523 793* 796* expression based structure level 1 dcl 8-3 fb_desc based bit(36) initial level 2 dcl 6-3 set ref 704* 712 715 found_end_paren 000150 automatic bit(1) packed unaligned dcl 167 set ref 355* 356 360* 389 i 000430 automatic fixed bin(17,0) dcl 628 in procedure "bump_var_ptrs" set ref 631* 632 633 633* i 000155 automatic fixed bin(17,0) dcl 171 in procedure "linus_modify" set ref 299* 300 300 301 301* 303* 304 304 305 305 306 306 307 307 308 308* 310* 311 311 312 312 313 313 314 314* 328* 330 330* 334* 335* 335 335* 348* 350 351 353 356 363 378 380 391* 396 397* 403* 404 404 404 404 413* 414* 420* 421 422 422 423* 437* 439 439* 487* 488 501* 502 502 502 502* 531* 532* 742* 745 746 747* 747 777* 778 778* 780 794* 795 795 797 797 797* 803* 816* 818 818* i 000442 automatic fixed bin(17,0) dcl 645 in procedure "reset_var_ptrs" set ref 648* 649 650 650* icode 000257 automatic fixed bin(35,0) dcl 183 set ref 264* 535* 547 549* 566 575 578 578* 590 590* 618 618* 710 762 762* 772 772* 797* 801 801* in_buf_index 000156 automatic fixed bin(17,0) dcl 171 set ref 266* 477 480 488* 488 489 491 in_buf_ptr 000272 automatic pointer initial dcl 190 set ref 190* 261* 319* 475* 477 480 489 491 index builtin function dcl 187 ref 670 776 777 795 initial_mrds_vclock 000170 automatic float bin(63) dcl 174 set ref 568* 572 580* 584 612* 615 764* 767 input 000130 automatic varying char dcl 156 set ref 479* 480 480 482 input_arg based char packed unaligned dcl 152 ref 353 353 358 380 383 input_arg_num 000157 automatic fixed bin(17,0) dcl 171 set ref 350* 353 353 353 353 357* 358 358 379* 380 380 383 383 input_buffer based char(1) array packed unaligned dcl 154 set ref 475 477 480 489* 491* interactive 000144 automatic bit(1) packed unaligned dcl 167 set ref 268* 474* interactive_ptr 000270 automatic pointer initial dcl 190 set ref 190* 477* 484 ioa_ 000050 constant entry external dcl 238 ref 473 726 ioa_$nnl 000052 constant entry external dcl 239 ref 502 ioa_$rsnnl 000054 constant entry external dcl 240 ref 478 item_ptr based pointer array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 314 item_ptr based pointer array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 314* 530 535* 549* item_type based fixed bin(17,0) array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 312* 529 549 556 601 662 803* item_type based fixed bin(17,0) array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 312 iteration 15(06) based bit(1) level 2 packed packed unaligned dcl 1-53 ref 345 k 000431 automatic fixed bin(17,0) dcl 628 in procedure "bump_var_ptrs" set ref 632* 633 k 000160 automatic fixed bin(17,0) dcl 171 in procedure "linus_modify" set ref 356* 357 358 363 378* 391 424* k 000443 automatic fixed bin(17,0) dcl 645 in procedure "reset_var_ptrs" set ref 649* 650 l 000161 automatic fixed bin(17,0) dcl 171 set ref 363* 364* 378* 379 380* 476* 478* 528* 529 530 535 535* 548* 549 549 549* 555* 556 556 556 556 556 556 556* 600* 601 601 601 601 601 601 601* 662 663 663 663 663 663 663 670 670 673 673 678 678 678 687 687 687 688 689 689 689 689 737* 739 739 740 740* 743* 745 746* 776* 780 781 lcb based structure level 1 dcl 1-53 lcb_ptr parameter pointer dcl 1-121 set ref 22 272 273 277 279 282 282* 283 285 289 316 324 345 372 375 417 475 479* 519* 535* 549* 568 572 572 572 577* 580 584 584 584 612 615 615 615 704 708 709 714 761* 764 767 767 767 797* len 0(12) based bit(24) level 2 packed packed unaligned dcl 143 ref 721 774 783 length builtin function dcl 187 ref 480 482 linus_area_ptr 60 based pointer level 2 dcl 1-53 ref 272 273 289 417 475 704 708 709 linus_data_$buff_len 000012 external static fixed bin(35,0) dcl 210 ref 156 161 475 480 linus_data_$max_req_args 000014 external static fixed bin(35,0) dcl 210 ref 271 328 372 373 437 816 linus_error_$bad_num_args 000016 external static fixed bin(35,0) dcl 210 set ref 512* linus_error_$linus_var_not_defined 000020 external static fixed bin(35,0) dcl 210 set ref 671* 676* linus_error_$mod_not_valid 000022 external static fixed bin(35,0) dcl 210 set ref 317* linus_error_$no_db 000024 external static fixed bin(35,0) dcl 210 set ref 277* linus_error_$null_input 000026 external static fixed bin(35,0) dcl 210 set ref 663* linus_error_$unbal_parens 000030 external static fixed bin(35,0) dcl 210 set ref 389* linus_error_$update_not_allowed 000032 external static fixed bin(35,0) dcl 210 set ref 280* linus_eval_expr 000056 constant entry external dcl 241 ref 535 549 linus_modify_build_expr_tab 000060 constant entry external dcl 243 ref 797 linus_query 000062 constant entry external dcl 246 ref 479 linus_query$yes_no 000064 constant entry external dcl 247 ref 519 linus_table$async_retrieval 000066 constant entry external dcl 248 ref 577 761 linus_translate_query$auto 000070 constant entry external dcl 250 ref 282 lv_ptr 32 based pointer level 2 in structure "lcb" dcl 1-53 in procedure "linus_modify" ref 316 lv_ptr 000104 automatic pointer dcl 3-14 in procedure "linus_modify" set ref 316* 671 673 673 676 678 678 678 lvar 12 based varying char(32) level 2 dcl 7-3 set ref 274* m 000162 automatic fixed bin(17,0) dcl 171 set ref 673* 673* 676 678 678 678 mb_len 000163 automatic fixed bin(17,0) dcl 171 set ref 264* 414* 414 416* 416 417 417 418 mb_ptr 000274 automatic pointer initial dcl 190 set ref 190* 261* 417* 418 419 mdb_display_data_value$ptr 000072 constant entry external dcl 251 ref 730 mdbm_util_$character_data_class 000074 constant entry external dcl 253 ref 663 mdbm_util_$varying_data_class 000076 constant entry external dcl 253 ref 633 650 663 mod_buf based char packed unaligned dcl 160 set ref 417 418* mod_ch_argl based structure level 1 dcl 224 set ref 272 401* mod_ch_ptr 000300 automatic pointer initial dcl 190 set ref 190* 261* 272* 275 330 330 330 330 330 347 361 361 362 362 364 364 364 364 368 368 368 368 375 375 375 375 375 375 376 377 377 377 377 380 380 380 380 383 383 383 383 383 383 383 383 395 395 396 396 397 397 401 403 404 404 404 404 406 406 408 413 414 420 421 422 422 423 439 439 439 439 439 481 481 482 482 484 484 487 488 502 502 502 512 663 663 670 670 673 673 687 687 688 689 794 795 795 797 797 818 818 818 818 818 mod_curr 000144 automatic char packed unaligned dcl 161 set ref 781* 784 mod_lit_offset 000260 automatic fixed bin(35,0) dcl 183 set ref 797* mod_lit_ptr 000306 automatic pointer initial dcl 190 set ref 190* 261* 797* mode 000245 automatic char(20) packed unaligned dcl 176 set ref 279* 280 280 mrds_error_$tuple_not_found 000034 external static fixed bin(35,0) dcl 210 ref 590 mrds_item based structure array level 2 in structure "select_info" dcl 4-5 in procedure "linus_modify" mrds_item based structure array level 2 in structure "sel_info" dcl 136 in procedure "linus_modify" mrds_time 74 based float bin(63) level 2 dcl 1-53 set ref 572* 572 584* 584 615* 615 767* 767 mvar 1 based varying char(32) level 2 dcl 7-3 set ref 274* n_chars 1 based fixed bin(17,0) level 2 dcl 6-3 set ref 704* n_chars_init 000122 automatic fixed bin(17,0) dcl 6-11 set ref 703* 704 704 n_mrds_items 16 based fixed bin(17,0) level 2 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 287 297 n_mrds_items 16 based fixed bin(17,0) level 2 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 297* 303 706 743 n_user_items 17 based fixed bin(17,0) level 2 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 288 298 n_user_items 17 based fixed bin(17,0) level 2 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 298* 310 476 501 512 528 548 555 600 name 2 based char(32) array level 3 in structure "variables" dcl 3-3 in procedure "linus_modify" ref 673 name based varying char(32) array level 3 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 311* 478* 502* 687 name based varying char(32) array level 3 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 311 nargs based fixed bin(17,0) level 2 in structure "mod_ch_argl" dcl 224 in procedure "linus_modify" set ref 272* 275* 330 330 347* 361* 361 362 364 364 368 368 375 375 375 376 377 377 380 380 383 383 383 383 395* 395 396 397 401 403 406* 406 408 413 420 439 439 481* 481 482 484 487 512 794 818 818 nargs based fixed bin(17,0) level 2 in structure "char_argl" dcl 2-9 in procedure "linus_modify" set ref 324* 326 401 435 814 nargs_init 000102 automatic fixed bin(17,0) dcl 2-16 set ref 271* 272 272 320* 321 324 324 334 348 356 nelems 1 based fixed bin(17,0) level 2 dcl 8-3 ref 531 nmi_alloc 13 based fixed bin(17,0) level 2 dcl 4-5 set ref 289* 311 311 312 312 313 314 314 478 502 529 530 535 549 549 556 556 556 556 601 601 601 601 662 687 803 nmi_init 000107 automatic fixed bin(17,0) dcl 4-48 set ref 287* 289 289 nsevals 15 based fixed bin(17,0) level 2 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 286 296 nsevals 15 based fixed bin(17,0) level 2 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 296* 299 706 737 737 743 743 nsv_alloc 12 based fixed bin(17,0) level 2 dcl 4-5 set ref 289* 304 304 305 305 306 306 307 307 308 308 311 311 312 312 313 313 314 314 478 502 529 530 535 549 549 556 556 556 556 556 556 556 601 601 601 601 601 601 601 662 663 663 663 663 678 678 678 687 689 689 689 745 746 803 nsv_init 000106 automatic fixed bin(17,0) dcl 4-48 set ref 286* 289 289 nui_alloc 14 based fixed bin(17,0) level 2 dcl 4-5 set ref 289* nui_init 000110 automatic fixed bin(17,0) dcl 4-48 set ref 288* 289 289 null builtin function dcl 187 ref 190 190 190 190 190 190 190 190 190 190 190 190 190 190 190 261 282 283 319 326 328 370 435 437 671 814 816 num_ptrs 000116 automatic fixed bin(17,0) dcl 5-14 set ref 707* 708 709 712 717 749 nvars 1 based fixed bin(17,0) level 2 dcl 3-3 ref 673 676 offset based bit(1) array packed unaligned dcl 169 set ref 425 pad 1(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 5-6 set ref 719* prompt 000130 automatic varying char(40) dcl 157 set ref 478* 479* prompt_len 000143 automatic fixed bin(17,0) dcl 158 set ref 478* re_ptr 000312 automatic pointer initial dcl 190 set ref 190* renv_ptr 000316 automatic pointer initial dcl 190 set ref 190* rslt_assn_len based fixed bin(35,0) array level 3 dcl 136 set ref 556* 601* rslt_assn_ptr based pointer array level 3 dcl 136 set ref 556* 601* rslt_assn_type based fixed bin(17,0) array level 3 dcl 136 set ref 556* 601* rslt_desc based bit(36) array level 3 dcl 136 set ref 313* rtrim builtin function dcl 187 ref 383 sci_ptr parameter pointer dcl 134 set ref 22 282* 320* 335* 821* se_flags 0(01) based structure level 2 in structure "select_info" packed packed unaligned dcl 4-5 in procedure "linus_modify" se_flags 0(01) based structure level 2 in structure "sel_info" packed packed unaligned dcl 136 in procedure "linus_modify" se_len 11 based fixed bin(35,0) level 2 in structure "select_info" dcl 4-5 in procedure "linus_modify" ref 295 se_len 11 based fixed bin(35,0) level 2 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 295* 721 758 758 758 769 769 769 776 777 778 781 se_ptr 4 based pointer level 2 in structure "select_info" dcl 4-5 in procedure "linus_modify" set ref 294 730* se_ptr 4 based pointer level 2 in structure "sel_info" dcl 136 in procedure "linus_modify" set ref 294* 723 758 758 758 769 769 769 776 777 781 se_vals 20 based structure array level 2 in structure "select_info" dcl 4-5 in procedure "linus_modify" se_vals 20 based structure array level 2 in structure "sel_info" dcl 136 in procedure "linus_modify" sel_expr based char packed unaligned dcl 162 set ref 758* 758 758 769* 769 769 776 777 781 sel_info based structure level 1 dcl 136 set ref 289 sel_ptr 000314 automatic pointer initial dcl 190 set ref 190* 261* 289* 290 292 294 295 296 297 298 299 300 301 303 304 305 306 307 308 310 311 312 313 314 317 476 478 501 502 512 528 529 530 535 548 549 549 555 556 556 556 556 556 556 556 600 601 601 601 601 601 601 601 662 663 663 663 663 678 678 678 687 689 689 689 706 706 721 723 737 737 739 740 743 743 743 745 746 758 758 758 758 758 758 769 769 769 769 769 769 776 776 777 777 778 781 781 797* 803 select_info based structure level 1 dcl 4-5 si_ptr 000112 automatic pointer dcl 4-49 in procedure "linus_modify" set ref 285* 286 287 288 292 294 295 296 297 298 300 301 304 305 306 307 308 311 312 313 314 730 si_ptr 34 based pointer level 2 in structure "lcb" dcl 1-53 in procedure "linus_modify" ref 282 283 285 simple_arg 000151 automatic bit(1) packed unaligned dcl 167 set ref 349* 351* 393* 394 source_len 000261 automatic fixed bin(35,0) dcl 183 set ref 688* 689* source_type 000164 automatic fixed bin(17,0) dcl 171 set ref 269* 689* ssu_$abort_line 000100 constant entry external dcl 257 ref 821 ssu_$arg_count 000102 constant entry external dcl 258 ref 320 ssu_$arg_ptr 000104 constant entry external dcl 259 ref 335 start_ptr 000304 automatic pointer initial dcl 190 set ref 190* static_area 144 based area level 2 dcl 1-53 ref 324 372 375 string builtin function dcl 187 ref 480 substr builtin function dcl 187 set ref 280 280 353 353 358 480* 489* 491* 673 758 781 tb_len 000165 automatic fixed bin(17,0) dcl 171 set ref 421* 422 424 428* 429 tb_ptr 000276 automatic pointer initial dcl 190 set ref 190* 419* 422 423 425* 425 429 td_ptr 000124 automatic pointer dcl 7-49 set ref 273* 274 274 797* temp 000166 automatic fixed bin(17,0) dcl 171 set ref 780* 781 782* 782 783 timing_mode 15(05) based bit(1) level 2 packed packed unaligned dcl 1-53 ref 568 572 580 584 612 615 764 767 tmp_buf based char packed unaligned dcl 163 set ref 422* 429* tmp_char based char packed unaligned dcl 659 in procedure "not_expr" ref 663 670 673 687 tmp_char based char packed unaligned dcl 164 in procedure "linus_modify" set ref 404 404 422 502* 795 token_data based structure level 1 dcl 7-3 set ref 273 type 2 based fixed bin(4,0) array level 3 packed packed unaligned dcl 8-3 ref 532 unspec builtin function dcl 187 set ref 373* user_item based structure array level 2 in structure "sel_info" dcl 136 in procedure "linus_modify" user_item based structure array level 2 in structure "select_info" dcl 4-5 in procedure "linus_modify" val_mod 0(04) based bit(1) level 3 in structure "sel_info" packed packed unaligned dcl 136 in procedure "linus_modify" set ref 292* 317 val_mod 0(04) based bit(1) level 3 in structure "select_info" packed packed unaligned dcl 4-5 in procedure "linus_modify" ref 292 var 2(12) based bit(24) array level 3 packed packed unaligned dcl 6-3 set ref 721* 721* 774* 783* var_expr 000404 automatic bit(1) packed unaligned dcl 510 set ref 527* 532* 535 542 var_info 2 based structure array level 2 dcl 3-3 var_ptr 12 based pointer array level 3 dcl 3-3 set ref 678* variables based structure level 1 dcl 3-3 vclock builtin function dcl 187 ref 568 572 580 584 612 615 764 767 work_area based area dcl 230 ref 272 273 289 417 475 704 708 709 yes_no_flag 000147 automatic bit(1) packed unaligned dcl 167 set ref 267* 519* 522 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. AND internal static fixed bin(17,0) initial dcl 7-13 COL_SPEC internal static fixed bin(17,0) initial dcl 7-13 COMMA internal static fixed bin(17,0) initial dcl 7-13 CONST internal static fixed bin(17,0) initial dcl 7-13 DIFFER internal static fixed bin(17,0) initial dcl 7-13 DIV internal static fixed bin(17,0) initial dcl 7-13 DUP internal static fixed bin(17,0) initial dcl 7-13 EQ internal static fixed bin(17,0) initial dcl 7-13 FROM internal static fixed bin(17,0) initial dcl 7-13 GE internal static fixed bin(17,0) initial dcl 7-13 GT internal static fixed bin(17,0) initial dcl 7-13 INTER internal static fixed bin(17,0) initial dcl 7-13 LB internal static fixed bin(17,0) initial dcl 7-13 LE internal static fixed bin(17,0) initial dcl 7-13 LINUS_VAR internal static fixed bin(17,0) initial dcl 7-13 LP internal static fixed bin(17,0) initial dcl 7-13 LT internal static fixed bin(17,0) initial dcl 7-13 MINUS internal static fixed bin(17,0) initial dcl 7-13 NE internal static fixed bin(17,0) initial dcl 7-13 NOT internal static fixed bin(17,0) initial dcl 7-13 NULL internal static fixed bin(17,0) initial dcl 7-13 OR internal static fixed bin(17,0) initial dcl 7-13 PLUS internal static fixed bin(17,0) initial dcl 7-13 RB internal static fixed bin(17,0) initial dcl 7-13 ROW_DES internal static fixed bin(17,0) initial dcl 7-13 ROW_TAB_PAIR internal static fixed bin(17,0) initial dcl 7-13 RP internal static fixed bin(17,0) initial dcl 7-13 SCAL_FN internal static fixed bin(17,0) initial dcl 7-13 SELECT internal static fixed bin(17,0) initial dcl 7-13 SET_FN internal static fixed bin(17,0) initial dcl 7-13 STAR internal static fixed bin(17,0) initial dcl 7-13 TAB_NAME internal static fixed bin(17,0) initial dcl 7-13 UNION internal static fixed bin(17,0) initial dcl 7-13 UNIQUE internal static fixed bin(17,0) initial dcl 7-13 WHERE internal static fixed bin(17,0) initial dcl 7-13 fixed builtin function dcl 187 nelems_init automatic fixed bin(17,0) dcl 8-28 nvars_init automatic fixed bin(17,0) dcl 3-15 rel builtin function dcl 187 sys_info$max_seg_size external static fixed bin(35,0) dcl 210 NAMES DECLARED BY EXPLICIT CONTEXT. bf_modify 002251 constant entry internal dcl 507 ref 431 492 bump_var_ptrs 003223 constant entry internal dcl 623 ref 567 611 const_mod 003032 constant entry internal dcl 596 ref 523 542 db_off 001741 constant entry external dcl 457 db_on 001726 constant entry external dcl 444 error 004700 constant entry internal dcl 809 ref 277 280 317 389 512 578 590 618 663 671 676 762 772 801 expr_set_up 004240 constant entry internal dcl 755 ref 546 interactive_modify 001752 constant entry internal dcl 470 ref 321 408 linus_modify 000137 constant entry external dcl 22 not_expr 003343 constant entry internal dcl 656 ref 564 609 parse_expr 004564 constant entry internal dcl 790 ref 515 reset_var_ptrs 003273 constant entry internal dcl 640 ref 576 617 set_up 003725 constant entry internal dcl 700 ref 545 599 verbose_modify 002160 constant entry internal dcl 498 ref 518 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5412 5520 5005 5422 Length 6134 5005 106 377 405 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_modify 572 external procedure is an external procedure. on unit on line 325 67 on unit interactive_modify internal procedure shares stack frame of external procedure linus_modify. verbose_modify internal procedure shares stack frame of external procedure linus_modify. bf_modify internal procedure shares stack frame of external procedure linus_modify. const_mod internal procedure shares stack frame of external procedure linus_modify. bump_var_ptrs internal procedure shares stack frame of external procedure linus_modify. reset_var_ptrs internal procedure shares stack frame of external procedure linus_modify. not_expr internal procedure shares stack frame of external procedure linus_modify. set_up internal procedure shares stack frame of external procedure linus_modify. expr_set_up internal procedure shares stack frame of external procedure linus_modify. parse_expr internal procedure shares stack frame of external procedure linus_modify. error internal procedure shares stack frame of external procedure linus_modify. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 debug_switch linus_modify STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_modify 000100 ca_ptr linus_modify 000102 nargs_init linus_modify 000104 lv_ptr linus_modify 000106 nsv_init linus_modify 000107 nmi_init linus_modify 000110 nui_init linus_modify 000112 si_ptr linus_modify 000114 al_ptr linus_modify 000116 num_ptrs linus_modify 000120 char_ptr linus_modify 000122 n_chars_init linus_modify 000124 td_ptr linus_modify 000126 ex_ptr linus_modify 000130 input linus_modify 000130 prompt linus_modify 000143 prompt_len linus_modify 000144 interactive linus_modify 000144 mod_curr linus_modify 000145 expr_found linus_modify 000146 bf_flag linus_modify 000147 yes_no_flag linus_modify 000150 found_end_paren linus_modify 000151 simple_arg linus_modify 000152 ano_curr_len linus_modify 000153 caller linus_modify 000154 desc linus_modify 000155 i linus_modify 000156 in_buf_index linus_modify 000157 input_arg_num linus_modify 000160 k linus_modify 000161 l linus_modify 000162 m linus_modify 000163 mb_len linus_modify 000164 source_type linus_modify 000165 tb_len linus_modify 000166 temp linus_modify 000170 initial_mrds_vclock linus_modify 000172 db_path linus_modify 000245 mode linus_modify 000252 ANOTHER linus_modify 000254 CURRENT linus_modify 000256 code linus_modify 000257 icode linus_modify 000260 mod_lit_offset linus_modify 000261 source_len linus_modify 000270 interactive_ptr linus_modify 000272 in_buf_ptr linus_modify 000274 mb_ptr linus_modify 000276 tb_ptr linus_modify 000300 mod_ch_ptr linus_modify 000302 destination_ptr linus_modify 000304 start_ptr linus_modify 000306 mod_lit_ptr linus_modify 000310 arg_l_ptr linus_modify 000312 re_ptr linus_modify 000314 sel_ptr linus_modify 000316 renv_ptr linus_modify 000320 e_ptr linus_modify 000322 env_ptr linus_modify 000324 combined_arg_idx_ptr linus_modify 000404 var_expr bf_modify 000430 i bump_var_ptrs 000431 k bump_var_ptrs 000442 i reset_var_ptrs 000443 k reset_var_ptrs THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out return_mac alloc_auto_adj bound_ck_signal enable_op shorten_stack ext_entry int_entry trunc_fx2 set_chars_eis index_chars_eis divide_fx1 op_alloc_ op_freen_ index_before_cs index_after_cs vclock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_round_ cu_$generate_call dsl_$get_pn dsl_$modify dsl_$retrieve ioa_ ioa_$nnl ioa_$rsnnl linus_eval_expr linus_modify_build_expr_tab linus_query linus_query$yes_no linus_table$async_retrieval linus_translate_query$auto mdb_display_data_value$ptr mdbm_util_$character_data_class mdbm_util_$varying_data_class ssu_$abort_line ssu_$arg_count ssu_$arg_ptr THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. linus_data_$buff_len linus_data_$max_req_args linus_error_$bad_num_args linus_error_$linus_var_not_defined linus_error_$mod_not_valid linus_error_$no_db linus_error_$null_input linus_error_$unbal_parens linus_error_$update_not_allowed mrds_error_$tuple_not_found LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 156 000062 161 000073 178 000102 179 000104 190 000106 479 000126 22 000133 261 000145 264 000160 265 000163 266 000165 267 000167 268 000171 269 000174 270 000176 271 000200 272 000203 273 000217 274 000227 275 000231 277 000232 279 000245 280 000264 282 000303 283 000323 285 000332 286 000334 287 000336 288 000340 289 000342 290 000374 292 000375 294 000401 295 000404 296 000407 297 000411 298 000413 299 000415 300 000425 301 000432 302 000435 303 000437 304 000447 305 000470 306 000501 307 000512 308 000523 309 000536 310 000540 311 000551 312 000614 313 000625 314 000653 315 000674 316 000676 317 000703 319 000715 320 000717 321 000731 324 000735 325 000751 326 000765 328 000777 330 001016 332 001037 333 001042 334 001043 335 001053 336 001073 345 001075 347 001103 348 001104 349 001113 350 001114 351 001115 353 001124 355 001143 356 001144 357 001155 358 001156 360 001171 361 001173 362 001174 363 001177 364 001207 367 001221 368 001223 370 001230 372 001234 373 001247 375 001254 376 001275 377 001302 378 001311 379 001321 380 001322 383 001343 385 001416 387 001421 389 001423 391 001435 392 001436 393 001437 394 001441 395 001443 396 001444 397 001454 399 001462 400 001464 401 001465 403 001515 404 001517 405 001534 406 001536 408 001540 413 001544 414 001553 415 001561 416 001563 417 001564 418 001576 419 001602 420 001603 421 001613 422 001617 423 001625 424 001626 425 001635 426 001641 427 001643 428 001645 429 001647 431 001653 435 001654 437 001665 439 001701 441 001722 442 001724 444 001725 454 001734 455 001737 457 001740 467 001747 468 001751 470 001752 473 001753 474 001764 475 001766 476 002001 477 002011 478 002017 479 002066 480 002111 481 002121 482 002122 484 002127 487 002134 488 002136 489 002144 490 002147 491 002151 492 002156 494 002157 498 002160 501 002161 502 002171 503 002246 505 002250 507 002251 512 002252 515 002265 517 002266 518 002270 519 002271 522 002322 523 002325 527 002331 528 002332 529 002343 530 002365 531 002372 532 002401 534 002412 535 002414 541 002457 542 002461 545 002465 546 002466 547 002467 548 002472 549 002503 554 002552 555 002554 556 002565 564 002666 565 002667 566 002671 567 002673 568 002674 570 002706 572 002723 575 002737 576 002741 577 002742 578 002754 580 002760 582 002772 584 003007 589 003023 590 003024 788 003031 596 003032 599 003033 600 003034 601 003045 609 003146 610 003147 611 003151 612 003152 614 003164 615 003201 617 003215 618 003216 621 003222 623 003223 630 003224 631 003234 632 003243 633 003245 635 003270 637 003272 640 003273 647 003274 648 003304 649 003313 650 003315 652 003340 654 003342 656 003343 662 003344 663 003366 670 003466 671 003506 673 003521 675 003550 676 003552 678 003566 685 003633 687 003634 688 003660 689 003663 698 003724 700 003725 703 003726 704 003730 705 003753 706 003755 707 003762 708 003764 709 003776 710 004010 712 004014 714 004021 715 004026 717 004031 718 004042 719 004044 721 004046 723 004054 724 004057 725 004063 726 004066 730 004101 737 004116 739 004127 740 004137 741 004147 742 004151 743 004153 745 004167 746 004203 747 004216 748 004217 749 004221 750 004232 752 004237 755 004240 758 004241 761 004326 762 004341 764 004345 766 004357 767 004374 769 004410 772 004471 774 004476 775 004501 776 004504 777 004514 778 004524 780 004527 781 004532 782 004554 783 004556 784 004560 786 004563 790 004564 793 004565 794 004566 795 004575 796 004614 797 004616 801 004647 803 004653 805 004675 807 004677 809 004700 814 004702 816 004713 818 004727 820 004750 821 004752 823 004771 ----------------------------------------------------------- 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