COMPILATION LISTING OF SEGMENT imft_hasp_ Compiled by: Multics PL/I Compiler, Release 28b, of April 11, 1983 Compiled at: Honeywell LCPD Phoenix, System M Compiled on: 07/19/83 1222.4 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 7 8 /* I/O module to translate between IMFT logical records and HASP physical records */ 9 10 /* Created: January 1983 by Robert Coren using Gary Palter's hasp-only imft_io_ as a base */ 11 /* Modified: June 1983 by Robert Coren to requote attach options when building attach description */ 12 13 /* format: style4,delnl,insnl,ifthenstmt,ifthen */ 14 15 16 imft_hasp_: 17 procedure (); 18 return; /* not an entry */ 19 20 21 /* Parameters */ 22 23 dcl P_iocb_ptr pointer parameter; /* *: -> I/O switch being operated upon */ 24 dcl P_code fixed binary (35) parameter; 25 26 dcl P_attach_options (*) character (*) varying parameter; /* attach: attachment arguments */ 27 dcl P_loud_sw bit (1) parameter; /* attach: ON => attachment errors should call com_err_ */ 28 29 dcl P_open_mode fixed binary parameter; /* open: opening mode */ 30 dcl P_open_sw bit (1) parameter; /* open: obsolete parameter */ 31 32 dcl P_record_length fixed binary (21) parameter; /* read_record: set to # of characters read into buffer; 33* write_record: # of characters to transmit as logical record */ 34 35 dcl P_buffer_ptr pointer parameter; /* read_record: -> area to place result of read */ 36 dcl P_buffer_max_lth fixed binary (21) parameter; /* read_record: size of area in characters */ 37 38 dcl P_record_ptr pointer parameter; /* write_record: -> record to be written */ 39 40 dcl P_order character (*) parameter; /* control: name of control order to be performed */ 41 dcl P_info_ptr pointer parameter; /* control: -> additional information required to execute the 42* control order */ 43 44 dcl P_new_modes character (*) parameter; /* modes: new modes to be set */ 45 dcl P_old_modes character (*) parameter; /* modes: set to modes in effect before change */ 46 47 48 /* Local copies of parameters */ 49 50 dcl iocb_ptr pointer; 51 dcl code fixed binary (35); 52 dcl loud_sw bit (1) aligned; 53 dcl open_mode fixed binary; 54 55 56 /* Remaining declarations */ 57 58 dcl system_area area aligned based (system_area_ptr); 59 dcl system_area_ptr pointer; 60 61 dcl arg_index fixed binary; /* # of attach option being processed */ 62 63 64 dcl terminal_attach_desc character (512); 65 dcl terminal_switch_name character (32); 66 67 dcl module_type character (12); /* "host_" or "workstation_" */ 68 69 dcl data_received fixed bin (21); 70 dcl packed_length fixed bin (21); 71 dcl unpacked_chars fixed bin (21); 72 73 dcl logical_record_data character (logical_record_data_lth) unaligned based (logical_record_data_ptr); 74 dcl logical_record_data_lth fixed binary (21); 75 dcl logical_record_data_ptr pointer; 76 77 dcl logical_record_data_bits_lth fixed binary (24); 78 79 dcl amount_left fixed binary (21); 80 dcl amount_sent fixed binary (24); /* may hold bit counters */ 81 dcl amount_to_send fixed binary (21); 82 dcl fb14uu fixed binary (14) unaligned unsigned; 83 dcl data_bytes char (n_bytes) based; 84 dcl n_bytes fixed bin (21); 85 86 dcl ips_mask bit (36); 87 88 dcl IMFT_HASP_ character (32) static options (constant) initial ("imft_hasp_"); 89 90 dcl N_BITS_PER_CHARACTER fixed binary static options (constant) initial (9); 91 92 /* format: off */ 93 dcl (error_table_$action_not_performed, 94 error_table_$bad_mode, error_table_$eof_record, error_table_$improper_data_format, 95 error_table_$long_record, error_table_$not_attached, 96 error_table_$not_closed, error_table_$not_detached, error_table_$not_open, 97 error_table_$short_record, error_table_$unimplemented_version) 98 fixed binary (35) external; 99 100 /* format: on */ 101 102 dcl com_err_ entry () options (variable); 103 dcl continue_to_signal_ entry (fixed binary (35)); 104 dcl cu_$arg_list_ptr entry () returns (pointer); 105 dcl cu_$arg_ptr entry (fixed binary, pointer, fixed binary (21), fixed binary (35)); 106 dcl get_system_free_area_ entry () returns (pointer); 107 dcl hcs_$reset_ips_mask entry (bit (36), bit (36)); 108 dcl hcs_$set_ips_mask entry (bit (36), bit (36)); 109 dcl ioa_$general_rs entry (pointer, fixed binary, fixed binary, character (*), fixed binary (21), bit (1), bit (1)); 110 dcl iox_$attach_ioname entry (character (*), pointer, character (*), fixed binary (35)); 111 dcl iox_$control entry (pointer, character (*), pointer, fixed binary (35)); 112 dcl iox_$close entry (pointer, fixed binary (35)); 113 dcl iox_$destroy_iocb entry (pointer, fixed binary (35)); 114 dcl iox_$detach_iocb entry (pointer, fixed binary (35)); 115 dcl iox_$err_no_operation entry () options (variable); 116 dcl iox_$open entry (pointer, fixed binary, bit (1) aligned, fixed binary (35)); 117 dcl iox_$propagate entry (pointer); 118 dcl iox_$read_record entry (pointer, pointer, fixed binary (21), fixed binary (21), fixed binary (35)); 119 dcl iox_$write_record entry (pointer, pointer, fixed binary (21), fixed binary (35)); 120 dcl requote_string_ entry (char (*)) returns (char (*)); 121 122 dcl (any_other, cleanup) condition; 123 124 dcl (addbitno, addcharno, addr, bin, bit, currentsize, divide, hbound, index, lbound, length, min, mod, null, rtrim, 125 size, string, substr, unspec) builtin; 126 127 /* */ 128 129 /* Description of a switch attached through this module */ 130 131 dcl 1 iad aligned based (iad_ptr), 132 2 attach_description character (1024) varying, /* attach description for this I/O switch */ 133 2 open_description character (24) varying, /* open description for this I/O switch */ 134 2 switch like switch_info, /* defines the terminal switch */ 135 2 flags aligned, 136 3 input_direction bit (1) unaligned, /* ON => receives data from remote system */ 137 3 pad bit (35) unaligned; 138 139 dcl iad_ptr pointer; 140 141 142 /* Description of a single terminal level I/O switch */ 143 144 dcl 1 switch_info aligned based, 145 2 terminal_iocb_ptr pointer, /* -> IOCB for terminal level module */ 146 2 current_physical_record_type fixed binary, /* type of record currently in buffer (if any) */ 147 2 current_physical_record_n_els fixed binary (24), /* # of characters or bits in current record */ 148 2 current_physical_record_used fixed binary (24), /* # of characters or bits already returned to caller */ 149 2 pad bit (36), 150 2 tior, /* terminal_io_record used for I/O */ 151 3 header like terminal_io_record.header, 152 3 data character (IMFT_PHYSICAL_RECORD_LTH) unaligned; 153 154 155 /* */ 156 157 /* Physical record structure used to transmit data and control information */ 158 159 dcl 1 imft_physical_record aligned based (ipr_ptr), 160 2 pad1 bit (11) unaligned, 161 2 flags unaligned, 162 3 binary bit (1) unaligned, /* ON => binary data in record as 7-bit bytes */ 163 3 bolr bit (1) unaligned, /* ON => this is first physical record of a logical record */ 164 3 eolr bit (1) unaligned, /* ON => last physical record in logical record */ 165 3 pad3 bit (4) unaligned, 166 2 n_els unaligned, /* # of elements (characters or 7-bit bytes) */ 167 3 pad4 bit (2) unaligned, 168 3 high_order bit (7) unaligned, 169 3 pad5 bit (2) unaligned, 170 3 low_order bit (7) unaligned, 171 2 data character (IMFT_PHYSICAL_RECORD_DATA_LTH) unaligned; 172 /* the actual data */ 173 174 175 dcl ipr_ptr pointer; 176 177 dcl ( 178 IMFT_PHYSICAL_RECORD_LTH initial (180), /* size of each physical record */ 179 IMFT_PHYSICAL_RECORD_DATA_LTH initial (176), /* # of bytes of user's data in each record */ 180 IMFT_PHYSICAL_RECORD_DATA_BITS_LTH initial (1232) /* # of bits of user's data in each record for binary data */ 181 ) fixed binary static options (constant); 182 183 /* */ 184 185 /* Attach an I/O switch for file transfer */ 186 187 imft_hasp_host_attach: 188 entry (P_iocb_ptr, P_attach_options, P_loud_sw, P_code); 189 190 module_type = "host_"; 191 go to ATTACH_COMMON; 192 193 imft_hasp_workstation_attach: 194 entry (P_iocb_ptr, P_attach_options, P_loud_sw, P_code); 195 196 module_type = "workstation_"; 197 198 ATTACH_COMMON: 199 iocb_ptr = P_iocb_ptr; 200 loud_sw = P_loud_sw; 201 code = 0; 202 203 iad_ptr = null (); /* avoid freeing garbage if I/O switch already attached */ 204 205 if iocb_ptr -> iocb.attach_descrip_ptr ^= null () then do; 206 P_code = error_table_$not_detached; 207 if loud_sw then call com_err_ (P_code, IMFT_HASP_, "For switch ^a.", iocb_ptr -> iocb.name); 208 return; 209 end; 210 211 system_area_ptr = get_system_free_area_ (); 212 213 on condition (cleanup) call cleanup_attachment ((0)); 214 215 216 217 allocate iad in (system_area) set (iad_ptr); 218 iad.switch.terminal_iocb_ptr = null (); /* keeps cleanup handler happy */ 219 220 iad.attach_description = ""; 221 iad.open_description = ""; 222 223 224 do arg_index = lbound (P_attach_options, 1) to hbound (P_attach_options, 1); 225 iad.attach_description = iad.attach_description || " " || requote_string_ ((P_attach_options (arg_index))); 226 end; 227 228 if index (iocb_ptr -> iocb.name, ".input.") ^= 0 then iad.input_direction = "1"b; 229 230 else if index (iocb_ptr -> iocb.name, ".output.") ^= 0 then iad.input_direction = "0"b; 231 232 else call abort_attachment (0, "Swtich name ^a does not specify input or output", iocb_ptr -> iocb.name); 233 234 terminal_switch_name = "hasp_" || substr (module_type, 1, 1) || "." || rtrim (iocb_ptr -> iocb.name); 235 236 terminal_attach_desc = "hasp_" || rtrim (module_type) || iad.attach_description; 237 /* note that iad.attach_description already has leading space */ 238 239 call iox_$attach_ioname (terminal_switch_name, iad.switch.terminal_iocb_ptr, terminal_attach_desc, code); 240 if code ^= 0 then call abort_attachment (code, "Unable to attach channel via: ^a", terminal_attach_desc); 241 242 /* Initialize the terminal switch structure */ 243 244 iad.switch.current_physical_record_type = -1; 245 iad.switch.current_physical_record_n_els = 0; 246 iad.switch.current_physical_record_used = 0; 247 248 iad.switch.tior.version = terminal_io_record_version_1; 249 250 if module_type = "workstation_" then do; 251 if iad.input_direction then 252 iad.switch.tior.device_type = READER_DEVICE; 253 else iad.switch.tior.device_type = PUNCH_DEVICE; 254 end; 255 256 else do; 257 if iad.input_direction then 258 iad.switch.tior.device_type = PUNCH_DEVICE; 259 else iad.switch.tior.device_type = READER_DEVICE; 260 end; 261 262 iad.switch.tior.slew_type = SLEW_BY_COUNT; 263 iad.switch.tior.slew_count = 1; 264 265 string (iad.switch.tior.flags) = ""b; 266 267 iad.switch.tior.element_size = N_BITS_PER_CHARACTER; 268 iad.switch.tior.n_elements = IMFT_PHYSICAL_RECORD_LTH; 269 270 /* Mask and complete construction of the IOCB */ 271 272 ips_mask = ""b; 273 274 on condition (any_other) call any_other_handler (); 275 276 call hcs_$set_ips_mask (((36)"0"b), ips_mask); 277 278 iocb_ptr -> iocb.attach_descrip_ptr = addr (iad.attach_description); 279 iocb_ptr -> iocb.attach_data_ptr = iad_ptr; 280 iocb_ptr -> iocb.open = imft_hasp_open; 281 iocb_ptr -> iocb.detach_iocb = imft_hasp_detach; 282 283 call iox_$propagate (iocb_ptr); 284 285 call hcs_$reset_ips_mask (ips_mask, ips_mask); 286 287 RETURN_FROM_ATTACH: 288 P_code = code; 289 return; 290 291 /* */ 292 293 /* Open an I/O switch for file transfer */ 294 295 imft_hasp_open: 296 entry (P_iocb_ptr, P_open_mode, P_open_sw, P_code); 297 298 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 299 iad_ptr = iocb_ptr -> iocb.attach_data_ptr; 300 301 if iocb_ptr -> iocb.open_descrip_ptr ^= null () then do; 302 P_code = error_table_$not_closed; 303 return; 304 end; 305 306 open_mode = P_open_mode; 307 308 if ^((iad.input_direction & (open_mode = Sequential_input)) 309 | (^iad.input_direction & (open_mode = Sequential_output))) then do; 310 /* opening mode and direction must agree */ 311 P_code = error_table_$bad_mode; 312 return; 313 end; 314 315 call iox_$open (iad.switch.terminal_iocb_ptr, open_mode, "0"b, P_code); 316 if P_code ^= 0 then return; 317 318 iad.open_description = rtrim (iox_modes (open_mode)); 319 320 ips_mask = ""b; 321 322 on condition (any_other) call any_other_handler (); 323 324 call hcs_$set_ips_mask (((36)"0"b), ips_mask); 325 326 if iad.input_direction then 327 iocb_ptr -> iocb.read_record = imft_hasp_read_record; 328 else iocb_ptr -> iocb.write_record = imft_hasp_write_record; 329 330 iocb_ptr -> iocb.control = imft_hasp_control; 331 iocb_ptr -> iocb.modes = imft_hasp_modes; 332 333 iocb_ptr -> iocb.close = imft_hasp_close; 334 iocb_ptr -> iocb.detach_iocb = imft_hasp_detach; 335 336 iocb_ptr -> iocb.open_descrip_ptr = addr (iad.open_description); 337 /* it's now open */ 338 339 call iox_$propagate (iocb_ptr); 340 341 call hcs_$reset_ips_mask (ips_mask, ips_mask); 342 343 P_code = 0; 344 return; 345 346 /* */ 347 348 /* Close an I/O switch used for file transfer */ 349 350 imft_hasp_close: 351 entry (P_iocb_ptr, P_code); 352 353 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 354 iad_ptr = iocb_ptr -> iocb.attach_data_ptr; 355 code = 0; 356 357 if iocb_ptr -> iocb.open_descrip_ptr = null () then do; 358 P_code = error_table_$not_open; 359 return; 360 end; 361 362 call iox_$close (iad.switch.terminal_iocb_ptr, code); 363 if (code = error_table_$not_open) | (code = error_table_$not_attached) then code = 0; 364 365 ips_mask = ""b; 366 367 on condition (cleanup) call any_other_handler (); 368 369 call hcs_$set_ips_mask (((36)"0"b), ips_mask); 370 371 iocb_ptr -> iocb.open_descrip_ptr = null (); 372 373 iocb_ptr -> iocb.open = imft_hasp_open; 374 iocb_ptr -> iocb.detach_iocb = imft_hasp_detach; 375 376 iocb_ptr -> iocb.control, iocb_ptr -> iocb.modes, iocb_ptr -> iocb.read_record, iocb_ptr -> iocb.write_record = 377 iox_$err_no_operation; 378 379 call iox_$propagate (iocb_ptr); 380 381 call hcs_$reset_ips_mask (ips_mask, ips_mask); 382 383 P_code = code; 384 385 return; 386 387 /* */ 388 389 /* Detach an I/O switch from file transfer */ 390 391 imft_hasp_detach: 392 entry (P_iocb_ptr, P_code); 393 394 iocb_ptr = P_iocb_ptr; 395 code = 0; 396 397 if iocb_ptr -> iocb.attach_descrip_ptr = null () then do; 398 P_code = error_table_$not_attached; 399 return; 400 end; 401 402 if iocb_ptr -> iocb.open_descrip_ptr ^= null () then do; 403 P_code = error_table_$not_closed; 404 return; 405 end; 406 407 system_area_ptr = get_system_free_area_ (); 408 409 iad_ptr = iocb_ptr -> iocb.attach_data_ptr; 410 411 call cleanup_attachment (code); 412 413 ips_mask = ""b; 414 415 on condition (any_other) call any_other_handler (); 416 417 call hcs_$set_ips_mask (((36)"0"b), ips_mask); 418 419 iocb_ptr -> iocb.attach_descrip_ptr = null (); /* it's detached */ 420 421 call iox_$propagate (iocb_ptr); 422 423 call hcs_$reset_ips_mask (ips_mask, ips_mask); 424 425 P_code = code; /* in case trouble freeing the channel */ 426 return; 427 428 /* */ 429 430 /* Perform control operations on an I/O switch attached for file transfer */ 431 432 imft_hasp_control: 433 entry (P_iocb_ptr, P_order, P_info_ptr, P_code); 434 435 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 436 iad_ptr = iocb_ptr -> attach_data_ptr; 437 call iox_$control (iad.switch.terminal_iocb_ptr, P_order, P_info_ptr, P_code); 438 /* just pass all orders on */ 439 return; 440 441 /* */ 442 443 /* Change modes: no modes are supported */ 444 445 imft_hasp_modes: 446 entry (P_iocb_ptr, P_new_modes, P_old_modes, P_code); 447 448 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 449 P_old_modes = ""; /* no modes are reflected to caller */ 450 451 if P_new_modes = "" then 452 P_code = 0; 453 else P_code = error_table_$bad_mode; 454 455 return; 456 457 /* */ 458 459 /* Transmit a logical record to the remote system as multiple physical records */ 460 461 imft_hasp_write_record: 462 entry (P_iocb_ptr, P_record_ptr, P_record_length, P_code); 463 464 iocb_ptr = P_iocb_ptr; 465 ilr_ptr = P_record_ptr; 466 iad_ptr = iocb_ptr -> iocb.attach_data_ptr; 467 468 logical_record_data_ptr = addr (imft_logical_record.contents); 469 logical_record_data_lth = imft_logical_record.length; 470 471 terminal_io_record_ptr = addr (iad.switch.tior); 472 ipr_ptr = addr (terminal_io_record.data); 473 474 unspec (imft_physical_record) = ""b; /* start out clean */ 475 476 /* logical record header is sent as a separate physical record, which is always binary */ 477 478 imft_physical_record.binary = "1"b; 479 imft_physical_record.bolr = "1"b; 480 imft_physical_record.eolr = (logical_record_data_lth = 0); 481 482 call unpack (ilr_ptr, addr (imft_physical_record.data), length (unspec (imft_logical_record_header)), 483 unpacked_chars); 484 485 imft_physical_record.n_els.low_order = bit (bin (unpacked_chars, 7), 7); 486 /* this assumes that the length of the header will always fit in 7 bits */ 487 call transmit_physical_record (unpacked_chars, P_code); 488 if P_code ^= 0 then return; 489 490 imft_physical_record.bolr = "0"b; 491 492 /* Now send the rest of the data (if any), unpacking only if necessary */ 493 494 amount_sent = 0; 495 496 497 if logical_record_data_lth ^= 0 then 498 if imft_logical_record.binary | imft_logical_record.eight_bit then do; 499 500 /* Binary data: unpack 7 bits at a time into 9 bit forming valid ASCII characters for transmission. At some future time, 501* support for binary transmission should be provided */ 502 503 logical_record_data_bits_lth = N_BITS_PER_CHARACTER * logical_record_data_lth; 504 505 do while (amount_sent < logical_record_data_bits_lth); 506 507 imft_physical_record.binary = "1"b; 508 509 amount_left = logical_record_data_bits_lth - amount_sent; 510 amount_to_send = min (amount_left, IMFT_PHYSICAL_RECORD_DATA_BITS_LTH); 511 /* are using 7 bits per character */ 512 513 call unpack (addbitno (logical_record_data_ptr, amount_sent), addr (imft_physical_record.data), 514 amount_to_send, unpacked_chars); 515 516 fb14uu = unpacked_chars; /* put # of characters in record into the record */ 517 imft_physical_record.n_els.high_order = substr (unspec (fb14uu), 1, 7); 518 imft_physical_record.n_els.low_order = substr (unspec (fb14uu), 8, 7); 519 520 if amount_to_send = amount_left then 521 /* last physical record */ 522 imft_physical_record.eolr = "1"b; 523 524 call transmit_physical_record (unpacked_chars, P_code); 525 /* zap! */ 526 if P_code ^= 0 then return; 527 528 amount_sent = amount_sent + amount_to_send; 529 end; 530 end; 531 532 533 else do; 534 535 /* Character only data */ 536 537 do while (amount_sent < logical_record_data_lth); 538 539 amount_left = logical_record_data_lth - amount_sent; 540 amount_to_send = min (amount_left, IMFT_PHYSICAL_RECORD_DATA_LTH); 541 /* determine how much to send now */ 542 imft_physical_record.data = substr (logical_record_data, (amount_sent + 1), amount_to_send); 543 544 fb14uu = amount_to_send; /* put # of characters in record into the record */ 545 imft_physical_record.n_els.high_order = substr (unspec (fb14uu), 1, 7); 546 imft_physical_record.n_els.low_order = substr (unspec (fb14uu), 8, 7); 547 548 if amount_to_send = amount_left then 549 /* last physical record */ 550 imft_physical_record.eolr = "1"b; 551 552 call transmit_physical_record (amount_to_send, P_code); 553 /* zap! */ 554 if P_code ^= 0 then return; 555 556 amount_sent = amount_sent + amount_to_send; 557 end; 558 end; 559 560 return; 561 562 /* */ 563 564 /* Receive the contents of a logical record from the remote system */ 565 566 imft_hasp_read_record: 567 entry (P_iocb_ptr, P_buffer_ptr, P_buffer_max_lth, P_record_length, P_code); 568 569 iocb_ptr = P_iocb_ptr; 570 ilr_ptr = P_buffer_ptr; 571 iad_ptr = iocb_ptr -> iocb.attach_data_ptr; 572 573 terminal_io_record_ptr = addr (iad.switch.tior); 574 ipr_ptr = addr (terminal_io_record.data); 575 576 /* read header record (which is always binary) */ 577 578 call receive_physical_record (n_bytes, P_code); 579 if P_code ^= 0 then return; 580 581 if ^imft_physical_record.bolr /* not first in logical record? */ 582 then do; 583 P_code = error_table_$improper_data_format; 584 return; 585 end; 586 587 call pack (addr (imft_physical_record.data), ilr_ptr, n_bytes, packed_length); 588 589 if imft_logical_record.version ^= IMFT_LOGICAL_RECORD_VERSION_1 then do; 590 P_code = error_table_$unimplemented_version; 591 return; 592 end; 593 594 if 4 * size (imft_logical_record_header) + imft_logical_record.length > P_buffer_max_lth 595 /* record is too big to fit in caller's buffer */ 596 then do; 597 P_code = error_table_$long_record; 598 return; 599 end; 600 601 /* now read the physical records (if any) that contain the data portion of the logical record */ 602 603 data_received = 0; 604 unspec (imft_logical_record.contents) = ""b; /* start clean */ 605 606 if imft_logical_record.binary | imft_logical_record.eight_bit then do; 607 logical_record_data_bits_lth = 9 * imft_logical_record.length; 608 /* have to work in bits in this case */ 609 610 do while (data_received < logical_record_data_bits_lth & ^imft_physical_record.eolr); 611 /* should run out of data exactly when eolr goes on */ 612 613 call receive_physical_record (n_bytes, P_code); 614 if P_code ^= 0 then return; 615 616 call pack (addr (imft_physical_record.data), 617 addbitno (addr (imft_logical_record.contents), data_received), n_bytes, packed_length); 618 data_received = data_received + packed_length; 619 end; 620 621 data_received = divide (data_received, 9, 21, 0); 622 /* now convert to characters */ 623 /* note that real data ends on 9-bit boundary */ 624 end; 625 626 else do while (data_received < imft_logical_record.length & ^imft_physical_record.eolr); 627 /* these two conditions SHOULD be equivalent */ 628 call receive_physical_record (n_bytes, P_code); 629 if P_code ^= 0 then return; 630 631 /* just copy the data directly */ 632 633 addcharno (addr (imft_logical_record.contents), data_received) -> data_bytes = 634 addr (imft_physical_record.data) -> data_bytes; 635 data_received = data_received + n_bytes; 636 end; 637 638 if data_received < imft_logical_record.length /* premature end_of_record flag */ 639 then P_code = error_table_$eof_record; /* it should probably be something else */ 640 641 else if ^imft_physical_record.eolr /* used up length before finding end-of-record */ 642 then P_code = error_table_$long_record; /* which means next record is probably messed up too */ 643 644 else P_code = 0; 645 646 P_record_length = 4 * size (imft_logical_record_header) + data_received; 647 return; 648 649 /* */ 650 651 /* Cleanup whatever portion of an attachment exists */ 652 653 cleanup_attachment: 654 procedure (P_code); 655 656 dcl P_code fixed binary (35) parameter; /* a parameter to allow callers to ignore it */ 657 658 P_code = 0; 659 660 if iad_ptr ^= null () then do; /* there is an I/O switch */ 661 662 if iad.switch.terminal_iocb_ptr ^= null () then do; 663 call iox_$close (iad.switch.terminal_iocb_ptr, (0)); 664 call iox_$detach_iocb (iad.switch.terminal_iocb_ptr, P_code); 665 call iox_$destroy_iocb (iad.switch.terminal_iocb_ptr, (0)); 666 iad.switch.terminal_iocb_ptr = null (); 667 end; 668 669 free iad in (system_area); 670 iad_ptr = null (); 671 672 end; 673 674 return; 675 676 end cleanup_attachment; 677 678 /* */ 679 680 /* Wrapper to protect against errors while IPS interrupts are masked */ 681 682 any_other_handler: 683 procedure () options (non_quick); 684 685 if ips_mask then call hcs_$reset_ips_mask (ips_mask, ips_mask); 686 ips_mask = ""b; 687 688 call continue_to_signal_ ((0)); /* not interested, */ 689 690 return; 691 692 end any_other_handler; 693 694 695 696 /* Abort a call to the attach entry: print an error message if requested */ 697 698 abort_attachment: 699 procedure () options (variable, non_quick); 700 701 dcl the_code fixed binary (35) based (the_code_ptr); 702 dcl the_code_ptr pointer; 703 704 dcl caller_message character (256); 705 706 call cu_$arg_ptr (1, the_code_ptr, (0), (0)); 707 708 if loud_sw then do; /* an error message is requested */ 709 call ioa_$general_rs (cu_$arg_list_ptr (), 2, 3, caller_message, (0), "1"b, "0"b); 710 call com_err_ (the_code, IMFT_HASP_, "For switch ^a: ^a", iocb_ptr -> iocb.name, caller_message); 711 end; 712 713 call cleanup_attachment ((0)); /* get rid of anything that was accomplished */ 714 715 if the_code = 0 then 716 code = error_table_$action_not_performed; 717 else code = the_code; /* save the error code */ 718 719 go to RETURN_FROM_ATTACH; 720 721 end abort_attachment; 722 723 /* */ 724 725 /* transmits a single physical record */ 726 727 transmit_physical_record: 728 procedure (n_bytes, code); 729 730 dcl n_bytes fixed bin (21); 731 dcl code fixed binary (35); 732 733 terminal_io_record.element_size = 9; 734 terminal_io_record.n_elements = n_bytes + 4; /* make sure they're still correct */ 735 terminal_io_record.version = terminal_io_record_version_1; 736 737 call iox_$write_record (iad.switch.terminal_iocb_ptr, terminal_io_record_ptr, 738 (4 * currentsize (terminal_io_record)), code); 739 740 unspec (imft_physical_record) = ""b; /* start next record clean */ 741 742 return; 743 744 end transmit_physical_record; 745 746 /* */ 747 748 /* read a single physical HASP record */ 749 750 receive_physical_record: 751 procedure (bytes_read, code); 752 753 dcl bytes_read fixed bin (21); 754 dcl code fixed binary (35); 755 756 dcl fb14uu fixed binary (14) unaligned unsigned; 757 758 terminal_io_record.element_size = 9; 759 terminal_io_record.n_elements = IMFT_PHYSICAL_RECORD_LTH; 760 terminal_io_record.version = terminal_io_record_version_1; 761 762 call iox_$read_record (iad.switch.terminal_iocb_ptr, terminal_io_record_ptr, 763 (4 * currentsize (terminal_io_record)), (0), code); 764 if code = error_table_$short_record then code = 0; 765 if code ^= 0 then return; 766 767 unspec (fb14uu) = imft_physical_record.n_els.high_order || imft_physical_record.n_els.low_order; 768 bytes_read = fb14uu; /* record # of characters or bytes */ 769 770 return; 771 772 end receive_physical_record; 773 774 /* */ 775 776 /* pair of subroutines for converting between 7 bits/byte and 9 bits/byte */ 777 778 pack_unpack: 779 procedure; 780 781 return; /* not to be called */ 782 783 dcl packed_byte_ptr pointer parameter; 784 dcl unpacked_byte_ptr pointer parameter; 785 dcl P_input_chars fixed bin (21) parameter; 786 dcl P_input_bits fixed bin (21) parameter; 787 dcl P_output_chars fixed bin (21) parameter; 788 dcl P_output_bits fixed bin (21) parameter; 789 790 dcl unpacked_length fixed bin; 791 dcl packed_bytes (unpacked_length) bit (7) unaligned based (packed_byte_ptr); 792 dcl unpacked_bytes (unpacked_length) bit (9) unaligned based (unpacked_byte_ptr); 793 794 pack: 795 entry (unpacked_byte_ptr, packed_byte_ptr, P_input_chars, P_output_bits); 796 797 /* input has 2 high-order bits of every 9 off, + 7 data bits; pack it into binary */ 798 799 unpacked_length = P_input_chars; 800 P_output_bits = 7 * unpacked_length; 801 packed_bytes = substr (unpacked_bytes, 3); /* simple as that! */ 802 return; 803 804 805 unpack: 806 entry (packed_byte_ptr, unpacked_byte_ptr, P_input_bits, P_output_chars); 807 808 /* input is binary; unpack it so that 2 high-order bits of every 9 are 0 */ 809 810 P_output_chars, unpacked_length = divide (P_input_bits + 6, 7, 21, 0); 811 string (unpacked_bytes) = ""b; 812 substr (unpacked_bytes, 3) = packed_bytes; /* it works in this direction, too */ 813 return; 814 815 end pack_unpack; 816 817 /* */ 818 1 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 1 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 1 3* version number to IOX2. */ 1 4 /* format: style2 */ 1 5 1 6 dcl 1 iocb aligned based, /* I/O control block. */ 1 7 2 version character (4) aligned, /* IOX2 */ 1 8 2 name char (32), /* I/O name of this block. */ 1 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 1 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 1 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 1 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 1 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 1 14 2 reserved bit (72), /* Reserved for future use. */ 1 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 1 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 1 17 /* open(p,mode,not_used,s) */ 1 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 1 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 20 /* get_line(p,bufptr,buflen,actlen,s) */ 1 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 1 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 1 24 /* put_chars(p,bufptr,buflen,s) */ 1 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 1 26 /* modes(p,newmode,oldmode,s) */ 1 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 1 28 /* position(p,u1,u2,s) */ 1 29 2 control entry (ptr, char (*), ptr, fixed (35)), 1 30 /* control(p,order,infptr,s) */ 1 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 1 32 /* read_record(p,bufptr,buflen,actlen,s) */ 1 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 1 34 /* write_record(p,bufptr,buflen,s) */ 1 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 1 36 /* rewrite_record(p,bufptr,buflen,s) */ 1 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 1 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 39 /* seek_key(p,key,len,s) */ 1 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 1 41 /* read_key(p,key,len,s) */ 1 42 2 read_length entry (ptr, fixed (21), fixed (35)), 1 43 /* read_length(p,len,s) */ 1 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 1 45 /* open_file(p,mode,desc,not_used,s) */ 1 46 2 close_file entry (ptr, char (*), fixed bin (35)), 1 47 /* close_file(p,desc,s) */ 1 48 2 detach entry (ptr, char (*), fixed bin (35)); 1 49 /* detach(p,desc,s) */ 1 50 1 51 declare iox_$iocb_version_sentinel 1 52 character (4) aligned external static; 1 53 1 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 819 820 2 1 /* Begin include file ..... iox_modes.incl.pl1 */ 2 2 2 3 /* Written by C. D. Tavares, 03/17/75 */ 2 4 /* Updated 10/31/77 by CDT to include short iox mode strings */ 2 5 2 6 dcl iox_modes (13) char (24) int static options (constant) aligned initial 2 7 ("stream_input", "stream_output", "stream_input_output", 2 8 "sequential_input", "sequential_output", "sequential_input_output", "sequential_update", 2 9 "keyed_sequential_input", "keyed_sequential_output", "keyed_sequential_update", 2 10 "direct_input", "direct_output", "direct_update"); 2 11 2 12 dcl short_iox_modes (13) char (4) int static options (constant) aligned initial 2 13 ("si", "so", "sio", "sqi", "sqo", "sqio", "squ", "ksqi", "ksqo", "ksqu", "di", "do", "du"); 2 14 2 15 dcl (Stream_input initial (1), 2 16 Stream_output initial (2), 2 17 Stream_input_output initial (3), 2 18 Sequential_input initial (4), 2 19 Sequential_output initial (5), 2 20 Sequential_input_output initial (6), 2 21 Sequential_update initial (7), 2 22 Keyed_sequential_input initial (8), 2 23 Keyed_sequential_output initial (9), 2 24 Keyed_sequential_update initial (10), 2 25 Direct_input initial (11), 2 26 Direct_output initial (12), 2 27 Direct_update initial (13)) fixed bin int static options (constant); 2 28 2 29 /* End include file ..... iox_modes.incl.pl1 */ 821 822 3 1 /* BEGIN INCLUDE FILE...imft_logical_record.incl.pl1 */ 3 2 3 3 /* Defines an IMFT logical record. Such records are passed by imft_io_ to the 3 4* write_record entries of imft_COMM_ I/O modules, and returned by the read_record 3 5* entries of such modules. */ 3 6 3 7 /* Written January 4, 1983 by Robert Coren */ 3 8 3 9 declare ilr_ptr pointer; 3 10 declare imft_logical_record_length fixed bin (21); 3 11 3 12 declare 1 imft_logical_record aligned based (ilr_ptr), 3 13 2 header, 3 14 3 version char (8), 3 15 3 type fixed bin, /* types are defined in _imft_std_commands.incl.pl1 */ 3 16 3 length fixed bin (21), /* in characters */ 3 17 3 flags, 3 18 4 binary bit (1) unaligned, /* ON => record contains characters with 9th bit on */ 3 19 4 eight_bit bit (1) unaligned, /* ON => record contains characters with 8th bit on */ 3 20 4 pad bit (34) unaligned, 3 21 2 contents character (imft_logical_record_length refer (imft_logical_record.length)); 3 22 3 23 /* NOTE: flags.binary and flags.eight_bit should never both be on in the same 3 24* record. If neither is on, every character in the record fits in 7 bits. 3 25**/ 3 26 3 27 dcl 1 imft_logical_record_header aligned like imft_logical_record.header; 3 28 /* so we can use size builtin on it */ 3 29 3 30 declare IMFT_LOGICAL_RECORD_VERSION_1 char (8) internal static options (constant) init ("ILR_0001"); 3 31 3 32 declare IMFT_MAX_RECORD_LENGTH fixed bin (21) internal static options (constant) init (4096); 3 33 3 34 /* END INCLUDE FILE...imft_logical_record.incl.pl1 */ 823 824 4 1 /* BEGIN INCLUDE FILE ... terminal_io_record.incl.pl1 */ 4 2 /* Created: November 1979 by G. Palter */ 4 3 /* Modified: 26 March 1982 by G. Palter to make the structure more compatible with use of the like attribute */ 4 4 4 5 4 6 /* Record format used by I/O modules designed for communcation with remote I/O daemon stations */ 4 7 4 8 dcl 1 terminal_io_record aligned based (terminal_io_record_ptr), 4 9 2 header, 4 10 3 version fixed binary, 4 11 3 device_type fixed binary, /* type of device sending/receiving this record -- 4 12* reader/printer/punch/teleprinter */ 4 13 3 slew_control, /* slew control data: used for printer and teleprinter only */ 4 14 4 slew_type fixed binary (18) unaligned unsigned, /* type of slewing operation before/after this line -- 4 15* by-count/top-of-form/inside-page/outside-page/to-channel */ 4 16 4 slew_count fixed binary (18) unaligned unsigned,/* # of lines if by count; channel # if to channel */ 4 17 3 flags, 4 18 4 binary bit (1) unaligned, /* ON => data in record should be written in binary mode */ 4 19 4 preslew bit (1) unaligned, /* ON => perform above slew before printing data; 4 20* OFF => perform above slew after printing data */ 4 21 4 pad bit (34) unaligned, 4 22 3 element_size fixed binary, /* # of bits in a data element */ 4 23 3 n_elements fixed binary (24), /* # of elements in the record */ 4 24 2 data, /* force word alignment */ 4 25 3 bits (terminal_io_record_n_elements refer (terminal_io_record.n_elements)) 4 26 bit (terminal_io_record_element_size refer (terminal_io_record.element_size)) unaligned; 4 27 4 28 dcl terminal_io_record_ptr pointer; 4 29 4 30 dcl terminal_io_record_element_size fixed binary; /* used for allocating terminal_io_record structures */ 4 31 dcl terminal_io_record_n_elements fixed binary (24); 4 32 4 33 4 34 /* Manifest constants */ 4 35 4 36 dcl terminal_io_record_version_1 fixed binary static options (constant) initial (1); 4 37 4 38 dcl (TELEPRINTER_DEVICE initial (1), 4 39 READER_DEVICE initial (2), 4 40 PRINTER_DEVICE initial (3), 4 41 PUNCH_DEVICE initial (4)) 4 42 fixed binary static options (constant); 4 43 4 44 dcl (SLEW_BY_COUNT initial (1), 4 45 SLEW_TO_TOP_OF_PAGE initial (2), 4 46 SLEW_TO_INSIDE_PAGE initial (3), /* skip to top of next inside page (head sheet) */ 4 47 SLEW_TO_OUTSIDE_PAGE initial (4), /* skip to top of next outside page (tail sheet) */ 4 48 SLEW_TO_CHANNEL initial (5)) /* skip to specified channel stop */ 4 49 fixed binary static options (constant); 4 50 4 51 4 52 /* Data in record as a character string (terminal_io_record.element_size = 9) */ 4 53 4 54 dcl terminal_io_record_data_chars character (terminal_io_record.n_elements) unaligned 4 55 based (addr (terminal_io_record.bits)); 4 56 4 57 dcl terminal_io_record_data_chars_varying_max_len fixed binary (21); /* Set this before using the varying string. */ 4 58 dcl terminal_io_record_data_chars_varying character (terminal_io_record_data_chars_varying_max_len) varying 4 59 based (addr (terminal_io_record.n_elements)); /* varying string consists of length and data */ 4 60 4 61 4 62 /* Data in record as a bit string (terminal_io_record.element_size = 1) */ 4 63 4 64 dcl terminal_io_record_data_bits bit (terminal_io_record.n_elements) unaligned based (addr (terminal_io_record.bits)); 4 65 4 66 /* END INCLUDE FILE ... terminal_io_record.incl.pl1 */ 825 826 827 end imft_hasp_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/19/83 1018.3 imft_hasp_.pl1 >special_ldd>on>07/19/83>imft_hasp_.pl1 819 1 05/20/83 1846.4 iocb.incl.pl1 >ldd>include>iocb.incl.pl1 821 2 02/02/78 1229.7 iox_modes.incl.pl1 >ldd>include>iox_modes.incl.pl1 823 3 04/12/83 1317.6 imft_logical_record.incl.pl1 >ldd>include>imft_logical_record.incl.pl1 825 4 11/12/82 1624.8 terminal_io_record.incl.pl1 >ldd>include>terminal_io_record.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. IMFT_HASP_ 000120 constant char(32) initial unaligned dcl 88 set ref 207* 710* IMFT_LOGICAL_RECORD_VERSION_1 000000 constant char(8) initial unaligned dcl 3-30 ref 589 IMFT_PHYSICAL_RECORD_DATA_BITS_LTH constant fixed bin(17,0) initial dcl 177 ref 510 IMFT_PHYSICAL_RECORD_DATA_LTH constant fixed bin(17,0) initial dcl 177 ref 474 482 482 513 513 540 542 587 587 616 616 633 740 IMFT_PHYSICAL_RECORD_LTH constant fixed bin(17,0) initial dcl 177 ref 217 228 230 251 257 268 308 308 326 669 759 N_BITS_PER_CHARACTER constant fixed bin(17,0) initial dcl 90 ref 267 503 PUNCH_DEVICE constant fixed bin(17,0) initial dcl 4-38 ref 253 257 P_attach_options parameter varying char array dcl 26 ref 187 193 224 224 225 P_buffer_max_lth parameter fixed bin(21,0) dcl 36 ref 566 594 P_buffer_ptr parameter pointer dcl 35 ref 566 570 P_code parameter fixed bin(35,0) dcl 656 in procedure "cleanup_attachment" set ref 653 658* 664* P_code parameter fixed bin(35,0) dcl 24 in procedure "imft_hasp_" set ref 187 193 206* 207* 287* 295 302* 311* 315* 316 343* 350 358* 383* 391 398* 403* 425* 432 437* 445 451* 453* 461 487* 488 524* 526 552* 554 566 578* 579 583* 590* 597* 613* 614 628* 629 638* 641* 644* P_info_ptr parameter pointer dcl 41 set ref 432 437* P_input_bits parameter fixed bin(21,0) dcl 786 ref 805 810 P_input_chars parameter fixed bin(21,0) dcl 785 ref 794 799 P_iocb_ptr parameter pointer dcl 23 ref 187 193 198 295 298 350 353 391 394 432 435 445 448 461 464 566 569 P_loud_sw parameter bit(1) unaligned dcl 27 ref 187 193 200 P_new_modes parameter char unaligned dcl 44 ref 445 451 P_old_modes parameter char unaligned dcl 45 set ref 445 449* P_open_mode parameter fixed bin(17,0) dcl 29 ref 295 306 P_open_sw parameter bit(1) unaligned dcl 30 ref 295 P_order parameter char unaligned dcl 40 set ref 432 437* P_output_bits parameter fixed bin(21,0) dcl 788 set ref 794 800* P_output_chars parameter fixed bin(21,0) dcl 787 set ref 805 810* P_record_length parameter fixed bin(21,0) dcl 32 set ref 461 566 646* P_record_ptr parameter pointer dcl 38 ref 461 465 READER_DEVICE constant fixed bin(17,0) initial dcl 4-38 ref 251 259 SLEW_BY_COUNT constant fixed bin(17,0) initial dcl 4-44 ref 262 Sequential_input constant fixed bin(17,0) initial dcl 2-15 ref 308 Sequential_output constant fixed bin(17,0) initial dcl 2-15 ref 308 actual_iocb_ptr 12 based pointer level 2 dcl 1-6 ref 298 353 435 448 addbitno builtin function dcl 124 ref 513 513 616 616 addcharno builtin function dcl 124 ref 633 addr builtin function dcl 124 ref 278 336 468 471 472 482 482 513 513 573 574 587 587 616 616 616 616 633 633 amount_left 000333 automatic fixed bin(21,0) dcl 79 set ref 509* 510 520 539* 540 548 amount_sent 000334 automatic fixed bin(24,0) dcl 80 set ref 494* 505 509 513 513 528* 528 537 539 542 556* 556 amount_to_send 000335 automatic fixed bin(21,0) dcl 81 set ref 510* 513* 520 528 540* 542 544 548 552* 556 any_other 000342 stack reference condition dcl 122 ref 274 322 415 arg_index 000110 automatic fixed bin(17,0) dcl 61 set ref 224* 225* attach_data_ptr 16 based pointer level 2 dcl 1-6 set ref 279* 299 354 409 436 466 571 attach_descrip_ptr 14 based pointer level 2 dcl 1-6 set ref 205 278* 397 419* attach_description based varying char(1024) level 2 dcl 131 set ref 220* 225* 225 236 278 bin builtin function dcl 124 ref 485 binary 0(11) based bit(1) level 3 in structure "imft_physical_record" packed unaligned dcl 159 in procedure "imft_hasp_" set ref 478* 507* binary 4 based bit(1) level 4 in structure "imft_logical_record" packed unaligned dcl 3-12 in procedure "imft_hasp_" ref 497 606 bit builtin function dcl 124 ref 485 bolr 0(12) based bit(1) level 3 packed unaligned dcl 159 set ref 479* 490* 581 bytes_read parameter fixed bin(21,0) dcl 753 set ref 750 768* caller_message 000102 automatic char(256) unaligned dcl 704 set ref 709* 710* cleanup 000350 stack reference condition dcl 122 ref 213 367 close 36 based entry variable level 2 dcl 1-6 set ref 333* code parameter fixed bin(35,0) dcl 731 in procedure "transmit_physical_record" set ref 727 737* code parameter fixed bin(35,0) dcl 754 in procedure "receive_physical_record" set ref 750 762* 764 764* 765 code 000102 automatic fixed bin(35,0) dcl 51 in procedure "imft_hasp_" set ref 201* 239* 240 240* 287 355* 362* 363 363 363* 383 395* 411* 425 715* 717* com_err_ 000036 constant entry external dcl 102 ref 207 710 contents 5 based char level 2 dcl 3-12 set ref 468 604* 616 616 633 continue_to_signal_ 000040 constant entry external dcl 103 ref 688 control 66 based entry variable level 2 dcl 1-6 set ref 330* 376* cu_$arg_list_ptr 000042 constant entry external dcl 104 ref 709 709 cu_$arg_ptr 000044 constant entry external dcl 105 ref 706 current_physical_record_n_els 413 based fixed bin(24,0) level 3 dcl 131 set ref 245* current_physical_record_type 412 based fixed bin(17,0) level 3 dcl 131 set ref 244* current_physical_record_used 414 based fixed bin(24,0) level 3 dcl 131 set ref 246* currentsize builtin function dcl 124 ref 737 762 data 1 based char level 2 in structure "imft_physical_record" packed unaligned dcl 159 in procedure "imft_hasp_" set ref 482 482 513 513 542* 587 587 616 616 633 data 6 based structure level 2 in structure "terminal_io_record" dcl 4-8 in procedure "imft_hasp_" set ref 472 574 data_bytes based char unaligned dcl 83 set ref 633* 633 data_received 000324 automatic fixed bin(21,0) dcl 69 set ref 603* 610 616 616 618* 618 621* 621 626 633 635* 635 638 646 detach_iocb 26 based entry variable level 2 dcl 1-6 set ref 281* 334* 374* device_type 417 based fixed bin(17,0) level 5 dcl 131 set ref 251* 253* 257* 259* divide builtin function dcl 124 ref 621 810 eight_bit 4(01) based bit(1) level 4 packed unaligned dcl 3-12 ref 497 606 element_size 4 based fixed bin(17,0) level 3 in structure "terminal_io_record" dcl 4-8 in procedure "imft_hasp_" set ref 733* 737 758* 762 element_size 422 based fixed bin(17,0) level 5 in structure "iad" dcl 131 in procedure "imft_hasp_" set ref 267* eolr 0(13) based bit(1) level 3 packed unaligned dcl 159 set ref 480* 520* 548* 610 626 641 error_table_$action_not_performed 000010 external static fixed bin(35,0) dcl 93 ref 715 error_table_$bad_mode 000012 external static fixed bin(35,0) dcl 93 ref 311 453 error_table_$eof_record 000014 external static fixed bin(35,0) dcl 93 ref 638 error_table_$improper_data_format 000016 external static fixed bin(35,0) dcl 93 ref 583 error_table_$long_record 000020 external static fixed bin(35,0) dcl 93 ref 597 641 error_table_$not_attached 000022 external static fixed bin(35,0) dcl 93 ref 363 398 error_table_$not_closed 000024 external static fixed bin(35,0) dcl 93 ref 302 403 error_table_$not_detached 000026 external static fixed bin(35,0) dcl 93 ref 206 error_table_$not_open 000030 external static fixed bin(35,0) dcl 93 ref 358 363 error_table_$short_record 000032 external static fixed bin(35,0) dcl 93 ref 764 error_table_$unimplemented_version 000034 external static fixed bin(35,0) dcl 93 ref 590 fb14uu 000336 automatic fixed bin(14,0) unsigned unaligned dcl 82 in procedure "imft_hasp_" set ref 516* 517 518 544* 545 546 fb14uu 000416 automatic fixed bin(14,0) unsigned unaligned dcl 756 in procedure "receive_physical_record" set ref 767* 768 flags 421 based structure level 5 in structure "iad" dcl 131 in procedure "imft_hasp_" set ref 265* flags 0(11) based structure level 2 in structure "imft_physical_record" packed unaligned dcl 159 in procedure "imft_hasp_" flags based structure level 2 in structure "iad" dcl 131 in procedure "imft_hasp_" flags 4 based structure level 3 in structure "imft_logical_record" dcl 3-12 in procedure "imft_hasp_" get_system_free_area_ 000046 constant entry external dcl 106 ref 211 407 hbound builtin function dcl 124 ref 224 hcs_$reset_ips_mask 000050 constant entry external dcl 107 ref 285 341 381 423 685 hcs_$set_ips_mask 000052 constant entry external dcl 108 ref 276 324 369 417 header 416 based structure level 4 in structure "iad" dcl 131 in procedure "imft_hasp_" header based structure level 2 in structure "imft_logical_record" dcl 3-12 in procedure "imft_hasp_" header based structure level 2 in structure "terminal_io_record" dcl 4-8 in procedure "imft_hasp_" high_order 0(20) based bit(7) level 3 packed unaligned dcl 159 set ref 517* 545* 767 iad based structure level 1 dcl 131 set ref 217 669 iad_ptr 000356 automatic pointer dcl 139 set ref 203* 217* 218 220 221 225 225 228 230 236 239 244 245 246 248 251 251 253 257 257 259 262 263 265 267 268 278 279 299* 308 308 315 318 326 336 354* 362 409* 436* 437 466* 471 571* 573 660 662 663 664 665 666 669 670* 737 762 ilr_ptr 000362 automatic pointer dcl 3-9 set ref 465* 468 469 482* 497 497 570* 587* 589 594 604 606 606 607 616 616 626 633 638 imft_logical_record based structure level 1 dcl 3-12 imft_logical_record_header 000364 automatic structure level 1 dcl 3-27 ref 482 482 594 646 imft_physical_record based structure level 1 dcl 159 set ref 474* 740* index builtin function dcl 124 ref 228 230 input_direction based bit(1) level 3 packed unaligned dcl 131 set ref 228* 230* 251 257 308 308 326 ioa_$general_rs 000054 constant entry external dcl 109 ref 709 iocb based structure level 1 dcl 1-6 iocb_ptr 000100 automatic pointer dcl 50 set ref 198* 205 207 228 230 232 234 278 279 280 281 283* 298* 299 301 326 328 330 331 333 334 336 339* 353* 354 357 371 373 374 376 376 376 376 379* 394* 397 402 409 419 421* 435* 436 448* 464* 466 569* 571 710 iox_$attach_ioname 000056 constant entry external dcl 110 ref 239 iox_$close 000062 constant entry external dcl 112 ref 362 663 iox_$control 000060 constant entry external dcl 111 ref 437 iox_$destroy_iocb 000064 constant entry external dcl 113 ref 665 iox_$detach_iocb 000066 constant entry external dcl 114 ref 664 iox_$err_no_operation 000070 constant entry external dcl 115 ref 376 iox_$open 000072 constant entry external dcl 116 ref 315 iox_$propagate 000074 constant entry external dcl 117 ref 283 339 379 421 iox_$read_record 000076 constant entry external dcl 118 ref 762 iox_$write_record 000100 constant entry external dcl 119 ref 737 iox_modes 000002 constant char(24) initial array dcl 2-6 ref 318 ipr_ptr 000360 automatic pointer dcl 175 set ref 472* 474 478 479 480 482 482 485 490 507 513 513 517 518 520 542 545 546 548 574* 581 587 587 610 616 616 626 633 641 740 767 767 ips_mask 000340 automatic bit(36) unaligned dcl 86 set ref 272* 276* 285* 285* 320* 324* 341* 341* 365* 369* 381* 381* 413* 417* 423* 423* 685 685* 685* 686* lbound builtin function dcl 124 ref 224 length 3 based fixed bin(21,0) level 3 in structure "imft_logical_record" dcl 3-12 in procedure "imft_hasp_" ref 468 469 594 604 607 616 616 626 633 638 length builtin function dcl 124 in procedure "imft_hasp_" ref 482 482 logical_record_data based char unaligned dcl 73 ref 542 logical_record_data_bits_lth 000332 automatic fixed bin(24,0) dcl 77 set ref 503* 505 509 607* 610 logical_record_data_lth 000327 automatic fixed bin(21,0) dcl 74 set ref 469* 480 497 503 537 539 542 logical_record_data_ptr 000330 automatic pointer dcl 75 set ref 468* 513 513 542 loud_sw 000103 automatic bit(1) dcl 52 set ref 200* 207 708 low_order 0(29) based bit(7) level 3 packed unaligned dcl 159 set ref 485* 518* 546* 767 min builtin function dcl 124 ref 510 540 modes 56 based entry variable level 2 dcl 1-6 set ref 331* 376* module_type 000321 automatic char(12) unaligned dcl 67 set ref 190* 196* 234 236 250 n_bytes parameter fixed bin(21,0) dcl 730 in procedure "transmit_physical_record" ref 727 734 n_bytes 000337 automatic fixed bin(21,0) dcl 84 in procedure "imft_hasp_" set ref 578* 587* 613* 616* 628* 633 633 635 n_elements 423 based fixed bin(24,0) level 5 in structure "iad" dcl 131 in procedure "imft_hasp_" set ref 268* n_elements 5 based fixed bin(24,0) level 3 in structure "terminal_io_record" dcl 4-8 in procedure "imft_hasp_" set ref 734* 737 759* 762 n_els 0(18) based structure level 2 packed unaligned dcl 159 name 1 based char(32) level 2 dcl 1-6 set ref 207* 228 230 232* 234 710* null builtin function dcl 124 ref 203 205 218 301 357 371 397 402 419 660 662 666 670 open 32 based entry variable level 2 dcl 1-6 set ref 280* 373* open_descrip_ptr 20 based pointer level 2 dcl 1-6 set ref 301 336* 357 371* 402 open_description 401 based varying char(24) level 2 dcl 131 set ref 221* 318* 336 open_mode 000104 automatic fixed bin(17,0) dcl 53 set ref 306* 308 308 315* 318 packed_byte_ptr parameter pointer dcl 783 ref 794 801 805 812 packed_bytes based bit(7) array unaligned dcl 791 set ref 801* 812 packed_length 000325 automatic fixed bin(21,0) dcl 70 set ref 587* 616* 618 read_record 72 based entry variable level 2 dcl 1-6 set ref 326* 376* requote_string_ 000102 constant entry external dcl 120 ref 225 rtrim builtin function dcl 124 ref 234 236 318 size builtin function dcl 124 ref 594 646 slew_control 420 based structure level 5 dcl 131 slew_count 420(18) based fixed bin(18,0) level 6 packed unsigned unaligned dcl 131 set ref 263* slew_type 420 based fixed bin(18,0) level 6 packed unsigned unaligned dcl 131 set ref 262* string builtin function dcl 124 set ref 265* 811* substr builtin function dcl 124 set ref 234 517 518 542 545 546 801 812* switch 410 based structure level 2 dcl 131 switch_info based structure level 1 dcl 144 system_area based area(1024) dcl 58 ref 217 669 system_area_ptr 000106 automatic pointer dcl 59 set ref 211* 217 407* 669 terminal_attach_desc 000111 automatic char(512) unaligned dcl 64 set ref 236* 239* 240* terminal_io_record based structure level 1 dcl 4-8 set ref 737 762 terminal_io_record_ptr 000372 automatic pointer dcl 4-28 set ref 471* 472 573* 574 733 734 735 737* 737 758 759 760 762* 762 terminal_io_record_version_1 constant fixed bin(17,0) initial dcl 4-36 ref 248 735 760 terminal_iocb_ptr 410 based pointer level 3 dcl 131 set ref 218* 239* 315* 362* 437* 662 663* 664* 665* 666* 737* 762* terminal_switch_name 000311 automatic char(32) unaligned dcl 65 set ref 234* 239* the_code based fixed bin(35,0) dcl 701 set ref 710* 715 717 the_code_ptr 000100 automatic pointer dcl 702 set ref 706* 710 715 717 tior 416 based structure level 3 dcl 131 set ref 471 573 unpacked_byte_ptr parameter pointer dcl 784 ref 794 801 805 811 812 unpacked_bytes based bit(9) array unaligned dcl 792 set ref 801 811* 812* unpacked_chars 000326 automatic fixed bin(21,0) dcl 71 set ref 482* 485 487* 513* 516 524* unpacked_length 000426 automatic fixed bin(17,0) dcl 790 set ref 799* 800 801 801 810* 811 812 812 unspec builtin function dcl 124 set ref 474* 482 482 517 518 545 546 604* 740* 767* version based fixed bin(17,0) level 3 in structure "terminal_io_record" dcl 4-8 in procedure "imft_hasp_" set ref 735* 760* version based char(8) level 3 in structure "imft_logical_record" dcl 3-12 in procedure "imft_hasp_" ref 589 version 416 based fixed bin(17,0) level 5 in structure "iad" dcl 131 in procedure "imft_hasp_" set ref 248* write_record 76 based entry variable level 2 dcl 1-6 set ref 328* 376* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Direct_input internal static fixed bin(17,0) initial dcl 2-15 Direct_output internal static fixed bin(17,0) initial dcl 2-15 Direct_update internal static fixed bin(17,0) initial dcl 2-15 IMFT_MAX_RECORD_LENGTH internal static fixed bin(21,0) initial dcl 3-32 Keyed_sequential_input internal static fixed bin(17,0) initial dcl 2-15 Keyed_sequential_output internal static fixed bin(17,0) initial dcl 2-15 Keyed_sequential_update internal static fixed bin(17,0) initial dcl 2-15 PRINTER_DEVICE internal static fixed bin(17,0) initial dcl 4-38 SLEW_TO_CHANNEL internal static fixed bin(17,0) initial dcl 4-44 SLEW_TO_INSIDE_PAGE internal static fixed bin(17,0) initial dcl 4-44 SLEW_TO_OUTSIDE_PAGE internal static fixed bin(17,0) initial dcl 4-44 SLEW_TO_TOP_OF_PAGE internal static fixed bin(17,0) initial dcl 4-44 Sequential_input_output internal static fixed bin(17,0) initial dcl 2-15 Sequential_update internal static fixed bin(17,0) initial dcl 2-15 Stream_input internal static fixed bin(17,0) initial dcl 2-15 Stream_input_output internal static fixed bin(17,0) initial dcl 2-15 Stream_output internal static fixed bin(17,0) initial dcl 2-15 TELEPRINTER_DEVICE internal static fixed bin(17,0) initial dcl 4-38 imft_logical_record_length automatic fixed bin(21,0) dcl 3-10 iox_$iocb_version_sentinel external static char(4) dcl 1-51 mod builtin function dcl 124 short_iox_modes internal static char(4) initial array dcl 2-12 terminal_io_record_data_bits based bit unaligned dcl 4-64 terminal_io_record_data_chars based char unaligned dcl 4-54 terminal_io_record_data_chars_varying based varying char dcl 4-58 terminal_io_record_data_chars_varying_max_len automatic fixed bin(21,0) dcl 4-57 terminal_io_record_element_size automatic fixed bin(17,0) dcl 4-30 terminal_io_record_n_elements automatic fixed bin(24,0) dcl 4-31 NAMES DECLARED BY EXPLICIT CONTEXT. ATTACH_COMMON 000316 constant label dcl 198 ref 191 RETURN_FROM_ATTACH 001170 constant label dcl 287 ref 719 abort_attachment 003030 constant entry internal dcl 698 ref 232 240 any_other_handler 002775 constant entry internal dcl 682 ref 274 322 367 415 cleanup_attachment 002673 constant entry internal dcl 653 ref 213 411 713 imft_hasp_ 000234 constant entry external dcl 16 imft_hasp_close 001453 constant entry external dcl 350 ref 333 imft_hasp_control 002007 constant entry external dcl 432 ref 330 imft_hasp_detach 001642 constant entry external dcl 391 ref 281 334 374 imft_hasp_host_attach 000247 constant entry external dcl 187 imft_hasp_modes 002067 constant entry external dcl 445 ref 331 imft_hasp_open 001200 constant entry external dcl 295 ref 280 373 imft_hasp_read_record 002435 constant entry external dcl 566 ref 326 imft_hasp_workstation_attach 000273 constant entry external dcl 193 imft_hasp_write_record 002145 constant entry external dcl 461 ref 328 pack 003370 constant entry internal dcl 794 ref 587 616 pack_unpack 003366 constant entry internal dcl 778 receive_physical_record 003274 constant entry internal dcl 750 ref 578 613 628 transmit_physical_record 003224 constant entry internal dcl 727 ref 487 524 552 unpack 003430 constant entry internal dcl 805 ref 482 513 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4326 4432 3554 4336 Length 5010 3554 104 341 552 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME imft_hasp_ 361 external procedure is an external procedure. on unit on line 213 72 on unit on unit on line 274 64 on unit on unit on line 322 64 on unit on unit on line 367 64 on unit on unit on line 415 64 on unit cleanup_attachment 72 internal procedure is called by several nonquick procedures. any_other_handler 71 internal procedure is declared options(non_quick). abort_attachment 178 internal procedure is declared options(non_quick), and is declared options(variable). transmit_physical_record internal procedure shares stack frame of external procedure imft_hasp_. receive_physical_record internal procedure shares stack frame of external procedure imft_hasp_. pack_unpack internal procedure shares stack frame of external procedure imft_hasp_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME abort_attachment 000100 the_code_ptr abort_attachment 000102 caller_message abort_attachment imft_hasp_ 000100 iocb_ptr imft_hasp_ 000102 code imft_hasp_ 000103 loud_sw imft_hasp_ 000104 open_mode imft_hasp_ 000106 system_area_ptr imft_hasp_ 000110 arg_index imft_hasp_ 000111 terminal_attach_desc imft_hasp_ 000311 terminal_switch_name imft_hasp_ 000321 module_type imft_hasp_ 000324 data_received imft_hasp_ 000325 packed_length imft_hasp_ 000326 unpacked_chars imft_hasp_ 000327 logical_record_data_lth imft_hasp_ 000330 logical_record_data_ptr imft_hasp_ 000332 logical_record_data_bits_lth imft_hasp_ 000333 amount_left imft_hasp_ 000334 amount_sent imft_hasp_ 000335 amount_to_send imft_hasp_ 000336 fb14uu imft_hasp_ 000337 n_bytes imft_hasp_ 000340 ips_mask imft_hasp_ 000356 iad_ptr imft_hasp_ 000360 ipr_ptr imft_hasp_ 000362 ilr_ptr imft_hasp_ 000364 imft_logical_record_header imft_hasp_ 000372 terminal_io_record_ptr imft_hasp_ 000416 fb14uu receive_physical_record 000426 unpacked_length pack_unpack THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return tra_ext enable shorten_stack ext_entry ext_entry_desc int_entry set_cs_eis index_cs_eis alloc_based free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ continue_to_signal_ cu_$arg_list_ptr cu_$arg_ptr get_system_free_area_ hcs_$reset_ips_mask hcs_$set_ips_mask ioa_$general_rs iox_$attach_ioname iox_$close iox_$control iox_$destroy_iocb iox_$detach_iocb iox_$err_no_operation iox_$open iox_$propagate iox_$read_record iox_$write_record requote_string_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed error_table_$bad_mode error_table_$eof_record error_table_$improper_data_format error_table_$long_record error_table_$not_attached error_table_$not_closed error_table_$not_detached error_table_$not_open error_table_$short_record error_table_$unimplemented_version LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 16 000233 18 000241 187 000242 190 000265 191 000270 193 000271 196 000311 198 000316 200 000322 201 000327 203 000330 205 000332 206 000335 207 000340 208 000372 211 000373 213 000402 217 000427 218 000437 220 000441 221 000442 224 000443 225 000455 226 000561 228 000564 230 000603 232 000621 234 000645 236 000707 239 000751 240 000777 244 001024 245 001027 246 001030 248 001031 250 001033 251 001037 253 001050 254 001052 257 001053 259 001064 262 001066 263 001070 265 001072 267 001073 268 001075 272 001077 274 001100 276 001122 278 001135 279 001140 280 001142 281 001146 283 001151 285 001160 287 001170 289 001172 295 001173 298 001210 299 001215 301 001217 302 001223 303 001226 306 001227 308 001231 311 001251 312 001254 315 001255 316 001274 318 001276 320 001330 322 001331 324 001353 326 001366 328 001403 330 001410 331 001413 333 001416 334 001421 336 001424 339 001426 341 001435 343 001445 344 001446 350 001447 353 001463 354 001470 355 001472 357 001473 358 001477 359 001502 362 001503 363 001514 365 001523 367 001524 369 001546 371 001561 373 001564 374 001570 376 001573 379 001617 381 001625 383 001635 385 001637 391 001640 394 001652 395 001656 397 001657 398 001663 399 001666 402 001667 403 001673 404 001676 407 001677 409 001706 411 001711 413 001717 415 001720 417 001742 419 001755 421 001760 423 001767 425 001777 426 002001 432 002002 435 002025 436 002032 437 002034 439 002061 445 002062 448 002112 449 002117 451 002124 453 002134 455 002137 461 002140 464 002157 465 002163 466 002166 468 002170 469 002172 471 002174 472 002176 474 002200 478 002206 479 002210 480 002212 482 002220 485 002226 487 002235 488 002245 490 002247 494 002251 497 002252 503 002260 505 002262 507 002265 509 002267 510 002272 513 002276 516 002307 517 002312 518 002317 520 002324 524 002331 526 002341 528 002343 529 002345 530 002346 537 002347 539 002353 540 002356 542 002362 544 002371 545 002373 546 002400 548 002405 552 002412 554 002422 556 002424 557 002426 560 002427 566 002430 569 002447 570 002453 571 002456 573 002460 574 002462 578 002464 579 002474 581 002476 583 002501 584 002504 587 002505 589 002512 590 002517 591 002522 594 002523 597 002530 598 002533 603 002534 604 002535 606 002544 607 002547 610 002552 613 002560 614 002570 616 002572 618 002604 619 002606 621 002607 624 002611 626 002612 628 002621 629 002631 633 002633 635 002644 636 002646 638 002647 641 002656 644 002665 646 002666 647 002671 653 002672 658 002700 660 002702 662 002707 663 002714 664 002725 665 002741 666 002755 669 002761 670 002770 674 002773 682 002774 685 003002 686 003014 688 003016 690 003026 698 003027 706 003035 708 003055 709 003060 710 003137 713 003200 715 003210 717 003217 719 003221 727 003224 733 003226 734 003231 735 003234 737 003236 740 003264 742 003273 750 003274 758 003276 759 003301 760 003303 762 003305 764 003336 765 003344 767 003347 768 003362 770 003365 778 003366 781 003367 794 003370 799 003376 800 003401 801 003403 802 003427 805 003430 810 003436 811 003444 812 003452 813 003475 ----------------------------------------------------------- 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