COMPILATION LISTING OF SEGMENT fst_command_processor_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 01/19/88 1503.3 mst Tue Options: optimize map 1 /****^ ****************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* ****************************************************** */ 9 10 11 12 /****^ HISTORY COMMENTS: 13* 1) change(87-12-03,TLNguyen), approve(87-12-03,MCR7806), 14* audit(87-12-10,Lippard), install(88-01-19,MR12.2-1015): 15* - Replace the "changes will be lost if you continue. Do you want to 16* continue?" queried message with "Changes will be lost if you quit. 17* Do you want to quit?". 18* - Remove the mod from the source because it is not referenced anywhere 19* within the source. 20* END HISTORY COMMENTS */ 21 22 23 fst_command_processor_: proc (arg_line, edit_changes); 24 25 /* * This procedure parses the user's command line. If it finds a commmand it recognizes, it builds a descriptor 26* * list and calls the command. The input line is assumed to be non-blank. 27* * Arguments are separated by blanks or tabs and there is a maximum of ten arguments allowed. 28* * 29* * edm on quit the user is queried, if he wants to continue, pi is signaled. 30* * logout if editing changes will be lost, the user is queried. 31* * 32* * Written 3/76 by S.E. Barr 33* */ 34 /* Fixed to find commands each time rather than assume their existence 12/12/79 S. Herbst */ 35 /* Add use_ep_basic and use_sp_basic commands. 10/25/83 C Spitzer */ 36 37 /* parameters */ 38 39 dcl arg_line char (*); /* user's command line */ 40 dcl edit_changes bit (1) unal; /* edit changes since last save */ 41 42 /* automatic */ 43 dcl (start, num_chars) fixed bin; /* start and number of characters in argument */ 44 dcl name char (32); /* command name */ 45 dcl line_length fixed bin; /* number of characters in line */ 46 dcl i fixed bin; 47 dcl command_index fixed bin; /* index to procedure ptr */ 48 dcl arg_length (max_num_args) fixed bin; /* temporarily holds argument lengths */ 49 dcl 1 descriptors (max_num_args) aligned based (addr (al.pointers (num_args + 1))), 50 2 desc_pointers bit (18) unal, 51 2 pad_pointers bit (18) unal, 52 2 flag bit (1) unal, 53 2 type bit (6) unal, 54 2 packed bit (1) unal, 55 2 ndims bit (4) unal, 56 2 size bit (24) unal; 57 dcl 1 al aligned, 58 2 dum_ptr ptr, 59 2 num_args fixed bin (16) unaligned, 60 2 tag bit (19) initial ("0000000000000000100"b) unaligned, 61 2 ndescs fixed bin (16) unaligned, 62 2 pad bit (19) unaligned, 63 2 pointers (20) ptr; 64 dcl (addr, bin, bit, hbound, length, null, rel, search, substr, unspec, verify) builtin; 65 dcl line char (256); 66 dcl answer char (3) var; /* 'yes' or 'no' for queries */ 67 dcl 1 query_info aligned, 68 2 version fixed bin init (2), 69 2 yes_or_no_sw bit (1) unal init ("1"b), /* must be yes or no */ 70 2 suppress_name_sw bit (1) unal init ("1"b), /* don't print name */ 71 2 code fixed bin (35) init (0), 72 2 query_code fixed bin (35) init (0); 73 74 dcl quit condition; 75 76 /* internal static */ 77 78 dcl max_num_args fixed bin int static options (constant) init (10); 79 dcl white_space char (2) int static options (constant) init (" "); /* TAB BLANK */ 80 81 /* based */ 82 83 dcl proc_ptr ptr based (addr (entry_value)); 84 85 /* external */ 86 87 dcl command_names (50) char (20) int static options (constant) init ( 88 "add_line_numbers", "aln", 89 "add_name", "an", 90 "basic", "", 91 "copy", "cp", 92 "delete", "dl", 93 "delete_acl", "da", 94 "delete_line_numbers", "dln", 95 "delete_name", "dn", 96 "dprint", "dp", 97 "edm", "edm", 98 "fortran", "ft", 99 "help", "", 100 "how_many_users", "hmu", 101 "link", "lk", 102 "list", "ls", 103 "list_acl", "la", 104 "logout", "logout", 105 "rename", "rn", 106 "set_acl", "sa", 107 "set_tty", "stty", 108 "truncate", "tc", 109 "use_ep_basic", "", 110 "use_sp_basic", "", 111 "convert_numeric_file", "", 112 "unlink", "ul"); 113 114 dcl cu_$gen_call entry (ptr, ptr); 115 dcl command_query_ entry options (variable); 116 dcl cv_entry_ entry (char (*), ptr, fixed bin (35)) returns (entry); 117 dcl ioa_$ioa_switch entry options (variable); 118 dcl iox_$user_output ext ptr; 119 120 dcl entry_value entry variable options (variable); 121 122 /* */ 123 start = 1; 124 line = arg_line; /* setup for get_arg */ 125 line_length = length (arg_line); 126 command_index = 0; 127 128 if get_arg () then do; 129 name = substr (line, start, num_chars); 130 start = start + num_chars; 131 unspec (al) = "0"b; 132 do command_index = hbound (command_names, 1) by -1 to 1 133 while (command_names (command_index) ^= name); end; 134 135 if command_index > 0 then do; 136 num_args = 0; 137 138 do while (get_arg ()); 139 if num_args < max_num_args then do; 140 num_args = num_args + 1; 141 al.pointers (num_args) = addr (substr (line, start, 1)); 142 arg_length (num_args) = num_chars; 143 start = start + num_chars; 144 end; 145 else call abort ("maximum of 10 arguments was exceeded", substr (line, start, num_chars)); 146 end; 147 al.tag = "0000000000000000100"b; 148 al.ndescs = num_args; 149 150 do i = 1 to num_args; 151 desc_pointers (i) = rel (addr (descriptors (i).flag)); 152 descriptors (i).flag = "1"b; 153 descriptors (i).size = bit (bin (arg_length (i), 24)); 154 descriptors (i).type = bit (bin (21, 6)); 155 descriptors (i).packed = "1"b; 156 end; 157 158 if name = "edm" then on quit call edm_query; 159 else if name = "logout" then call logout_query; /* check if editing will be lost */ 160 else if name = "help" then name = "fst_help_"; 161 else if name = "basic" then name = "fst_compile_$basic"; 162 else if name = "fortran" | name = "ft" then name = "fst_compile_$fortran"; 163 else if name = "use_ep_basic" then name = "fst_compile_$ep_basic"; 164 else if name = "use_sp_basic" then name = "fst_compile_$sp_basic"; 165 166 entry_value = cv_entry_ (name, null, code); 167 if code ^= 0 then do; 168 call ioa_$ioa_switch (iox_$user_output, 169 "fast: ^a not an object segment.", name); 170 go to RETURN; 171 end; 172 173 call cu_$gen_call (proc_ptr, addr (al.num_args)); 174 end; 175 else call abort ("unrecognized command", name); 176 end; 177 RETURN: 178 return; 179 180 /* */ 181 /* * This procedure gets the index of the next argument on the line. It uses global variables: 182* * 183* * line user's command line 184* * start (input) index to begin search 185* * (output) index of start of argument 186* * num_chars (output) length of argument 187* * 188* * "1"b the argument was found 189* * "0"b no arguments remain on the line 190**/ 191 get_arg: proc () returns (bit (1)); 192 193 dcl i fixed bin; 194 195 if start <= line_length then do; 196 i = verify (substr (line, start, line_length - start + 1), white_space); 197 if i > 0 then do; 198 start = start + i -1; 199 num_chars = search (substr (line, start, line_length - start + 1), white_space) -1; 200 if num_chars = -1 then num_chars = line_length - start + 1; 201 return ("1"b); 202 end; 203 end; 204 205 return ("0"b); 206 207 end get_arg; 208 209 210 /* This procedure prints an error message and then returns from fst_command_processor_ */ 211 abort: proc (err_message, add_info); 212 213 dcl err_message char (*); 214 dcl add_info char (*); 215 216 call ioa_$ioa_switch (iox_$user_output, "fast: ^a ^a", err_message, add_info); 217 218 goto RETURN; 219 220 end abort; 221 222 /* */ 223 /* This procedure is called when the user has quit out of edm. If he wants to continue editing, program 224* interrupt is signaled. Otherwise a non-local goto is made to return to command level. 225**/ 226 edm_query: proc; 227 228 dcl program_interrupt condition; 229 230 call ioa_$ioa_switch (iox_$user_output, "QUIT"); 231 call command_query_ (addr (query_info), answer, "edm", "Do you want to continue editing ?"); 232 if answer = "yes" then signal program_interrupt; 233 else goto RETURN; 234 235 end edm_query; 236 237 /* This procedure is called when the user types logout. If there is temporary text that has been modified 238* since the last save, the user will be queried. If he types 'yes' logout will be called. If he types 'no' 239* the process will return to command level. 240**/ 241 logout_query: proc; 242 243 if edit_changes then do; 244 call command_query_ (addr (query_info), answer, "fast", 245 "Changes will be lost if you quit. Do you want to quit ?"); 246 if answer = "no" then goto RETURN; 247 end; 248 249 return; 250 251 end logout_query; 252 253 end fst_command_processor_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/19/88 1500.7 fst_command_processor_.pl1 >spec>install>MR12.2-1015>fst_command_processor_.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. add_info parameter char unaligned dcl 214 set ref 211 216* addr builtin function dcl 64 ref 141 151 151 151 152 153 154 155 173 173 173 231 231 244 244 al 000116 automatic structure level 1 dcl 57 set ref 131* answer 000272 automatic varying char(3) dcl 66 set ref 231* 232 244* 246 arg_length 000115 automatic fixed bin(17,0) array dcl 48 set ref 142* 153 arg_line parameter char unaligned dcl 39 ref 23 124 125 bin builtin function dcl 64 ref 153 154 bit builtin function dcl 64 ref 153 154 code 2 000274 automatic fixed bin(35,0) initial level 2 dcl 67 set ref 67* 166* 167 command_index 000114 automatic fixed bin(17,0) dcl 47 set ref 126* 132* 132* 135 command_names 000000 constant char(20) initial array unaligned dcl 87 ref 132 132 command_query_ 000012 constant entry external dcl 115 ref 231 244 cu_$gen_call 000010 constant entry external dcl 114 ref 173 cv_entry_ 000014 constant entry external dcl 116 ref 166 desc_pointers based bit(18) array level 2 packed unaligned dcl 49 set ref 151* descriptors based structure array level 1 dcl 49 edit_changes parameter bit(1) unaligned dcl 40 ref 23 243 entry_value 000306 automatic entry variable dcl 120 set ref 166* 173 err_message parameter char unaligned dcl 213 set ref 211 216* flag 1 based bit(1) array level 2 packed unaligned dcl 49 set ref 151 152* hbound builtin function dcl 64 ref 132 i 000113 automatic fixed bin(17,0) dcl 46 in procedure "fst_command_processor_" set ref 150* 151 151 152 153 153 154 155* i 000346 automatic fixed bin(17,0) dcl 193 in procedure "get_arg" set ref 196* 197 198 ioa_$ioa_switch 000016 constant entry external dcl 117 ref 168 216 230 iox_$user_output 000020 external static pointer dcl 118 set ref 168* 216* 230* length builtin function dcl 64 ref 125 line 000172 automatic char(256) unaligned dcl 65 set ref 124* 129 141 145 145 196 199 line_length 000112 automatic fixed bin(17,0) dcl 45 set ref 125* 195 196 199 200 max_num_args constant fixed bin(17,0) initial dcl 78 ref 48 139 name 000102 automatic char(32) unaligned dcl 44 set ref 129* 132 158 159 160 160* 161 161* 162 162 162* 163 163* 164 164* 166* 168* 175* ndescs 3 000116 automatic fixed bin(16,0) level 2 packed unaligned dcl 57 set ref 148* null builtin function dcl 64 ref 166 166 num_args 2 000116 automatic fixed bin(16,0) level 2 packed unaligned dcl 57 set ref 136* 139 140* 140 141 142 148 150 151 151 152 153 154 155 173 173 num_chars 000101 automatic fixed bin(17,0) dcl 43 set ref 129 130 142 143 145 145 199* 200 200* packed 1(07) based bit(1) array level 2 packed unaligned dcl 49 set ref 155* pointers 4 000116 automatic pointer array level 2 dcl 57 set ref 141* 151 151 152 153 154 155 proc_ptr based pointer dcl 83 set ref 173* program_interrupt 000106 stack reference condition dcl 228 ref 232 query_code 3 000274 automatic fixed bin(35,0) initial level 2 dcl 67 set ref 67* query_info 000274 automatic structure level 1 dcl 67 set ref 231 231 244 244 quit 000300 stack reference condition dcl 74 ref 158 rel builtin function dcl 64 ref 151 search builtin function dcl 64 ref 199 size 1(12) based bit(24) array level 2 packed unaligned dcl 49 set ref 153* start 000100 automatic fixed bin(17,0) dcl 43 set ref 123* 129 130* 130 141 143* 143 145 145 195 196 196 198* 198 199 199 200 substr builtin function dcl 64 ref 129 141 145 145 196 199 suppress_name_sw 1(01) 000274 automatic bit(1) initial level 2 packed unaligned dcl 67 set ref 67* tag 2(17) 000116 automatic bit(19) initial level 2 packed unaligned dcl 57 set ref 57* 147* type 1(01) based bit(6) array level 2 packed unaligned dcl 49 set ref 154* unspec builtin function dcl 64 set ref 131* verify builtin function dcl 64 ref 196 version 000274 automatic fixed bin(17,0) initial level 2 dcl 67 set ref 67* white_space constant char(2) initial unaligned dcl 79 ref 196 199 yes_or_no_sw 1 000274 automatic bit(1) initial level 2 packed unaligned dcl 67 set ref 67* NAMES DECLARED BY EXPLICIT CONTEXT. RETURN 001265 constant label dcl 177 ref 170 218 232 246 abort 001353 constant entry internal dcl 211 ref 145 175 edm_query 001431 constant entry internal dcl 226 ref 158 fst_command_processor_ 000561 constant entry external dcl 23 get_arg 001266 constant entry internal dcl 191 ref 128 138 logout_query 001524 constant entry internal dcl 241 ref 159 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2314 2336 2206 2324 Length 2524 2206 22 151 105 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME fst_command_processor_ 320 external procedure is an external procedure. on unit on line 158 108 on unit get_arg internal procedure shares stack frame of external procedure fst_command_processor_. abort 88 internal procedure is called during a stack extension. edm_query internal procedure shares stack frame of on unit on line 158. logout_query internal procedure shares stack frame of external procedure fst_command_processor_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME fst_command_processor_ 000100 start fst_command_processor_ 000101 num_chars fst_command_processor_ 000102 name fst_command_processor_ 000112 line_length fst_command_processor_ 000113 i fst_command_processor_ 000114 command_index fst_command_processor_ 000115 arg_length fst_command_processor_ 000116 al fst_command_processor_ 000172 line fst_command_processor_ 000272 answer fst_command_processor_ 000274 query_info fst_command_processor_ 000306 entry_value fst_command_processor_ 000346 i get_arg THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out call_int_this_desc return_mac tra_ext_1 alloc_auto_adj signal_op enable_op shorten_stack ext_entry_desc int_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. command_query_ cu_$gen_call cv_entry_ ioa_$ioa_switch THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 23 000555 48 000574 57 000600 67 000604 123 000614 124 000616 125 000624 126 000626 128 000627 129 000634 130 000641 131 000643 132 000646 133 000661 135 000664 136 000666 138 000672 139 000677 140 000704 141 000711 142 000722 143 000726 144 000727 145 000730 146 000757 147 000761 148 000765 150 000774 151 001003 152 001017 153 001021 154 001031 155 001041 156 001043 158 001045 159 001070 160 001076 161 001106 162 001116 163 001132 164 001142 166 001151 167 001200 168 001202 170 001226 173 001227 174 001242 175 001243 177 001265 191 001266 195 001270 196 001273 197 001311 198 001312 199 001315 200 001332 201 001340 205 001345 211 001352 216 001373 218 001426 226 001431 230 001432 231 001451 232 001507 235 001523 241 001524 243 001525 244 001533 246 001567 249 001574 ----------------------------------------------------------- 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