COMPILATION LISTING OF SEGMENT option_symbols Compiled by: Multics PL/I Compiler, Release 26a, of September 3, 1980 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 01/06/81 1248.0 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems * 5* * Inc., 1980. * 6* * * 7* * * 8* ****************************************************** */ 9 10 option_symbols: osb: procedure; 11 12 /* This procedure implements the option_symbols command. 13* * Created on 05/20/76 by Bill Silver as option_notescript. 14* * Changed on 06/08/77 by Bill Silver to option_symbols. 15* * Changed on 10/28/80 by Paul Benjamin for special suffixing. 16* * 17* * The option_symbols command will set the special characters 18* * contained in the current Speedtype symbol dictionary. 19* * its calling sequence is: 20* * 21* * option_symbols, osb {-control_args} 22* * 23* * where: 24* * 25* * -plural A Set specified SUFFIX character. 26* * -ed A 27* * -ing A 28* * -er A 29* * -ly A 30* * 31* * -pad A Set specified ESCAPE character. 32* * -perm A 33* * -temp A 34* * -trans A 35* * -space A 36* 37* * -under A Set specified PREFIX character. 38* * -upper A 39* * 40* * -delim AA /* Specify other delimiters. 41**/ 42 43 /* AUTOMATIC DATA */ 44 45 dcl arg_len fixed bin; /* Length of a command argument. */ 46 dcl arg_ptr ptr; /* Pointer to a command argument. */ 47 dcl argx fixed bin; /* Index of current command argument. */ 48 dcl dir_name char (168); /* Directory of symbol dictionary. */ 49 dcl ecode fixed bin (35); /* Error table code. */ 50 dcl ent_name char (32); /* Name of symbol dictionary. */ 51 dcl num_args fixed bin; /* Number of command arguments. */ 52 dcl option char (8); /* Option control argument. */ 53 dcl optx fixed bin; /* Option index. */ 54 dcl temp_code fixed bin (35); /* Used when already have non-zero ecode. */ 55 56 /* BASED DATA */ 57 58 dcl argument char (arg_len) based (arg_ptr); /* Command argument. */ 59 60 61 /* INTERNAL STATIC DATA */ 62 63 dcl options (13) char (8) /* Control argument options. */ 64 internal static init ("-plural", "-ed", "-ing", "-er", "-ly", 65 "-pad", "-perm", "-temp", "-trans", "-space", 66 "-under", "-upper", "-delim"); 67 68 69 /* EXTERNAL ENTRIES CALLED */ 70 71 dcl (addr, hbound, length, substr) builtin; 72 73 dcl error_table_$bad_arg fixed bin (35) external; 74 dcl error_table_$badopt fixed bin (35) external; 75 dcl error_table_$no_w_permission fixed bin(35) ext static; 76 dcl error_table_$odd_no_of_args fixed bin (35) external; 77 dcl error_table_$wrong_no_of_args fixed bin (35) external; 78 79 dcl com_err_ entry options (variable); 80 dcl cu_$arg_count entry (fixed bin); 81 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 82 dcl speedtype_info_$name entry (char (*), char (*), fixed bin (35)); 83 dcl speedtype_info_$pointer entry (ptr, fixed bin (35)); 84 /* */ 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 */ 85 86 /* */ 87 call speedtype_info_$pointer (ssd_ptr, ecode); 88 if ecode ^= 0 /* Did we get a pointer to the symbol dictionary? */ 89 then do; /* No. */ 90 if ecode = error_table_$no_w_permission 91 then do; 92 call speedtype_info_$name (dir_name, ent_name, temp_code); 93 call com_err_ (ecode, "Speedtype", "Attempting to convert ^a>^a to new version.", dir_name, ent_name); 94 end; 95 return; 96 end; 97 98 call cu_$arg_count (num_args); /* Get number of arguments. */ 99 if num_args = 0 /* Is there at least one argument? */ 100 then do; /* No, error. */ 101 call com_err_ (error_table_$wrong_no_of_args, "Speedtype", "No arguments"); 102 return; 103 end; 104 105 ecode = 0; /* Initialize error code. */ 106 107 do argx = 1 to num_args while (ecode = 0); /* Process all of the control arguments. */ 108 call PROCESS_OPTION; 109 end; 110 111 return; 112 /* */ 113 PROCESS_OPTION: procedure; 114 115 /* This procedure is called to process the control arguments to 116* * this command. These control arguments all come in pairs with a 117* * control argument followed by a value argument. 118**/ 119 /* Get the control argument. */ 120 call cu_$arg_ptr (argx, arg_ptr, arg_len, ecode); 121 if ecode ^= 0 122 then do; 123 call com_err_ (ecode, "Speedtype", "Error getting argument ^d", argx); 124 return; 125 end; 126 127 option = argument; /* Save control argument. */ 128 129 argx = argx + 1; /* Next argument is value argument. */ 130 if argx > num_args /* Is there a next argument? */ 131 then do; /* No, value argument is missing. */ 132 ecode = error_table_$odd_no_of_args; 133 call com_err_ (ecode, "Speedtype", "^a requires a value argument", option); 134 return; 135 end; 136 /* Get value argument. */ 137 call cu_$arg_ptr (argx, arg_ptr, arg_len, ecode); 138 if ecode ^= 0 139 then do; 140 call com_err_ (ecode, "Speedtype", "Error getting argument ^d", argx); 141 return; 142 end; 143 144 do optx = 1 to hbound (options, 1); /* Look up option. */ 145 if option = options (optx) /* Is this a known option? */ 146 then goto OPTION (optx); /* Yes, go process this option. */ 147 end; 148 149 ecode = error_table_$badopt; /* Option not known. */ 150 call com_err_ (ecode, "Speedtype", "Control argument ^a unknown", option); 151 return; 152 153 OPTION (1): OPTION (2): OPTION (3): /* Defining a SUFFIX character. */ 154 OPTION (4): OPTION (5): 155 call CHECK_CHARACTER; /* Is this a valid suffix character? */ 156 if ecode ^= 0 then return; /* No. */ 157 substr (ssd.suffixes, optx, 1) = argument; /* Yes, set this suffix character. */ 158 return; 159 160 OPTION (6): OPTION (7): OPTION (8): /* Defining an ESCAPE character. */ 161 OPTION (9): OPTION (10): 162 call CHECK_CHARACTER; /* Is this a valid escape character? */ 163 if ecode ^= 0 then return; /* No. */ 164 optx = optx - 5; /* Turn option index into an escape index. */ 165 substr (ssd.escapes, optx, 1) = argument; /* Set escape character. */ 166 delim_ptr = addr (ssd.delimiters); /* Update delimiter escapes too. */ 167 delim_chars.escapes = ssd.escapes; 168 return; /* Escape character has been set. */ 169 170 OPTION (11): OPTION (12): /* Defining a PREFIX character. */ 171 call CHECK_CHARACTER; /* Is this a valid prefix character? */ 172 if ecode ^= 0 then return; /* No. */ 173 optx = optx - 10; /* Turn option index into a prefix index. */ 174 substr (ssd.prefixes, optx, 1) = argument; /* Set prefixes character. */ 175 return; 176 177 OPTION (13): /* Set DELIMITERS. */ 178 if arg_len > length (delim_chars.others) /* Is new delimiter string too long? */ 179 then do; /* Yes, too long. */ 180 ecode = error_table_$bad_arg; 181 call com_err_ (ecode, "Speedtype", "Delimiter string ""^a"" is too long", argument); 182 return; 183 end; 184 delim_ptr = addr (ssd.delimiters); /* Set up to reference delimiters. */ 185 delim_chars.others = argument; /* Set delimiter characters. */ 186 return; 187 188 end PROCESS_OPTION; 189 190 191 192 193 194 CHECK_CHARACTER: procedure; 195 196 /* This procedure checks to see that the new suffix, escape, or prefix character 197* * is valid. 198**/ 199 if arg_len > 1 /* Must be only one character. */ 200 then do; 201 ecode = error_table_$bad_arg; 202 call com_err_ (ecode, "Speedtype", "^a argument ""^a"" is too long", option, argument); 203 return; 204 end; 205 206 end CHECK_CHARACTER; 207 208 end option_symbols; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/06/81 1247.6 option_symbols.pl1 >spec>on>speed>option_symbols.pl1 85 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. addr builtin function dcl 71 ref 166 184 arg_len 000100 automatic fixed bin(17,0) dcl 45 set ref 120* 127 137* 157 165 174 177 181 181 185 199 202 202 arg_ptr 000102 automatic pointer dcl 46 set ref 120* 127 137* 157 165 174 181 185 202 argument based char unaligned dcl 58 set ref 127 157 165 174 181* 185 202* argx 000104 automatic fixed bin(17,0) dcl 47 set ref 107* 120* 123* 129* 129 130 137* 140* com_err_ 000022 constant entry external dcl 79 ref 93 101 123 133 140 150 181 202 cu_$arg_count 000024 constant entry external dcl 80 ref 98 cu_$arg_ptr 000026 constant entry external dcl 81 ref 120 137 delim_chars based structure level 1 dcl 1-41 delim_ptr 000200 automatic pointer dcl 1-21 set ref 166* 167 177 184* 185 delimiters 5 based char(24) level 2 dcl 1-26 set ref 166 184 dir_name 000105 automatic char(168) unaligned dcl 48 set ref 92* 93* ecode 000157 automatic fixed bin(35,0) dcl 49 set ref 87* 88 90 93* 105* 107 120* 121 123* 132* 133* 137* 138 140* 149* 150* 156 163 172 180* 181* 201* 202* ent_name 000160 automatic char(32) unaligned dcl 50 set ref 92* 93* error_table_$bad_arg 000010 external static fixed bin(35,0) dcl 73 ref 180 201 error_table_$badopt 000012 external static fixed bin(35,0) dcl 74 ref 149 error_table_$no_w_permission 000014 external static fixed bin(35,0) dcl 75 ref 90 error_table_$odd_no_of_args 000016 external static fixed bin(35,0) dcl 76 ref 132 error_table_$wrong_no_of_args 000020 external static fixed bin(35,0) dcl 77 set ref 101* escapes 0(27) based char(5) level 2 in structure "delim_chars" packed unaligned dcl 1-41 in procedure "osb" set ref 167* escapes 13 based char(5) level 2 in structure "ssd" dcl 1-26 in procedure "osb" set ref 165* 167 exp based structure level 1 dcl 1-52 hbound builtin function dcl 71 ref 144 length builtin function dcl 71 ref 177 num_args 000170 automatic fixed bin(17,0) dcl 51 set ref 98* 99 107 130 option 000172 automatic char(8) unaligned dcl 52 set ref 127* 133* 145 150* 202* options 000015 constant char(8) initial array unaligned dcl 63 ref 144 145 optx 000174 automatic fixed bin(17,0) dcl 53 set ref 144* 145 145* 157 164* 164 165 173* 173 174 others 2 based char(16) level 2 packed unaligned dcl 1-41 set ref 177 185* prefixes 15 based char(2) level 2 dcl 1-26 set ref 174* sb based structure level 1 dcl 1-48 spc based structure level 1 dcl 1-57 speedtype_info_$name 000030 constant entry external dcl 82 ref 92 speedtype_info_$pointer 000032 constant entry external dcl 83 ref 87 ssd based structure level 1 dcl 1-26 ssd_ptr 000176 automatic pointer dcl 1-17 set ref 87* 157 165 166 167 174 184 substr builtin function dcl 71 set ref 157* 165* 174* suffixes 16 based char(5) level 2 dcl 1-26 set ref 157* temp_code 000175 automatic fixed bin(35,0) dcl 54 set ref 92* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. exp_ptr automatic pointer dcl 1-18 sb_ptr automatic pointer dcl 1-19 spc_ptr automatic pointer dcl 1-20 ssd_version_2 internal static fixed bin(17,0) initial dcl 1-23 NAMES DECLARED BY EXPLICIT CONTEXT. CHECK_CHARACTER 000770 constant entry internal dcl 194 ref 153 160 170 OPTION 000000 constant label array(13) dcl 153 ref 145 PROCESS_OPTION 000347 constant entry internal dcl 113 ref 108 option_symbols 000162 constant entry external dcl 10 osb 000153 constant entry external dcl 10 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1202 1236 1044 1212 Length 1444 1044 34 171 135 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME osb 258 external procedure is an external procedure. PROCESS_OPTION internal procedure shares stack frame of external procedure osb. CHECK_CHARACTER internal procedure shares stack frame of external procedure osb. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME osb 000100 arg_len osb 000102 arg_ptr osb 000104 argx osb 000105 dir_name osb 000157 ecode osb 000160 ent_name osb 000170 num_args osb 000172 option osb 000174 optx osb 000175 temp_code osb 000176 ssd_ptr osb 000200 delim_ptr osb 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_info_$name speedtype_info_$pointer 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 10 000152 87 000167 88 000177 90 000201 92 000204 93 000224 95 000265 98 000266 99 000275 101 000277 102 000331 105 000332 107 000333 108 000343 109 000344 111 000346 113 000347 120 000350 121 000365 123 000367 124 000424 127 000425 129 000432 130 000433 132 000436 133 000441 134 000475 137 000476 138 000513 140 000515 141 000552 144 000553 145 000560 147 000571 149 000573 150 000576 151 000632 153 000633 156 000634 157 000637 158 000646 160 000647 163 000650 164 000653 165 000655 166 000664 167 000666 168 000673 170 000674 172 000675 173 000700 174 000702 175 000711 177 000712 180 000715 181 000720 182 000757 184 000760 185 000763 186 000767 194 000770 199 000771 201 000774 202 000777 203 001042 206 001043 ----------------------------------------------------------- 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