COMPILATION LISTING OF SEGMENT tty_replace_canon Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 0935.6 mst Sat Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 /* Replacement canonicalization (can_type=replace): Assuming that overstriking is destructive, space (SP) is destructive, 14* and horizontal tab (HT) is not destructive, this procedure accepts a line of ASCII characters as input and replaces it 15* with the canonical representation of that line. Characters are sorted by column position; NUL (\000) characters are 16* discarded; when characters are overstruck, only the last character in the column is preserved */ 17 18 /* Created: 18 September 1980 by G. Palter */ 19 /* Modified: 11 November 1980 by G. Palter to rename to tty_replace_canon and accept additional parameters */ 20 /* Modified: 14 February 1984 by Robert Coren to preserve invisible control characters */ 21 22 tty_replace_canon: 23 procedure (P_line_ptr, P_line_lth, P_line_max_lth, P_erase_character, P_kill_character, P_code); 24 25 26 /* Parameters */ 27 28 dcl P_line_ptr pointer parameter; /* -> string to be processed and output area */ 29 dcl P_line_lth fixed binary parameter; /* current length of string (Input/Output) */ 30 dcl P_line_max_lth fixed binary parameter; /* maximum size of the string */ 31 dcl P_erase_character character (1) aligned parameter; /* current erase character or SP if none */ 32 dcl P_kill_character character (1) aligned parameter; /* current kill character or SP if none */ 33 dcl P_code fixed binary (35) parameter; /* status code (Output) */ 34 35 36 /* Local copies of parameters */ 37 38 dcl line_ptr pointer; 39 dcl (line_lth, line_max_lth) fixed binary; 40 dcl code fixed binary (35); 41 42 43 /* Remaining declarations */ 44 45 dcl line character (line_max_lth) unaligned based (line_ptr); 46 47 dcl 1 char_array (P_line_max_lth) aligned, /* characters to be sorted by column */ 48 2 column fixed binary (18) unaligned unsigned, 49 2 flags unaligned, 50 3 vertical bit (1) unaligned, /* ON => character has vertical paper motion */ 51 3 pad bit (6) unaligned, 52 3 not_control bit (1) unaligned, /* ON => character is not "invisible" control character */ 53 3 not_tab bit (1) unaligned, /* ON => character isn't horizontal tab */ 54 2 char character (1) unaligned; /* the character itself */ 55 56 dcl complete_item (1) bit (36) aligned based (addr (char_array)); 57 dcl 1 partial_item (1) aligned based (addr (char_array)), 58 2 sorted bit (27) unaligned, 59 2 unsorted bit (9) unaligned; 60 61 dcl temp_item bit (36) aligned; 62 dcl 1 partial_temp aligned based (addr (temp_item)), 63 2 sorted bit (27) unaligned, 64 2 unsorted bit (9) unaligned; 65 66 dcl (start_column, current_column, next_column, end_of_tab) fixed binary; 67 dcl (char_idx, array_idx, idx) fixed binary; 68 69 dcl the_char character (1) aligned; 70 71 dcl n_characters fixed binary; /* # of characters possibly in output */ 72 73 dcl (NUL initial (""), /* NUL */ 74 CR initial (" "), /* carriage return */ 75 BS initial (""), /* backspace */ 76 HT initial (" "), /* horizontal tab */ 77 NL initial (" 78 "), /* newline */ 79 VT initial /* vertical tab */ 80 (" "), 81 FF initial /* form feed */ 82 (" "), 83 SP initial (" ")) /* space */ 84 character (1) aligned static options (constant); 85 86 dcl HTSP character (2) static options (constant) initial (" "); 87 88 dcl MAX_COLUMN fixed binary (18) static options (constant) initial (262143); 89 90 dcl error_table_$long_record fixed binary (35) external; 91 92 dcl (addr, length, max, mod, rtrim, string, substr) builtin; 93 94 start_column, current_column = 0; 95 96 line_ptr = P_line_ptr; 97 line_lth = P_line_lth; 98 line_max_lth = P_line_max_lth; 99 100 P_code, code = 0; 101 102 103 /* Classify each input character and determine which column it appears in on the screen */ 104 105 array_idx = 1; 106 107 do char_idx = 1 to line_lth; 108 109 string (char_array(array_idx).flags) = "003"b3; /* turn on flags.not_tab and flags.not_control */ 110 the_char = substr (line, char_idx, 1); 111 112 if (the_char = CR) then /* carriage return: reset to start of line */ 113 current_column = start_column; 114 115 else if (the_char = BS) then /* backspace: move back one column -- replacement later */ 116 current_column = max (start_column, (current_column - 1)); 117 118 else if (the_char = NUL) then; /* throw away NULs */ 119 120 else do; /* anything else: put into array */ 121 if (the_char = NL) /* newline: insure it is last in output */ 122 then do; 123 char_array(array_idx).column = MAX_COLUMN; 124 char_array(array_idx).vertical = "1"b; 125 end; 126 127 else if (the_char = VT) | (the_char = FF) 128 then do; /* these characters start a new "line" */ 129 current_column, start_column = start_column + 1000; 130 char_array(array_idx).column = start_column - 1; 131 char_array(array_idx).vertical = "1"b; 132 end; 133 134 else do; /* ordinary character */ 135 char_array(array_idx).column = current_column; /* into next column */ 136 if (the_char = HT) 137 then do; /* horizontal tab: compute next tab stop */ 138 char_array(array_idx).not_tab = "0"b; 139 current_column = current_column + 10 - mod (current_column, 10); 140 end; 141 else if (the_char >= SP) then /* advances to next position */ 142 current_column = current_column + 1; 143 144 else char_array(array_idx).not_control = "0"b; 145 end; 146 147 char_array(array_idx).char = the_char; 148 array_idx = array_idx + 1; 149 end; 150 end; 151 152 n_characters = array_idx - 1; /* incremented by one too many */ 153 154 155 /* Sort characters according to column */ 156 157 do array_idx = 1 to n_characters - 1; 158 if partial_item(array_idx).sorted > partial_item(array_idx+1).sorted then do; 159 temp_item = complete_item (array_idx+1); 160 do idx = array_idx to 1 by -1 while (partial_item(idx).sorted > partial_temp.sorted); 161 complete_item (idx+1) = complete_item (idx); 162 end; 163 complete_item (idx+1) = temp_item; 164 end; 165 end; 166 167 168 /* Place characters into output string, replacing overstruck sequences with the last character typed into the column */ 169 170 char_idx = 1; 171 current_column = 0; 172 173 do array_idx = 1 to n_characters; 174 175 next_column = char_array(array_idx).column; /* where this graphic belongs */ 176 177 do while (current_column < next_column); /* insert spaces as needed */ 178 if char_array(array_idx).vertical 179 then do; 180 current_column = next_column; /* moves to next line: don't add uneeded spaces */ 181 char_idx = length (rtrim (substr (line, 1, char_idx-1), HTSP)) + 1; 182 end; /* stip trailing whitespace already present */ 183 else do; 184 call insert_character (SP); 185 current_column = current_column + 1; 186 end; 187 end; 188 189 if ^char_array(array_idx).not_tab 190 then do; /* horizontal tab */ 191 end_of_tab = current_column + 10 - mod (current_column, 10); 192 if array_idx < n_characters then 193 if char_array(array_idx+1).column >= end_of_tab then do; 194 call insert_character (HT); /* chars after HT don't overwrite it */ 195 current_column = end_of_tab; 196 end; 197 end; 198 199 /* if HT is overwritten, next character will cause spaces to be inserted by above loop */ 200 201 else do; /* not HT */ 202 call insert_character ((char_array(array_idx).char)); 203 /* put it into string */ 204 do while ((array_idx < n_characters) & (char_array(array_idx+1).column = current_column)); 205 if ^char_array (array_idx).not_control then 206 char_idx = char_idx + 1; /* don't overwrite control characters */ 207 array_idx = array_idx + 1; /* process overstrikes by replacing previous character */ 208 substr (line, char_idx-1, 1) = char_array(array_idx).char; 209 end; 210 current_column = current_column + 1; 211 end; 212 end; 213 214 P_line_lth = char_idx - 1; /* set output length */ 215 216 RETURN_TO_CALLER: 217 P_code = code; 218 return; 219 220 /* Insert the given character into the output string */ 221 222 insert_character: 223 procedure (p_character); 224 225 dcl p_character character (1) aligned parameter; 226 227 if char_idx > line_max_lth then do; /* overflowed */ 228 code = error_table_$long_record; 229 go to RETURN_TO_CALLER; 230 end; 231 232 substr (line, char_idx, 1) = p_character; 233 char_idx = char_idx + 1; 234 235 return; 236 237 end insert_character; 238 239 end tty_replace_canon; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0826.9 tty_replace_canon.pl1 >spec>install>1112>tty_replace_canon.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. BS constant char(1) initial dcl 73 ref 115 CR constant char(1) initial dcl 73 ref 112 FF constant char(1) initial dcl 73 ref 127 HT 000001 constant char(1) initial dcl 73 set ref 136 194* HTSP constant char(2) initial packed unaligned dcl 86 ref 181 MAX_COLUMN constant fixed bin(18,0) initial dcl 88 ref 123 NL constant char(1) initial dcl 73 ref 121 NUL constant char(1) initial dcl 73 ref 118 P_code parameter fixed bin(35,0) dcl 33 set ref 22 100* 216* P_erase_character parameter char(1) dcl 31 ref 22 P_kill_character parameter char(1) dcl 32 ref 22 P_line_lth parameter fixed bin(17,0) dcl 29 set ref 22 97 214* P_line_max_lth parameter fixed bin(17,0) dcl 30 ref 22 47 98 P_line_ptr parameter pointer dcl 28 ref 22 96 SP 000000 constant char(1) initial dcl 73 set ref 141 184* VT constant char(1) initial dcl 73 ref 127 addr builtin function dcl 92 ref 158 158 159 160 160 161 161 163 array_idx 000113 automatic fixed bin(17,0) dcl 67 set ref 105* 109 123 124 130 131 135 138 144 147 148* 148 152 157* 158 158 159 160* 173* 175 178 189 192 192 202 204 204 205 207* 207 208* char 0(27) 000105 automatic char(1) array level 2 packed packed unaligned dcl 47 set ref 147* 202 208 char_array 000105 automatic structure array level 1 dcl 47 set ref 158 158 159 160 161 161 163 char_idx 000112 automatic fixed bin(17,0) dcl 67 set ref 107* 110* 170* 181* 181 205* 205 208 214 227 232 233* 233 code 000104 automatic fixed bin(35,0) dcl 40 set ref 100* 216 228* column 000105 automatic fixed bin(18,0) array level 2 packed packed unsigned unaligned dcl 47 set ref 123* 130* 135* 175 192 204 complete_item based bit(36) array dcl 56 set ref 159 161* 161 163* current_column 000107 automatic fixed bin(17,0) dcl 66 set ref 94* 112* 115* 115 129* 135 139* 139 139 141* 141 171* 177 180* 185* 185 191 191 195* 204 210* 210 end_of_tab 000111 automatic fixed bin(17,0) dcl 66 set ref 191* 192 195 error_table_$long_record 000010 external static fixed bin(35,0) dcl 90 ref 228 flags 0(18) 000105 automatic structure array level 2 packed packed unaligned dcl 47 set ref 109* idx 000114 automatic fixed bin(17,0) dcl 67 set ref 160* 160* 161 161* 163 length builtin function dcl 92 ref 181 line based char packed unaligned dcl 45 set ref 110 181 208* 232* line_lth 000102 automatic fixed bin(17,0) dcl 39 set ref 97* 107 line_max_lth 000103 automatic fixed bin(17,0) dcl 39 set ref 98* 110 181 208 227 232 line_ptr 000100 automatic pointer dcl 38 set ref 96* 110 181 208 232 max builtin function dcl 92 ref 115 mod builtin function dcl 92 ref 139 191 n_characters 000116 automatic fixed bin(17,0) dcl 71 set ref 152* 157 173 192 204 next_column 000110 automatic fixed bin(17,0) dcl 66 set ref 175* 177 180 not_control 0(25) 000105 automatic bit(1) array level 3 packed packed unaligned dcl 47 set ref 144* 205 not_tab 0(26) 000105 automatic bit(1) array level 3 packed packed unaligned dcl 47 set ref 138* 189 p_character parameter char(1) dcl 225 ref 222 232 partial_item based structure array level 1 dcl 57 partial_temp based structure level 1 dcl 62 rtrim builtin function dcl 92 ref 181 sorted based bit(27) array level 2 in structure "partial_item" packed packed unaligned dcl 57 in procedure "tty_replace_canon" ref 158 158 160 sorted based bit(27) level 2 in structure "partial_temp" packed packed unaligned dcl 62 in procedure "tty_replace_canon" ref 160 start_column 000106 automatic fixed bin(17,0) dcl 66 set ref 94* 112 115 129 129* 130 string builtin function dcl 92 set ref 109* substr builtin function dcl 92 set ref 110 181 208* 232* temp_item 000105 automatic bit(36) dcl 61 set ref 159* 160 163 the_char 000115 automatic char(1) dcl 69 set ref 110* 112 115 118 121 127 127 136 141 147 vertical 0(18) 000105 automatic bit(1) array level 3 packed packed unaligned dcl 47 set ref 124* 131* 178 NAMES DECLARED BY EXPLICIT CONTEXT. RETURN_TO_CALLER 000427 constant label dcl 216 ref 229 insert_character 000433 constant entry internal dcl 222 ref 184 194 202 tty_replace_canon 000014 constant entry external dcl 22 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 734 746 673 744 Length 1114 673 12 131 40 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tty_replace_canon 94 external procedure is an external procedure. insert_character internal procedure shares stack frame of external procedure tty_replace_canon. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME tty_replace_canon 000100 line_ptr tty_replace_canon 000102 line_lth tty_replace_canon 000103 line_max_lth tty_replace_canon 000104 code tty_replace_canon 000105 char_array tty_replace_canon 000105 temp_item tty_replace_canon 000106 start_column tty_replace_canon 000107 current_column tty_replace_canon 000110 next_column tty_replace_canon 000111 end_of_tab tty_replace_canon 000112 char_idx tty_replace_canon 000113 array_idx tty_replace_canon 000114 idx tty_replace_canon 000115 the_char tty_replace_canon 000116 n_characters tty_replace_canon THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return_mac alloc_auto_adj mdfx1 ext_entry NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$long_record LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 22 000006 47 000021 94 000026 96 000030 97 000033 98 000035 100 000037 105 000041 107 000043 109 000053 110 000060 112 000065 115 000073 118 000104 121 000107 123 000111 124 000114 125 000116 127 000117 129 000123 130 000127 131 000133 132 000135 135 000136 136 000142 138 000145 139 000147 140 000157 141 000160 144 000164 147 000166 148 000172 150 000173 152 000175 157 000200 158 000207 159 000221 160 000223 161 000243 162 000245 163 000250 165 000253 170 000255 171 000257 173 000260 175 000267 177 000273 178 000277 180 000304 181 000306 182 000325 184 000326 185 000330 187 000331 189 000332 191 000337 192 000346 194 000355 195 000357 197 000361 202 000362 204 000367 205 000377 207 000405 208 000406 209 000417 210 000420 212 000421 214 000423 216 000427 218 000432 222 000433 227 000435 228 000440 229 000443 232 000444 233 000451 235 000452 ----------------------------------------------------------- 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