COMPILATION LISTING OF SEGMENT ibm3270_control_ Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/15/82 1644.8 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /* IBM3270_CONTROL_ - Implements the control entry (and the guts of) the ibm3270_ I/O module */ 12 /* Written October 1977 by Larry Johnson */ 13 14 ibm3270_control_: proc; 15 16 /* Paramaters */ 17 18 dcl arg_iocbp ptr; 19 dcl arg_order char (*); 20 dcl arg_info_ptr ptr; 21 dcl arg_code fixed bin (35); 22 dcl arg_event_call_infop ptr; 23 24 /* Automatic */ 25 26 dcl code fixed bin (35); 27 dcl state fixed bin; 28 dcl order char (32); 29 dcl info_ptr ptr; 30 dcl iocbp ptr; 31 dcl event_call_infop ptr; 32 33 dcl 1 auto_read_ctl like read_ctl aligned automatic; 34 35 dcl 1 event_info aligned, /* For ipc_$block */ 36 2 channel_id fixed bin (71), 37 2 message fixed bin (71), 38 2 sender bit (36), 39 2 origon, 40 3 dev_signal bit (18) unal, 41 3 ring bit (18) unal, 42 2 channel_index fixed bin (17); 43 44 /* Based */ 45 46 dcl based_chan fixed bin (71) based; /* Event_info order */ 47 dcl poll_device fixed bin based (info_ptr); /* Argument for poll order */ 48 49 dcl 1 event_call_info aligned based (event_call_infop), 50 2 channel_id fixed bin (71), 51 2 message fixed bin (71), 52 2 sender bit (36), 53 2 origon, 54 3 dev_signal bit (18) unal, 55 3 ring bit (18) unal, 56 2 data_ptr ptr; 57 58 dcl 1 msg unal based (ad.text_buf_ptr), /* Start of standard reply */ 59 2 address, 60 3 pad1 bit (3), 61 3 controller bit (6), 62 3 pad2 bit (3), 63 3 device bit (6), 64 2 pad3 bit (3), 65 2 aid bit (6), /* Action code */ 66 2 cursor char (2); 67 68 dcl out_reqp ptr; /* Pointer to current output request */ 69 70 dcl 1 out_req aligned based (out_reqp), /* Output is a queue of these structures */ 71 2 next_out_reqp ptr, /* Forward pointer */ 72 2 out_msgp ptr, /* Pointer to text */ 73 2 out_msgl fixed bin, /* Its length */ 74 2 sent_len fixed bin, /* Amount of data actually sent */ 75 2 req_time fixed bin (71), /* Time request queued */ 76 2 device fixed bin, /* Device this message is for */ 77 2 retry_count fixed bin, /* Times this output has been tried */ 78 2 eot_sent bit (1); /* Send once eot sent for this request */ 79 80 dcl out_msg char (out_req.out_msgl) based (out_req.out_msgp); 81 82 dcl poll_reqp ptr; /* Pointer to poll queue block */ 83 84 dcl 1 poll_req aligned based (poll_reqp), 85 2 next_poll_reqp ptr, 86 2 device fixed bin; 87 88 /* Constants */ 89 90 91 /* The following 2 arrays map the low order 5 bits of an ebcdic aid byte into the values required 92* in read_info.key and sub_key */ 93 94 dcl aid_to_key (0:31) fixed bin (8) unal int static options (constant) init ( 95 0, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 5, 5, 6, 5, 0, 96 9, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 3, 8, 0); 97 98 dcl aid_to_sub_key (0:31) fixed bin (8) unal int static options (constant) init ( 99 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 1, 0, 2, 0, 100 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 0, 0, 0); 101 102 /* The following map values of write_info.command to the command code */ 103 104 dcl command_codes (6) bit (8) unal int static options (constant) init ( 105 "f1"b4, "f5"b4, "f7"b4, "6f"b4, "f6"b4, "f2"b4); 106 107 /* External */ 108 109 dcl hcs_$tty_read entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)); 110 dcl hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35)); 111 dcl hcs_$tty_write entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)); 112 dcl ibm3270_translate_$ascii_to_ebcdic entry (ptr, fixed bin); 113 dcl ibm3270_translate_$ebcdic_to_ascii entry (ptr, fixed bin); 114 dcl ipc_$block entry (ptr, ptr, fixed bin (35)); 115 dcl convert_ipc_code_ entry (fixed bin (35)); 116 dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); 117 dcl ibm3270_io_call_ entry (ptr, ptr, fixed bin (35)); 118 dcl ipc_$mask_ev_calls entry (fixed bin (35)); 119 dcl ipc_$unmask_ev_calls entry (fixed bin (35)); 120 dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); 121 122 dcl error_table_$bad_arg ext fixed bin (35); 123 dcl error_table_$no_operation ext fixed bin (35); 124 dcl error_table_$request_pending ext fixed bin (35); 125 dcl error_table_$unimplemented_version ext fixed bin (35); 126 dcl error_table_$line_status_pending ext fixed bin (35); 127 dcl error_table_$long_record ext fixed bin (35); 128 129 dcl (addr, addrel, bin, clock, divide, hbound, index, lbound, length, low, max, min, mod, null, string, substr, unspec) builtin; 130 131 dcl cleanup condition; 132 1 1 /* Begin include file ..... ibm3270_attach_data.incl.pl1 */ 1 2 1 3 /* Attach data block for the ibm3270_ I/O module */ 1 4 /* Written October 1977 by Larry Johnson */ 1 5 1 6 dcl adp ptr; 1 7 1 8 dcl 1 ad aligned based (adp), 1 9 2 work_areap ptr, /* Pointer to work area containing this structure */ 1 10 2 device char (6), /* Name of channel attached */ 1 11 2 tty_index fixed bin, /* Ring0 name for channel */ 1 12 2 attach_description char (256) var, 1 13 2 open_description char (24) var, 1 14 2 wait_list aligned, 1 15 3 nchan fixed bin, /* Number of channels to block on */ 1 16 3 user_channel fixed bin (71), /* The channel */ 1 17 2 attach_channel fixed bin (71), /* For talking to ansering service */ 1 18 2 io_channel fixed bin (71), /* Channel used by ring 0 */ 1 19 2 timer_channel fixed bin (71), /* Channel for error recovery timer */ 1 20 2 controller fixed bin, /* Address of controller, usually 0 */ 1 21 2 open_in_progress bit (1), /* Indicates we are blockig during open */ 1 22 2 close_in_progress bit (1), /* In process of closing switch, be careful of wakeups */ 1 23 2 open_wakeup_occured bit (1), /* Got answering service wakeup at open */ 1 24 2 open_event_message fixed bin (71), /* Temp copy of open event message */ 1 25 2 ascii bit (1), /* Set if running in ascii mode */ 1 26 2 async bit (1), /* Indicates the I/O module must not block ever */ 1 27 2 eot char (1), /* Some char codes */ 1 28 2 stx char (1), 1 29 2 etx char (1), 1 30 2 etb char (1), 1 31 2 soh char (1), 1 32 2 esc char (1), 1 33 2 sf char (1), /* Start field */ 1 34 2 sba char (1), /* Set buffer address */ 1 35 2 ic char (1), /* Insert cursor */ 1 36 2 pt char (1), /* Program tab */ 1 37 2 ra char (1), /* Repeat to address */ 1 38 2 eua char (1), /* Erase unprotected to address */ 1 39 2 bit6_char (0:63) char (1) unal, /* Maps 6 bit codes into ebcdic characters */ 1 40 2 first_read_infop ptr, /* First input block */ 1 41 2 last_read_infop ptr, /* Last input block */ 1 42 2 header_data, /* Header is build here */ 1 43 3 header_buf_ptr ptr, /* Addr of start of header */ 1 44 3 header_buf_len fixed bin, /* Lemgth of header buffer */ 1 45 3 header_len fixed bin, /* Length of data */ 1 46 2 text_data, /* Text is built here */ 1 47 3 text_buf_ptr ptr, /* Addr of start of text */ 1 48 3 text_buf_len fixed bin, /* Length of text_buffer */ 1 49 3 text_len fixed bin, /* Length of real data */ 1 50 2 input_buf_ptr ptr, /* Address of input buffer */ 1 51 2 input_buf_len fixed bin, /* Its length */ 1 52 2 unscanned_data_ptr ptr, /* Addr of next char in inpput buffer to scan */ 1 53 2 unscanned_data_len fixed bin, /* Number of chars remaining */ 1 54 2 input_state fixed bin, /* Current state of text scan */ 1 55 2 output_buf_ptr ptr, /* Buffer for building output messages */ 1 56 2 output_buf_len fixed bin, /* Its length */ 1 57 2 polling_in_progress bit (1), /* Set during polling operation */ 1 58 2 device_responded bit (1), /* Set if polling resulted in real data coming back */ 1 59 2 general_poll bit (1), /* User is doing general_poll */ 1 60 2 first_poll_reqp ptr, /* Pointer to first queued poll request */ 1 61 2 last_poll_reqp ptr, /* Pointer to last polled request */ 1 62 2 wakeup_needed bit (1), /* Set if caller needes wakeup when data available */ 1 63 2 last_device_polled fixed bin, /* Last poll address sent to fnp */ 1 64 2 last_device_selected fixed bin, /* Last select address sent to fnp */ 1 65 2 cur_out_reqp ptr, /* Current output request */ 1 66 2 output_in_progress bit (1), /* Set while doing output */ 1 67 2 per_dev (0:31), /* Data on output to each device */ 1 68 3 first_out_reqp ptr, /* Addr of first request in its queue */ 1 69 3 last_out_reqp ptr, /* Addr of last request in its queue */ 1 70 3 pend_time fixed bin (71), /* Time at which output should be retryed */ 1 71 2 min_dev fixed bin, /* Index of lowest device which currently has output pended */ 1 72 2 max_dev fixed bin, /* Index of highest device */ 1 73 2 pend_interval fixed bin (71), /* Time interval for retrying otput */ 1 74 2 retry_limit fixed bin, /* Times to retry output to non-ready devices */ 1 75 2 input_line_status fixed bin, /* Input error code */ 1 76 2 output_line_status fixed bin, /* Output error code */ 1 77 2 processid bit (36); 1 78 1 79 dcl work_area area based (ad.work_areap); 1 80 dcl header_buf char (ad.header_buf_len) based (ad.header_buf_ptr); /* Header built here */ 1 81 dcl header_data char (ad.header_len) based (ad.header_buf_ptr); 1 82 dcl text_buf char (ad.text_buf_len) based (ad.text_buf_ptr); /* Text built here */ 1 83 dcl text_data char (ad.text_len) based (ad.text_buf_ptr); 1 84 dcl input_buf char (ad.input_buf_len) based (ad.input_buf_ptr); /* Raw data read here */ 1 85 dcl unscanned_data char (ad.unscanned_data_len) based (ad.unscanned_data_ptr); /* Unprocessed part of input_buf */ 1 86 dcl output_buf char (ad.output_buf_len) based (ad.output_buf_ptr); 1 87 1 88 /* The following array maps any 6-bit code into the ebcdic character needed to transmit it */ 1 89 /* The first 32 elements are used for device addresses (poll and select) and controller address (poll only) */ 1 90 /* The second 32 elements are used for controller addresses (select only) */ 1 91 /* A more useable character form of this array is kept in ad.bit6_char */ 1 92 1 93 dcl address_mapping (0:63) bit (8) unal int static options (constant) init ( 1 94 "40"b4, "c1"b4, "c2"b4, "c3"b4, "c4"b4, "c5"b4, "c6"b4, "c7"b4, 1 95 "c8"b4, "c9"b4, "4a"b4, "4b"b4, "4c"b4, "4d"b4, "4e"b4, "4f"b4, 1 96 "50"b4, "d1"b4, "d2"b4, "d3"b4, "d4"b4, "d5"b4, "d6"b4, "d7"b4, 1 97 "d8"b4, "d9"b4, "5a"b4, "5b"b4, "5c"b4, "5d"b4, "5e"b4, "5f"b4, 1 98 "60"b4, "61"b4, "e2"b4, "e3"b4, "e4"b4, "e5"b4, "e6"b4, "e7"b4, 1 99 "e8"b4, "e9"b4, "6a"b4, "6b"b4, "6c"b4, "6d"b4, "6e"b4, "6f"b4, 1 100 "f0"b4, "f1"b4, "f2"b4, "f3"b4, "f4"b4, "f5"b4, "f6"b4, "f7"b4, 1 101 "f8"b4, "f9"b4, "7a"b4, "7b"b4, "7c"b4, "7d"b4, "7e"b4, "7f"b4); 1 102 1 103 /* End include file ..... ibm3270_attach_data.incl.pl1 */ 133 134 2 1 /* Begin include file ..... ibm3270_io_info.incl.pl1 */ 2 2 2 3 /* 3270 input/output information structure */ 2 4 /* Initially constructed 09/08/77 by Larry Johnson and Warren Johnson */ 2 5 2 6 /* Following structure must be supplied for "read" order */ 2 7 2 8 dcl read_ctlp ptr; 2 9 2 10 dcl 1 read_ctl aligned based (read_ctlp), 2 11 2 version fixed bin, /* Currently one */ 2 12 2 areap ptr, /* Pointer to area where "read_info" is allocated */ 2 13 2 read_infop ptr, /* Pointer to read_info structure, allocatd by I/O module */ 2 14 2 max_len fixed bin, /* Max character length */ 2 15 2 max_fields fixed bin; /* Max number of fields in array */ 2 16 2 17 /* The following structure is allocate by the I/O module on a read order */ 2 18 /* It must be freed by the caller when no longer needed */ 2 19 2 20 dcl 1 read_info aligned based (read_ctl.read_infop), 2 21 2 version fixed bin, /* Currently 1 */ 2 22 2 next_read_infop ptr, /* Used by I/O module internally for chaining blocks */ 2 23 2 controller fixed bin, /* Controller which data is for */ 2 24 2 device fixed bin, /* Which device on that controller */ 2 25 2 reason, /* Reason for this data */ 2 26 3 key fixed bin, /* Indicates which key pressed, see codes below */ 2 27 3 sub_key fixed bin, /* For PF or PA, which one */ 2 28 3 code fixed bin (35), /* If reason is error, an error code */ 2 29 2 status, /* If reason STATUS, the status data */ 2 30 3 bits bit (12) unal, 2 31 3 fill bit (24) unal, 2 32 2 cursor_position fixed bin, /* Current cursor position */ 2 33 2 max_fields fixed bin, /* Used to define array */ 2 34 2 max_len fixed bin, /* Used to define array */ 2 35 2 mod_fields fixed bin, /* Number of elements in array actually filled in */ 2 36 2 data (read_ctl.max_fields refer (read_info.max_fields)), 2 37 3 field_position fixed bin, /* Address of field */ 2 38 3 contents char (read_ctl.max_len refer (read_info.max_len)) var; 2 39 2 40 /* Possible values for read_info.key */ 2 41 2 42 dcl (ERROR init (1), /* Serious error, see read_info.code */ 2 43 STATUS init (2), /* Device reported status */ 2 44 ENTER init (3), /* Entry key hit */ 2 45 PF_KEY init (4), /* One of PF keys hit, see read_info.sub_key */ 2 46 PA_KEY init (5), /* One of PA keys hit, see read_info.sub_key */ 2 47 CLEAR init (6), /* Clear key hit */ 2 48 ID_READER init (7), /* Operatior identification card reader */ 2 49 LIGHT_PEN init (8), /* Light pen used */ 2 50 TEST_REQ init (9)) /* Test request key hit */ 2 51 int static options (constant); 2 52 2 53 dcl write_infop ptr; 2 54 dcl max_write_fields fixed bin; 2 55 dcl max_write_len fixed bin; 2 56 2 57 dcl 1 write_info aligned based (write_infop), 2 58 2 version fixed bin, 2 59 2 controller fixed bin, 2 60 2 device fixed bin, 2 61 2 from_device fixed bin, /* used with COPY command */ 2 62 2 command fixed bin, /* write, erase/write, copy, etc. */ 2 63 2 write_ctl_char, 2 64 3 bits unal, 2 65 4 print_format bit (2) unal, /* 00 = use NL order, 01 = 40, 10 = 60, 11 = 80 */ 2 66 4 start_printer bit (1) unal, 2 67 4 sound_alarm bit (1) unal, 2 68 4 keyboard_restore bit (1) unal, 2 69 4 reset_mdt bit (1) unal, 2 70 3 copy_bits bit (2) unal, /* which fields to copy */ 2 71 3 pad bit (28) unal, 2 72 2 max_fields fixed bin, 2 73 2 max_len fixed bin, /* max length of data.contents */ 2 74 2 mod_fields fixed bin, /* number of fields actually filled in */ 2 75 2 data (max_write_fields refer (write_info.max_fields)), 2 76 3 orders unal, /* orders to precede this block of data */ 2 77 4 set_buffer_addr bit (1), /* defines starting address */ 2 78 4 start_field bit (1), /* define field, using attribute char */ 2 79 4 insert_cursor bit (1), 2 80 4 program_tab bit (1), 2 81 4 repeat_to_addr bit (1), /* repeat supplied char */ 2 82 4 erase_to_addr bit (1), 2 83 3 attributes unal, /* used in field definition if start_field = "1"b */ 2 84 4 protected bit (1), 2 85 4 numeric bit (1), 2 86 4 display_form bit (2), /* 00 = display, ^pen, 01 = display,pen, 10 = intensified */ 2 87 /* 11 = invisible */ 2 88 4 reserved bit (1), 2 89 4 mdt bit (1), /* modified data tag */ 2 90 3 pad1 bit (12) unal, 2 91 3 field_position fixed bin, 2 92 3 contents char (max_write_len refer (write_info.max_len)) varying; 2 93 2 94 /* possible values for write_info.command */ 2 95 2 96 dcl (WRITE init (1), 2 97 ERASE_WRITE init (2), 2 98 COPY init (3), 2 99 ERASE_UNPROTECTED init (4), 2 100 READ_MODIFIED init (5), 2 101 READ_BUFFER init (6)) 2 102 fixed bin int static options (constant); 2 103 2 104 /* End include file ..... ibm3270_io_info.incl.pl1 */ 135 136 3 1 /* BEGIN INCLUDE FILE ..... iocb.incl.pl1 ..... 13 Feb 1975, M. Asherman */ 3 2 /* format: style2 */ 3 3 3 4 dcl 1 iocb aligned based, /* I/O control block. */ 3 5 2 version character (4) aligned, 3 6 2 name char (32), /* I/O name of this block. */ 3 7 2 actual_iocb_ptr ptr, /* IOCB ultimately SYNed to. */ 3 8 2 attach_descrip_ptr ptr, /* Ptr to printable attach description. */ 3 9 2 attach_data_ptr ptr, /* Ptr to attach data structure. */ 3 10 2 open_descrip_ptr ptr, /* Ptr to printable open description. */ 3 11 2 open_data_ptr ptr, /* Ptr to open data structure (old SDB). */ 3 12 2 reserved bit (72), /* Reserved for future use. */ 3 13 2 detach_iocb entry (ptr, fixed (35)),/* detach_iocb(p,s) */ 3 14 2 open entry (ptr, fixed, bit (1) aligned, fixed (35)), 3 15 /* open(p,mode,not_used,s) */ 3 16 2 close entry (ptr, fixed (35)),/* close(p,s) */ 3 17 2 get_line entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 18 /* get_line(p,bufptr,buflen,actlen,s) */ 3 19 2 get_chars entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 20 /* get_chars(p,bufptr,buflen,actlen,s) */ 3 21 2 put_chars entry (ptr, ptr, fixed (21), fixed (35)), 3 22 /* put_chars(p,bufptr,buflen,s) */ 3 23 2 modes entry (ptr, char (*), char (*), fixed (35)), 3 24 /* modes(p,newmode,oldmode,s) */ 3 25 2 position entry (ptr, fixed, fixed (21), fixed (35)), 3 26 /* position(p,u1,u2,s) */ 3 27 2 control entry (ptr, char (*), ptr, fixed (35)), 3 28 /* control(p,order,infptr,s) */ 3 29 2 read_record entry (ptr, ptr, fixed (21), fixed (21), fixed (35)), 3 30 /* read_record(p,bufptr,buflen,actlen,s) */ 3 31 2 write_record entry (ptr, ptr, fixed (21), fixed (35)), 3 32 /* write_record(p,bufptr,buflen,s) */ 3 33 2 rewrite_record entry (ptr, ptr, fixed (21), fixed (35)), 3 34 /* rewrite_record(p,bufptr,buflen,s) */ 3 35 2 delete_record entry (ptr, fixed (35)),/* delete_record(p,s) */ 3 36 2 seek_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 3 37 /* seek_key(p,key,len,s) */ 3 38 2 read_key entry (ptr, char (256) varying, fixed (21), fixed (35)), 3 39 /* read_key(p,key,len,s) */ 3 40 2 read_length entry (ptr, fixed (21), fixed (35)); 3 41 /* read_length(p,len,s) */ 3 42 3 43 declare iox_$iocb_version_sentinel 3 44 character (4) aligned external static; 3 45 3 46 /* END INCLUDE FILE ..... iocb.incl.pl1 ..... */ 137 138 4 1 /* BEGIN INCLUDE FILE .... bisync_line_data.incl.pl1 */ 4 2 /* Written: October 1977 by Larry Johnson */ 4 3 /* Modified: November 1979 by Larry Johnson and Gary Palter for HASP */ 4 4 4 5 /* Structures and codes for doing line_control and line_status operations on bisync lines */ 4 6 4 7 /* For line_control order */ 4 8 4 9 dcl 1 line_ctl aligned, 4 10 2 op fixed binary (17) unaligned, /* indicates action being performed */ 4 11 2 val (3) fixed binary (17) unaligned; /* optional arguments with some ops */ 4 12 4 13 dcl 1 valchar based (addr (line_ctl.val (1))), /* character overlay of line_ctl.val */ 4 14 2 data_len fixed binary (9) unaligned unsigned, 4 15 2 data character (5) unaligned; 4 16 4 17 4 18 /* Values for line_ctl.op */ 4 19 4 20 dcl (SET_BID_LIMIT initial (1), 4 21 ACCEPT_BID initial (2), 4 22 CONFIGURE initial (3), /* val(1): 0 = non-transparent ASCII, 1 = not-tranparent EBCDIC, 4 23* 2 = transparent ASCII, 3 = transparent EBCDIC */ 4 24 SET_TTD_PARAMS initial (4), /* val(1): ttd_time; val(2): ttd_limit */ 4 25 REPORT_WRITE_STATUS initial (5), /* Request FNP to report on output buffers */ 4 26 SET_3270_MODE initial (6), 4 27 SET_POLLING_ADDR initial (7), 4 28 START_POLL initial (8), 4 29 SET_SELECT_ADDR initial (9), 4 30 STOP_AUTO_POLL initial (10), 4 31 SET_MASTER_SLAVE_MODE initial (11), /* val(1): 0 = slave (host), 1 = master (workstation) */ 4 32 SET_HASP_MODE initial (12), 4 33 SET_NAK_LIMIT initial (13), /* val(1): maximum # of NAKs allowed in a row */ 4 34 SET_HASP_TIMERS initial (14)) /* val(1): initial connect timeout; val(2): receive timeout; 4 35* val(3): transmit timeout */ 4 36 fixed binary static options (constant); 4 37 4 38 4 39 /* For line status order */ 4 40 4 41 dcl 1 line_stat aligned, 4 42 2 op fixed binary (17) unaligned, /* contains reason for status */ 4 43 2 val (3) fixed binary (17) unaligned; 4 44 4 45 4 46 /* Values for line_stat.op */ 4 47 4 48 dcl (BID_FAILED initial (1), 4 49 BAD_BLOCK initial (2), 4 50 REVERSE_INTERRUPT initial (3), 4 51 TOO_MANY_NAKS initial (4), 4 52 FNP_WRITE_STATUS initial (5), 4 53 IBM3270_WRITE_COMPLETE initial (6), 4 54 IBM3270_WACK_MESSAGE initial (7), 4 55 IBM3270_WRITE_EOT initial (8), 4 56 IBM3270_WRITE_ABORT initial (9), 4 57 IBM3270_SELECT_FAILED initial (10), 4 58 IBM3270_WACK_SELECT initial (11), 4 59 IBM3270_NAK_OUTPUT initial (12), 4 60 HASP_INIT_COMPLETE initial (13)) 4 61 fixed binary static options (constant); 4 62 4 63 /* END INCLUDE FILE ..... bisync_line_data.incl.pl1 */ 139 140 141 142 /* The control entry point */ 143 144 control: entry (arg_iocbp, arg_order, arg_info_ptr, arg_code); 145 146 iocbp = arg_iocbp -> iocb.actual_iocb_ptr; 147 adp = iocbp -> iocb.attach_data_ptr; 148 order = arg_order; 149 info_ptr = arg_info_ptr; 150 read_ctlp = addr (auto_read_ctl); 151 152 /* Following orders are allowed before open */ 153 154 if order = "event_info" then do; 155 info_ptr -> based_chan = ad.user_channel; 156 code = 0; 157 go to control_return; 158 end; 159 if order = "io_call" then do; 160 call ibm3270_io_call_ (iocbp, info_ptr, code); 161 go to control_return; 162 end; 163 164 if iocbp -> iocb.open_descrip_ptr = null then do; /* Not open yet */ 165 code = error_table_$no_operation; 166 go to control_return; 167 end; 168 169 /* Orders allowed after switch is open */ 170 171 if order = "general_poll" then do; 172 ad.general_poll = "1"b; /* We want to be polling */ 173 call worker; 174 code = 0; 175 end; 176 177 else if order = "stop_general_poll" then do; 178 ad.general_poll = "0"b; 179 call stop_auto_poll; 180 code = 0; 181 end; 182 183 else if order = "poll" then do; 184 call queue_poll_req (poll_device); 185 call worker; 186 code = 0; 187 end; 188 189 else if order = "read" then do; /* Get next data block */ 190 read_ctlp = info_ptr; 191 if read_ctl.version ^= 1 then do; 192 code = error_table_$unimplemented_version; 193 go to control_return; 194 end; 195 if ad.first_read_infop = null then call worker; /* Look harder if none yet */ 196 do while (ad.first_read_infop = null); /* Then, block until available */ 197 ad.wakeup_needed = "1"b; 198 if ad.async then do; /* Cant block here */ 199 code = error_table_$request_pending; 200 go to control_return; 201 end; 202 call ipc_$block (addr (ad.wait_list), addr (event_info), code); 203 if code ^= 0 then do; 204 call convert_ipc_code_ (code); 205 go to control_return; 206 end; 207 ad.wakeup_needed = "0"b; 208 end; 209 210 read_ctlp = info_ptr; /* This may have been changed */ 211 read_ctl.read_infop = ad.first_read_infop; /* Return first block */ 212 ad.first_read_infop = read_info.next_read_infop; 213 if ad.first_read_infop = null then ad.last_read_infop = null; 214 read_info.next_read_infop = null; /* Don't let caller see this */ 215 code = 0; 216 read_ctl.areap = ad.work_areap; 217 read_ctl.max_len = read_info.max_len; 218 read_ctl.max_fields = read_info.max_fields; 219 end; 220 221 else if order = "write" then do; 222 write_infop = info_ptr; 223 if write_info.device < 0 | write_info.device > 31 then do; 224 code = error_table_$bad_arg; 225 go to control_return; 226 end; 227 call format_write_msg; /* Setup real output */ 228 if code ^= 0 then go to control_return; 229 call queue_out_req; 230 call worker; 231 code = 0; 232 end; 233 234 else do; 235 retry_order: call hcs_$tty_order (ad.tty_index, order, info_ptr, state, code); 236 if code ^= 0 then do; 237 call check_error_code; 238 if code ^= 0 then go to control_return; /* Serious error */ 239 if ad.input_line_status ^= 0 | ad.output_line_status ^= 0 then call worker; /* If line status returned */ 240 go to retry_order; /* Then do callers work */ 241 end; 242 end; 243 control_return: 244 arg_code = code; 245 return; 246 247 /* This entry is the event call handler for wakeups on the communications channel */ 248 249 wakeup_handler: entry (arg_event_call_infop); 250 251 event_call_infop = arg_event_call_infop; 252 iocbp = event_call_info.data_ptr; 253 adp = iocbp -> iocb.attach_data_ptr; 254 read_ctlp = addr (auto_read_ctl); 255 if ad.close_in_progress then return; 256 257 call worker; 258 259 if ad.wakeup_needed & (ad.first_read_infop ^= null) then /* Got good data for caller */ 260 call hcs_$wakeup (ad.processid, ad.user_channel, 0, code); 261 262 return; 263 264 /* Handler for wakeups on the timer channel */ 265 266 timer_handler: entry (arg_event_call_infop); 267 268 event_call_infop = arg_event_call_infop; 269 iocbp = event_call_info.data_ptr; 270 adp = iocbp -> iocb.attach_data_ptr; 271 read_ctlp = addr (auto_read_ctl); 272 if ad.close_in_progress then return; 273 274 call unpend_out_req; /* Unpend all requests */ 275 276 return; 277 278 /* Procedure to do as much I/O as can be done right now */ 279 280 worker: proc; 281 282 call ipc_$mask_ev_calls (code); 283 on cleanup call ipc_$unmask_ev_calls (code); 284 worker_loop: 285 call scan_more_input; 286 287 call send_more_output; 288 289 if ad.input_line_status ^= 0 then go to worker_loop; /* In case read error reported during output */ 290 291 call poll_more_devices; 292 293 if ad.input_line_status ^= 0 | ad.output_line_status ^= 0 then go to worker_loop; 294 295 call ipc_$unmask_ev_calls (code); 296 297 return; 298 299 end worker; 300 301 /* Procedure that parses the input data stream at the bisync level */ 302 303 scan_more_input: proc; 304 305 dcl (i, j) fixed bin ; 306 307 check_input_status: 308 if ad.input_line_status ^= 0 then do; /* Some bad condition */ 309 call queue_error (ad.last_device_polled, (ad.input_line_status)); 310 ad.input_line_status = 0; 311 ad.polling_in_progress = "0"b; 312 end; 313 314 get_more_data: if ad.unscanned_data_len = 0 then do; /* First need some data */ 315 retry_read: call hcs_$tty_read (ad.tty_index, ad.input_buf_ptr, 0, ad.input_buf_len, ad.unscanned_data_len, 316 state, code); 317 if code ^= 0 then do; 318 call check_error_code; 319 if code ^= 0 then do; /* Bad error */ 320 call queue_error (-1, code); 321 return; 322 end; 323 if ad.input_line_status ^= 0 then go to check_input_status; 324 else go to retry_read; 325 end; 326 if ad.unscanned_data_len = 0 then return; 327 ad.unscanned_data_ptr = ad.input_buf_ptr; 328 end; 329 330 /* Now dispatch of current state of input scan and the data type */ 331 332 go to get_data (ad.input_state); 333 334 get_data (1): /* Looking for stx in non_transparent mode */ 335 if substr (unscanned_data, 1, 1) = ad.stx then do; /* Found data */ 336 ad.input_state = 2; 337 call advance_unscanned_data (1); 338 go to get_more_data; 339 end; 340 if substr (unscanned_data, 1, 1) = ad.soh then do; /* Found header */ 341 ad.input_state = 4; 342 call advance_unscanned_data (1); 343 go to get_more_data; 344 end; 345 if substr (unscanned_data, 1, 1) = ad.eot then call process_eot; 346 call advance_unscanned_data (1); /* Move over eot */ 347 go to get_more_data; 348 349 get_data (2): /* In middle of block, looking for etb or etx */ 350 i = index (unscanned_data, ad.etx); 351 if i = 1 then do; /* End of block */ 352 get_data_2a: call advance_unscanned_data (1); /* Move over etx */ 353 call process_input; 354 ad.input_state = 3; /* To skip lrc */ 355 go to get_more_data; 356 end; 357 358 j = index (unscanned_data, ad.etb); /* Check for etb too */ 359 if j = 1 then do; /* Found etb before etx */ 360 get_data_2b: call advance_unscanned_data (1); /* Over etb */ 361 ad.input_state = 3; /* Skip lrc */ 362 go to get_more_data; 363 end; 364 if i = 0 then i = j; /* If not etx, use etb answer */ 365 else if j ^= 0 then i = min (i, j); /* If both, use first */ 366 if i = 0 then do; /* All data is good */ 367 call move_data (addr (ad.text_data), ad.unscanned_data_len); 368 go to get_more_data; 369 end; 370 call move_data (addr (ad.text_data), i-1); /* Move stuff before etb or etx */ 371 if substr (unscanned_data, 1, 1) = ad.etx then go to get_data_2a; 372 else go to get_data_2b; 373 374 get_data (3): /* Skip over lrc character after etx or etb */ 375 if ad.ascii then call advance_unscanned_data (1); 376 ad.input_state = 1; 377 go to get_more_data; 378 379 get_data (4): /* Scanning data in header */ 380 i = index (unscanned_data, ad.etx); /* Look for etx */ 381 if i = 1 then do; /* Etx first */ 382 get_data_4a: call advance_unscanned_data (1); /* Skip over etxx */ 383 ad.input_state = 3; 384 call process_input; 385 go to get_more_data; 386 end; 387 j = index (unscanned_data, ad.etb); /* Also look for etb */ 388 if i = 0 then i = j; /* If no etx, use etb */ 389 else if j ^= 0 then i = min (i, j); /* Otherwise use what comes first */ 390 if i = 1 then do; /* Etb is first */ 391 get_data_4b: call advance_unscanned_data (1); /* Ignore etb */ 392 ad.input_state = 3; 393 go to get_more_data; 394 end; 395 j = index (unscanned_data, ad.stx); /* This may also terminate header */ 396 if i = 0 then i = j; /* If no etb or etx, use stx */ 397 else if j ^= 0 then i = min (i, j); /* Otherwise use what comes first */ 398 if i = 1 then do; /* Stx is first */ 399 get_data_4c: call advance_unscanned_data (1); 400 ad.input_state = 2; 401 go to get_more_data; 402 end; 403 if i = 0 then do; /* Didnt find any special chars */ 404 call move_data (addr (ad.header_data), ad.unscanned_data_len); 405 go to get_more_data; 406 end; 407 call move_data (addr (ad.header_data), i-1); 408 i = 1; /* First char is now control char */ 409 if substr (unscanned_data, 1, 1) = ad.etx then go to get_data_4a; 410 else if substr (unscanned_data, 1, 1) = ad.etb then go to get_data_4b; 411 else go to get_data_4c; /* Looking at stx */ 412 413 414 end scan_more_input; 415 416 /* Internal procedure to move chars to header or text */ 417 418 move_data: proc (p, n); 419 420 dcl i fixed bin; 421 dcl n fixed bin; 422 dcl p ptr; /* Points to header data or text data */ 423 424 dcl 1 data aligned based (p), 425 2 data_buf_ptr ptr, 426 2 data_buf_len fixed bin, 427 2 data_len fixed bin; 428 429 dcl data_chars char (data.data_buf_len) based (data.data_buf_ptr); 430 431 i = min (n, data.data_buf_len - data.data_len); /* Move what fits */ 432 if i > 0 then substr (data_chars, data.data_len + 1, i) = substr (unscanned_data, 1, i); 433 call advance_unscanned_data (n); /* Move past chars moved */ 434 data.data_len = data.data_len + i; 435 return; 436 437 end move_data; 438 439 /* Procedure to move the pointer in the unscanned data area */ 440 441 advance_unscanned_data: proc (amt); 442 443 dcl amt fixed bin ; 444 445 ad.unscanned_data_ptr = substraddr (unscanned_data, amt+1); 446 ad.unscanned_data_len = ad.unscanned_data_len - amt; 447 return; 448 449 end advance_unscanned_data; 450 451 /* Routine to process input data once it is found */ 452 453 process_input: proc; 454 455 dcl (i, j) fixed bin; 456 dcl fldi (256) fixed bin; 457 dcl nf fixed bin; 458 dcl max_fldl fixed bin; 459 dcl scanp ptr; 460 dcl scanl fixed bin; 461 dcl scan_data char (scanl) based (scanp); 462 463 if ad.header_len > 0 then do; /* Header means some special format */ 464 if ^ad.ascii then call ibm3270_translate_$ebcdic_to_ascii (ad.header_buf_ptr, ad.header_len); 465 if header_data = "%R" then do; /* Status information */ 466 if ad.text_len < 4 then go to process_input_end; /* Not enough data, ignore */ 467 call get_read_info (0, 0); /* Setup input structure */ 468 call extract_address; /* Get device address */ 469 read_info.key = STATUS; 470 substr (read_info.bits, 1, 6) = substr (unspec (substr (text_data, 3, 1)), 4, 6); 471 substr (read_info.bits, 7, 6) = substr (unspec (substr (text_data, 4, 1)), 4, 6); 472 if read_info.bits = "0200"b3 then /* Ready device */ 473 ad.pend_time (read_info.device) = 0; /* This unpends output for this device */ 474 go to queue_standard; 475 end; 476 else if header_data = "%/" then do; /* Test request */ 477 call get_read_info (1, ad.text_len); 478 read_info.key = TEST_REQ; 479 read_info.mod_fields = 1; 480 if ^ad.ascii then call ibm3270_translate_$ebcdic_to_ascii (ad.text_buf_ptr, ad.text_len); 481 read_info.contents (1) = text_data; 482 read_info.field_position (1) = 0; 483 go to queue_standard; 484 end; 485 go to process_input_end; /* Bad header */ 486 end; 487 488 /* Data has no header, so standard input text is assumed */ 489 490 if ad.text_len < 2 then go to process_input_end; 491 if ad.text_len > 5 then do; /* There is data */ 492 scanp = substraddr (text_data, 6); 493 scanl = ad.text_len - 5; 494 if substr (scan_data, 1, 1) ^= ad.sba then do; /* Unformatted */ 495 call get_read_info (1, scanl); /* One unformated string */ 496 read_info.field_position (1) = -1; 497 call ibm3270_translate_$ebcdic_to_ascii (scanp, scanl); 498 read_info.contents (1) = scan_data; 499 read_info.mod_fields = 1; 500 end; 501 else do; /* Formatted screen */ 502 nf = 0; 503 max_fldl = 1; 504 i = 1; 505 do while ((i <= scanl) & (nf < 256)); /* Find all sba's */ 506 j = index (substr (scan_data, i), ad.sba); 507 if j ^= 0 then do; /* Found one */ 508 nf = nf + 1; 509 fldi (nf) = i + j - 1; 510 i = i + j; 511 max_fldl = max (max_fldl, j-3); 512 end; 513 else do; 514 max_fldl = max (max_fldl, scanl - i - 1); 515 i = scanl+1; /* To stop scan */ 516 end; 517 end; 518 call get_read_info (nf, max_fldl); 519 do i = 1 to nf; /* Insert positions */ 520 read_info.field_position (i) = get_position (substr (scan_data, fldi (i)+1, 2)); 521 end; 522 call ibm3270_translate_$ebcdic_to_ascii (scanp, scanl); 523 do i = 1 to nf; /* Get data */ 524 if i < nf then j = fldi (i+1) - fldi (i) - 3; 525 else j = scanl - fldi (i) - 2; 526 read_info.contents (i) = substr (scan_data, fldi (i)+3, j); 527 end; 528 read_info.mod_fields = nf; 529 end; 530 end; 531 else call get_read_info (0, 0); /* No data */ 532 call extract_address; 533 if ad.text_len < 3 then go to queue_standard; /* No aid */ 534 i = bin (substr (msg.aid, 2, 5)); /* Low order 5 bits of aid */ 535 read_info.key = aid_to_key (i); 536 read_info.sub_key = aid_to_sub_key (i); 537 if ad.text_len < 5 then go to queue_standard; /* No cursor */ 538 read_info.cursor_position = get_position (msg.cursor); 539 queue_standard: 540 call queue_read_info; 541 ad.device_responded = "1"b; /* Means device answered poll */ 542 process_input_end: 543 ad.text_len, ad.header_len = 0; /* Start new data */ 544 return; 545 546 end process_input; 547 548 process_eot: proc; 549 550 ad.polling_in_progress = "0"b; /* These means polling finished */ 551 if ad.last_device_polled >= 0 & ^ad.device_responded then do; 552 /* Last poll was to specific device that answered EOT */ 553 call get_read_info (0, 0); /* Build dummy ready status */ 554 read_info.controller = ad.controller; 555 read_info.device = ad.last_device_polled; 556 read_info.key = STATUS; 557 read_info.status.bits = "0200"b3; 558 call queue_read_info; 559 end; 560 561 end process_eot; 562 563 /* Allocate a read_info structure */ 564 565 get_read_info: proc (max_fields, max_len); 566 567 dcl (max_fields, max_len); 568 569 read_ctl.max_fields = max_fields; 570 read_ctl.max_len = max_len; 571 allocate read_info in (work_area); 572 read_info.version = 1; 573 read_info.next_read_infop = null; 574 read_info.controller = 0; 575 read_info.device = -1; 576 read_info.reason = 0; 577 read_info.status = "0"b; 578 read_info.cursor_position = 0; 579 read_info.mod_fields = 0; 580 return; 581 582 end get_read_info; 583 584 /* Procudure to add a complete read_info structure to the chain */ 585 586 queue_read_info: proc; 587 588 read_info.next_read_infop = null; 589 if ad.first_read_infop = null then /* Only one */ 590 ad.first_read_infop, ad.last_read_infop = addr (read_info); 591 else do; 592 ad.last_read_infop -> read_info.next_read_infop = addr (read_info); 593 ad.last_read_infop = addr (read_info); 594 end; 595 return; 596 597 end queue_read_info; 598 599 /* Extract device address from input text */ 600 601 extract_address: proc; 602 603 read_info.controller = bin (msg.controller); 604 read_info.device = bin (msg.device); 605 return; 606 607 end extract_address; 608 609 /* Get address out of 2 character seqyence */ 610 611 get_position: proc (c) returns (fixed bin); 612 613 dcl c char (2); 614 615 return (bin (substr (unspec (c), 4, 6) || substr (unspec (c), 13, 6))); 616 617 end get_position; 618 619 /* Procedure to set up polling address and initiate a poll operation */ 620 621 poll: proc (device); 622 623 dcl device fixed bin; 624 dcl controller_char char (1); /* Controller address, in char form */ 625 dcl device_char char (1); /* Device address, in char form */ 626 dcl select_sw bit (1) init ("0"b); 627 dcl auto bit (1) init ("0"b); 628 629 poll_join: if device ^= ad.last_device_polled then do; /* Skip if fnp already has address */ 630 select_join: if ^select_sw then controller_char = ad.bit6_char (ad.controller); 631 else controller_char = ad.bit6_char (ad.controller + 32); 632 if device = -1 then /* General poll */ 633 unspec (device_char) = "177"b3; 634 else device_char = ad.bit6_char (device); 635 636 if select_sw then line_ctl.op = SET_SELECT_ADDR; 637 else line_ctl.op = SET_POLLING_ADDR; 638 valchar.data_len = 4; 639 substr (valchar.data, 1, 1), substr (valchar.data, 2, 1) = controller_char; 640 substr (valchar.data, 3, 1), substr (valchar.data, 4, 1) = device_char; 641 retry_addr: call hcs_$tty_order (ad.tty_index, "line_control", addr (line_ctl), state, code); 642 if code ^= 0 then do; 643 call check_error_code; 644 if code ^= 0 then return; 645 else go to retry_addr; 646 end; 647 if select_sw then do; 648 ad.last_device_selected = device; 649 return; 650 end; 651 else ad.last_device_polled = device; 652 end; 653 654 line_ctl.op = START_POLL; /* Now, poll */ 655 line_ctl.val = 0; 656 if auto then line_ctl.val (1) = 1; 657 retry_poll: call hcs_$tty_order (ad.tty_index, "line_control", addr (line_ctl), state, code); 658 if code ^= 0 then do; 659 call check_error_code; 660 if code ^= 0 then return; 661 else go to retry_poll; 662 end; 663 if line_ctl.op = START_POLL then do; 664 ad.polling_in_progress = "1"b; 665 ad.device_responded = "0"b; /* No answwer yet */ 666 end; 667 return; 668 669 select: entry (device); 670 671 if ad.last_device_selected = device then return; 672 select_sw = "1"b; 673 go to select_join; 674 675 auto_poll: entry (device); 676 677 auto = "1"b; 678 go to poll_join; 679 680 stop_auto_poll: entry; 681 682 line_ctl.op = STOP_AUTO_POLL; 683 line_ctl.val = 0; 684 go to retry_poll; 685 686 end poll; 687 688 /* This procedure is responsible for keeping output moving */ 689 690 send_more_output: proc; 691 692 dcl i fixed bin; 693 dcl moved fixed bin; 694 dcl 1 wstat aligned, 695 2 chan fixed bin (71), 696 2 pending bit (1); 697 698 check_output_status: 699 if ad.output_line_status ^= 0 then do; /* Error to handle first */ 700 if ad.output_in_progress then do; /* May be end of output */ 701 out_reqp = ad.cur_out_reqp; 702 if out_req.eot_sent then do; /* Done output */ 703 if ad.output_line_status = IBM3270_WACK_SELECT then do; /* Device busy, pend output */ 704 call pend_out_req; 705 ad.output_in_progress = "0"b; 706 ad.cur_out_reqp = null; 707 end; 708 else if ad.output_line_status = IBM3270_WACK_MESSAGE then do; /* Device is going to be busy */ 709 ad.output_in_progress = "0"b; 710 ad.cur_out_reqp = null; 711 i = out_req.device; 712 call free_out_req; /* Current output has completed ok */ 713 if ad.first_out_reqp (i) ^= null then do; /* If more, pend it - otherwise select will 714* just get wack */ 715 out_reqp = ad.first_out_reqp (i); 716 call pend_out_req; 717 end; 718 end; 719 else if ad.output_line_status = REVERSE_INTERRUPT then do; /* Device has status */ 720 i = out_req.device; 721 if ad.retry_limit > 0 then /* If we should give up eventually */ 722 if out_req.retry_count >= ad.retry_limit then /* And the time is now */ 723 call free_out_req; 724 else do; 725 out_req.retry_count = out_req.retry_count + 1; 726 call pend_out_req; 727 end; 728 else call pend_out_req; /* Retry forever */ 729 call queue_poll_req_first (i); /* Must poll this device first */ 730 ad.output_in_progress = "0"b; 731 ad.cur_out_reqp = null; 732 end; 733 else do; 734 if ad.output_line_status ^= IBM3270_WRITE_COMPLETE then 735 /* Inform user of other serious error before deleting data */ 736 call queue_error (out_req.device, (ad.output_line_status)); 737 ad.output_in_progress = "0"b; 738 ad.cur_out_reqp = null; 739 call free_out_req; 740 end; 741 end; 742 end; 743 ad.output_line_status = 0; 744 end; 745 746 if ^ad.output_in_progress then do; /* Not currently doing output */ 747 if ad.first_poll_reqp ^= null then return; /* If polling to do, don't do output */ 748 if ad.polling_in_progress then /* If polling specific device, dont write yet */ 749 if ad.last_device_polled ^= -1 then return; 750 call get_next_out_req; /* Find something to do */ 751 if ad.cur_out_reqp = null then return; 752 call select (out_req.device); /* Tell fnp who to talk to */ 753 if code ^= 0 then return; 754 out_req.eot_sent = "0"b; 755 out_req.sent_len = 0; 756 ad.output_in_progress = "1"b; 757 end; 758 out_reqp = ad.cur_out_reqp; /* Pickup current block */ 759 if out_req.eot_sent then return; 760 continue_output: 761 retry_write_status: 762 call hcs_$tty_order (ad.tty_index, "write_status", addr (wstat), state, code); 763 if code ^= 0 then do; 764 call check_error_code; /* Check for line status */ 765 if code ^= 0 then go to fatal_output_error; /* Something bad */ 766 if ad.output_line_status ^= 0 then go to check_output_status; /* Must process status */ 767 else go to retry_write_status; 768 end; 769 if wstat.pending then return; /* Cant take more now */ 770 if out_req.sent_len = out_req.out_msgl then do; /* Written all data */ 771 retry_eot: call hcs_$tty_write (ad.tty_index, addr (ad.eot), 0, 1, moved, state, code); 772 if code ^= 0 then do; 773 call check_error_code; 774 if code ^= 0 then go to fatal_output_error; 775 if ad.output_line_status ^= 0 then go to check_output_status; 776 else go to retry_eot; 777 end; 778 if moved = 1 then out_req.eot_sent = "1"b; /* Eot accepted */ 779 return; 780 end; 781 782 retry_write: call hcs_$tty_write (ad.tty_index, out_req.out_msgp, out_req.sent_len, 783 out_req.out_msgl - out_req.sent_len, moved, state, code); 784 if code ^= 0 then do; 785 call check_error_code; 786 if code ^= 0 then go to fatal_output_error; 787 if ad.output_line_status ^= 0 then go to check_output_status; 788 else go to retry_write; 789 end; 790 if moved = 0 then return; /* Can't take it now, try later */ 791 out_req.sent_len = out_req.sent_len + moved; /* Accumulate length sent */ 792 go to continue_output; /* Keep trying */ 793 794 fatal_output_error: 795 call queue_error (-1, code); 796 return; 797 798 end send_more_output; 799 800 /* Queue an output request */ 801 802 queue_out_req: proc; 803 804 dcl i fixed bin; 805 806 out_req.next_out_reqp = null; 807 out_req.eot_sent = "0"b; 808 out_req.req_time = clock; /* Remebr time queued */ 809 810 i = out_req.device; 811 if ad.first_out_reqp (i) = null then do; /* No other output for this device */ 812 ad.first_out_reqp (i), ad.last_out_reqp (i) = out_reqp; 813 ad.pend_time (i) = 0; 814 if ad.min_dev = -1 then /* No other devices have output queued */ 815 ad.min_dev, ad.max_dev = i; 816 else do; 817 ad.min_dev = min (i, ad.min_dev); 818 ad.max_dev = max (i, ad.max_dev); 819 end; 820 end; 821 else do; /* Thread on end */ 822 ad.last_out_reqp (i) -> out_req.next_out_reqp = out_reqp; 823 ad.last_out_reqp (i) = out_reqp; 824 end; 825 826 return; 827 828 end queue_out_req; 829 830 /* Procedure to pend the current output request */ 831 832 pend_out_req: proc; 833 834 dcl i fixed bin; 835 836 i = out_req.device; 837 ad.pend_time (i) = clock + ad.pend_interval; /* Time to retry */ 838 call schedule_timer; 839 out_reqp, ad.cur_out_reqp = null; 840 ad.output_in_progress = "0"b; 841 return; 842 843 end pend_out_req; 844 845 /* Procedure to select the next output request to perform. The oldest unpended request is used */ 846 847 get_next_out_req: proc; 848 849 dcl i fixed bin; 850 dcl j fixed bin init (-1); 851 dcl min_time fixed bin (71) init (10000000000000000000000000000000000000000000000000000b); /* 2**52 */ 852 853 ad.cur_out_reqp, out_reqp = null; /* Answer if nothing found */ 854 if ad.min_dev = -1 then return; /* Nothing queued */ 855 do i = ad.min_dev to ad.max_dev; 856 if (ad.first_out_reqp (i) ^= null) & (ad.pend_time (i) = 0) then do; 857 /* This device has unpended request */ 858 if ad.first_out_reqp (i) -> out_req.req_time < min_time then do; 859 min_time = ad.first_out_reqp (i) -> out_req.req_time; 860 j = i; /* Remebert index */ 861 end; 862 end; 863 end; 864 if j = -1 then return; /* All requests are pended */ 865 ad.cur_out_reqp, out_reqp = ad.first_out_reqp (j); 866 return; 867 868 end get_next_out_req; 869 870 /* Procedure to free an output request */ 871 872 free_out_req: proc; 873 874 dcl i fixed bin; 875 dcl (min_dev, max_dev) fixed bin; 876 877 i = out_req.device; 878 ad.first_out_reqp (i) = out_req.next_out_reqp; 879 if ad.first_out_reqp (i) = null then do; /* No more for this device */ 880 ad.last_out_reqp (i) = null; 881 if (i = ad.min_dev) | (i = ad.max_dev) then do; /* If request is for one of limits, must adjust */ 882 min_dev, max_dev = -1; 883 do i = ad.min_dev to ad.max_dev; 884 if ad.first_out_reqp (i) ^= null then do; 885 if min_dev = -1 then min_dev = i; 886 max_dev = i; 887 end; 888 end; 889 ad.min_dev = min_dev; 890 ad.max_dev = max_dev; 891 end; 892 end; 893 free out_msg; 894 free out_req; 895 return; 896 897 end free_out_req; 898 899 /* Schuduler error recovery timer */ 900 901 schedule_timer: proc; 902 903 call timer_manager_$alarm_wakeup (ad.pend_interval, "10"b, ad.timer_channel); 904 return; 905 906 end schedule_timer; 907 908 /* Procedure that is invoked on timer wakeups to unpend all output whose time has come */ 909 910 unpend_out_req: proc; 911 912 dcl req_pending bit (1) init ("0"b); /* Set if pended requests are found */ 913 dcl req_unpended bit (1) init ("0"b); /* Set if some output released */ 914 dcl now fixed bin (71); 915 dcl i fixed bin; 916 917 if ad.min_dev = -1 then return; 918 now = clock; 919 do i = ad.min_dev to ad.max_dev; 920 if (ad.first_out_reqp (i) ^= null) & (ad.pend_time (i) ^= 0) then do; 921 req_pending = "1"b; 922 if now >= ad.pend_time (i) then do; /* Found one */ 923 ad.pend_time (i) = 0; 924 req_unpended = "1"b; 925 end; 926 end; 927 end; 928 if req_unpended & ^ad.output_in_progress then call worker; /* Fire up output */ 929 if req_pending & ^req_unpended then call schedule_timer; 930 return; 931 932 end unpend_out_req; 933 934 /* Procedure to perform queued device polling */ 935 936 poll_more_devices: proc; 937 938 dcl i fixed bin; 939 940 if ad.output_in_progress then return; /* Must finish output first */ 941 942 if ad.first_poll_reqp ^= null then do; /* If there is request */ 943 if ad.polling_in_progress then do; /* Already polling */ 944 if ad.last_device_polled = -1 then call stop_auto_poll; /* Stop polling if general poll */ 945 return; /* Cant do more polling while polling in progress */ 946 end; 947 poll_reqp = ad.first_poll_reqp; /* Get firrst request */ 948 ad.first_poll_reqp = poll_req.next_poll_reqp; 949 if ad.first_poll_reqp = null then ad.last_poll_reqp = null; 950 i = poll_req.device; 951 free poll_req; /* Dont need this anymore */ 952 call poll (i); /* Poll indicated device */ 953 return; 954 end; 955 956 else if ^ad.polling_in_progress then /* If not polling */ 957 if ad.general_poll then call auto_poll (-1); /* Restart auto general poll */ 958 return; 959 960 end poll_more_devices; 961 962 /* Queue a poll request */ 963 964 queue_poll_req: proc (device); 965 966 dcl device fixed bin; 967 dcl first bit (1) init ("0"b); /* If set, entry goes to head of queue */ 968 969 queue_poll_join: 970 allocate poll_req in (work_area); 971 poll_req.next_poll_reqp = null; 972 poll_req.device = device; 973 974 if ad.first_poll_reqp = null then /* Only request in queue */ 975 ad.first_poll_reqp, ad.last_poll_reqp = poll_reqp; 976 else if first then do; /* Must queue at head */ 977 poll_req.next_poll_reqp = ad.first_poll_reqp; 978 ad.first_poll_reqp = poll_reqp; 979 end; 980 else do; /* Must queue at end */ 981 ad.last_poll_reqp -> poll_req.next_poll_reqp = poll_reqp; 982 ad.last_poll_reqp = poll_reqp; 983 end; 984 return; 985 986 queue_poll_req_first: entry (device); /* Satart here to put entry at head of queue */ 987 988 first = "1"b; 989 go to queue_poll_join; 990 991 end queue_poll_req; 992 993 /* Procedure to build the output data messages from the write_info structure */ 994 995 format_write_msg: proc; 996 997 dcl seq char (4); /* For short control sequences */ 998 dcl (i, j) fixed bin; 999 dcl ch char (1); 1000 dcl msg_len fixed bin; 1001 dcl bc char (j) based (addr (substr (output_buf, msg_len+1, 1))); 1002 1003 msg_len = 0; 1004 substr (seq, 1, 1) = ad.stx; /* Standard start */ 1005 call move_seq (1); 1006 1007 substr (seq, 1, 1) = ad.esc; /* Start command sequence */ 1008 unspec (ch) = "0"b || command_codes (write_info.command); 1009 substr (seq, 2, 1) = ch; 1010 if write_info.command = COPY then do; 1011 i = bin (substr (string (write_info.write_ctl_char.bits), 1, 4) || write_info.copy_bits); 1012 substr (seq, 3, 1) = ad.bit6_char (i); /* The copy control char */ 1013 substr (seq, 4, 1) = ad.bit6_char (write_info.from_device); 1014 call move_seq (4); 1015 go to end_format_write; 1016 end; 1017 if write_info.command = READ_BUFFER | write_info.command = READ_MODIFIED then do; 1018 call move_seq (2); /* No wcc for read type commands */ 1019 go to end_format_write; 1020 end; 1021 substr (seq, 3, 1) = ad.bit6_char (bin (string (write_info.write_ctl_char.bits))); 1022 call move_seq (3); /* Move esc-cmd-wcc */ 1023 1024 do i = 1 to write_info.mod_fields; /* Rest of message is per/field */ 1025 if write_info.set_buffer_addr (i) then do; 1026 substr (seq, 1, 1) = ad.sba; /* Set buffer address code */ 1027 substr (seq, 2, 2) = make_addr (write_info.field_position (i)); 1028 call move_seq (3); 1029 end; 1030 if write_info.start_field (i) then do; /* New fields */ 1031 substr (seq, 1, 1) = ad.sf; 1032 substr (seq, 2, 1) = ad.bit6_char (bin (string (write_info.attributes (i)))); 1033 call move_seq (2); 1034 end; 1035 if write_info.insert_cursor (i) then do; 1036 substr (seq, 1, 1) = ad.ic; 1037 call move_seq (1); 1038 end; 1039 if write_info.program_tab (i) then do; 1040 substr (seq, 1, 1) = ad.pt; 1041 call move_seq (1); 1042 end; 1043 if write_info.repeat_to_addr (i) then do; 1044 substr (seq, 1, 1) = ad.ra; /* Repeat to address code */ 1045 substr (seq, 2, 2) = make_addr (write_info.field_position (i)); 1046 if length (write_info.contents (i)) = 0 then substr (seq, 4, 1) = low (1); /* Default char */ 1047 else do; 1048 ch = substr (write_info.contents (i), 1, 1); 1049 if ^ad.ascii then call ibm3270_translate_$ascii_to_ebcdic (addr (ch), 1); 1050 substr (seq, 4, 1) = ch; 1051 end; 1052 call move_seq (4); 1053 end; 1054 if write_info.erase_to_addr (i) then do; 1055 substr (seq, 1, 1) = ad.eua; 1056 substr (seq, 2, 2) = make_addr (write_info.field_position (i)); 1057 call move_seq (3); 1058 end; 1059 j = length (write_info.contents (i)); 1060 if ^write_info.repeat_to_addr (i) & j > 0 then do; 1061 if j > (length (output_buf) - msg_len) then go to big_write_err; 1062 substr (output_buf, msg_len+1, j) = write_info.contents (i); 1063 if ^ad.ascii then call ibm3270_translate_$ascii_to_ebcdic (substraddr (output_buf, msg_len+1), j); 1064 msg_len = msg_len + j; 1065 end; 1066 end; 1067 1068 end_format_write: 1069 substr (seq, 1, 1) = ad.etx; 1070 call move_seq (1); 1071 1072 allocate out_req in (work_area); 1073 out_req.out_msgl = msg_len; 1074 allocate out_msg in (work_area); 1075 out_msg = substr (output_buf, 1, msg_len); /* Copy to smaller buffer */ 1076 out_req.req_time = 0; 1077 out_req.device = write_info.device; 1078 out_req.sent_len = 0; 1079 out_req.eot_sent = "0"b; 1080 out_req.req_time = 0; 1081 out_req.retry_count = 0; 1082 code = 0; 1083 1084 return; 1085 1086 big_write_err: 1087 code = error_table_$long_record; 1088 return; 1089 1090 /* Procedure to move short control sequqnces into the output stream. These cannot be split between data blocks */ 1091 1092 move_seq: proc (n); 1093 1094 dcl n fixed bin; 1095 1096 if n > (length (output_buf) - msg_len) then go to big_write_err; 1097 substr (output_buf, msg_len+1, n) = substr (seq, 1, n); 1098 msg_len = msg_len + n; 1099 return; 1100 1101 end move_seq; 1102 1103 end format_write_msg; 1104 1105 /* Build 2 character address from a position */ 1106 1107 make_addr: proc (pos) returns (char (2)); 1108 1109 dcl pos fixed bin; 1110 dcl (i, j) fixed bin; 1111 1112 i = divide (pos, 64, 17, 0); 1113 j = mod (pos, 64); 1114 return (ad.bit6_char (i) || ad.bit6_char (j)); 1115 1116 end make_addr; 1117 1118 /* This procedure checks errors on calls to the ring0 tty dim. If the error indicates that line 1119* status is present, it is picked up and classified according to whehter it affects input or output */ 1120 1121 check_error_code: proc; 1122 1123 if code ^= error_table_$line_status_pending then return; /* More serious error */ 1124 ad.polling_in_progress = "0"b; /* Any line status error stops polling */ 1125 call hcs_$tty_order (ad.tty_index, "line_status", addr (line_stat), state, code); /* Pick up status */ 1126 if code ^= 0 then return; /* Seriout error */ 1127 1128 if line_stat.op < lbound (line_stat_lab, 1) | line_stat.op > hbound (line_stat_lab, 1) then return; 1129 go to line_stat_lab (line_stat.op); 1130 1131 line_stat_lab (1): /* Input codes */ 1132 line_stat_lab (4): 1133 ad.input_line_status = line_stat.op; 1134 return; 1135 1136 line_stat_lab (2): /* Output codes */ 1137 line_stat_lab (3): 1138 line_stat_lab (6): 1139 line_stat_lab (7): 1140 line_stat_lab (8): 1141 line_stat_lab (9): 1142 line_stat_lab (10): 1143 line_stat_lab (11): 1144 line_stat_lab (12): 1145 ad.output_line_status = line_stat.op; 1146 return; 1147 1148 line_stat_lab (5): /* Codes to ignore */ 1149 return; 1150 1151 end check_error_code; 1152 1153 /* The following procedure queues up an error condition so the input reader will see it. */ 1154 /* This is done because the error may be detected by the event call handler who has no-one to tell. */ 1155 1156 queue_error: proc (device, code); 1157 1158 dcl device fixed bin; 1159 dcl code fixed bin (35); 1160 1161 call get_read_info (0, 0); 1162 read_info.device = device; 1163 read_info.code = code; 1164 read_info.key = ERROR; 1165 call queue_read_info; 1166 return; 1167 1168 end queue_error; 1169 1170 /* Builtin function substraddr until it is real */ 1171 1172 substraddr: proc (c, n) returns (ptr); 1173 1174 dcl c char (*); 1175 dcl n fixed bin; 1176 dcl ca (n) char (1) based (addr (c)); 1177 1178 return (addr (ca (n))); 1179 1180 end substraddr; 1181 1182 1183 end ibm3270_control_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/15/82 1506.4 ibm3270_control_.pl1 >dumps>old>recomp>ibm3270_control_.pl1 133 1 07/24/78 1704.7 ibm3270_attach_data.incl.pl1 >ldd>include>ibm3270_attach_data.incl.pl1 135 2 02/17/78 1339.8 ibm3270_io_info.incl.pl1 >ldd>include>ibm3270_io_info.incl.pl1 137 3 07/28/81 1333.4 iocb.incl.pl1 >ldd>include>iocb.incl.pl1 139 4 09/02/80 1523.7 bisync_line_data.incl.pl1 >ldd>include>bisync_line_data.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. COPY constant fixed bin(17,0) initial dcl 2-96 ref 1010 ERROR constant fixed bin(17,0) initial dcl 2-42 ref 1164 IBM3270_WACK_MESSAGE constant fixed bin(17,0) initial dcl 4-48 ref 708 IBM3270_WACK_SELECT constant fixed bin(17,0) initial dcl 4-48 ref 703 IBM3270_WRITE_COMPLETE constant fixed bin(17,0) initial dcl 4-48 ref 734 READ_BUFFER constant fixed bin(17,0) initial dcl 2-96 ref 1017 READ_MODIFIED constant fixed bin(17,0) initial dcl 2-96 ref 1017 REVERSE_INTERRUPT constant fixed bin(17,0) initial dcl 4-48 ref 719 SET_POLLING_ADDR constant fixed bin(17,0) initial dcl 4-20 ref 637 SET_SELECT_ADDR constant fixed bin(17,0) initial dcl 4-20 ref 636 START_POLL constant fixed bin(17,0) initial dcl 4-20 ref 654 663 STATUS constant fixed bin(17,0) initial dcl 2-42 ref 469 556 STOP_AUTO_POLL constant fixed bin(17,0) initial dcl 4-20 ref 682 TEST_REQ constant fixed bin(17,0) initial dcl 2-42 ref 478 actual_iocb_ptr 12 based pointer level 2 dcl 3-4 ref 146 ad based structure level 1 dcl 1-8 addr builtin function dcl 129 ref 150 202 202 202 202 254 271 367 367 370 370 404 404 407 407 589 592 593 638 639 639 640 640 641 641 657 657 760 760 771 771 1049 1049 1125 1125 1178 1178 address based structure level 2 packed unaligned dcl 58 adp 000144 automatic pointer dcl 1-6 set ref 147* 155 172 178 195 196 197 198 202 202 207 211 212 213 213 216 235 239 239 253* 255 259 259 259 259 270* 272 289 293 293 307 309 309 310 311 314 315 315 315 315 323 326 327 327 332 334 334 334 336 340 340 340 341 345 345 345 349 349 349 354 358 358 358 361 367 367 367 370 370 371 371 371 374 376 379 379 379 383 387 387 387 392 395 395 395 400 404 404 404 407 407 409 409 409 410 410 410 432 432 445 445 445 445 446 446 463 464 464 464 465 465 466 470 470 471 471 472 476 476 477 480 480 480 481 481 490 491 492 492 492 493 494 506 533 534 537 538 541 542 542 550 551 551 554 555 571 589 589 589 592 593 603 604 629 630 630 631 631 634 641 648 651 657 664 665 671 698 700 701 703 705 706 708 709 710 713 715 719 721 721 730 731 734 734 737 738 743 746 747 748 748 751 756 758 760 766 771 771 771 775 782 787 811 812 812 813 814 814 814 817 817 818 818 822 823 837 837 839 840 853 854 855 855 856 856 858 859 865 865 878 879 880 881 881 883 883 884 889 890 903 903 917 919 919 920 920 922 923 928 940 942 943 944 947 948 949 949 956 956 969 974 974 974 977 978 981 982 1004 1007 1012 1013 1021 1026 1031 1032 1036 1040 1044 1049 1055 1061 1061 1062 1062 1063 1063 1063 1063 1063 1063 1063 1068 1072 1074 1075 1075 1096 1096 1097 1097 1114 1114 1124 1125 1131 1136 aid 0(21) based bit(6) level 2 packed unaligned dcl 58 ref 534 aid_to_key 000032 constant fixed bin(8,0) initial array unaligned dcl 94 ref 535 aid_to_sub_key 000022 constant fixed bin(8,0) initial array unaligned dcl 98 ref 536 amt parameter fixed bin(17,0) dcl 443 ref 441 445 446 areap 2 based pointer level 2 dcl 2-10 set ref 216* arg_code parameter fixed bin(35,0) dcl 21 set ref 144 243* arg_event_call_infop parameter pointer dcl 22 ref 249 251 266 268 arg_info_ptr parameter pointer dcl 20 ref 144 149 arg_iocbp parameter pointer dcl 18 ref 144 146 arg_order parameter char unaligned dcl 19 ref 144 148 ascii 136 based bit(1) level 2 dcl 1-8 ref 374 464 480 1049 1063 async 137 based bit(1) level 2 dcl 1-8 ref 198 attach_data_ptr 16 based pointer level 2 dcl 3-4 ref 147 253 270 attributes 11(06) based structure array level 3 packed unaligned dcl 2-57 ref 1032 auto 000103 automatic bit(1) initial unaligned dcl 627 set ref 627* 656 677* auto_read_ctl 000120 automatic structure level 1 dcl 33 set ref 150 254 271 based_chan based fixed bin(71,0) dcl 46 set ref 155* bin builtin function dcl 129 ref 534 603 604 615 1011 1021 1032 bit6_char 154 based char(1) array level 2 packed unaligned dcl 1-8 ref 630 631 634 1012 1013 1021 1032 1114 1114 bits 5 based structure level 3 in structure "write_info" packed unaligned dcl 2-57 in procedure "ibm3270_control_" ref 1011 1021 bits 11 based bit(12) level 3 in structure "read_info" packed unaligned dcl 2-20 in procedure "ibm3270_control_" set ref 470* 471* 472 557* c parameter char(2) unaligned dcl 613 in procedure "get_position" ref 611 615 615 c parameter char unaligned dcl 1174 in procedure "substraddr" set ref 1172 1178 ca based char(1) array unaligned dcl 1176 set ref 1178 ch 000213 automatic char(1) unaligned dcl 999 set ref 1008* 1009 1048* 1049 1049 1050 cleanup 000000 stack reference condition dcl 131 ref 283 clock builtin function dcl 129 ref 808 837 918 close_in_progress 132 based bit(1) level 2 dcl 1-8 ref 255 272 code 10 based fixed bin(35,0) level 3 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" set ref 1163* code parameter fixed bin(35,0) dcl 1159 in procedure "queue_error" ref 1156 1163 code 000100 automatic fixed bin(35,0) dcl 26 in procedure "ibm3270_control_" set ref 156* 160* 165* 174* 180* 186* 192* 199* 202* 203 204* 215* 224* 228 231* 235* 236 238 243 259* 282* 283* 295* 315* 317 319 320* 641* 642 644 657* 658 660 753 760* 763 765 771* 772 774 782* 784 786 794* 1082* 1086* 1123 1125* 1126 command 4 based fixed bin(17,0) level 2 dcl 2-57 ref 1008 1010 1017 1017 command_codes 000020 constant bit(8) initial array unaligned dcl 104 ref 1008 contents 13 based varying char array level 3 in structure "write_info" dcl 2-57 in procedure "ibm3270_control_" ref 1046 1048 1059 1062 contents 17 based varying char array level 3 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" set ref 481* 498* 526* controller 4 based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" set ref 554* 574* 603* controller 130 based fixed bin(17,0) level 2 in structure "ad" dcl 1-8 in procedure "ibm3270_control_" ref 554 630 631 controller 0(03) based bit(6) level 3 in structure "msg" packed unaligned dcl 58 in procedure "ibm3270_control_" ref 603 controller_char 000100 automatic char(1) unaligned dcl 624 set ref 630* 631* 639 convert_ipc_code_ 000024 constant entry external dcl 115 ref 204 copy_bits 5(06) based bit(2) level 3 packed unaligned dcl 2-57 ref 1011 cur_out_reqp 236 based pointer level 2 dcl 1-8 set ref 701 706* 710* 731* 738* 751 758 839* 853* 865* cursor 0(27) based char(2) level 2 packed unaligned dcl 58 set ref 538* cursor_position 12 based fixed bin(17,0) level 2 dcl 2-20 set ref 538* 578* data 11 based structure array level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_control_" data 0(09) based char(5) level 2 in structure "valchar" packed unaligned dcl 4-13 in procedure "ibm3270_control_" set ref 639* 639* 640* 640* data based structure level 1 dcl 424 in procedure "move_data" data 16 based structure array level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" data_buf_len 2 based fixed bin(17,0) level 2 dcl 424 ref 431 432 data_buf_ptr based pointer level 2 dcl 424 ref 432 data_chars based char unaligned dcl 429 set ref 432* data_len based fixed bin(9,0) level 2 in structure "valchar" packed unsigned unaligned dcl 4-13 in procedure "ibm3270_control_" set ref 638* data_len 3 based fixed bin(17,0) level 2 in structure "data" dcl 424 in procedure "move_data" set ref 431 432 434* 434 data_ptr 6 based pointer level 2 dcl 49 ref 252 269 device 5 based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" set ref 472 555* 575* 604* 1162* device 2 based fixed bin(17,0) level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_control_" ref 223 223 1077 device parameter fixed bin(17,0) dcl 966 in procedure "queue_poll_req" ref 964 972 986 device parameter fixed bin(17,0) dcl 1158 in procedure "queue_error" ref 1156 1162 device 2 based fixed bin(17,0) level 2 in structure "poll_req" dcl 84 in procedure "ibm3270_control_" set ref 950 972* device 0(12) based bit(6) level 3 in structure "msg" packed unaligned dcl 58 in procedure "ibm3270_control_" ref 604 device parameter fixed bin(17,0) dcl 623 in procedure "poll" ref 621 629 632 634 648 651 669 671 675 device 10 based fixed bin(17,0) level 2 in structure "out_req" dcl 70 in procedure "ibm3270_control_" set ref 711 720 734* 752* 810 836 877 1077* device_char 000101 automatic char(1) unaligned dcl 625 set ref 632* 634* 640 device_responded 224 based bit(1) level 2 dcl 1-8 set ref 541* 551 665* divide builtin function dcl 129 ref 1112 eot 140 based char(1) level 2 dcl 1-8 set ref 345 771 771 eot_sent 12 based bit(1) level 2 dcl 70 set ref 702 754* 759 778* 807* 1079* erase_to_addr 11(05) based bit(1) array level 4 packed unaligned dcl 2-57 ref 1054 error_table_$bad_arg 000040 external static fixed bin(35,0) dcl 122 ref 224 error_table_$line_status_pending 000050 external static fixed bin(35,0) dcl 126 ref 1123 error_table_$long_record 000052 external static fixed bin(35,0) dcl 127 ref 1086 error_table_$no_operation 000042 external static fixed bin(35,0) dcl 123 ref 165 error_table_$request_pending 000044 external static fixed bin(35,0) dcl 124 ref 199 error_table_$unimplemented_version 000046 external static fixed bin(35,0) dcl 125 ref 192 esc 145 based char(1) level 2 dcl 1-8 ref 1007 etb 143 based char(1) level 2 dcl 1-8 ref 358 387 410 etx 142 based char(1) level 2 dcl 1-8 ref 349 371 379 409 1068 eua 153 based char(1) level 2 dcl 1-8 ref 1055 event_call_info based structure level 1 dcl 49 event_call_infop 000116 automatic pointer dcl 31 set ref 251* 252 268* 269 event_info 000130 automatic structure level 1 dcl 35 set ref 202 202 field_position 12 based fixed bin(17,0) array level 3 in structure "write_info" dcl 2-57 in procedure "ibm3270_control_" set ref 1027* 1045* 1056* field_position 16 based fixed bin(17,0) array level 3 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" set ref 482* 496* 520* first 000100 automatic bit(1) initial unaligned dcl 967 set ref 967* 976 988* first_out_reqp 242 based pointer array level 3 dcl 1-8 set ref 713 715 811 812* 856 858 859 865 878* 879 884 920 first_poll_reqp 226 based pointer level 2 dcl 1-8 set ref 747 942 947 948* 949 974 974* 977 978* first_read_infop 174 based pointer level 2 dcl 1-8 set ref 195 196 211 212* 213 259 589 589* fldi 000144 automatic fixed bin(17,0) array dcl 456 set ref 509* 520 520 524 524 525 526 from_device 3 based fixed bin(17,0) level 2 dcl 2-57 ref 1013 general_poll 225 based bit(1) level 2 dcl 1-8 set ref 172* 178* 956 hbound builtin function dcl 129 ref 1128 hcs_$tty_order 000012 constant entry external dcl 110 ref 235 641 657 760 1125 hcs_$tty_read 000010 constant entry external dcl 109 ref 315 hcs_$tty_write 000014 constant entry external dcl 111 ref 771 782 hcs_$wakeup 000026 constant entry external dcl 116 ref 259 header_buf_ptr 200 based pointer level 3 dcl 1-8 set ref 464* 465 476 header_data based char unaligned dcl 1-81 in procedure "ibm3270_control_" ref 465 476 header_data 200 based structure level 2 in structure "ad" dcl 1-8 in procedure "ibm3270_control_" set ref 404 404 407 407 header_len 203 based fixed bin(17,0) level 3 dcl 1-8 set ref 463 464* 465 476 542* i 000672 automatic fixed bin(17,0) dcl 938 in procedure "poll_more_devices" set ref 950* 952* i 000211 automatic fixed bin(17,0) dcl 998 in procedure "format_write_msg" set ref 1011* 1012 1024* 1025 1027 1030 1032 1035 1039 1043 1045 1046 1048 1054 1056 1059 1060 1062* i 000660 automatic fixed bin(17,0) dcl 874 in procedure "free_out_req" set ref 877* 878 879 880 881 881 883* 884 885 886* i 000634 automatic fixed bin(17,0) dcl 834 in procedure "pend_out_req" set ref 836* 837 i 000124 automatic fixed bin(17,0) dcl 420 in procedure "move_data" set ref 431* 432 432 432 434 i 000114 automatic fixed bin(17,0) dcl 305 in procedure "scan_more_input" set ref 349* 351 364 364* 365* 365 366 370 379* 381 388 388* 389* 389 390 396 396* 397* 397 398 403 407 408* i 000142 automatic fixed bin(17,0) dcl 455 in procedure "process_input" set ref 504* 505 506 509 510* 510 514 515* 519* 520 520 520* 523* 524 524 524 525 526 526* 534* 535 536 i 000164 automatic fixed bin(17,0) dcl 804 in procedure "queue_out_req" set ref 810* 811 812 812 813 814 817 818 822 823 i 000644 automatic fixed bin(17,0) dcl 849 in procedure "get_next_out_req" set ref 855* 856 856 858 859 860* i 000232 automatic fixed bin(17,0) dcl 1110 in procedure "make_addr" set ref 1112* 1114 i 000200 automatic fixed bin(17,0) dcl 915 in procedure "unpend_out_req" set ref 919* 920 920 922 923* i 000620 automatic fixed bin(17,0) dcl 692 in procedure "send_more_output" set ref 711* 713 715 720* 729* ibm3270_io_call_ 000030 constant entry external dcl 117 ref 160 ibm3270_translate_$ascii_to_ebcdic 000016 constant entry external dcl 112 ref 1049 1063 ibm3270_translate_$ebcdic_to_ascii 000020 constant entry external dcl 113 ref 464 480 497 522 ic 150 based char(1) level 2 dcl 1-8 ref 1036 index builtin function dcl 129 ref 349 358 379 387 395 506 info_ptr 000112 automatic pointer dcl 29 set ref 149* 155 160* 184 190 210 222 235* input_buf_len 212 based fixed bin(17,0) level 2 dcl 1-8 set ref 315* input_buf_ptr 210 based pointer level 2 dcl 1-8 set ref 315* 327 input_line_status 547 based fixed bin(17,0) level 2 dcl 1-8 set ref 239 289 293 307 309 310* 323 1131* input_state 217 based fixed bin(17,0) level 2 dcl 1-8 set ref 332 336* 341* 354* 361* 376* 383* 392* 400* insert_cursor 11(02) based bit(1) array level 4 packed unaligned dcl 2-57 ref 1035 iocb based structure level 1 dcl 3-4 iocbp 000114 automatic pointer dcl 30 set ref 146* 147 160* 164 252* 253 269* 270 ipc_$block 000022 constant entry external dcl 114 ref 202 ipc_$mask_ev_calls 000032 constant entry external dcl 118 ref 282 ipc_$unmask_ev_calls 000034 constant entry external dcl 119 ref 283 295 j 000645 automatic fixed bin(17,0) initial dcl 850 in procedure "get_next_out_req" set ref 850* 860* 864 865 j 000115 automatic fixed bin(17,0) dcl 305 in procedure "scan_more_input" set ref 358* 359 364 365 365 387* 388 389 389 395* 396 397 397 j 000212 automatic fixed bin(17,0) dcl 998 in procedure "format_write_msg" set ref 1059* 1060 1061 1062 1063* 1064 j 000143 automatic fixed bin(17,0) dcl 455 in procedure "process_input" set ref 506* 507 509 510 511 524* 525* 526 j 000233 automatic fixed bin(17,0) dcl 1110 in procedure "make_addr" set ref 1113* 1114 key 6 based fixed bin(17,0) level 3 dcl 2-20 set ref 469* 478* 535* 556* 1164* last_device_polled 233 based fixed bin(17,0) level 2 dcl 1-8 set ref 309* 551 555 629 651* 748 944 last_device_selected 234 based fixed bin(17,0) level 2 dcl 1-8 set ref 648* 671 last_out_reqp 244 based pointer array level 3 dcl 1-8 set ref 812* 822 823* 880* last_poll_reqp 230 based pointer level 2 dcl 1-8 set ref 949* 974* 981 982* last_read_infop 176 based pointer level 2 dcl 1-8 set ref 213* 589* 592 593* lbound builtin function dcl 129 ref 1128 length builtin function dcl 129 ref 1046 1059 1061 1096 line_ctl 000152 automatic structure level 1 dcl 4-9 set ref 641 641 657 657 line_stat 000154 automatic structure level 1 dcl 4-41 set ref 1125 1125 low builtin function dcl 129 ref 1046 max builtin function dcl 129 ref 511 514 818 max_dev 543 based fixed bin(17,0) level 2 in structure "ad" dcl 1-8 in procedure "ibm3270_control_" set ref 814* 818* 818 855 881 883 890* 919 max_dev 000662 automatic fixed bin(17,0) dcl 875 in procedure "free_out_req" set ref 882* 886* 890 max_fields parameter fixed bin(17,0) dcl 567 in procedure "get_read_info" ref 565 569 max_fields 13 based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" set ref 218 571* max_fields 7 based fixed bin(17,0) level 2 in structure "read_ctl" dcl 2-10 in procedure "ibm3270_control_" set ref 218* 569* 571 571 max_fldl 000545 automatic fixed bin(17,0) dcl 458 set ref 503* 511* 511 514* 514 518* max_len 6 based fixed bin(17,0) level 2 in structure "read_ctl" dcl 2-10 in procedure "ibm3270_control_" set ref 217* 570* 571 571 max_len 7 based fixed bin(17,0) level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_control_" ref 1025 1025 1027 1027 1030 1030 1032 1032 1035 1035 1039 1039 1043 1043 1045 1045 1046 1046 1048 1048 1054 1054 1056 1056 1059 1059 1060 1060 1062 1062 max_len parameter fixed bin(17,0) dcl 567 in procedure "get_read_info" ref 565 570 max_len 14 based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" set ref 217 481 481 481 482 482 496 496 498 498 498 520 520 526 526 526 571* min builtin function dcl 129 ref 365 389 397 431 817 min_dev 000661 automatic fixed bin(17,0) dcl 875 in procedure "free_out_req" set ref 882* 885 885* 889 min_dev 542 based fixed bin(17,0) level 2 in structure "ad" dcl 1-8 in procedure "ibm3270_control_" set ref 814 814* 817* 817 854 855 881 883 889* 917 919 min_time 000646 automatic fixed bin(71,0) initial dcl 851 set ref 851* 858 859* mod builtin function dcl 129 ref 1113 mod_fields 15 based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" set ref 479* 499* 528* 579* mod_fields 10 based fixed bin(17,0) level 2 in structure "write_info" dcl 2-57 in procedure "ibm3270_control_" ref 1024 moved 000621 automatic fixed bin(17,0) dcl 693 set ref 771* 778 782* 790 791 msg based structure level 1 packed unaligned dcl 58 msg_len 000214 automatic fixed bin(17,0) dcl 1000 set ref 1003* 1061 1062 1063 1063 1064* 1064 1073 1075 1096 1097 1098* 1098 n parameter fixed bin(17,0) dcl 1175 in procedure "substraddr" ref 1172 1178 n parameter fixed bin(17,0) dcl 1094 in procedure "move_seq" ref 1092 1096 1097 1097 1098 n parameter fixed bin(17,0) dcl 421 in procedure "move_data" set ref 418 431 433* next_out_reqp based pointer level 2 dcl 70 set ref 806* 822* 878 next_poll_reqp based pointer level 2 dcl 84 set ref 948 971* 977* 981* next_read_infop 2 based pointer level 2 dcl 2-20 set ref 212 214* 573* 588* 592* nf 000544 automatic fixed bin(17,0) dcl 457 set ref 502* 505 508* 508 509 518* 519 523 524 528 now 000176 automatic fixed bin(71,0) dcl 914 set ref 918* 922 null builtin function dcl 129 ref 164 195 196 213 213 214 259 573 588 589 706 710 713 731 738 747 751 806 811 839 853 856 879 880 884 920 942 949 949 971 974 op 000152 automatic fixed bin(17,0) level 2 in structure "line_ctl" packed unaligned dcl 4-9 in procedure "ibm3270_control_" set ref 636* 637* 654* 663 682* op 000154 automatic fixed bin(17,0) level 2 in structure "line_stat" packed unaligned dcl 4-41 in procedure "ibm3270_control_" set ref 1128 1128 1129 1131 1136 open_descrip_ptr 20 based pointer level 2 dcl 3-4 ref 164 order 000102 automatic char(32) unaligned dcl 28 set ref 148* 154 159 171 177 183 189 221 235* orders 11 based structure array level 3 packed unaligned dcl 2-57 out_msg based char unaligned dcl 80 set ref 893 1074 1075* out_msgl 4 based fixed bin(17,0) level 2 dcl 70 set ref 770 782 893 893 1073* 1074 1074 1075 out_msgp 2 based pointer level 2 dcl 70 set ref 782* 893 1074* 1075 out_req based structure level 1 dcl 70 set ref 894 1072 out_reqp 000140 automatic pointer dcl 68 set ref 701* 702 711 715* 720 721 725 725 734 752 754 755 758* 759 770 770 778 782 782 782 782 791 791 806 807 808 810 812 822 823 836 839* 853* 865* 877 878 893 893 893 894 1072* 1073 1074 1074 1074 1075 1075 1076 1077 1078 1079 1080 1081 output_buf based char unaligned dcl 1-86 set ref 1061 1062* 1063* 1063* 1075 1096 1097* output_buf_len 222 based fixed bin(17,0) level 2 dcl 1-8 ref 1061 1062 1063 1063 1063 1063 1075 1096 1097 output_buf_ptr 220 based pointer level 2 dcl 1-8 ref 1061 1062 1063 1063 1075 1096 1097 output_in_progress 240 based bit(1) level 2 dcl 1-8 set ref 700 705* 709* 730* 737* 746 756* 840* 928 940 output_line_status 550 based fixed bin(17,0) level 2 dcl 1-8 set ref 239 293 698 703 708 719 734 734 743* 766 775 787 1136* p parameter pointer dcl 422 ref 418 431 431 432 432 432 434 434 pend_interval 544 based fixed bin(71,0) level 2 dcl 1-8 set ref 837 903* pend_time 246 based fixed bin(71,0) array level 3 dcl 1-8 set ref 472* 813* 837* 856 920 922 923* pending 2 000622 automatic bit(1) level 2 dcl 694 set ref 769 per_dev 242 based structure array level 2 dcl 1-8 poll_device based fixed bin(17,0) dcl 47 set ref 184* poll_req based structure level 1 dcl 84 set ref 951 969 poll_reqp 000142 automatic pointer dcl 82 set ref 947* 948 950 951 969* 971 972 974 977 978 981 982 polling_in_progress 223 based bit(1) level 2 dcl 1-8 set ref 311* 550* 664* 748 943 956 1124* pos parameter fixed bin(17,0) dcl 1109 ref 1107 1112 1113 processid 551 based bit(36) level 2 dcl 1-8 set ref 259* program_tab 11(03) based bit(1) array level 4 packed unaligned dcl 2-57 ref 1039 pt 151 based char(1) level 2 dcl 1-8 ref 1040 ra 152 based char(1) level 2 dcl 1-8 ref 1044 read_ctl based structure level 1 dcl 2-10 read_ctlp 000146 automatic pointer dcl 2-8 set ref 150* 190* 191 210* 211 212 214 216 217 217 218 218 254* 271* 469 470 471 472 472 478 479 481 482 496 498 499 520 526 528 535 536 538 554 555 556 557 569 570 571 571 571 571 571 572 573 574 575 576 577 578 579 588 589 592 593 603 604 1162 1163 1164 read_info based structure level 1 dcl 2-20 set ref 571 589 592 593 read_infop 4 based pointer level 2 dcl 2-10 set ref 211* 212 214 217 218 469 470 471 472 472 478 479 481 482 496 498 499 520 526 528 535 536 538 554 555 556 557 571* 572 573 574 575 576 577 578 579 588 589 592 593 603 604 1162 1163 1164 reason 6 based structure level 2 dcl 2-20 set ref 576* repeat_to_addr 11(04) based bit(1) array level 4 packed unaligned dcl 2-57 ref 1043 1060 req_pending 000174 automatic bit(1) initial unaligned dcl 912 set ref 912* 921* 929 req_time 6 based fixed bin(71,0) level 2 dcl 70 set ref 808* 858 859 1076* 1080* req_unpended 000175 automatic bit(1) initial unaligned dcl 913 set ref 913* 924* 928 929 retry_count 11 based fixed bin(17,0) level 2 dcl 70 set ref 721 725* 725 1081* retry_limit 546 based fixed bin(17,0) level 2 dcl 1-8 ref 721 721 sba 147 based char(1) level 2 dcl 1-8 ref 494 506 1026 scan_data based char unaligned dcl 461 ref 494 498 506 520 520 526 scanl 000550 automatic fixed bin(17,0) dcl 460 set ref 493* 494 495* 497* 498 505 506 514 515 520 520 522* 525 526 scanp 000546 automatic pointer dcl 459 set ref 492* 494 497* 498 506 520 520 522* 526 select_sw 000102 automatic bit(1) initial unaligned dcl 626 set ref 626* 630 636 647 672* sent_len 5 based fixed bin(17,0) level 2 dcl 70 set ref 755* 770 782* 782 791* 791 1078* seq 000210 automatic char(4) unaligned dcl 997 set ref 1004* 1007* 1009* 1012* 1013* 1021* 1026* 1027* 1031* 1032* 1036* 1040* 1044* 1045* 1046* 1050* 1055* 1056* 1068* 1097 set_buffer_addr 11 based bit(1) array level 4 packed unaligned dcl 2-57 ref 1025 sf 146 based char(1) level 2 dcl 1-8 ref 1031 soh 144 based char(1) level 2 dcl 1-8 ref 340 start_field 11(01) based bit(1) array level 4 packed unaligned dcl 2-57 ref 1030 state 000101 automatic fixed bin(17,0) dcl 27 set ref 235* 315* 641* 657* 760* 771* 782* 1125* status 11 based structure level 2 dcl 2-20 set ref 577* string builtin function dcl 129 ref 1011 1021 1032 stx 141 based char(1) level 2 dcl 1-8 ref 334 395 1004 sub_key 7 based fixed bin(17,0) level 3 dcl 2-20 set ref 536* substr builtin function dcl 129 set ref 334 340 345 371 409 410 432* 432 470* 470 470 471* 471 471 494 506 520 520 526 534 615 615 639* 639* 640* 640* 1004* 1007* 1009* 1011 1012* 1013* 1021* 1026* 1027* 1031* 1032* 1036* 1040* 1044* 1045* 1046* 1048 1050* 1055* 1056* 1062* 1068* 1075 1097* 1097 text_buf_ptr 204 based pointer level 3 dcl 1-8 set ref 470 471 480* 481 492 534 538 603 604 text_data based char unaligned dcl 1-83 in procedure "ibm3270_control_" set ref 470 471 481 492* text_data 204 based structure level 2 in structure "ad" dcl 1-8 in procedure "ibm3270_control_" set ref 367 367 370 370 text_len 207 based fixed bin(17,0) level 3 dcl 1-8 set ref 466 470 471 477* 480* 481 490 491 492 492 493 533 537 542* timer_channel 126 based fixed bin(71,0) level 2 dcl 1-8 set ref 903* timer_manager_$alarm_wakeup 000036 constant entry external dcl 120 ref 903 tty_index 4 based fixed bin(17,0) level 2 dcl 1-8 set ref 235* 315* 641* 657* 760* 771* 782* 1125* unscanned_data based char unaligned dcl 1-85 set ref 334 340 345 349 358 371 379 387 395 409 410 432 445* unscanned_data_len 216 based fixed bin(17,0) level 2 dcl 1-8 set ref 314 315* 326 334 340 345 349 358 367* 371 379 387 395 404* 409 410 432 445 445 446* 446 unscanned_data_ptr 214 based pointer level 2 dcl 1-8 set ref 327* 334 340 345 349 358 371 379 387 395 409 410 432 445* 445 unspec builtin function dcl 129 set ref 470 471 615 615 632* 1008* user_channel 120 based fixed bin(71,0) level 3 dcl 1-8 set ref 155 259* val 0(18) 000152 automatic fixed bin(17,0) array level 2 packed unaligned dcl 4-9 set ref 638 639 639 640 640 655* 656* 683* valchar based structure level 1 packed unaligned dcl 4-13 version based fixed bin(17,0) level 2 in structure "read_info" dcl 2-20 in procedure "ibm3270_control_" set ref 572* version based fixed bin(17,0) level 2 in structure "read_ctl" dcl 2-10 in procedure "ibm3270_control_" ref 191 wait_list 116 based structure level 2 dcl 1-8 set ref 202 202 wakeup_needed 232 based bit(1) level 2 dcl 1-8 set ref 197* 207* 259 work_area based area(1024) dcl 1-79 ref 571 969 1072 1074 work_areap based pointer level 2 dcl 1-8 ref 216 571 969 1072 1074 write_ctl_char 5 based structure level 2 dcl 2-57 write_info based structure level 1 dcl 2-57 write_infop 000150 automatic pointer dcl 2-53 set ref 222* 223 223 1008 1010 1011 1011 1013 1017 1017 1021 1024 1025 1027 1030 1032 1035 1039 1043 1045 1046 1048 1054 1056 1059 1060 1062 1077 wstat 000622 automatic structure level 1 dcl 694 set ref 760 760 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACCEPT_BID internal static fixed bin(17,0) initial dcl 4-20 BAD_BLOCK internal static fixed bin(17,0) initial dcl 4-48 BID_FAILED internal static fixed bin(17,0) initial dcl 4-48 CLEAR internal static fixed bin(17,0) initial dcl 2-42 CONFIGURE internal static fixed bin(17,0) initial dcl 4-20 ENTER internal static fixed bin(17,0) initial dcl 2-42 ERASE_UNPROTECTED internal static fixed bin(17,0) initial dcl 2-96 ERASE_WRITE internal static fixed bin(17,0) initial dcl 2-96 FNP_WRITE_STATUS internal static fixed bin(17,0) initial dcl 4-48 HASP_INIT_COMPLETE internal static fixed bin(17,0) initial dcl 4-48 IBM3270_NAK_OUTPUT internal static fixed bin(17,0) initial dcl 4-48 IBM3270_SELECT_FAILED internal static fixed bin(17,0) initial dcl 4-48 IBM3270_WRITE_ABORT internal static fixed bin(17,0) initial dcl 4-48 IBM3270_WRITE_EOT internal static fixed bin(17,0) initial dcl 4-48 ID_READER internal static fixed bin(17,0) initial dcl 2-42 LIGHT_PEN internal static fixed bin(17,0) initial dcl 2-42 PA_KEY internal static fixed bin(17,0) initial dcl 2-42 PF_KEY internal static fixed bin(17,0) initial dcl 2-42 REPORT_WRITE_STATUS internal static fixed bin(17,0) initial dcl 4-20 SET_3270_MODE internal static fixed bin(17,0) initial dcl 4-20 SET_BID_LIMIT internal static fixed bin(17,0) initial dcl 4-20 SET_HASP_MODE internal static fixed bin(17,0) initial dcl 4-20 SET_HASP_TIMERS internal static fixed bin(17,0) initial dcl 4-20 SET_MASTER_SLAVE_MODE internal static fixed bin(17,0) initial dcl 4-20 SET_NAK_LIMIT internal static fixed bin(17,0) initial dcl 4-20 SET_TTD_PARAMS internal static fixed bin(17,0) initial dcl 4-20 TOO_MANY_NAKS internal static fixed bin(17,0) initial dcl 4-48 WRITE internal static fixed bin(17,0) initial dcl 2-96 addrel builtin function dcl 129 address_mapping internal static bit(8) initial array unaligned dcl 1-93 bc based char unaligned dcl 1001 header_buf based char unaligned dcl 1-80 input_buf based char unaligned dcl 1-84 iox_$iocb_version_sentinel external static char(4) dcl 3-43 max_write_fields automatic fixed bin(17,0) dcl 2-54 max_write_len automatic fixed bin(17,0) dcl 2-55 text_buf based char unaligned dcl 1-82 NAMES DECLARED BY EXPLICIT CONTEXT. advance_unscanned_data 001466 constant entry internal dcl 441 ref 337 342 346 352 360 374 382 391 399 433 auto_poll 003053 constant entry internal dcl 675 ref 956 big_write_err 005133 constant label dcl 1086 ref 1061 1096 check_error_code 005213 constant entry internal dcl 1121 ref 237 318 643 659 764 773 785 check_input_status 000726 constant label dcl 307 ref 323 check_output_status 003114 constant label dcl 698 ref 766 775 787 continue_output 003321 constant label dcl 760 ref 792 control 000132 constant entry external dcl 144 control_return 000526 constant label dcl 243 ref 157 161 166 193 200 205 225 228 238 end_format_write 005061 constant label dcl 1068 ref 1015 1019 extract_address 002456 constant entry internal dcl 601 ref 468 532 fatal_output_error 003546 constant label dcl 794 ref 765 774 786 format_write_msg 004343 constant entry internal dcl 995 ref 227 free_out_req 003751 constant entry internal dcl 872 ref 712 721 739 get_data 000000 constant label array(4) dcl 334 ref 332 get_data_2a 001117 constant label dcl 352 ref 371 get_data_2b 001144 constant label dcl 360 ref 372 get_data_4a 001253 constant label dcl 382 ref 409 get_data_4b 001314 constant label dcl 391 ref 410 get_data_4c 001354 constant label dcl 399 ref 411 get_more_data 000747 constant label dcl 314 ref 338 343 347 355 362 368 377 385 393 401 405 get_next_out_req 003664 constant entry internal dcl 847 ref 750 get_position 002501 constant entry internal dcl 611 ref 520 538 get_read_info 002354 constant entry internal dcl 565 ref 467 477 495 518 531 553 1161 ibm3270_control_ 000117 constant entry external dcl 14 line_stat_lab 000004 constant label array(12) dcl 1131 ref 1128 1128 1129 make_addr 005157 constant entry internal dcl 1107 ref 1027 1045 1056 move_data 001426 constant entry internal dcl 418 ref 367 370 404 407 move_seq 005137 constant entry internal dcl 1092 ref 1005 1014 1018 1022 1028 1033 1037 1041 1052 1057 1070 pend_out_req 003634 constant entry internal dcl 832 ref 704 716 726 728 poll 002526 constant entry internal dcl 621 ref 952 poll_join 002534 constant label dcl 629 ref 678 poll_more_devices 004167 constant entry internal dcl 936 ref 291 process_eot 002322 constant entry internal dcl 548 ref 345 process_input 001527 constant entry internal dcl 453 ref 353 384 process_input_end 002315 constant label dcl 542 ref 466 485 490 queue_error 005313 constant entry internal dcl 1156 ref 309 320 734 794 queue_out_req 003561 constant entry internal dcl 802 ref 229 queue_poll_join 004273 constant label dcl 969 ref 989 queue_poll_req 004265 constant entry internal dcl 964 ref 184 queue_poll_req_first 004332 constant entry internal dcl 986 ref 729 queue_read_info 002431 constant entry internal dcl 586 ref 539 558 1165 queue_standard 002310 constant label dcl 539 ref 474 483 533 537 retry_addr 002633 constant label dcl 641 ref 644 retry_eot 003410 constant label dcl 771 ref 776 retry_order 000453 constant label dcl 235 ref 240 retry_poll 002745 constant label dcl 657 ref 660 684 retry_read 000753 constant label dcl 315 ref 324 retry_write 003470 constant label dcl 782 ref 788 retry_write_status 003321 constant label dcl 760 ref 767 scan_more_input 000725 constant entry internal dcl 303 ref 284 schedule_timer 004052 constant entry internal dcl 901 ref 838 929 select 003033 constant entry internal dcl 669 ref 752 select_join 002542 constant label dcl 630 ref 673 send_more_output 003113 constant entry internal dcl 690 ref 287 stop_auto_poll 003065 constant entry internal dcl 680 ref 179 944 substraddr 005336 constant entry internal dcl 1172 ref 445 492 1063 1063 timer_handler 000613 constant entry external dcl 266 unpend_out_req 004076 constant entry internal dcl 910 ref 274 wakeup_handler 000535 constant entry external dcl 249 worker 000637 constant entry internal dcl 280 ref 173 185 195 230 239 257 928 worker_loop 000700 constant label dcl 284 ref 289 293 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 6056 6132 5463 6066 Length 6454 5463 54 306 372 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ibm3270_control_ 227 external procedure is an external procedure. worker 599 internal procedure enables or reverts conditions. on unit on line 283 68 on unit scan_more_input internal procedure shares stack frame of internal procedure worker. move_data internal procedure shares stack frame of internal procedure worker. advance_unscanned_data internal procedure shares stack frame of internal procedure worker. process_input internal procedure shares stack frame of internal procedure worker. process_eot internal procedure shares stack frame of internal procedure worker. get_read_info internal procedure shares stack frame of internal procedure worker. queue_read_info internal procedure shares stack frame of internal procedure worker. extract_address internal procedure shares stack frame of internal procedure worker. get_position internal procedure shares stack frame of internal procedure worker. poll 100 internal procedure is called by several nonquick procedures. send_more_output internal procedure shares stack frame of internal procedure worker. queue_out_req internal procedure shares stack frame of external procedure ibm3270_control_. pend_out_req internal procedure shares stack frame of internal procedure worker. get_next_out_req internal procedure shares stack frame of internal procedure worker. free_out_req internal procedure shares stack frame of internal procedure worker. schedule_timer 74 internal procedure is called by several nonquick procedures. unpend_out_req internal procedure shares stack frame of external procedure ibm3270_control_. poll_more_devices internal procedure shares stack frame of internal procedure worker. queue_poll_req 68 internal procedure is called by several nonquick procedures. format_write_msg internal procedure shares stack frame of external procedure ibm3270_control_. move_seq internal procedure shares stack frame of external procedure ibm3270_control_. make_addr internal procedure shares stack frame of external procedure ibm3270_control_. check_error_code 92 internal procedure is called by several nonquick procedures. queue_error internal procedure shares stack frame of internal procedure worker. substraddr 68 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ibm3270_control_ 000100 code ibm3270_control_ 000101 state ibm3270_control_ 000102 order ibm3270_control_ 000112 info_ptr ibm3270_control_ 000114 iocbp ibm3270_control_ 000116 event_call_infop ibm3270_control_ 000120 auto_read_ctl ibm3270_control_ 000130 event_info ibm3270_control_ 000140 out_reqp ibm3270_control_ 000142 poll_reqp ibm3270_control_ 000144 adp ibm3270_control_ 000146 read_ctlp ibm3270_control_ 000150 write_infop ibm3270_control_ 000152 line_ctl ibm3270_control_ 000154 line_stat ibm3270_control_ 000164 i queue_out_req 000174 req_pending unpend_out_req 000175 req_unpended unpend_out_req 000176 now unpend_out_req 000200 i unpend_out_req 000210 seq format_write_msg 000211 i format_write_msg 000212 j format_write_msg 000213 ch format_write_msg 000214 msg_len format_write_msg 000232 i make_addr 000233 j make_addr poll 000100 controller_char poll 000101 device_char poll 000102 select_sw poll 000103 auto poll queue_poll_req 000100 first queue_poll_req worker 000114 i scan_more_input 000115 j scan_more_input 000124 i move_data 000142 i process_input 000143 j process_input 000144 fldi process_input 000544 nf process_input 000545 max_fldl process_input 000546 scanp process_input 000550 scanl process_input 000620 i send_more_output 000621 moved send_more_output 000622 wstat send_more_output 000634 i pend_out_req 000644 i get_next_out_req 000645 j get_next_out_req 000646 min_time get_next_out_req 000660 i free_out_req 000661 min_dev free_out_req 000662 max_dev free_out_req 000672 i poll_more_devices THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return mod_fx1 enable ext_entry ext_entry_desc int_entry int_entry_desc alloc_based free_based clock THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. convert_ipc_code_ hcs_$tty_order hcs_$tty_read hcs_$tty_write hcs_$wakeup ibm3270_io_call_ ibm3270_translate_$ascii_to_ebcdic ibm3270_translate_$ebcdic_to_ascii ipc_$block ipc_$mask_ev_calls ipc_$unmask_ev_calls timer_manager_$alarm_wakeup THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$line_status_pending error_table_$long_record error_table_$no_operation error_table_$request_pending error_table_$unimplemented_version LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 14 000116 144 000124 146 000145 147 000152 148 000154 149 000161 150 000164 154 000166 155 000172 156 000174 157 000175 159 000176 160 000202 161 000214 164 000215 165 000222 166 000224 171 000225 172 000231 173 000234 174 000240 175 000241 177 000242 178 000246 179 000250 180 000254 181 000255 183 000256 184 000262 185 000270 186 000274 187 000275 189 000276 190 000302 191 000303 192 000306 193 000310 195 000311 196 000322 197 000327 198 000331 199 000333 200 000336 202 000337 203 000356 204 000360 205 000367 207 000370 208 000372 210 000373 211 000375 212 000400 213 000402 214 000410 215 000413 216 000414 217 000416 218 000421 219 000423 221 000424 222 000430 223 000431 224 000436 225 000440 227 000441 228 000442 229 000444 230 000445 231 000451 232 000452 235 000453 236 000504 237 000506 238 000512 239 000514 240 000525 243 000526 245 000531 249 000532 251 000542 252 000546 253 000550 254 000552 255 000554 257 000556 259 000562 262 000610 266 000611 268 000620 269 000624 270 000626 271 000630 272 000632 274 000634 276 000635 280 000636 282 000644 283 000653 284 000700 287 000701 289 000702 291 000706 293 000707 295 000715 297 000724 303 000725 307 000726 309 000732 310 000743 311 000746 314 000747 315 000753 317 001001 318 001004 319 001011 320 001014 321 001026 323 001027 324 001032 326 001033 327 001037 332 001041 334 001043 336 001052 337 001054 338 001060 340 001061 341 001063 342 001065 343 001071 345 001072 346 001075 347 001101 349 001102 351 001115 352 001117 353 001123 354 001124 355 001130 358 001131 359 001142 360 001144 361 001150 362 001154 364 001155 365 001162 366 001170 367 001172 368 001204 370 001205 371 001213 372 001222 374 001223 376 001231 377 001235 379 001236 381 001251 382 001253 383 001257 384 001263 385 001264 387 001265 388 001276 389 001303 390 001311 391 001314 392 001320 393 001324 395 001325 396 001336 397 001343 398 001351 399 001354 400 001360 401 001364 403 001365 404 001367 405 001401 407 001402 408 001410 409 001412 410 001421 411 001425 418 001426 431 001430 432 001440 433 001452 434 001460 435 001465 441 001466 445 001470 446 001521 447 001526 453 001527 463 001530 464 001534 465 001547 466 001557 467 001562 468 001566 469 001567 470 001574 471 001601 472 001604 474 001615 476 001616 477 001622 478 001634 479 001641 480 001643 481 001657 482 001674 483 001675 485 001676 490 001677 491 001702 492 001704 493 001731 494 001736 495 001743 496 001747 497 001754 498 001765 499 002001 500 002003 502 002004 503 002005 504 002007 505 002010 506 002016 507 002040 508 002041 509 002042 510 002046 511 002050 512 002055 514 002056 515 002065 517 002070 518 002071 519 002073 520 002102 521 002133 522 002135 523 002146 524 002155 525 002165 526 002172 527 002221 528 002223 530 002230 531 002231 532 002235 533 002236 534 002243 535 002252 536 002264 537 002272 538 002276 539 002310 541 002311 542 002315 544 002321 548 002322 550 002323 551 002326 553 002332 554 002336 555 002344 556 002346 557 002350 558 002352 561 002353 565 002354 569 002356 570 002362 571 002364 572 002407 573 002411 574 002413 575 002415 576 002417 577 002422 578 002426 579 002427 580 002430 586 002431 588 002432 589 002437 592 002450 593 002453 595 002455 601 002456 603 002457 604 002472 605 002500 611 002501 615 002503 626 002521 627 002522 621 002525 629 002534 630 002542 631 002554 632 002563 634 002572 636 002575 637 002602 638 002604 639 002606 640 002622 641 002633 642 002673 643 002676 644 002703 647 002707 648 002711 649 002715 651 002716 654 002722 655 002725 656 002741 657 002745 658 003005 659 003010 660 003015 663 003021 664 003025 665 003030 667 003031 669 003032 671 003041 672 003047 673 003051 675 003052 677 003061 678 003063 680 003064 682 003073 683 003076 684 003112 690 003113 698 003114 700 003120 701 003122 702 003124 703 003126 704 003130 705 003131 706 003134 707 003136 708 003137 709 003141 710 003142 711 003144 712 003146 713 003147 715 003160 716 003163 718 003164 719 003165 720 003167 721 003171 725 003177 726 003200 727 003201 728 003202 729 003203 730 003212 731 003215 732 003217 734 003220 737 003233 738 003236 739 003240 743 003241 746 003244 747 003246 748 003253 750 003261 751 003262 752 003271 753 003301 754 003305 755 003307 756 003310 758 003313 759 003316 760 003321 763 003362 764 003365 765 003372 766 003375 767 003400 769 003401 770 003404 771 003410 772 003442 773 003445 774 003452 775 003455 776 003460 778 003461 779 003467 782 003470 784 003521 785 003524 786 003531 787 003534 788 003537 790 003540 791 003543 792 003545 794 003546 796 003560 802 003561 806 003562 807 003564 808 003566 810 003571 811 003573 812 003602 813 003605 814 003607 817 003616 818 003622 820 003627 822 003630 823 003632 826 003633 832 003634 836 003635 837 003641 838 003650 839 003655 840 003662 841 003663 847 003664 850 003665 851 003667 853 003671 854 003676 855 003702 856 003711 858 003724 859 003730 860 003731 863 003733 864 003735 865 003741 866 003750 872 003751 877 003752 878 003756 879 003762 880 003767 881 003772 882 003777 883 004002 884 004011 885 004020 886 004025 888 004027 889 004031 890 004035 893 004037 894 004045 895 004050 901 004051 903 004057 904 004075 910 004076 912 004077 913 004100 917 004101 918 004106 919 004110 920 004120 921 004132 922 004134 923 004137 924 004141 927 004143 928 004145 929 004156 930 004166 936 004167 940 004170 942 004175 943 004201 944 004203 945 004213 947 004214 948 004216 949 004220 950 004226 951 004230 952 004232 953 004241 956 004242 958 004257 967 004261 964 004264 969 004273 971 004303 972 004305 974 004310 976 004320 977 004322 978 004324 979 004325 981 004326 982 004327 984 004330 986 004331 988 004340 989 004342 995 004343 1003 004344 1004 004345 1005 004350 1007 004354 1008 004357 1009 004370 1010 004373 1011 004376 1012 004410 1013 004413 1014 004417 1015 004423 1017 004424 1018 004430 1019 004434 1021 004435 1022 004442 1024 004446 1025 004456 1026 004472 1027 004475 1028 004507 1030 004513 1031 004526 1032 004531 1033 004537 1035 004543 1036 004556 1037 004561 1039 004565 1040 004600 1041 004603 1043 004607 1044 004622 1045 004625 1046 004642 1048 004661 1049 004664 1050 004704 1052 004707 1054 004713 1055 004726 1056 004731 1057 004746 1059 004752 1060 004766 1061 004776 1062 005003 1063 005014 1064 005055 1066 005057 1068 005061 1070 005064 1072 005070 1073 005076 1074 005100 1075 005112 1076 005121 1077 005123 1078 005126 1079 005127 1081 005130 1082 005131 1084 005132 1086 005133 1088 005136 1092 005137 1096 005141 1097 005146 1098 005154 1099 005156 1107 005157 1112 005161 1113 005164 1114 005170 1121 005212 1123 005220 1124 005224 1125 005226 1126 005263 1128 005266 1129 005274 1131 005276 1134 005303 1136 005304 1146 005311 1148 005312 1156 005313 1161 005315 1162 005321 1163 005327 1164 005331 1165 005333 1166 005334 1172 005335 1178 005351 ----------------------------------------------------------- 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