COMPILATION LISTING OF SEGMENT l6_tran_send_file_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 10/05/83 1345.4 mst Wed 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 of the work necessary to send a file to */ 11 /* the Level 6. It is used by the l6_tran_ NASP. */ 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 check for an error message from */ 18 /* the L6 after every transmission unit is sent. */ 19 /* 3) Modified 9/83 by R.J.C. Kissel to not call the final prompt after a */ 20 /* file transfer an error. */ 21 /* */ 22 /*****************************************************************************/ 23 24 /* format: style3,linecom,ifthenstmt,indthenelse,^indnoniterdo,indnoniterend,initcol3,dclind5,idind32 */ 25 26 l6_tran_send_file_: 27 proc (P_input_args_ptr, P_output_args_ptr, P_error_message, P_code); 28 29 /* Parameters */ 30 31 dcl P_input_args_ptr ptr parameter; 32 dcl P_output_args_ptr ptr parameter; 33 dcl P_error_message char (*) varying parameter; 34 dcl P_code fixed bin (35) parameter; 35 36 /* Automatic */ 37 38 dcl comm_buffer char (comm_buffer_len) based (comm_buffer_ptr); 39 dcl comm_buffer_len fixed bin (21); 40 dcl comm_buffer_ptr ptr; 41 dcl comm_buffer_position fixed bin (21); 42 43 dcl code fixed bin (35); 44 dcl end_of_file bit (1); 45 46 dcl file_buffer char (file_buffer_len) based (file_buffer_ptr); 47 dcl file_buffer_len fixed bin (21); 48 dcl file_buffer_ptr ptr; 49 50 dcl last_file bit (1); 51 52 dcl level_6_chars_read fixed bin (21); 53 dcl level_6_chars_to_write fixed bin (21); 54 dcl level_6_iocbp ptr; 55 56 dcl multics_chars_read fixed bin (21); 57 dcl multics_data_type fixed bin; 58 dcl multics_file_type fixed bin; 59 dcl multics_file_iocbp ptr; 60 61 dcl next_transmission_unit fixed bin; 62 63 dcl 1 prompt aligned, 64 2 prompt_char char (1) unaligned init ("P"), 65 2 record_number pic "99999" unaligned; 66 67 dcl record_number fixed bin; 68 dcl total_bytes fixed bin (35); 69 dcl tu_size fixed bin (21); 70 71 /* Internal Constants */ 72 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-----------------------------------*/ 73 74 75 /* External Constants */ 76 77 dcl error_table_$end_of_info fixed bin (35) ext static; 78 dcl error_table_$fatal_error fixed bin (35) ext static; 79 dcl error_table_$short_record fixed bin (35) ext static; 80 dcl error_table_$unimplemented_version 81 fixed bin (35) ext static; 82 83 /* External Entries */ 84 85 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 86 dcl cu_$arg_list_ptr entry (ptr); 87 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 88 dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, 89 bit (1) aligned); 90 dcl ioa_$rsnpnnl entry options (variable); 91 dcl iox_$read_record entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 92 dcl l6_tran_util_$get_chars entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 93 dcl l6_tran_util_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 94 dcl l6_tran_util_$read_status entry (ptr) returns (bit (1)); 95 96 /* Builtin Functions and Conditions */ 97 98 dcl length builtin; 99 dcl min builtin; 100 dcl mod builtin; 101 dcl null builtin; 102 dcl string builtin; 103 dcl substr builtin; 104 dcl verify builtin; 105 106 /* Include Files */ 107 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-------------------------------*/ 108 109 110 level_6_iocbp = null (); /* Initialize these in case of error. */ 111 comm_buffer_ptr = null (); 112 113 tiap = P_input_args_ptr; 114 toap = P_output_args_ptr; 115 116 if transfer_input_args.version ^= transfer_input_args_version_1 117 then call ERROR (error_table_$unimplemented_version, "The input args version was ^a, expected ^a.", 118 transfer_input_args.version, transfer_input_args_version_1); 119 120 if transfer_output_args.version ^= transfer_output_args_version_1 121 then call ERROR (error_table_$unimplemented_version, "The output args version was ^a, expected ^a.", 122 transfer_output_args.version, transfer_output_args_version_1); 123 124 level_6_iocbp = transfer_input_args.comm_iocbp; 125 comm_buffer_ptr = transfer_input_args.comm_buffer_ptr; 126 comm_buffer_len = transfer_input_args.comm_buffer_len; 127 multics_file_iocbp = transfer_input_args.file_iocbp; 128 file_buffer_ptr = transfer_input_args.file_buffer_ptr; 129 file_buffer_len = transfer_input_args.file_buffer_len; 130 multics_file_type = transfer_input_args.file_type; 131 multics_data_type = transfer_input_args.data_type; 132 tu_size = transfer_input_args.tu_size; 133 last_file = transfer_input_args.last_file; 134 total_bytes = 0; 135 136 comm_buffer_position = 1; /* Set this for Send_L6_Record. */ 137 next_transmission_unit = 0; /* Set this for Send_L6_Record. */ 138 139 /* Get the first prompt from the Level 6, it should be for record 0. */ 140 141 if ^transfer_input_args.flags.prompt_read 142 then do; 143 call l6_tran_util_$get_chars (level_6_iocbp, comm_buffer_ptr, comm_buffer_len, level_6_chars_read, 144 code); 145 if code ^= 0 then call ERROR (code, "Trying to read the first prompt from the Level 6."); 146 147 string (prompt) = substr (comm_buffer, 1, level_6_chars_read); 148 149 if prompt.record_number ^= 0 then ; /* Something wrong, but keep going. */ 150 end; 151 152 /* Send records until end of file. (et_$short_record means eof but no newline from iox_$get_line). */ 153 154 155 call iox_$read_record (multics_file_iocbp, file_buffer_ptr, file_buffer_len, multics_chars_read, code); 156 if code ^= 0 & code ^= error_table_$end_of_info & code ^= error_table_$short_record 157 then call ERROR (code, "Trying to read the first record from the multics file."); 158 159 /* The level 6 cannot handle a null record, so if we have one put a space in it and send that. */ 160 161 if multics_file_type = UNSTRUCTURED_FILE_TYPE & multics_data_type = ASCII & multics_chars_read = 0 162 then do; 163 multics_chars_read = 1; 164 substr (file_buffer, 1, 1) = " "; 165 end; 166 167 total_bytes = total_bytes + multics_chars_read; 168 end_of_file = (code = error_table_$end_of_info); 169 170 do record_number = 0 by 1 while (^end_of_file); 171 172 /* Send the record if it is non-null, otherwise skip it. */ 173 174 if multics_chars_read > 0 175 then call Send_L6_Record (record_number, end_of_file, last_file); 176 else record_number = record_number - 1; /* Ignore null record, do loop will increment this. */ 177 178 /* Read the next Multics record, and check the error code. */ 179 180 call iox_$read_record (multics_file_iocbp, file_buffer_ptr, file_buffer_len, multics_chars_read, code); 181 if code ^= 0 & code ^= error_table_$end_of_info & code ^= error_table_$short_record 182 then call ERROR (code, "Trying to read record ^d from the multics file.", record_number + 1); 183 184 /* The level 6 cannot handle a null record, so if we have one put a space in it and send that. */ 185 186 if multics_file_type = UNSTRUCTURED_FILE_TYPE & multics_data_type = ASCII & multics_chars_read = 0 187 then do; 188 multics_chars_read = 1; 189 substr (file_buffer, 1, 1) = " "; 190 end; 191 192 total_bytes = total_bytes + multics_chars_read; 193 end_of_file = (code = error_table_$end_of_info); 194 end; 195 196 call Send_L6_Record (record_number, end_of_file, last_file); 197 /* Write the end of file record. */ 198 199 /* Get the final prompt from the Level 6, it might be an error message. */ 200 201 call l6_tran_util_$get_chars (level_6_iocbp, comm_buffer_ptr, comm_buffer_len, level_6_chars_read, code); 202 if code ^= 0 then call ERROR (code, "Trying to read the final prompt from the Level 6."); 203 204 call Check_For_L6_Error ((record_number)); 205 206 transfer_output_args.record_number = record_number; 207 transfer_output_args.total_bytes = total_bytes; 208 P_error_message = ""; 209 P_code = 0; 210 211 RETURN: 212 return; 213 214 Send_L6_Record: 215 proc (P_record_number, P_end_of_file, P_last_file); 216 217 dcl P_record_number fixed bin parameter; 218 dcl P_end_of_file bit (1) parameter; 219 dcl P_last_file bit (1) parameter; 220 221 dcl chars_left_in_record fixed bin (21); 222 dcl code fixed bin (35); 223 dcl current_digit fixed bin; 224 dcl data_field_len pic "99"; 225 dcl end_of_record bit (1); 226 dcl file_buffer_position fixed bin (21); 227 dcl max_unpacked_chars fixed bin; 228 dcl media_code char (1); 229 dcl pic_next_tu pic "9"; 230 dcl pack_the_data bit (1); 231 dcl packable_index fixed bin; 232 dcl packable_string bit (1); 233 dcl possible_packed_char char (1); 234 dcl possible_packed_length fixed bin; 235 dcl record_number pic "99999"; 236 dcl write_record_state fixed bin; 237 238 current_digit = 1; 239 file_buffer_position = 1; 240 media_code = L6_DATA_TYPE (multics_data_type); 241 record_number = min (99999, P_record_number); 242 write_record_state = 1; 243 244 end_of_record = "0"b; 245 do while (^end_of_record); /* Output loop. */ 246 247 if comm_buffer_position = tu_size + 1 | comm_buffer_position = 1 248 then do; 249 250 if comm_buffer_position = tu_size + 1 251 then do; /* Normal case, = 1 only the first time. */ 252 call l6_tran_util_$put_chars (level_6_iocbp, comm_buffer_ptr, tu_size, code); 253 if code ^= 0 then call ERROR (code, "Trying to write transmission unit."); 254 255 /* Look and see if the L6 has sent us something (usually an error message). */ 256 257 if l6_tran_util_$read_status (level_6_iocbp) 258 then do; 259 call l6_tran_util_$get_chars (level_6_iocbp, comm_buffer_ptr, 260 comm_buffer_len, level_6_chars_read, code); 261 if code ^= 0 262 then call ERROR (code, 263 "Trying to read a message from the Level 6 after sending record ^d." 264 , record_number); 265 266 call Check_For_L6_Error ((record_number)); 267 end; 268 end; 269 270 comm_buffer_position = 1; 271 272 pic_next_tu = next_transmission_unit; 273 substr (comm_buffer, comm_buffer_position, 1) = string (pic_next_tu); 274 275 comm_buffer_position = comm_buffer_position + 1; 276 next_transmission_unit = mod (next_transmission_unit + 1, 10); 277 278 goto NEXT_STATE; 279 end; 280 281 goto WRITE_RECORD (write_record_state); 282 283 WRITE_RECORD (1): /* Put in the media code */ 284 if P_end_of_file 285 then do; 286 if P_last_file 287 then substr (comm_buffer, comm_buffer_position, 1) = "E"; 288 else substr (comm_buffer, comm_buffer_position, 1) = "F"; 289 290 call l6_tran_util_$put_chars (level_6_iocbp, comm_buffer_ptr, comm_buffer_position, code); 291 if code ^= 0 then call ERROR (code, "Trying to write the last tu."); 292 293 end_of_record = "1"b; /* Exit the loop. */ 294 end; 295 296 else substr (comm_buffer, comm_buffer_position, 1) = media_code; 297 298 comm_buffer_position = comm_buffer_position + 1; 299 write_record_state = 2; 300 301 goto NEXT_STATE; 302 303 WRITE_RECORD (2): /* Put in the record number, one digit at a time. */ 304 substr (comm_buffer, comm_buffer_position, 1) = substr (record_number, current_digit, 1); 305 306 comm_buffer_position = comm_buffer_position + 1; 307 current_digit = current_digit + 1; 308 309 if current_digit <= length (record_number) 310 then write_record_state = 2; 311 else do; 312 current_digit = 1; 313 write_record_state = 3; 314 end; 315 316 goto NEXT_STATE; 317 318 WRITE_RECORD (3): /* Decide to pack, unpack (and how much), or end record. */ 319 chars_left_in_record = multics_chars_read - file_buffer_position + 1; 320 321 if chars_left_in_record <= 0 322 then do; /* Done with the record data. */ 323 substr (comm_buffer, comm_buffer_position, 1) = "R"; 324 325 comm_buffer_position = comm_buffer_position + 1; 326 end_of_record = "1"b; /* Exit the loop. */ 327 328 goto NEXT_STATE; 329 end; 330 331 /* Find the longest unpackable string in what is left. If one is not found, use what is left. */ 332 333 packable_string = "0"b; 334 335 do packable_index = 0 to min (99, chars_left_in_record) - 1 while (^packable_string); 336 337 possible_packed_char = substr (file_buffer, file_buffer_position + packable_index, 1); 338 339 possible_packed_length = 340 verify ( 341 substr (file_buffer, file_buffer_position + packable_index + 1, 342 min (99, chars_left_in_record) - packable_index - 1), possible_packed_char); 343 344 if possible_packed_length = 0 & min (99, chars_left_in_record) - packable_index - 1 > 0 345 then possible_packed_length = min (99, chars_left_in_record) - packable_index; 346 347 if possible_packed_length >= 5 348 then packable_string = "1"b; 349 else packable_string = "0"b; 350 end; 351 352 packable_index = packable_index - 1; 353 354 if packable_string & packable_index = 0 then pack_the_data = "1"b; 355 356 else if packable_string & packable_index > 0 357 then do; 358 pack_the_data = "0"b; 359 360 max_unpacked_chars = (tu_size - comm_buffer_position + 1) - 3; 361 if max_unpacked_chars <= 0 | max_unpacked_chars >= 99 then max_unpacked_chars = 99; 362 max_unpacked_chars = min (max_unpacked_chars, packable_index); 363 end; 364 365 else do; 366 pack_the_data = "0"b; 367 368 max_unpacked_chars = (tu_size - comm_buffer_position + 1) - 3; 369 if max_unpacked_chars <= 0 | max_unpacked_chars >= 99 then max_unpacked_chars = 99; 370 max_unpacked_chars = min (max_unpacked_chars, chars_left_in_record); 371 end; 372 373 /* Now put in "P" or "U" as appropriate, and set the length. */ 374 375 if pack_the_data 376 then do; 377 data_field_len = possible_packed_length; 378 substr (comm_buffer, comm_buffer_position, 1) = "P"; 379 end; 380 381 else do; 382 data_field_len = max_unpacked_chars; 383 substr (comm_buffer, comm_buffer_position, 1) = "U"; 384 end; 385 386 comm_buffer_position = comm_buffer_position + 1; 387 write_record_state = 4; 388 389 goto NEXT_STATE; 390 391 WRITE_RECORD (4): /* Put in the data length, one digit at a time. */ 392 substr (comm_buffer, comm_buffer_position, 1) = substr (data_field_len, current_digit, 1); 393 394 comm_buffer_position = comm_buffer_position + 1; 395 current_digit = current_digit + 1; 396 397 if current_digit <= length (string (data_field_len)) 398 then write_record_state = 4; 399 else do; 400 current_digit = 1; 401 write_record_state = 5; 402 end; 403 404 goto NEXT_STATE; 405 406 WRITE_RECORD (5): /* Now put in the data, it won't cross the tu boundary. */ 407 if pack_the_data 408 then do; 409 substr (comm_buffer, comm_buffer_position, 1) = possible_packed_char; 410 comm_buffer_position = comm_buffer_position + 1; 411 file_buffer_position = file_buffer_position + possible_packed_length; 412 end; 413 414 else do; 415 substr (comm_buffer, comm_buffer_position, max_unpacked_chars) = 416 substr (file_buffer, file_buffer_position, max_unpacked_chars); 417 comm_buffer_position = comm_buffer_position + max_unpacked_chars; 418 file_buffer_position = file_buffer_position + max_unpacked_chars; 419 end; 420 421 write_record_state = 3; 422 423 goto NEXT_STATE; 424 425 NEXT_STATE: 426 end; /* Output loop. */ 427 428 return; 429 430 end Send_L6_Record; 431 432 Check_For_L6_Error: 433 proc (current_multics_record); 434 435 dcl current_multics_record fixed bin; 436 437 dcl 1 l6_error aligned based (comm_buffer_ptr), 438 /* L6 error message overlay. */ 439 2 header, 440 3 first_char char (1) unaligned, /* Should be "C". */ 441 3 second_char char (1) unaligned, /* Should be "U". */ 442 3 message_len pic "99" unaligned, 443 2 message char (0 refer (l6_error.header.message_len)) unaligned; 444 445 dcl strange_error char (level_6_chars_read) based (comm_buffer_ptr); 446 447 if level_6_chars_read > 0 448 then do; /* Something to look at. */ 449 if l6_error.first_char = "C" & level_6_chars_read >= length (string (l6_error.header)) 450 then call ERROR (error_table_$fatal_error, "Error from the Level 6 after sending record ^d: ^a.", 451 current_multics_record, l6_error.message); 452 453 else if l6_error.first_char = "P" & level_6_chars_read = length (string (prompt)) then ; 454 /* This is not an error, just a prompt. */ 455 456 else call ERROR (error_table_$fatal_error, "Error from the Level 6 after sending record ^d: ^a.", 457 current_multics_record, strange_error); 458 end; 459 460 return; 461 462 end Check_For_L6_Error; 463 464 /*****************************************************************************/ 465 /* */ 466 /* PROCEDURE: ERROR */ 467 /* */ 468 /* This subroutine expects arguments as follows: */ 469 /* */ 470 /* call ERROR (code, ioa_control_string, ioa_arguments, ...) */ 471 /* */ 472 /* where: code is fixed bin (35), and ioa_control_string and ioa_arguments */ 473 /* are optional character strings as defined for ioa_. */ 474 /* */ 475 /* Some global variables are used: */ 476 /* */ 477 /* Cleanup_Handler (a procedure that does cleanup) */ 478 /* */ 479 /* For commands: */ 480 /* report_error (an entry variable set to com_err_ or active_fnc_err_)*/ 481 /* command_name (the character string name of the command) */ 482 /* return_arg_ptr (used to return "false" for active functions) */ 483 /* */ 484 /* For subroutines: */ 485 /* depends on the error reporting strategy chosen. */ 486 /* */ 487 /* At completion a non-local goto is done to the label RETURN. */ 488 /* */ 489 /* Declarations are expected for: */ 490 /* */ 491 /* cu_$arg_list_ptr */ 492 /* cu_$arg_ptr */ 493 /* cu_$arg_count */ 494 /* error_table_$fatal_error */ 495 /* ioa_$general_rs */ 496 /* */ 497 /*****************************************************************************/ 498 499 ERROR: 500 proc () options (variable, non_quick); 501 502 dcl arg_list_ptr ptr; 503 dcl arg_len fixed bin (21); 504 dcl arg_ptr ptr; 505 dcl based_code fixed bin (35) based; 506 dcl caller_code fixed bin (35); 507 dcl code fixed bin (35); 508 dcl err_msg char (256); 509 dcl err_msg_len fixed bin (21); 510 dcl nargs fixed bin; 511 512 call cu_$arg_count (nargs, code); /* IGNORE CODE */ 513 514 if nargs >= 1 515 then do; /* We were called correctly. */ 516 arg_ptr = null (); /* Set this so we know if cu_$arg_ptr worked. */ 517 call cu_$arg_ptr (1, arg_ptr, arg_len, code); 518 519 if arg_ptr ^= null () 520 then caller_code = arg_ptr -> based_code; 521 /* The normal case. */ 522 else caller_code = error_table_$fatal_error; 523 /* Some problem with our arg list. */ 524 525 if nargs > 1 526 then do; /* There is a message. */ 527 call cu_$arg_list_ptr (arg_list_ptr); 528 call ioa_$general_rs (arg_list_ptr, 2, 3, err_msg, err_msg_len, "1"b, "0"b); 529 end; 530 531 else do; /* No message. */ 532 err_msg = ""; 533 err_msg_len = 0; 534 end; 535 end; /* We were called correctly. */ 536 537 else do; /* We were called with no arguments. */ 538 caller_code = error_table_$fatal_error; /* The best we can do. */ 539 err_msg = ""; 540 err_msg_len = 0; 541 end; /* We were called with no arguments. */ 542 543 /* The following lines must be modified depending on the error reporting strategy used. */ 544 545 if level_6_iocbp ^= null () & comm_buffer_ptr ^= null () 546 then do; /* Tell the Level 6. */ 547 548 dcl pic_err_msg_len pic "99"; 549 550 pic_err_msg_len = min (99, err_msg_len); 551 552 call ioa_$rsnpnnl ("CU^a^aR", comm_buffer, level_6_chars_to_write, pic_err_msg_len, 553 substr (err_msg, 1, pic_err_msg_len)); 554 555 call l6_tran_util_$put_chars (level_6_iocbp, comm_buffer_ptr, level_6_chars_to_write, code); 556 end; 557 558 P_error_message = substr (err_msg, 1, err_msg_len); 559 P_code = caller_code; 560 561 /* Clean up and do a non-local goto back to the outermost block. */ 562 563 call Cleanup_Handler (); 564 goto RETURN; 565 566 end ERROR; 567 568 Cleanup_Handler: 569 proc (); 570 571 return; /* Nothing to do for now. */ 572 573 end Cleanup_Handler; 574 575 end l6_tran_send_file_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/05/83 1332.6 l6_tran_send_file_.pl1 >spec>on>10/05/83>l6_tran_send_file_.pl1 73 1 11/12/82 1624.7 l6_tran_constants.incl.pl1 >ldd>include>l6_tran_constants.incl.pl1 108 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 161 186 L6_DATA_TYPE 000012 constant char(1) initial array unaligned dcl 1-31 ref 240 P_code parameter fixed bin(35,0) dcl 34 set ref 26 209* 559* P_end_of_file parameter bit(1) unaligned dcl 218 ref 214 283 P_error_message parameter varying char dcl 33 set ref 26 208* 558* P_input_args_ptr parameter pointer dcl 31 ref 26 113 P_last_file parameter bit(1) unaligned dcl 219 ref 214 286 P_output_args_ptr parameter pointer dcl 32 ref 26 114 P_record_number parameter fixed bin(17,0) dcl 217 ref 214 241 UNSTRUCTURED_FILE_TYPE constant fixed bin(17,0) initial dcl 1-19 ref 161 186 arg_len 000102 automatic fixed bin(21,0) dcl 503 set ref 517* arg_list_ptr 000100 automatic pointer dcl 502 set ref 527* 528* arg_ptr 000104 automatic pointer dcl 504 set ref 516* 517* 519 519 based_code based fixed bin(35,0) dcl 505 ref 519 caller_code 000106 automatic fixed bin(35,0) dcl 506 set ref 519* 522* 538* 559 chars_left_in_record 000150 automatic fixed bin(21,0) dcl 221 set ref 318* 321 335 339 344 344 370 code 000107 automatic fixed bin(35,0) dcl 507 in procedure "ERROR" set ref 512* 517* 555* code 000151 automatic fixed bin(35,0) dcl 222 in procedure "Send_L6_Record" set ref 252* 253 253* 259* 261 261* 290* 291 291* code 000105 automatic fixed bin(35,0) dcl 43 in procedure "l6_tran_send_file_" set ref 143* 145 145* 155* 156 156 156 156* 168 180* 181 181 181 181* 193 201* 202 202* comm_buffer based char unaligned dcl 38 set ref 147 273* 286* 288* 296* 303* 323* 378* 383* 391* 409* 415* 552* comm_buffer_len 000100 automatic fixed bin(21,0) dcl 39 in procedure "l6_tran_send_file_" set ref 126* 143* 147 201* 259* 273 286 288 296 303 323 378 383 391 409 415 552 552 comm_buffer_len 6 based fixed bin(21,0) level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_send_file_" ref 126 comm_buffer_position 000104 automatic fixed bin(21,0) dcl 41 set ref 136* 247 247 250 270* 273 275* 275 286 288 290* 296 298* 298 303 306* 306 323 325* 325 360 368 378 383 386* 386 391 394* 394 409 410* 410 415 417* 417 comm_buffer_ptr 000102 automatic pointer dcl 40 in procedure "l6_tran_send_file_" set ref 111* 125* 143* 147 201* 252* 259* 273 286 288 290* 296 303 323 378 383 391 409 415 449 449 449 453 456 545 552 555* comm_buffer_ptr 4 based pointer level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_send_file_" ref 125 comm_iocbp 2 based pointer level 2 dcl 2-12 ref 124 cu_$arg_count 000020 constant entry external dcl 85 ref 512 cu_$arg_list_ptr 000022 constant entry external dcl 86 ref 527 cu_$arg_ptr 000024 constant entry external dcl 87 ref 517 current_digit 000152 automatic fixed bin(17,0) dcl 223 set ref 238* 303 307* 307 309 312* 391 395* 395 397 400* current_multics_record parameter fixed bin(17,0) dcl 435 set ref 432 449* 456* data_field_len 000153 automatic picture(2) unaligned dcl 224 set ref 377* 382* 391 397 data_type 16 based fixed bin(17,0) level 2 dcl 2-12 ref 131 end_of_file 000106 automatic bit(1) unaligned dcl 44 set ref 168* 170 174* 193* 196* end_of_record 000154 automatic bit(1) unaligned dcl 225 set ref 244* 245 293* 326* err_msg 000110 automatic char(256) unaligned dcl 508 set ref 528* 532* 539* 552 552 558 err_msg_len 000210 automatic fixed bin(21,0) dcl 509 set ref 528* 533* 540* 550 558 error_table_$end_of_info 000010 external static fixed bin(35,0) dcl 77 ref 156 168 181 193 error_table_$fatal_error 000012 external static fixed bin(35,0) dcl 78 set ref 449* 456* 522 538 error_table_$short_record 000014 external static fixed bin(35,0) dcl 79 ref 156 181 error_table_$unimplemented_version 000016 external static fixed bin(35,0) dcl 80 set ref 116* 120* file_buffer based char unaligned dcl 46 set ref 164* 189* 337 339 415 file_buffer_len 000107 automatic fixed bin(21,0) dcl 47 in procedure "l6_tran_send_file_" set ref 129* 155* 164 180* 189 337 339 415 file_buffer_len 14 based fixed bin(21,0) level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_send_file_" ref 129 file_buffer_position 000155 automatic fixed bin(21,0) dcl 226 set ref 239* 318 337 339 411* 411 415 418* 418 file_buffer_ptr 12 based pointer level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_send_file_" ref 128 file_buffer_ptr 000110 automatic pointer dcl 48 in procedure "l6_tran_send_file_" set ref 128* 155* 164 180* 189 337 339 415 file_iocbp 10 based pointer level 2 dcl 2-12 ref 127 file_type 15 based fixed bin(17,0) level 2 dcl 2-12 ref 130 first_char based char(1) level 3 packed unaligned dcl 437 ref 449 453 flags 20 based structure level 2 dcl 2-12 header based structure level 2 dcl 437 ref 449 ioa_$general_rs 000026 constant entry external dcl 88 ref 528 ioa_$rsnpnnl 000030 constant entry external dcl 90 ref 552 iox_$read_record 000032 constant entry external dcl 91 ref 155 180 l6_error based structure level 1 dcl 437 l6_tran_util_$get_chars 000034 constant entry external dcl 92 ref 143 201 259 l6_tran_util_$put_chars 000036 constant entry external dcl 93 ref 252 290 555 l6_tran_util_$read_status 000040 constant entry external dcl 94 ref 257 last_file 20 based bit(1) level 3 in structure "transfer_input_args" packed unaligned dcl 2-12 in procedure "l6_tran_send_file_" ref 133 last_file 000112 automatic bit(1) unaligned dcl 50 in procedure "l6_tran_send_file_" set ref 133* 174* 196* length builtin function dcl 98 ref 309 397 449 453 level_6_chars_read 000113 automatic fixed bin(21,0) dcl 52 set ref 143* 147 201* 259* 447 449 453 456 456 level_6_chars_to_write 000114 automatic fixed bin(21,0) dcl 53 set ref 552* 555* level_6_iocbp 000116 automatic pointer dcl 54 set ref 110* 124* 143* 201* 252* 257* 259* 290* 545 555* max_unpacked_chars 000156 automatic fixed bin(17,0) dcl 227 set ref 360* 361 361 361* 362* 362 368* 369 369 369* 370* 370 382 415 415 417 418 media_code 000157 automatic char(1) unaligned dcl 228 set ref 240* 296 message 1 based char level 2 packed unaligned dcl 437 set ref 449* message_len 0(18) based picture(2) level 3 packed unaligned dcl 437 ref 449 449 min builtin function dcl 99 ref 241 335 339 344 344 362 370 550 mod builtin function dcl 100 ref 276 multics_chars_read 000120 automatic fixed bin(21,0) dcl 56 set ref 155* 161 163* 167 174 180* 186 188* 192 318 multics_data_type 000121 automatic fixed bin(17,0) dcl 57 set ref 131* 161 186 240 multics_file_iocbp 000124 automatic pointer dcl 59 set ref 127* 155* 180* multics_file_type 000122 automatic fixed bin(17,0) dcl 58 set ref 130* 161 186 nargs 000211 automatic fixed bin(17,0) dcl 510 set ref 512* 514 525 next_transmission_unit 000126 automatic fixed bin(17,0) dcl 61 set ref 137* 272 276* 276 null builtin function dcl 101 ref 110 111 516 519 545 545 pack_the_data 000161 automatic bit(1) unaligned dcl 230 set ref 354* 358* 366* 375 406 packable_index 000162 automatic fixed bin(17,0) dcl 231 set ref 335* 337 339 339 344 344* 352* 352 354 356 362 packable_string 000163 automatic bit(1) unaligned dcl 232 set ref 333* 335 347* 349* 354 356 pic_err_msg_len 000212 automatic picture(2) unaligned dcl 548 set ref 550* 552* 552 552 pic_next_tu 000160 automatic picture(1) unaligned dcl 229 set ref 272* 273 possible_packed_char 000164 automatic char(1) unaligned dcl 233 set ref 337* 339 409 possible_packed_length 000165 automatic fixed bin(17,0) dcl 234 set ref 339* 344 344* 347 377 411 prompt 000130 automatic structure level 1 dcl 63 set ref 147* 453 prompt_char 000130 automatic char(1) initial level 2 packed unaligned dcl 63 set ref 63* prompt_read 20(01) based bit(1) level 3 packed unaligned dcl 2-12 ref 141 record_number 000132 automatic fixed bin(17,0) dcl 67 in procedure "l6_tran_send_file_" set ref 170* 174* 176* 176 181* 196* 204 206 record_number 000166 automatic picture(5) unaligned dcl 235 in procedure "Send_L6_Record" set ref 241* 261* 266 303 309 record_number 2 based fixed bin(17,0) level 2 in structure "transfer_output_args" dcl 2-33 in procedure "l6_tran_send_file_" set ref 206* record_number 0(09) 000130 automatic picture(5) level 2 in structure "prompt" packed unaligned dcl 63 in procedure "l6_tran_send_file_" set ref 149 strange_error based char unaligned dcl 445 set ref 456* string builtin function dcl 102 set ref 147* 273 397 449 453 substr builtin function dcl 103 set ref 147 164* 189* 273* 286* 288* 296* 303* 303 323* 337 339 378* 383* 391* 391 409* 415* 415 552 552 558 tiap 000136 automatic pointer dcl 2-9 set ref 113* 116 116 124 125 126 127 128 129 130 131 132 133 141 toap 000140 automatic pointer dcl 2-30 set ref 114* 120 120 206 207 total_bytes 000133 automatic fixed bin(35,0) dcl 68 in procedure "l6_tran_send_file_" set ref 134* 167* 167 192* 192 207 total_bytes 3 based fixed bin(35,0) level 2 in structure "transfer_output_args" dcl 2-33 in procedure "l6_tran_send_file_" set ref 207* 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 116 116* 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 120 120* tu_size 17 based fixed bin(21,0) level 2 in structure "transfer_input_args" dcl 2-12 in procedure "l6_tran_send_file_" ref 132 tu_size 000134 automatic fixed bin(21,0) dcl 69 in procedure "l6_tran_send_file_" set ref 132* 247 250 252* 360 368 verify builtin function dcl 104 ref 339 version based char(8) level 2 in structure "transfer_input_args" packed unaligned dcl 2-12 in procedure "l6_tran_send_file_" set ref 116 116* version based char(8) level 2 in structure "transfer_output_args" packed unaligned dcl 2-33 in procedure "l6_tran_send_file_" set ref 120 120* write_record_state 000170 automatic fixed bin(17,0) dcl 236 set ref 242* 281 299* 309* 313* 387* 397* 401* 421* 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 HT internal static char(1) initial unaligned dcl 1-10 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 SP internal static char(1) initial unaligned dcl 1-8 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. Check_For_L6_Error 001631 constant entry internal dcl 432 ref 204 266 Cleanup_Handler 002275 constant entry internal dcl 568 ref 563 ERROR 001761 constant entry internal dcl 499 ref 116 120 145 156 181 202 253 261 291 449 456 NEXT_STATE 001630 constant label dcl 425 ref 278 301 316 328 389 404 423 RETURN 000776 constant label dcl 211 ref 564 Send_L6_Record 000777 constant entry internal dcl 214 ref 174 196 WRITE_RECORD 000000 constant label array(5) dcl 283 ref 281 l6_tran_send_file_ 000245 constant entry external dcl 26 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2526 2570 2335 2536 Length 3026 2335 42 221 171 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME l6_tran_send_file_ 274 external procedure is an external procedure. Send_L6_Record internal procedure shares stack frame of external procedure l6_tran_send_file_. Check_For_L6_Error internal procedure shares stack frame of external procedure l6_tran_send_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_send_file_ 000100 comm_buffer_len l6_tran_send_file_ 000102 comm_buffer_ptr l6_tran_send_file_ 000104 comm_buffer_position l6_tran_send_file_ 000105 code l6_tran_send_file_ 000106 end_of_file l6_tran_send_file_ 000107 file_buffer_len l6_tran_send_file_ 000110 file_buffer_ptr l6_tran_send_file_ 000112 last_file l6_tran_send_file_ 000113 level_6_chars_read l6_tran_send_file_ 000114 level_6_chars_to_write l6_tran_send_file_ 000116 level_6_iocbp l6_tran_send_file_ 000120 multics_chars_read l6_tran_send_file_ 000121 multics_data_type l6_tran_send_file_ 000122 multics_file_type l6_tran_send_file_ 000124 multics_file_iocbp l6_tran_send_file_ 000126 next_transmission_unit l6_tran_send_file_ 000130 prompt l6_tran_send_file_ 000132 record_number l6_tran_send_file_ 000133 total_bytes l6_tran_send_file_ 000134 tu_size l6_tran_send_file_ 000136 tiap l6_tran_send_file_ 000140 toap l6_tran_send_file_ 000150 chars_left_in_record Send_L6_Record 000151 code Send_L6_Record 000152 current_digit Send_L6_Record 000153 data_field_len Send_L6_Record 000154 end_of_record Send_L6_Record 000155 file_buffer_position Send_L6_Record 000156 max_unpacked_chars Send_L6_Record 000157 media_code Send_L6_Record 000160 pic_next_tu Send_L6_Record 000161 pack_the_data Send_L6_Record 000162 packable_index Send_L6_Record 000163 packable_string Send_L6_Record 000164 possible_packed_char Send_L6_Record 000165 possible_packed_length Send_L6_Record 000166 record_number Send_L6_Record 000170 write_record_state Send_L6_Record THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_cs call_ext_out_desc call_ext_out call_int_this_desc return tra_ext mod_fx1 shorten_stack ext_entry_desc int_entry verify_eis unpack_pic THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr ioa_$general_rs ioa_$rsnpnnl iox_$read_record l6_tran_util_$get_chars l6_tran_util_$put_chars l6_tran_util_$read_status THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$end_of_info error_table_$fatal_error error_table_$short_record error_table_$unimplemented_version LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 26 000240 63 000260 110 000262 111 000264 113 000265 114 000271 116 000274 120 000326 124 000362 125 000365 126 000370 127 000373 128 000375 129 000377 130 000401 131 000403 132 000405 133 000407 134 000412 136 000413 137 000415 141 000416 143 000421 145 000440 147 000461 149 000467 155 000501 156 000520 161 000546 163 000556 164 000560 167 000564 168 000570 170 000575 174 000601 176 000606 180 000610 181 000627 186 000664 188 000674 189 000676 192 000702 193 000706 194 000715 196 000717 201 000721 202 000740 204 000761 206 000765 207 000770 208 000772 209 000775 211 000776 214 000777 238 001001 239 001003 240 001005 241 001012 242 001027 244 001031 245 001032 247 001034 250 001044 252 001047 253 001064 257 001105 259 001121 261 001140 266 001165 270 001176 272 001200 273 001210 275 001214 276 001215 278 001222 281 001223 283 001225 286 001233 288 001245 290 001251 291 001266 293 001307 294 001311 296 001312 298 001316 299 001317 301 001321 303 001322 306 001327 307 001330 309 001331 312 001337 313 001341 316 001343 318 001344 321 001350 323 001351 325 001356 326 001357 328 001361 333 001362 335 001363 337 001377 339 001405 344 001425 347 001433 349 001441 350 001442 352 001444 354 001446 356 001455 358 001461 360 001462 361 001466 362 001473 363 001477 366 001500 368 001501 369 001505 370 001512 375 001516 377 001520 378 001530 379 001535 382 001536 383 001546 386 001553 387 001554 389 001556 391 001557 394 001564 395 001565 397 001566 400 001574 401 001576 404 001600 406 001601 409 001603 410 001607 411 001610 412 001612 415 001613 417 001622 418 001624 421 001625 423 001627 428 001630 432 001631 447 001633 449 001635 453 001714 456 001723 460 001757 499 001760 512 001766 514 001776 516 002001 517 002003 519 002022 522 002031 525 002034 527 002037 528 002046 529 002115 532 002116 533 002121 535 002122 538 002123 539 002126 540 002131 545 002132 550 002143 552 002160 555 002235 558 002254 559 002267 563 002271 564 002272 568 002275 571 002276 ----------------------------------------------------------- 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