COMPILATION LISTING OF SEGMENT bigletter_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1642.5 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 bigletter_: proc (inchar, writer); 12 13 /* BIGLETTER_ - Create "big letters" for printing. 14* Used by IO Daemon subroutine "head_sheet_" and routine "make_tape_labels", and others. 15* 16* This routine can make two sizes of letters: 9x8 large letters, and 5x5 small ones. 17* The letters are printed according to a format matrix which shows where a mark should be made. 18* Each input letter is looked up in a "translation alphabet" -- if not found, the letter is skipped. 19* Only 132 characters will be put out on a line - this is 13 9x8 letters or 22 5x5 letters. 20* 21* An entry point is provided for the user who insists on making his own alphabet and 22* format matrix, for the 8x9 case only. the $init entry sets this up, and the $var is used to write. 23* 24* THVV */ 25 26 dcl inchar char (*); /* Input character string to be written. */ 27 28 dcl writer entry (ptr, fixed bin); /* Input user program to write one line. */ 29 30 dcl 1 letters (0:128) based (bigp) aligned, /* The matrix to be used. Subscript 0 is not used. */ 31 2 bits bit (item) aligned; /* 36 or 72 bit elements. */ 32 33 dcl 1 letter based (letp) aligned, /* A single letter in the array. */ 34 2 bitrow (high) bit (wide) unal; /* .. consists of a matrix of bits */ 35 36 dcl 1 letters9 (0: 128) based (bigp) aligned, /* Special for 9x8 */ 37 2 bits bit (72) aligned; 38 39 dcl 1 letter9 based (letp) aligned, 40 2 bitrow9 bit (72); 41 42 dcl 1 letters5 (0: 128) based (bigp) aligned, /* Special for 5x5 */ 43 2 bits bit (36) aligned; 44 45 dcl 1 letter5 based (letp) aligned, 46 2 bitrow5 bit (36); 47 48 dcl cx fixed bin (8) unal based (addr (c)); /* For convert char to number in fast case. */ 49 50 dcl i fixed bin, /* index in input string */ 51 ii fixed bin, /* horizontal index in output char */ 52 m fixed bin, /* Constant part of above */ 53 row fixed bin, /* vertical index in output */ 54 inch char (22), /* Copy of input. */ 55 incl fixed bin, /* Length of input. */ 56 x fixed bin, /* horizontal index in output buffer */ 57 k fixed bin, /* index of character in alphabet. */ 58 c char (1) aligned, /* temp for one char of inchar */ 59 big_letterp ptr int static init (null), /* pointer to user-supplied format matrix */ 60 alpha char (128) aligned, /* actual lookup alphabet used. */ 61 item fixed bin, /* width of element in "letters" -- 36 or 72 */ 62 high fixed bin, /* letter height */ 63 wide fixed bin, /* letter width */ 64 bigp ptr, /* pointer to actual alphabet format matrix */ 65 letp ptr; /* pointer to current letter format matrix */ 66 67 dcl alphabet char (128) aligned int static init (""); /* user-supplied lookup alphabet */ 68 dcl fill char (1) aligned int static init ("*"); /* user-supplied fill character */ 69 70 dcl (letseg_$letseg, letseg_$littles) fixed bin ext; /* System alphabet format matrices */ 71 72 dcl (null, length, substr, index) builtin; 73 74 dcl linebuf char (132) aligned; /* Output buffer for one line. */ 75 76 /* ===================================================== */ 77 78 regular: bigp = addr (letseg_$letseg); /* Regular 9 x 8 big letters, upper and lower case. */ 79 inch = inchar; /* Copy input for speed. */ 80 incl = length (inchar) + 1 - verify (reverse (inchar), " "); 81 m = 0; 82 do row = 1 to 9; /* Will put out nine lines. */ 83 linebuf = ""; /* Clean out line buffer. */ 84 x = 1; /* Reset to left margin. */ 85 86 do i = 1 to incl; /* Loop over the input string. */ 87 c = substr (inch, i, 1); /* Get one character. */ 88 if unspec (c) = "000001000"b then do; /* handle backpsace */ 89 if x > 10 then x = x - 10; /* .. overstriking will work */ 90 go to skip0; 91 end; 92 if x > 125 then go to skip0; /* write max of 132 */ 93 k = cx - 31; 94 if k <= 0 then go to skip0; 95 if k = 1 then do; /* Special-case blanks. */ 96 x = x +10; 97 go to skip0; 98 end; 99 100 if fill ^= " " then c = fill; /* Default makes all *'s - user can change. */ 101 letp = addr (letters9 (k)); /* Find format matrix for the "K"th letter */ 102 do ii = 1 to 8; /* Minor loop is over the letter width. */ 103 if substr (bitrow9, m+ii, 1) then 104 substr (linebuf, x, 1) = c; 105 x = x + 1; /* Go to next column */ 106 end; 107 x = x + 2; /* Make room between letters. */ 108 109 skip0: end; 110 111 call writer (addr (linebuf), 132); /* Give the line to the user procedure. */ 112 m = m + 8; /* Increment array index. */ 113 end; 114 return; /* Finished. */ 115 116 /* Entry point to make 5 x 5 characters. */ 117 118 five: entry (inchar, writer); 119 120 bigp = addr (letseg_$littles); /* Find 5x5 letters. */ 121 inch = inchar; /* Copy input for speed. */ 122 incl = length (inchar) + 1 - verify (reverse (inchar), " "); 123 m = 0; 124 do row = 1 to 5; /* Will put out five lines. */ 125 linebuf = ""; /* Clean out line buffer. */ 126 x = 1; /* Reset to left margin. */ 127 128 do i = 1 to incl; /* Loop over the input string. */ 129 c = substr (inch, i, 1); /* Get one character. */ 130 if unspec (c) = "000001000"b then do; /* handle backpsace */ 131 if x > 7 then x = x - 7; /* .. overstriking will work */ 132 go to skip1; 133 end; 134 if x > 128 then go to skip1; /* write max of 132 */ 135 k = cx - 31; 136 if k <= 0 then go to skip1; 137 if k = 1 then do; /* Special-case blanks. */ 138 x = x + 7; 139 go to skip1; 140 end; 141 142 if fill ^= " " then c = fill; /* Default makes all *'s - user can change. */ 143 letp = addr (letters5 (k)); /* Find format matrix for the "K"th letter */ 144 do ii = 1 to 5; /* Minor loop is over the letter width. */ 145 if substr (bitrow5, m+ii, 1) then 146 substr (linebuf, x, 1) = c; 147 x = x + 1; /* Go to next column */ 148 end; 149 x = x + 2; /* Make room between letters. */ 150 151 skip1: end; 152 153 call writer (addr (linebuf), 132); /* Give the line to the user procedure. */ 154 m = m + 5; /* Increment array index. */ 155 end; 156 return; /* Finished. */ 157 158 /* Entry to use user-specified alphabel for 9 x 8 characters */ 159 160 var: entry (inchar, writer); 161 162 if big_letterp = null then go to regular; /* If user never init'ed, use regular big letters */ 163 bigp = big_letterp; /* Retrieve saved matrix pointer */ 164 alpha = alphabet; /* .. and saved lookup alphabet */ 165 166 wide = 8; /* Set sizes */ 167 high = 9; /* ... */ 168 item = 72; /* ... */ 169 170 /* The main loop is on the height of the letters. */ 171 172 inch = inchar; /* Copy input for speed. */ 173 incl = length (inchar) + 1 - verify (reverse (inchar), " "); 174 do row = 1 to high; /* Will put out "high" lines. */ 175 linebuf = ""; /* Clean out line buffer. */ 176 x = 1; /* Reset to left margin. */ 177 178 do i = 1 to incl; /* Loop over the input string. */ 179 c = substr (inch, i, 1); /* Get one character. */ 180 if unspec (c) = "000001000"b then do; /* handle backpsace */ 181 if x > (wide+2) then x = x-wide-2; /* .. overstriking will work */ 182 go to skip; 183 end; 184 if x+wide > 133 then go to skip; /* write max of 132 */ 185 k = index (alpha, c); /* Look up input character in lookup alphabet */ 186 if k = 0 then go to skip; /* If not found, ignore character. */ 187 188 if fill ^= " " then c = fill; /* Default makes all *'s - user can change. */ 189 letp = addr (letters (k)); /* Find format matrix for the "K"th letter */ 190 do ii = 1 to wide; /* Minor loop is over the letter width. */ 191 if substr (bitrow (row), ii, 1) then 192 substr (linebuf, x, 1) = c; 193 x = x + 1; /* Go to next column */ 194 end; 195 x = x + 2; /* Make room between letters. */ 196 197 skip: end; 198 199 call writer (addr (linebuf), 132); /* Give the line to the user procedure. */ 200 201 end; 202 return; /* Finished. */ 203 204 /* --------------------------------------------- */ 205 206 init: entry (xp, a, f); /* Entry for the user who wants to play. */ 207 208 dcl xp ptr, (a, f) char (*); 209 210 fill = f; 211 alphabet = a; 212 big_letterp = xp; 213 214 return; 215 216 end bigletter_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1613.4 bigletter_.pl1 >dumps>old>recomp>bigletter_.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. a parameter char unaligned dcl 208 ref 206 211 alpha 000116 automatic char(128) dcl 50 set ref 164* 185 alphabet 000012 internal static char(128) initial dcl 67 set ref 164 211* big_letterp 000010 internal static pointer initial dcl 50 set ref 162 163 212* bigp 000162 automatic pointer dcl 50 set ref 78* 101 120* 143 163* 189 bitrow based bit array level 2 packed unaligned dcl 33 ref 191 bitrow5 based bit(36) level 2 dcl 45 ref 145 bitrow9 based bit(72) level 2 dcl 39 ref 103 c 000115 automatic char(1) dcl 50 set ref 87* 88 93 100* 103 129* 130 135 142* 145 179* 180 185 188* 191 cx based fixed bin(8,0) unaligned dcl 48 ref 93 135 f parameter char unaligned dcl 208 ref 206 210 fill 000052 internal static char(1) initial dcl 68 set ref 100 100 142 142 188 188 210* high 000157 automatic fixed bin(17,0) dcl 50 set ref 167* 174 i 000100 automatic fixed bin(17,0) dcl 50 set ref 86* 87* 128* 129* 178* 179* ii 000101 automatic fixed bin(17,0) dcl 50 set ref 102* 103* 144* 145* 190* 191* inch 000104 automatic char(22) unaligned dcl 50 set ref 79* 87 121* 129 172* 179 inchar parameter char unaligned dcl 26 ref 11 79 80 80 118 121 122 122 160 172 173 173 incl 000112 automatic fixed bin(17,0) dcl 50 set ref 80* 86 122* 128 173* 178 index builtin function dcl 72 ref 185 item 000156 automatic fixed bin(17,0) dcl 50 set ref 168* 189 k 000114 automatic fixed bin(17,0) dcl 50 set ref 93* 94 95 101 135* 136 137 143 185* 186 189 length builtin function dcl 72 ref 80 122 173 letp 000164 automatic pointer dcl 50 set ref 101* 103 143* 145 189* 191 letseg_$letseg 000054 external static fixed bin(17,0) dcl 70 set ref 78 letseg_$littles 000056 external static fixed bin(17,0) dcl 70 set ref 120 letter based structure level 1 dcl 33 letter5 based structure level 1 dcl 45 letter9 based structure level 1 dcl 39 letters based structure array level 1 dcl 30 set ref 189 letters5 based structure array level 1 dcl 42 set ref 143 letters9 based structure array level 1 dcl 36 set ref 101 linebuf 000166 automatic char(132) dcl 74 set ref 83* 103* 111 111 125* 145* 153 153 175* 191* 199 199 m 000102 automatic fixed bin(17,0) dcl 50 set ref 81* 103 112* 112 123* 145 154* 154 null builtin function dcl 72 ref 162 row 000103 automatic fixed bin(17,0) dcl 50 set ref 82* 124* 174* 191* substr builtin function dcl 72 set ref 87 103 103* 129 145 145* 179 191 191* wide 000160 automatic fixed bin(17,0) dcl 50 set ref 166* 181 181 184 190 191 191 191 writer parameter entry variable dcl 28 ref 11 111 118 153 160 199 x 000113 automatic fixed bin(17,0) dcl 50 set ref 84* 89 89* 89 92 96* 96 103 105* 105 107* 107 126* 131 131* 131 134 138* 138 145 147* 147 149* 149 176* 181 181* 181 184 191 193* 193 195* 195 xp parameter pointer dcl 208 ref 206 212 NAMES DECLARED BY EXPLICIT CONTEXT. bigletter_ 000012 constant entry external dcl 11 five 000213 constant entry external dcl 118 init 000650 constant entry external dcl 206 regular 000025 constant label dcl 78 ref 162 skip 000622 constant label dcl 197 ref 182 184 186 skip0 000165 constant label dcl 109 ref 90 92 94 97 skip1 000365 constant label dcl 151 ref 132 134 136 139 var 000413 constant entry external dcl 160 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 78 93 101 111 111 120 135 143 153 153 189 199 199 reverse builtin function ref 80 122 173 unspec builtin function ref 88 130 180 verify builtin function ref 80 122 173 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 770 1050 711 1000 Length 1224 711 60 137 56 44 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME bigletter_ 170 external procedure is an external procedure. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 big_letterp bigletter_ 000012 alphabet bigletter_ 000052 fill bigletter_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME bigletter_ 000100 i bigletter_ 000101 ii bigletter_ 000102 m bigletter_ 000103 row bigletter_ 000104 inch bigletter_ 000112 incl bigletter_ 000113 x bigletter_ 000114 k bigletter_ 000115 c bigletter_ 000116 alpha bigletter_ 000156 item bigletter_ 000157 high bigletter_ 000160 wide bigletter_ 000162 bigp bigletter_ 000164 letp bigletter_ 000166 linebuf bigletter_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_var return ext_entry_desc NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. letseg_$letseg letseg_$littles LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000006 78 000025 79 000030 80 000036 81 000054 82 000055 83 000062 84 000065 86 000067 87 000076 88 000102 89 000106 90 000113 92 000114 93 000117 94 000123 95 000124 96 000126 97 000130 100 000131 101 000136 102 000141 103 000146 105 000160 106 000161 107 000163 109 000165 111 000167 112 000204 113 000206 114 000210 118 000211 120 000226 121 000231 122 000237 123 000255 124 000256 125 000263 126 000266 128 000270 129 000277 130 000303 131 000307 132 000314 134 000315 135 000320 136 000324 137 000325 138 000327 139 000331 142 000332 143 000337 144 000341 145 000346 147 000360 148 000361 149 000363 151 000365 153 000367 154 000404 155 000406 156 000410 160 000411 162 000426 163 000433 164 000435 166 000440 167 000442 168 000444 172 000446 173 000454 174 000472 175 000501 176 000504 178 000506 179 000515 180 000521 181 000525 182 000535 184 000536 185 000542 186 000553 188 000554 189 000561 190 000567 191 000576 193 000615 194 000616 195 000620 197 000622 199 000624 201 000641 202 000643 206 000644 210 000670 211 000700 212 000705 214 000710 ----------------------------------------------------------- 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