COMPILATION LISTING OF SEGMENT tty_overstrike_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 0936.4 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 14 /* Overstriking canonicalization (can_type=overstrike): This procedure takes a line of ASCII characters as input, and 15* replaces it with a canonical version of the same line. It sorts characters by column position, and by ASCII value 16* within column position, ensuring that kill and erase characters come out last in their respective column positions. 17* NUL (\000) characters are discarded; columns overstruck with an erase character are likewise deleted */ 18 19 /* Modified: 19 September 1980 by G. Palter as part of fix to MCS bug #203 */ 20 /* Modified: 11 November 1980 by G. Palter to rename to tty_overstrike_canon */ 21 22 23 tty_overstrike_canon: 24 procedure (a_ptr, a_len, a_max_len, a_erase, a_kill, code); 25 26 27 /* PARAMETERS */ 28 29 dcl a_ptr ptr; /* pointer to string to be canonicalized */ 30 dcl a_len fixed bin; /* current length of string (INPUT/OUTPUT) */ 31 dcl a_max_len fixed bin; /* maximum allowable length of string */ 32 dcl a_erase char (1) aligned; /* erase character */ 33 dcl a_kill char (1) aligned; /* kill character */ 34 dcl code fixed bin (35); /* status code (OUTPUT) */ 35 36 37 /* AUTOMATIC */ 38 39 dcl stringp ptr; /* local copy of a_ptr */ 40 dcl stringl fixed bin; /* " " " a_len */ 41 dcl max_len fixed bin; /* " " " a_max_len */ 42 dcl erase_char char (1); /* " " " a_erase */ 43 dcl kill_char char (1); /* " " " a_kill */ 44 45 dcl start_col fixed bin; /* left margin column no. */ 46 dcl current_col fixed bin; 47 dcl next_col fixed bin; 48 dcl char_x fixed bin; /* index into character string */ 49 dcl last_x fixed bin; 50 dcl col_x fixed bin; /* index into column_array */ 51 52 dcl current_char char (1); 53 dcl n_items fixed bin; 54 dcl temp fixed bin; 55 dcl i fixed bin; 56 dcl end_of_tab fixed bin; /* column position of next tab stop */ 57 58 dcl 1 column_array (a_max_len) aligned, /* temporary storage for sorting by column */ 59 2 column fixed bin (17) unal, 60 2 flags unal, 61 3 erase bit (1) unal, 62 3 kill bit (1) unal, 63 3 vertical bit (1) unal, /* character involves vertical paper motion */ 64 3 pad bit (5) unal, 65 3 not_tab bit (1) unal, /* on for all characters EXCEPT horizontal tab */ 66 2 char char (1) unal; 67 68 69 /* INTERNAL STATIC CONSTANTS */ 70 71 dcl nul_char char (1) int static aligned init (""); /* NUL */ 72 dcl cr char (1) int static aligned init /* carriage return */ 73 (" "); 74 75 dcl bs char (1) int static aligned init (""); /* backspace */ 76 dcl ht char (1) int static aligned init (" "); /* horizontal tab */ 77 dcl nl char (1) int static aligned init (" 78 "); 79 /* newline */ 80 dcl vt char (1) int static aligned init /* vertical tab */ 81 (" "); 82 dcl ff char (1) int static aligned init /* form-feed */ 83 (" "); 84 dcl sp char (1) int static aligned init (" "); 85 86 dcl HTSP character (2) static options (constant) initial (" "); /* horizontal tab and space */ 87 88 dcl biggest_num fixed bin int static aligned init (131071); 89 90 91 /* BASED */ 92 93 dcl based_string char (stringl) based (stringp); 94 dcl items (10) based (addr(column_array)); /* overlay for column_array used in sorting */ 95 96 97 /* EXTERNAL STATIC */ 98 99 dcl error_table_$long_record ext static aligned fixed bin (35); 100 101 102 /* BUILTINS */ 103 104 dcl (addr, length, max, mod, rtrim, string, substr) builtin; 105 106 /* */ 107 start_col, current_col = 0; 108 stringp = a_ptr; 109 stringl = a_len; 110 max_len = a_max_len; 111 erase_char = a_erase; 112 kill_char = a_kill; 113 114 col_x = 1; 115 116 do char_x = 1 to stringl; /* examine all input characters */ 117 string (column_array (col_x).flags) = "000000001"b; /* turn on not_tab, other flags off */ 118 current_char = substr (stringp -> based_string, char_x, 1); 119 120 if current_char = cr /* carriage return, just reset column */ 121 then current_col = start_col; 122 123 else 124 if current_char = bs 125 then current_col = max (start_col, current_col - 1); /* back up one for backspace */ 126 127 else 128 if current_char = sp 129 then current_col = current_col + 1; 130 131 else 132 if current_char = nul_char 133 then; 134 135 /* other characters will be stored */ 136 137 else do; 138 if current_char = nl /* newline */ 139 then do; 140 column_array (col_x).column = biggest_num; /* make sure it sorts to end */ 141 column_array (col_x).vertical = "1"b; 142 end; 143 144 else 145 if current_char = vt | 146 current_char = ff 147 then do; 148 current_col, 149 start_col = start_col + 1000; 150 column_array (col_x).column = start_col - 1; 151 column_array (col_x).vertical = "1"b; 152 end; 153 154 else do; 155 column_array (col_x).column = current_col; /* graphic goes in next column */ 156 if current_char = ht /* horizontal tab */ 157 then do; 158 column_array (col_x).not_tab = "0"b; 159 current_col = current_col + 10 - mod (current_col, 10); /* advance to next tab stop */ 160 end; 161 162 else do; 163 if current_char >= sp /* if not control char */ 164 then current_col = current_col + 1; /* ordinary graphic, advances column by 1 */ 165 if current_char = erase_char 166 then column_array (col_x).erase = "1"b; 167 168 else if current_char = kill_char 169 then column_array (col_x).kill = "1"b; 170 end; 171 end; 172 173 column_array (col_x).char = current_char; 174 col_x = col_x + 1; 175 end; 176 end; 177 178 /* now sort */ 179 180 n_items = col_x - 1; /* we incremented an extra time at the end */ 181 182 /* we will use dumb kind of sort, since columns will usually be mostly in order */ 183 184 do col_x = 1 to n_items - 1; 185 if items (col_x) > items (col_x+1) /* out of order */ 186 then do; 187 temp = items (col_x+1); /* save item we're moving */ 188 do i = col_x to 1 by -1 while (items (i) > temp); /* find its place */ 189 items (i+1) = items (i); /* move everyone else over */ 190 end; 191 192 items (i+1) = temp; 193 end; 194 end; 195 196 /* now put characters back in string in right order */ 197 198 char_x = 1; 199 current_col = 0; 200 201 do col_x = 1 to n_items; 202 next_col = column_array (col_x).column; /* place where next graphic goes */ 203 204 do while (current_col < next_col); /* insert spaces if needed */ 205 if column_array (col_x).vertical 206 then do; 207 current_col = next_col; 208 char_x = length (rtrim (substr (based_string, 1, char_x-1), HTSP)) + 1; 209 end; /* remove trailing whitepsace from just completed line */ 210 211 else do; 212 call insert_char (sp); 213 current_col = current_col + 1; 214 end; 215 end; 216 217 last_x = char_x; /* place to back up to in case of erase */ 218 219 if ^column_array (col_x).not_tab /* horizontal tab */ 220 then do; 221 end_of_tab = current_col + 10 - mod (current_col, 10); 222 if col_x < n_items /* if there are characters after it */ 223 then if column_array (col_x+1).column >= end_of_tab /* and tab is not overwritten */ 224 then do; 225 call insert_char (ht); 226 current_col = end_of_tab; 227 end; 228 229 /* otherwise next time around will insert spaces if needed */ 230 231 end; 232 233 else do; /* not tab */ 234 235 call insert_char ((column_array (col_x).char)); 236 237 do while (column_array (col_x+1).column = current_col & col_x < n_items); 238 col_x = col_x + 1; 239 if column_array (col_x).erase /* column position is erased */ 240 then char_x = last_x; /* pretend it never happened */ 241 242 else do; 243 if column_array (col_x).char ^= substr (based_string, char_x-1, 1) 244 then do; /* don't store multiple instances of same graphic */ 245 call insert_char (bs); 246 call insert_char ((column_array (col_x).char)); 247 end; 248 end; 249 end; 250 251 current_col = current_col + 1; /* finished with that column position */ 252 end; 253 end; 254 255 /* all done */ 256 257 a_len = char_x - 1; /* we incremented after every insertion */ 258 code = 0; 259 return; 260 261 262 blew_it: /* we come here if we overflowed max_len */ 263 code = error_table_$long_record; 264 return; 265 /* */ 266 insert_char: proc (a_char); 267 268 /* this procedure inserts a character into the final string and updates the index into the string */ 269 /* it checks to make sure we don't overflow */ 270 271 dcl a_char char (1) aligned; 272 273 if char_x > max_len 274 then go to blew_it; 275 276 substr (based_string, char_x, 1) = a_char; 277 char_x = char_x + 1; 278 return; 279 280 end insert_char; 281 282 end tty_overstrike_canon; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0826.9 tty_overstrike_canon.pl1 >spec>install>1112>tty_overstrike_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. HTSP constant char(2) initial packed unaligned dcl 86 ref 208 a_char parameter char(1) dcl 271 ref 266 276 a_erase parameter char(1) dcl 32 ref 23 111 a_kill parameter char(1) dcl 33 ref 23 112 a_len parameter fixed bin(17,0) dcl 30 set ref 23 109 257* a_max_len parameter fixed bin(17,0) dcl 31 ref 23 58 110 a_ptr parameter pointer dcl 29 ref 23 108 addr builtin function dcl 104 ref 185 185 187 188 189 189 192 based_string based char packed unaligned dcl 93 set ref 118 208 243 276* biggest_num constant fixed bin(17,0) initial dcl 88 ref 140 bs 000010 internal static char(1) initial dcl 75 set ref 123 245* char 0(27) 000121 automatic char(1) array level 2 packed packed unaligned dcl 58 set ref 173* 235 243 246 char_x 000111 automatic fixed bin(17,0) dcl 48 set ref 116* 118* 198* 208* 208 217 239* 243 257 273 276 277* 277 code parameter fixed bin(35,0) dcl 34 set ref 23 258* 262* col_x 000113 automatic fixed bin(17,0) dcl 50 set ref 114* 117 140 141 150 151 155 158 165 168 173 174* 174 180 184* 185 185 187 188* 201* 202 205 219 222 222 235 237 237 238* 238 239 243 246* column 000121 automatic fixed bin(17,0) array level 2 packed packed unaligned dcl 58 set ref 140* 150* 155* 202 222 237 column_array 000121 automatic structure array level 1 dcl 58 set ref 185 185 187 188 189 189 192 cr constant char(1) initial dcl 72 ref 120 current_char 000114 automatic char(1) packed unaligned dcl 52 set ref 118* 120 123 127 131 138 144 144 156 163 165 168 173 current_col 000107 automatic fixed bin(17,0) dcl 46 set ref 107* 120* 123* 123 127* 127 148* 155 159* 159 159 163* 163 199* 204 207* 213* 213 221 221 226* 237 251* 251 end_of_tab 000120 automatic fixed bin(17,0) dcl 56 set ref 221* 222 226 erase 0(18) 000121 automatic bit(1) array level 3 packed packed unaligned dcl 58 set ref 165* 239 erase_char 000104 automatic char(1) packed unaligned dcl 42 set ref 111* 165 error_table_$long_record 000014 external static fixed bin(35,0) dcl 99 ref 262 ff constant char(1) initial dcl 82 ref 144 flags 0(18) 000121 automatic structure array level 2 packed packed unaligned dcl 58 set ref 117* ht 000011 internal static char(1) initial dcl 76 set ref 156 225* i 000117 automatic fixed bin(17,0) dcl 55 set ref 188* 188* 189 189* 192 items based fixed bin(17,0) array dcl 94 set ref 185 185 187 188 189* 189 192* kill 0(19) 000121 automatic bit(1) array level 3 packed packed unaligned dcl 58 set ref 168* kill_char 000105 automatic char(1) packed unaligned dcl 43 set ref 112* 168 last_x 000112 automatic fixed bin(17,0) dcl 49 set ref 217* 239 length builtin function dcl 104 ref 208 max builtin function dcl 104 ref 123 max_len 000103 automatic fixed bin(17,0) dcl 41 set ref 110* 273 mod builtin function dcl 104 ref 159 221 n_items 000115 automatic fixed bin(17,0) dcl 53 set ref 180* 184 201 222 237 next_col 000110 automatic fixed bin(17,0) dcl 47 set ref 202* 204 207 nl constant char(1) initial dcl 77 ref 138 not_tab 0(26) 000121 automatic bit(1) array level 3 packed packed unaligned dcl 58 set ref 158* 219 nul_char constant char(1) initial dcl 71 ref 131 rtrim builtin function dcl 104 ref 208 sp 000012 internal static char(1) initial dcl 84 set ref 127 163 212* start_col 000106 automatic fixed bin(17,0) dcl 45 set ref 107* 120 123 148 148* 150 string builtin function dcl 104 set ref 117* stringl 000102 automatic fixed bin(17,0) dcl 40 set ref 109* 116 118 208 243 276 stringp 000100 automatic pointer dcl 39 set ref 108* 118 208 243 276 substr builtin function dcl 104 set ref 118 208 243 276* temp 000116 automatic fixed bin(17,0) dcl 54 set ref 187* 188 192 vertical 0(20) 000121 automatic bit(1) array level 3 packed packed unaligned dcl 58 set ref 141* 151* 205 vt constant char(1) initial dcl 80 ref 144 NAMES DECLARED BY EXPLICIT CONTEXT. blew_it 000502 constant label dcl 262 ref 273 insert_char 000507 constant entry internal dcl 266 ref 212 225 235 245 246 tty_overstrike_canon 000012 constant entry external dcl 23 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 774 1012 732 1004 Length 1164 732 16 135 41 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME tty_overstrike_canon 102 external procedure is an external procedure. insert_char internal procedure shares stack frame of external procedure tty_overstrike_canon. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 bs tty_overstrike_canon 000011 ht tty_overstrike_canon 000012 sp tty_overstrike_canon STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME tty_overstrike_canon 000100 stringp tty_overstrike_canon 000102 stringl tty_overstrike_canon 000103 max_len tty_overstrike_canon 000104 erase_char tty_overstrike_canon 000105 kill_char tty_overstrike_canon 000106 start_col tty_overstrike_canon 000107 current_col tty_overstrike_canon 000110 next_col tty_overstrike_canon 000111 char_x tty_overstrike_canon 000112 last_x tty_overstrike_canon 000113 col_x tty_overstrike_canon 000114 current_char tty_overstrike_canon 000115 n_items tty_overstrike_canon 000116 temp tty_overstrike_canon 000117 i tty_overstrike_canon 000120 end_of_tab tty_overstrike_canon 000121 column_array tty_overstrike_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 23 000004 58 000017 107 000024 108 000026 109 000031 110 000033 111 000035 112 000040 114 000043 116 000045 117 000055 118 000062 120 000067 123 000075 127 000111 131 000117 138 000123 140 000125 141 000130 142 000132 144 000133 148 000137 150 000143 151 000147 152 000151 155 000152 156 000156 158 000162 159 000164 160 000174 163 000175 165 000203 168 000211 173 000215 174 000221 176 000222 180 000224 184 000227 185 000237 187 000244 188 000246 189 000257 190 000261 192 000264 194 000267 198 000271 199 000273 201 000274 202 000303 204 000307 205 000313 207 000320 208 000322 209 000341 212 000342 213 000351 215 000352 217 000353 219 000355 221 000362 222 000372 225 000401 226 000410 231 000412 235 000413 237 000420 238 000430 239 000431 243 000441 245 000452 246 000461 249 000470 251 000471 253 000472 257 000474 258 000500 259 000501 262 000502 264 000506 266 000507 273 000511 276 000514 277 000521 278 000522 ----------------------------------------------------------- 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