COMPILATION LISTING OF SEGMENT punch_MIT_deck Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 09/18/84 1229.4 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 7 /* ****************************************************** 8* * * 9* * * 10* * Copyright (c) 1972 by Massachusetts Institute of * 11* * Technology and Honeywell Information Systems, Inc. * 12* * * 13* * * 14* ****************************************************** */ 15 16 punch_MIT_deck: proc; 17 18 /* Punch accounting cards in the peculiar format required by MIT accounting. 19* 20* This format is.: 21* 22* cc lth variable contents 23* ----- --- -------- -------- 24* 01-03 3 - " " (formerly accounting batch number) 25* 04-09 6 voucher MIT accounting voucher number for deck (obtain from accounting) 26* 10-14 5 tacct current MIT account number for Multics account 27* 15-17 3 objcd MIT accounting object code (usually 896, computer service) 28* 18-20 3 tmon 3-letter month id 29* 21-24 4 - ", 19" 30* 25-26 2 year 2-digit year 31* 27-52 26 - " IPC MULTICS COMPUTER REQ " 32* 53-62 10 treqn current MIT requisition number for Multics account 33* 63-64 2 mm 2-digit month 34* 65-66 2 dd 2-digit day of last of month 35* 67-68 2 year 2-digit year 36* 69-77 9 dols dollars charged 37* 78-79 2 cts cents charged 38* 80 1 - "J" 39* 40* So an example of a card produced by this program is: 41* 42* " B9999979457896JUL, 1971 IPC MULTICS COMPUTER REQ 123456 07317100014732105J" 43* 44* NOTES: 45* Object code is "896", computer services, except for the following accounts: 46* 10000-11149 and 11700-13299 (outside transfer accounts) where it is "001" 47* 13565-13649 (IPC internal accounts) where it is "421" 48* 49* Voucher numbers are obtained from the accounting office just before the run. 50* 51* No blanks are allowed in cc. 63-79. 52* 53* All letters must be capital for the Multics punch DIM. 54* 55* Two cards are punched at the end with a minus punch in cc 79. 56* They represent the accounting-office credit input for our operating account 57* which will result from billing the customers. (one is for IPC use, other for paying.) 58* 59* OPERATING INSTRUCTIONS: 60* 61* 1. iocall attach cards "file_" cardfilename 62* 2. punch_MIT_deck mm dd yy Byyyyy 63* 3. iocall detach cards 64* 4. fo cards.print; p80 cardfilename; co 65* 5. dpunch1 -mcc cardfilename 66* 6. dprint1 cards.print 67* 68* HISTORY: 69* 70* Initial coding 7/71, THVV 71* Credit vouchers added 11/71, THVV 72* 001 account range corrected 6/74, JLH 73* 74* */ 75 76 dcl (i, j, k, l, m, n) fixed bin, 77 ncards fixed bin init (0), 78 requisition_total float bin init (0.0e0), 79 tout float bin init (0e0), /* total accounts 10000-11149, 11700-13299 */ 80 iptot float bin init (0e0), /* total IPC */ 81 paytot float bin init (0e0), /* total paying */ 82 cards char (32) aligned int static init ("cards"), 83 dols fixed bin, 84 cts fixed bin, 85 buf char (80) aligned, 86 objcd char (3) aligned, 87 voucher char (6) aligned, 88 tacct char (5) aligned, 89 treqn char (10) aligned, 90 xreqn char (10) aligned int static init ("CREDIT"), 91 tmon char (3) aligned, 92 (mm, dd, yy) fixed bin, 93 oreq char (12) aligned init (""), 94 oac char (12) aligned init (""), 95 ap ptr, 96 al fixed bin, 97 bchr char (al) unaligned based (ap), 98 ec fixed bin, 99 qp ptr; 100 101 dcl minus (0: 9) char (1) aligned int static init ("}", "J", "K", "L", "M", "N", "O", "P", "Q", "R"); 102 dcl month (12) char (3) aligned int static init ("JAN", "FEB", "MAR", "APR", "MAY", "JUN", 103 "JUL", "AUG", "SEP", "OCT", "NOV", "DEC"); 104 105 dcl uppercase char (26) aligned int static init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"), 106 lowercase char (26) aligned int static init ("abcdefghijklmnopqrstuvwxyz"); 107 dcl (divide, index, mod, null, substr, abs) builtin; 108 109 dcl cv_dec_check_ entry (char (*) unal, fixed bin) returns (fixed bin), 110 ioa_$rsnnl entry options (variable), 111 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin), 112 get_wdir_ entry () returns (char (168) aligned), 113 ioa_ entry options (variable), 114 ioa_$ioa_stream entry options (variable), 115 com_err_ entry options (variable), 116 hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin, 117 ptr, fixed bin), 118 hcs_$terminate_noname entry (ptr, fixed bin); 119 120 dcl punchf char (80) int static aligned init 121 ("^3x^6a^5a^3a^3a, 19^2d IPC MULTICS COMPUTER REQ ^10a^2d^2d^2d^9d^2dJ"); 122 1 1 /* Requisition file declaration */ 1 2 /* Modified BIM 1984-07-10 for unaligned strings */ 1 3 /* Modified BIM 1984-09-14 foor 3000 size-array */ 1 4 1 5 dcl 1 reqfile based (qp) aligned, /* MIT accounting data */ 1 6 2 nacts fixed, 1 7 2 version fixed bin, 1 8 2 pad (6) bit (36) aligned, 1 9 2 reqfiletab (3000), /* one entry per Multics account */ 1 10 /* same size as projfile */ 1 11 3 acctid char (12) unal, /* account id. usually same as Proj */ 1 12 3 mitacct char (12) unal, /* MIT account no. */ 1 13 3 reqno char (12) unal, /* requisition or PO no. */ 1 14 3 qflag char (8), /* class & activity */ 1 15 3 procssd fixed bin, /* temp for usage report */ 1 16 3 qdn fixed bin (71), /* date on for account */ 1 17 3 qdf fixed bin (71), /* date off */ 1 18 3 billing_name char (32) unal, /* where to send bill */ 1 19 3 billing_addr char (32) unal, 1 20 3 chg_mo float bin (63), /* charges this month */ 1 21 3 chg_tr float bin (63), /* charges this req */ 1 22 3 req_amt float bin (63), /* req face value */ 1 23 3 cutoff fixed bin (71); /* term date for req */ 1 24 1 25 dcl loqh int static fixed bin (17) init (8), /* length of reqfile head */ 1 26 loqe int static fixed bin (17) init (40); /* lth of reqfile entry */ 1 27 1 28 declare REQFILE_VERSION fixed bin init (2) int static options (constant); 1 29 1 30 /* End include file reqfile.incl.pl1 */ 123 124 125 /* =============================================== */ 126 call cu_$arg_ptr (1, ap, al, ec); 127 if ec ^= 0 then do; 128 aer: call com_err_ (0, "punch_MIT_deck", "illegal argument: mm dd yy Byyyyy"); 129 return; 130 end; 131 mm = cv_dec_check_ (bchr, ec); 132 if ec ^= 0 then go to aer; 133 if mm > 12 then go to aer; 134 if mm < 1 then go to aer; 135 call cu_$arg_ptr (2, ap, al, ec); 136 if ec ^= 0 then go to aer; 137 dd = cv_dec_check_ (bchr, ec); 138 if ec ^= 0 then go to er; 139 call cu_$arg_ptr (3, ap, al, ec); 140 if ec ^= 0 then go to aer; 141 yy = cv_dec_check_ (bchr, ec); 142 if ec ^= 0 then go to aer; 143 call cu_$arg_ptr (4, ap, al, ec); 144 if ec ^= 0 then go to aer; 145 if al ^= 6 then go to aer; 146 voucher = bchr; 147 if substr (voucher, 1, 1) = "b" then substr (voucher, 1, 1) = "B"; 148 if substr (voucher, 1, 1) = "B" then do; 149 j = cv_dec_check_ (substr (voucher, 2), ec); 150 if ec ^= 0 then go to aer; 151 end; 152 else go to aer; 153 154 tmon = month (mm); 155 156 call hcs_$initiate ((get_wdir_ ()), "reqfile", "", 0, 1, qp, ec); 157 if qp = null then do; 158 er: call com_err_ (ec, "punch_MIT_deck", "reqfile"); 159 return; 160 end; 161 162 do i = 1 to nacts; 163 if chg_mo (i) = 0 then go to skipb; 164 if acctid (i) = "" then go to skipb; 165 if reqno (i) ^= oreq | mitacct (i) ^= oac then do; 166 if oac ^= "" then call sub; 167 requisition_total = 0.0e0; 168 oreq = reqno (i); 169 oac = mitacct (i); 170 end; 171 requisition_total = requisition_total + chg_mo (i); 172 skipb: end; 173 call sub; 174 cts = 100 * (paytot + tout + 0.005e0); /* compute total billed */ 175 dols = divide (cts, 100, 17, 0); 176 cts = mod (cts, 100); 177 call ioa_$rsnnl (punchf, buf, j, voucher, "13622", "146", 178 tmon, yy, xreqn, mm, dd, yy, dols, cts); 179 do j = 63 to 79; 180 if substr (buf, j, 1) = " " then substr (buf, j, 1) = "0"; 181 end; 182 j = mod (cts, 10); 183 substr (buf, 79, 1) = minus (j); 184 call ioa_$ioa_stream (cards, "^80a", buf); 185 cts = 100 * (iptot + 0.005e0); /* compute internal charges */ 186 dols = divide (cts, 100, 17, 0); 187 cts = mod (cts, 100); 188 call ioa_$rsnnl (punchf, buf, j, voucher, "13622", "421", 189 tmon, yy, xreqn, mm, dd, yy, dols, cts); 190 do j = 63 to 79; 191 if substr (buf, j, 1) = " " then substr (buf, j, 1) = "0"; 192 end; 193 j = mod (cts, 10); 194 substr (buf, 79, 1) = minus (j); 195 call ioa_$ioa_stream (cards, "^80a", buf); 196 197 call ioa_$ioa_stream (cards, "^/"); /* run out the punch */ 198 199 call hcs_$terminate_noname (qp, ec); 200 201 call ioa_ ("Accounting deck punched, ^d cards", ncards+2); 202 call ioa_ ("Total billable $^.2f", paytot + tout); 203 204 return; 205 206 /* ------------------------------------------------------- */ 207 208 sub: proc; 209 210 if (oac <= "11149" & oac >= "10000")| 211 (oac <= "13299" & oac >= "11700") then do; /* External billing? */ 212 objcd = "001"; 213 tout = tout + requisition_total; 214 end; 215 else if oac = "nonbill" then return; 216 else if oac = "system" then return; 217 else if oac <= "13649" & oac >= "13565" then do; 218 objcd = "421"; 219 iptot = iptot + requisition_total; 220 end; 221 else do; /* paying */ 222 objcd = "896"; /* .. computer services */ 223 paytot = paytot + requisition_total; 224 end; 225 if abs(requisition_total) < 0.005e0 then return; /* skip zero charge */ 226 tacct = oac; /* length */ 227 treqn = oreq; 228 cts = 100 * (abs(requisition_total) + 0.005e0); 229 dols = divide (cts, 100, 17, 0); 230 cts = mod (cts, 100); 231 call ioa_$rsnnl (punchf, buf, j, voucher, tacct, objcd, 232 tmon, yy, treqn, mm, dd, yy, dols, cts); 233 do j = 63 to 79; /* change blanks to zero here */ 234 if substr (buf, j, 1) = "" then substr (buf, j, 1) = "0"; 235 end; 236 if requisition_total<0e0 237 then do; 238 j=mod(cts,10); 239 substr(buf,79,1)=minus(j); 240 end; 241 do j = 1 to 80; /* upshift */ 242 k = index (lowercase, substr (buf, j, 1)); 243 if k ^= 0 then substr (buf, j, 1) = substr (uppercase, k, 1); 244 end; 245 call ioa_$ioa_stream (cards, "^80a", buf); 246 ncards = ncards + 1; 247 248 end sub; 249 250 end punch_MIT_deck; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 09/18/84 0758.7 punch_MIT_deck.pl1 >special_ldd>online>09/18/84>punch_MIT_deck.pl1 123 1 09/18/84 1000.6 reqfile.incl.pl1 >special_ldd>online>09/18/84>reqfile.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. abs builtin function dcl 107 ref 225 228 acctid 10 based char(12) array level 3 packed unaligned dcl 1-5 ref 164 al 000164 automatic fixed bin(17,0) dcl 76 set ref 126* 131 131 135* 137 137 139* 141 141 143* 145 146 ap 000162 automatic pointer dcl 76 set ref 126* 131 135* 137 139* 141 143* 146 bchr based char unaligned dcl 76 set ref 131* 137* 141* 146 buf 000112 automatic char(80) dcl 76 set ref 177* 180 180* 183* 184* 188* 191 191* 194* 195* 231* 234 234* 239* 242 243* 245* cards 000010 internal static char(32) initial dcl 76 set ref 184* 195* 197* 245* chg_mo 50 based float bin(63) array level 3 dcl 1-5 ref 163 171 com_err_ 000064 constant entry external dcl 109 ref 128 158 cts 000111 automatic fixed bin(17,0) dcl 76 set ref 174* 175 176* 176 177* 182 185* 186 187* 187 188* 193 228* 229 230* 230 231* 238 cu_$arg_ptr 000054 constant entry external dcl 109 ref 126 135 139 143 cv_dec_check_ 000050 constant entry external dcl 109 ref 131 137 141 149 dd 000151 automatic fixed bin(17,0) dcl 76 set ref 137* 177* 188* 231* divide builtin function dcl 107 ref 175 186 229 dols 000110 automatic fixed bin(17,0) dcl 76 set ref 175* 177* 186* 188* 229* 231* ec 000165 automatic fixed bin(17,0) dcl 76 set ref 126* 127 131* 132 135* 136 137* 138 139* 140 141* 142 143* 144 149* 150 156* 158* 199* get_wdir_ 000056 constant entry external dcl 109 ref 156 hcs_$initiate 000066 constant entry external dcl 109 ref 156 hcs_$terminate_noname 000070 constant entry external dcl 109 ref 199 i 000100 automatic fixed bin(17,0) dcl 76 set ref 162* 163 164 165 165 168 169 171* index builtin function dcl 107 ref 242 ioa_ 000060 constant entry external dcl 109 ref 201 202 ioa_$ioa_stream 000062 constant entry external dcl 109 ref 184 195 197 245 ioa_$rsnnl 000052 constant entry external dcl 109 ref 177 188 231 iptot 000106 automatic float bin(27) initial dcl 76 set ref 76* 185 219* 219 j 000101 automatic fixed bin(17,0) dcl 76 set ref 149* 177* 179* 180 180* 182* 183 188* 190* 191 191* 193* 194 231* 233* 234 234* 238* 239 241* 242 243* k 000102 automatic fixed bin(17,0) dcl 76 set ref 242* 243 243 lowercase 000000 constant char(26) initial dcl 105 ref 242 minus 000032 constant char(1) initial array dcl 101 ref 183 194 239 mitacct 13 based char(12) array level 3 packed unaligned dcl 1-5 ref 165 169 mm 000150 automatic fixed bin(17,0) dcl 76 set ref 131* 133 134 154 177* 188* 231* mod builtin function dcl 107 ref 176 182 187 193 230 238 month 000016 constant char(3) initial array dcl 102 ref 154 nacts based fixed bin(17,0) level 2 dcl 1-5 ref 162 ncards 000103 automatic fixed bin(17,0) initial dcl 76 set ref 76* 201 246* 246 null builtin function dcl 107 ref 157 oac 000156 automatic char(12) initial dcl 76 set ref 76* 165 166 169* 210 210 210 210 215 216 217 217 226 objcd 000136 automatic char(3) dcl 76 set ref 212* 218* 222* 231* oreq 000153 automatic char(12) initial dcl 76 set ref 76* 165 168* 227 paytot 000107 automatic float bin(27) initial dcl 76 set ref 76* 174 202 223* 223 punchf 000023 internal static char(80) initial dcl 120 set ref 177* 188* 231* qp 000166 automatic pointer dcl 76 set ref 156* 157 162 163 164 165 165 168 169 171 199* reqfile based structure level 1 dcl 1-5 reqfiletab 10 based structure array level 2 dcl 1-5 reqno 16 based char(12) array level 3 packed unaligned dcl 1-5 ref 165 168 requisition_total 000104 automatic float bin(27) initial dcl 76 set ref 76* 167* 171* 171 213 219 223 225 228 236 substr builtin function dcl 107 set ref 147 147* 148 149 149 180 180* 183* 191 191* 194* 234 234* 239* 242 243* 243 tacct 000142 automatic char(5) dcl 76 set ref 226* 231* tmon 000147 automatic char(3) dcl 76 set ref 154* 177* 188* 231* tout 000105 automatic float bin(27) initial dcl 76 set ref 76* 174 202 213* 213 treqn 000144 automatic char(10) dcl 76 set ref 227* 231* uppercase 000007 constant char(26) initial dcl 105 ref 243 voucher 000140 automatic char(6) dcl 76 set ref 146* 147 147* 148 149 149 177* 188* 231* xreqn 000020 internal static char(10) initial dcl 76 set ref 177* 188* yy 000152 automatic fixed bin(17,0) dcl 76 set ref 141* 177* 177* 188* 188* 231* 231* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. REQFILE_VERSION internal static fixed bin(17,0) initial dcl 1-28 l automatic fixed bin(17,0) dcl 76 loqe internal static fixed bin(17,0) initial dcl 1-25 loqh internal static fixed bin(17,0) initial dcl 1-25 m automatic fixed bin(17,0) dcl 76 n automatic fixed bin(17,0) dcl 76 NAMES DECLARED BY EXPLICIT CONTEXT. aer 000221 constant label dcl 128 ref 132 133 134 136 140 142 144 145 148 150 er 000574 constant label dcl 158 ref 138 punch_MIT_deck 000160 constant entry external dcl 16 skipb 000716 constant label dcl 172 ref 163 164 sub 001354 constant entry internal dcl 208 ref 166 173 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2006 2100 1667 2016 Length 2320 1667 72 204 116 40 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME punch_MIT_deck 356 external procedure is an external procedure. sub internal procedure shares stack frame of external procedure punch_MIT_deck. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 cards punch_MIT_deck 000020 xreqn punch_MIT_deck 000023 punchf punch_MIT_deck STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME punch_MIT_deck 000100 i punch_MIT_deck 000101 j punch_MIT_deck 000102 k punch_MIT_deck 000103 ncards punch_MIT_deck 000104 requisition_total punch_MIT_deck 000105 tout punch_MIT_deck 000106 iptot punch_MIT_deck 000107 paytot punch_MIT_deck 000110 dols punch_MIT_deck 000111 cts punch_MIT_deck 000112 buf punch_MIT_deck 000136 objcd punch_MIT_deck 000140 voucher punch_MIT_deck 000142 tacct punch_MIT_deck 000144 treqn punch_MIT_deck 000147 tmon punch_MIT_deck 000150 mm punch_MIT_deck 000151 dd punch_MIT_deck 000152 yy punch_MIT_deck 000153 oreq punch_MIT_deck 000156 oac punch_MIT_deck 000162 ap punch_MIT_deck 000164 al punch_MIT_deck 000165 ec punch_MIT_deck 000166 qp punch_MIT_deck THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return fl2_to_fx1 mod_fx1 ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_ptr cv_dec_check_ get_wdir_ hcs_$initiate hcs_$terminate_noname ioa_ ioa_$ioa_stream ioa_$rsnnl NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 16 000157 76 000165 126 000201 127 000217 128 000221 129 000252 131 000253 132 000276 133 000300 134 000303 135 000305 136 000324 137 000326 138 000351 139 000353 140 000372 141 000374 142 000417 143 000421 144 000440 145 000442 146 000445 147 000452 148 000460 149 000464 150 000510 154 000512 156 000515 157 000570 158 000574 159 000623 162 000624 163 000633 164 000637 165 000646 166 000662 167 000667 168 000671 169 000703 171 000710 172 000716 173 000720 174 000721 175 000727 176 000731 177 000735 179 001026 180 001033 181 001042 182 001044 183 001050 184 001053 185 001076 186 001103 187 001105 188 001111 190 001202 191 001207 192 001216 193 001220 194 001224 195 001227 197 001252 199 001271 201 001302 202 001325 204 001353 208 001354 210 001355 212 001377 213 001401 214 001404 215 001405 216 001412 217 001417 218 001430 219 001432 220 001435 222 001436 223 001440 225 001443 226 001452 227 001455 228 001462 229 001467 230 001471 231 001475 233 001562 234 001567 235 001576 236 001600 238 001602 239 001606 241 001611 242 001617 243 001630 244 001635 245 001637 246 001662 248 001663 ----------------------------------------------------------- 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