COMPILATION LISTING OF SEGMENT linus_invoke Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 07/29/86 1001.4 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 19 linus_invoke: 20 proc (sci_ptr, lcb_ptr); 21 22 /* DESCRIPTION: 23* 24* This request specifies that the requests contained in the designated macro 25* segment are to be executed. Arguments are optionally passed to the macro. 26* This feature provides the capability to invoke a pre-defined series of 27* LINUS requests. 28* 29* 30* 31* HISTORY: 32* 33* 77-06-01 J. C. C. Jagernuath: Initially written. 34* 35* 80-01-04 Rickie E. Brinegar: Modified to add the pop_all entry point. 36* 37* 80-01-15 Rickie E. Brinegar: to return an error message when the number of 38* invokes exceed linus_data_$max_invocs. 39* 40* 82-02-11 Paul W. Benjamin: ssu_ conversion. 41* 42* 82-06-21 Al Dupuis: removed unreferenced variable iox_$user_io. 43* 44* 82-08-31 DJ Schimke: Replaced the calls to the undocumented entrypoint 45* syn_$syn_attach_ with a calls to iox_$attach_ptr. Declared iox_$attach_ptr 46* and attach_description and added the iocb include file. 47* This is in response to phx13314. 48**/ 49 1 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 1 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 1 3* version number to IOX2. */ 1 4 /* format: style2 */ 1 5 1 6 dcl 1 iocb aligned based, /* I/O control block. */ 1 7 2 version character (4) aligned, /* IOX2 */ 1 8 2 name char (32), /* I/O name of this block. */ 1 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 1 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 1 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 1 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 1 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 1 14 2 reserved bit (72), /* Reserved for future use. */ 1 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 1 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 1 17 /* open(p,mode,not_used,s) */ 1 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 1 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 20 /* get_line(p,bufptr,buflen,actlen,s) */ 1 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 1 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 1 24 /* put_chars(p,bufptr,buflen,s) */ 1 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 1 26 /* modes(p,newmode,oldmode,s) */ 1 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 1 28 /* position(p,u1,u2,s) */ 1 29 2 control entry (ptr, char (*), ptr, fixed (35)), 1 30 /* control(p,order,infptr,s) */ 1 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 32 /* read_record(p,bufptr,buflen,actlen,s) */ 1 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 1 34 /* write_record(p,bufptr,buflen,s) */ 1 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 1 36 /* rewrite_record(p,bufptr,buflen,s) */ 1 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 1 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 39 /* seek_key(p,key,len,s) */ 1 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 41 /* read_key(p,key,len,s) */ 1 42 2 read_length entry (ptr, fixed (21), fixed (35)), 1 43 /* read_length(p,len,s) */ 1 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 1 45 /* open_file(p,mode,desc,not_used,s) */ 1 46 2 close_file entry (ptr, char (*), fixed bin (35)), 1 47 /* close_file(p,desc,s) */ 1 48 2 detach entry (ptr, char (*), fixed bin (35)); 1 49 /* detach(p,desc,s) */ 1 50 1 51 declare iox_$iocb_version_sentinel 1 52 character (4) aligned external static; 1 53 1 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 50 51 2 1 /* BEGIN INCLUDE FILE linus_lcb.incl.pl1 -- jaw 8/30/77 */ 2 2 2 3 2 4 2 5 /****^ HISTORY COMMENTS: 2 6* 1) change(86-04-23,Dupuis), approve(86-05-23,MCR7188), audit(86-07-23,GWMay), 2 7* install(86-07-29,MR12.0-1106): 2 8* Added general_work_area_ptr and renamed sfr_ptr to 2 9* force_retrieve_scope_ptr. 2 10* END HISTORY COMMENTS */ 2 11 2 12 2 13 /* HISTORY: 2 14* 2 15* 78-09-29 J. C. C. Jagernauth: Modified for MR7.0. 2 16* 2 17* 81-05-11 Rickie E. Brinegar: added security bit and andministrator bit as 2 18* a part of the attribute level control work. 2 19* 2 20* 81-06-17 Rickie E. Brinegar: deleted the sd_ptr as a part of removing the 2 21* scope_data structure from LINUS. LINUS now depends totally on MRDS for 2 22* scope information. 2 23* 2 24* 81-11-11 Rickie E. Brinegar: added the timing bit and three fields for 2 25* retaining various vcpu times to be collected when in timing mode. The 2 26* times to be collected are: LINUS parsing time, LINUS processing time, and 2 27* MRDS processing time. 2 28* 2 29* 82-01-15 DJ Schimke: Added the build_increment and build_start fields as 2 30* part of the line numbering implementation. This allows for possible later 2 31* LINUS control of the build defaults. 2 32* 2 33* 82-03-01 Paul W. Benjamin: Removed linus_prompt_chars_ptr, as that 2 34* information is now retained by ssu_. Removed parse_timer as no longer 2 35* meaningful. Added linus_version. Added iteration bit. Added 6 entry 2 36* variables for ssu_ replaceable procedures. Added actual_input_iocbp. 2 37* 2 38* 82-06-23 Al Dupuis: Added subsystem_control_info_ptr, 2 39* subsystem_invocation_level, and selection_expression_identifier. 2 40* 2 41* 82-08-26 DJ Schimke: Added report_control_info_ptr, and 2 42* table_control_info_ptr. 2 43* 2 44* 82-10-19 DJ Schimke: Added ssu_abort_line. 2 45* 2 46* 83-06-06 Bert Moberg: Added print_search_order (pso) and no_optimize (no_ot) 2 47* 2 48* 83-04-07 DJ Schimke: Added temp_seg_info_ptr. 2 49* 2 50* 83-08-26 Al Dupuis: Added query_temp_segment_ptr. 2 51**/ 2 52 2 53 dcl 1 lcb aligned based (lcb_ptr), /* LINUS control block */ 2 54 2 db_index fixed bin (35), /* index of open data base, or 0 */ 2 55 2 rb_len fixed bin (21), /* length of request buffer */ 2 56 2 lila_count fixed bin (35), /* number of LILA text lines */ 2 57 2 lila_chars fixed bin (35), /* number of LILA source test chars */ 2 58 2 trans_id fixed bin (35), /* used by checkpoint and rollback facilities (MR7.0) */ 2 59 2 lila_fn char (32) unal, /* entry name of lila data file */ 2 60 2 prompt_flag bit (1) unal, /* on if in prompt mode */ 2 61 2 test_flag bit (1) unal, /* on if in test mode */ 2 62 2 new_version bit (1) unal init (1), /* on for new version data base (MR7.0) */ 2 63 2 secured_db bit (1) unal, /* on if the db is in a secure state */ 2 64 2 administrator bit (1) unal, /* on if the user is a db administrator */ 2 65 2 timing_mode bit (1) unal, /* on if timing is to be done */ 2 66 2 iteration bit (1) unal, /* interpret parens as iteration sets */ 2 67 2 pso_flag bit (1) unal, /* add print_search_order to select */ 2 68 2 no_ot_flag bit (1) unal, /* add no_optimize to select */ 2 69 2 reserved bit (27) unal, 2 70 2 liocb_ptr ptr, /* iocb ptr for lila file */ 2 71 2 rb_ptr ptr, /* ptr to request buffer */ 2 72 2 is_ptr ptr, /* iocb ptr for currentinput stream switch */ 2 73 2 cal_ptr ptr, /* ptr to current arg list for invoke (or null) */ 2 74 2 ttn_ptr ptr, /* pointer to table info structure */ 2 75 2 force_retrieve_scope_info_ptr ptr, /* structure pointer to force retrieve scope operation */ 2 76 2 lv_ptr ptr, /* pointer linus variables */ 2 77 2 si_ptr ptr, /* pointer to select_info structure */ 2 78 2 setfi_ptr ptr, /* pointer to set function information */ 2 79 2 sclfi_ptr ptr, /* pointer to user declared scalar fun. names */ 2 80 2 ivs_ptr ptr, /* pointer to stack of invoke iocb pointers */ 2 81 2 lit_ptr ptr, /* pointer to literal pool */ 2 82 2 lvv_ptr ptr, /* pointer to linus variable alloc. pool */ 2 83 2 rd_ptr ptr, /* point to readied files mode information (MR7.0) */ 2 84 2 rt_ptr ptr, /* point to table of relation names and their readied modes 2 85* (MR7.0) */ 2 86 2 actual_input_iocbp ptr, /* ptr to input while in macros */ 2 87 2 lila_promp_chars_ptr ptr, /* pointer to the prompt characters for lila */ 2 88 2 linus_area_ptr ptr, /* LINUS temporary segment pointer */ 2 89 2 lila_area_ptr ptr, /* LILA temporary segment pointer */ 2 90 2 i_o_area_ptr ptr, /* temporary segment pointer used by write, print, create_list */ 2 91 2 rel_array_ptr ptr, /* ptr to array of names rslt info structure 2 92* for current lila expression */ 2 93 2 unused_timer float bin (63), /* future expansion */ 2 94 2 request_time float bin (63), /* How much request time was spent 2 95* in LINUS. (-1 = user has just enabled 2 96* timing, do not report) */ 2 97 2 mrds_time float bin (63), /* How much time was spent in MRDS */ 2 98 2 build_increment fixed bin, /* default increment for build mode */ 2 99 2 build_start fixed bin, /* default start count for build mode */ 2 100 2 linus_version char (4), /* current version of LINUS */ 2 101 2 subsystem_control_info_ptr ptr, /* the same ptr passed by ssu_ to each request procedure */ 2 102 2 subsystem_invocation_level fixed bin, /* identifies this invocation of LINUS */ 2 103 2 selection_expression_identifier fixed bin, /* identifies the current processed selection expression */ 2 104 2 report_control_info_ptr ptr, /* pointer to linus_report_control_info structure */ 2 105 2 table_control_info_ptr ptr, /* pointer to linus_table control structure */ 2 106 2 temp_seg_info_ptr ptr, /* pointer to linus_temp_seg_mgr control structure */ 2 107 2 query_temp_segment_ptr ptr, /* points to temp seg used for manipulating query */ 2 108 2 general_work_area_ptr ptr, /* a freeing area for general use */ 2 109 2 word_pad (6) bit (36) unal, 2 110 /* procedures that will be optionally */ 2 111 /* replaced by the user. Saved so they */ 2 112 /* can be reinstated if desired. */ 2 113 2 ssu_abort_line entry options (variable), 2 114 2 ssu_post_request_line variable entry (ptr), 2 115 2 ssu_pre_request_line variable entry (ptr), 2 116 2 117 2 curr_lit_offset fixed bin (35), /* index of first free bit in lit. pool */ 2 118 2 curr_lv_val_offset fixed bin (35), /* index of first free bit lv. val. pool */ 2 119 2 static_area area (sys_info$max_seg_size - fixed (rel (addr (lcb.static_area))) + 1); 2 120 2 121 dcl lcb_ptr ptr; 2 122 2 123 /* END INCLUDE FILE linus_lcb.incl.pl1 */ 52 53 3 1 /* BEGIN INCLUDE FILE linus_char_argl.incl.pl1 -- jaw 2/11/77 */ 3 2 3 3 /* HISTORY: 3 4* 3 5* 82-02-05 Paul W. Benjamin: Changed arg_len to fixed bin (21). 3 6* 3 7**/ 3 8 3 9 dcl 1 char_argl aligned based (ca_ptr), /* structure for general char. arg. list */ 3 10 2 nargs fixed bin, /* number of args */ 3 11 2 arg (nargs_init refer (char_argl.nargs)), 3 12 3 arg_ptr ptr, /* ptr to first char. of arg */ 3 13 3 arg_len fixed bin (21); /* no. of chars. in arg */ 3 14 3 15 dcl ca_ptr ptr; 3 16 dcl nargs_init fixed bin; 3 17 3 18 /* END INCLUDE FILE linus_char_argl.incl.pl1 */ 54 55 4 1 /* BEGIN INCLUDE FILE linus_invoc_stack.incl.pl1 -- jaw 7/19/77 */ 4 2 4 3 dcl 1 invoc_stack aligned based (ivs_ptr), /* invocation info */ 4 4 2 ninvocs fixed bin, /* number of current invocations */ 4 5 2 invoc (linus_data_$max_invocs), /* for each invocation */ 4 6 3 iocb_ptr ptr, /* iocb for input sw */ 4 7 3 arg_ptr ptr; /* pointer to arg list */ 4 8 4 9 dcl ivs_ptr ptr; 4 10 4 11 /* END INCLUDE FILE linus_invoc_stack.incl.pl1 */ 56 57 5 1 /* BEGIN INCLUDE FILE ... ssu_prompt_modes.incl.pl1 */ 5 2 /* Created: 15 February 1982 by G. Palter */ 5 3 5 4 /* Values for use in calls to ssu_$set_prompt_mode to control prompting by the subsystem listener */ 5 5 5 6 dcl PROMPT bit (1) static options (constant) initial ("0"b); 5 7 dcl DONT_PROMPT bit (1) static options (constant) initial ("1"b); 5 8 5 9 dcl PROMPT_AFTER_NULL_LINES bit (2) static options (constant) initial ("01"b); 5 10 dcl DONT_PROMPT_AFTER_NULL_LINES bit (2) static options (constant) initial ("00"b); 5 11 5 12 dcl PROMPT_IF_TYPEAHEAD bit (3) static options (constant) initial ("000"b); 5 13 dcl DONT_PROMPT_IF_TYPEAHEAD bit (3) static options (constant) initial ("001"b); 5 14 5 15 /* For example: 5 16* call ssu_$set_prompt_mode (sci_ptr, PROMPT | DONT_PROMPT_AFTER_NULL_LINES | DONT_PROMPT_IF_TYPEAHEAD); */ 5 17 5 18 /* END INCLUDE FILE ... ssu_prompt_modes.incl.pl1 */ 58 59 60 dcl sci_ptr ptr; /* for ssu_ */ 61 62 dcl STREAM_INPUT fixed bin options (constant) int static init (1); 63 64 dcl path_name char (char_argl.arg.arg_len (1)) based (char_argl.arg.arg_ptr (1)); 65 dcl argument char (char_argl.arg.arg_len (l)) based (char_argl.arg.arg_ptr (l)); 66 dcl lcbpa char (16); 67 dcl lcbpl fixed bin (21); 68 dcl macro_path char (168); 69 dcl macro_arg char (mac_len) based (mac_ptr); 70 dcl popped_on_pi bit (1); 71 dcl scipa char (16); 72 dcl scipl fixed bin (21); 73 dcl static_sci_ptr ptr int static; /* Change this if linus allows recursion */ 74 dcl temp_lcb_ptr ptr; 75 dcl tmp_char char (char_argl.arg.arg_len (l + 1)) based (char_argl.arg.arg_ptr (l + 1)); 76 77 dcl attach_description char (37); /* "syn_ "||sw_name */ 78 dcl sw_name char (32); 79 dcl dot_linus char (6); 80 dcl ( 81 iocb_ptr init (null), 82 ref_ptr init (null), 83 mac_ptr init (null), 84 env_ptr init (null), 85 tmp_ptr init (null) 86 ) ptr; 87 dcl (l, i) fixed bin; 88 dcl (addr, before, fixed, null, rel, substr) builtin; 89 dcl (icode, code, mac_len, out_code) fixed bin (35); 90 dcl ( 91 error_table_$not_attached, 92 linus_error_$no_input_arg, 93 linus_error_$too_many_invocs, 94 sys_info$max_seg_size, 95 linus_data_$i_id, 96 linus_data_$max_invocs 97 ) fixed bin (35) ext; 98 dcl cleanup condition; 99 dcl unique_chars_ entry (bit (*)) returns (char (15)); 100 dcl cu_$decode_entry_value entry (entry, ptr, ptr); 101 dcl ioa_$rsnnl entry () options (variable); 102 dcl iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35)); 103 dcl iox_$attach_ptr entry (ptr, char (*), ptr, fixed bin (35)); 104 dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)); 105 dcl iox_$find_iocb entry (char (*), ptr, fixed bin (35)); 106 dcl iox_$move_attach entry (ptr, ptr, fixed bin (35)); 107 dcl iox_$detach_iocb entry (ptr, fixed bin (35)); 108 dcl iox_$destroy_iocb entry (ptr, fixed bin (35)); 109 dcl iox_$close entry (ptr, fixed bin (35)); 110 dcl linus_convert_code entry (fixed bin (35), fixed bin (35), fixed bin (35)); 111 dcl ssu_$abort_line entry options (variable); 112 dcl ssu_$abort_subsystem entry options (variable); 113 dcl ssu_$arg_count entry (ptr, fixed bin); 114 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); 115 dcl ssu_$get_info_ptr entry (ptr) returns (ptr); 116 dcl ssu_$set_prompt_mode entry (ptr, bit (*)); 117 dcl iox_$user_input ext ptr; 118 119 ca_ptr = null; 120 121 mac_len, icode = 0; 122 123 on cleanup call clean_up; 124 125 static_sci_ptr = sci_ptr; 126 127 call ssu_$arg_count (sci_ptr, nargs_init); 128 if nargs_init = 0 then 129 call error (linus_error_$no_input_arg, ""); 130 if lcb.ivs_ptr ^= null then do; 131 ivs_ptr = lcb.ivs_ptr; /* No need to allocate invoke structure */ 132 if invoc_stack.ninvocs ^< linus_data_$max_invocs then 133 call error (linus_error_$too_many_invocs, ""); 134 end; 135 else do; 136 allocate invoc_stack in (lcb.static_area); /* Invoke stack needs to be allocated */ 137 lcb.ivs_ptr = ivs_ptr; 138 invoc_stack.ninvocs = 0; 139 end; 140 dot_linus = " "; /* Append .linus to pathname if necessary */ 141 allocate char_argl in (lcb.static_area); 142 do i = 1 to nargs_init; 143 call ssu_$arg_ptr (sci_ptr, i, char_argl.arg.arg_ptr (i), char_argl.arg.arg_len (i)); 144 end; 145 if char_argl.arg.arg_len (1) > 6 then 146 dot_linus = substr (path_name, char_argl.arg.arg_len (1) - 5); 147 if dot_linus ^= ".linus" then 148 macro_path = path_name || ".linus"; 149 else macro_path = path_name; 150 call cu_$decode_entry_value (linus_invoke, ref_ptr, env_ptr); 151 sw_name = unique_chars_ ("0"b) || ".linus_invoke";/* Unique switch name */ 152 call ioa_$rsnnl ("^p", lcbpa, lcbpl, lcb_ptr); 153 call ioa_$rsnnl ("^p", scipa, scipl, sci_ptr); 154 call iox_$attach_name (sw_name, iocb_ptr, 155 "linus_invoke_ " || macro_path || " " || substr (lcbpa, 1, lcbpl) || " " || substr (scipa, 1, scipl), 156 ref_ptr, icode); 157 if icode ^= 0 then 158 call error (icode, before (macro_path, " ")); 159 call iox_$open (iocb_ptr, STREAM_INPUT, "0"b, icode); 160 if icode ^= 0 then 161 call error (icode, before (macro_path, " ")); 162 163 if invoc_stack.ninvocs = 0 /* save actual attachment of user_input */ 164 then do; /* if we are grabbing it away */ 165 sw_name = unique_chars_ ("0"b) || ".linus_input"; /* another unique switch */ 166 /* creating a new switch */ 167 call iox_$find_iocb (sw_name, lcb.actual_input_iocbp, icode); 168 if icode ^= error_table_$not_attached & icode ^= 0 169 then call error (icode, "Creating IO control block."); 170 call iox_$move_attach (iox_$user_input, lcb.actual_input_iocbp, icode); 171 if icode ^= 0 172 then call error (icode, "Moving attachment of user input."); 173 end; 174 else do; 175 call iox_$detach_iocb (iox_$user_input, icode); 176 if icode ^= 0 177 then call error (icode, "Detaching user input."); 178 end; 179 attach_description = "syn_ " || iocb_ptr -> iocb.name; 180 call iox_$attach_ptr (iox_$user_input, attach_description, ref_ptr, icode); 181 if icode ^= 0 182 then call error (icode, "Attaching user input."); 183 184 invoc_stack.ninvocs = invoc_stack.ninvocs + 1; /* Push invoke stack */ 185 invoc_stack.invoc.iocb_ptr (invoc_stack.ninvocs) = lcb.is_ptr; 186 lcb.is_ptr = iocb_ptr; 187 invoc_stack.invoc.arg_ptr (invoc_stack.ninvocs) = lcb.cal_ptr; 188 if char_argl.nargs = 1 then 189 lcb.cal_ptr = null; 190 else do; /* Prepare optional arguments for macro segment */ 191 nargs_init = char_argl.nargs - 1; 192 allocate char_argl in (lcb.static_area) set (tmp_ptr); 193 do l = 1 to nargs_init; 194 tmp_ptr -> char_argl.nargs = l; 195 mac_len, tmp_ptr -> char_argl.arg.arg_len (l) = char_argl.arg.arg_len (l + 1); 196 allocate macro_arg in (lcb.static_area); 197 macro_arg = tmp_char; 198 tmp_ptr -> char_argl.arg.arg_ptr (l) = mac_ptr; 199 mac_ptr = null; 200 end; 201 lcb.cal_ptr = tmp_ptr; 202 tmp_ptr = null; 203 end; 204 205 call ssu_$set_prompt_mode (sci_ptr, DONT_PROMPT); /* turn off prompting */ 206 207 if ca_ptr ^= null 208 then free char_argl; 209 return; 210 211 error: 212 proc (err_code, string); 213 214 dcl err_code fixed bin (35); 215 dcl string char (*); 216 217 call clean_up; 218 call linus_convert_code (err_code, out_code, linus_data_$i_id); 219 call ssu_$abort_line (sci_ptr, out_code, string); 220 221 end error; 222 223 clean_up: 224 proc; 225 226 dcl i fixed bin; 227 228 if mac_ptr ^= null then 229 free macro_arg; 230 if tmp_ptr ^= null then do; 231 do i = 1 to tmp_ptr -> char_argl.nargs; 232 mac_ptr = tmp_ptr -> char_argl.arg.arg_ptr (i); 233 mac_len = tmp_ptr -> char_argl.arg.arg_len (i); 234 free macro_arg; 235 end; 236 free tmp_ptr -> char_argl; 237 end; 238 if ca_ptr ^= null 239 then free char_argl; 240 241 end clean_up; 242 243 pop: 244 entry (lcb_ptr, code); /* Pop invoke stack */ 245 246 code = 0; 247 ivs_ptr = lcb.ivs_ptr; 248 if lcb.cal_ptr ^= null then do; 249 do i = 1 to lcb.cal_ptr -> char_argl.nargs; 250 mac_len = lcb.cal_ptr -> char_argl.arg.arg_len (i); 251 mac_ptr = lcb.cal_ptr -> char_argl.arg.arg_ptr (i); 252 free macro_arg; 253 end; 254 free lcb.cal_ptr -> char_argl; /* Free current argument list */ 255 end; 256 call iox_$close (lcb.is_ptr, icode); 257 if icode ^= 0 then 258 call error (icode, ""); 259 else call iox_$detach_iocb (lcb.is_ptr, icode); 260 if icode ^= 0 then 261 call error (icode, ""); 262 lcb.cal_ptr = invoc_stack.invoc.arg_ptr (invoc_stack.ninvocs); 263 /* Pop pointer to argument list */ 264 lcb.is_ptr = invoc_stack.invoc.iocb_ptr (invoc_stack.ninvocs); 265 /* Pop pointer to input stream */ 266 call iox_$detach_iocb (iox_$user_input, code); 267 if code = 0 268 then do; 269 270 if lcb.is_ptr ^= iox_$user_input 271 then do; 272 attach_description = "syn_ " || lcb.is_ptr -> iocb.name; 273 call iox_$attach_ptr (iox_$user_input, attach_description, ref_ptr, code); 274 end; 275 else do; 276 call iox_$move_attach (lcb.actual_input_iocbp, iox_$user_input, code); 277 if code = 0 278 then call iox_$destroy_iocb (lcb.actual_input_iocbp, code); 279 end; 280 end; 281 invoc_stack.ninvocs = invoc_stack.ninvocs - 1; 282 if invoc_stack.ninvocs = 0 then do; 283 free invoc_stack; 284 lcb.ivs_ptr = null; 285 end; 286 return; 287 288 pop_all_on_pi: /* called by ssu_ pi handler */ 289 entry (sci_ptr); 290 291 temp_lcb_ptr = ssu_$get_info_ptr (sci_ptr); 292 popped_on_pi = "1"b; 293 goto common_pop_all; 294 295 pop_all: 296 entry (lcb_ptr, code); /* Throw away the invoke stack */ 297 298 299 code = 0; 300 temp_lcb_ptr = lcb_ptr; 301 popped_on_pi = "0"b; 302 303 common_pop_all: 304 if temp_lcb_ptr -> lcb.is_ptr ^= iox_$user_input then do; 305 call iox_$close (temp_lcb_ptr -> lcb.is_ptr, icode); /* close and detach the current stream */ 306 call iox_$detach_iocb (temp_lcb_ptr -> lcb.is_ptr, icode); 307 temp_lcb_ptr -> lcb.is_ptr = iox_$user_input; 308 if temp_lcb_ptr -> lcb.cal_ptr ^= null then do; 309 ca_ptr = temp_lcb_ptr -> lcb.cal_ptr; 310 do l = 1 to char_argl.nargs; 311 free argument; 312 end; 313 free char_argl; 314 temp_lcb_ptr -> lcb.cal_ptr = null; 315 end; 316 if temp_lcb_ptr -> lcb.ivs_ptr ^= null then do; 317 ivs_ptr = temp_lcb_ptr -> lcb.ivs_ptr; 318 do i = 2 to invoc_stack.ninvocs; 319 call iox_$close (invoc_stack.invoc.iocb_ptr (i), icode); 320 call iox_$detach_iocb (invoc_stack.iocb_ptr (i), icode); 321 if invoc_stack.invoc.arg_ptr (i) ^= null then do; 322 ca_ptr = invoc_stack.invoc.arg_ptr (i); 323 do l = 1 to char_argl.nargs; 324 free argument; 325 end; 326 free char_argl; 327 end; 328 end; 329 free invoc_stack; 330 temp_lcb_ptr -> lcb.ivs_ptr = null; 331 end; 332 call iox_$detach_iocb (iox_$user_input, icode); 333 if icode = 0 334 then call iox_$move_attach (temp_lcb_ptr -> lcb.actual_input_iocbp, iox_$user_input, icode); 335 if icode = 0 336 then call iox_$destroy_iocb (temp_lcb_ptr -> lcb.actual_input_iocbp, icode); 337 if icode = 0 338 then do; 339 if temp_lcb_ptr -> lcb.prompt_flag 340 then call ssu_$set_prompt_mode (static_sci_ptr, PROMPT | DONT_PROMPT_AFTER_NULL_LINES | PROMPT_IF_TYPEAHEAD); 341 end; 342 else if popped_on_pi 343 then call ssu_$abort_subsystem (sci_ptr, icode); 344 else code = icode; 345 end; 346 347 348 end linus_invoke; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/29/86 0939.8 linus_invoke.pl1 >special_ldd>install>MR12.0-1106>linus_invoke.pl1 50 1 05/20/83 1846.4 iocb.incl.pl1 >ldd>include>iocb.incl.pl1 52 2 07/29/86 0937.8 linus_lcb.incl.pl1 >special_ldd>install>MR12.0-1106>linus_lcb.incl.pl1 54 3 11/23/82 1327.3 linus_char_argl.incl.pl1 >ldd>include>linus_char_argl.incl.pl1 56 4 03/27/82 0434.5 linus_invoc_stack.incl.pl1 >ldd>include>linus_invoc_stack.incl.pl1 58 5 04/13/82 1620.2 ssu_prompt_modes.incl.pl1 >ldd>include>ssu_prompt_modes.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. DONT_PROMPT 000002 constant bit(1) initial unaligned dcl 5-7 set ref 205* DONT_PROMPT_AFTER_NULL_LINES constant bit(2) initial unaligned dcl 5-10 ref 339 PROMPT constant bit(1) initial unaligned dcl 5-6 ref 339 PROMPT_IF_TYPEAHEAD constant bit(3) initial unaligned dcl 5-12 ref 339 STREAM_INPUT 000021 constant fixed bin(17,0) initial dcl 62 set ref 159* actual_input_iocbp 54 based pointer level 2 dcl 2-53 set ref 167* 170* 276* 277* 333* 335* arg 2 based structure array level 2 dcl 3-9 arg_len 4 based fixed bin(21,0) array level 3 dcl 3-9 set ref 143* 145 145 145 147 149 195 195* 197 233 250 311 311 324 324 arg_ptr 4 based pointer array level 3 in structure "invoc_stack" dcl 4-3 in procedure "linus_invoke" set ref 187* 262 321 322 arg_ptr 2 based pointer array level 3 in structure "char_argl" dcl 3-9 in procedure "linus_invoke" set ref 143* 145 147 149 197 198* 232 251 311 324 argument based char unaligned dcl 65 ref 311 324 attach_description 000176 automatic char(37) unaligned dcl 77 set ref 179* 180* 272* 273* before builtin function dcl 88 ref 157 157 160 160 ca_ptr 000100 automatic pointer dcl 3-15 set ref 119* 141* 143 143 145 145 145 145 147 147 149 149 188 191 195 197 197 207 207 238 238 309* 310 311 311 311 313 322* 323 324 324 324 326 cal_ptr 24 based pointer level 2 dcl 2-53 set ref 187 188* 201* 248 249 250 251 254 262* 308 309 314* char_argl based structure level 1 dcl 3-9 set ref 141 192 207 236 238 254 313 326 cleanup 000242 stack reference condition dcl 98 ref 123 code parameter fixed bin(35,0) dcl 89 set ref 243 246* 266* 267 273* 276* 277 277* 295 299* 344* cu_$decode_entry_value 000026 constant entry external dcl 100 ref 150 dot_linus 000220 automatic char(6) unaligned dcl 79 set ref 140* 145* 147 env_ptr 000230 automatic pointer initial dcl 80 set ref 80* 150* err_code parameter fixed bin(35,0) dcl 214 set ref 211 218* error_table_$not_attached 000012 external static fixed bin(35,0) dcl 90 ref 168 i 000235 automatic fixed bin(17,0) dcl 87 in procedure "linus_invoke" set ref 142* 143* 143 143* 249* 250 251* 318* 319 320 321 322* i 000100 automatic fixed bin(17,0) dcl 226 in procedure "clean_up" set ref 231* 232 233* icode 000236 automatic fixed bin(35,0) dcl 89 set ref 121* 154* 157 157* 159* 160 160* 167* 168 168 168* 170* 171 171* 175* 176 176* 180* 181 181* 256* 257 257* 259* 260 260* 305* 306* 319* 320* 332* 333 333* 335 335* 337 342* 344 invoc 2 based structure array level 2 dcl 4-3 invoc_stack based structure level 1 dcl 4-3 set ref 136 283 329 ioa_$rsnnl 000030 constant entry external dcl 101 ref 152 153 iocb based structure level 1 dcl 1-6 iocb_ptr 000222 automatic pointer initial dcl 80 in procedure "linus_invoke" set ref 80* 154* 159* 179 186 iocb_ptr 2 based pointer array level 3 in structure "invoc_stack" dcl 4-3 in procedure "linus_invoke" set ref 185* 264 319* 320* iox_$attach_name 000032 constant entry external dcl 102 ref 154 iox_$attach_ptr 000034 constant entry external dcl 103 ref 180 273 iox_$close 000050 constant entry external dcl 109 ref 256 305 319 iox_$destroy_iocb 000046 constant entry external dcl 108 ref 277 335 iox_$detach_iocb 000044 constant entry external dcl 107 ref 175 259 266 306 320 332 iox_$find_iocb 000040 constant entry external dcl 105 ref 167 iox_$move_attach 000042 constant entry external dcl 106 ref 170 276 333 iox_$open 000036 constant entry external dcl 104 ref 159 iox_$user_input 000070 external static pointer dcl 117 set ref 170* 175* 180* 266* 270 273* 276* 303 307 332* 333* is_ptr 22 based pointer level 2 dcl 2-53 set ref 185 186* 256* 259* 264* 270 272 303 305* 306* 307* ivs_ptr 000104 automatic pointer dcl 4-9 in procedure "linus_invoke" set ref 131* 132 136* 137 138 163 184 184 185 185 187 187 247* 262 262 264 264 281 281 282 283 317* 318 319 320 321 322 329 ivs_ptr 42 based pointer level 2 in structure "lcb" dcl 2-53 in procedure "linus_invoke" set ref 130 131 137* 247 284* 316 317 330* l 000234 automatic fixed bin(17,0) dcl 87 set ref 193* 194 195 195 197 197 198* 310* 311 311 311* 323* 324 324 324* lcb based structure level 1 dcl 2-53 lcb_ptr parameter pointer dcl 2-121 set ref 19 130 131 136 137 141 152* 167 170 185 186 187 188 192 196 201 243 247 248 249 250 251 254 256 259 262 264 270 272 276 277 284 295 300 lcbpa 000106 automatic char(16) unaligned dcl 66 set ref 152* 154 lcbpl 000112 automatic fixed bin(21,0) dcl 67 set ref 152* 154 linus_convert_code 000052 constant entry external dcl 110 ref 218 linus_data_$i_id 000020 external static fixed bin(35,0) dcl 90 set ref 218* linus_data_$max_invocs 000022 external static fixed bin(35,0) dcl 90 ref 132 136 283 329 linus_error_$no_input_arg 000014 external static fixed bin(35,0) dcl 90 set ref 128* linus_error_$too_many_invocs 000016 external static fixed bin(35,0) dcl 90 set ref 132* mac_len 000237 automatic fixed bin(35,0) dcl 89 set ref 121* 195* 196 196 197 228 228 233* 234 234 250* 252 252 mac_ptr 000226 automatic pointer initial dcl 80 set ref 80* 196* 197 198 199* 228 228 232* 234 251* 252 macro_arg based char unaligned dcl 69 set ref 196 197* 228 234 252 macro_path 000113 automatic char(168) unaligned dcl 68 set ref 147* 149* 154 157 157 160 160 name 1 based char(32) level 2 dcl 1-6 ref 179 272 nargs based fixed bin(17,0) level 2 dcl 3-9 set ref 141* 188 191 192* 194* 207 231 236 238 249 254 310 313 323 326 nargs_init 000102 automatic fixed bin(17,0) dcl 3-16 set ref 127* 128 141 141 142 191* 192 192 193 ninvocs based fixed bin(17,0) level 2 dcl 4-3 set ref 132 138* 163 184* 184 185 187 262 264 281* 281 282 318 null builtin function dcl 88 ref 80 80 80 80 80 119 130 188 199 202 207 228 230 238 248 284 308 314 316 321 330 out_code 000240 automatic fixed bin(35,0) dcl 89 set ref 218* 219* path_name based char unaligned dcl 64 ref 145 147 149 popped_on_pi 000165 automatic bit(1) unaligned dcl 70 set ref 292* 301* 342 prompt_flag 15 based bit(1) level 2 packed unaligned dcl 2-53 ref 339 ref_ptr 000224 automatic pointer initial dcl 80 set ref 80* 150* 154* 180* 273* sci_ptr parameter pointer dcl 60 set ref 19 125 127* 143* 153* 205* 219* 288 291* 342* scipa 000166 automatic char(16) unaligned dcl 71 set ref 153* 154 scipl 000172 automatic fixed bin(21,0) dcl 72 set ref 153* 154 ssu_$abort_line 000054 constant entry external dcl 111 ref 219 ssu_$abort_subsystem 000056 constant entry external dcl 112 ref 342 ssu_$arg_count 000060 constant entry external dcl 113 ref 127 ssu_$arg_ptr 000062 constant entry external dcl 114 ref 143 ssu_$get_info_ptr 000064 constant entry external dcl 115 ref 291 ssu_$set_prompt_mode 000066 constant entry external dcl 116 ref 205 339 static_area 144 based area level 2 dcl 2-53 ref 136 141 192 196 static_sci_ptr 000010 internal static pointer dcl 73 set ref 125* 339* string parameter char unaligned dcl 215 set ref 211 219* substr builtin function dcl 88 ref 145 154 154 sw_name 000210 automatic char(32) unaligned dcl 78 set ref 151* 154* 165* 167* temp_lcb_ptr 000174 automatic pointer dcl 74 set ref 291* 300* 303 305 306 307 308 309 314 316 317 330 333 335 339 tmp_char based char unaligned dcl 75 ref 197 tmp_ptr 000232 automatic pointer initial dcl 80 set ref 80* 192* 194 195 198 201 202* 230 231 232 233 236 unique_chars_ 000024 constant entry external dcl 99 ref 151 165 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. DONT_PROMPT_IF_TYPEAHEAD internal static bit(3) initial unaligned dcl 5-13 PROMPT_AFTER_NULL_LINES internal static bit(2) initial unaligned dcl 5-9 addr builtin function dcl 88 fixed builtin function dcl 88 iox_$iocb_version_sentinel external static char(4) dcl 1-51 rel builtin function dcl 88 sys_info$max_seg_size external static fixed bin(35,0) dcl 90 NAMES DECLARED BY EXPLICIT CONTEXT. clean_up 002362 constant entry internal dcl 223 ref 123 217 common_pop_all 001737 constant label dcl 303 ref 293 error 002276 constant entry internal dcl 211 ref 128 132 157 160 168 171 176 181 257 260 linus_invoke 000117 constant entry external dcl 19 ref 150 150 pop 001363 constant entry external dcl 243 pop_all 001720 constant entry external dcl 295 pop_all_on_pi 001673 constant entry external dcl 288 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3016 3110 2457 3026 Length 3460 2457 72 333 337 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_invoke 242 external procedure is an external procedure. on unit on line 123 64 on unit error 88 internal procedure is called during a stack extension. clean_up 66 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 static_sci_ptr linus_invoke STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME clean_up 000100 i clean_up linus_invoke 000100 ca_ptr linus_invoke 000102 nargs_init linus_invoke 000104 ivs_ptr linus_invoke 000106 lcbpa linus_invoke 000112 lcbpl linus_invoke 000113 macro_path linus_invoke 000165 popped_on_pi linus_invoke 000166 scipa linus_invoke 000172 scipl linus_invoke 000174 temp_lcb_ptr linus_invoke 000176 attach_description linus_invoke 000210 sw_name linus_invoke 000220 dot_linus linus_invoke 000222 iocb_ptr linus_invoke 000224 ref_ptr linus_invoke 000226 mac_ptr linus_invoke 000230 env_ptr linus_invoke 000232 tmp_ptr linus_invoke 000234 l linus_invoke 000235 i linus_invoke 000236 icode linus_invoke 000237 mac_len linus_invoke 000240 out_code linus_invoke THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_other return enable shorten_stack ext_entry int_entry int_entry_desc alloc_based free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$decode_entry_value ioa_$rsnnl iox_$attach_name iox_$attach_ptr iox_$close iox_$destroy_iocb iox_$detach_iocb iox_$find_iocb iox_$move_attach iox_$open linus_convert_code ssu_$abort_line ssu_$abort_subsystem ssu_$arg_count ssu_$arg_ptr ssu_$get_info_ptr ssu_$set_prompt_mode unique_chars_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$not_attached iox_$user_input linus_data_$i_id linus_data_$max_invocs linus_error_$no_input_arg linus_error_$too_many_invocs LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 80 000103 19 000113 119 000130 121 000132 123 000134 125 000156 127 000163 128 000173 130 000212 131 000220 132 000222 134 000242 136 000243 137 000255 138 000260 140 000261 141 000263 142 000276 143 000305 144 000325 145 000327 147 000345 149 000367 150 000375 151 000414 152 000446 153 000476 154 000526 157 000626 159 000661 160 000701 163 000733 165 000736 167 000770 168 001014 170 001041 171 001056 173 001077 175 001100 176 001111 179 001132 180 001141 181 001165 184 001206 185 001207 186 001216 187 001222 188 001226 191 001236 192 001240 193 001253 194 001261 195 001262 196 001270 197 001301 198 001313 199 001315 200 001317 201 001321 202 001325 205 001327 207 001345 209 001356 243 001357 246 001374 247 001376 248 001402 249 001406 250 001415 251 001423 252 001426 253 001432 254 001434 256 001443 257 001456 259 001475 260 001510 262 001526 264 001535 266 001542 267 001554 270 001557 272 001566 273 001575 274 001620 276 001621 277 001633 281 001651 282 001653 283 001655 284 001663 286 001667 288 001670 291 001701 292 001713 293 001715 295 001716 299 001731 300 001733 301 001736 303 001737 305 001745 306 001755 307 001767 308 001774 309 002000 310 002002 311 002011 312 002022 313 002024 314 002031 316 002034 317 002041 318 002043 319 002053 320 002066 321 002102 322 002111 323 002115 324 002125 325 002136 326 002140 328 002145 329 002147 330 002155 332 002160 333 002171 335 002207 337 002223 339 002225 341 002250 342 002251 344 002272 348 002274 211 002275 217 002311 218 002316 219 002333 221 002360 223 002361 228 002367 230 002401 231 002406 232 002415 233 002423 234 002425 235 002431 236 002433 238 002441 241 002453 ----------------------------------------------------------- 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