COMPILATION LISTING OF SEGMENT speedtype_retain_ Compiled by: Multics PL/I Compiler, Release 26a, of September 3, 1980 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 01/06/81 1249.0 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems * 5* * Inc., 1980. * 6* * * 7* * * 8* ****************************************************** */ 9 10 speedtype_retain_: procedure (arg_perm_flag, arg_in_ptr, arg_in_len, arg_out_ptr, arg_out_len, arg_out_used, arg_ecode); 11 12 /* This procedure is an internal interface of the Speedtype subsystem. 13* * Created on 02/20/76 by Bill Silver as notescript_escape_. 14* * Changed on 06/13/77 by Bill Silver to speedtype_retain_. 15**/ 16 17 /* ARGUMENTS */ 18 19 dcl arg_ecode fixed bin (35); /* (O) error_table code. */ 20 dcl arg_in_len fixed bin (21); /* (I) Length of input string in characters. */ 21 dcl arg_in_ptr ptr; /* (I) Pointer to input string. */ 22 dcl arg_out_len fixed bin (21); /* (I) Length of output buffer in characters. */ 23 dcl arg_out_ptr ptr; /* (I) Pointer to output buffer. */ 24 dcl arg_out_used fixed bin (21); /* (O) Actual length of output string in characters. */ 25 dcl arg_perm_flag bit (1) aligned; /* (I) ON => Perm (`), OFF => Temp (~). */ 26 27 28 /* AUTOMATIC DATA */ 29 30 dcl dtok_len fixed bin; /* Length of delimiter token string. */ 31 dcl dtok_ptr ptr; /* Pointer to delimiter token. */ 32 dcl ecode fixed bin (35); /* Error table code. */ 33 dcl escape_char char (1); /* Specified escape character to insert. */ 34 dcl texp_len fixed bin (21); /* Length of test expansion string. */ 35 dcl texp_len_max fixed bin (21); /* Length of output string left. */ 36 dcl texp_ptr ptr; /* Where test expansion string will go. */ 37 dcl in_len fixed bin (21); /* Length of unused part of input segment. */ 38 dcl in_ptr ptr; /* Pointer to input segment. */ 39 dcl in_used fixed bin; /* Length of used part of input segment. */ 40 dcl out_len fixed bin (21); /* Length of actual output string. */ 41 dcl out_ptr ptr; /* Pointer to output string. */ 42 dcl out_used fixed bin (21); /* Length of used part of output segment. */ 43 dcl pad_escape char (1); /* Used to hold pad escape character. */ 44 dcl ttok_len fixed bin; /* Length of text token string. */ 45 dcl ttok_ptr ptr; /* Pointer to text token string. */ 46 dcl token_len fixed bin (21); /* Length of one token. */ 47 dcl token_ptr ptr; /* Pointer to a token. */ 48 49 50 /* BASED DATA */ 51 52 dcl 1 input based (in_ptr) aligned, /* Overlay of input segment. */ 53 (2 used char (in_used), /* Part of segment that has been processed. */ 54 2 text char (in_len)) unaligned; /* Part of segment still to be processed. */ 55 56 dcl 1 output based (out_ptr) aligned, /* Overlay of output segment. */ 57 (2 used char (out_used), /* Part of segment that has been processed. */ 58 2 text char (1)) unaligned; /* Beginning of unprocessed part. */ 59 60 /* Overlay of temporary output string. */ 61 dcl test_expansion char (texp_len) based (texp_ptr) aligned; 62 63 dcl token char (token_len) based (token_ptr); /* Overlay of one token string. */ 64 65 66 /* EXTERNAL ENTRIES */ 67 68 dcl (addr, length, search, substr, verify) builtin; 69 70 dcl error_table_$item_too_big fixed bin (35) external; 71 72 dcl speedtype_expand_ entry (ptr, fixed bin (21), ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 73 dcl speedtype_info_$pointer entry (ptr, fixed bin (35)); 74 /* */ 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 */ 75 76 /* */ 77 /* Begin Escaping 78**/ 79 in_ptr = arg_in_ptr; /* Copy arguments and initialize. */ 80 in_len = arg_in_len; 81 out_ptr = arg_out_ptr; 82 out_len = arg_out_len; 83 84 in_used, 85 out_used, 86 ecode = 0; 87 88 /* Get pointer to current symbol dictionary. */ 89 call speedtype_info_$pointer (ssd_ptr, ecode); 90 if ecode ^= 0 then goto RETURN; 91 92 if arg_perm_flag /* Save selected escape character. */ 93 then escape_char = substr (ssd.escapes, 2, 1); /* Perm escape. */ 94 else escape_char = substr (ssd.escapes, 3, 1); /* Temp escape. */ 95 pad_escape = substr (ssd.escapes, 1, 1); /* Save pad escape character. */ 96 97 do while ((in_len > 0) & (ecode = 0)); /* Copy input to output until no more input. */ 98 call COPY_PAIR; /* Copy next delimiter/text token pair. */ 99 end; 100 101 RETURN: 102 arg_out_used = out_used; /* Return number of chars in output segment. */ 103 arg_ecode = ecode; 104 return; 105 /* */ 106 COPY_PAIR: procedure; 107 108 /* This procedure copies the input string into the output string one 109* * delimiter/text token pair at a time. Each pair is expanded to see 110* * if it would be altered by the expansion process. It it would be, 111* * then the specified escape character is inserted between the two tokens. 112* * Otherwise the token pair is copied into the output string as is. 113* * In addition, if the last character of the delimiter token is a PAD 114* * escape character, then it is converted to the specified escape character. 115**/ 116 dtok_ptr = addr (input.text); /* Get pointer to delimiter token. */ 117 dtok_len = verify (input.text, ssd.delimiters); 118 if dtok_len > 0 /* Adjust length of delimiter token. */ 119 then dtok_len = dtok_len - 1; 120 else dtok_len = in_len; 121 in_used = in_used + dtok_len; /* Move input window past delimiter token. */ 122 in_len = in_len - dtok_len; 123 124 if in_len = 0 /* Is there any text token? */ 125 then do; /* No, special case last delimiter token. */ 126 token_ptr = dtok_ptr; /* Move just the delimiter token. */ 127 token_len = dtok_len; 128 call MOVE_OUT; 129 return; 130 end; 131 132 ttok_ptr = addr (input.text); /* Get address of text token. */ 133 ttok_len = search (input.text, ssd.delimiters); 134 if ttok_len > 0 /* Adjust length of text token. */ 135 then ttok_len = ttok_len -1; 136 else ttok_len = in_len; 137 in_used = in_used + ttok_len; /* Move input window past text token. */ 138 in_len = in_len - ttok_len; 139 140 token_ptr = dtok_ptr; /* Define token to be whole pair. */ 141 token_len = dtok_len + ttok_len; 142 143 texp_ptr = addr (output.text); /* Expand directly into our output string. */ 144 texp_len_max = out_len - out_used; /* Use all the space that is left. */ 145 call speedtype_expand_ (token_ptr, token_len, texp_ptr, texp_len_max, texp_len, ecode); 146 if ecode ^= 0 then return; 147 148 if token = test_expansion /* Did expansion change anything? */ 149 then do; /* No, expanded string OK. */ 150 if dtok_len > 0 /* If delim token, check for PAD escape. */ 151 then if substr (test_expansion, dtok_len, 1) = pad_escape 152 then substr (test_expansion, dtok_len, 1) = escape_char; 153 out_used = out_used + texp_len; /* Move output window. */ 154 return; 155 end; 156 157 /* Expansion does alter the input text. Thus expanded string cannot be used. 158* * Move input string tokens one at a time and insert an escape character in between. 159**/ 160 token_ptr = dtok_ptr; /* First move th delimiter token. */ 161 token_len = dtok_len; 162 call MOVE_OUT; 163 if ecode ^= 0 then return; 164 165 token_ptr = addr (escape_char); /* Add the escape character. */ 166 token_len = 1; 167 call MOVE_OUT; 168 if ecode ^= 0 then return; 169 170 token_ptr = ttok_ptr; /* Now move the text token. */ 171 token_len = ttok_len; 172 call MOVE_OUT; 173 174 end COPY_PAIR; 175 /* */ 176 MOVE_OUT: procedure; 177 178 /* This procedure is called to move the current token string 179* * into the output string. It will make sure that there is 180* * enough room in the output string. 181**/ 182 183 if token_len = 0 then return; /* No token => nothing to do. */ 184 185 if (out_used + token_len) > out_len /* Is there room for this output? */ 186 then do; /* No. */ 187 out_used = out_len; /* Make sure no other output fits. */ 188 ecode = error_table_$item_too_big; 189 return; 190 end; 191 192 addr (output.text) -> token = token; /* Copy token into output. */ 193 194 out_used = out_used + token_len; /* Move output pointer over token. */ 195 196 end MOVE_OUT; 197 198 end speedtype_retain_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/06/81 1247.6 speedtype_retain_.pl1 >spec>on>speed>speedtype_retain_.pl1 75 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 68 ref 116 132 143 165 192 arg_ecode parameter fixed bin(35,0) dcl 19 set ref 10 103* arg_in_len parameter fixed bin(21,0) dcl 20 ref 10 80 arg_in_ptr parameter pointer dcl 21 ref 10 79 arg_out_len parameter fixed bin(21,0) dcl 22 ref 10 82 arg_out_ptr parameter pointer dcl 23 ref 10 81 arg_out_used parameter fixed bin(21,0) dcl 24 set ref 10 101* arg_perm_flag parameter bit(1) dcl 25 ref 10 92 delimiters 5 based char(24) level 2 dcl 1-26 ref 117 133 dtok_len 000100 automatic fixed bin(17,0) dcl 30 set ref 117* 118 118* 118 120* 121 122 127 141 150 150 150 161 dtok_ptr 000102 automatic pointer dcl 31 set ref 116* 126 140 160 ecode 000104 automatic fixed bin(35,0) dcl 32 set ref 84* 89* 90 97 103 145* 146 163 168 188* error_table_$item_too_big 000010 external static fixed bin(35,0) dcl 70 ref 188 escape_char 000105 automatic char(1) unaligned dcl 33 set ref 92* 94* 150 165 escapes 13 based char(5) level 2 dcl 1-26 ref 92 94 95 exp based structure level 1 dcl 1-52 in_len 000112 automatic fixed bin(21,0) dcl 37 set ref 80* 97 116 117 120 122* 122 124 132 133 136 138* 138 in_ptr 000114 automatic pointer dcl 38 set ref 79* 116 117 132 133 in_used 000116 automatic fixed bin(17,0) dcl 39 set ref 84* 116 117 121* 121 132 133 137* 137 input based structure level 1 dcl 52 out_len 000117 automatic fixed bin(21,0) dcl 40 set ref 82* 144 185 187 out_ptr 000120 automatic pointer dcl 41 set ref 81* 143 192 out_used 000122 automatic fixed bin(21,0) dcl 42 set ref 84* 101 143 144 153* 153 185 187* 192 194* 194 output based structure level 1 dcl 56 pad_escape 000123 automatic char(1) unaligned dcl 43 set ref 95* 150 sb based structure level 1 dcl 1-48 search builtin function dcl 68 ref 133 spc based structure level 1 dcl 1-57 speedtype_expand_ 000012 constant entry external dcl 72 ref 145 speedtype_info_$pointer 000014 constant entry external dcl 73 ref 89 ssd based structure level 1 dcl 1-26 ssd_ptr 000134 automatic pointer dcl 1-17 set ref 89* 92 94 95 117 133 substr builtin function dcl 68 set ref 92 94 95 150 150* test_expansion based char dcl 61 set ref 148 150 150* texp_len 000106 automatic fixed bin(21,0) dcl 34 set ref 145* 148 150 150 153 texp_len_max 000107 automatic fixed bin(21,0) dcl 35 set ref 144* 145* texp_ptr 000110 automatic pointer dcl 36 set ref 143* 145* 148 150 150 text based char level 2 in structure "input" packed unaligned dcl 52 in procedure "speedtype_retain_" set ref 116 117 132 133 text based char(1) level 2 in structure "output" packed unaligned dcl 56 in procedure "speedtype_retain_" set ref 143 192 token based char unaligned dcl 63 set ref 148 192* 192 token_len 000130 automatic fixed bin(21,0) dcl 46 set ref 127* 141* 145* 148 161* 166* 171* 183 185 192 192 194 token_ptr 000132 automatic pointer dcl 47 set ref 126* 140* 145* 148 160* 165* 170* 192 ttok_len 000124 automatic fixed bin(17,0) dcl 44 set ref 133* 134 134* 134 136* 137 138 141 171 ttok_ptr 000126 automatic pointer dcl 45 set ref 132* 170 verify builtin function dcl 68 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 exp_ptr automatic pointer dcl 1-18 length builtin function dcl 68 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. COPY_PAIR 000105 constant entry internal dcl 106 ref 98 MOVE_OUT 000300 constant entry internal dcl 176 ref 128 162 167 172 RETURN 000077 constant label dcl 101 ref 90 speedtype_retain_ 000012 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 410 426 326 420 Length 614 326 16 152 62 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME speedtype_retain_ 126 external procedure is an external procedure. COPY_PAIR internal procedure shares stack frame of external procedure speedtype_retain_. MOVE_OUT internal procedure shares stack frame of external procedure speedtype_retain_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME speedtype_retain_ 000100 dtok_len speedtype_retain_ 000102 dtok_ptr speedtype_retain_ 000104 ecode speedtype_retain_ 000105 escape_char speedtype_retain_ 000106 texp_len speedtype_retain_ 000107 texp_len_max speedtype_retain_ 000110 texp_ptr speedtype_retain_ 000112 in_len speedtype_retain_ 000114 in_ptr speedtype_retain_ 000116 in_used speedtype_retain_ 000117 out_len speedtype_retain_ 000120 out_ptr speedtype_retain_ 000122 out_used speedtype_retain_ 000123 pad_escape speedtype_retain_ 000124 ttok_len speedtype_retain_ 000126 ttok_ptr speedtype_retain_ 000130 token_len speedtype_retain_ 000132 token_ptr speedtype_retain_ 000134 ssd_ptr speedtype_retain_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return ext_entry verify_eis search_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. speedtype_expand_ speedtype_info_$pointer THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$item_too_big LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 000004 79 000017 80 000023 81 000025 82 000030 84 000032 89 000035 90 000045 92 000047 94 000061 95 000066 97 000071 98 000075 99 000076 101 000077 103 000102 104 000104 106 000105 116 000106 117 000112 118 000122 120 000126 121 000130 122 000132 124 000134 126 000136 127 000140 128 000142 129 000143 132 000144 133 000150 134 000154 136 000160 137 000162 138 000164 140 000166 141 000170 143 000173 144 000177 145 000202 146 000223 148 000226 150 000236 153 000247 154 000251 160 000252 161 000254 162 000256 163 000257 165 000262 166 000264 167 000266 168 000267 170 000272 171 000274 172 000276 174 000277 176 000300 183 000301 185 000304 187 000307 188 000311 189 000314 192 000315 194 000324 196 000325 ----------------------------------------------------------- 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