COMPILATION LISTING OF SEGMENT change_symbols Compiled by: Multics PL/I Compiler, Release 27b, of September 15, 1981 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 02/04/82 1411.3 mst Thu 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 change_symbols: csb: procedure; 19 20 /* This procedure implements the change_symbols command. 21* * Created on 05/20/76 by Bill Silver as change_notescript. 22* * Changed on 06/07/77 by Bill Silver to change_symbols. 23* * Changed on 10/28/80 by Paul Benjamin for special suffixing. 24* * 25* * The change_symbols command will change the suffixing or expansion 26* * of a symbol in the current Speedtype symbol dictionary. 27* * Its calling sequence is: 28* * 29* * change_symbols, csb symbol -control_args 30* * 31* * where: 32* * 33* * -plural AA Defines this suffix. 34* * -ed AA 35* * -ing AA 36* * -er AA 37* * -ly AA 38* * 39* * -suffix "on" | "off" 40* * 41* * -exp AA Defines a new expansion for this symbol. 42**/ 43 44 /* AUTOMATIC DATA */ 45 46 dcl arg_len fixed bin; /* Length of a command argument. */ 47 dcl arg_ptr ptr; /* Pointer to a command argument. */ 48 dcl argx fixed bin; /* Index of current command argument. */ 49 dcl dir_name char (168); /* Directory containing symbol dictionary. */ 50 dcl ecode fixed bin (35); /* Error table code. */ 51 dcl ent_name char (32); /* Entry name of symbol dictionary. */ 52 dcl i fixed bin; 53 dcl sbx fixed bin; /* Index of symbol entry. */ 54 dcl temp_code fixed bin (35); /* Used when already have non-zero ecode. */ 55 dcl num_args fixed bin; /* Number of command arguments. */ 56 dcl option char (8); /* Option argument. */ 57 dcl optx fixed bin; /* Option argument index. */ 58 dcl suffix_len fixed bin; /* Length of suffix expansion string. */ 59 60 61 /* BASED DATA */ 62 63 dcl argument char (arg_len) based (arg_ptr); /* Command argument. */ 64 65 66 /* INTERNAL STATIC DATA */ 67 68 dcl options (7) char (8) /* Control arg options. */ 69 internal static init ("-plural", "-ed", "-ing", "-er", "-ly", 70 "-suffix", "-exp"); 71 72 73 /* EXTERNAL ENTRIES CALLED */ 74 75 dcl (addr, hbound, length) builtin; 76 77 dcl error_table_$bad_arg fixed bin (35) external; 78 dcl error_table_$badopt fixed bin (35) external; 79 dcl error_table_$no_w_permission fixed bin(35) ext static; 80 dcl error_table_$odd_no_of_args fixed bin (35) external; 81 dcl error_table_$wrong_no_of_args fixed bin (35) external; 82 83 dcl com_err_ entry options (variable); 84 dcl cu_$arg_count entry (fixed bin); 85 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 86 dcl speedtype_index_ entry (char (*), ptr, fixed bin, fixed bin (35)); 87 dcl speedtype_info_$name entry (char (*), char (*), fixed bin (35)); 88 dcl speedtype_info_$pointer entry (ptr, fixed bin (35)); 89 dcl speedtype_suffix_ entry (ptr, ptr, ptr, fixed bin, ptr, fixed bin); 90 /* */ 1 1 /* Begin include file ... speedtype_symbols.incl.pl1 1 2** Created on 09/06/76 by Bill Silver. 1 3** Modified 06/03/80 by Paul Benjamin to allow special suffixing. 1 4** 1 5** This include file defines the format of a Speedtype Symbol Dictionary. 1 6** The default Speedtype options are: 1 7** 1 8** ESCAPES: 1 9** temp "~" pad (Octal 177) perm "`" trans ":" space ";" 1 10** PREFIXES: 1 11** under "_" upper "+" 1 12** SUFFIXES: 1 13** plural "+" ed "-" ing "*" er "=" ly "|" 1 14** DELIMITERS: 1 15** ,"()?!<>[]{} 1 16**/ 1 17 dcl ssd_ptr ptr; /* Pointer to the base of a Speedtype Symbol Dictionary. */ 1 18 dcl exp_ptr ptr; /* Pointer to an expansion entry. */ 1 19 dcl sb_ptr ptr; /* Pointer to a symbol entry. */ 1 20 dcl spc_ptr ptr; /* Pointer to a special entry. */ 1 21 dcl delim_ptr ptr; /* Pointer to delimiter characters. */ 1 22 1 23 dcl ssd_version_2 fixed bin /* Version of this include file. */ 1 24 internal static init (2); 1 25 1 26 dcl 1 ssd based(ssd_ptr) aligned, /* Format of a Speedtype Symbol Dictionary. */ 1 27 2 version fixed bin, /* Version number. Currently = 2. */ 1 28 2 identifier char(12), /* "Seedtype_SD" => this is a Speedtype Symbol Dictionary. */ 1 29 2 flags bit(36), /* Not used, all zero. */ 1 30 2 delimiters char(24), /* Blank, New Line, Tab, Escapes, Others. */ 1 31 2 escapes char(5), /* Pad, Perm, Temp, Trans, Space */ 1 32 2 prefixes char(2), /* Under, Upper. */ 1 33 2 suffixes char(5), /* Plural, ed, ing, er, ly. */ 1 34 2 num_symbols fixed bin, /* Number of defined symbols. */ 1 35 2 table_size fixed bin, /* Size of the 3 tables to follow. */ 1 36 2 pad(14) bit(36), /* Round out header to 32 words. */ 1 37 2 spec_tab(table_size) like spc, /* Special entries. */ 1 38 2 exp_tab(table_size) like exp, /* Expansion entries. */ 1 39 2 sb_tab(table_size) like sb; /* Symbol entries. */ 1 40 1 41 dcl 1 delim_chars based(delim_ptr) aligned, /* Overlay of ssd.delimiters. */ 1 42 ( 2 blank char(1), 1 43 2 new_line char(1), 1 44 2 tab char(1), 1 45 2 escapes char(5), 1 46 2 others char(16)) unaligned; 1 47 1 48 dcl 1 sb based(sb_ptr) aligned, /* Symbol entry. */ 1 49 ( 2 new_line char(1), /* Needed to make index functions work. */ 1 50 2 symbol char(7)) unal; /* Actual symbol string. */ 1 51 1 52 dcl 1 exp based(exp_ptr) aligned, /* Expansion entry. */ 1 53 ( 2 actionx(5) fixed bin(8), /* Action index for each suffix. */ 1 54 2 pad fixed bin(17), /* Reserved for additional suffixes, flags, etc.. */ 1 55 2 len fixed bin(8), /* Actual length of expansion. */ 1 56 2 expansion char(56)) unal; /* Expansion of string (56 => size(exp) = 16 words). */ 1 57 dcl 1 spc based(spc_ptr) aligned, /* Special entry. */ 1 58 2 special (5) char(56) unal; /* One for each possible suffix. */ 1 59 1 60 /* End include file ... speedtype_symbols.incl.pl1 */ 91 92 /* */ 93 /* Begin change_symbols command. 94**/ 95 96 call cu_$arg_count (num_args); /* Get number of arguments. */ 97 if num_args < 3 98 then do; 99 call com_err_ (error_table_$wrong_no_of_args, "Speedtype", 100 "Usage is: csb symbol -control_args"); 101 return; 102 end; 103 104 /* Get symbol argument. */ 105 call cu_$arg_ptr (1, arg_ptr, arg_len, ecode); 106 if ecode ^= 0 107 then do; 108 call com_err_ (ecode, "Speedtype", "Error getting symbol argument"); 109 return; 110 end; 111 112 call speedtype_info_$pointer (ssd_ptr, ecode); 113 if ecode ^= 0 /* Did we get a pointer to the symbol dictionary? */ 114 then do; 115 if ecode = error_table_$no_w_permission 116 then do; 117 call speedtype_info_$name (dir_name, ent_name, temp_code); 118 call com_err_ (ecode, "Speedtype", "Attempting to convert ^a>^a to new version.", dir_name, ent_name); 119 end; 120 return; 121 end; 122 123 call speedtype_index_ (argument, ssd_ptr, sbx, ecode); 124 if ecode ^= 0 then return; /* Return if error getting symbol index. */ 125 if sbx = 0 /* Is symbol defined? */ 126 then do; /* No, error. */ 127 call com_err_ (0, "Speedtype", """^a"" not defined", argument); 128 return; 129 end; 130 131 sb_ptr = addr (ssd.sb_tab (sbx)); /* Get pointer to symbol entry. */ 132 exp_ptr = addr (ssd.exp_tab (sbx)); /* And expansion entry. */ 133 spc_ptr = addr (ssd.spec_tab (sbx)); /* AND special entry. */ 134 do argx = 2 to num_args while (ecode = 0); /* Process the control arguments. */ 135 call PROCESS_OPTION; /* Process one option pair. */ 136 end; 137 138 return; 139 /* */ 140 PROCESS_OPTION: procedure; 141 142 /* This procedure is called to process one option pair. 143* * Each pair consists of a control argument and a value argument. 144**/ 145 /* Get option argument. */ 146 call cu_$arg_ptr (argx, arg_ptr, arg_len, ecode); 147 if ecode ^= 0 148 then do; 149 call com_err_ (ecode, "Speedtype", "Error getting argument ^d", argx); 150 return; 151 end; 152 153 option = argument; /* Save option argument. */ 154 155 argx = argx + 1; /* Get index of value argument. */ 156 if argx > num_args /* Is there another argument? */ 157 then do; /* No, missing value argument. */ 158 ecode = error_table_$odd_no_of_args; 159 call com_err_ (ecode, "Speedtype", "^a requires a value argument", option); 160 return; 161 end; 162 163 /* Get value argument. */ 164 call cu_$arg_ptr (argx, arg_ptr, arg_len, ecode); 165 if ecode ^= 0 166 then do; 167 call com_err_ (ecode, "Speedtype", "Error getting argument ^d", argx); 168 return; 169 end; 170 171 do optx = 1 to hbound (options, 1); /* Look for option argument. */ 172 if option = options (optx) /* Did we find it? */ 173 then goto OPTION (optx); /* Yes, go process this option. */ 174 end; 175 176 ecode = error_table_$badopt; /* Option not found. */ 177 call com_err_ (ecode, "Speedtype", "Argument ^a unknown", option); 178 return; 179 180 OPTION (1): OPTION (2): OPTION (3): /* SUFFIX change option. */ 181 OPTION (4): OPTION (5): 182 suffix_len = arg_len; /* Get length of suffix expansion string. */ 183 if argument = "on" /* ON => use default action. */ 184 then suffix_len = 0; 185 if argument = "off" /* OFF => disable suffix. */ 186 then suffix_len = -1; 187 call speedtype_suffix_ (sb_ptr, exp_ptr, spc_ptr, optx, arg_ptr, suffix_len); 188 if (exp.actionx (optx) = 0) & /* Test if desired suffix not actually set. */ 189 (suffix_len >0) 190 then call com_err_ (0, "Speedtype", "^a suffix ""^a"" invalid, ^a turned off", 191 options (optx), argument, options (optx)); 192 return; 193 194 OPTION (6): /* "-suffix "yes","on" | "no","off"" */ 195 suffix_len = 1; /* Error if it remains = 1. */ 196 if argument = "on" /* ON => set all defaults. */ 197 then suffix_len = 0; 198 if argument = "off" /* OFF => disable all suffixes. */ 199 then suffix_len = -1; 200 if suffix_len = 1 /* Was it "on" or "off"? */ 201 then do; /* No, error. */ 202 ecode = error_table_$bad_arg; 203 call com_err_ (ecode, "Speedtype", "-suffix argument must be ""on"", or ""off"""); 204 return; 205 end; 206 do i = 1 to hbound (exp.actionx, 1); /* Set each suffix. */ 207 call speedtype_suffix_ (sb_ptr, exp_ptr, spc_ptr, i, arg_ptr, suffix_len); 208 end; 209 return; 210 211 OPTION (7): /* "-exp" */ 212 /* Is expansion argument a valid length? */ 213 if length (argument) > length (exp.expansion) 214 then do; /* No, expansion argument is too long. */ 215 ecode = error_table_$bad_arg; 216 call com_err_ (ecode, "Speedtype", "-exp value argument is too long"); 217 return; 218 end; 219 exp.expansion = argument; 220 exp.len = length (argument); 221 return; 222 223 end PROCESS_OPTION; 224 225 end change_symbols; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 02/04/82 1254.0 change_symbols.pl1 >spec>on>02/04/82>change_symbols.pl1 91 1 11/14/80 1152.8 speedtype_symbols.incl.pl1 >ldd>include_1>speedtype_symbols.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. actionx based fixed bin(8,0) array level 2 packed unaligned dcl 1-52 ref 188 206 addr builtin function dcl 75 ref 131 132 133 arg_len 000100 automatic fixed bin(17,0) dcl 46 set ref 105* 123 123 127 127 146* 153 164* 180 183 185 188 188 196 198 211 219 220 arg_ptr 000102 automatic pointer dcl 47 set ref 105* 123 127 146* 153 164* 183 185 187* 188 196 198 207* 211 219 220 argument based char unaligned dcl 63 set ref 123* 127* 153 183 185 188* 196 198 211 219 220 argx 000104 automatic fixed bin(17,0) dcl 48 set ref 134* 146* 149* 155* 155 156 164* 167* com_err_ 000040 constant entry external dcl 83 ref 99 108 118 127 149 159 167 177 188 203 216 cu_$arg_count 000042 constant entry external dcl 84 ref 96 cu_$arg_ptr 000044 constant entry external dcl 85 ref 105 146 164 dir_name 000105 automatic char(168) unaligned dcl 49 set ref 117* 118* ecode 000157 automatic fixed bin(35,0) dcl 50 set ref 105* 106 108* 112* 113 115 118* 123* 124 134 146* 147 149* 158* 159* 164* 165 167* 176* 177* 202* 203* 215* 216* ent_name 000160 automatic char(32) unaligned dcl 51 set ref 117* 118* error_table_$bad_arg 000026 external static fixed bin(35,0) dcl 77 ref 202 215 error_table_$badopt 000030 external static fixed bin(35,0) dcl 78 ref 176 error_table_$no_w_permission 000032 external static fixed bin(35,0) dcl 79 ref 115 error_table_$odd_no_of_args 000034 external static fixed bin(35,0) dcl 80 ref 158 error_table_$wrong_no_of_args 000036 external static fixed bin(35,0) dcl 81 set ref 99* exp based structure level 1 dcl 1-52 exp_ptr 000202 automatic pointer dcl 1-18 set ref 132* 187* 188 206 207* 211 219 220 exp_tab based structure array level 2 dcl 1-26 set ref 132 expansion 2 based char(56) level 2 packed unaligned dcl 1-52 set ref 211 219* hbound builtin function dcl 75 ref 171 206 i 000170 automatic fixed bin(17,0) dcl 52 set ref 206* 207* len 1(27) based fixed bin(8,0) level 2 packed unaligned dcl 1-52 set ref 220* length builtin function dcl 75 ref 211 211 220 num_args 000173 automatic fixed bin(17,0) dcl 55 set ref 96* 97 134 156 option 000174 automatic char(8) unaligned dcl 56 set ref 153* 159* 172 177* options 000010 internal static char(8) initial array unaligned dcl 68 set ref 171 172 188* 188* optx 000176 automatic fixed bin(17,0) dcl 57 set ref 171* 172 172* 187* 188 188 188 sb based structure level 1 dcl 1-48 sb_ptr 000204 automatic pointer dcl 1-19 set ref 131* 187* 207* sb_tab based structure array level 2 dcl 1-26 set ref 131 sbx 000171 automatic fixed bin(17,0) dcl 53 set ref 123* 125 131 132 133 spc based structure level 1 dcl 1-57 spc_ptr 000206 automatic pointer dcl 1-20 set ref 133* 187* 207* spec_tab 40 based structure array level 2 dcl 1-26 set ref 133 speedtype_index_ 000046 constant entry external dcl 86 ref 123 speedtype_info_$name 000050 constant entry external dcl 87 ref 117 speedtype_info_$pointer 000052 constant entry external dcl 88 ref 112 speedtype_suffix_ 000054 constant entry external dcl 89 ref 187 207 ssd based structure level 1 dcl 1-26 ssd_ptr 000200 automatic pointer dcl 1-17 set ref 112* 123* 131 131 131 132 132 133 suffix_len 000177 automatic fixed bin(17,0) dcl 58 set ref 180* 183* 185* 187* 188 194* 196* 198* 200 207* table_size 21 based fixed bin(17,0) level 2 dcl 1-26 ref 131 131 132 temp_code 000172 automatic fixed bin(35,0) dcl 54 set ref 117* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. delim_chars based structure level 1 dcl 1-41 delim_ptr automatic pointer dcl 1-21 ssd_version_2 internal static fixed bin(17,0) initial dcl 1-23 NAMES DECLARED BY EXPLICIT CONTEXT. OPTION 000000 constant label array(7) dcl 180 ref 172 PROCESS_OPTION 000553 constant entry internal dcl 140 ref 135 change_symbols 000165 constant entry external dcl 18 csb 000156 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 1524 1602 1347 1534 Length 2022 1347 56 203 155 16 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME csb 260 external procedure is an external procedure. PROCESS_OPTION internal procedure shares stack frame of external procedure csb. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 options csb STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME csb 000100 arg_len csb 000102 arg_ptr csb 000104 argx csb 000105 dir_name csb 000157 ecode csb 000160 ent_name csb 000170 i csb 000171 sbx csb 000172 temp_code csb 000173 num_args csb 000174 option csb 000176 optx csb 000177 suffix_len csb 000200 ssd_ptr csb 000202 exp_ptr csb 000204 sb_ptr csb 000206 spc_ptr csb THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr speedtype_index_ speedtype_info_$name speedtype_info_$pointer speedtype_suffix_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$badopt error_table_$no_w_permission error_table_$odd_no_of_args error_table_$wrong_no_of_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000155 96 000172 97 000200 99 000203 101 000234 105 000235 106 000254 108 000256 109 000307 112 000310 113 000321 115 000323 117 000326 118 000346 120 000407 123 000410 124 000440 125 000442 127 000444 128 000506 131 000507 132 000525 133 000532 134 000536 135 000547 136 000550 138 000552 140 000553 146 000554 147 000571 149 000573 150 000630 153 000631 155 000636 156 000637 158 000642 159 000645 160 000701 164 000702 165 000717 167 000721 168 000756 171 000757 172 000764 174 000776 176 001000 177 001003 178 001042 180 001043 183 001045 185 001054 187 001063 188 001103 192 001171 194 001172 196 001174 198 001203 200 001212 202 001215 203 001217 204 001247 206 001250 207 001255 208 001276 209 001300 211 001301 215 001304 216 001306 217 001336 219 001337 220 001344 221 001345 ----------------------------------------------------------- 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