COMPILATION LISTING OF SEGMENT viipunch_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.3 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 /* "Outer module" to read 7punch decks. Reads to EOF card, returns number of elements as 7* bits. See CTSS manual for 7punch format. coded by MAP, 1/70 */ 8 9 /* updated for new io switch, MAP, 3/70 */ 10 11 /* Modified by B. Greenberg 3/73 for accepting previously mispunched 12* decks, punching correct tag fields, and decimal sequence field in cols. 76-80 */ 13 /* Modified by J. Stern on 7/29/71 to add standard SDB declaration 14* and to delete "viipunch_attach" and "viipunch_detach" entry points. Common 15* attach and detach entry points for all card pseudo-DIMs are now in card_dim. */ 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 29 viipunch_read: proc (sdb_ptr, wksp, off, nel, nelt, iostatus); 30 31 dcl dsb_ptr ptr, /* pointer to stream data block */ 32 wksp ptr, /* pointer to caller's workspace */ 33 off fixed bin (24), /* offset into caller's workspace */ 34 nel fixed bin (24), /* number of elements to transmit */ 35 nelt fixed bin (24), /* number of elements actually transmitted */ 36 iostatus bit (72) aligned; /* IOS_ status bits */ 37 38 dcl last_sw bit (1) aligned, /* non-zero after reading last card */ 39 in ptr, /* input pointer */ 40 out ptr, /* output pointer */ 41 seqno fixed bin (15), /* card sequence number */ 42 nleft fixed bin (24), /* number of elements left to transfer */ 43 bad_tag_sw bit (1) aligned, /* to fix cards mangled by Padlipsky */ 44 wdct bit (12) aligned, /* word count on card */ 45 len fixed bin, /* data copy length */ 46 i fixed bin, /* iteration variable */ 47 j fixed bin, /* useful variable */ 48 len2 fixed bin, /* used for repeated data */ 49 bitcnt fixed bin (24), /* bit count of 7punch deck */ 50 same_sw bit (1) aligned, /* used to detect repeated data */ 51 number fixed bin, /* for computing sequence number field */ 52 tenth fixed bin; /* for computing sequence number field */ 53 54 dcl wks bit (nleft) unal based; /* caller's workspace */ 55 56 dcl 1 card aligned, /* 7punch card declaration */ 57 2 w0, /* first word */ 58 (3 seven bit (3), /* "111"b */ 59 3 cnthi bit (6), /* high-order word count */ 60 3 five bit (3), /* "101"b */ 61 3 cntlo bit (6), /* low-order word count */ 62 3 tag bit (3), /* non-zero on last card */ 63 3 seq bit (15)) unal, /* card sequence number */ 64 2 cksm bit (36), /* checksum */ 65 2 data bit (792), /* data words */ 66 (2 blank (3) bit (12), /* blank field */ 67 2 id (5) bit (12)) unal; /* sequence number field */ 68 69 dcl error_table_$eof_record ext fixed bin(35); 70 71 dcl ios_$read entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned), 72 ios_$write entry (char (*) aligned, ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned), 73 com_err_ entry options (variable), 74 check_cd entry (ptr) returns (bit (36) aligned); 75 76 dcl (addr, divide, bin, bit, length, min, string, substr, unspec) builtin; 77 78 79 /* */ 80 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 81 82 83 /* */ 84 85 iostatus = "0"b; /* Clear status bits. */ 86 in = addr (card); /* Set input pointer to card image. */ 87 out = addr (substr (wksp -> wks, off+1)); /* Set output pointer into caller's workspace. */ 88 nelt = 0; /* Initialize count of elements transmitted. */ 89 90 last_sw = "0"b; /* Clear last card switch. */ 91 seqno = 0; /* Initialize card sequence number. */ 92 nleft = nel; /* Get number of elements remaining to be transmitted. */ 93 94 do while (nleft > 0); /* Loop, reading cards. */ 95 call read_7_card; /* Read and check a card. */ 96 97 if seqno = 0 then if card.tag then /* If first card ... */ 98 bad_tag_sw = "1"b; /* It should not have non-zero tag. */ 99 else 100 bad_tag_sw = "0"b; 101 102 wdct = card.cnthi || card.cntlo; /* Get word count. */ 103 len = min (bin (wdct, 12) * 36, nleft); /* Compute elements to be taken from card. */ 104 105 if len = 0 then /* If zero word count ... */ 106 if card.tag = "011"b then do; /* If this is a bit count card ... */ 107 nelt = bin (substr (card.data, 1, 36), 35); 108 last_sw = "1"b; /* Return correct element count and set switch. */ 109 end; 110 else if bad_tag_sw | (card.tag = "000"b) then do; 111 call com_err_ (0, "viipunch_read", "Zero word count on card ^d.", seqno); 112 go to error_return; /* Should never have zero word count otherwise. */ 113 end; 114 else; 115 116 else if len <= length (card.data) then /* If data is on card ... */ 117 substr (out -> wks, 1, len) = card.data;/* Copy it into caller's workspace. */ 118 119 else do j = 0 to len by 36; /* Otherwise, copy repeated word. */ 120 len2 = min (36, len - j); /* Compute elements to transfer. */ 121 substr (out -> wks, j+1, len2) = card.data; 122 end; /* Copy single word. */ 123 124 nleft = nleft - len; /* Decrement count of elements left. */ 125 out = addr (substr (out -> wks, len+1)); /* Bump pointer into caller's workspace. */ 126 nelt = nelt + len; /* Return count of elements transmitted so far. */ 127 128 if ^bad_tag_sw then /* If not ignoring bad tags ... */ 129 if card.tag & "001"b then /* If card has non-zero tag ... */ 130 last_sw = "1"b; /* Set last card switch. */ 131 132 seqno = seqno + 1; /* Bump card sequence number. */ 133 end; 134 135 return; 136 137 138 /* */ 139 140 read_7_card: proc; 141 142 call ios_$read (stream, in, 0, 1, j, iostatus); /* Read one card. */ 143 if substr (iostatus, 1, 36) & substr(iostatus, 1, 36) ^= unspec(error_table_$eof_record) then do; 144 bad_read: substr (iostatus, 46, 1) = "0"b; /* Clear this bit. */ 145 go to error_return; /* And take error return. */ 146 end; 147 148 if j = 0 then /* If no elements were read ... */ 149 if substr (iostatus, 46, 1) then /* Did we get an EOF? */ 150 if last_sw then /* Was it expected? */ 151 go to reof; /* If so, transfer. */ 152 else do; /* Unexpected EOF. */ 153 call com_err_ (0, "viipunch_read", "Premature EOF after card ^d.", seqno - 1); 154 go to bad_read; 155 end; 156 else go to bad_read; /* Read zero cards. */ 157 158 if last_sw then do; /* Should have gotten EOF after last read. */ 159 call com_err_ (0, "viipunch_read", "Missing EOF after card ^d.", seqno - 1); 160 go to bad_read; 161 end; 162 163 if card.seven ^= "111"b | card.five ^= "101"b then do; 164 call com_err_ (0, "viipunch_read", "Non 7-punched card after card ^d.", seqno - 1); 165 go to bad_read; 166 end; 167 168 if bin (card.seq, 15) ^= seqno then do; /* If sequence error ... */ 169 call com_err_ (0, "viipunch_read", "Card sequence error. Expected ^d; read ^d.", seqno, bin (card.seq, 15)); 170 go to bad_read; 171 end; 172 173 if card.cksm then /* If checksum is not blank ... */ 174 if card.cksm ^= check_cd (in) then do; /* Compre against computed checksum. */ 175 call com_err_ (0, "viipunch_read", "Checksum error on card ^d.", seqno); 176 go to bad_read; 177 end; 178 179 return; 180 181 182 end read_7_card; 183 184 185 /* */ 186 187 viipunch_write: entry (sdb_ptr, wksp, off, nel, nelt, iostatus); 188 189 iostatus = "0"b; /* Clear status bits. */ 190 out = addr (card); /* Set output pointer. */ 191 in = addr (substr (wksp -> wks, off+1)); /* Set input pointer. */ 192 nelt = 0; /* Initialize count of elements transmitted. */ 193 194 string (card.w0) = "0"b; /* Clear first word in card image. */ 195 card.seven = "111"b; /* Set 7punch bits. */ 196 card.five = "101"b; /* Set 7-9 punch. */ 197 string (card.blank) = "0"b; /* Clear blank field. */ 198 199 seqno = 0; /* Initialize sequence number. */ 200 bitcnt, nleft = nel; /* Set number of elements remaining to be transmitted. */ 201 202 do while (nleft > 0); /* Iterate until all elements processed. */ 203 len = min (length (card.data), nleft); /* Compute number of elements to process. */ 204 card.data = substr (in -> wks, 1, len); /* Copy the data. */ 205 in = addr (substr (in -> wks, len+1)); /* Bump input pointer. */ 206 nleft = nleft - len; /* Decrement elements remaining to be transmitted. */ 207 208 if substr (card.data, 1, length (card.data)-36) = substr (card.data, 37) then do; 209 same_sw = "1"b; /* If data is replicated on card ... */ 210 do while (same_sw & (nleft > 0)); /* Search to end of replication. */ 211 len2 = min (36, nleft); /* Compute number of elements to test. */ 212 if substr (in -> wks, 1, len2) = substr (card.data, 1, 36) then do; 213 len = len + len2; /* Data still replicated. Skip over it. */ 214 in = addr (substr (in -> wks, len2+1)); 215 nleft = nleft - len2; 216 end; 217 else /* Data no longer replicated. */ 218 same_sw = "0"b; /* Clear replication switch. */ 219 end; 220 end; 221 222 wdct = bit (divide (len + 35, 36, 12, 0)); /* Compute word count for card. */ 223 card.cnthi = wdct; /* Set high order part of word count. */ 224 card.cntlo = substr (wdct, 7); /* And low order part. */ 225 226 call write_7_card; /* Write out the card. */ 227 228 nelt = nelt + len; /* Bump elements transmitted. */ 229 end; 230 231 card.cnthi, card.cntlo = "0"b; /* Clear word count. */ 232 card.data = bit (bin (bitcnt, 36)); /* Set bitcount on card. */ 233 card.tag = "011"b; /* Set tag indicating bitcount card. */ 234 235 call write_7_card; /* Write out the bit count card. */ 236 237 return; 238 239 240 /* */ 241 242 write_7_card: proc; 243 244 card.seq = bit (bin (seqno, 15)); /* Set the sequence number on card. */ 245 246 card.cksm = check_cd (out); /* Insert the checksum. */ 247 248 number = seqno; /* Set sequence number for ID field. */ 249 string (card.id) = "0"b; /* Clear the ID field. */ 250 do i = 5 to 1 by -1; /* Convert each digit to column binary representation. */ 251 tenth = divide (number, 10, 17, 0); /* Compute number of 10's. */ 252 j = number - tenth * 10; /* Get a digit. */ 253 substr (card.id (i), j+3, 1) = "1"b; /* Insert correct column binary bit. */ 254 number = tenth; /* Iterate for next digit. */ 255 end; 256 257 call ios_$write (stream, out, 0, 1, j, iostatus); /* Write out the card image. */ 258 if substr (iostatus, 1, 36) | j = 0 then do; /* Check for error. */ 259 substr (iostatus, 46, 1) = "0"b; 260 go to error_return; 261 end; 262 263 seqno = seqno + 1; /* Bump card sequence number. */ 264 265 return; 266 267 268 end write_7_card; 269 270 271 /* */ 272 273 error_return: 274 reof: 275 return; 276 277 278 /* */ 279 280 viipunch_getsize: entry (sdb_ptr, elsize, iostatus); 281 282 dcl elsize fixed bin; /* element size */ 283 284 285 iostatus = "0"b; /* Clear status bits. */ 286 287 elsize = 1; /* Element size is 1 bit. */ 288 289 return; 290 291 292 293 end viipunch_read; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1458.4 viipunch_dim.pl1 >dumps>old>recomp>viipunch_dim.pl1 81 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. SDB based structure level 1 dcl 1-6 addr builtin function dcl 76 ref 86 87 125 190 191 205 214 bad_tag_sw 000110 automatic bit(1) dcl 38 set ref 97* 99* 110 128 bin builtin function dcl 76 ref 103 107 168 169 169 232 244 bit builtin function dcl 76 ref 222 232 244 bitcnt 000116 automatic fixed bin(24,0) dcl 38 set ref 200* 232 blank 30 000122 automatic bit(12) array level 2 packed unaligned dcl 56 set ref 197* card 000122 automatic structure level 1 dcl 56 set ref 86 190 check_cd 000020 constant entry external dcl 71 ref 173 246 cksm 1 000122 automatic bit(36) level 2 dcl 56 set ref 173 173 246* cnthi 0(03) 000122 automatic bit(6) level 3 packed unaligned dcl 56 set ref 102 223* 231* cntlo 0(12) 000122 automatic bit(6) level 3 packed unaligned dcl 56 set ref 102 224* 231* com_err_ 000016 constant entry external dcl 71 ref 111 153 159 164 169 175 data 2 000122 automatic bit(792) level 2 dcl 56 set ref 107 116 116 121 203 204* 208 208 208 212 232* divide builtin function dcl 76 ref 222 251 elsize parameter fixed bin(17,0) dcl 282 set ref 280 287* error_table_$eof_record 000010 external static fixed bin(35,0) dcl 69 ref 143 five 0(09) 000122 automatic bit(3) level 3 packed unaligned dcl 56 set ref 163 196* i 000113 automatic fixed bin(17,0) dcl 38 set ref 250* 253* id 31 000122 automatic bit(12) array level 2 packed unaligned dcl 56 set ref 249* 253* in 000102 automatic pointer dcl 38 set ref 86* 142* 173* 191* 204 205* 205 212 214* 214 ios_$read 000012 constant entry external dcl 71 ref 142 ios_$write 000014 constant entry external dcl 71 ref 257 iostatus parameter bit(72) dcl 31 set ref 29 85* 142* 143 143 144* 148 187 189* 257* 258 259* 280 285* j 000114 automatic fixed bin(17,0) dcl 38 set ref 119* 120 121* 142* 148 252* 253 257* 258 last_sw 000100 automatic bit(1) dcl 38 set ref 90* 108* 128* 148 158 len 000112 automatic fixed bin(17,0) dcl 38 set ref 103* 105 116 116 119 120 124 125 126 203* 204 205 206 213* 213 222 228 len2 000115 automatic fixed bin(17,0) dcl 38 set ref 120* 121 211* 212 213 214 215 length builtin function dcl 76 ref 116 203 208 min builtin function dcl 76 ref 103 120 203 211 nel parameter fixed bin(24,0) dcl 31 ref 29 92 187 200 nelt parameter fixed bin(24,0) dcl 31 set ref 29 88* 107* 126* 126 187 192* 228* 228 nleft 000107 automatic fixed bin(24,0) dcl 38 set ref 87 92* 94 103 116 121 124* 124 125 191 200* 202 203 204 205 206* 206 210 211 212 214 215* 215 number 000120 automatic fixed bin(17,0) dcl 38 set ref 248* 251 252 254* off parameter fixed bin(24,0) dcl 31 ref 29 87 187 191 out 000104 automatic pointer dcl 38 set ref 87* 116 121 125* 125 190* 246* 257* same_sw 000117 automatic bit(1) dcl 38 set ref 209* 210 217* sdb_ptr parameter pointer dcl 1-4 ref 29 142 187 257 280 seq 0(21) 000122 automatic bit(15) level 3 packed unaligned dcl 56 set ref 168 169 169 244* seqno 000106 automatic fixed bin(15,0) dcl 38 set ref 91* 97 111* 132* 132 153 159 164 168 169* 175* 199* 244 248 263* 263 seven 000122 automatic bit(3) level 3 packed unaligned dcl 56 set ref 163 195* stream 15 based char(32) level 3 dcl 1-6 set ref 142* 257* stream_name 12 based structure level 2 dcl 1-6 string builtin function dcl 76 set ref 194* 197* 249* substr builtin function dcl 76 set ref 87 107 116* 121* 125 143 143 144* 148 191 204 205 208 208 212 212 214 224 253* 258 259* tag 0(18) 000122 automatic bit(3) level 3 packed unaligned dcl 56 set ref 97 105 110 128 233* tenth 000121 automatic fixed bin(17,0) dcl 38 set ref 251* 252 254 unspec builtin function dcl 76 ref 143 w0 000122 automatic structure level 2 dcl 56 set ref 194* wdct 000111 automatic bit(12) dcl 38 set ref 102* 103 222* 223 224 wks based bit unaligned dcl 54 set ref 87 116* 121* 125 191 204 205 212 214 wksp parameter pointer dcl 31 ref 29 87 187 191 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. dsb_ptr automatic pointer dcl 31 NAMES DECLARED BY EXPLICIT CONTEXT. bad_read 000623 constant label dcl 144 ref 148 154 160 165 170 176 error_return 000526 constant label dcl 273 ref 112 145 260 read_7_card 000553 constant entry internal dcl 140 ref 95 reof 000526 constant label dcl 273 set ref 148 viipunch_getsize 000533 constant entry external dcl 280 viipunch_read 000114 constant entry external dcl 29 viipunch_write 000342 constant entry external dcl 187 write_7_card 001137 constant entry internal dcl 242 ref 226 235 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1412 1434 1277 1422 Length 1630 1277 22 157 112 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME viipunch_read 246 external procedure is an external procedure. read_7_card internal procedure shares stack frame of external procedure viipunch_read. write_7_card internal procedure shares stack frame of external procedure viipunch_read. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME viipunch_read 000100 last_sw viipunch_read 000102 in viipunch_read 000104 out viipunch_read 000106 seqno viipunch_read 000107 nleft viipunch_read 000110 bad_tag_sw viipunch_read 000111 wdct viipunch_read 000112 len viipunch_read 000113 i viipunch_read 000114 j viipunch_read 000115 len2 viipunch_read 000116 bitcnt viipunch_read 000117 same_sw viipunch_read 000120 number viipunch_read 000121 tenth viipunch_read 000122 card viipunch_read THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. check_cd com_err_ ios_$read ios_$write THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$eof_record LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 29 000106 85 000124 86 000127 87 000131 88 000136 90 000137 91 000140 92 000141 94 000143 95 000145 97 000146 99 000156 102 000157 103 000171 105 000177 107 000207 108 000213 109 000215 110 000216 111 000222 112 000257 114 000260 116 000261 119 000270 120 000275 121 000303 122 000310 124 000313 125 000315 126 000321 128 000324 132 000335 133 000336 135 000337 187 000340 189 000352 190 000356 191 000360 192 000366 194 000367 195 000370 196 000372 197 000376 199 000377 200 000400 202 000403 203 000405 204 000411 205 000415 206 000420 208 000422 209 000427 210 000431 211 000435 212 000441 213 000446 214 000447 215 000452 216 000454 217 000455 219 000456 222 000457 223 000467 224 000473 226 000476 228 000477 229 000502 231 000503 232 000507 233 000520 235 000524 237 000525 273 000526 280 000527 285 000543 287 000547 289 000552 140 000553 142 000554 143 000615 144 000623 145 000626 148 000627 153 000637 154 000676 158 000677 159 000701 160 000740 163 000741 164 000752 165 001011 168 001012 169 001020 170 001062 173 001063 175 001100 176 001135 179 001136 242 001137 244 001140 246 001147 248 001160 249 001162 250 001165 251 001172 252 001175 253 001202 254 001212 255 001214 257 001217 258 001260 259 001264 260 001267 263 001270 265 001271 ----------------------------------------------------------- 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