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_: An I/O module for controling multi-station 3270 controllers */
 12 
 13 /* Written September 1977 by Larry Johnson */
 14 
 15 ibm3270_: proc;
 16 
 17 /* Parameters */
 18 
 19 dcl  arg_iocbp ptr;
 20 dcl  arg_option (*) char (*) var;                           /* Options for attach */
 21 dcl  arg_sw bit (1);                                        /* Com_err_ switch for attach */
 22 dcl  arg_code fixed bin (35);
 23 dcl  arg_mode fixed bin;                                    /* The open mode */
 24 dcl  arg_event_call_infop ptr;
 25 
 26 /* Automatic */
 27 
 28 dcl  com_err_sw bit (1);                                    /* Set if com_err_ sould be called on attach error */
 29 dcl  i fixed bin;
 30 dcl  code fixed bin (35);
 31 dcl  iocbp ptr;
 32 dcl  mask bit (36) aligned;                                 /* For setting ips mask */
 33 dcl  state fixed bin;
 34 dcl  ch char (1);
 35 dcl 1 my_area_info aligned like area_info automatic;
 36 
 37 dcl 1 mode_data aligned,
 38     2 req_len fixed bin,
 39     2 req char (256);
 40 
 41 dcl 1 event_info aligned,
 42     2 channel_id fixed bin (71),
 43     2 message fixed bin (71),
 44     2 sender bit (36),
 45     2 origon,
 46       3 dev_signal bit (18) unal,
 47       3 ring bit (18) unal,
 48     2 channel_index fixed bin (17);
 49 
 50 dcl  event_call_infop ptr;
 51 dcl 1 event_call_info aligned based (event_call_infop),
 52     2 channel_id fixed bin (71),
 53     2 message fixed bin (71),
 54     2 sender bit (36),
 55     2 origon,
 56       3 dev_signal bit (18) unal,
 57       3 ring bit (18) unal,
 58     2 data_ptr ptr;
 59 
 60 dcl 1 rw_status aligned,                                    /* For read_status and write_status */
 61     2 channel fixed bin (71),
 62     2 flag bit (1);
 63 
 64 dcl 1 poll_addr aligned,
 65     2 length fixed bin,
 66     2 data char (4);
 67 
 68 dcl  dial_msg_chan char (6);                                /* Variables for dial manager */
 69 dcl  dial_msg_module char (32);
 70 dcl  dial_msg_ndialed fixed bin;
 71 
 72 dcl 1 dma aligned,
 73     2 version fixed bin,
 74     2 dial_qual char (22),
 75     2 event_channel fixed bin (71),
 76     2 channel_name char (32);
 77 
 78 dcl 1 dial_msg_flags aligned,
 79     2 dialed_up bit (1) unal,
 80     2 hung_up bit (1) unal,
 81     2 control bit (1) unal,
 82     2 pad bit (33) unal;
 83 
 84 /* Constants */
 85 
 86 dcl  iomodule_name char (8) int static options (constant) init ("ibm3270_");
 87 
 88 /* External stuff */
 89 
 90 dcl  define_area_ entry (ptr, fixed bin (35));
 91 dcl  release_area_ entry (ptr);
 92 dcl  ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
 93 dcl  ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
 94 dcl  ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35));
 95 dcl  ipc_$decl_ev_wait_chn entry (fixed bin (71), fixed bin (35));
 96 dcl  ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
 97 dcl  convert_ipc_code_ entry (fixed bin (35));
 98 dcl  timer_manager_$reset_alarm_wakeup entry (fixed bin (71));
 99 dcl  hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned);
100 dcl  hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned);
101 dcl  iox_$propagate entry (ptr);
102 dcl  com_err_ entry options (variable);
103 dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
104 dcl  hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
105 dcl  get_process_id_ entry returns (bit (36) aligned);
106 dcl  dial_manager_$privileged_attach entry (ptr, fixed bin (35));
107 dcl  convert_dial_message_ entry (bit (72) aligned, char (*), char (*), fixed bin, 1 like dial_msg_flags aligned,
108      fixed bin (35));
109 dcl  hcs_$tty_attach entry (char (*), fixed bin (71), fixed bin, fixed bin, fixed bin (35));
110 dcl  hcs_$tty_detach entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
111 dcl  hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35));
112 dcl  ibm3270_control_$control ext entry;
113 dcl  ibm3270_control_$timer_handler ext entry;
114 dcl  ibm3270_control_$wakeup_handler ext entry;
115 
116 dcl (addr, hbound, length, null, rtrim, string, unspec) builtin;
117 
118 dcl  sys_info$max_seg_size ext fixed bin (35);
119 dcl  error_table_$bad_mode ext fixed bin (35);
120 dcl  error_table_$line_status_pending ext fixed bin (35);
121 dcl  error_table_$not_detached ext fixed bin (35);
122 dcl  error_table_$wrong_no_of_args ext fixed bin (35);
123 dcl  error_table_$badopt ext fixed bin (35);
124 dcl  error_table_$action_not_performed ext fixed bin (35);
125 dcl  error_table_$request_pending ext fixed bin (35);
126 dcl  error_table_$noarg ext fixed bin (35);
127 
128 dcl  conversion condition;
129 
130 
131 
132 
133 %include iocb;
134 
135 %include iox_modes;
136 
137 
138 %include area_info;
139 
140 %include bisync_line_data;
141 
142 %include ibm3270_attach_data;
143 ^L
144 /* Attach entry point */
145 
146 ibm3270_attach: entry (arg_iocbp, arg_option, arg_sw, arg_code);
147 
148           iocbp = arg_iocbp;
149           com_err_sw = arg_sw;
150           arg_code = 0;
151 
152           area_infop = addr (my_area_info);
153           area_info.version = area_info_version_1;
154           string (area_info.control) = "0"b;
155           area_info.extend = "1"b;
156           area_info.zero_on_free = "1"b;
157           area_info.owner = iomodule_name;
158           area_info.size = sys_info$max_seg_size;
159           area_info.areap = null;
160           adp = null;
161 
162           if iocbp -> iocb.attach_descrip_ptr ^= null then do;
163                code = error_table_$not_detached;
164                call abort_attach ("^a", iocbp -> iocb.name);
165           end;
166 
167           call define_area_ (area_infop, code);
168           if code ^= 0 then call abort_attach ("Unable to allocate temp area.", "");
169           allocate ad in (area_info.areap -> work_area);
170           unspec (ad) = "0"b;
171           ad.work_areap = area_info.areap;
172           ad.processid = get_process_id_ ();
173 
174 /* Process options */
175 
176           if hbound (arg_option, 1) < 1 then do;            /* Must be exactly one */
177                code = error_table_$wrong_no_of_args;
178                call abort_attach ("Bad attach description.", "");
179           end;
180 
181           ad.device = arg_option (1);
182 
183           do i = 2 to hbound (arg_option, 1);
184                if arg_option (i) = "-ebcdic" then ad.ascii = "0"b;
185                else if arg_option (i) = "-ascii" then ad.ascii = "1"b;
186                else if arg_option (i) = "-async" then ad.async = "1"b;
187                else if arg_option (i) = "-retry_limit" then do; /* Times to retry i/o */
188                     i = i + 1;                              /* Check next arg */
189                     if i > hbound (arg_option, 1) then do;
190                          code = error_table_$noarg;
191                          call abort_attach ("^a", "After -retry_limit");
192                     end;
193                     on conversion begin;                    /* In case bad arg */
194                          code = 0;
195                          call abort_attach ("Invalid retry limit: ^a", (arg_option (i)));
196                     end;
197                     ad.retry_limit = bin (arg_option (i));
198                     revert conversion;
199                     if ad.retry_limit < 0 then ad.retry_limit = 0;
200                end;
201                else do;
202                     code = error_table_$badopt;
203                     call abort_attach ("^a", (arg_option (i)));
204                end;
205           end;
206 
207           ad.nchan = 1;
208           call create_channel (ad.user_channel);
209           call create_channel (ad.io_channel);
210           call create_channel (ad.attach_channel);
211           call create_channel (ad.timer_channel);
212 
213 /* Now mask and complete the iocb */
214 
215           ad.attach_description = iomodule_name;
216           do i = 1 to hbound (arg_option, 1);
217                ad.attach_description = ad.attach_description || " ";
218                ad.attach_description = ad.attach_description || arg_option (i);
219           end;
220           call hcs_$set_ips_mask ("0"b, mask);
221           iocbp -> iocb.attach_descrip_ptr = addr (ad.attach_description);
222           iocbp -> iocb.attach_data_ptr = adp;
223           iocbp -> iocb.open = ibm3270_open;
224           iocbp -> iocb.control = ibm3270_control_$control;
225           iocbp -> iocb.detach_iocb = ibm3270_detach;
226           call iox_$propagate (iocbp);
227           call hcs_$reset_ips_mask (mask, mask);
228 attach_return:
229           return;
230 
231 
232 /* Internal procedure to handle attach errors */
233 
234 abort_attach: proc (str1, str2);
235 
236 dcl (str1, str2) char (*) aligned;
237 
238                if com_err_sw then call com_err_ (code, iomodule_name, str1, str2);
239                if code = 0 then code = error_table_$badopt;
240                arg_code = code;
241 
242                if adp ^= null then do;
243                     if ad.user_channel ^= 0 then call ipc_$delete_ev_chn (ad.user_channel, code);
244                end;
245                if area_info.areap ^= null then call release_area_ (area_info.areap);
246                go to attach_return;
247 
248           end abort_attach;
249 
250 /* Internal procedure used by attach to create event channels */
251 
252 create_channel: proc (ch);
253 
254 dcl  ch fixed bin (71);
255 
256                call ipc_$create_ev_chn (ch, code);
257                if code = 0 then return;
258                call convert_ipc_code_ (code);
259                call abort_attach ("Creating event channel.", "");
260 
261           end create_channel;
262 ^L
263 /* Detach entry point */
264 
265 ibm3270_detach: entry (arg_iocbp, arg_code);
266 
267           iocbp = arg_iocbp;
268           arg_code = 0;
269 
270           adp = iocbp -> iocb.attach_data_ptr;
271 
272           call hcs_$set_ips_mask ("0"b, mask);
273           iocbp -> iocb.attach_descrip_ptr = null;
274           call iox_$propagate (iocbp);
275           call hcs_$reset_ips_mask (mask, mask);
276 
277           call ipc_$delete_ev_chn (ad.user_channel, code);
278           call ipc_$delete_ev_chn (ad.timer_channel, code);
279           call ipc_$delete_ev_chn (ad.attach_channel, code);
280           call ipc_$delete_ev_chn (ad.io_channel, code);
281           call release_area_ (addr (work_area));
282 
283           return;
284 ^L
285 /* Open entry point */
286 
287 ibm3270_open: entry (arg_iocbp, arg_mode, arg_sw, arg_code);
288 
289           iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
290           arg_code = 0;
291           adp = iocbp -> iocb.attach_data_ptr;
292 
293           if arg_mode ^= Stream_input_output then do;
294                code = error_table_$bad_mode;
295                go to report_open_code;
296           end;
297 
298 /* See if we are completing a previously started open */
299 
300           if ad.open_in_progress then do;
301                if ad.open_wakeup_occured then do;           /* Got the wakeup */
302                     ad.open_in_progress, ad.open_wakeup_occured = "0"b;
303                     go to complete_open;
304                end;
305                code = error_table_$request_pending;         /* Still not done */
306                go to report_open_code;
307           end;
308 
309 /* Get bisync channel from answering service. */
310 
311           dma.version = 1;                                  /* Setup dial manager data structure */
312           dma.event_channel = ad.attach_channel;
313           dma.channel_name = ad.device;
314           dma.dial_qual = "";
315           call dial_manager_$privileged_attach (addr (dma), code);
316           if code = error_table_$action_not_performed then go to maybe_mine_already;
317           if code ^= 0 then go to report_open_code;
318 
319 /* Make ansering service call us back when line is ready */
320 
321           call ipc_$decl_ev_call_chn (ad.attach_channel, open_wakeup_handler, iocbp, 1, code);
322           if code ^= 0 then do;
323                call convert_ipc_code_ (code);
324                go to report_open_code;
325           end;
326 
327           ad.open_in_progress = "1"b;
328           if ad.async then do;                              /* Cant block here */
329                code = error_table_$request_pending;
330                go to report_open_code;
331           end;
332           call block;                                       /* Wait for answering service */
333           ad.open_in_progress, ad.open_wakeup_occured = "0"b;
334           if code ^= 0 then go to report_open_code;
335 
336 complete_open:
337           call convert_dial_message_ (unspec (ad.open_event_message), dial_msg_chan, dial_msg_module,
338                dial_msg_ndialed, dial_msg_flags, code);
339           if code ^= 0 then go to report_open_code;
340 maybe_mine_already:
341 
342 /* Attach the device */
343 
344           call hcs_$tty_attach ((ad.device), ad.io_channel, ad.tty_index, state, code);
345           if code ^= 0 then go to report_open_code;
346 retry_modes:
347           mode_data.req_len = length (mode_data.req);
348           mode_data.req = "rawi,rawo";
349           call hcs_$tty_order (ad.tty_index, "modes", addr (mode_data), state, code);
350           if code = error_table_$line_status_pending then do;
351                call flush_line_status;
352                if code = 0 then go to retry_modes;
353           end;
354           if code ^= 0 then go to report_open_code;
355 
356 retry_message_size:
357           i = 256;
358           call hcs_$tty_order (ad.tty_index, "set_input_message_size", addr (i), state, code);
359           if code = error_table_$line_status_pending then do;
360                call flush_line_status;
361                if code = 0 then go to retry_message_size;
362           end;
363           if code ^= 0 then go to report_open_code;
364 
365           call line_control (SET_3270_MODE, 0);
366           if code ^= 0 then go to report_open_code;
367           call line_control (SET_BID_LIMIT, 3);
368           if code ^= 0 then go to report_open_code;
369           call line_control (CONFIGURE, 1);
370           if code ^= 0 then go to report_open_code;
371           call line_control2 (SET_TTD_PARAMS, 2, 2);
372           if code ^= 0 then go to report_open_code;
373 
374 
375           call ipc_$decl_ev_call_chn (ad.io_channel, ibm3270_control_$wakeup_handler, iocbp, 1, code);
376           if code ^= 0 then do;
377                call convert_ipc_code_ (code);
378                go to report_open_code;
379           end;
380 
381           call ipc_$decl_ev_call_chn (ad.timer_channel, ibm3270_control_$timer_handler, iocbp, 1, code);
382           if code ^= 0 then do;
383                call convert_ipc_code_ (code);
384                go to report_open_code;
385           end;
386 
387 /* Initialize attach data variables */
388 
389           ad.first_read_infop = null;
390           ad.last_read_infop = null;
391           ad.header_buf_len = 16;
392           allocate header_buf in (work_area);
393           ad.input_buf_len = 4096;
394           allocate input_buf in (work_area);
395           ad.text_buf_len = 4096;
396           allocate text_buf in (work_area);
397           ad.output_buf_len = 56*40;                        /* FNPs arbitrary limit */
398           allocate output_buf in (work_area);
399           ad.header_len, ad.text_len, ad.unscanned_data_len = 0;
400           ad.input_state = 1;
401           ad.last_device_polled = -2;                       /* Set to invalid number */
402           ad.last_device_selected = -2;
403           ad.cur_out_reqp = null;                           /* No output */
404           ad.first_out_reqp (*) = null;
405           ad.last_out_reqp (*) = null;
406           ad.min_dev, ad.max_dev = -1;
407           ad.pend_interval = 30000000;                      /* 30 seconds */
408           ad.pend_time (*) = 0;
409           ad.close_in_progress = "0"b;
410           ad.output_in_progress = "0"b;
411           ad.input_line_status, ad.output_line_status = 0;
412           ad.general_poll, ad.polling_in_progress = "0"b;
413           ad.device_responded = "0"b;
414           ad.first_poll_reqp, ad.last_poll_reqp = null;
415 
416           unspec (ad.stx) = "002"b3;
417           unspec (ad.etx) = "003"b3;
418           unspec (ad.soh) = "001"b3;
419           unspec (ad.sf) = "035"b3;
420           unspec (ad.sba) = "021"b3;
421           unspec (ad.ic) = "023"b3;
422           unspec (ad.eua) = "022"b3;
423           if ad.ascii then do;
424                unspec (ad.etb) = "027"b3;
425                unspec (ad.eot) = "004"b3;
426                unspec (ad.pt) = "011"b3;
427                unspec (ad.ra) = "024"b3;
428                unspec (ad.esc) = "033"b3;
429           end;
430           else do;
431                unspec (ad.etb) = "046"b3;
432                unspec (ad.eot) = "067"b3;
433                unspec (ad.pt) = "005"b3;
434                unspec (ad.ra) = "074"b3;
435                unspec (ad.esc) = "047"b3;
436           end;
437 
438           do i = 0 to 63;                                   /* Set up usavble form of address_mapping array */
439                unspec (ch) = "0"b || address_mapping (i);
440                ad.bit6_char (i) = ch;
441           end;
442 
443           ad.open_description = rtrim (iox_modes (arg_mode));
444 
445           call hcs_$set_ips_mask ("0"b, mask);
446           iocbp -> iocb.close = ibm3270_close;
447           iocbp -> iocb.control = ibm3270_control_$control;
448           iocbp -> iocb.open_descrip_ptr = addr (ad.open_description);
449           call iox_$propagate (iocbp);
450           call hcs_$reset_ips_mask (mask, mask);
451           code = 0;
452 report_open_code:
453           arg_code = code;
454           return;
455 
456 /* This entry is the event call handeler for the attach channel during opens */
457 
458 open_wakeup_handler: entry (arg_event_call_infop);
459 
460           event_call_infop = arg_event_call_infop;
461           iocbp = event_call_info.data_ptr;
462           adp = iocbp -> iocb.attach_data_ptr;
463 
464           if ^ad.open_in_progress then return;              /* Came at bad time */
465           ad.open_event_message = event_call_info.message;  /* Save the message */
466           ad.open_wakeup_occured = "1"b;
467           call hcs_$wakeup (ad.processid, ad.user_channel, 0, code);
468           return;
469 ^L
470 /* Close entry point */
471 
472 ibm3270_close: entry (arg_iocbp, arg_code);
473 
474           iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
475           arg_code = 0;
476           adp = iocbp -> iocb.attach_data_ptr;
477 
478           ad.close_in_progress = "1"b;
479           call line_control (STOP_AUTO_POLL, 0);
480           call hcs_$tty_detach (ad.tty_index, 0, state, code);
481           call ipc_$decl_ev_wait_chn (ad.io_channel, code);
482           call ipc_$decl_ev_wait_chn (ad.attach_channel, code);
483           call ipc_$decl_ev_wait_chn (ad.timer_channel, code);
484 
485           call hcs_$set_ips_mask ("0"b, mask);
486           iocbp -> iocb.open_descrip_ptr = null;
487           iocbp -> iocb.open = ibm3270_open;
488           iocbp -> iocb.detach_iocb = ibm3270_detach;
489           call iox_$propagate (iocbp);
490           call hcs_$reset_ips_mask (mask, mask);
491 
492           call ipc_$drain_chn (ad.user_channel, code);
493           call ipc_$drain_chn (ad.io_channel, code);
494           call ipc_$drain_chn (ad.attach_channel, code);
495           call timer_manager_$reset_alarm_wakeup (ad.timer_channel);
496           call ipc_$drain_chn (ad.timer_channel, code);
497 
498           free header_buf;
499           free text_buf;
500           free input_buf;
501           free output_buf;
502 
503           return;
504 ^L
505 /* Control/* Internal procedure to block */
506 
507 block:    proc;
508 
509                call ipc_$block (addr (ad.wait_list), addr (event_info), code);
510                if code ^= 0 then call convert_ipc_code_ (code);
511                return;
512 
513           end block;
514 
515 /* Procedure to do a line control order */
516 
517 line_control: proc (op, val1);
518 
519 dcl (op, val1, val2) fixed bin;
520 
521                line_ctl.val = 0;
522 line_control_join:
523                line_ctl.val (1) = val1;
524                line_ctl.op = op;
525 retry_line_control:
526                call hcs_$tty_order (ad.tty_index, "line_control", addr (line_ctl), state, code);
527                if code = error_table_$line_status_pending then do;
528                     call flush_line_status;
529                     if code = 0 then go to retry_line_control;
530                end;
531                return;
532 
533 line_control2: entry (op, val1, val2);
534 
535                line_ctl.val = 0;
536                line_ctl.val (2) = val2;
537                go to line_control_join;
538 
539           end line_control;
540 
541 flush_line_status: proc;
542 
543                call hcs_$tty_order (ad.tty_index, "line_status", addr (line_stat), state, code);
544                return;
545 
546           end flush_line_status;
547 ^L
548 
549      end ibm3270_;