COMPILATION LISTING OF SEGMENT linus_canon_input Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 07/29/86 0959.8 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 linus_canon_input: 19 proc (lcb_ptr, lineptr, nread, code); 20 21 /* DESCRIPTION: 22* 23* This procedure canonized an input line by removing comments and by 24* substituting for macro arguments. Substitution for linus variables is left 25* to the request handlers to eliminate possible conversions to character 26* form. 27* 28* 29* 30* HISTORY: 31* 32* 77-06-01 J. A. Weeldreyer: Initially written. 33* 34* 78-04-01 J. A. Weeldreyer: Modified to properly handle /*'s in quoted 35* strings -- April, 1978. 36* 37* 82-02-18 Paul W. Benjamin: ssu_ conversion. This procedure is now called 38* only from the linus_invoke_ I/O module. Calling sequence altered to reflect 39* the fact that the variables line, and line_array now refer to the line as 40* read by iox_$get_line rather than something in the lcb. 41* 42**/ 43 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 */ 44 45 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 */ 46 47 48 dcl lineptr ptr parameter; /* Input: ptr to input line. */ 49 dcl nread fixed bin (21); /* Input/Output: No. of input chars. */ 50 dcl code fixed bin (35); /* Output: status code */ 51 52 dcl ( 53 i, /* internal indices */ 54 start_pos 55 ) fixed bin; /* position in input line */ 56 57 dcl arg_no fixed bin; /* specified arg no. */ 58 dcl canon_line char (lcb.rb_len) var; /* place to build canonized line */ 59 dcl line char (nread) based (lineptr); /* old input line */ 60 dcl line_array (nread) char (1) unal based (lineptr); /* array view */ 61 dcl in_quote bit (1) unal; 62 63 dcl ( 64 linus_error_$no_macro_arg, 65 linus_error_$bad_macro_arg, 66 linus_error_$bad_comment, 67 linus_error_$exp_line_len, 68 sys_info$max_seg_size 69 ) fixed bin (35) ext; 70 71 dcl (fixed, rel, addr, search, verify, index, null, length, substr) builtin; 72 73 start_pos = 1; /* initialize */ 74 canon_line = ""; 75 in_quote = "0"b; 76 77 do while (start_pos < nread); /* look through entire input line */ 78 79 i = search (substr (line, start_pos), """%/"); /* look for possible arg or comment */ 80 if i <= 0 then do; /* not found */ 81 call add_to_line (addr (line_array (start_pos)), nread - start_pos + 1); 82 /* add rest of line to output */ 83 start_pos = nread; /* finished */ 84 end; 85 else do; /* found one */ 86 call add_to_line (addr (line_array (start_pos)), i - 1); 87 /* add scanned characters */ 88 start_pos = start_pos + i - 1; /* index of char just found */ 89 if line_array (start_pos) = """" then do; /* if possible start of end of quoted string */ 90 in_quote = ^in_quote; 91 call add_to_line (addr (line_array (start_pos)), 1); 92 start_pos = start_pos + 1; 93 end; 94 else if line_array (start_pos) = "%" then do; /* if arg. */ 95 if line_array (start_pos + 1) = "%" then do; /* just put in one % */ 96 call add_to_line (addr (line_array (start_pos)), 1); 97 start_pos = start_pos + 2; 98 end; 99 else do; /* if not double % */ 100 if lcb.cal_ptr = null then 101 call error (linus_error_$no_macro_arg); 102 /* if no args defined for macro */ 103 i = verify (substr (line, start_pos + 1), "0123456789"); 104 /* look for end */ 105 if i <= 1 then 106 call error (linus_error_$bad_macro_arg); 107 /* no number */ 108 if line_array (start_pos + i) ^= "%" then 109 call error (linus_error_$bad_macro_arg); 110 /* no closing % */ 111 arg_no = fixed (substr (line, start_pos + 1, i - 1)); 112 /* isolate arg number */ 113 ca_ptr = lcb.cal_ptr; /* get args for this macro */ 114 if arg_no < 1 | arg_no > char_argl.nargs then 115 /* must be in range */ 116 call error (linus_error_$no_macro_arg); 117 call add_to_line (char_argl.arg.arg_ptr (arg_no), char_argl.arg.arg_len (arg_no)); 118 /* make subst. */ 119 start_pos = start_pos + i + 1; /* first char. beyond % */ 120 end; /* if not double % */ 121 end; /* macro arg */ 122 else if substr (line, start_pos, 2) = "/*" & ^in_quote then do; 123 /* if comment */ 124 i = index (substr (line, start_pos + 2), "*/"); 125 /* look for end of comment */ 126 if i <= 0 then 127 call error (linus_error_$bad_comment); /* not found */ 128 start_pos = start_pos + i + 3; /* first char beyond comment */ 129 end; /* if comment */ 130 else do; /* if was only / or slash-star in quote str. */ 131 call add_to_line (addr (line_array (start_pos)), 1); 132 /* add the / to the output */ 133 start_pos = start_pos + 1; 134 end; 135 end; /* if spec char found */ 136 end; /* main loop */ 137 138 nread = length (canon_line); 139 line = canon_line; 140 code = 0; 141 142 exit: 143 return; 144 145 add_to_line: 146 proc (c_ptr, c_len); 147 148 /* Procedure to add string to canon. line */ 149 150 dcl c_ptr ptr; 151 dcl c_len fixed bin (21); 152 dcl c_string char (c_len) based (c_ptr); 153 154 if length (canon_line) + c_len > lcb.rb_len then /* must stay in bounds */ 155 call error (linus_error_$exp_line_len); 156 canon_line = canon_line || c_string; 157 158 end add_to_line; 159 160 error: 161 proc (cd); 162 163 /* Error procedure */ 164 165 dcl cd fixed bin (35); 166 167 code = cd; 168 go to exit; 169 170 end error; 171 172 end linus_canon_input; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/29/86 0939.8 linus_canon_input.pl1 >special_ldd>install>MR12.0-1106>linus_canon_input.pl1 44 1 07/29/86 0937.8 linus_lcb.incl.pl1 >special_ldd>install>MR12.0-1106>linus_lcb.incl.pl1 46 2 11/23/82 1327.3 linus_char_argl.incl.pl1 >ldd>include>linus_char_argl.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. addr builtin function dcl 71 ref 81 81 86 86 91 91 96 96 131 131 arg 2 based structure array level 2 dcl 2-9 arg_len 4 based fixed bin(21,0) array level 3 dcl 2-9 set ref 117* arg_no 000104 automatic fixed bin(17,0) dcl 57 set ref 111* 114 114 117 117 arg_ptr 2 based pointer array level 3 dcl 2-9 set ref 117* c_len parameter fixed bin(21,0) dcl 151 ref 145 154 156 c_ptr parameter pointer dcl 150 ref 145 156 c_string based char unaligned dcl 152 ref 156 ca_ptr 000100 automatic pointer dcl 2-15 set ref 113* 114 117 117 cal_ptr 24 based pointer level 2 dcl 1-53 ref 100 113 canon_line 000105 automatic varying char dcl 58 set ref 74* 138 139 154 156* 156 cd parameter fixed bin(35,0) dcl 165 ref 160 167 char_argl based structure level 1 dcl 2-9 code parameter fixed bin(35,0) dcl 50 set ref 18 140* 167* fixed builtin function dcl 71 ref 111 i 000102 automatic fixed bin(17,0) dcl 52 set ref 79* 80 86 88 103* 105 108 111 119 124* 126 128 in_quote 000105 automatic bit(1) unaligned dcl 61 set ref 75* 90* 90 122 index builtin function dcl 71 ref 124 lcb based structure level 1 dcl 1-53 lcb_ptr parameter pointer dcl 1-121 ref 18 58 100 113 154 length builtin function dcl 71 ref 138 154 line based char unaligned dcl 59 set ref 79 103 111 122 124 139* line_array based char(1) array unaligned dcl 60 set ref 81 81 86 86 89 91 91 94 95 96 96 108 131 131 lineptr parameter pointer dcl 48 ref 18 79 81 81 86 86 89 91 91 94 95 96 96 103 108 111 122 124 131 131 139 linus_error_$bad_comment 000014 external static fixed bin(35,0) dcl 63 set ref 126* linus_error_$bad_macro_arg 000012 external static fixed bin(35,0) dcl 63 set ref 105* 108* linus_error_$exp_line_len 000016 external static fixed bin(35,0) dcl 63 set ref 154* linus_error_$no_macro_arg 000010 external static fixed bin(35,0) dcl 63 set ref 100* 114* nargs based fixed bin(17,0) level 2 dcl 2-9 ref 114 nread parameter fixed bin(21,0) dcl 49 set ref 18 77 79 81 83 103 111 122 124 138* 139 null builtin function dcl 71 ref 100 rb_len 1 based fixed bin(21,0) level 2 dcl 1-53 ref 58 154 search builtin function dcl 71 ref 79 start_pos 000103 automatic fixed bin(17,0) dcl 52 set ref 73* 77 79 81 81 81 83* 86 86 88* 88 89 91 91 92* 92 94 95 96 96 97* 97 103 108 111 119* 119 122 124 128* 128 131 131 133* 133 substr builtin function dcl 71 ref 79 103 111 122 124 verify builtin function dcl 71 ref 103 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. nargs_init automatic fixed bin(17,0) dcl 2-16 rel builtin function dcl 71 sys_info$max_seg_size external static fixed bin(35,0) dcl 63 NAMES DECLARED BY EXPLICIT CONTEXT. add_to_line 000426 constant entry internal dcl 145 ref 81 86 91 96 117 131 error 000465 constant entry internal dcl 160 ref 100 105 108 114 126 154 exit 000425 constant label dcl 142 ref 168 linus_canon_input 000016 constant entry external dcl 18 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1206 1226 1120 1216 Length 1444 1120 20 201 65 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_canon_input 276 external procedure is an external procedure. add_to_line internal procedure shares stack frame of external procedure linus_canon_input. error internal procedure shares stack frame of external procedure linus_canon_input. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_canon_input 000100 ca_ptr linus_canon_input 000102 i linus_canon_input 000103 start_pos linus_canon_input 000104 arg_no linus_canon_input 000105 in_quote linus_canon_input 000105 canon_line linus_canon_input THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return alloc_auto_adj ext_entry any_to_any_tr NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. linus_error_$bad_comment linus_error_$bad_macro_arg linus_error_$exp_line_len linus_error_$no_macro_arg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000011 58 000023 73 000036 74 000040 75 000041 77 000042 79 000046 80 000067 81 000070 83 000102 84 000105 86 000106 88 000116 89 000122 90 000133 91 000136 92 000146 93 000147 94 000150 95 000152 96 000156 97 000166 98 000170 100 000171 103 000206 105 000226 108 000237 111 000257 113 000277 114 000304 117 000320 119 000333 121 000337 122 000340 124 000346 126 000364 128 000374 129 000400 131 000401 133 000411 136 000412 138 000413 139 000415 140 000424 142 000425 145 000426 154 000430 156 000446 158 000464 160 000465 167 000467 168 000472 ----------------------------------------------------------- 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