COMPILATION LISTING OF SEGMENT mcc_dim Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1558.4 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 /* "Outer module" to read Multics card codes. Major facelifting of a Ken Thompson original by MAP, 12/69. 7* Deals only with character (9 bit) elements; if 80 or less requested, will read one card; if >80 requested, 8* will read number of cards necessary to get nel. Assumes reader attached. . */ 9 10 /* Last modified by J. Stern on 7/29/71 to add standard SDB declaration 11* and to delete "mcc_attach" and "mcc_detach" entry points. Common 12* attach and detach entry points for all card pseudo-DIMs are now in raw_dim. */ 13 14 15 /* Rewritten 6/27/75 by Noel I. Morris */ 16 17 18 /* ****************************************************** 19* * * 20* * * 21* * Copyright (c) 1972 by Massachusetts Institute of * 22* * Technology and Honeywell Information Systems, Inc. * 23* * * 24* * * 25* ****************************************************** */ 26 27 28 mcc_read: proc (sdb_ptr, wksp, off, nel, nelt, iostatus); 29 30 dcl wksp ptr, /* ptr to caller's workspace */ 31 off fixed bin, /* offset of data */ 32 nel fixed bin, /* number of elements to transmit */ 33 nelt fixed bin, /* number actually transmitted */ 34 iostatus bit (72) aligned; /* status bits */ 35 36 dcl i fixed bin, /* index */ 37 code fixed bin (35), /* error code */ 38 j fixed bin, /* count of cards punched or read */ 39 cardx fixed bin, 40 in ptr, /* input pointer */ 41 out ptr, /* output pointer */ 42 len fixed bin, /* length of caller's string */ 43 nleft fixed bin, /* number of characters left to transmit */ 44 character char (1) aligned, /* single ASCII character */ 45 num fixed bin, /* translation table index */ 46 zone fixed bin (3), /* zone bits */ 47 one_seven bit (7) aligned, /* rows 1 thru 7 */ 48 eight_nine fixed bin (2), /* rows 8 and 9 */ 49 illeg_char bit (1) aligned, /* "1"b if illegal character code read */ 50 NL char (1) static init (" 51 "); 52 53 dcl 1 raw aligned, /* raw column binary card image */ 54 2 col (1:80) bit (12) unal, /* 80 columns */ 55 2 pad bit (12) unal; /* padding to word boundary */ 56 57 dcl card_image char (80) ; /* ASCII card image */ 58 59 dcl wks char (nleft) based unal; /* used to reference caller's workspace */ 60 61 dcl card_codes_$mcc_reader_codes (0:255) char (1) unal ext, /* reader translation table */ 62 card_codes_$mcc_punch_codes (0:127) bit (12) unal ext, /* punch translation table */ 63 error_table_$eof_record fixed bin (35) ext, 64 error_table_$short_record fixed bin (35) ext; 65 66 dcl ios_$read entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned), 67 ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned); 68 69 dcl (addr, bin, index, min, substr, unspec, length, divide) builtin; 70 71 /* */ 72 1 1 1 2 /* Begin include file ...... card_sdb.incl.pl1 */ 1 3 1 4 dcl sdb_ptr ptr; /* pointer to stream data block */ 1 5 1 6 dcl 1 SDB aligned based (sdb_ptr), 1 7 2 outer_module_name char (32), 1 8 2 attachment_list_ptr ptr, /* ptr to list of stream names to which this SDB is attached */ 1 9 2 stream_name, 1 10 3 next_stream_ptr ptr, /* always null, single attachments only */ 1 11 3 name_size fixed bin (17), /* length of stream name */ 1 12 3 stream char (32), /* the stream to which this SDB is attached */ 1 13 2 areaptr ptr, /* pointer to allocation area for SDB */ 1 14 2 modes bit (36); /* mode bits */ 1 15 1 16 /* End of include file ...... card_sdb.incl.pl1 */ 1 17 73 74 75 /* */ 76 77 iostatus = "0"b; /* Clear status bits. */ 78 in = addr (raw); /* Set input pointer. */ 79 out = addr (substr (wksp -> wks, off+1)); /* Get pointer into caller's workspace. */ 80 nelt = 0; /* Initialize number of chars xmitted. */ 81 nleft = nel; 82 83 do cardx = 1 to divide (nel + 79, 80, 17, 0); 84 85 86 /* Read a card. */ 87 88 call ios_$read (stream, in, 0, 1, j, iostatus); /* Read a card. */ 89 if substr (iostatus, 1, 36) & substr (iostatus, 1, 36) ^= unspec (error_table_$eof_record) then do; 90 bad_read: substr (iostatus, 46, 1) = "0"b; /* Make sure trouble is noticed */ 91 return; 92 end; 93 94 if j = 0 then /* If nothing was read ... */ 95 if substr (iostatus, 46, 1) then return; 96 else go to bad_read; 97 98 99 /* Convert column binary to ASCII card image. */ 100 101 card_image = ""; /* initialize to all blank */ 102 do i = 1 to 80; /* Process 80 columns. */ 103 zone = bin (substr (raw.col (i), 1, 3), 3); /* Get zone bits. */ 104 one_seven = substr (raw.col (i), 4, 7); /* Get rows 1 thru 7. */ 105 eight_nine = bin (substr (raw.col (i), 11, 2)); /* Get rows 8 and 9. */ 106 107 illeg_char = "0"b; /* Clear illegal punch flag. */ 108 109 if one_seven then do; /* If any punches in rows 1 thru 7 ... */ 110 num = index (one_seven, "1"b); /* Look for a punch. */ 111 if substr (one_seven, num+1) then /* Must only be one punch. */ 112 illeg_char = "1"b; /* Otherwise, punch is illegal. */ 113 else 114 num = 8 - num; /* Compute index from punch. */ 115 end; 116 else /* If no punches in rows 1 thru 7 ... */ 117 num = 0; /* Index is 0. */ 118 119 if illeg_char then /* If punch was illegal ... */ 120 unspec (character) = (9)"1"b; /* Use ASCII 777 for this case. */ 121 else do; 122 num = (zone * 8 + num) * 4 + eight_nine; 123 /* Compute index from punches. */ 124 character = card_codes_$mcc_reader_codes (num); 125 end; /* Get correct character from table. */ 126 substr (card_image, i, 1) = character; /* Insert character in ASCII card image. */ 127 end; 128 129 len = length (card_image); 130 131 /* Copy card image into caller's workspace. */ 132 133 len = min (len, nleft); /* Copy as much as caller has room for. */ 134 substr (out -> wks, 1, len) = card_image; /* Copy the card image. */ 135 nelt = nelt + len; /* Count these chars as being transmitted. */ 136 nleft = nleft - len; 137 out = addr (substr (out -> wks, len+1)); /* Step output pointer. */ 138 end; 139 if nel ^= nelt then substr (iostatus, 1, 36) = unspec (error_table_$short_record); 140 return; 141 142 143 mcc_write: entry (sdb_ptr, wksp, off, nel, nelt, iostatus); 144 145 iostatus = "0"b; /* Clear status bits. */ 146 out = addr (raw); /* Set output pointer. */ 147 in = addr (substr (wksp -> wks, off+1)); /* Get pointer into caller's workspace. */ 148 nelt = 0; /* Clear count of chars transferred. */ 149 150 raw.pad = "0"b; /* Clear padding in column binary card image. */ 151 152 do nleft = nel repeat nleft - len while (nleft > 0); /* Process characters until exhausted. */ 153 154 155 /* Examine input to get a line or 80 characters, whichever is shortest. */ 156 157 i = index (in -> wks, NL); /* Search for end of line in input. */ 158 if i = 0 then /* If no NL can be found ... */ 159 i, len = min (80, nleft); /* Take up to 80 characters. */ 160 else if i > 81 then /* If line too long ... */ 161 i, len = 80; /* Take only 80 characters. */ 162 else do; 163 len = i; /* NL can be no further than 81 chars into string. */ 164 i = len - 1; /* We do not copy the NL. */ 165 end; 166 167 168 /* Copy the input and convert to column binary card image. */ 169 170 card_image = (81)" "; /* initialize to all blank */ 171 card_image = substr (in -> wks, 1, i); /* Copy up to but not including NL. */ 172 173 do i = 1 to 80; /* Process each column. */ 174 character = substr (card_image, i, 1); /* Extract a character. */ 175 num = bin (unspec (character), 9); /* Convert to binary integer. */ 176 raw.col (i) = card_codes_$mcc_punch_codes (num); 177 end; /* Look up and insert column binary punches. */ 178 179 180 /* Write out the card and step to next one. */ 181 182 call ios_$write (stream, out, 0, 1, j, iostatus); /* Write out the card. */ 183 if substr (iostatus, 1, 36) ^= "0"b | j = 0 then do; /* If error ... */ 184 substr (iostatus, 46, 1) = "0"b; 185 return; 186 end; 187 188 nelt = nelt + len; /* Increment count of characters transferred. */ 189 in = addr (substr (in -> wks, len+1)); /* Step pointer to next line. */ 190 end; 191 192 return; 193 194 mcc_getsize: entry (sdb_ptr, el_size, iostatus); 195 dcl el_size fixed bin; 196 197 iostatus = "0"b; /* Clear status bits. */ 198 199 el_size = 9; /* Size is 9 bits. */ 200 201 return; 202 203 204 205 mcc_changemode: entry (sdb_ptr, new_mode, old_mode, iostatus); 206 207 dcl new_mode char (*), /* new mode setting */ 208 old_mode char (*); /* old mode setting */ 209 210 211 old_mode = ""; 212 iostatus = "0"b; 213 214 215 return; 216 217 218 219 end mcc_read; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1458.5 mcc_dim.pl1 >dumps>old>recomp>mcc_dim.pl1 73 1 09/09/75 1333.7 card_sdb.incl.pl1 >ldd>include>card_sdb.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. NL constant char(1) initial unaligned dcl 36 ref 157 SDB based structure level 1 dcl 1-6 addr builtin function dcl 69 ref 78 79 137 146 147 189 bin builtin function dcl 69 ref 103 105 175 card_codes_$mcc_punch_codes 000012 external static bit(12) array unaligned dcl 61 ref 176 card_codes_$mcc_reader_codes 000010 external static char(1) array unaligned dcl 61 ref 124 card_image 000153 automatic char(80) unaligned dcl 57 set ref 101* 126* 129 134 170* 171* 174 cardx 000102 automatic fixed bin(17,0) dcl 36 set ref 83* character 000112 automatic char(1) dcl 36 set ref 119* 124* 126 174* 175 col 000120 automatic bit(12) array level 2 packed unaligned dcl 53 set ref 103 104 105 176* divide builtin function dcl 69 ref 83 eight_nine 000116 automatic fixed bin(2,0) dcl 36 set ref 105* 122 el_size parameter fixed bin(17,0) dcl 195 set ref 194 199* error_table_$eof_record 000014 external static fixed bin(35,0) dcl 61 ref 89 error_table_$short_record 000016 external static fixed bin(35,0) dcl 61 ref 139 i 000100 automatic fixed bin(17,0) dcl 36 set ref 102* 103 104 105 126* 157* 158 158* 160 160* 163 164* 171 173* 174 176* illeg_char 000117 automatic bit(1) dcl 36 set ref 107* 111* 119 in 000104 automatic pointer dcl 36 set ref 78* 88* 147* 157 171 189* 189 index builtin function dcl 69 ref 110 157 ios_$read 000020 constant entry external dcl 66 ref 88 ios_$write 000022 constant entry external dcl 66 ref 182 iostatus parameter bit(72) dcl 30 set ref 28 77* 88* 89 89 90* 94 139* 143 145* 182* 183 184* 194 197* 205 212* j 000101 automatic fixed bin(17,0) dcl 36 set ref 88* 94 182* 183 len 000110 automatic fixed bin(17,0) dcl 36 set ref 129* 133* 133 134 135 136 137 158* 160* 163* 164 188 189 190 length builtin function dcl 69 ref 129 min builtin function dcl 69 ref 133 158 nel parameter fixed bin(17,0) dcl 30 ref 28 81 83 139 143 152 nelt parameter fixed bin(17,0) dcl 30 set ref 28 80* 135* 135 139 143 148* 188* 188 new_mode parameter char unaligned dcl 207 ref 205 nleft 000111 automatic fixed bin(17,0) dcl 36 set ref 79 81* 133 134 136* 136 137 147 152* 152* 157 158 171 189* 190 num 000113 automatic fixed bin(17,0) dcl 36 set ref 110* 111 113* 113 116* 122* 122 124 175* 176 off parameter fixed bin(17,0) dcl 30 ref 28 79 143 147 old_mode parameter char unaligned dcl 207 set ref 205 211* one_seven 000115 automatic bit(7) dcl 36 set ref 104* 109 110 111 out 000106 automatic pointer dcl 36 set ref 79* 134 137* 137 146* 182* pad 32(24) 000120 automatic bit(12) level 2 packed unaligned dcl 53 set ref 150* raw 000120 automatic structure level 1 dcl 53 set ref 78 146 sdb_ptr parameter pointer dcl 1-4 ref 28 88 143 182 194 205 stream 15 based char(32) level 3 dcl 1-6 set ref 88* 182* stream_name 12 based structure level 2 dcl 1-6 substr builtin function dcl 69 set ref 79 89 89 90* 94 103 104 105 111 126* 134* 137 139* 147 171 174 183 184* 189 unspec builtin function dcl 69 set ref 89 119* 139 175 wks based char unaligned dcl 59 set ref 79 134* 137 147 157 171 189 wksp parameter pointer dcl 30 ref 28 79 143 147 zone 000114 automatic fixed bin(3,0) dcl 36 set ref 103* 122 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. code automatic fixed bin(35,0) dcl 36 NAMES DECLARED BY EXPLICIT CONTEXT. bad_read 000122 constant label dcl 90 ref 94 mcc_changemode 000542 constant entry external dcl 205 mcc_getsize 000515 constant entry external dcl 194 mcc_read 000016 constant entry external dcl 28 mcc_write 000302 constant entry external dcl 143 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 732 756 602 742 Length 1150 602 24 155 130 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME mcc_read 162 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME mcc_read 000100 i mcc_read 000101 j mcc_read 000102 cardx mcc_read 000104 in mcc_read 000106 out mcc_read 000110 len mcc_read 000111 nleft mcc_read 000112 character mcc_read 000113 num mcc_read 000114 zone mcc_read 000115 one_seven mcc_read 000116 eight_nine mcc_read 000117 illeg_char mcc_read 000120 raw mcc_read 000153 card_image mcc_read THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_ne_as call_ext_out_desc return ext_entry ext_entry_desc index_bs_1_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ios_$read ios_$write THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. card_codes_$mcc_punch_codes card_codes_$mcc_reader_codes error_table_$eof_record error_table_$short_record LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 28 000010 77 000026 78 000031 79 000033 80 000040 81 000041 83 000043 88 000053 89 000114 90 000122 91 000125 94 000126 101 000135 102 000140 103 000145 104 000155 105 000161 107 000167 109 000170 110 000172 111 000177 113 000211 115 000213 116 000214 119 000215 122 000222 124 000230 126 000236 127 000242 129 000244 133 000246 134 000252 135 000256 136 000260 137 000262 138 000266 139 000270 140 000277 143 000300 145 000312 146 000316 147 000320 148 000326 150 000327 152 000331 157 000335 158 000347 160 000357 163 000365 164 000366 170 000370 171 000373 173 000376 174 000403 175 000407 176 000412 177 000424 182 000426 183 000467 184 000473 185 000476 188 000477 189 000502 190 000505 192 000510 194 000511 197 000525 199 000531 201 000534 205 000535 211 000565 212 000573 215 000577 ----------------------------------------------------------- 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