COMPILATION LISTING OF SEGMENT l6_tran_receive_file_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 07/21/83 1205.4 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 /*****************************************************************************/ 7 /* */ 8 /* DESCRIPTION: */ 9 /* */ 10 /* This subroutine does all the work necessary to receive a file from */ 11 /* the Level 6. It is used by the l6_tran_ NASP and l6_tran_overseer_. */ 12 /* */ 13 /* */ 14 /* JOURNALIZATION: */ 15 /* */ 16 /* 1) Written 5/82 by R.J.C. Kissel. */ 17 /* 2) Modified 7/83 by R.J.C. Kissel to fix an error message sent to the L6*/ 18 /* */ 19 /*****************************************************************************/ 20 21 /* format: style3,linecom,ifthenstmt,indthenelse,^indnoniterdo,indnoniterend,initcol3,dclind5,idind32 */ 22 23 l6_tran_receive_file_: 24 proc (P_input_args_ptr, P_output_args_ptr, P_error_message, P_code); 25 26 /* Parameters */ 27 28 dcl P_input_args_ptr ptr parameter; 29 dcl P_output_args_ptr ptr parameter; 30 dcl P_error_message char (*) varying parameter; 31 dcl P_code fixed bin (35) parameter; 32 33 /* Automatic */ 34 35 dcl comm_buffer char (comm_buffer_len) based (comm_buffer_ptr); 36 dcl comm_buffer_len fixed bin (21); 37 dcl comm_buffer_ptr ptr; 38 dcl comm_buffer_position fixed bin (21); 39 40 dcl char_position_in_tu fixed bin (21); 41 dcl code fixed bin (35); 42 dcl end_of_file bit (1); 43 44 dcl file_buffer char (file_buffer_len) based (file_buffer_ptr); 45 dcl file_buffer_len fixed bin (21); 46 dcl file_buffer_ptr ptr; 47 48 dcl last_file bit (1); 49 50 dcl level_6_chars_read fixed bin (21); 51 dcl level_6_chars_to_write fixed bin (21); 52 dcl level_6_iocbp ptr; 53 54 dcl multics_chars_to_write fixed bin (21); 55 dcl multics_data_type fixed bin; 56 dcl multics_file_iocbp ptr; 57 dcl multics_file_type fixed bin; 58 59 dcl next_transmission_unit fixed bin; 60 61 dcl 1 prompt aligned, 62 2 prompt_char char (1) unaligned init ("P"), 63 2 record_number pic "99999" unaligned; 64 65 dcl record_number fixed bin; 66 dcl total_bytes fixed bin (35); 67 dcl tu_size fixed bin (21); 68 69 /* Internal Constants */ 70 1 1 /*----------BEGIN l6_tran_constants.incl.pl1---------------------------------*/ 1 2 1 3 dcl SEND_TU_SIZE fixed bin (21) internal static options (constant) init (119); 1 4 dcl RECV_TU_SIZE fixed bin (21) internal static options (constant) init (1000); 1 5 1 6 dcl CR char (1) internal static options (constant) init (" "); 1 7 /* A carrige return. */ 1 8 dcl SP char (1) internal static options (constant) init (" "); 1 9 /* A space. */ 1 10 dcl HT char (1) internal static options (constant) init (" "); 1 11 /* A horizontal tab. */ 1 12 1 13 dcl ASCII fixed bin internal static options (constant) init (1); 1 14 dcl BINARY fixed bin internal static options (constant) init (2); 1 15 dcl BCD fixed bin internal static options (constant) init (3); 1 16 1 17 dcl CHASE fixed bin (1) internal static options (constant) init (1); 1 18 1 19 dcl UNSTRUCTURED_FILE_TYPE fixed bin internal static options (constant) init (1); 1 20 dcl SEQUENTIAL_FILE_TYPE fixed bin internal static options (constant) init (2); 1 21 dcl BLOCKED_FILE_TYPE fixed bin internal static options (constant) init (3); 1 22 dcl INDEXED_FILE_TYPE fixed bin internal static options (constant) init (4); 1 23 dcl VARIABLE_FILE_TYPE fixed bin internal static options (constant) init (5); 1 24 1 25 dcl L6_S_FILE_TYPE fixed bin internal static options (constant) init (1); 1 26 dcl L6_D_FILE_TYPE fixed bin internal static options (constant) init (2); 1 27 dcl L6_R_FILE_TYPE fixed bin internal static options (constant) init (3); 1 28 dcl L6_F_FILE_TYPE fixed bin internal static options (constant) init (4); 1 29 1 30 dcl L6_FILE_TYPE (4) char (1) internal static options (constant) init ("S", "D", "R", "F"); 1 31 dcl L6_DATA_TYPE (3) char (1) internal static options (constant) init ("A", "8", "B"); 1 32 1 33 dcl FILE_TYPE_TO_PNAME (5) char (12) internal static options (constant) 1 34 init ("unstructured", "sequential", "blocked", "indexed", "variable"); 1 35 1 36 dcl MULTICS_L6_FILE_SUFFIX (4) char (3) internal static options (constant) init ("", "l6d", "l6r", "l6f"); 1 37 1 38 dcl USAGE char (256) internal static options (constant) 1 39 init ( 1 40 "Usage: nr l6_ftf {}, where <*_file> is: {-nm} {-at
}" 1 41 ); 1 42 1 43 /*----------END l6_tran_constants.incl.pl1-----------------------------------*/ 71 72 73 /* External Constants */ 74 75 dcl error_table_$unimplemented_version 76 fixed bin (35) ext static; 77 dcl error_table_$fatal_error fixed bin (35) ext static; 78 79 /* External Entries */ 80 81 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 82 dcl cu_$arg_list_ptr entry (ptr); 83 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 84 dcl cv_dec_ entry (char (*)) returns (fixed bin (35)); 85 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 86 dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, 87 bit (1) aligned); 88 dcl ioa_$rsnpnnl entry options (variable); 89 dcl iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35)); 90 dcl l6_tran_util_$get_chars entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 91 dcl l6_tran_util_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 92 93 /* Builtin Functions and Conditions */ 94 95 dcl copy builtin; 96 dcl index builtin; 97 dcl length builtin; 98 dcl min builtin; 99 dcl null builtin; 100 dcl string builtin; 101 dcl substr builtin; 102 dcl verify builtin; 103 104 /* Include Files */ 105 2 1 /*----------BEGIN l6_tran_transfer_args.incl.pl1-----------------------------*/ 2 2 2 3 /* format: style3,linecom,ifthenstmt,indthenelse,^indnoniterdo,indnoniterend,initcol3,dclind5,idind32 */ 2 4 2 5 /* Written 9/82 by R.J.C. Kissel */ 2 6 2 7 /* Input arguments for l6_tran_send/receive_file_. */ 2 8 2 9 dcl tiap ptr; 2 10 dcl transfer_input_args_version_1 char (8) unaligned internal static options (constant) init ("version1"); 2 11 2 12 dcl 1 transfer_input_args aligned based (tiap), 2 13 2 version char (8) unaligned, 2 14 2 comm_iocbp ptr, 2 15 2 comm_buffer_ptr ptr, 2 16 2 comm_buffer_len fixed bin (21), 2 17 2 file_iocbp ptr, 2 18 2 file_buffer_ptr ptr, 2 19 2 file_buffer_len fixed bin (21), 2 20 2 file_type fixed bin, 2 21 2 data_type fixed bin, 2 22 2 tu_size fixed bin (21), 2 23 2 flags aligned, 2 24 3 last_file bit (1) unaligned, /* Input for sending, not used for receiving. */ 2 25 3 prompt_read bit (1) unaligned, /* Input for sending, not used for receiving. */ 2 26 3 pad bit (34) unaligned; 2 27 2 28 /* Output arguments for l6_tran_send/receive_file_. */ 2 29 2 30 dcl toap ptr; 2 31 dcl transfer_output_args_version_1 char (8) unaligned internal static options (constant) init ("version1"); 2 32 2 33 dcl 1 transfer_output_args aligned based (toap), 2 34 2 version char (8) unaligned, 2 35 2 record_number fixed bin, 2 36 2 total_bytes fixed bin (35), 2 37 2 flags aligned, 2 38 3 last_file bit (1) unaligned, /* Output from receive, not used by send. */ 2 39 3 pad bit (35) unaligned; 2 40 2 41 /*----------END l6_tran_transfer_args.incl.pl1-------------------------------*/ 106 107 108 level_6_iocbp = null (); /* Initialize these in case of error. */ 109 comm_buffer_ptr = null (); 110 111 tiap = P_input_args_ptr; 112 toap = P_output_args_ptr; 113 114 if transfer_input_args.version ^= transfer_input_args_version_1 115 then call ERROR (error_table_$unimplemented_version, "The input args version was ^a, expected ^a.", 116 transfer_input_args.version, transfer_input_args_version_1); 117 118 if transfer_output_args.version ^= transfer_output_args_version_1 119 then call ERROR (error_table_$unimplemented_version, "The output args version was ^a, expected ^a.", 120 transfer_output_args.version, transfer_output_args_version_1); 121 122 level_6_iocbp = transfer_input_args.comm_iocbp; 123 comm_buffer_ptr = transfer_input_args.comm_buffer_ptr; 124 comm_buffer_len = transfer_input_args.comm_buffer_len; 125 multics_file_iocbp = transfer_input_args.file_iocbp; 126 file_buffer_ptr = transfer_input_args.file_buffer_ptr; 127 file_buffer_len = transfer_input_args.file_buffer_len; 128 multics_file_type = transfer_input_args.file_type; 129 multics_data_type = transfer_input_args.data_type; 130 tu_size = transfer_input_args.tu_size; 131 total_bytes = 0; 132 133 comm_buffer_position = 1; /* Set this for Receive_L6_Record */ 134 char_position_in_tu = 1; /* Set this for Receive_L6_Record */ 135 level_6_chars_read = 0; /* Set this for Receive_L6_Record */ 136 next_transmission_unit = 0; /* Set this for Receive_L6_Record */ 137 138 /* Send the initial prompt for record 0. */ 139 140 prompt.record_number = 0; 141 level_6_chars_to_write = length (string (prompt)); 142 substr (comm_buffer, 1, level_6_chars_to_write) = string (prompt); 143 144 call l6_tran_util_$put_chars (level_6_iocbp, comm_buffer_ptr, level_6_chars_to_write, code); 145 if code ^= 0 then call ERROR (code, "Trying to write the first prompt to the Level 6."); 146 147 /* Receive records until we find end of file (returned after the last record is read). */ 148 149 call Receive_L6_Record (record_number, end_of_file, last_file); 150 151 /* A level 6 null line has whitespace in it. If we get a whitespace record, write a null line to the Multics file. */ 152 153 if multics_file_type = UNSTRUCTURED_FILE_TYPE & multics_data_type = ASCII 154 & verify (substr (file_buffer, 1, multics_chars_to_write), SP || HT) = 0 155 then multics_chars_to_write = 0; 156 157 do while (^end_of_file); 158 159 call iox_$write_record (multics_file_iocbp, file_buffer_ptr, multics_chars_to_write, code); 160 if code ^= 0 then call ERROR (code, "Trying to write record ^d to the multics file.", record_number); 161 162 total_bytes = total_bytes + multics_chars_to_write; 163 164 call Receive_L6_Record (record_number, end_of_file, last_file); 165 166 /* A level 6 null line has whitespace in it. If we get a record of just whitespace, write a null line to the Multics file. */ 167 168 if multics_file_type = UNSTRUCTURED_FILE_TYPE & multics_data_type = ASCII 169 & verify (substr (file_buffer, 1, multics_chars_to_write), SP || HT) = 0 170 then multics_chars_to_write = 0; 171 172 end; 173 174 /* Send the final prompt for the last record we got. The L6 wants the # of records, not the # of the last record. */ 175 176 prompt.record_number = min (99999, record_number + 1); 177 level_6_chars_to_write = length (string (prompt)); 178 substr (comm_buffer, 1, level_6_chars_to_write) = string (prompt); 179 180 call l6_tran_util_$put_chars (level_6_iocbp, comm_buffer_ptr, level_6_chars_to_write, code); 181 if code ^= 0 then call ERROR (code, "Trying to write the final prompt to the Level 6."); 182 183 transfer_output_args.record_number = record_number; 184 transfer_output_args.total_bytes = total_bytes; 185 transfer_output_args.last_file = last_file; 186 P_error_message = ""; 187 P_code = 0; 188 189 RETURN: 190 return; 191 192 Receive_L6_Record: 193 proc (P_record_number, P_end_of_file, P_last_file); 194 195 dcl P_record_number fixed bin; 196 dcl P_end_of_file bit (1) parameter; 197 dcl P_last_file bit (1) parameter; 198 199 dcl code fixed bin (35); 200 dcl current_char char (1); 201 dcl current_digit fixed bin; 202 dcl data_chars_available fixed bin; 203 dcl data_field_len char (2); 204 dcl data_is_packed bit (1); 205 dcl end_of_file bit (1); 206 dcl end_of_record bit (1); 207 dcl file_buffer_position fixed bin (21); 208 dcl fixed_data_field_len fixed bin; 209 dcl last_file bit (1); 210 211 dcl 1 l6_error aligned based (comm_buffer_ptr), 212 2 first_char char (1) unaligned, /* Should be "C". */ 213 2 second_char char (1) unaligned, /* Should be "U". */ 214 2 message_len pic "99" unaligned, 215 2 message char (0 refer (l6_error.message_len)) unaligned; 216 217 dcl media_code fixed bin; 218 dcl read_record_state fixed bin; 219 dcl record_number char (5); 220 221 /* Set initial parser state variables. */ 222 223 file_buffer_position = 1; 224 read_record_state = 1; 225 current_digit = 1; 226 227 /* Now parse the record, getting more characters as needed. */ 228 229 last_file = "0"b; 230 231 end_of_file = "0"b; 232 end_of_record = "0"b; 233 do while (^end_of_file & ^end_of_record); 234 235 if comm_buffer_position > level_6_chars_read 236 then do; /* Get some more characters to process. */ 237 call l6_tran_util_$get_chars (level_6_iocbp, comm_buffer_ptr, comm_buffer_len, 238 level_6_chars_read, code); 239 if code ^= 0 then call ERROR (code, "Trying to get characters for a record."); 240 241 comm_buffer_position = 1; 242 end; /* Get some more characters to process. */ 243 244 current_char = substr (comm_buffer, comm_buffer_position, 1); 245 246 if char_position_in_tu = tu_size + 1 | char_position_in_tu = 1 247 then do; /* Special transmission unit character. */ 248 char_position_in_tu = 1; 249 250 if current_char = "C" 251 then call ERROR (error_table_$fatal_error, "Error from the Level 6: ^a.", l6_error.message); 252 253 if cv_dec_ (current_char) ^= next_transmission_unit then ; 254 /* Something wrong, but keep going. */ 255 256 next_transmission_unit = next_transmission_unit + 1; 257 comm_buffer_position = comm_buffer_position + 1; 258 char_position_in_tu = char_position_in_tu + 1; 259 260 goto NEXT_STATE; 261 end; /* Special transmission unit character. */ 262 263 goto RECORD_PARSER (read_record_state); 264 265 RECORD_PARSER (1): /* Process the media code or end of file */ 266 if current_char = "E" 267 then do; 268 end_of_file = "1"b; 269 last_file = "1"b; 270 end; 271 272 else if current_char = "F" 273 then do; 274 end_of_file = "1"b; 275 last_file = "0"b; 276 end; 277 278 else media_code = index (string (L6_DATA_TYPE), current_char); 279 280 comm_buffer_position = comm_buffer_position + 1; 281 /* Take any media code. */ 282 char_position_in_tu = char_position_in_tu + 1; 283 read_record_state = 2; 284 285 goto NEXT_STATE; 286 287 RECORD_PARSER (2): /* Process the digits of the record number */ 288 substr (record_number, current_digit, 1) = current_char; 289 290 comm_buffer_position = comm_buffer_position + 1; 291 current_digit = current_digit + 1; 292 char_position_in_tu = char_position_in_tu + 1; 293 294 if current_digit <= length (record_number) 295 then read_record_state = 2; 296 else do; 297 current_digit = 1; 298 read_record_state = 3; 299 end; 300 301 goto NEXT_STATE; 302 303 RECORD_PARSER (3): /* Process packed (P), unpacked (U), or end of record (R) */ 304 if current_char = "P" then data_is_packed = "1"b; 305 306 else if current_char = "U" then data_is_packed = "0"b; 307 308 else if current_char = "R" then end_of_record = "1"b; 309 310 else do; /* Assume end of record */ 311 end_of_record = "1"b; 312 goto NEXT_STATE; /* Don't advance buffer position */ 313 end; 314 315 comm_buffer_position = comm_buffer_position + 1; 316 char_position_in_tu = char_position_in_tu + 1; 317 read_record_state = 4; 318 319 goto NEXT_STATE; 320 321 RECORD_PARSER (4): /* Process the digits of the data field length */ 322 substr (data_field_len, current_digit, 1) = current_char; 323 324 comm_buffer_position = comm_buffer_position + 1; 325 current_digit = current_digit + 1; 326 char_position_in_tu = char_position_in_tu + 1; 327 328 if current_digit <= length (data_field_len) 329 then read_record_state = 4; 330 else do; 331 current_digit = 1; 332 333 fixed_data_field_len = cv_dec_check_ (data_field_len, code); 334 if code ^= 0 then fixed_data_field_len = 0; 335 336 code = 0; 337 read_record_state = 5; 338 end; 339 340 goto NEXT_STATE; 341 342 RECORD_PARSER (5): /* Process a data field, we may not have it all. */ 343 if data_is_packed 344 then do; 345 substr (file_buffer, file_buffer_position, fixed_data_field_len) = 346 copy (current_char, fixed_data_field_len); 347 file_buffer_position = file_buffer_position + fixed_data_field_len; 348 comm_buffer_position = comm_buffer_position + 1; 349 char_position_in_tu = char_position_in_tu + 1; 350 351 read_record_state = 3; 352 end; 353 354 else do; 355 data_chars_available = min (fixed_data_field_len, level_6_chars_read - comm_buffer_position + 1); 356 357 substr (file_buffer, file_buffer_position, data_chars_available) = 358 substr (comm_buffer, comm_buffer_position, data_chars_available); 359 file_buffer_position = file_buffer_position + data_chars_available; 360 comm_buffer_position = comm_buffer_position + data_chars_available; 361 char_position_in_tu = char_position_in_tu + data_chars_available; 362 363 fixed_data_field_len = fixed_data_field_len - data_chars_available; 364 365 if fixed_data_field_len <= 0 366 then read_record_state = 3; /* done with the data. */ 367 else read_record_state = 5; /* more unpacked data. */ 368 end; 369 370 goto NEXT_STATE; 371 372 NEXT_STATE: 373 end; /* Parser loop */ 374 375 multics_chars_to_write = file_buffer_position - 1; 376 377 P_last_file = last_file; 378 P_end_of_file = end_of_file; /* Only eof or eor may be set, not both. */ 379 P_record_number = cv_dec_check_ (record_number, code); 380 if code ^= 0 then P_record_number = 0; 381 382 return; 383 384 end Receive_L6_Record; 385 386 /*****************************************************************************/ 387 /* */ 388 /* PROCEDURE: ERROR */ 389 /* */ 390 /* This subroutine expects arguments as follows: */ 391 /* */ 392 /* call ERROR (code, ioa_control_string, ioa_arguments, ...) */ 393 /* */ 394 /* where: code is fixed bin (35), and ioa_control_string and ioa_arguments */ 395 /* are optional character strings as defined for ioa_. */ 396 /* */ 397 /* Some global variables are used: */ 398 /* */ 399 /* Cleanup_Handler (a procedure that does cleanup) */ 400 /* */ 401 /* For commands: */ 402 /* report_error (an entry variable set to com_err_ or active_fnc_err_)*/ 403 /* command_name (the character string name of the command) */ 404 /* return_arg_ptr (used to return "false" for active functions) */ 405 /* */ 406 /* For subroutines: */ 407 /* depends on the error reporting strategy chosen. */ 408 /* */ 409 /* At completion a non-local goto is done to the label RETURN. */ 410 /* */ 411 /* Declarations are expected for: */ 412 /* */ 413 /* cu_$arg_list_ptr */ 414 /* cu_$arg_ptr */ 415 /* cu_$arg_count */ 416 /* error_table_$fatal_error */ 417 /* ioa_$general_rs */ 418 /* */ 419 /*****************************************************************************/ 420 421 ERROR: 422 proc () options (variable, non_quick); 423 424 dcl arg_list_ptr ptr; 425 dcl arg_len fixed bin (21); 426 dcl arg_ptr ptr; 427 dcl based_code fixed bin (35) based; 428 dcl caller_code fixed bin (35); 429 dcl code fixed bin (35); 430 dcl err_msg char (256); 431 dcl err_msg_len fixed bin (21); 432 dcl nargs fixed bin; 433 434 call cu_$arg_count (nargs, code); /* IGNORE CODE */ 435 436 if nargs >= 1 437 then do; /* We were called correctly. */ 438 arg_ptr = null (); /* Set this so we know if cu_$arg_ptr worked. */ 439 call cu_$arg_ptr (1, arg_ptr, arg_len, code); 440 441 if arg_ptr ^= null () 442 then caller_code = arg_ptr -> based_code; 443 /* The normal case. */ 444 else caller_code = error_table_$fatal_error; 445 /* Some problem with our arg list. */ 446 447 if nargs > 1 448 then do; /* There is a message. */ 449 call cu_$arg_list_ptr (arg_list_ptr); 450 call ioa_$general_rs (arg_list_ptr, 2, 3, err_msg, err_msg_len, "1"b, "0"b); 451 end; 452 453 else do; /* No message. */ 454 err_msg = ""; 455 err_msg_len = 0; 456 end; 457 end; /* We were called correctly. */ 458 459 else do; /* We were called with no arguments. */ 460 caller_code = error_table_$fatal_error; /* The best we can do. */ 461 err_msg = ""; 462 err_msg_len = 0; 463 end; /* We were called with no arguments. */ 464 465 /* The following lines must be modified depending on the error reporting strategy used. */ 466 467 if level_6_iocbp ^= null () & comm_buffer_ptr ^= null () 468 then do; /* Tell the Level 6. */ 469 470 dcl pic_err_msg_len pic "99"; 471 472 pic_err_msg_len = min (99, err_msg_len); 473 474 call ioa_$rsnpnnl ("CU^a^aR", comm_buffer, level_6_chars_to_write, pic_err_msg_len, 475 substr (err_msg, 1, pic_err_msg_len)); 476 477 call l6_tran_util_$put_chars (level_6_iocbp, comm_buffer_ptr, level_6_chars_to_write, code); 478 end; 479 480 P_error_message = substr (err_msg, 1, err_msg_len); 481 P_code = caller_code; 482 483 /* Clean up and do a non-local goto back to the outermost block. */ 484 485 call Cleanup_Handler (); 486 goto RETURN; 487 488 end ERROR; 489 490 Cleanup_Handler: 491 proc (); 492 493 return; /* Nothing to do for now. */ 494 495 end Cleanup_Handler; 496 497 end l6_tran_receive_file_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/21/83 1115.1 l6_tran_receive_file_.pl1 >special_ldd>on>07/21/83>l6_tran_receive_file_.pl1 71 1 11/12/82 1624.7 l6_tran_constants.incl.pl1 >ldd>include>l6_tran_constants.incl.pl1 106 2 11/12/82 1624.7 l6_tran_transfer_args.incl.pl1 >ldd>include>l6_tran_transfer_args.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. ASCII constant fixed bin(17,0) initial dcl 1-13 ref 153 168 HT constant char(1) initial unaligned dcl 1-10 ref 153 168 L6_DATA_TYPE 000012 constant char(1) initial array unaligned dcl 1-31 ref 278 P_code parameter fixed bin(35,0) dcl 31 set ref 23 187* 481* P_end_of_file parameter bit(1) unaligned dcl 196 set ref 192 378* P_error_message parameter varying char dcl 30 set ref 23 186* 480* P_input_args_ptr parameter pointer dcl 28 ref 23 111 P_last_file parameter bit(1) unaligned dcl 197 set ref 192 377* P_output_args_ptr parameter pointer dcl 29 ref 23 112 P_record_number parameter fixed bin(17,0) dcl 195 set ref 192 379* 380* SP constant char(1) initial unaligned dcl 1-8 ref 153 168 UNSTRUCTURED_FILE_TYPE constant fixed bin(17,0) initial dcl 1-19 ref 153 168 arg_len 000102 automatic fixed bin(21,0) dcl 425 set ref 439* arg_list_ptr 000100 automatic pointer dcl 424 set ref 449* 450* arg_ptr 000104 automatic pointer dcl 426 set ref 438* 439* 441 441 based_code based fixed bin(35,0) dcl 427 ref 441 caller_code 000106 automatic fixed bin(35,0) dcl 428 set ref 441* 444* 460* 481 char_position_in_tu 000105 automatic fixed bin(21,0) dcl 40 set ref 134* 246 246 248* 258* 258 282* 282 292* 292 316* 316 326* 326 349* 349 361* 361 code 000107 automatic fixed bin(35,0) dcl 429 in procedure "ERROR" set ref 434* 439* 477* code 000106 automatic fixed bin(35,0) dcl 41 in procedure "l6_tran_receive_file_" set ref 144* 145 145* 159* 160 160* 180* 181 181* code 000150 automatic fixed bin(35,0) dcl 199 in procedure "Receive_L6_Record" set ref 237* 239 239* 333* 334 336* 379* 380 comm_buffer based char unaligned dcl 35 set ref 142* 178* 244 357 474* comm_buffer_len 6 based fixed bin(21,0) level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_receive_file_" ref 124 comm_buffer_len 000100 automatic fixed bin(21,0) dcl 36 in procedure "l6_tran_receive_file_" set ref 124* 142 178 237* 244 357 474 474 comm_buffer_position 000104 automatic fixed bin(21,0) dcl 38 set ref 133* 235 241* 244 257* 257 280* 280 290* 290 315* 315 324* 324 348* 348 355 357 360* 360 comm_buffer_ptr 000102 automatic pointer dcl 37 in procedure "l6_tran_receive_file_" set ref 109* 123* 142 144* 178 180* 237* 244 250 357 467 474 477* comm_buffer_ptr 4 based pointer level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_receive_file_" ref 123 comm_iocbp 2 based pointer level 2 dcl 2-12 ref 122 copy builtin function dcl 95 ref 345 cu_$arg_count 000014 constant entry external dcl 81 ref 434 cu_$arg_list_ptr 000016 constant entry external dcl 82 ref 449 cu_$arg_ptr 000020 constant entry external dcl 83 ref 439 current_char 000151 automatic char(1) unaligned dcl 200 set ref 244* 250 253* 265 272 278 287 303 306 308 321 345 current_digit 000152 automatic fixed bin(17,0) dcl 201 set ref 225* 287 291* 291 294 297* 321 325* 325 328 331* cv_dec_ 000022 constant entry external dcl 84 ref 253 cv_dec_check_ 000024 constant entry external dcl 85 ref 333 379 data_chars_available 000153 automatic fixed bin(17,0) dcl 202 set ref 355* 357 357 359 360 361 363 data_field_len 000154 automatic char(2) unaligned dcl 203 set ref 321* 328 333* data_is_packed 000155 automatic bit(1) unaligned dcl 204 set ref 303* 306* 342 data_type 16 based fixed bin(17,0) level 2 dcl 2-12 ref 129 end_of_file 000107 automatic bit(1) unaligned dcl 42 in procedure "l6_tran_receive_file_" set ref 149* 157 164* end_of_file 000156 automatic bit(1) unaligned dcl 205 in procedure "Receive_L6_Record" set ref 231* 233 268* 274* 378 end_of_record 000157 automatic bit(1) unaligned dcl 206 set ref 232* 233 308* 311* err_msg 000110 automatic char(256) unaligned dcl 430 set ref 450* 454* 461* 474 474 480 err_msg_len 000210 automatic fixed bin(21,0) dcl 431 set ref 450* 455* 462* 472 480 error_table_$fatal_error 000012 external static fixed bin(35,0) dcl 77 set ref 250* 444 460 error_table_$unimplemented_version 000010 external static fixed bin(35,0) dcl 75 set ref 114* 118* file_buffer based char unaligned dcl 44 set ref 153 168 345* 357* file_buffer_len 14 based fixed bin(21,0) level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_receive_file_" ref 127 file_buffer_len 000110 automatic fixed bin(21,0) dcl 45 in procedure "l6_tran_receive_file_" set ref 127* 153 168 345 357 file_buffer_position 000160 automatic fixed bin(21,0) dcl 207 set ref 223* 345 347* 347 357 359* 359 375 file_buffer_ptr 12 based pointer level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_receive_file_" ref 126 file_buffer_ptr 000112 automatic pointer dcl 46 in procedure "l6_tran_receive_file_" set ref 126* 153 159* 168 345 357 file_iocbp 10 based pointer level 2 dcl 2-12 ref 125 file_type 15 based fixed bin(17,0) level 2 dcl 2-12 ref 128 fixed_data_field_len 000161 automatic fixed bin(17,0) dcl 208 set ref 333* 334* 345 345 347 355 363* 363 365 flags 4 based structure level 2 dcl 2-33 index builtin function dcl 96 ref 278 ioa_$general_rs 000026 constant entry external dcl 86 ref 450 ioa_$rsnpnnl 000030 constant entry external dcl 88 ref 474 iox_$write_record 000032 constant entry external dcl 89 ref 159 l6_error based structure level 1 dcl 211 l6_tran_util_$get_chars 000034 constant entry external dcl 90 ref 237 l6_tran_util_$put_chars 000036 constant entry external dcl 91 ref 144 180 477 last_file 4 based bit(1) level 3 in structure "transfer_output_args" packed unaligned dcl 2-33 in procedure "l6_tran_receive_file_" set ref 185* last_file 000162 automatic bit(1) unaligned dcl 209 in procedure "Receive_L6_Record" set ref 229* 269* 275* 377 last_file 000114 automatic bit(1) unaligned dcl 48 in procedure "l6_tran_receive_file_" set ref 149* 164* 185 length builtin function dcl 97 ref 141 177 294 328 level_6_chars_read 000115 automatic fixed bin(21,0) dcl 50 set ref 135* 235 237* 355 level_6_chars_to_write 000116 automatic fixed bin(21,0) dcl 51 set ref 141* 142 144* 177* 178 180* 474* 477* level_6_iocbp 000120 automatic pointer dcl 52 set ref 108* 122* 144* 180* 237* 467 477* media_code 000163 automatic fixed bin(17,0) dcl 217 set ref 278* message 1 based char level 2 packed unaligned dcl 211 set ref 250* message_len 0(18) based picture(2) level 2 packed unaligned dcl 211 ref 250 250 min builtin function dcl 98 ref 176 355 472 multics_chars_to_write 000122 automatic fixed bin(21,0) dcl 54 set ref 153 153* 159* 162 168 168* 375* multics_data_type 000123 automatic fixed bin(17,0) dcl 55 set ref 129* 153 168 multics_file_iocbp 000124 automatic pointer dcl 56 set ref 125* 159* multics_file_type 000126 automatic fixed bin(17,0) dcl 57 set ref 128* 153 168 nargs 000211 automatic fixed bin(17,0) dcl 432 set ref 434* 436 447 next_transmission_unit 000127 automatic fixed bin(17,0) dcl 59 set ref 136* 253 256* 256 null builtin function dcl 99 ref 108 109 438 441 467 467 pic_err_msg_len 000212 automatic picture(2) unaligned dcl 470 set ref 472* 474* 474 474 prompt 000130 automatic structure level 1 dcl 61 set ref 141 142 177 178 prompt_char 000130 automatic char(1) initial level 2 packed unaligned dcl 61 set ref 61* read_record_state 000164 automatic fixed bin(17,0) dcl 218 set ref 224* 263 283* 294* 298* 317* 328* 337* 351* 365* 367* record_number 000166 automatic char(5) unaligned dcl 219 in procedure "Receive_L6_Record" set ref 287* 294 379* record_number 2 based fixed bin(17,0) level 2 in structure "transfer_output_args" dcl 2-33 in procedure "l6_tran_receive_file_" set ref 183* record_number 0(09) 000130 automatic picture(5) level 2 in structure "prompt" packed unaligned dcl 61 in procedure "l6_tran_receive_file_" set ref 140* 176* record_number 000132 automatic fixed bin(17,0) dcl 65 in procedure "l6_tran_receive_file_" set ref 149* 160* 164* 176 183 string builtin function dcl 100 ref 141 142 177 178 278 substr builtin function dcl 101 set ref 142* 153 168 178* 244 287* 321* 345* 357* 357 474 474 480 tiap 000136 automatic pointer dcl 2-9 set ref 111* 114 114 122 123 124 125 126 127 128 129 130 toap 000140 automatic pointer dcl 2-30 set ref 112* 118 118 183 184 185 total_bytes 3 based fixed bin(35,0) level 2 in structure "transfer_output_args" dcl 2-33 in procedure "l6_tran_receive_file_" set ref 184* total_bytes 000133 automatic fixed bin(35,0) dcl 66 in procedure "l6_tran_receive_file_" set ref 131* 162* 162 184 transfer_input_args based structure level 1 dcl 2-12 transfer_input_args_version_1 000010 constant char(8) initial unaligned dcl 2-10 set ref 114 114* transfer_output_args based structure level 1 dcl 2-33 transfer_output_args_version_1 000006 constant char(8) initial unaligned dcl 2-31 set ref 118 118* tu_size 000134 automatic fixed bin(21,0) dcl 67 in procedure "l6_tran_receive_file_" set ref 130* 246 tu_size 17 based fixed bin(21,0) level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_receive_file_" ref 130 verify builtin function dcl 102 ref 153 168 version based char(8) level 2 in structure "transfer_output_args" packed unaligned dcl 2-33 in procedure "l6_tran_receive_file_" set ref 118 118* version based char(8) level 2 in structure "transfer_input_args" packed unaligned dcl 2-12 in procedure "l6_tran_receive_file_" set ref 114 114* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. BCD internal static fixed bin(17,0) initial dcl 1-15 BINARY internal static fixed bin(17,0) initial dcl 1-14 BLOCKED_FILE_TYPE internal static fixed bin(17,0) initial dcl 1-21 CHASE internal static fixed bin(1,0) initial dcl 1-17 CR internal static char(1) initial unaligned dcl 1-6 FILE_TYPE_TO_PNAME internal static char(12) initial array unaligned dcl 1-33 INDEXED_FILE_TYPE internal static fixed bin(17,0) initial dcl 1-22 L6_D_FILE_TYPE internal static fixed bin(17,0) initial dcl 1-26 L6_FILE_TYPE internal static char(1) initial array unaligned dcl 1-30 L6_F_FILE_TYPE internal static fixed bin(17,0) initial dcl 1-28 L6_R_FILE_TYPE internal static fixed bin(17,0) initial dcl 1-27 L6_S_FILE_TYPE internal static fixed bin(17,0) initial dcl 1-25 MULTICS_L6_FILE_SUFFIX internal static char(3) initial array unaligned dcl 1-36 RECV_TU_SIZE internal static fixed bin(21,0) initial dcl 1-4 SEND_TU_SIZE internal static fixed bin(21,0) initial dcl 1-3 SEQUENTIAL_FILE_TYPE internal static fixed bin(17,0) initial dcl 1-20 USAGE internal static char(256) initial unaligned dcl 1-38 VARIABLE_FILE_TYPE internal static fixed bin(17,0) initial dcl 1-23 NAMES DECLARED BY EXPLICIT CONTEXT. Cleanup_Handler 001636 constant entry internal dcl 490 ref 485 ERROR 001322 constant entry internal dcl 421 ref 114 118 145 160 181 239 250 NEXT_STATE 001256 constant label dcl 372 ref 260 285 301 312 319 340 370 RECORD_PARSER 000000 constant label array(5) dcl 265 ref 263 RETURN 000622 constant label dcl 189 ref 486 Receive_L6_Record 000623 constant entry internal dcl 192 ref 149 164 l6_tran_receive_file_ 000166 constant entry external dcl 23 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2042 2102 1656 2052 Length 2336 1656 40 220 164 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME l6_tran_receive_file_ 212 external procedure is an external procedure. Receive_L6_Record internal procedure shares stack frame of external procedure l6_tran_receive_file_. ERROR 200 internal procedure is declared options(non_quick), and is declared options(variable). Cleanup_Handler internal procedure shares stack frame of internal procedure ERROR. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ERROR 000100 arg_list_ptr ERROR 000102 arg_len ERROR 000104 arg_ptr ERROR 000106 caller_code ERROR 000107 code ERROR 000110 err_msg ERROR 000210 err_msg_len ERROR 000211 nargs ERROR 000212 pic_err_msg_len ERROR l6_tran_receive_file_ 000100 comm_buffer_len l6_tran_receive_file_ 000102 comm_buffer_ptr l6_tran_receive_file_ 000104 comm_buffer_position l6_tran_receive_file_ 000105 char_position_in_tu l6_tran_receive_file_ 000106 code l6_tran_receive_file_ 000107 end_of_file l6_tran_receive_file_ 000110 file_buffer_len l6_tran_receive_file_ 000112 file_buffer_ptr l6_tran_receive_file_ 000114 last_file l6_tran_receive_file_ 000115 level_6_chars_read l6_tran_receive_file_ 000116 level_6_chars_to_write l6_tran_receive_file_ 000120 level_6_iocbp l6_tran_receive_file_ 000122 multics_chars_to_write l6_tran_receive_file_ 000123 multics_data_type l6_tran_receive_file_ 000124 multics_file_iocbp l6_tran_receive_file_ 000126 multics_file_type l6_tran_receive_file_ 000127 next_transmission_unit l6_tran_receive_file_ 000130 prompt l6_tran_receive_file_ 000132 record_number l6_tran_receive_file_ 000133 total_bytes l6_tran_receive_file_ 000134 tu_size l6_tran_receive_file_ 000136 tiap l6_tran_receive_file_ 000140 toap l6_tran_receive_file_ 000150 code Receive_L6_Record 000151 current_char Receive_L6_Record 000152 current_digit Receive_L6_Record 000153 data_chars_available Receive_L6_Record 000154 data_field_len Receive_L6_Record 000155 data_is_packed Receive_L6_Record 000156 end_of_file Receive_L6_Record 000157 end_of_record Receive_L6_Record 000160 file_buffer_position Receive_L6_Record 000161 fixed_data_field_len Receive_L6_Record 000162 last_file Receive_L6_Record 000163 media_code Receive_L6_Record 000164 read_record_state Receive_L6_Record 000166 record_number Receive_L6_Record THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out call_int_this_desc return tra_ext shorten_stack ext_entry_desc int_entry repeat set_cs_eis verify_eis unpack_pic THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr cv_dec_ cv_dec_check_ ioa_$general_rs ioa_$rsnpnnl iox_$write_record l6_tran_util_$get_chars l6_tran_util_$put_chars THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$fatal_error error_table_$unimplemented_version LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 23 000161 61 000201 108 000203 109 000205 111 000206 112 000212 114 000215 118 000247 122 000303 123 000306 124 000311 125 000314 126 000316 127 000320 128 000322 129 000324 130 000326 131 000330 133 000331 134 000333 135 000334 136 000335 140 000336 141 000342 142 000344 144 000347 145 000364 149 000405 153 000407 157 000427 159 000433 160 000450 162 000475 164 000501 168 000503 172 000523 176 000524 177 000541 178 000543 180 000547 181 000564 183 000605 184 000610 185 000612 186 000616 187 000621 189 000622 192 000623 223 000625 224 000627 225 000631 229 000632 231 000633 232 000634 233 000635 235 000642 237 000645 239 000664 241 000705 244 000707 246 000714 248 000723 250 000725 253 000772 256 001012 257 001013 258 001014 260 001015 263 001016 265 001020 268 001024 269 001026 270 001027 272 001030 274 001032 275 001034 276 001035 278 001036 280 001047 282 001050 283 001051 285 001053 287 001054 290 001060 291 001061 292 001062 294 001063 297 001071 298 001073 301 001075 303 001076 306 001105 308 001111 311 001116 312 001120 315 001121 316 001122 317 001123 319 001125 321 001126 324 001132 325 001133 326 001134 328 001135 331 001143 333 001145 334 001167 336 001172 337 001173 340 001175 342 001176 345 001200 347 001213 348 001215 349 001216 351 001217 352 001221 355 001222 357 001231 359 001240 360 001242 361 001243 363 001244 365 001246 367 001253 370 001255 375 001256 377 001261 378 001266 379 001272 380 001315 382 001320 421 001321 434 001327 436 001337 438 001342 439 001344 441 001363 444 001372 447 001375 449 001400 450 001407 451 001456 454 001457 455 001462 457 001463 460 001464 461 001467 462 001472 467 001473 472 001504 474 001521 477 001576 480 001615 481 001630 485 001632 486 001633 490 001636 493 001637 ----------------------------------------------------------- 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