COMPILATION LISTING OF SEGMENT gcos_read_cards_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/19/82 1001.2 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 gcos_read_cards_: proc (a_stream_name, a_test, a_eof_found, a_code); 7 8 /* ****************************************************** 9* * * 10* * * 11* * Copyright (c) 1972 by Massachusetts Institute of * 12* * Technology and Honeywell Information Systems, Inc. * 13* * * 14* * * 15* ****************************************************** */ 16 17 /* 18* 19*MODIFIED: Scott C. Akers 31 MAR 82 To make use of the snumb 20* variable in gcos_daemon_stat_, 21* rather than pass it as a 22* parameter 'twixt all and 23* sundry. 24* 25**/ 26 27 input_ptr = addr (input); /* pointer to card image */ 28 output_ptr = addr (ascii); /* pointer to ascii card image */ 29 sp = addr (status_stuff); /* pointer to returned status */ 30 31 on condition (cleanup) /* establish cleanup condition handler */ 32 call wrap_up ("1"b); 33 34 stream_name = a_stream_name; /* copy argument */ 35 code = 0; /* initialize error code */ 36 37 READ: 38 39 call get_snumb; /* read first card and check for "SNUMB" */ 40 if code > 1 /* fatal error */ 41 then go to RETURN; 42 if eof_found /* end of deck found */ 43 then go to RETURN; 44 if code = 0 /* no error occurred */ 45 then if ^snumb_found /* the card was not a SNUMB card */ 46 then call com_err_ (0, "gcos_read_cards_", "Expected SNUMB card not found"); 47 48 if (^snumb_found)| (code = 1) /* no SNUMB or error in input */ 49 then do while (^status.eof & ^eof_found); /* search for another SNUMB card */ 50 call get_snumb; 51 if code > 1 52 then go to RETURN; 53 if code = 0 54 then if (snumb_found) 55 then go to RETURN; 56 end; 57 58 RETURN: 59 60 if (code>1)| (eof_found) /* fatal error or ***eof */ 61 then call wrap_up ("0"b); 62 if ^eof_found /* no eof card yet */ 63 then go to READ; /* try again */ 64 65 a_eof_found = eof_found; /* return argument */ 66 a_code = code; /* return error code */ 67 68 return; 69 70 /* INTERNAL PROCEDURES */ 71 get_snumb: proc; 72 73 eof_found, /* initialize flags */ 74 eoc_found, 75 snumb_found = "0"b; 76 77 READ: 78 call ios_$read (stream_name, input_ptr, 0, 1, elements_read, status_stuff); /* read in a card */ 79 code = status.code; /* extract code from status bit string */ 80 if code ^= 0 /* error reading */ 81 then do; 82 call com_err_ (code, "gcos_read_cards_", "Error reading from card reader"); 83 return; 84 end; 85 if status.eof /* "last batch button" and eof */ 86 then do; 87 code = 2; /* cause return to command level */ 88 return; 89 end; 90 91 if substr (input, 10, 2) = "101"b /* this is a binary card */ 92 then return; /* it can't be a SNUMB card */ 93 94 call cv_bin_to_bcd_ (input_ptr, input_ptr, code); /* convert card image to bcd */ 95 if code ^= 0 /* error converting card */ 96 then do; 97 code = 0; /* prevents return from external procedure */ 98 return; 99 end; 100 101 call cv_bcd_to_ascii_ (input_ptr, output_ptr); 102 103 if substr (ascii, 1, 1) = "$" /* check for SNUMB card */ 104 then do; 105 if substr (ascii, 8, 5) = "snumb" 106 then do; 107 108 snumb_found = "1"b; /* got it */ 109 do i = 16 to 80 while /* find end of SNUMB */ 110 ((substr (ascii, i, 1) ^= " ")& 111 (substr (ascii, i, 1) ^= ",")); 112 end; 113 if i = 17 /* error, no SNUMB argument */ 114 then do; 115 code = 1; /* return non-fatal error */ 116 call com_err_ (0, "gcos_read_cards_", "Missing argument on SNUMB card"); 117 return; 118 end; 119 gcos_daemon_stat_$snumb = substr (ascii, 16, i-16); 120 121 if substr (ascii, i, 1) = "," /* card contains urgency field */ 122 then do; 123 do j = i + 1 to 80 while /* find end of urgency field */ 124 (substr (ascii, j, 1) ^= " "); 125 end; 126 urgency = cv_dec_check_ (substr (ascii, i+1, j-i-1), code); /* pick off urgency field */ 127 if code ^= 0 /* error converting urgency field */ 128 then do; 129 call com_err_ (0, 130 "gcos_read_cards_", 131 "Invalid urgency field: SNUMB = ^a", 132 gcos_daemon_stat_$snumb); 133 return; 134 end; 135 if (urgency < 1)| (urgency > 63) /* urgency field out of bounds */ 136 then do; 137 call com_err_ (0, 138 "gcos_read_cards_", 139 "Urgency field out of bounds: SNUMB = ^a", 140 gcos_daemon_stat_$snumb); 141 return; 142 end; 143 urgency = divide (63-urgency, 21, 17, 0)+1; /* convert to queue number */ 144 end; 145 else /* no urgency field on card */ 146 urgency = 3; /* set default urgency */ 147 148 if ^eoc_found /* more input to come */ 149 then do; /* read the job */ 150 151 call gcos_read_$cards (urgency, input_ptr, 152 addr (gcos_abs_data), eoc_found, 153 code); 154 if code ^= 0 /* error reading job */ 155 then return; 156 157 call gcos_queue_job_ (addr (gcos_abs_data), a_test, code); /* queue the job */ 158 if code ^= 0 /* error queueing job */ 159 then return; 160 161 end; 162 163 end; 164 end; 165 166 else /* not SNUMB card */ 167 if substr (ascii, 1, 6) = "***eof" /* eof card */ 168 then eof_found = "1"b; 169 170 if eoc_found /* end of input occurred */ 171 then do; 172 if ^eof_found /* ***eof card not found */ 173 then do; 174 call com_err_ (0, "gcos_read_cards_", "Unexpected eof: SNUMB = ^a", gcos_daemon_stat_$snumb); 175 code = 2; 176 end; 177 else /* ***eof card found */ 178 call ioa_ ("Normal Termination"); 179 end; 180 181 return; 182 183 end get_snumb; 184 185 wrap_up: proc (cleanup_was_signalled); 186 187 dcl cleanup_was_signalled bit (1) aligned; 188 189 if cleanup_was_signalled | code > 1 /* abort or fatal error */ 190 then do; 191 call ios_$resetread (stream_name, status_stuff); /* delete any read-ahead */ 192 code2 = status.code; 193 if code2 ^= 0 /* error deleting read-ahead */ 194 then do; 195 call com_err_ (code2, "gcos_read_cards_", "Error resetting ^a", stream_name); 196 if code <= 1 /* no fatal error occurred yet */ 197 then code = code2; /* return this one */ 198 end; 199 end; 200 201 if (code ^= 0)| (cleanup_was_signalled) /* error occurred or job was aborted */ 202 then do; 203 if gcos_daemon_stat_$snumb = "" 204 then return; 205 call hcs_$delentry_file (get_wdir_ (), 206 rtrim (gcos_daemon_stat_$snumb)||".gcos", 207 code2); 208 end; 209 210 a_eof_found = eof_found; /* return argument */ 211 212 return; 213 214 end wrap_up; 215 216 /* DECLARATIONS */ 217 /* ------------ */ 218 219 /* fixed bin */ 220 /* ----- --- */ 221 222 dcl ( 223 elements_read, /* elements read from ios_ call */ 224 i, /* random variable */ 225 j, /* ditto */ 226 urgency /* priority queues to be used */ 227 ) fixed bin aligned; 228 229 dcl ( 230 a_code, /* error code (argument) */ 231 code, /* error code (internal) */ 232 code2 /* secondary internal error code */ 233 ) fixed bin (35) aligned; 234 235 236 /* bit strings */ 237 /* --- ------- */ 238 239 dcl ( 240 a_eof_found, /* ON when last job card is read */ 241 a_test, /* ON when user brings up daemon */ 242 eoc_found, /* ON when end of read input encountered */ 243 eof_found, /* ON when last card is read */ 244 snumb_found /* ON when a SNUMB card is found */ 245 ) bit (1) aligned; 246 247 dcl ( 248 status_stuff /* returned status from ios_ calls */ 249 ) bit (72) aligned; 250 251 dcl ( 252 input /* card image */ 253 ) bit (972) aligned; 254 255 256 /* pointers */ 257 /* -------- */ 258 259 dcl ( 260 input_ptr, /* pointer to card image */ 261 output_ptr, /* pointer to ascii card image */ 262 sp /* pointer to returned status */ 263 ) pointer aligned; 264 265 266 /* character strings */ 267 /* --------- ------- */ 268 269 dcl gcos_daemon_stat_$snumb ext char (6) aligned; 270 /* dcl snumb char (8) aligned; */ 271 272 dcl ( 273 a_stream_name, /* stream name on which to read (argument) */ 274 stream_name /* same (internal) */ 275 ) char (12) aligned; 276 277 dcl ( 278 ascii /* ascii card image */ 279 ) char (80) aligned; 280 281 282 /* built in */ 283 /* ----- -- */ 284 285 dcl ( 286 addr, 287 divide, 288 index, 289 substr 290 ) builtin; 291 292 293 /* masks */ 294 /* ----- */ 295 296 dcl 1 status based (sp) aligned, /* mask for checking status from ios_ */ 297 2 code fixed bin aligned, 298 2 pad bit (9) unaligned, 299 2 eof bit (1) unaligned; 300 301 302 /* include files */ 303 /* ------- ----- */ 304 1 1 /* BEGIN gcos_abs_data include file */ 1 2 1 3 dcl abs_data_ptr ptr int static; /* pointer to absentee data */ 1 4 1 5 dcl abs_data_len int static fixed bin aligned; /* bit length of data structure */ 1 6 1 7 dcl 1 abs_data aligned based (abs_data_ptr), /* mask for data */ 1 8 2 absentee_dir char (168) aligned, /* directory to which to direct absentee output */ 1 9 2 home_dir char (168) aligned, /* home directory of absentee user */ 1 10 2 input_segment_name char (32) aligned, /* name of created input segment */ 1 11 2 user_name char (32) aligned, /* proxy name */ 1 12 2 priority_queue fixed bin aligned, /* queue number for absentee and output */ 1 13 2 absentee_options aligned, /* ON if option specified */ 1 14 3 deferral_switch bit (1) unaligned, /* ON if job deferral specified */ 1 15 2 absentee_data aligned, 1 16 3 deferral fixed bin (71) aligned, /* time job deferred to */ 1 17 2 end_abs_data fixed bin aligned; 1 18 1 19 dcl data_blank bit (abs_data_len) aligned based (abs_data_ptr); 1 20 1 21 /* END gcos_abs_data include file */ 305 306 2 1 /* BEGIN gcos_abs_data_storage include file */ 2 2 2 3 dcl 1 gcos_abs_data like abs_data; /* storage for absentee data */ 2 4 2 5 /* END gcos_abs_data_storage include file */ 307 308 309 310 /* conditions */ 311 /* ---------- */ 312 dcl ( 313 cleanup 314 )condition; 315 316 317 /* external entries */ 318 /* -------- ------- */ 319 320 dcl com_err_ ext entry 321 options (variable); 322 323 dcl cv_bcd_to_ascii_ ext entry 324 (ptr aligned, ptr aligned); 325 326 dcl cv_bin_to_bcd_ ext entry 327 (ptr aligned, ptr aligned, fixed bin (35) aligned); 328 329 dcl cv_dec_check_ ext entry 330 (char (*) aligned, fixed bin (35) aligned) returns (fixed bin aligned); 331 332 dcl gcos_queue_job_ ext entry 333 (ptr aligned, bit (1) aligned, fixed bin (35) aligned); 334 335 dcl gcos_read_$cards ext entry 336 (fixed bin aligned, ptr aligned, ptr aligned, bit (1) aligned, fixed bin (35) aligned); 337 338 dcl get_wdir_ ext entry 339 returns (char (168) aligned); 340 341 dcl hcs_$delentry_file ext entry 342 (char (*) aligned, char (*) aligned, fixed bin (35) aligned); 343 344 dcl ioa_ ext entry 345 options (variable); 346 347 dcl ios_$read ext entry 348 (char (*) aligned, ptr aligned, fixed bin aligned, fixed bin aligned, fixed bin aligned, bit (72) aligned); 349 350 dcl ios_$resetread ext entry 351 (char (*) aligned, bit (72) aligned); 352 353 354 end gcos_read_cards_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/19/82 0853.2 gcos_read_cards_.pl1 >spec>on>11/19/82>gcos_read_cards_.pl1 305 1 03/27/82 0439.3 gcos_abs_data.incl.pl1 >ldd>include>gcos_abs_data.incl.pl1 307 2 03/27/82 0439.3 gcos_abs_data_storage.incl.pl1 >ldd>include>gcos_abs_data_storage.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. a_code parameter fixed bin(35,0) dcl 229 set ref 6 66* a_eof_found parameter bit(1) dcl 239 set ref 6 65* 210* a_stream_name parameter char(12) dcl 272 ref 6 34 a_test parameter bit(1) dcl 239 set ref 6 157* abs_data based structure level 1 dcl 1-7 addr builtin function dcl 285 ref 27 28 29 151 151 157 157 ascii 000161 automatic char(80) dcl 277 set ref 28 103 105 109 109 119 121 123 126 126 166 cleanup 000360 stack reference condition dcl 312 ref 31 cleanup_was_signalled parameter bit(1) dcl 187 ref 185 189 201 code 000104 automatic fixed bin(35,0) dcl 229 in procedure "gcos_read_cards_" set ref 35* 40 44 48 51 53 58 66 79* 80 82* 87* 94* 95 97* 115* 126* 127 151* 154 157* 158 175* 189 196 196* 201 code based fixed bin(17,0) level 2 in structure "status" dcl 296 in procedure "gcos_read_cards_" ref 79 192 code2 000105 automatic fixed bin(35,0) dcl 229 set ref 192* 193 195* 196 205* com_err_ 000012 constant entry external dcl 320 ref 44 82 116 129 137 174 195 cv_bcd_to_ascii_ 000014 constant entry external dcl 323 ref 101 cv_bin_to_bcd_ 000016 constant entry external dcl 326 ref 94 cv_dec_check_ 000020 constant entry external dcl 329 ref 126 divide builtin function dcl 285 ref 143 elements_read 000100 automatic fixed bin(17,0) dcl 222 set ref 77* eoc_found 000106 automatic bit(1) dcl 239 set ref 73* 148 151* 170 eof 1(09) based bit(1) level 2 packed unaligned dcl 296 ref 48 85 eof_found 000107 automatic bit(1) dcl 239 set ref 42 48 58 62 65 73* 166* 172 210 gcos_abs_data 000206 automatic structure level 1 unaligned dcl 2-3 set ref 151 151 157 157 gcos_daemon_stat_$snumb 000010 external static char(6) dcl 269 set ref 119* 129* 137* 174* 203 205 gcos_queue_job_ 000022 constant entry external dcl 332 ref 157 gcos_read_$cards 000024 constant entry external dcl 335 ref 151 get_wdir_ 000026 constant entry external dcl 338 ref 205 205 hcs_$delentry_file 000030 constant entry external dcl 341 ref 205 i 000101 automatic fixed bin(17,0) dcl 222 set ref 109* 109 109* 113 119 121 123 126 126 126 126 input 000114 automatic bit(972) dcl 251 set ref 27 91 input_ptr 000150 automatic pointer dcl 259 set ref 27* 77* 94* 94* 101* 151* ioa_ 000032 constant entry external dcl 344 ref 177 ios_$read 000034 constant entry external dcl 347 ref 77 ios_$resetread 000036 constant entry external dcl 350 ref 191 j 000102 automatic fixed bin(17,0) dcl 222 set ref 123* 123* 126 126 output_ptr 000152 automatic pointer dcl 259 set ref 28* 101* snumb_found 000110 automatic bit(1) dcl 239 set ref 44 48 53 73* 108* sp 000154 automatic pointer dcl 259 set ref 29* 48 79 85 192 status based structure level 1 dcl 296 status_stuff 000112 automatic bit(72) dcl 247 set ref 29 77* 191* stream_name 000156 automatic char(12) dcl 272 set ref 34* 77* 191* 195* substr builtin function dcl 285 ref 91 103 105 109 109 119 121 123 126 126 166 urgency 000103 automatic fixed bin(17,0) dcl 222 set ref 126* 135 135 143* 143 145* 151* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. abs_data_len internal static fixed bin(17,0) dcl 1-5 abs_data_ptr internal static pointer dcl 1-3 data_blank based bit dcl 1-19 index builtin function dcl 285 NAMES DECLARED BY EXPLICIT CONTEXT. READ 000210 constant label dcl 37 in procedure "gcos_read_cards_" ref 62 READ 000327 constant label dcl 77 in procedure "get_snumb" RETURN 000277 constant label dcl 58 ref 40 42 51 53 gcos_read_cards_ 000137 constant entry external dcl 6 get_snumb 000323 constant entry internal dcl 71 ref 37 50 wrap_up 001117 constant entry internal dcl 185 ref 31 58 NAME DECLARED BY CONTEXT OR IMPLICATION. rtrim builtin function ref 205 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1522 1562 1333 1532 Length 2014 1333 40 216 167 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gcos_read_cards_ 332 external procedure is an external procedure. on unit on line 31 72 on unit get_snumb internal procedure shares stack frame of external procedure gcos_read_cards_. wrap_up 144 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME gcos_read_cards_ 000100 elements_read gcos_read_cards_ 000101 i gcos_read_cards_ 000102 j gcos_read_cards_ 000103 urgency gcos_read_cards_ 000104 code gcos_read_cards_ 000105 code2 gcos_read_cards_ 000106 eoc_found gcos_read_cards_ 000107 eof_found gcos_read_cards_ 000110 snumb_found gcos_read_cards_ 000112 status_stuff gcos_read_cards_ 000114 input gcos_read_cards_ 000150 input_ptr gcos_read_cards_ 000152 output_ptr gcos_read_cards_ 000154 sp gcos_read_cards_ 000156 stream_name gcos_read_cards_ 000161 ascii gcos_read_cards_ 000206 gcos_abs_data gcos_read_cards_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return enable shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cv_bcd_to_ascii_ cv_bin_to_bcd_ cv_dec_check_ gcos_queue_job_ gcos_read_$cards get_wdir_ hcs_$delentry_file ioa_ ios_$read ios_$resetread THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. gcos_daemon_stat_$snumb LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000132 27 000144 28 000146 29 000150 31 000152 34 000200 35 000207 37 000210 40 000211 42 000214 44 000216 48 000253 50 000266 51 000267 53 000272 56 000276 58 000277 62 000314 65 000316 66 000320 68 000322 71 000323 73 000324 77 000327 79 000365 80 000367 82 000370 83 000420 85 000421 87 000425 88 000427 91 000430 94 000436 95 000450 97 000452 98 000453 101 000454 103 000465 105 000471 108 000475 109 000477 112 000514 113 000516 115 000520 116 000522 117 000553 119 000554 121 000564 123 000571 125 000603 126 000605 127 000640 129 000643 133 000700 135 000701 137 000706 141 000743 143 000744 144 000751 145 000752 148 000754 151 000757 154 001000 157 001003 158 001021 164 001024 166 001025 170 001034 172 001037 174 001041 175 001076 176 001100 177 001101 181 001115 185 001116 189 001124 191 001134 192 001151 193 001154 195 001155 196 001214 201 001222 203 001231 205 001244 208 001323 210 001324 212 001330 ----------------------------------------------------------- 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