COMPILATION LISTING OF SEGMENT ibm3780_ Compiled by: Multics PL/I Compiler, Release 33a, of May 30, 1990 Compiled at: ACTC Technologies Inc. Compiled on: 08/08/90 1037.8 mdt Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1990 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1984 * 6* * * 7* *********************************************************** */ 8 9 /* ibm3780_: An I/O module for communicating with an IBM 3780. */ 10 11 /* Coded: March 1977 by David Vinograd */ 12 /* Modified: 1979 April by Art Beattie to accept abbreviated control 13* arguments, set default pll for printer to 120, and check for 14* required tty and comm control arguments. */ 15 /* Rewritten: February 1984 by Allan Haggett because it did not work so well. 16* Of the things done differently in this version, the 17* multiplexing of multiple ibm3780_ attachments over a single 18* bisync_ attachment is the most important change. */ 19 /* Modified: July 1984 by Laurent Hazard to fix space expansion. */ 20 21 22 /****^ HISTORY COMMENTS: 23* 1) change(86-07-28,Beattie), approve(86-07-28,MCR7483), 24* audit(86-09-03,Brunelle), install(86-09-03,MR12.0-1144): 25* Modify interpretation of 512 character limit to include protocol overhead. 26* 2) change(90-06-13,Vu), approve(90-06-13,MCR8178), audit(90-07-13,Bubric), 27* install(90-08-08,MR12.4-1023): 28* ibm3780_ gets "size" condition after 99 attaches. 29* END HISTORY COMMENTS */ 30 31 32 /* * 33* * Each ibm3780_ switch of a station is attached to a single bisync_ 34* * switch. For each bisync_ attachment maintain a Comm Info Block 35* * (A rose is a rose ...) which describes the current state of affairs 36* * in the bisync_ world. Each ibm3780_ switch's "cib" is pointed to by 37* * "ad.cib_ptr". 38* * 39* * In order for this to work, we depend upon a "select_device" control 40* * order being issued before resuming operations on a new ibm3780_ 41* * switch (device). This allows us to change the characteristics of the 42* * bisync_ attachment to suit the ibm3780_ device about to be used. 43** */ 44 45 /* format: style4,indattr,ifthenstmt,ifthen,^indcomtxt,^indproc,indcom,comcol56 */ 46 ibm3780_: procedure (); 47 48 return; 49 50 /**** Parameters */ 51 52 dcl P_iocb_ptr pointer parameter; 53 dcl P_code fixed bin (35) parameter; 54 dcl P_attach_options (*) char (*) varying parameter; /* attach */ 55 dcl P_loud_sw bit (1) parameter; /* attach */ 56 dcl P_open_mode fixed bin parameter; /* open */ 57 dcl P_ignore_sw bit (1) parameter; /* open */ 58 dcl P_inbuf_ptr pointer parameter; /* get_chars: ptr to user buffer */ 59 dcl P_inbuf_len fixed bin (21) parameter; /* get_chars: length of user buffer */ 60 dcl P_inbuf_count fixed bin (21) parameter; /* get_chars: count of char's we are returning */ 61 dcl P_outbuf_ptr pointer parameter; /* put_chars: ptr to user buffer */ 62 dcl P_outbuf_len fixed bin (21) parameter; /* put_chars: count of char's to write */ 63 dcl P_pos_type fixed bin parameter; /* position */ 64 dcl P_pos_value fixed bin (21) parameter; /* position */ 65 dcl P_order char (*) parameter; /* control: the order */ 66 dcl P_info_ptr pointer parameter; /* control: order info structure */ 67 dcl P_new_modes char (*) parameter; /* modes */ 68 dcl P_old_modes char (*) parameter; /* modes */ 69 70 /**** Automatic */ 71 72 dcl ad_initialized_sw bit (1); /* Attach data is meaningful? */ 73 dcl char_string_ptr pointer; 74 dcl code fixed bin (35); 75 dcl unrecognized_attach_options char (256) varying; 76 dcl data_count fixed bin (21); 77 dcl option_comm char (32); 78 dcl option_tty char (32); 79 dcl info_ptr pointer; 80 dcl iocb_ptr pointer; 81 dcl loud_sw bit (1); /* Set if com_err_ sould be called on attach error */ 82 dcl ips_mask bit (36) aligned; 83 dcl open_mode fixed bin; 84 dcl order char (32); 85 dcl converted_chars char (512) varying; 86 dcl remaining_count fixed bin (21); 87 dcl system_free_area_ptr pointer; 88 dcl two_digits picture "99"; 89 90 dcl 1 set_bsc_modes_auto like info_set_bsc_modes aligned; 91 92 /**** Based */ 93 94 dcl info_string char (32) based (info_ptr); 95 dcl char_string char (80) based (char_string_ptr); 96 dcl system_free_area area aligned based (system_free_area_ptr); 97 98 /**** Used by "control" entry. */ 99 dcl 1 info_read_status aligned based (info_ptr), 100 2 event_channel fixed bin (71), 101 2 input_pending bit (1); 102 103 dcl 1 info_set_bsc_modes aligned based (info_ptr), 104 2 transparent bit (1) unal, 105 2 ebcdic_sw bit (1) unal, 106 2 pad bit (34) unal; 107 108 109 /**** Internal static and constants. */ 110 111 dcl static_attach_count fixed bin init (0) int static; 112 dcl static_conv_proc_initialized_sw bit (1) static init ("0"b); /* Per process */ 113 /**** CIB list head and tail. */ 114 dcl first_cib_ptr pointer internal static init (null ()); 115 dcl last_cib_ptr pointer internal static init (null ()); 116 117 dcl BASE_VALUE fixed bin internal static options (constant) init (64); 118 dcl IBM3780_BIGGEST_BUFFER_SIZE fixed bin internal static options (constant) init (512); 119 dcl PROTOCOL_OVERHEAD fixed bin internal static options (constant) init (8); 120 121 dcl IRS char (1) internal static options (constant) init (""); 122 dcl IGS char (1) internal static options (constant) init (""); 123 dcl ME char (32) init ("ibm3780_") internal static options (constant); 124 dcl NL char (1) internal static options (constant) init (" 125 "); 126 dcl DEFAULT_PRINTER_SELECT char (1) internal static options (constant) init (""); 127 dcl DEFAULT_PUNCH_SELECT char (1) internal static options (constant) init (""); 128 dcl SPACE char (1) internal static options (constant) init (" "); 129 dcl SPACE_CHAR (2) char (1) internal static options (constant) init (" ", "@"); /* ASCII & EBCDIC */ 130 dcl (LOWERCASE init ("abcdefghijklmnopqrstuvwxyz"), 131 UPPERCASE init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ")) char (26) internal static options (constant); 132 dcl DEFAULT_CARRIAGE_CTL_TABLE (4) char (4) aligned internal static options (constant) init ("M", "/", "S", "T"); 133 dcl DEFAULT_SLEW_CTL_TABLE (6) char (4) aligned internal static options (constant) 134 init ("", /* (4) NUL */ 135 "A", /* ESC A */ 136 " ", /* (3) NUL VT */ 137 "A", /* ESC A */ 138 " ", /* (3) NUL TAB */ 139 "A"); /* ESC A */ 140 141 /**** Entries */ 142 143 dcl com_err_ entry options (variable); 144 dcl continue_to_signal_ entry (fixed bin (35)); 145 dcl convert_string_$input entry (char (*) var, pointer, char (*) var, fixed bin (35)); 146 dcl convert_string_$output entry (char (*) var, pointer, char (*) var, fixed bin (35)); 147 dcl cu_$arg_list_ptr entry () returns (pointer); 148 dcl cu_$arg_ptr entry (fixed bin, pointer, fixed bin (21), fixed bin (35)); 149 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 150 dcl get_system_free_area_ entry returns (pointer); 151 dcl get_ttt_info_ entry (pointer, fixed bin (35)); 152 dcl hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned); 153 dcl hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned); 154 dcl ibm3780_io_call_control_ entry (pointer, pointer, pointer, fixed bin (35)); 155 dcl ioa_$rsnnl entry options (variable); 156 dcl ioa_$general_rs entry (pointer, fixed bin, fixed bin, char (*), fixed bin, bit (1) aligned, bit (1) aligned); 157 158 /**** External */ 159 160 dcl (error_table_$action_not_performed, 161 error_table_$bad_arg, 162 error_table_$bad_conversion, 163 error_table_$bad_mode, 164 error_table_$badopt, 165 error_table_$bisync_bid_fail, 166 error_table_$inconsistent, 167 error_table_$no_operation, 168 error_table_$noarg, 169 error_table_$not_attached, 170 error_table_$not_closed, 171 error_table_$not_detached, 172 error_table_$not_open, 173 error_table_$null_info_ptr, 174 error_table_$wrong_no_of_args) fixed bin (35) external static; 175 dcl ibm3780_conv_$transparent fixed bin external; 176 dcl ibm3780_conv_$slew_ctl_table_ptr pointer external; 177 dcl ibm3780_conv_$carriage_ctl_table_ptr pointer external; 178 dcl sys_info$max_seg_size fixed bin external; 179 180 181 dcl (any_other, cleanup, quit) condition; 182 183 dcl (addr, after, before, char, codeptr, copy, divide, fixed, 184 hbound, lbound, length, ltrim, maxlength, min, null, rtrim, 185 search, substr, translate, unspec) builtin; 186 187 /* Attach an IO switch to a new or existing comm switch. */ 188 189 ibm3780_attach: 190 entry (P_iocb_ptr, P_attach_options, P_loud_sw, P_code); 191 192 /* Copy parameters and make gullibility check. */ 193 iocb_ptr = P_iocb_ptr; 194 loud_sw = P_loud_sw; 195 code, P_code = 0; 196 197 198 if iocb_ptr -> iocb.attach_descrip_ptr ^= null () then do; 199 P_code = error_table_$not_detached; 200 if loud_sw then call com_err_ (P_code, ME, "Switch ^a.", iocb_ptr -> iocb.name); 201 return; 202 end; 203 204 adp = null (); /* No attach data yet. */ 205 ad_initialized_sw = "0"b; /* ... */ 206 cib_ptr = null (); 207 system_free_area_ptr = get_system_free_area_ (); 208 209 on condition (cleanup) call attach_cleaner (); 210 211 if hbound (P_attach_options, 1) < 4 then 212 call abort_attach (error_table_$wrong_no_of_args, 213 "At least ""-comm"" and ""-tty"" must be supplied."); 214 215 /* One time: Put some defaults here. These values also live in the */ 216 /* attach data and are set at each "select_device". */ 217 if ^static_conv_proc_initialized_sw then do; 218 ibm3780_conv_$carriage_ctl_table_ptr = addr (DEFAULT_CARRIAGE_CTL_TABLE); 219 ibm3780_conv_$slew_ctl_table_ptr = addr (DEFAULT_SLEW_CTL_TABLE); 220 ibm3780_conv_$transparent = 0; 221 static_conv_proc_initialized_sw = "1"b; 222 end; 223 224 /* Setup default attach data. */ 225 call allocate_attach_data (); 226 ad_initialized_sw = "1"b; /* Trust it now. */ 227 228 ad.attach_desc = rtrim (ME); /* ibm3780_ */ 229 unrecognized_attach_options = ""; /* Pass these to comm module. */ 230 option_tty, option_comm = ""; 231 232 /* Simply move this loop into its own procedure. It may punt. */ 233 call process_attach_options (); 234 235 /* Do we have all required options -comm and -tty ? */ 236 if option_comm = "" then call abort_attach (error_table_$noarg, """-comm"""); 237 if option_tty = "" then call abort_attach (error_table_$noarg, """-tty"""); 238 239 /* Cross-check attach options. */ 240 if (ad.char_mode = ASCII & ad.transparent) then 241 call abort_attach (error_table_$inconsistent, "^/Control arguments -ascii and -transparent."); 242 243 if ad.phys_line_length = 0 then /* We will decide? */ 244 if ad.device_type = PRINTER then ad.phys_line_length = 120; 245 else ad.phys_line_length = 80; 246 247 /* These values are taken from old ibm3780_ code. */ 248 if (^ad.transparent | ad.multi_record) then 249 ad.record_len = IBM3780_BIGGEST_BUFFER_SIZE; 250 else ad.record_len = ad.phys_line_length; 251 252 /* See this procedure for notes. */ 253 call set_ad_multirecord_info (); 254 255 /* Find a Comm Info Block for this channel. */ 256 do cib_ptr = first_cib_ptr repeat (cib_ptr -> cib.chain.next_cib_ptr) while (cib_ptr ^= null ()); 257 if cib_ptr -> cib.device_channel = option_tty then 258 goto CHANNEL_HAS_CIB; 259 end; 260 261 /* Fell through... have to create a new CIB. */ 262 call cib_create (cib_ptr); /* Allocate it. */ 263 cib.device_channel = option_tty; 264 265 CHANNEL_HAS_CIB: /* Ith switch for this CIB. */ 266 ad.cib_ptr = cib_ptr; /* Have to get at switch's CIB. */ 267 268 /* Do we have to attach the comm module? */ 269 if ^cib.attached_sw then do; /* Once per target channel. */ 270 271 /* See this procedure for fascinating notes. */ 272 call attach_comm_module (option_comm, option_tty, unrecognized_attach_options, cib.comm_iocb_ptr); 273 cib.attached_sw = "1"b; 274 end; 275 276 /* Make changes and tell anyone concerned. */ 277 ips_mask = ""b; 278 on condition (any_other) call any_other_handler (); 279 280 call hcs_$set_ips_mask ((""b), ips_mask); 281 282 iocb_ptr -> iocb.attach_descrip_ptr = addr (ad.attach_desc); 283 iocb_ptr -> iocb.attach_data_ptr = adp; 284 iocb_ptr -> iocb.open = ibm3780_open; 285 iocb_ptr -> iocb.detach_iocb = ibm3780_detach; 286 287 /* This switch is now officially using this CIB. */ 288 cib.n_attached = cib.n_attached + 1; 289 290 call iox_$propagate (iocb_ptr); 291 292 revert condition (cleanup); /* All is OK now. */ 293 294 call hcs_$reset_ips_mask (ips_mask, ips_mask); 295 296 revert condition (any_other); /* Not our fault. */ 297 298 ATTACH_RETURN: /* Non local target for abort_attach. */ 299 return; 300 301 ibm3780_detach: 302 entry (P_iocb_ptr, P_code); 303 304 iocb_ptr = P_iocb_ptr; 305 P_code = 0; 306 307 /* Just be sure it is attached and opened. */ 308 if iocb_ptr -> iocb.attach_descrip_ptr = null () then do; 309 P_code = error_table_$not_attached; 310 return; 311 end; 312 313 if iocb_ptr -> iocb.open_descrip_ptr ^= null () then do; 314 P_code = error_table_$not_closed; 315 return; 316 end; 317 318 /* Looks good so finish initialization. */ 319 system_free_area_ptr = get_system_free_area_ (); 320 adp = iocb_ptr -> iocb.attach_data_ptr; 321 cib_ptr = ad.cib_ptr; 322 323 /* Remove knowledge of this switch from the CIB. */ 324 cib.n_attached = cib.n_attached - 1; 325 326 call attach_cleaner (); /* Maybe free the CIB too. */ 327 328 ips_mask = ""b; /* Complete IOCB. */ 329 330 on condition (any_other) call any_other_handler (); 331 call hcs_$set_ips_mask ((""b), ips_mask); 332 333 iocb_ptr -> iocb.attach_descrip_ptr = null (); 334 iocb_ptr -> iocb.attach_data_ptr = null (); 335 iocb_ptr -> iocb.detach_iocb = iox_$err_not_attached; 336 iocb_ptr -> iocb.open = iox_$err_not_attached; 337 iocb_ptr -> iocb.control = iox_$err_not_attached; 338 339 call iox_$propagate (iocb_ptr); 340 call hcs_$reset_ips_mask (ips_mask, ips_mask); 341 342 revert condition (any_other); 343 344 return; 345 346 ibm3780_open: 347 entry (P_iocb_ptr, P_open_mode, P_ignore_sw, P_code); 348 349 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 350 P_code = 0; 351 352 if iocb_ptr -> iocb.open_descrip_ptr ^= null () then do; 353 P_code = error_table_$not_closed; 354 return; 355 end; 356 357 open_mode = P_open_mode; 358 359 /* We support SI, SO, and SIO. Comm switch is always SIO though. */ 360 if ^((open_mode = Stream_input) | (open_mode = Stream_output) | (open_mode = Stream_input_output)) then do; 361 P_code = error_table_$bad_mode; 362 return; 363 end; 364 365 adp = iocb_ptr -> iocb.attach_data_ptr; 366 cib_ptr = ad.cib_ptr; 367 368 ad.open_description = rtrim (iox_modes (open_mode)); 369 370 /* Is this the first open for this comm? */ 371 if ^cib.opened_sw then do; 372 call open_comm_module (P_code); 373 if P_code ^= 0 then return; /* Has to work. */ 374 else cib.opened_sw = "1"b; 375 end; 376 377 ips_mask = ""b; 378 379 on condition (any_other) call any_other_handler (); 380 call hcs_$set_ips_mask ((""b), ips_mask); 381 382 if ((open_mode = Stream_input) | (open_mode = Stream_input_output)) then do; 383 iocb_ptr -> iocb.get_chars = ibm3780_get_chars; 384 iocb_ptr -> iocb.get_line = ibm3780_get_line; 385 end; 386 387 if ((open_mode = Stream_output) | (open_mode = Stream_input_output)) then 388 iocb_ptr -> iocb.put_chars = ibm3780_put_chars; 389 390 iocb_ptr -> iocb.control = ibm3780_control; 391 iocb_ptr -> iocb.position = ibm3780_position; 392 iocb_ptr -> iocb.modes = ibm3780_modes; 393 iocb_ptr -> iocb.close = ibm3780_close; 394 iocb_ptr -> iocb.detach_iocb = ibm3780_detach; 395 396 /* Make it officially open. */ 397 iocb_ptr -> iocb.open_descrip_ptr = addr (ad.open_description); 398 399 call iox_$propagate (iocb_ptr); 400 401 call hcs_$reset_ips_mask (ips_mask, ips_mask); 402 403 revert condition (any_other); 404 405 return; 406 407 ibm3780_close: 408 entry (P_iocb_ptr, P_code); 409 410 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 411 P_code = 0; 412 413 if iocb_ptr -> iocb.open_descrip_ptr = null () then do; /* Closed. */ 414 P_code = error_table_$not_open; 415 return; 416 end; 417 418 adp = iocb_ptr -> iocb.attach_data_ptr; 419 cib_ptr = ad.cib_ptr; 420 421 /* Close the comm switch if this is the last ibm3780 switch on it. */ 422 if cib.opened_sw then 423 if cib.n_attached <= 1 then do; 424 call iox_$close (cib.comm_iocb_ptr, (0)); 425 cib.opened_sw = "0"b; 426 end; 427 428 ips_mask = ""b; 429 430 on condition (any_other) call any_other_handler (); 431 call hcs_$set_ips_mask ((""b), ips_mask); 432 433 iocb_ptr -> iocb.open_descrip_ptr = null (); 434 435 iocb_ptr -> iocb.open = ibm3780_open; 436 iocb_ptr -> iocb.detach_iocb = ibm3780_detach; 437 438 iocb_ptr -> iocb.control, 439 iocb_ptr -> iocb.position, 440 iocb_ptr -> iocb.modes, 441 iocb_ptr -> iocb.get_chars, 442 iocb_ptr -> iocb.get_line, 443 iocb_ptr -> iocb.put_chars = iox_$err_no_operation; 444 445 call iox_$propagate (iocb_ptr); 446 call hcs_$reset_ips_mask (ips_mask, ips_mask); 447 448 revert condition (any_other); 449 450 return; 451 452 /****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 453* * * 454* * Control Notes: * 455* * * 456* * There is a crock here which will work as long as users of this IO * 457* * module use the "select_device" order before initiating a new series * 458* * of IO operations for a device. We take this as a cue to perform any * 459* * necessary reconfiguration of the comm connection to suite the device * 460* * selected. We also have to set static in the ibm3780_conv_ module so * 461* * that the hacking performed by "prt_conv_", as called from someone * 462* * like "remote_printer_" BEFORE calling iox_$put_chars, will result * 463* * in the right transformations for this device. Not pretty... * 464* * * 465* * All identifiers beginning with "info_" are based on "info_ptr". * 466* * * 467* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 468 469 ibm3780_control: 470 entry (P_iocb_ptr, P_order, P_info_ptr, P_code); 471 472 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 473 order = P_order; 474 info_ptr = P_info_ptr; 475 P_code, code = 0; 476 477 adp = iocb_ptr -> iocb.attach_data_ptr; 478 cib_ptr = ad.cib_ptr; 479 480 /* Be compatible with old ibm3780_. */ 481 if cib.comm_iocb_ptr = null () then do; 482 P_code = error_table_$no_operation; 483 return; 484 end; 485 486 if order = "select_device" then do; /* setup device */ 487 488 call reject_null_info (); 489 490 if info_string = TELEPRINTER then 491 ad.device_type = PRINTER; 492 else if (info_string = PRINTER | info_string = PUNCH) then 493 ad.device_type = info_string; 494 else do; /* Unknown device. Code is for compatibility. */ 495 P_code = error_table_$no_operation; 496 return; 497 end; 498 499 if iocb_ptr = cib.last_selected_iocb_ptr then /* Last select over bisync_ was for this switch? */ 500 if ad.device_type = ad.last_selected_device then /* And we are selecting the same device? */ 501 return; /* Optimize at a certain risk. */ 502 503 call select_device (code); /* Select it and set */ 504 if code ^= 0 then goto CONTROL_RETURN; 505 call configure_comm (code); /* up bisync_ for it. */ 506 if code ^= 0 then goto CONTROL_RETURN; 507 508 /* It all worked so... */ 509 cib.last_selected_iocb_ptr = iocb_ptr; 510 ad.last_selected_device = ad.device_type; 511 512 end; /* select_device */ 513 514 else if order = "set_bsc_modes" then do; 515 516 call reject_null_info (); 517 518 ad.transparent = info_set_bsc_modes.transparent; 519 if info_set_bsc_modes.ebcdic_sw then 520 ad.char_mode = EBCDIC; 521 else ad.char_mode = ASCII; 522 523 /* This informs bisync_ of changes. */ 524 call configure_comm (code); 525 526 end; /* set_bsc_modes */ 527 528 else if order = "set_multi_record_mode" then do; 529 530 ad.multi_record = "1"b; 531 goto PASS_CONTROL_ORDER; 532 533 end; /* set_multi_record_mode */ 534 535 else if order = "runout" | order = "end_write_mode" then do; 536 537 call write_buffer (); 538 ad.output_buf = ""; 539 goto PASS_CONTROL_ORDER; 540 541 end; /* runout */ 542 543 else if order = "resetwrite" then do; 544 545 ad.output_buf = ""; 546 goto PASS_CONTROL_ORDER; 547 548 end; /* resetwrite */ 549 550 else if order = "resetread" then do; 551 552 ad.input_buf = ""; 553 goto PASS_CONTROL_ORDER; 554 555 end; /* resetread */ 556 557 else if order = "reset" then ad.edited = "1"b; 558 else if order = "io_call" then 559 call ibm3780_io_call_control_ (adp, iocb_ptr, info_ptr, code); 560 561 /* See if this is understood by comm module. */ 562 else do; 563 PASS_CONTROL_ORDER: 564 call iox_$control (cib.comm_iocb_ptr, order, info_ptr, code); 565 end; 566 567 /* Postprocessing: We have a say in read_status order. */ 568 if code = 0 then /* Comm took it. */ 569 if order = "read_status" then /* And it was this. */ 570 info_read_status.input_pending = (length (ad.input_buf) > 0 | info_read_status.input_pending); 571 572 CONTROL_RETURN: 573 P_code = code; /* Pass back any error. */ 574 return; 575 576 577 /**** Control entry procedure to make sure we have an info pointer. */ 578 reject_null_info: 579 procedure (); 580 581 if info_ptr ^= null () then return; /* Continue... */ 582 583 code = error_table_$null_info_ptr; 584 goto CONTROL_RETURN; 585 586 end reject_null_info; 587 588 /**** This code is from old module. Note that the old module would never 589* return a non-zero code, so we do not either. */ 590 591 ibm3780_modes: 592 entry (P_iocb_ptr, P_new_modes, P_old_modes, P_code); 593 594 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 595 P_old_modes = ""; /* No modes are passed back. */ 596 P_code = 0; 597 598 if P_new_modes = "" then return; 599 600 adp = iocb_ptr -> iocb.attach_data_ptr; 601 602 if P_new_modes = "non_edited" then 603 ad.edited = "0"b; 604 else if P_new_modes = "default" then 605 ad.edited = "1"b; 606 else ; /* Old module would assign error to */ 607 /* automatic variable, then return! */ 608 609 return; 610 611 ibm3780_position: 612 entry (P_iocb_ptr, P_pos_type, P_pos_value, P_code); 613 614 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 615 P_code = 0; 616 617 adp = iocb_ptr -> iocb.attach_data_ptr; 618 cib_ptr = ad.cib_ptr; 619 620 call iox_$position (cib.comm_iocb_ptr, P_pos_type, P_pos_value, P_code); 621 622 return; 623 624 /**** Get_line and get_chars perform the same operation (compatible with old). */ 625 626 ibm3780_get_line: 627 ibm3780_get_chars: 628 entry (P_iocb_ptr, P_inbuf_ptr, P_inbuf_len, P_inbuf_count, P_code); 629 630 /* 631* This procedure along with get_string do not seem to make any 632* real use of the variable remaining_count, and assume that the caller 633* has provided a big enough buffer to hold an entire card image. 634* This is probably okay, but I'm not sure and it should be looked 635* into in the near future. - CLM */ 636 637 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 638 P_code = 0; 639 640 adp = iocb_ptr -> iocb.attach_data_ptr; 641 cib_ptr = ad.cib_ptr; 642 code = 0; 643 644 P_inbuf_count, data_count = 0; /* Count of char's read. */ 645 remaining_count = P_inbuf_len; /* We can return this many. */ 646 char_string_ptr = P_inbuf_ptr; 647 648 call get_string (); /* Do it here. */ 649 650 GET_CHARS_RETURN: /* Update the output parameters from auto's. */ 651 P_code = code; 652 P_inbuf_count = data_count; 653 654 return; 655 656 ibm3780_put_chars: 657 entry (P_iocb_ptr, P_outbuf_ptr, P_outbuf_len, P_code); 658 659 iocb_ptr = P_iocb_ptr -> iocb.actual_iocb_ptr; 660 P_code = 0; 661 662 adp = iocb_ptr -> iocb.attach_data_ptr; 663 cib_ptr = ad.cib_ptr; 664 code = 0; 665 666 if (P_outbuf_len < 0 | P_outbuf_len > sys_info$max_seg_size * 4) then do; 667 P_code = error_table_$bad_arg; 668 return; 669 end; 670 671 remaining_count = P_outbuf_len; 672 char_string_ptr = P_outbuf_ptr; 673 674 do while (remaining_count > 0); 675 call put_string (); 676 if code ^= 0 then goto PUT_CHARS_RETURN; 677 end; 678 679 PUT_CHARS_RETURN: 680 P_code = code; 681 682 return; 683 684 /**** This is the procedure which does all the work for "get_chars". 685* It returns the data in card_image to the user buffer. */ 686 687 get_string: 688 procedure (); 689 690 dcl card_image char (80) varying; /* Card readers *always* send 80 characters. */ 691 dcl igs_pos fixed bin (21); 692 dcl space_cnt fixed bin; 693 694 if (length (ad.input_buf)) = 0 then 695 call read_buffer (); 696 697 if ad.transparent then do; 698 if ad.multi_record then do; 699 700 /* Need those 80 characters. */ 701 if length (ad.input_buf) < 80 then 702 call read_buffer (); /* Get more from comm. */ 703 card_image = substr (ad.input_buf, 1, 80); 704 705 if length (ad.input_buf) > 80 then 706 ad.input_buf = substr (ad.input_buf, 81); 707 else ad.input_buf = ""; 708 end; 709 else do; 710 card_image = ad.input_buf; 711 ad.input_buf = ""; 712 end; 713 end; 714 715 else do; /* Not transparent. */ 716 717 /* If no IRS in buffer, then read some more. */ 718 if search (ad.input_buf, IRS) = 0 then 719 call read_buffer (); 720 721 card_image = before (ad.input_buf, IRS); 722 ad.input_buf = after (ad.input_buf, IRS); 723 724 /* Hack space compression. */ 725 igs_pos = search (card_image, IGS); 726 do while (igs_pos > 0); 727 space_cnt = fixed (unspec (substr (card_image, (igs_pos + 1), 1)), 9) - BASE_VALUE; 728 card_image = substr (card_image, 1, (igs_pos - 1)) || copy (SPACE_CHAR (ad.char_mode), space_cnt) 729 || substr (card_image, (igs_pos + 2)); 730 igs_pos = search (card_image, IGS); 731 end; 732 end; 733 734 call convert_string_$input (card_image, addr (ad.ttt_info), converted_chars, code); 735 if code ^= 0 then return; 736 737 /* Copy bytes and update state. */ 738 char_string = converted_chars; 739 data_count = data_count + length (converted_chars); 740 char_string_ptr = substraddr (char_string, (length (converted_chars) + 1)); 741 remaining_count = remaining_count - length (card_image); 742 743 return; 744 745 746 747 /**** Internal procedure of "get_string" to read data into the variable 748* card_image up to the preset length. We handle the case where there are 749* characters already in our input buffer but we have been called to get 750* more. This allows us to go after a character we need (ie. IRS) but 751* did not get from comm last time. */ 752 753 read_buffer: 754 procedure (); 755 756 dcl n_read fixed bin (21); 757 dcl n_not_processed fixed bin (21); /* Now in buffer. */ 758 759 n_not_processed = length (ad.input_buf); /* Could be zero. */ 760 if n_not_processed >= ad.record_len then return; 761 762 763 call iox_$get_chars (cib.comm_iocb_ptr, 764 substraddr (ad.input_buf, (n_not_processed + 1)), /* Fill from here. */ 765 (ad.record_len - n_not_processed), /* Up to this many. */ 766 n_read, code); 767 768 if code ^= 0 then goto GET_CHARS_RETURN; /* Has to work. */ 769 770 ad.input_buf = substr (ad.input_buf, 1, (n_read + n_not_processed)); 771 772 return; 773 774 end read_buffer; 775 776 end get_string; 777 778 /**** This is the procedure which does all the work for "put_chars". It takes 779* user data in chunks and puts it in the output buffer. This code is almost 780* identical to that in the old ibm3780_ module. */ 781 782 put_string: 783 procedure (); 784 785 dcl input char (512) varying; 786 dcl input_count fixed bin; /* Number of characters to transmit. */ 787 dcl (igs_pos, igs_found_pos) fixed bin; 788 dcl substring char (512) varying; 789 790 input_count = min (remaining_count, ad.record_len); 791 input = substr (char_string, 1, input_count); 792 converted_chars = ""; 793 794 if ad.device_type ^= PUNCH then do; 795 ad.ttt_info.escape_output = "0"b; 796 call convert_string_$output (substr (input, 1, 2), addr (ad.ttt_info), converted_chars, code); 797 ad.ttt_info.escape_output = "1"b; 798 if code ^= 0 then return; 799 igs_found_pos = 3; 800 end; 801 else igs_found_pos = 1; 802 803 igs_pos = search (substr (input, igs_found_pos), IGS); 804 do while (igs_pos > 0); 805 call convert_string_$output (substr (input, igs_found_pos, igs_pos), addr (ad.ttt_info), substring, code); 806 if code ^= 0 then return; 807 igs_found_pos = igs_found_pos + igs_pos + 1; 808 converted_chars = converted_chars || substring; 809 converted_chars = converted_chars || substr (input, igs_found_pos - 1, 1); 810 igs_pos = search (substr (input, igs_found_pos), IGS); 811 end; 812 call convert_string_$output (substr (input, igs_found_pos), addr (ad.ttt_info), substring, code); 813 if code ^= 0 then return; 814 815 converted_chars = converted_chars || substring; 816 817 if ad.transparent then do; 818 ad.output_buf = converted_chars; 819 call write_buffer (); 820 if code ^= 0 then return; 821 ad.output_buf = ""; 822 end; 823 else do; 824 825 /* If we cannot stuff anymore, then we add IRS and write it. */ 826 if length (ad.output_buf) + length (converted_chars) >= ad.record_len then do; 827 call write_buffer (); 828 if code ^= 0 then return; 829 ad.output_buf = ""; 830 end; 831 ad.output_buf = ad.output_buf || converted_chars || IRS; 832 end; 833 834 remaining_count = remaining_count - input_count; 835 char_string_ptr = substraddr (char_string, (input_count + 1)); 836 return; 837 838 end put_string; 839 840 /**** This is probably a crock. Anyway, this code is taken directly from old module. */ 841 842 write_buffer: 843 procedure (); 844 845 if ^cib.in_quit_state_sw then do; /* This BISYNC_ is healthy? */ 846 WRITE_BUFFER_RETRY: 847 848 call iox_$put_chars (cib.comm_iocb_ptr, substraddr (ad.output_buf, 1), length (ad.output_buf), code); 849 if code = 0 then return; 850 851 /* Check for bad bisync_ lossage. */ 852 else if code = error_table_$bisync_bid_fail then do; 853 854 on condition (cleanup) begin; 855 cib.in_quit_state_sw = "0"b; 856 end; 857 858 cib.in_quit_state_sw = "1"b; 859 signal condition (quit); 860 cib.in_quit_state_sw = "0"b; 861 goto WRITE_BUFFER_RETRY; 862 863 end; 864 end; 865 866 return; 867 868 end write_buffer; 869 870 /**** Select the device (ad.device_type) and the terminal (ad.terminal_id). */ 871 select_device: 872 procedure (P_code); 873 874 dcl P_code fixed bin (35) parameter; 875 876 dcl control_string char (256) varying; /* Send this. */ 877 dcl tab_pos fixed bin; 878 879 P_code = 0; 880 881 /* A non-null terminal ID means we have to prepend it to select. */ 882 if ad.terminal_id ^= "" then do; /* Have to send this? */ 883 if ad.device_type = PRINTER then 884 control_string = ad.terminal_id || ad.printer_select; 885 else if ad.device_type = PUNCH then 886 control_string = ad.terminal_id || ad.punch_select; 887 else return; /* No select. */ 888 889 control_string = control_string || ENQ; 890 end; 891 892 else do; /* No terminal ID. */ 893 if ad.device_type = PRINTER then 894 control_string = ad.printer_select; 895 else if ad.device_type = PUNCH then 896 control_string = ad.punch_select; 897 else return; 898 end; 899 900 /* Do the actual select. This procedure, which is internal, writes "control_string". */ 901 call write_nontransparent (); 902 903 /* May have to set tabs if we are selecting printer. */ 904 if (ad.device_type = PRINTER & ad.has_tabs) then do; 905 906 /* Clear control string forcibly. */ 907 substr (control_string, 1, maxlength (control_string)) = ""; 908 909 control_string = ESC || HT; /* Control prefix. */ 910 911 /* Put a tab every 10th column. */ 912 do tab_pos = 10 by 10 while (tab_pos < ad.phys_line_length); 913 substr (control_string, tab_pos, 1) = HT; 914 end; 915 916 control_string = control_string || NL; 917 call write_nontransparent (); 918 919 end; /* printer init */ 920 921 WRITE_NONTRANSPARENT_ERROR: /* Our code parameter is set, return now. */ 922 return; 923 924 925 /****^ Internal procedure of "select_device". We transmit "control_string" 926* in nontransparent mode in a single block. We use "P_code" and return 927* if any error is encountered. */ 928 929 write_nontransparent: 930 procedure (); 931 932 ad.ttt_info.escape_output = "0"b; 933 call convert_string_$output (control_string, addr (ad.ttt_info), control_string, P_code); 934 ad.ttt_info.escape_output = "1"b; 935 if P_code ^= 0 then goto WRITE_NONTRANSPARENT_ERROR; 936 937 /* The old ibm3780_ copied data to a varying string overlay before calling bisync_. We do not. */ 938 939 call iox_$control (cib.comm_iocb_ptr, "send_nontransparent_msg", addr (control_string), P_code); 940 if P_code ^= 0 then goto WRITE_NONTRANSPARENT_ERROR; 941 942 return; 943 944 end write_nontransparent; 945 946 end select_device; 947 948 /****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 949* * * 950* * A "select_device" is being performed. We have multiple switches, each * 951* * with a different requirement as to how the single comm (bisync_) * 952* * switch should be configured. We simply reconfigure to characteristics * 953* * in the attach data for this switch. This is not fool-proof of course. * 954* * * 955* * This is also called at open time to be sure that BISYNC world is ready. * 956* * * 957* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 958 959 configure_comm: 960 procedure (P_code); 961 962 dcl P_code fixed bin (35) parameter; 963 dcl multi_record_count fixed bin (35); 964 965 /* First, set the static used for output pre-conversion. */ 966 ibm3780_conv_$carriage_ctl_table_ptr = addr (ad.carriage_ctl_table); 967 ibm3780_conv_$slew_ctl_table_ptr = addr (ad.slew_ctl_table); 968 ibm3780_conv_$transparent = fixed (ad.transparent, 35, 0); 969 970 /* Tell BISYNC_ about transparency and character mode. */ 971 unspec (set_bsc_modes_auto) = ""b; 972 set_bsc_modes_auto.transparent = ad.transparent; 973 if ad.char_mode = EBCDIC then set_bsc_modes_auto.ebcdic_sw = "1"b; 974 975 call iox_$control (cib.comm_iocb_ptr, "set_bsc_modes", addr (set_bsc_modes_auto), P_code); 976 if P_code ^= 0 then return; /* Bad lossage. */ 977 978 call set_ad_multirecord_info (); /* Set multi-record info based on transparency. */ 979 980 multi_record_count = ad.multi_record_count; 981 call iox_$control (cib.comm_iocb_ptr, "set_multi_record_mode", addr (multi_record_count), P_code); 982 983 return; 984 985 end configure_comm; 986 987 set_ad_multirecord_info: 988 procedure (); 989 990 /****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 991* * * 992* * This code is taken from the old ibm3780_ IO module. I am not sure * 993* * why it is done exactly like this, but we will leave it until is is * 994* * proven defective. This procedure is called at attach time, and * 995* * whenever we have to set the characteristics of the comm attachment. * 996* * * 997* * Note that the bit ad.multi_record is redundant, as a count of 1 means * 998* * that it is not multi-record. See bisync_.pl1. 999* * * 1000* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1001 1002 /* Set multi-record information based on transparency mode. */ 1003 if ^ad.transparent then do; 1004 ad.multi_record = "1"b; 1005 ad.multi_record_count = 512; 1006 end; 1007 else if ad.multi_record then do; 1008 ad.multi_record = "1"b; 1009 ad.multi_record_count = 6; 1010 end; 1011 else do; 1012 ad.multi_record = "0"b; 1013 ad.multi_record_count = 1; 1014 end; 1015 1016 return; 1017 1018 end set_ad_multirecord_info; 1019 1020 /**** Usage: call abort_attach (code, ioa_args) */ 1021 abort_attach: 1022 procedure () options (variable, non_quick); 1023 1024 1025 dcl the_code fixed bin (35) based (the_code_ptr); 1026 dcl the_code_ptr pointer; 1027 1028 dcl abort_msg character (256); 1029 1030 call cu_$arg_ptr (1, the_code_ptr, (0), (0)); 1031 1032 if loud_sw then do; /* an error message is requested */ 1033 call ioa_$general_rs (cu_$arg_list_ptr (), 2, 3, abort_msg, (0), "1"b, "0"b); 1034 call com_err_ (the_code, ME, "Switch ^a. ^a", iocb_ptr -> iocb.name, abort_msg); 1035 end; 1036 1037 call attach_cleaner (); /* Undo any work. */ 1038 1039 if the_code = 0 then /* Caller must get non-zero code. */ 1040 P_code = error_table_$action_not_performed; 1041 else P_code = the_code; 1042 1043 go to ATTACH_RETURN; 1044 1045 end abort_attach; 1046 1047 /**** Attach entry calls us to alloc and init our attach block. */ 1048 1049 allocate_attach_data: 1050 procedure (); 1051 1052 allocate ad in (system_free_area) set (adp); 1053 unspec (ad) = ""b; 1054 ad.ptrs = null (); /* Get these level */ 1055 ad.chars = ""; /* 3 variables. */ 1056 ad.printer_select = DEFAULT_PRINTER_SELECT; 1057 ad.punch_select = DEFAULT_PUNCH_SELECT; 1058 ad.char_mode = EBCDIC; /* Default. */ 1059 ad.record_len = 80; 1060 ad.carriage_ctl_table (*) = DEFAULT_CARRIAGE_CTL_TABLE (*); 1061 ad.slew_ctl_table (*) = DEFAULT_SLEW_CTL_TABLE (*); 1062 /* Initialize remote_ttt_info. */ 1063 ad.ttt_info.ttt_ptrs = null (); /* Again, assigning */ 1064 ad.ttt_info.ttt_bits = "1"b; /* to level 3's. */ 1065 ad.ttt_info.terminal_type = ""; 1066 ad.ttt_info.kill_char = "@"; 1067 ad.ttt_info.erase_char = "#"; 1068 1069 return; 1070 1071 end allocate_attach_data; 1072 1073 /**** Attach entry procedure for processing attachment arguments. */ 1074 1075 process_attach_options: 1076 procedure (); 1077 1078 dcl arg_idx fixed bin; /* Current option. */ 1079 dcl arg_len fixed bin (21); 1080 dcl arg_ptr pointer; 1081 dcl arg char (arg_len) based (arg_ptr); /* An attach option. */ 1082 dcl ctl_string char (8) varying; /* For carriage and slew control. */ 1083 1084 do arg_idx = lbound (P_attach_options, 1) to hbound (P_attach_options, 1); 1085 1086 /* Set up "arg" and add option to attach description. */ 1087 call access_option (arg_idx); 1088 1089 /* Do not let this one get through. */ 1090 if arg = "-size" then 1091 call abort_attach (error_table_$badopt, "^a", arg); 1092 else if arg = "-transparent" then ad.transparent = "1"b; 1093 else if arg = "-nontransparent" then ad.transparent = "0"b; 1094 else if arg = "-ebcdic" then ad.char_mode = EBCDIC; 1095 else if arg = "-ascii" then ad.char_mode = ASCII; 1096 else if arg = "-horizontal_tab" | arg = "-htab" then ad.has_tabs = "1"b; 1097 else if arg = "-multi_record" then ad.multi_record = "1"b; 1098 else if arg = "-multi_point" then 1099 ad.terminal_id = fetch_arg ("Terminal ID"); 1100 else if arg = "-printer_select" then 1101 ad.printer_select = fetch_arg ("Printer select character"); 1102 else if arg = "-punch_select" then 1103 ad.punch_select = fetch_arg ("Punch select character"); 1104 else if arg = "-physical_line_length" | arg = "-pll" then 1105 ad.phys_line_length = fetch_numarg ("Line length"); 1106 else if arg = "-terminal_type" | arg = "-ttp" then do; 1107 ad.terminal_type = fetch_arg ("Terminal type"); 1108 ad.terminal_type = translate (ad.terminal_type, UPPERCASE, LOWERCASE); 1109 call get_ttt_info_ (addr (ad.ttt_info), code); 1110 if code ^= 0 then call abort_attach (code, "Cannot get ttt info for ""^a"".", arg); 1111 end; 1112 1113 /* The old ibm3780_ never checked lengths, so I suppose we cannot either. */ 1114 else if arg = "-carriage_ctl" then do; 1115 ctl_string = fetch_arg ("Carriage control characters"); 1116 call set_carriage_ctl (ctl_string, ad.carriage_ctl_table); 1117 end; 1118 else if arg = "-slew_ctl" then do; 1119 ctl_string = fetch_arg ("Slew control characters"); 1120 call set_slew_ctl (ctl_string, ad.slew_ctl_table); 1121 end; 1122 else if arg = "-device" then do; 1123 ad.device_type = fetch_arg ("Device name"); 1124 1125 /* Compatibility: No checking on name here. */ 1126 end; 1127 1128 /* These next two are required arguments. */ 1129 else if arg = "-comm" then option_comm = fetch_arg ("Comm module name"); 1130 else if arg = "-tty" then option_tty = fetch_arg ("TTY channel name"); 1131 1132 else do; 1133 unrecognized_attach_options = unrecognized_attach_options || SPACE; 1134 unrecognized_attach_options = unrecognized_attach_options || arg; 1135 end; 1136 1137 end; /* option processing loop */ 1138 1139 return; 1140 1141 /**** Internal procedures of "process_attach_options" for argument manipulation. */ 1142 1143 access_option: 1144 procedure (P_arg_idx); 1145 1146 dcl P_arg_idx fixed bin parameter; 1147 1148 /* Make "arg" reference P_attach_option (P_arg_idx). Assert: P_arg_idx <= bound (P_attach_options, 1) */ 1149 arg_ptr = substraddr (P_attach_options (P_arg_idx), 1); 1150 arg_len = length (P_attach_options (P_arg_idx)); 1151 1152 /* All options go into our attach description. */ 1153 ad.attach_desc = ad.attach_desc || SPACE || arg; 1154 1155 return; 1156 1157 end access_option; 1158 1159 1160 1161 /**** Procedures for fetching a value of a control (the current) argument. */ 1162 1163 fetch_arg: 1164 procedure (P_desc) returns (char (*)); 1165 1166 dcl P_desc char (*) parameter; 1167 dcl control_arg char (32); 1168 1169 control_arg = arg; /* Save it for error. */ 1170 1171 if arg_idx = hbound (P_attach_options, 1) then 1172 call abort_attach (error_table_$noarg, "^a following ""^a"".", P_desc, control_arg); 1173 1174 arg_idx = arg_idx + 1; /* Something is there. */ 1175 1176 call access_option (arg_idx); /* Set up "arg". */ 1177 1178 if arg = "" then 1179 call abort_attach (0, "^a for ""^a"" must be a non-null string.", P_desc, control_arg); 1180 1181 return (arg); 1182 1183 end fetch_arg; 1184 1185 1186 1187 /**** Same thing except we return a fixed bin. */ 1188 1189 fetch_numarg: 1190 procedure (P_desc) returns (fixed bin (35)); 1191 1192 dcl P_desc char (*) parameter; 1193 dcl control_arg char (32); 1194 dcl numarg fixed bin (35); 1195 dcl code fixed bin (35); /* Just for us. */ 1196 1197 control_arg = arg; 1198 1199 if arg_idx = hbound (P_attach_options, 1) then 1200 call abort_attach (error_table_$noarg, "^a following ""^a"".", P_desc, control_arg); 1201 1202 arg_idx = arg_idx + 1; 1203 1204 call access_option (arg_idx); 1205 1206 numarg = cv_dec_check_ (arg, code); 1207 1208 if code ^= 0 then 1209 call abort_attach (error_table_$bad_conversion, 1210 "^a for ""^a"" must be a number; not ""^a"".", P_desc, control_arg, arg); 1211 1212 return (numarg); /* Some number. */ 1213 1214 end fetch_numarg; 1215 1216 1217 1218 /**** Passed a varying string, set a control table array in the attach data. */ 1219 1220 set_carriage_ctl: 1221 procedure (P_string, P_table); 1222 1223 dcl P_string char (8) varying aligned parameter; 1224 dcl P_table (*) char (4) aligned parameter; 1225 dcl idx fixed bin; 1226 1227 /****^ Take the characters from the string 2 at a time, putting each pair 1228* in the next element of the table (vector). There is already a default 1229* control table in the table, put there at attach data initialization 1230* time. NOTE: We take characters up to the last *pair* only. The old 1231* ibm3780_ marched on whether he had no characters or an odd number of 1232* characters. We also make sure that we do not try to stuff characters 1233* off the end of the array (see "min" function at loop start. We do 1234* assume, correctly, that tables have lbound of 1. */ 1235 1236 do idx = 1 to min (hbound (P_table, 1), divide (length (P_string), 2, 17, 0)); 1237 P_table (idx) = substr (P_string, ((idx * 2) - 1), 2); 1238 end; 1239 1240 return; 1241 1242 1243 /**** Slew control table lives in elements 2, 4, and 6 of a six element vec. */ 1244 1245 set_slew_ctl: 1246 entry (P_string, P_table); 1247 1248 1249 /* As usual, strip off chars until we run out of chars of string or elements of array. */ 1250 /* Note that we divide the hbound by 2 as we double idx in loop. */ 1251 do idx = 1 to min (divide (hbound (P_table, 1), 2, 17, 0), divide (length (P_string), 2, 17, 0)); 1252 P_table (idx * 2) = substr (P_string, ((idx * 2) - 1), 2); 1253 end; 1254 1255 return; 1256 1257 end set_carriage_ctl; 1258 1259 1260 end process_attach_options; 1261 1262 attach_cleaner: /* Cleanup handler */ 1263 procedure (); 1264 1265 /* If we do not have attach data, then there is nothing to do. */ 1266 if adp = null () then return; 1267 1268 if ad_initialized_sw then do; /* Trust it? */ 1269 if ad.cib_ptr ^= null () then /* Using a CIB? */ 1270 call cib_janitor (ad.cib_ptr); /* Still need it? */ 1271 end; 1272 1273 /* Ok, now free our attach data. */ 1274 free ad in (system_free_area); 1275 adp = null (); /* Be clean. */ 1276 1277 return; 1278 1279 end attach_cleaner; 1280 1281 attach_comm_module: 1282 procedure (P_io_module_name, P_tty_channel, P_other_args, P_iocb_ptr) options (non_quick); 1283 1284 /****^ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 1285* * * 1286* * For each CIB there is a comm attachment. There may be multiple * 1287* * devices, and therefore switches, which are multiplexed over this * 1288* * single unique attachment. We attach with the simplest attach * 1289* * description possible, as per-device options are set for the comm * 1290* * module at "select_device" time. The only option we must specify * 1291* * at attach time is buffer size, as bisync_ will not allow us to * 1292* * ask later for a buffer larger than that specified in the attach * 1293* * options. We ask for the biggest we may need (512), plus some space * 1294* * for bisync_ overhead. * 1295* * * 1296* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 1297 1298 dcl P_io_module_name char (32) parameter; /* Input */ 1299 dcl P_tty_channel char (32) parameter; /* Input */ 1300 dcl P_other_args char (256) varying parameter; /* Input */ 1301 dcl P_iocb_ptr pointer parameter; /* Output */ 1302 1303 dcl switch_name char (32); 1304 dcl attach_desc char (256); 1305 dcl attach_code fixed bin (35); 1306 1307 /* Allows up to 99 attachments (compatibility code). 1308* but if there are more than 99 then attach as many 1309* as required (related bug fix phx17327.) */ 1310 1311 static_attach_count = static_attach_count + 1; 1312 1313 if static_attach_count < 100 then do; 1314 two_digits = static_attach_count; 1315 switch_name = rtrim (ME) || two_digits; 1316 end; 1317 else 1318 switch_name = rtrim (ME) || ltrim(char(static_attach_count)); 1319 1320 call ioa_$rsnnl ("^a ^a -size ^d ^a", attach_desc, (0), 1321 P_io_module_name, P_tty_channel, 1322 1323 /* Some IBM3780 emulators don't want more than 512 including 1324* overhead added by whatever protocol being used. 1325* */ 1326 (IBM3780_BIGGEST_BUFFER_SIZE - PROTOCOL_OVERHEAD), 1327 P_other_args); 1328 1329 call iox_$attach_name (switch_name, P_iocb_ptr, attach_desc, codeptr (ibm3780_), attach_code); 1330 if attach_code ^= 0 then call abort_attach (attach_code, "Cannot attach comm module.^/Attach description: ""^a"".", attach_desc); 1331 1332 return; 1333 1334 end attach_comm_module; 1335 1336 open_comm_module: 1337 procedure (P_code); 1338 1339 dcl P_code fixed bin (35) parameter; 1340 1341 P_code = 0; 1342 call iox_$open (cib.comm_iocb_ptr, Stream_input_output, ("0"b), P_code); 1343 1344 /* If open worked, then finish off the BISYNC initialization. */ 1345 /* This *must* be done now before user tries to use any switch. */ 1346 if P_code = 0 then 1347 call configure_comm ((0)); 1348 1349 return; 1350 1351 end open_comm_module; 1352 1353 /**** Procedures for managing CIBlocks. */ 1354 1355 cib_create: 1356 procedure (P_cib_ptr); 1357 1358 dcl P_cib_ptr pointer parameter; 1359 1360 allocate cib in (system_free_area) set (P_cib_ptr); 1361 unspec (P_cib_ptr -> cib) = ""b; 1362 P_cib_ptr -> cib.comm_iocb_ptr = null (); 1363 P_cib_ptr -> cib.last_selected_iocb_ptr = null (); 1364 P_cib_ptr -> cib.next_cib_ptr = null (); 1365 P_cib_ptr -> cib.prev_cib_ptr = last_cib_ptr;/* null if first. */ 1366 1367 /* Thread it in. */ 1368 if first_cib_ptr = null () then /* Very first CIB. */ 1369 first_cib_ptr = P_cib_ptr; 1370 else last_cib_ptr -> cib.next_cib_ptr = P_cib_ptr; 1371 1372 /* This is now the most recent. */ 1373 last_cib_ptr = P_cib_ptr; 1374 return; 1375 1376 1377 1378 /**** Checks to see if CIB is still needed. */ 1379 cib_janitor: 1380 entry (P_cib_ptr); 1381 1382 /* If we have a comm attachment but no ibm3780_ users on it, then remove the comm. */ 1383 if P_cib_ptr -> cib.attached_sw then /* Bisync_ attached? */ 1384 if P_cib_ptr -> cib.n_attached < 1 then do; /* Ibm3780_ switches. */ 1385 call iox_$close (P_cib_ptr -> cib.comm_iocb_ptr, (0)); 1386 call iox_$detach_iocb (P_cib_ptr -> cib.comm_iocb_ptr, (0)); 1387 P_cib_ptr -> cib.attached_sw = "0"b; 1388 1389 /* If first CIB, then update head of list. */ 1390 if P_cib_ptr -> cib.prev_cib_ptr = null () then 1391 first_cib_ptr = P_cib_ptr -> cib.next_cib_ptr; 1392 1393 /* Our forward pointer is bequeathed to previous block. */ 1394 else P_cib_ptr -> cib.prev_cib_ptr -> cib.next_cib_ptr = P_cib_ptr -> cib.next_cib_ptr; 1395 1396 /* Are we the tail? */ 1397 if P_cib_ptr -> cib.next_cib_ptr = null () then 1398 last_cib_ptr = P_cib_ptr -> cib.prev_cib_ptr; /* Update static. */ 1399 1400 /* Our backward pointer goes into our "next" CIB. */ 1401 else P_cib_ptr -> cib.next_cib_ptr -> cib.prev_cib_ptr = P_cib_ptr -> cib.prev_cib_ptr; 1402 1403 /* It is unthreaded... free it. */ 1404 free P_cib_ptr -> cib in (system_free_area); 1405 P_cib_ptr = null (); /* Useless now. */ 1406 end; 1407 1408 return; 1409 1410 1411 end cib_create; 1412 1413 /**** Handler for IPS masked code. */ 1414 1415 any_other_handler: 1416 procedure (); 1417 1418 /* Simply unmask and lateral. */ 1419 if ips_mask then call hcs_$reset_ips_mask (ips_mask, ips_mask); 1420 ips_mask = ""b; 1421 1422 call continue_to_signal_ ((0)); 1423 return; 1424 1425 end any_other_handler; 1426 1427 /**** SUBSTRADDR functions stolen from hasp_host_. */ 1428 1429 /**** Return a pointer to the specified character of a varying or nonvarying string. When the substraddr 1430* builtin function is finally implemented, these internal procedures should be removed */ 1431 1432 dcl substraddr generic (substraddr_nonvarying when (character (*) nonvarying, fixed binary precision (1:35)), 1433 substraddr_varying when (character (*) varying, fixed binary precision (1:35))); 1434 1435 1436 substraddr_nonvarying: 1437 procedure (P_string, P_position) returns (pointer); 1438 1439 dcl P_string character (*) nonvarying parameter; 1440 dcl P_position fixed binary (21) parameter; 1441 1442 dcl string_overlay (length (P_string)) character (1) unaligned based (addr (P_string)); 1443 1444 return (addr (string_overlay (P_position))); 1445 1446 end substraddr_nonvarying; 1447 1448 1449 substraddr_varying: 1450 procedure (P_string, P_position) returns (pointer); 1451 1452 dcl P_string character (*) varying parameter; 1453 dcl P_position fixed binary (21) parameter; 1454 1455 dcl 1 string_overlay aligned based (addr (P_string)), 1456 2 lth fixed binary (21), 1457 2 characters (0 refer (string_overlay.lth)) character (1) unaligned; 1458 1459 return (addr (string_overlay.characters (P_position))); 1460 1461 end substraddr_varying; 1462 1463 /* BEGIN INCLUDE FILE ... ibm3780_data.incl.pl1 ... 3/77 */ 1 2 1 3 /* Reworked February 1984 by Allan Haggett for new ibm3780_. */ 1 4 1 5 dcl adp ptr; /* local copy of pointer to attach data */ 1 6 1 7 dcl 1 ad aligned based (adp), 1 8 2 ttt_info like remote_ttt_info, 1 9 2 fixed, 1 10 3 phys_line_length fixed, 1 11 3 char_mode fixed bin, /* translation mode ascii or ebcdic */ 1 12 3 record_len fixed bin, /* length of output record in characters */ 1 13 3 line_length fixed bin, /* length of printer line */ 1 14 3 multi_record_count fixed bin, /* If multirecord, then this is records/block. */ 1 15 2 bits, 1 16 3 has_tabs bit (1), /* on if terminal has tab option */ 1 17 3 multi_record bit (1), /* enable multi record mode if on */ 1 18 3 auto_turnaround bit (1), /* enable auto turnaround if on */ 1 19 3 transparent bit (1), /* Set if in transparent mode */ 1 20 2 ptrs, 1 21 3 comm_info_ptr pointer, 1 22 3 cib_ptr pointer, /* Comm Info Block */ 1 23 2 chars, 1 24 3 printer_select char (1), 1 25 3 punch_select char (1), 1 26 3 terminal_id char (5), /* terminal id string of terminal */ 1 27 3 device_type char (32), /* Current device type. */ 1 28 3 last_selected_device char (32), /* Via select_device */ 1 29 3 attach_desc char (256) var, 1 30 3 input_buf char (512) var, 1 31 3 output_buf char (512) var, 1 32 3 open_description char (24) var, 1 33 3 carriage_ctl_table (4) char (4) aligned, /* These are used by */ 1 34 3 slew_ctl_table (6) char (4) aligned; /* ibm3780_conv_. */ 1 35 1 36 dcl cib_ptr pointer; 1 37 dcl 1 cib aligned based (cib_ptr), /* Information about the comm switch for each attachment. */ 1 38 2 device_channel char (32), /* Channel name. */ 1 39 2 comm_iocb_ptr pointer, /* ptr to bisync_ IOCB. */ 1 40 2 last_selected_iocb_ptr pointer, /* Via select_device. */ 1 41 2 n_attached fixed bin, /* Count of ibm3780_ switches attached to this one? */ 1 42 2 flags, 1 43 3 attached_sw bit (1) unaligned, 1 44 3 opened_sw bit (1) unaligned, 1 45 3 in_quit_state_sw bit (1) unaligned, 1 46 3 pad_flags bit (33) unaligned, 1 47 2 chain, /* Thread pointers. */ 1 48 3 next_cib_ptr pointer, 1 49 3 prev_cib_ptr pointer; 1 50 1 51 1 52 dcl ASCII fixed bin int static init (1) options (constant); 1 53 dcl EBCDIC fixed bin int static init (2) options (constant); 1 54 1 55 /* There are three supported device types. There names: */ 1 56 dcl (PUNCH init ("punch"), 1 57 PRINTER init ("printer"), 1 58 TELEPRINTER init ("teleprinter")) char (32) internal static options (constant); 1 59 1 60 1 61 dcl HT char (1) int static options (constant) init (" "); 1 62 dcl ENQ char (1) int static options (constant) init (""); 1 63 dcl ESC char (1) int static options (constant) init (""); 1 64 1 65 /* END INCLUDE FILE ... ibm3780_data.incl.pl1 */ 1463 1464 /* BEGIN... remote_ttt_info.incl.pl1 ... 5/78 */ 2 2 2 3 dcl rttp ptr; /* ptr to data structure */ 2 4 2 5 2 6 dcl 1 remote_ttt_info based (rttp) aligned, /* data */ 2 7 2 ttt_bits, /* control bits */ 2 8 (3 escape_output bit (1), /* if on enables output escape processing */ 2 9 3 translate_output bit (1), /* if on enables output translation */ 2 10 3 translate_input bit (1), /* if on enables input translation */ 2 11 3 escape_input bit (1), /* if on enables input escape processing */ 2 12 3 erase_input bit (1), /* if on enables input erase processing */ 2 13 3 canonicalize_input bit (1), /* if on enables input canonicalization */ 2 14 3 edited bit (1)) unal, /* if on enables edited escape processing */ 2 15 2 terminal_type char (32), /* terminal type in TTT */ 2 16 2 kill_char char (1), /* specified kil character */ 2 17 2 erase_char char (1), /* and erase character */ 2 18 2 ttt_ptrs, /* ptr to various ttt tables */ 2 19 3 input_mvtp ptr, /* input translation table */ 2 20 3 output_mvtp ptr, /* output translation table */ 2 21 3 input_tctp ptr, /* input escape table */ 2 22 3 output_tctp ptr, /* output escape table */ 2 23 3 specp ptr; /* special table */ 2 24 2 25 /* END remote_ttt_info.incl.pl1 */ 1464 1465 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 3 2 /* Modified 11/29/82 by S. Krupp to add new entries and to change 3 3* version number to IOX2. */ 3 4 /* format: style2 */ 3 5 3 6 dcl 1 iocb aligned based, /* I/O control block. */ 3 7 2 version character (4) aligned, /* IOX2 */ 3 8 2 name char (32), /* I/O name of this block. */ 3 9 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 3 10 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 3 11 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 3 12 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 3 13 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 3 14 2 reserved bit (72), /* Reserved for future use. */ 3 15 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 3 16 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 3 17 /* open(p,mode,not_used,s) */ 3 18 2 close entry (ptr, fixed (35)),/* close(p,s) */ 3 19 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 20 /* get_line(p,bufptr,buflen,actlen,s) */ 3 21 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 22 /* get_chars(p,bufptr,buflen,actlen,s) */ 3 23 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 3 24 /* put_chars(p,bufptr,buflen,s) */ 3 25 2 modes entry (ptr, char (*), char (*), fixed (35)), 3 26 /* modes(p,newmode,oldmode,s) */ 3 27 2 position entry (ptr, fixed, fixed (21), fixed (35)), 3 28 /* position(p,u1,u2,s) */ 3 29 2 control entry (ptr, char (*), ptr, fixed (35)), 3 30 /* control(p,order,infptr,s) */ 3 31 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 32 /* read_record(p,bufptr,buflen,actlen,s) */ 3 33 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 3 34 /* write_record(p,bufptr,buflen,s) */ 3 35 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 3 36 /* rewrite_record(p,bufptr,buflen,s) */ 3 37 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 3 38 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 3 39 /* seek_key(p,key,len,s) */ 3 40 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 3 41 /* read_key(p,key,len,s) */ 3 42 2 read_length entry (ptr, fixed (21), fixed (35)), 3 43 /* read_length(p,len,s) */ 3 44 2 open_file entry (ptr, fixed bin, char (*), bit (1) aligned, fixed bin (35)), 3 45 /* open_file(p,mode,desc,not_used,s) */ 3 46 2 close_file entry (ptr, char (*), fixed bin (35)), 3 47 /* close_file(p,desc,s) */ 3 48 2 detach entry (ptr, char (*), fixed bin (35)); 3 49 /* detach(p,desc,s) */ 3 50 3 51 declare iox_$iocb_version_sentinel 3 52 character (4) aligned external static; 3 53 3 54 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 1465 1466 /* --------------- BEGIN include file iox_dcls.incl.pl1 --------------- */ 4 2 4 3 /* Written 05/04/78 by C. D. Tavares */ 4 4 /* Fixed declaration of iox_$find_iocb_n 05/07/80 by R. Holmstedt */ 4 5 /* Modified 5/83 by S. Krupp to add declarations for: iox_$open_file, 4 6* iox_$close_file, iox_$detach and iox_$attach_loud entries. */ 4 7 4 8 dcl iox_$attach_name entry (char (*), pointer, char (*), pointer, fixed bin (35)), 4 9 iox_$attach_ptr entry (pointer, char (*), pointer, fixed bin (35)), 4 10 iox_$close entry (pointer, fixed bin (35)), 4 11 iox_$control entry (pointer, char (*), pointer, fixed bin (35)), 4 12 iox_$delete_record entry (pointer, fixed bin (35)), 4 13 iox_$destroy_iocb entry (pointer, fixed bin (35)), 4 14 iox_$detach_iocb entry (pointer, fixed bin (35)), 4 15 iox_$err_not_attached entry options (variable), 4 16 iox_$err_not_closed entry options (variable), 4 17 iox_$err_no_operation entry options (variable), 4 18 iox_$err_not_open entry options (variable), 4 19 iox_$find_iocb entry (char (*), pointer, fixed bin (35)), 4 20 iox_$find_iocb_n entry (fixed bin, ptr, fixed bin(35)), 4 21 iox_$get_chars entry (pointer, pointer, fixed bin (21), fixed bin (21), fixed bin (35)), 4 22 iox_$get_line entry (pointer, pointer, fixed bin (21), fixed bin (21), fixed bin (35)), 4 23 iox_$look_iocb entry (char (*), pointer, fixed bin (35)), 4 24 iox_$modes entry (pointer, char (*), char (*), fixed bin (35)), 4 25 iox_$move_attach entry (pointer, pointer, fixed bin (35)), 4 26 iox_$open entry (pointer, fixed bin, bit (1) aligned, fixed bin (35)), 4 27 iox_$position entry (pointer, fixed bin, fixed bin (21), fixed bin (35)), 4 28 iox_$propagate entry (pointer), 4 29 iox_$put_chars entry (pointer, pointer, fixed bin (21), fixed bin (35)), 4 30 iox_$read_key entry (pointer, char (256) varying, fixed bin (21), fixed bin (35)), 4 31 iox_$read_length entry (pointer, fixed bin (21), fixed bin (35)), 4 32 iox_$read_record entry (pointer, pointer, fixed bin (21), fixed bin (21), fixed bin (35)), 4 33 iox_$rewrite_record entry (pointer, pointer, fixed bin (21), fixed bin (35)), 4 34 iox_$seek_key entry (pointer, char (256) varying, fixed bin (21), fixed bin (35)), 4 35 iox_$write_record entry (pointer, pointer, fixed bin (21), fixed bin (35)), 4 36 iox_$open_file entry(ptr, fixed bin, char(*), bit(1) aligned, fixed bin(35)), 4 37 iox_$close_file entry(ptr, char(*), fixed bin(35)), 4 38 iox_$detach entry(ptr, char(*), fixed bin(35)), 4 39 iox_$attach_loud entry(ptr, char(*), ptr, fixed bin(35)); 4 40 4 41 dcl (iox_$user_output, 4 42 iox_$user_input, 4 43 iox_$user_io, 4 44 iox_$error_output) external static pointer; 4 45 4 46 /* ---------------- END include file iox_dcls.incl.pl1 ---------------- */ 1466 1467 /* Begin include file ..... iox_modes.incl.pl1 */ 5 2 5 3 /* Written by C. D. Tavares, 03/17/75 */ 5 4 /* Updated 10/31/77 by CDT to include short iox mode strings */ 5 5 5 6 dcl iox_modes (13) char (24) int static options (constant) aligned initial 5 7 ("stream_input", "stream_output", "stream_input_output", 5 8 "sequential_input", "sequential_output", "sequential_input_output", "sequential_update", 5 9 "keyed_sequential_input", "keyed_sequential_output", "keyed_sequential_update", 5 10 "direct_input", "direct_output", "direct_update"); 5 11 5 12 dcl short_iox_modes (13) char (4) int static options (constant) aligned initial 5 13 ("si", "so", "sio", "sqi", "sqo", "sqio", "squ", "ksqi", "ksqo", "ksqu", "di", "do", "du"); 5 14 5 15 dcl (Stream_input initial (1), 5 16 Stream_output initial (2), 5 17 Stream_input_output initial (3), 5 18 Sequential_input initial (4), 5 19 Sequential_output initial (5), 5 20 Sequential_input_output initial (6), 5 21 Sequential_update initial (7), 5 22 Keyed_sequential_input initial (8), 5 23 Keyed_sequential_output initial (9), 5 24 Keyed_sequential_update initial (10), 5 25 Direct_input initial (11), 5 26 Direct_output initial (12), 5 27 Direct_update initial (13)) fixed bin int static options (constant); 5 28 5 29 /* End include file ..... iox_modes.incl.pl1 */ 1467 1468 1469 end ibm3780_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 08/08/90 1037.8 ibm3780_.pl1 >spec>install>1023>ibm3780_.pl1 1463 1 04/02/85 1619.9 ibm3780_data.incl.pl1 >ldd>include>ibm3780_data.incl.pl1 1464 2 08/03/78 2121.0 remote_ttt_info.incl.pl1 >ldd>include>remote_ttt_info.incl.pl1 1465 3 05/20/83 1946.4 iocb.incl.pl1 >ldd>include>iocb.incl.pl1 1466 4 05/23/83 1016.6 iox_entries.incl.pl1 >ldd>include>iox_dcls.incl.pl1 1467 5 02/02/78 1329.7 iox_modes.incl.pl1 >ldd>include>iox_modes.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-52 ref 240 521 1095 BASE_VALUE constant fixed bin(17,0) initial dcl 117 ref 727 DEFAULT_CARRIAGE_CTL_TABLE 000154 constant char(4) initial array dcl 132 set ref 218 1060 DEFAULT_PRINTER_SELECT constant char(1) initial packed unaligned dcl 126 ref 1056 DEFAULT_PUNCH_SELECT constant char(1) initial packed unaligned dcl 127 ref 1057 DEFAULT_SLEW_CTL_TABLE 000146 constant char(4) initial array dcl 133 set ref 219 1061 EBCDIC constant fixed bin(17,0) initial dcl 1-53 ref 519 973 1058 1094 ENQ 010576 constant char(1) initial packed unaligned dcl 1-62 ref 889 ESC constant char(1) initial packed unaligned dcl 1-63 ref 909 HT constant char(1) initial packed unaligned dcl 1-61 ref 909 913 IBM3780_BIGGEST_BUFFER_SIZE constant fixed bin(17,0) initial dcl 118 ref 248 1320 IGS constant char(1) initial packed unaligned dcl 122 ref 725 730 803 810 IRS 010601 constant char(1) initial packed unaligned dcl 121 ref 718 721 722 831 LOWERCASE 000167 constant char(26) initial packed unaligned dcl 130 ref 1108 ME 000177 constant char(32) initial packed unaligned dcl 123 set ref 200* 228 1034* 1315 1317 NL 010600 constant char(1) initial packed unaligned dcl 124 ref 916 PRINTER 000126 constant char(32) initial packed unaligned dcl 1-56 ref 243 490 492 883 893 904 PROTOCOL_OVERHEAD constant fixed bin(17,0) initial dcl 119 ref 1320 PUNCH 000136 constant char(32) initial packed unaligned dcl 1-56 ref 492 794 885 895 P_arg_idx parameter fixed bin(17,0) dcl 1146 ref 1143 1149 1150 P_attach_options parameter varying char array dcl 54 set ref 189 211 1084 1084 1149* 1150 1171 1199 P_cib_ptr parameter pointer dcl 1358 set ref 1355 1360* 1361 1362 1363 1364 1365 1368 1370 1373 1379 1383 1383 1385 1386 1387 1390 1390 1394 1394 1397 1397 1401 1401 1404 1405* P_code parameter fixed bin(35,0) dcl 962 in procedure "configure_comm" set ref 959 975* 976 981* P_code parameter fixed bin(35,0) dcl 874 in procedure "select_device" set ref 871 879* 933* 935 939* 940 P_code parameter fixed bin(35,0) dcl 1339 in procedure "open_comm_module" set ref 1336 1341* 1342* 1346 P_code parameter fixed bin(35,0) dcl 53 in procedure "ibm3780_" set ref 189 195* 199* 200* 301 305* 309* 314* 346 350* 353* 361* 372* 373 407 411* 414* 469 475* 482* 495* 572* 591 596* 611 615* 620* 626 626 638* 650* 656 660* 667* 679* 1039* 1041* P_desc parameter char packed unaligned dcl 1166 in procedure "fetch_arg" set ref 1163 1171* 1178* P_desc parameter char packed unaligned dcl 1192 in procedure "fetch_numarg" set ref 1189 1199* 1208* P_ignore_sw parameter bit(1) packed unaligned dcl 57 ref 346 P_inbuf_count parameter fixed bin(21,0) dcl 60 set ref 626 626 644* 652* P_inbuf_len parameter fixed bin(21,0) dcl 59 ref 626 626 645 P_inbuf_ptr parameter pointer dcl 58 ref 626 626 646 P_info_ptr parameter pointer dcl 66 ref 469 474 P_io_module_name parameter char(32) packed unaligned dcl 1298 set ref 1281 1320* P_iocb_ptr parameter pointer dcl 1301 in procedure "attach_comm_module" set ref 1281 1329* P_iocb_ptr parameter pointer dcl 52 in procedure "ibm3780_" ref 189 193 301 304 346 349 407 410 469 472 591 594 611 614 626 626 637 656 659 P_loud_sw parameter bit(1) packed unaligned dcl 55 ref 189 194 P_new_modes parameter char packed unaligned dcl 67 ref 591 598 602 604 P_old_modes parameter char packed unaligned dcl 68 set ref 591 595* P_open_mode parameter fixed bin(17,0) dcl 56 ref 346 357 P_order parameter char packed unaligned dcl 65 ref 469 473 P_other_args parameter varying char(256) dcl 1300 set ref 1281 1320* P_outbuf_len parameter fixed bin(21,0) dcl 62 ref 656 666 666 671 P_outbuf_ptr parameter pointer dcl 61 ref 656 672 P_pos_type parameter fixed bin(17,0) dcl 63 set ref 611 620* P_pos_value parameter fixed bin(21,0) dcl 64 set ref 611 620* P_position parameter fixed bin(21,0) dcl 1440 in procedure "substraddr_nonvarying" ref 1436 1444 P_position parameter fixed bin(21,0) dcl 1453 in procedure "substraddr_varying" ref 1449 1459 P_string parameter char packed unaligned dcl 1439 in procedure "substraddr_nonvarying" set ref 1436 1444 P_string parameter varying char dcl 1452 in procedure "substraddr_varying" set ref 1449 1459 P_string parameter varying char(8) dcl 1223 in procedure "set_carriage_ctl" ref 1220 1236 1237 1245 1251 1252 P_table parameter char(4) array dcl 1224 set ref 1220 1236 1237* 1245 1251 1252* P_tty_channel parameter char(32) packed unaligned dcl 1299 set ref 1281 1320* SPACE 010577 constant char(1) initial packed unaligned dcl 128 ref 1133 1153 SPACE_CHAR 000176 constant char(1) initial array packed unaligned dcl 129 ref 728 Stream_input constant fixed bin(17,0) initial dcl 5-15 ref 360 382 Stream_input_output 000261 constant fixed bin(17,0) initial dcl 5-15 set ref 360 382 387 1342* Stream_output constant fixed bin(17,0) initial dcl 5-15 ref 360 387 TELEPRINTER 000116 constant char(32) initial packed unaligned dcl 1-56 ref 490 UPPERCASE 000160 constant char(26) initial packed unaligned dcl 130 ref 1108 abort_msg 000102 automatic char(256) packed unaligned dcl 1028 set ref 1033* 1034* actual_iocb_ptr 12 based pointer level 2 dcl 3-6 ref 349 410 472 594 614 637 659 ad based structure level 1 dcl 1-7 set ref 1052 1053* 1274 ad_initialized_sw 000100 automatic bit(1) packed unaligned dcl 72 set ref 205* 226* 1268 addr builtin function dcl 183 ref 218 219 282 397 734 734 796 796 805 805 812 812 933 933 939 939 966 967 975 975 981 981 1109 1109 1444 1444 1459 1459 adp 000472 automatic pointer dcl 1-5 set ref 204* 228 240 240 243 243 243 245 248 248 248 250 250 265 282 283 320* 321 365* 366 368 397 418* 419 477* 478 490 492 499 499 510 510 518 519 521 530 538 545 552 557 558* 568 600* 602 604 617* 618 640* 641 662* 663 694 697 698 701 703 705 705 705 707 710 711 718 721 722 722 728 734 734 759 760 763 763 763 770 770 790 794 795 796 796 797 805 805 812 812 817 818 821 826 826 829 831 831 846 846 846 846 882 883 883 883 885 885 885 893 893 895 895 904 904 912 932 933 933 934 966 967 968 972 973 980 1003 1004 1005 1007 1008 1009 1012 1013 1052* 1053 1054 1055 1056 1057 1058 1059 1060 1061 1063 1064 1065 1066 1067 1092 1093 1094 1095 1096 1097 1098 1100 1102 1104 1107 1108 1108 1109 1109 1116 1120 1123 1153 1153 1266 1269 1269 1274 1275* after builtin function dcl 183 ref 722 any_other 000456 stack reference condition dcl 181 ref 278 296 330 342 379 403 430 448 arg based char packed unaligned dcl 1081 set ref 1090 1090* 1092 1093 1094 1095 1096 1096 1097 1098 1100 1102 1104 1104 1106 1106 1110* 1114 1118 1122 1129 1130 1134 1153 1169 1178 1181 1197 1206* 1208* arg_idx 001342 automatic fixed bin(17,0) dcl 1078 set ref 1084* 1087* 1171 1174* 1174 1176* 1199 1202* 1202 1204* arg_len 001343 automatic fixed bin(21,0) dcl 1079 set ref 1090 1090 1090 1092 1093 1094 1095 1096 1096 1097 1098 1100 1102 1104 1104 1106 1106 1110 1110 1114 1118 1122 1129 1130 1134 1150* 1153 1169 1178 1181 1197 1206 1206 1208 1208 arg_ptr 001344 automatic pointer dcl 1080 set ref 1090 1090 1092 1093 1094 1095 1096 1096 1097 1098 1100 1102 1104 1104 1106 1106 1110 1114 1118 1122 1129 1130 1134 1149* 1153 1169 1178 1181 1197 1206 1208 attach_code 000210 automatic fixed bin(35,0) dcl 1305 set ref 1329* 1330 1330* attach_data_ptr 16 based pointer level 2 dcl 3-6 set ref 283* 320 334* 365 418 477 600 617 640 662 attach_desc 000110 automatic char(256) packed unaligned dcl 1304 in procedure "attach_comm_module" set ref 1320* 1329* 1330* attach_desc 70 based varying char(256) level 3 in structure "ad" dcl 1-7 in procedure "ibm3780_" set ref 228* 282 1153* 1153 attach_descrip_ptr 14 based pointer level 2 dcl 3-6 set ref 198 282* 308 333* attached_sw 15 based bit(1) level 3 packed packed unaligned dcl 1-37 set ref 269 273* 1383 1387* before builtin function dcl 183 ref 721 bits 33 based structure level 2 dcl 1-7 card_image 000514 automatic varying char(80) dcl 690 set ref 703* 710* 721* 725 727 728* 728 728 730 734* 741 carriage_ctl_table 602 based char(4) array level 3 dcl 1-7 set ref 966 1060* 1116* chain 16 based structure level 2 dcl 1-37 char builtin function dcl 183 ref 1317 char_mode 27 based fixed bin(17,0) level 3 dcl 1-7 set ref 240 519* 521* 728 973 1058* 1094* 1095* char_string based char(80) packed unaligned dcl 95 set ref 738* 740* 791 835* char_string_ptr 000102 automatic pointer dcl 73 set ref 646* 672* 738 740* 740 791 835* 835 characters 1 based char(1) array level 2 packed packed unaligned dcl 1455 set ref 1459 chars 44 based structure level 2 dcl 1-7 set ref 1055* cib based structure level 1 dcl 1-37 set ref 1360 1361* 1404 cib_ptr 42 based pointer level 3 in structure "ad" dcl 1-7 in procedure "ibm3780_" set ref 265* 321 366 419 478 618 641 663 1269 1269* cib_ptr 000474 automatic pointer dcl 1-36 in procedure "ibm3780_" set ref 206* 256* 256* 257* 259 262* 263 265 269 272 273 288 288 321* 324 324 366* 371 374 419* 422 422 424 425 478* 481 499 509 563 618* 620 641* 663* 763 845 846 855 858 860 939 975 981 1342 cleanup 000464 stack reference condition dcl 181 ref 209 292 854 close 36 based entry variable level 2 dcl 3-6 set ref 393* code 001371 automatic fixed bin(35,0) dcl 1195 in procedure "fetch_numarg" set ref 1206* 1208 code 000104 automatic fixed bin(35,0) dcl 74 in procedure "ibm3780_" set ref 195* 475* 503* 504 505* 506 524* 558* 563* 568 572 583* 642* 650 664* 676 679 734* 735 763* 768 796* 798 805* 806 812* 813 820 828 846* 849 852 1109* 1110 1110* codeptr builtin function dcl 183 ref 1329 1329 com_err_ 000016 constant entry external dcl 143 ref 200 1034 comm_iocb_ptr 10 based pointer level 2 dcl 1-37 set ref 272* 424* 481 563* 620* 763* 846* 939* 975* 981* 1342* 1362* 1385* 1386* continue_to_signal_ 000020 constant entry external dcl 144 ref 1422 control 66 based entry variable level 2 dcl 3-6 set ref 337* 390* 438* control_arg 000100 automatic char(32) packed unaligned dcl 1167 in procedure "fetch_arg" set ref 1169* 1171* 1178* control_arg 001360 automatic char(32) packed unaligned dcl 1193 in procedure "fetch_numarg" set ref 1197* 1199* 1208* control_string 001176 automatic varying char(256) dcl 876 set ref 883* 885* 889* 889 893* 895* 907 907* 909* 913* 916* 916 933* 933* 939 939 convert_string_$input 000022 constant entry external dcl 145 ref 734 convert_string_$output 000024 constant entry external dcl 146 ref 796 805 812 933 converted_chars 000247 automatic varying char(512) dcl 85 set ref 734* 738 739 740 792* 796* 808* 808 809* 809 815* 815 818 826 831 copy builtin function dcl 183 ref 728 ctl_string 001346 automatic varying char(8) dcl 1082 set ref 1115* 1116* 1119* 1120* cu_$arg_list_ptr 000026 constant entry external dcl 147 ref 1033 1033 cu_$arg_ptr 000030 constant entry external dcl 148 ref 1030 cv_dec_check_ 000032 constant entry external dcl 149 ref 1206 data_count 000206 automatic fixed bin(21,0) dcl 76 set ref 644* 652 739* 739 detach_iocb 26 based entry variable level 2 dcl 3-6 set ref 285* 335* 394* 436* device_channel based char(32) level 2 dcl 1-37 set ref 257 263* device_type 50 based char(32) level 3 dcl 1-7 set ref 243 490* 492* 499 510 794 883 885 893 895 904 1123* divide builtin function dcl 183 ref 1236 1251 1251 ebcdic_sw 0(01) 000455 automatic bit(1) level 2 in structure "set_bsc_modes_auto" packed packed unaligned dcl 90 in procedure "ibm3780_" set ref 973* ebcdic_sw 0(01) based bit(1) level 2 in structure "info_set_bsc_modes" packed packed unaligned dcl 103 in procedure "ibm3780_" ref 519 edited 0(06) based bit(1) level 4 packed packed unaligned dcl 1-7 set ref 557* 602* 604* erase_char 12 based char(1) level 3 dcl 1-7 set ref 1067* error_table_$action_not_performed 000052 external static fixed bin(35,0) dcl 160 ref 1039 error_table_$bad_arg 000054 external static fixed bin(35,0) dcl 160 ref 667 error_table_$bad_conversion 000056 external static fixed bin(35,0) dcl 160 set ref 1208* error_table_$bad_mode 000060 external static fixed bin(35,0) dcl 160 ref 361 error_table_$badopt 000062 external static fixed bin(35,0) dcl 160 set ref 1090* error_table_$bisync_bid_fail 000064 external static fixed bin(35,0) dcl 160 ref 852 error_table_$inconsistent 000066 external static fixed bin(35,0) dcl 160 set ref 240* error_table_$no_operation 000070 external static fixed bin(35,0) dcl 160 ref 482 495 error_table_$noarg 000072 external static fixed bin(35,0) dcl 160 set ref 236* 237* 1171* 1199* error_table_$not_attached 000074 external static fixed bin(35,0) dcl 160 ref 309 error_table_$not_closed 000076 external static fixed bin(35,0) dcl 160 ref 314 353 error_table_$not_detached 000100 external static fixed bin(35,0) dcl 160 ref 199 error_table_$not_open 000102 external static fixed bin(35,0) dcl 160 ref 414 error_table_$null_info_ptr 000104 external static fixed bin(35,0) dcl 160 ref 583 error_table_$wrong_no_of_args 000106 external static fixed bin(35,0) dcl 160 set ref 211* escape_output based bit(1) level 4 packed packed unaligned dcl 1-7 set ref 795* 797* 932* 934* first_cib_ptr 000012 internal static pointer initial dcl 114 set ref 256 1368 1368* 1390* fixed builtin function dcl 183 in procedure "ibm3780_" ref 727 968 fixed 26 based structure level 2 in structure "ad" dcl 1-7 in procedure "ibm3780_" flags 15 based structure level 2 dcl 1-37 get_chars 46 based entry variable level 2 dcl 3-6 set ref 383* 438* get_line 42 based entry variable level 2 dcl 3-6 set ref 384* 438* get_system_free_area_ 000034 constant entry external dcl 150 ref 207 319 get_ttt_info_ 000036 constant entry external dcl 151 ref 1109 has_tabs 33 based bit(1) level 3 dcl 1-7 set ref 904 1096* hbound builtin function dcl 183 ref 211 1084 1171 1199 1236 1251 hcs_$reset_ips_mask 000040 constant entry external dcl 152 ref 294 340 401 446 1419 hcs_$set_ips_mask 000042 constant entry external dcl 153 ref 280 331 380 431 ibm3780_conv_$carriage_ctl_table_ptr 000114 external static pointer dcl 177 set ref 218* 966* ibm3780_conv_$slew_ctl_table_ptr 000112 external static pointer dcl 176 set ref 219* 967* ibm3780_conv_$transparent 000110 external static fixed bin(17,0) dcl 175 set ref 220* 968* ibm3780_io_call_control_ 000044 constant entry external dcl 154 ref 558 idx 001400 automatic fixed bin(17,0) dcl 1225 set ref 1236* 1237 1237* 1251* 1252 1252* igs_found_pos 000765 automatic fixed bin(17,0) dcl 787 set ref 799* 801* 803 805 805 807* 807 809 810 812 812 igs_pos 000541 automatic fixed bin(21,0) dcl 691 in procedure "get_string" set ref 725* 726 727 728 728 730* igs_pos 000764 automatic fixed bin(17,0) dcl 787 in procedure "put_string" set ref 803* 804 805 805 807 810* in_quit_state_sw 15(02) based bit(1) level 3 packed packed unaligned dcl 1-37 set ref 845 855* 858* 860* info_ptr 000230 automatic pointer dcl 79 set ref 474* 490 492 492 492 518 519 558* 563* 568 568 581 info_read_status based structure level 1 dcl 99 info_set_bsc_modes based structure level 1 dcl 103 info_string based char(32) packed unaligned dcl 94 ref 490 492 492 492 input 000562 automatic varying char(512) dcl 785 set ref 791* 796 796 803 805 805 809 810 812 812 input_buf 171 based varying char(512) level 3 dcl 1-7 set ref 552* 568 694 701 703 705 705* 705 707* 710 711* 718 721 722* 722 759 763* 763* 770* 770 input_count 000763 automatic fixed bin(17,0) dcl 786 set ref 790* 791 834 835 input_pending 2 based bit(1) level 2 dcl 99 set ref 568* 568 ioa_$general_rs 000050 constant entry external dcl 156 ref 1033 ioa_$rsnnl 000046 constant entry external dcl 155 ref 1320 iocb based structure level 1 dcl 3-6 iocb_ptr 000232 automatic pointer dcl 80 set ref 193* 198 200 282 283 284 285 290* 304* 308 313 320 333 334 335 336 337 339* 349* 352 365 383 384 387 390 391 392 393 394 397 399* 410* 413 418 433 435 436 438 438 438 438 438 438 445* 472* 477 499 509 558* 594* 600 614* 617 637* 640 659* 662 1034 iox_$attach_name 000120 constant entry external dcl 4-8 ref 1329 iox_$close 000122 constant entry external dcl 4-8 ref 424 1385 iox_$control 000124 constant entry external dcl 4-8 ref 563 939 975 981 iox_$detach_iocb 000126 constant entry external dcl 4-8 ref 1386 iox_$err_no_operation 000132 constant entry external dcl 4-8 ref 438 iox_$err_not_attached 000130 constant entry external dcl 4-8 ref 335 336 337 iox_$get_chars 000134 constant entry external dcl 4-8 ref 763 iox_$open 000136 constant entry external dcl 4-8 ref 1342 iox_$position 000140 constant entry external dcl 4-8 ref 620 iox_$propagate 000142 constant entry external dcl 4-8 ref 290 339 399 445 iox_$put_chars 000144 constant entry external dcl 4-8 ref 846 iox_modes 000000 constant char(24) initial array dcl 5-6 ref 368 ips_mask 000235 automatic bit(36) dcl 82 set ref 277* 280* 294* 294* 328* 331* 340* 340* 377* 380* 401* 401* 428* 431* 446* 446* 1419 1419* 1419* 1420* kill_char 11 based char(1) level 3 dcl 1-7 set ref 1066* last_cib_ptr 000014 internal static pointer initial dcl 115 set ref 1365 1370 1373* 1397* last_selected_device 60 based char(32) level 3 dcl 1-7 set ref 499 510* last_selected_iocb_ptr 12 based pointer level 2 dcl 1-37 set ref 499 509* 1363* lbound builtin function dcl 183 ref 1084 length builtin function dcl 183 ref 568 694 701 705 739 740 741 759 826 826 846 846 1150 1236 1251 loud_sw 000234 automatic bit(1) packed unaligned dcl 81 set ref 194* 200 1032 ltrim builtin function dcl 183 ref 1317 maxlength builtin function dcl 183 ref 907 min builtin function dcl 183 ref 790 1236 1251 modes 56 based entry variable level 2 dcl 3-6 set ref 392* 438* multi_record 34 based bit(1) level 3 dcl 1-7 set ref 248 530* 698 1004* 1007 1008* 1012* 1097* multi_record_count 001314 automatic fixed bin(35,0) dcl 963 in procedure "configure_comm" set ref 980* 981 981 multi_record_count 32 based fixed bin(17,0) level 3 in structure "ad" dcl 1-7 in procedure "ibm3780_" set ref 980 1005* 1009* 1013* n_attached 14 based fixed bin(17,0) level 2 dcl 1-37 set ref 288* 288 324* 324 422 1383 n_not_processed 000553 automatic fixed bin(21,0) dcl 757 set ref 759* 760 763 763 763 770 n_read 000552 automatic fixed bin(21,0) dcl 756 set ref 763* 770 name 1 based char(32) level 2 dcl 3-6 set ref 200* 1034* next_cib_ptr 16 based pointer level 3 dcl 1-37 set ref 259 1364* 1370* 1390 1394* 1394 1397 1401 null builtin function dcl 183 ref 198 204 206 256 308 313 333 334 352 413 433 481 581 1054 1063 1266 1269 1275 1362 1363 1364 1368 1390 1397 1405 numarg 001370 automatic fixed bin(35,0) dcl 1194 set ref 1206* 1212 open 32 based entry variable level 2 dcl 3-6 set ref 284* 336* 435* open_descrip_ptr 20 based pointer level 2 dcl 3-6 set ref 313 352 397* 413 433* open_description 573 based varying char(24) level 3 dcl 1-7 set ref 368* 397 open_mode 000236 automatic fixed bin(17,0) dcl 83 set ref 357* 360 360 360 368 382 382 387 387 opened_sw 15(01) based bit(1) level 3 packed packed unaligned dcl 1-37 set ref 371 374* 422 425* option_comm 000207 automatic char(32) packed unaligned dcl 77 set ref 230* 236 272* 1129* option_tty 000217 automatic char(32) packed unaligned dcl 78 set ref 230* 237 257 263 272* 1130* order 000237 automatic char(32) packed unaligned dcl 84 set ref 473* 486 514 528 535 535 543 550 557 558 563* 568 output_buf 372 based varying char(512) level 3 dcl 1-7 set ref 538* 545* 818* 821* 826 829* 831* 831 846* 846* 846 846 phys_line_length 26 based fixed bin(17,0) level 3 dcl 1-7 set ref 243 243* 245* 250 912 1104* position 62 based entry variable level 2 dcl 3-6 set ref 391* 438* prev_cib_ptr 20 based pointer level 3 dcl 1-37 set ref 1365* 1390 1394 1397 1401* 1401 printer_select 44 based char(1) level 3 dcl 1-7 set ref 883 893 1056* 1100* ptrs 40 based structure level 2 dcl 1-7 set ref 1054* punch_select 45 based char(1) level 3 dcl 1-7 set ref 885 895 1057* 1102* put_chars 52 based entry variable level 2 dcl 3-6 set ref 387* 438* quit 000000 stack reference condition dcl 181 ref 859 record_len 30 based fixed bin(17,0) level 3 dcl 1-7 set ref 248* 250* 760 763 790 826 1059* remaining_count 000450 automatic fixed bin(21,0) dcl 86 set ref 645* 671* 674 741* 741 790 834* 834 remote_ttt_info based structure level 1 dcl 2-6 rtrim builtin function dcl 183 ref 228 368 1315 1317 search builtin function dcl 183 ref 718 725 730 803 810 set_bsc_modes_auto 000455 automatic structure level 1 dcl 90 set ref 971* 975 975 slew_ctl_table 606 based char(4) array level 3 dcl 1-7 set ref 967 1061* 1120* space_cnt 000542 automatic fixed bin(17,0) dcl 692 set ref 727* 728 static_attach_count 000010 internal static fixed bin(17,0) initial dcl 111 set ref 1311* 1311 1313 1314 1317 static_conv_proc_initialized_sw 000011 internal static bit(1) initial packed unaligned dcl 112 set ref 217 221* string_overlay based char(1) array packed unaligned dcl 1442 in procedure "substraddr_nonvarying" set ref 1444 string_overlay based structure level 1 dcl 1455 in procedure "substraddr_varying" substr builtin function dcl 183 set ref 703 705 727 728 728 770 791 796 796 803 805 805 809 810 812 812 907* 913* 1237 1252 substraddr generic function dcl 1432 ref 740 763 763 835 846 846 1149 substring 000766 automatic varying char(512) dcl 788 set ref 805* 808 812* 815 switch_name 000100 automatic char(32) packed unaligned dcl 1303 set ref 1315* 1317* 1329* sys_info$max_seg_size 000116 external static fixed bin(17,0) dcl 178 ref 666 system_free_area based area(1024) dcl 96 ref 1052 1274 1360 1404 system_free_area_ptr 000452 automatic pointer dcl 87 set ref 207* 319* 1052 1274 1360 1404 tab_pos 001277 automatic fixed bin(17,0) dcl 877 set ref 912* 912* 913* terminal_id 46 based char(5) level 3 dcl 1-7 set ref 882 883 885 1098* terminal_type 1 based char(32) level 3 dcl 1-7 set ref 1065* 1107* 1108* 1108 the_code based fixed bin(35,0) dcl 1025 set ref 1034* 1039 1041 the_code_ptr 000100 automatic pointer dcl 1026 set ref 1030* 1034 1039 1041 translate builtin function dcl 183 ref 1108 transparent 36 based bit(1) level 3 in structure "ad" dcl 1-7 in procedure "ibm3780_" set ref 240 248 518* 697 817 968 972 1003 1092* 1093* transparent 000455 automatic bit(1) level 2 in structure "set_bsc_modes_auto" packed packed unaligned dcl 90 in procedure "ibm3780_" set ref 972* transparent based bit(1) level 2 in structure "info_set_bsc_modes" packed packed unaligned dcl 103 in procedure "ibm3780_" ref 518 ttt_bits based structure level 3 dcl 1-7 set ref 1064* ttt_info based structure level 2 dcl 1-7 set ref 734 734 796 796 805 805 812 812 933 933 1109 1109 ttt_ptrs 14 based structure level 3 dcl 1-7 set ref 1063* two_digits 000454 automatic picture(2) packed unaligned dcl 88 set ref 1314* 1315 unrecognized_attach_options 000105 automatic varying char(256) dcl 75 set ref 229* 272* 1133* 1133 1134* 1134 unspec builtin function dcl 183 set ref 727 971* 1053* 1361* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. Direct_input internal static fixed bin(17,0) initial dcl 5-15 Direct_output internal static fixed bin(17,0) initial dcl 5-15 Direct_update internal static fixed bin(17,0) initial dcl 5-15 Keyed_sequential_input internal static fixed bin(17,0) initial dcl 5-15 Keyed_sequential_output internal static fixed bin(17,0) initial dcl 5-15 Keyed_sequential_update internal static fixed bin(17,0) initial dcl 5-15 Sequential_input internal static fixed bin(17,0) initial dcl 5-15 Sequential_input_output internal static fixed bin(17,0) initial dcl 5-15 Sequential_output internal static fixed bin(17,0) initial dcl 5-15 Sequential_update internal static fixed bin(17,0) initial dcl 5-15 iox_$attach_loud 000000 constant entry external dcl 4-8 iox_$attach_ptr 000000 constant entry external dcl 4-8 iox_$close_file 000000 constant entry external dcl 4-8 iox_$delete_record 000000 constant entry external dcl 4-8 iox_$destroy_iocb 000000 constant entry external dcl 4-8 iox_$detach 000000 constant entry external dcl 4-8 iox_$err_not_closed 000000 constant entry external dcl 4-8 iox_$err_not_open 000000 constant entry external dcl 4-8 iox_$error_output external static pointer dcl 4-41 iox_$find_iocb 000000 constant entry external dcl 4-8 iox_$find_iocb_n 000000 constant entry external dcl 4-8 iox_$get_line 000000 constant entry external dcl 4-8 iox_$iocb_version_sentinel external static char(4) dcl 3-51 iox_$look_iocb 000000 constant entry external dcl 4-8 iox_$modes 000000 constant entry external dcl 4-8 iox_$move_attach 000000 constant entry external dcl 4-8 iox_$open_file 000000 constant entry external dcl 4-8 iox_$read_key 000000 constant entry external dcl 4-8 iox_$read_length 000000 constant entry external dcl 4-8 iox_$read_record 000000 constant entry external dcl 4-8 iox_$rewrite_record 000000 constant entry external dcl 4-8 iox_$seek_key 000000 constant entry external dcl 4-8 iox_$user_input external static pointer dcl 4-41 iox_$user_io external static pointer dcl 4-41 iox_$user_output external static pointer dcl 4-41 iox_$write_record 000000 constant entry external dcl 4-8 rttp automatic pointer dcl 2-3 short_iox_modes internal static char(4) initial array dcl 5-12 NAMES DECLARED BY EXPLICIT CONTEXT. ATTACH_RETURN 001422 constant label dcl 298 ref 1043 CHANNEL_HAS_CIB 001300 constant label dcl 265 ref 257 CONTROL_RETURN 002607 constant label dcl 572 ref 504 506 584 GET_CHARS_RETURN 003023 constant label dcl 650 ref 768 PASS_CONTROL_ORDER 002547 constant label dcl 563 ref 531 539 546 553 PUT_CHARS_RETURN 003110 constant label dcl 679 ref 676 WRITE_BUFFER_RETRY 004223 constant label dcl 846 ref 861 WRITE_NONTRANSPARENT_ERROR 004506 constant label dcl 921 ref 935 940 abort_attach 004765 constant entry internal dcl 1021 ref 211 236 237 240 1090 1110 1171 1178 1199 1208 1330 access_option 006302 constant entry internal dcl 1143 ref 1087 1176 1204 allocate_attach_data 005153 constant entry internal dcl 1049 ref 225 any_other_handler 007640 constant entry internal dcl 1415 ref 278 330 379 430 attach_cleaner 007075 constant entry internal dcl 1262 ref 209 326 1037 attach_comm_module 007135 constant entry internal dcl 1281 ref 272 cib_create 007454 constant entry internal dcl 1355 ref 262 cib_janitor 007527 constant entry internal dcl 1379 ref 1269 configure_comm 004607 constant entry internal dcl 959 ref 505 524 1346 fetch_arg 006432 constant entry internal dcl 1163 ref 1098 1100 1102 1107 1115 1119 1123 1129 1130 fetch_numarg 006576 constant entry internal dcl 1189 ref 1104 get_string 003125 constant entry internal dcl 687 ref 648 ibm3780_ 000667 constant entry external dcl 46 ref 1329 1329 ibm3780_attach 000702 constant entry external dcl 189 ibm3780_close 002060 constant entry external dcl 407 ref 393 ibm3780_control 002266 constant entry external dcl 469 ref 390 ibm3780_detach 001427 constant entry external dcl 301 ref 285 394 436 ibm3780_get_chars 002755 constant entry external dcl 626 ref 383 ibm3780_get_line 002770 constant entry external dcl 626 ref 384 ibm3780_modes 002617 constant entry external dcl 591 ref 392 ibm3780_open 001606 constant entry external dcl 346 ref 284 435 ibm3780_position 002710 constant entry external dcl 611 ref 391 ibm3780_put_chars 003036 constant entry external dcl 656 ref 387 open_comm_module 007420 constant entry internal dcl 1336 ref 372 process_attach_options 005321 constant entry internal dcl 1075 ref 233 put_string 003556 constant entry internal dcl 782 ref 675 read_buffer 003467 constant entry internal dcl 753 ref 694 701 718 reject_null_info 003113 constant entry internal dcl 578 ref 488 516 select_device 004337 constant entry internal dcl 871 ref 503 set_ad_multirecord_info 004740 constant entry internal dcl 987 ref 253 978 set_carriage_ctl 006754 constant entry internal dcl 1220 ref 1116 set_slew_ctl 007023 constant entry internal dcl 1245 ref 1120 substraddr_nonvarying 007672 constant entry internal dcl 1436 ref 740 835 substraddr_varying 007714 constant entry internal dcl 1449 ref 763 763 846 846 1149 write_buffer 004211 constant entry internal dcl 842 ref 537 819 827 write_nontransparent 004507 constant entry internal dcl 929 ref 901 917 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 11602 11750 10602 11612 Length 12410 10602 146 424 1000 6 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ibm3780_ 1083 external procedure is an external procedure. on unit on line 209 64 on unit on unit on line 278 64 on unit on unit on line 330 64 on unit on unit on line 379 64 on unit on unit on line 430 64 on unit reject_null_info internal procedure shares stack frame of external procedure ibm3780_. get_string internal procedure shares stack frame of external procedure ibm3780_. read_buffer internal procedure shares stack frame of external procedure ibm3780_. put_string internal procedure shares stack frame of external procedure ibm3780_. write_buffer 96 internal procedure enables or reverts conditions. on unit on line 854 64 on unit select_device internal procedure shares stack frame of external procedure ibm3780_. write_nontransparent internal procedure shares stack frame of external procedure ibm3780_. configure_comm internal procedure shares stack frame of external procedure ibm3780_. set_ad_multirecord_info internal procedure shares stack frame of external procedure ibm3780_. abort_attach 178 internal procedure is declared options(non_quick), and is declared options(variable). allocate_attach_data internal procedure shares stack frame of external procedure ibm3780_. process_attach_options internal procedure shares stack frame of external procedure ibm3780_. access_option 84 internal procedure is called by several nonquick procedures. fetch_arg 120 internal procedure uses returns(char(*)) or returns(bit(*)). fetch_numarg internal procedure shares stack frame of external procedure ibm3780_. set_carriage_ctl internal procedure shares stack frame of external procedure ibm3780_. attach_cleaner 70 internal procedure is called by several nonquick procedures. attach_comm_module 198 internal procedure is declared options(non_quick). open_comm_module internal procedure shares stack frame of external procedure ibm3780_. cib_create 72 internal procedure is called by several nonquick procedures. any_other_handler 71 internal procedure is called by several nonquick procedures. substraddr_nonvarying internal procedure shares stack frame of external procedure ibm3780_. substraddr_varying 65 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 static_attach_count ibm3780_ 000011 static_conv_proc_initialized_sw ibm3780_ 000012 first_cib_ptr ibm3780_ 000014 last_cib_ptr ibm3780_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME abort_attach 000100 the_code_ptr abort_attach 000102 abort_msg abort_attach attach_comm_module 000100 switch_name attach_comm_module 000110 attach_desc attach_comm_module 000210 attach_code attach_comm_module fetch_arg 000100 control_arg fetch_arg ibm3780_ 000100 ad_initialized_sw ibm3780_ 000102 char_string_ptr ibm3780_ 000104 code ibm3780_ 000105 unrecognized_attach_options ibm3780_ 000206 data_count ibm3780_ 000207 option_comm ibm3780_ 000217 option_tty ibm3780_ 000230 info_ptr ibm3780_ 000232 iocb_ptr ibm3780_ 000234 loud_sw ibm3780_ 000235 ips_mask ibm3780_ 000236 open_mode ibm3780_ 000237 order ibm3780_ 000247 converted_chars ibm3780_ 000450 remaining_count ibm3780_ 000452 system_free_area_ptr ibm3780_ 000454 two_digits ibm3780_ 000455 set_bsc_modes_auto ibm3780_ 000472 adp ibm3780_ 000474 cib_ptr ibm3780_ 000514 card_image get_string 000541 igs_pos get_string 000542 space_cnt get_string 000552 n_read read_buffer 000553 n_not_processed read_buffer 000562 input put_string 000763 input_count put_string 000764 igs_pos put_string 000765 igs_found_pos put_string 000766 substring put_string 001176 control_string select_device 001277 tab_pos select_device 001314 multi_record_count configure_comm 001342 arg_idx process_attach_options 001343 arg_len process_attach_options 001344 arg_ptr process_attach_options 001346 ctl_string process_attach_options 001360 control_arg fetch_numarg 001370 numarg fetch_numarg 001371 code fetch_numarg 001400 idx set_carriage_ctl THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 signal_op enable_op shorten_stack ext_entry ext_entry_desc int_entry int_entry_desc repeat set_chars_eis return_chars_eis op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ continue_to_signal_ convert_string_$input convert_string_$output cu_$arg_list_ptr cu_$arg_ptr cv_dec_check_ get_system_free_area_ get_ttt_info_ hcs_$reset_ips_mask hcs_$set_ips_mask ibm3780_io_call_control_ ioa_$general_rs ioa_$rsnnl iox_$attach_name iox_$close iox_$control iox_$detach_iocb iox_$err_no_operation iox_$err_not_attached iox_$get_chars iox_$open iox_$position iox_$propagate iox_$put_chars THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed error_table_$bad_arg error_table_$bad_conversion error_table_$bad_mode error_table_$badopt error_table_$bisync_bid_fail error_table_$inconsistent error_table_$no_operation error_table_$noarg error_table_$not_attached error_table_$not_closed error_table_$not_detached error_table_$not_open error_table_$null_info_ptr error_table_$wrong_no_of_args ibm3780_conv_$carriage_ctl_table_ptr ibm3780_conv_$slew_ctl_table_ptr ibm3780_conv_$transparent sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 46 000666 48 000674 189 000675 193 000720 194 000724 195 000731 198 000733 199 000737 200 000742 201 000774 204 000775 205 000777 206 001000 207 001001 209 001010 211 001032 217 001057 218 001062 219 001064 220 001066 221 001067 225 001071 226 001072 228 001074 229 001115 230 001116 233 001124 236 001125 237 001150 240 001173 243 001221 245 001233 248 001235 250 001244 253 001246 256 001247 257 001256 259 001263 262 001266 263 001274 265 001300 269 001302 272 001305 273 001321 277 001324 278 001325 280 001347 282 001362 283 001366 284 001370 285 001374 288 001377 290 001401 292 001410 294 001411 296 001421 298 001422 301 001423 304 001437 305 001443 308 001444 309 001450 310 001453 313 001454 314 001460 315 001463 319 001464 320 001473 321 001476 324 001500 326 001502 328 001506 330 001507 331 001531 333 001544 334 001547 335 001550 336 001555 337 001557 339 001561 340 001567 342 001577 344 001600 346 001601 349 001616 350 001623 352 001624 353 001630 354 001633 357 001634 360 001636 361 001644 362 001647 365 001650 366 001652 368 001654 371 001704 372 001707 373 001715 374 001717 377 001722 379 001723 380 001745 382 001760 383 001767 384 001774 387 001777 390 002011 391 002016 392 002021 393 002024 394 002027 397 002032 399 002035 401 002044 403 002054 405 002055 407 002056 410 002070 411 002075 413 002076 414 002102 415 002105 418 002106 419 002110 422 002112 424 002120 425 002132 428 002135 430 002136 431 002160 433 002173 435 002176 436 002202 438 002205 445 002241 446 002247 448 002257 450 002260 469 002261 472 002304 473 002311 474 002316 475 002321 477 002323 478 002325 481 002327 482 002333 483 002336 486 002337 488 002343 490 002344 492 002356 495 002373 496 002376 499 002377 503 002410 504 002412 505 002414 506 002416 509 002420 510 002423 512 002427 514 002430 516 002434 518 002435 519 002441 521 002447 524 002451 526 002453 528 002454 530 002460 531 002462 535 002463 537 002473 538 002477 539 002501 543 002502 545 002506 546 002507 550 002510 552 002514 553 002515 557 002516 558 002525 563 002547 568 002574 572 002607 574 002611 591 002612 594 002642 595 002647 596 002654 598 002655 600 002663 602 002665 604 002674 609 002702 611 002703 614 002720 615 002725 617 002726 618 002730 620 002732 622 002747 626 002750 637 003000 638 003005 640 003006 641 003010 642 003012 644 003013 645 003015 646 003017 648 003022 650 003023 652 003025 654 003030 656 003031 659 003046 660 003053 662 003054 663 003056 664 003060 666 003061 667 003070 668 003073 671 003074 672 003076 674 003101 675 003104 676 003105 677 003107 679 003110 682 003112 578 003113 581 003114 583 003121 584 003124 687 003125 694 003126 697 003132 698 003135 701 003137 703 003143 705 003151 707 003165 708 003166 710 003167 711 003177 713 003200 718 003201 721 003215 722 003233 725 003256 726 003271 727 003274 728 003304 730 003364 731 003400 734 003401 735 003430 738 003433 739 003440 740 003442 741 003464 743 003466 753 003467 759 003470 760 003473 763 003476 768 003544 770 003546 772 003555 782 003556 790 003557 791 003565 792 003575 794 003576 795 003602 796 003604 797 003640 798 003642 799 003645 800 003647 801 003650 803 003652 804 003671 805 003674 806 003732 807 003736 808 003742 809 003754 810 003764 811 004003 812 004004 813 004050 815 004054 817 004066 818 004071 819 004076 820 004102 821 004105 822 004107 826 004110 827 004114 828 004120 829 004123 831 004125 832 004161 834 004162 835 004164 836 004207 842 004210 845 004216 846 004223 849 004272 852 004275 854 004300 855 004314 856 004321 858 004322 859 004326 860 004331 861 004335 866 004336 871 004337 879 004341 882 004342 883 004352 885 004370 887 004406 889 004407 890 004416 893 004417 895 004430 897 004441 901 004442 904 004443 907 004452 909 004455 912 004462 913 004470 914 004473 916 004476 917 004505 921 004506 929 004507 932 004510 933 004512 934 004541 935 004543 939 004546 940 004603 942 004606 959 004607 966 004611 967 004615 968 004620 971 004624 972 004625 973 004631 975 004636 976 004671 978 004675 980 004676 981 004701 983 004737 987 004740 1003 004741 1004 004744 1005 004746 1006 004750 1007 004751 1008 004753 1009 004755 1010 004757 1012 004760 1013 004761 1016 004763 1021 004764 1030 004772 1032 005012 1033 005015 1034 005073 1037 005132 1039 005137 1041 005146 1043 005150 1049 005153 1052 005154 1053 005161 1054 005164 1055 005171 1056 005236 1057 005240 1058 005242 1059 005244 1060 005246 1061 005254 1063 005257 1064 005271 1065 005310 1066 005314 1067 005316 1069 005320 1075 005321 1084 005322 1087 005333 1090 005341 1092 005376 1093 005406 1094 005415 1095 005425 1096 005435 1097 005451 1098 005461 1100 005521 1102 005563 1104 005625 1106 005651 1107 005661 1108 005712 1109 005717 1110 005732 1111 005762 1114 005763 1115 005767 1116 006022 1117 006040 1118 006041 1119 006045 1120 006103 1121 006121 1122 006122 1123 006126 1126 006157 1129 006161 1130 006216 1132 006254 1133 006255 1134 006264 1137 006276 1139 006300 1143 006301 1149 006307 1150 006352 1153 006370 1155 006427 1163 006431 1169 006445 1171 006453 1174 006512 1176 006514 1178 006523 1181 006565 1189 006576 1197 006607 1199 006614 1202 006653 1204 006654 1206 006662 1208 006705 1212 006750 1220 006754 1236 006760 1237 006777 1238 007020 1240 007022 1245 007023 1251 007027 1252 007051 1253 007071 1255 007073 1262 007074 1266 007102 1268 007107 1269 007111 1274 007125 1275 007130 1277 007133 1281 007134 1311 007142 1313 007143 1314 007146 1315 007157 1316 007205 1317 007207 1320 007264 1329 007336 1330 007371 1332 007417 1336 007420 1341 007422 1342 007423 1346 007444 1349 007452 1355 007453 1360 007461 1361 007470 1362 007473 1363 007475 1364 007500 1365 007503 1368 007510 1370 007517 1373 007522 1374 007525 1379 007526 1383 007534 1385 007545 1386 007557 1387 007574 1390 007601 1394 007611 1397 007614 1401 007626 1404 007631 1405 007633 1408 007636 1415 007637 1419 007645 1420 007657 1422 007661 1423 007671 1436 007672 1444 007703 1449 007713 1459 007727 ----------------------------------------------------------- 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