COMPILATION LISTING OF SEGMENT speedtype_suffix_ Compiled by: Multics PL/I Compiler, Release 26a, of September 3, 1980 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 01/06/81 1250.4 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems * 5* * Inc., 1980. * 6* * * 7* * * 8* ****************************************************** */ 9 10 speedtype_suffix_: procedure (arg_sb_ptr, arg_exp_ptr, arg_spc_ptr, arg_suffixx, arg_match_ptr, arg_match_len); 11 12 /* This procedure is an internal interface of the Speedtype subsystem. 13* * Created on 01/01/76 by Bill Silver as notescript_suffix_. 14* * Changed on 06/13/77 by Bill Silver to speedtype_suffix_. 15* * Changed on 06/04/80 by Paul Benjamin for special suffixing. 16* * 17* * It is called to set a suffix action index for a defined symbol. 18* * The action index set depends upon the suffix and the expansion string 19* * for this symbol. All possible action indexes will be tried until one is 20* * found that matches the specified string. If no action index results 21* * in a match then this suffix for this symbol is disabled. If the 22* * length of the match string is "0" or "-1", then the following special 23* * processing is performed: 24* * 0 => default action index 25* * -1 => disable this suffix. 26**/ 27 28 /* ARGUMENTS */ 29 30 dcl arg_exp_ptr ptr; /* (I) Pointer to expansion entry. */ 31 dcl arg_match_len fixed bin; /* (I) Length of expansion ( 0=>default, -1=>disable). */ 32 dcl arg_match_ptr ptr; /* (I) Pointer to expansion we have to match. */ 33 dcl arg_sb_ptr ptr; /* (I) Pointer to symbol entry. */ 34 dcl arg_spc_ptr ptr; /* (I) Pointer to special entry. */ 35 dcl arg_suffixx fixed bin; /* (I) Number of specified suffix. */ 36 37 38 /* AUTOMATIC DATA */ 39 40 dcl sb_buf char (8); /* Used to expand symbol with suffix. */ 41 dcl exp_buf char (56); /* Holds expansion. */ 42 43 /* Note above that 56 is really length(exp.expansion). */ 44 45 dcl ecode fixed bin (35); /* Error table code. */ 46 dcl exp_buf_len fixed bin; /* Length of expansion buffer. */ 47 dcl exp_buf_ptr ptr; /* Pointer to expansion buffer. */ 48 dcl exp_len fixed bin; /* Length of expansion argument. */ 49 dcl i fixed bin; 50 dcl match_len fixed bin; /* Length of expansion we have to match. */ 51 dcl match_ptr ptr; /* Pointer to expansion we have to match. */ 52 dcl sb_buf_ptr ptr; /* Pointer to symbol buffer. */ 53 dcl sb_len fixed bin; /* Length of symbol with suffix. */ 54 dcl suffixx fixed bin; /* Number of specified suffix. */ 55 dcl word_type fixed bin; /* Word type of expansion. */ 56 57 58 /* BASED DATA */ 59 60 dcl expansion char (exp_len) based (exp_buf_ptr); 61 62 dcl match_expansion char (match_len) based (match_ptr); 63 64 65 /* INTERNAL STATIC DATA */ 66 67 dcl num_actions fixed bin /* Current number of known suffix actions. */ 68 internal static init (6); 69 70 dcl default_actionx (0:6, 5) fixed bin /* (word_type, suffix) default action indexes. */ 71 internal static init (1, 1, 1, 1, 1, /* other */ 72 1, 2, 2, 2, 2, /* "Ce" */ 73 1, 2, 1, 2, 1, /* "Ve" */ 74 5, 4, 1, 4, 1, /* "Cy" */ 75 1, 1, 1, 1, 1, /* "Vy" */ 76 6, 1, 1, 1, 1, /* "ch", "sh", or "ex" */ 77 1, 3, 3, 3, 1); /* "CVC" */ 78 79 dcl vowels char (5) 80 internal static init ("eaiou"); 81 82 83 /* EXTERNAL ENTRIES CALLED */ 84 85 dcl (addr, index, length, ptr, substr) builtin; 86 87 dcl speedtype_expand_ entry (ptr, fixed bin, ptr, fixed bin, fixed bin, fixed bin (35)); 88 /* */ 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 */ 89 90 /* */ 91 sb_ptr = arg_sb_ptr; /* Copy arguments. */ 92 exp_ptr = arg_exp_ptr; 93 spc_ptr = arg_spc_ptr; 94 suffixx = arg_suffixx; 95 match_ptr = arg_match_ptr; /* Set reference to expansion to match. */ 96 match_len = arg_match_len; 97 98 if match_len = -1 /* -1 => disable this suffix. */ 99 then do; /* That is what we have to do. */ 100 exp.actionx (suffixx) = 0; 101 return; 102 end; 103 104 if match_len = 0 /* 0 => set default action index. */ 105 then do; 106 word_type = GET_WORD_TYPE (); /* Get word type of expansion. */ 107 exp.actionx (suffixx) = default_actionx (word_type, suffixx); 108 return; 109 end; 110 111 /* We must find an action index that will expand this symbol the 112* * way the caller wants. First test expansion to see if it is valid. 113* * Then built the symbol with the specified suffix. 114**/ 115 ssd_ptr = ptr (sb_ptr, 0); /* Get pointer to base of symbol dictionary. */ 116 if match_len > length (exp.expansion) /* Is expansion too long? */ 117 then do; /* Yes, disable this suffix. */ 118 exp.actionx (suffixx) = 0; 119 return; 120 end; 121 122 sb_buf = sb.symbol; /* Copy symbol into our buffer. */ 123 sb_len = index (sb_buf, " "); /* Get the length of the symbol. */ 124 if sb_len = 0 then sb_len = length (sb_buf); 125 sb_buf_ptr = addr (sb_buf); /* Set up buffer pointers and lengths for expanding. */ 126 exp_buf_ptr = addr (exp_buf); 127 exp_buf_len = length (exp_buf); 128 129 /* Add suffix to symbol. */ 130 substr (sb_buf, sb_len, 1) = substr (ssd.suffixes, suffixx, 1); 131 132 do i = 1 to num_actions; /* Try all known action indexes. */ 133 exp.actionx (suffixx) = i; /* Try this action index. */ 134 call speedtype_expand_ (sb_buf_ptr, sb_len, exp_buf_ptr, exp_buf_len, exp_len, ecode); 135 if expansion = match_expansion /* Does expansion match? */ 136 then return; /* Yes, action index set correctly. */ 137 end; 138 139 exp.actionx(suffixx) = 7; /* User has specified special suffixing. */ 140 spc.special(suffixx) = match_expansion; 141 142 return; 143 /* */ 144 GET_WORD_TYPE: procedure returns (fixed bin); 145 146 /* This function will return an index that represents the word type of 147* * the expansion. Speedtype currently recognizes the following word 148* * types: 149* * 0 - other => none of the below 150* * 1 - ends in "e" preceeded by a consonant 151* * 2 - ends in "e" preceeded by a vowel 152* * 3 - ends in "y" preceeded by a consonant 153* * 4 - ends in "y" preceeded by a vowel 154* * 5 - ends in "ch" or "sh" or "ex" 155* * 6 - ends with a consonant || vowel || consonant 156**/ 157 exp_buf_ptr = addr (exp.expansion); /* Work on expansion entry itself. */ 158 exp_len = exp.len; 159 160 if exp_len < 3 then return (0); /* Default for short expansions. */ 161 162 if substr (expansion, exp_len, 1) = "e" 163 then do; /* Expansion ends with "e". */ 164 if index (vowels, substr (expansion, (exp_len - 1), 1)) = 0 165 then return (1); /* Preeceded by a consonant. */ 166 else return (2); /* Preceeded by a vowel. */ 167 end; 168 169 if substr (expansion, exp_len, 1) = "y" 170 then do; /* Expansion ends with "y". */ 171 if index (vowels, substr (expansion, (exp_len - 1), 1)) = 0 172 then return (3); /* Preceded by a consonant. */ 173 else return (4); /* Preceded by a vowel. */ 174 end; 175 176 if (substr (expansion, (exp_len - 1), 2) = "ch") | 177 (substr (expansion, (exp_len - 1), 2) = "sh") | 178 (substr (expansion, (exp_len - 1), 2) = "ex") 179 then return (5); 180 181 if (index (vowels, substr (expansion, exp_len, 1)) = 0) & 182 (index (vowels, substr (expansion, (exp_len - 1), 1)) ^= 0) & 183 (index (vowels, substr (expansion, (exp_len - 2), 1)) = 0) 184 then return (6); /* Consonant || vowel || consonant */ 185 186 return (0); /* None of the above. */ 187 188 end GET_WORD_TYPE; 189 190 end speedtype_suffix_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/06/81 1247.7 speedtype_suffix_.pl1 >spec>on>speed>speedtype_suffix_.pl1 89 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 set ref 100* 107* 118* 133* 139* addr builtin function dcl 85 ref 125 126 157 arg_exp_ptr parameter pointer dcl 30 ref 10 92 arg_match_len parameter fixed bin(17,0) dcl 31 ref 10 96 arg_match_ptr parameter pointer dcl 32 ref 10 95 arg_sb_ptr parameter pointer dcl 33 ref 10 91 arg_spc_ptr parameter pointer dcl 34 ref 10 93 arg_suffixx parameter fixed bin(17,0) dcl 35 ref 10 94 default_actionx 000002 constant fixed bin(17,0) initial array dcl 70 ref 107 ecode 000120 automatic fixed bin(35,0) dcl 45 set ref 134* exp based structure level 1 dcl 1-52 exp_buf 000102 automatic char(56) unaligned dcl 41 set ref 126 127 exp_buf_len 000121 automatic fixed bin(17,0) dcl 46 set ref 127* 134* exp_buf_ptr 000122 automatic pointer dcl 47 set ref 126* 134* 135 157* 162 164 169 171 176 176 176 181 181 181 exp_len 000124 automatic fixed bin(17,0) dcl 48 set ref 134* 135 158* 160 162 162 164 164 169 169 171 171 176 176 176 176 176 176 181 181 181 181 181 181 exp_ptr 000142 automatic pointer dcl 1-18 set ref 92* 100 107 116 118 133 139 157 158 expansion 2 based char(56) level 2 in structure "exp" packed unaligned dcl 1-52 in procedure "speedtype_suffix_" set ref 116 157 expansion based char unaligned dcl 60 in procedure "speedtype_suffix_" ref 135 162 164 169 171 176 176 176 181 181 181 i 000125 automatic fixed bin(17,0) dcl 49 set ref 132* 133* index builtin function dcl 85 ref 123 164 171 181 181 181 len 1(27) based fixed bin(8,0) level 2 packed unaligned dcl 1-52 ref 158 length builtin function dcl 85 ref 116 124 127 match_expansion based char unaligned dcl 62 ref 135 140 match_len 000126 automatic fixed bin(17,0) dcl 50 set ref 96* 98 104 116 135 140 match_ptr 000130 automatic pointer dcl 51 set ref 95* 135 140 num_actions constant fixed bin(17,0) initial dcl 67 ref 132 ptr builtin function dcl 85 ref 115 sb based structure level 1 dcl 1-48 sb_buf 000100 automatic char(8) unaligned dcl 40 set ref 122* 123 124 125 130* sb_buf_ptr 000132 automatic pointer dcl 52 set ref 125* 134* sb_len 000134 automatic fixed bin(17,0) dcl 53 set ref 123* 124 124* 130 134* sb_ptr 000144 automatic pointer dcl 1-19 set ref 91* 115 122 spc based structure level 1 dcl 1-57 spc_ptr 000146 automatic pointer dcl 1-20 set ref 93* 140 special based char(56) array level 2 packed unaligned dcl 1-57 set ref 140* speedtype_expand_ 000010 constant entry external dcl 87 ref 134 ssd based structure level 1 dcl 1-26 ssd_ptr 000140 automatic pointer dcl 1-17 set ref 115* 130 substr builtin function dcl 85 set ref 130* 130 162 164 169 171 176 176 176 181 181 181 suffixes 16 based char(5) level 2 dcl 1-26 ref 130 suffixx 000135 automatic fixed bin(17,0) dcl 54 set ref 94* 100 107 107 118 130 133 139 140 symbol 0(09) based char(7) level 2 packed unaligned dcl 1-48 ref 122 vowels 000000 constant char(5) initial unaligned dcl 79 ref 164 171 181 181 181 word_type 000136 automatic fixed bin(17,0) dcl 55 set ref 106* 107 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. GET_WORD_TYPE 000301 constant entry internal dcl 144 ref 106 speedtype_suffix_ 000055 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 510 522 451 520 Length 706 451 12 147 36 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME speedtype_suffix_ 130 external procedure is an external procedure. GET_WORD_TYPE internal procedure shares stack frame of external procedure speedtype_suffix_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME speedtype_suffix_ 000100 sb_buf speedtype_suffix_ 000102 exp_buf speedtype_suffix_ 000120 ecode speedtype_suffix_ 000121 exp_buf_len speedtype_suffix_ 000122 exp_buf_ptr speedtype_suffix_ 000124 exp_len speedtype_suffix_ 000125 i speedtype_suffix_ 000126 match_len speedtype_suffix_ 000130 match_ptr speedtype_suffix_ 000132 sb_buf_ptr speedtype_suffix_ 000134 sb_len speedtype_suffix_ 000135 suffixx speedtype_suffix_ 000136 word_type speedtype_suffix_ 000140 ssd_ptr speedtype_suffix_ 000142 exp_ptr speedtype_suffix_ 000144 sb_ptr speedtype_suffix_ 000146 spc_ptr speedtype_suffix_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. speedtype_expand_ NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 000047 91 000062 92 000066 93 000071 94 000074 95 000076 96 000101 98 000103 100 000105 101 000112 104 000113 106 000115 107 000117 108 000134 115 000135 116 000137 118 000141 119 000146 122 000147 123 000155 124 000166 125 000171 126 000173 127 000175 130 000177 132 000205 133 000214 134 000226 135 000247 137 000257 139 000261 140 000267 142 000300 144 000301 157 000303 158 000306 160 000312 162 000316 164 000324 166 000340 169 000343 171 000345 173 000361 176 000364 181 000401 186 000440 ----------------------------------------------------------- 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