1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33 bisync_: proc;
34
35
36
37 dcl arg_iocbp ptr;
38 dcl arg_option (*) char (*) var;
39 dcl arg_sw bit (1);
40 dcl arg_code fixed bin (35);
41 dcl arg_mode fixed bin;
42 dcl arg_buf_ptr ptr;
43 dcl arg_data_ptr ptr;
44 dcl arg_buf_len fixed bin (21);
45 dcl arg_data_len fixed bin (21);
46 dcl arg_pos_type fixed bin;
47 dcl arg_pos_value fixed bin (21);
48 dcl arg_order char (*);
49 dcl arg_info_ptr ptr;
50
51
52
53 dcl com_err_sw bit (1);
54 dcl adp ptr;
55 dcl code fixed bin (35);
56 dcl iocbp ptr;
57 dcl empty_buffer char (1) init ("");
58 dcl mask bit (36) aligned;
59 dcl state fixed bin;
60 dcl i fixed bin (21);
61 dcl open_mode fixed bin;
62 dcl remaining_len fixed bin (21);
63 dcl offset fixed bin (21);
64 dcl data_ptr ptr;
65 dcl data_len fixed bin (21);
66 dcl header_len fixed bin (21);
67 dcl buf_ptr ptr;
68 dcl buf_len fixed bin (21);
69 dcl hbuf_ptr ptr;
70 dcl hbuf_len fixed bin (21);
71 dcl order_sw bit (1);
72 dcl etb_found bit (1);
73 dcl etx_found bit (1);
74 dcl stx_found bit (1);
75 dcl eot_found bit (1);
76 dcl soh_found bit (1);
77 dcl header_found bit (1);
78 dcl data_found bit (1);
79 dcl nl_found bit (1);
80 dcl order char (32);
81 dcl info_ptr ptr;
82 dcl pos_type fixed bin;
83 dcl pos_value fixed bin (21);
84 dcl caller char (32);
85 dcl (rpt, err) entry variable options (variable);
86 dcl 1 my_area_info like area_info aligned automatic;
87 dcl real_transparent bit (1);
88 dcl time_out bit (1);
89
90 dcl 1 event_info aligned,
91 2 channel_id fixed bin (71),
92 2 message fixed bin (71),
93 2 sender bit (36),
94 2 origon,
95 3 dev_signal bit (18) unal,
96 3 ring bit (18) unal,
97 2 channel_index fixed bin (17);
98
99 dcl 1 mode_data aligned,
100 2 req_len fixed bin,
101 2 req char (256);
102
103 dcl dial_msg_chan char (6);
104 dcl dial_msg_module char (32);
105 dcl dial_msg_ndialed fixed bin;
106
107 dcl 1 dma aligned,
108 2 version fixed bin,
109 2 dial_qual char (22),
110 2 event_channel fixed bin (71),
111 2 channel_name char (32);
112
113 dcl 1 dial_msg_flags aligned,
114 2 dialed_up bit (1) unal,
115 2 hung_up bit (1) unal,
116 2 control bit (1) unal,
117 2 pad bit (33) unal;
118
119
120
121 dcl BISYNC_OVERHEAD fixed bin int static options (constant) init (8);
122 dcl iomodule_name char (7) int static options (constant) init ("bisync_");
123 dcl nl char (1) int static options (constant) init ("
124 ");
125
126
127
128 dcl define_area_ entry (ptr, fixed bin (35));
129 dcl release_area_ entry (ptr);
130 dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
131 dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
132 dcl ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35));
133 dcl ipc_$decl_ev_wait_chn entry (fixed bin(71), fixed bin(35));
134 dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
135 dcl hcs_$assign_channel entry (fixed bin (71), fixed bin (35));
136 dcl convert_ipc_code_ entry (fixed bin (35));
137 dcl hcs_$tty_attach entry (char (*), fixed bin (71), fixed bin, fixed bin, fixed bin (35));
138 dcl hcs_$tty_detach entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
139 dcl hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned);
140 dcl hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned);
141 dcl iox_$propagate entry (ptr);
142 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35));
143 dcl com_err_ entry options (variable);
144 dcl hcs_$tty_write entry (fixed bin, ptr, fixed bin (21), fixed bin (21), fixed bin (21), fixed bin, fixed bin (35));
145 dcl hcs_$tty_read entry (fixed bin, ptr, fixed bin (21), fixed bin (21), fixed bin (21), fixed bin, fixed bin (35));
146 dcl hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35));
147 dcl hcs_$tty_abort entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
148 dcl hcs_$tty_state entry (fixed bin, fixed bin, fixed bin (35));
149 dcl ipc_$block entry (ptr, ptr, fixed bin (35));
150 dcl timer_manager_$sleep entry (fixed bin (71), bit (2));
151 dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71));
152 dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));
153 dcl dial_manager_$privileged_attach entry (ptr, fixed bin (35));
154 dcl dial_manager_$dial_out entry (ptr, fixed bin (35));
155 dcl dial_manager_$release_channel entry (ptr, fixed bin(35));
156 dcl dial_manager_$release_channel_no_hangup entry (ptr, fixed bin(35));
157 dcl convert_dial_message_ entry (bit (72) aligned, char (*), char (*), fixed bin, 1 like dial_msg_flags aligned,
158 fixed bin (35));
159 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35));
160 dcl iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35));
161 dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
162 dcl iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35));
163 dcl iox_$close entry (ptr, fixed bin (35));
164 dcl iox_$detach_iocb entry (ptr, fixed bin (35));
165 dcl iox_$err_no_operation entry;
166
167 dcl (addr, bin, hbound, index, length, low, max, min, null, rtrim, string, substr, unspec) builtin;
168
169 dcl sys_info$max_seg_size ext fixed bin (35);
170 dcl error_table_$buffer_big ext fixed bin (35);
171 dcl error_table_$bad_arg ext fixed bin (35);
172 dcl error_table_$bad_mode ext fixed bin (35);
173 dcl error_table_$bisync_bid_fail ext fixed bin (35);
174 dcl error_table_$bisync_reverse_interrupt ext fixed bin (35);
175 dcl error_table_$long_record ext fixed bin (35);
176 dcl error_table_$line_status_pending ext fixed bin (35);
177 dcl error_table_$not_detached ext fixed bin (35);
178 dcl error_table_$wrong_no_of_args ext fixed bin (35);
179 dcl error_table_$noarg ext fixed bin (35);
180 dcl error_table_$no_operation ext fixed bin (35);
181 dcl error_table_$no_line_status ext fixed bin (35);
182 dcl error_table_$badopt ext fixed bin (35);
183 dcl error_table_$device_parity ext fixed bin (35);
184 dcl error_table_$action_not_performed ext fixed bin (35);
185 dcl error_table_$bisync_block_bad ext fixed bin (35);
186 dcl error_table_$end_of_info ext fixed bin (35);
187 dcl error_table_$resource_attached ext fixed bin (35);
188
189 dcl conversion condition;
190
191
192
193 dcl 1 ad aligned based (adp),
194 2 work_areap ptr,
195 2 device char (6),
196 2 attach_description char (256) var,
197 2 open_description char (24) var,
198 2 wait_list aligned,
199 3 nchan fixed bin,
200 3 channel_id fixed bin (71),
201 3 timer_channel fixed bin (71),
202 2 attach_channel fixed bin (71),
203 2 channel fixed bin (71),
204 2 delay fixed bin (71),
205 2 log_iocbp ptr,
206 2 tty_index fixed bin,
207 2 bid_limit fixed bin,
208 2 ttd_time fixed bin,
209 2 ttd_limit fixed bin,
210 2 transparent bit (1),
211 2 ascii bit (1),
212 2 attach_channel_is_call bit (1),
213 2 temp_nontransparent bit (1),
214 2 break_on_etb bit (1),
215 2 break_on_eot bit (1),
216 2 saved_eot bit (1),
217 2 output_mode bit (1),
218 2 hangup_sw bit (1),
219 2 fnp_output_reported bit (1),
220 2 fnp_output_pending bit (1),
221 2 ibm3270_mode bit (1),
222 2 hasp_mode bit (1),
223 2 master_sw bit (1),
224 2 slave_sw bit (1),
225 2 tty_attached bit (1),
226 2 multi_record bit (1),
227 2 output_etb_mode bit (1),
228 2 use_etb bit (1),
229 2 multi_record_limit fixed bin,
230 2 record_count fixed bin,
231 2 write_error_code fixed bin (35),
232 2 log_sw bit (1),
233 2 stx char (1),
234 2 etx char (1),
235 2 etb char (1),
236 2 dle char (1),
237 2 eot char (1),
238 2 itb char (1),
239 2 soh char (1),
240 2 scanned_data_len fixed bin (21),
241 2 scanned_data_ptr ptr,
242 2 unscanned_data_len fixed bin (21),
243 2 unscanned_data_ptr ptr,
244 2 input_state fixed bin,
245 2 block_len fixed bin (21),
246 2 max_block_len fixed bin (21),
247 2 input_blockp ptr,
248 2 last_input_blockp ptr,
249 2 input_buf_len fixed bin (21),
250 2 input_buf_ptr ptr,
251 2 output_buf_len fixed bin (21),
252 2 output_buf_ptr ptr,
253 2 output_buf_used fixed bin (21),
254 2 output_buf_left fixed bin (21),
255 2 last_etx fixed bin (21);
256
257 dcl output_buffer char (ad.output_buf_len) based (ad.output_buf_ptr);
258 dcl unscanned_data char (ad.unscanned_data_len) based (ad.unscanned_data_ptr);
259 dcl scanned_data char (ad.scanned_data_len) based (ad.scanned_data_ptr);
260 dcl work_area area based (ad.work_areap);
261
262 dcl 1 input_block aligned based (ad.input_blockp),
263 2 next_blockp ptr init (null),
264 2 data_len fixed bin (21),
265 2 input_buffer char (ad.input_buf_len);
266
267 dcl data_arg char (data_len) based (data_ptr);
268 dcl buf_arg char (buf_len) based (buf_ptr);
269 dcl header_arg char (hbuf_len) based (hbuf_ptr);
270
271
272
273 dcl event_info_channel fixed bin (71) based (info_ptr);
274 dcl 1 rw_status aligned based (info_ptr),
275 2 channel fixed bin (71),
276 2 flag bit (1);
277 dcl order_val fixed bin based (info_ptr);
278 dcl 1 bsc_modes aligned based (info_ptr),
279 2 transparent bit (1) unal,
280 2 ebcdic bit (1) unal,
281 2 fill bit (34) unal;
282 dcl 1 hangup_proc aligned based (info_ptr),
283 2 entry_var entry variable,
284 2 data_ptr ptr,
285 2 prior fixed bin;
286 dcl 1 order_msg aligned based (info_ptr),
287 2 data_len fixed bin,
288 2 data char (order_msg.data_len);
289
290 dcl 1 get_chars_info aligned based (info_ptr),
291 2 buf_ptr ptr,
292 2 buf_len fixed bin (21),
293 2 data_len fixed bin (21),
294 2 hbuf_ptr ptr,
295 2 hbuf_len fixed bin (21),
296 2 header_len fixed bin (21),
297 2 flags,
298 3 etx bit (1) unal,
299 3 etb bit (1) unal,
300 3 soh bit (1) unal,
301 3 eot bit (1) unal,
302 3 pad bit (32) unal;
303
304 ^L
305
306
307 bisync_attach: entry (arg_iocbp, arg_option, arg_sw, arg_code);
308
309 iocbp = arg_iocbp;
310 com_err_sw = arg_sw;
311 arg_code, code = 0;
312
313 area_infop = addr (my_area_info);
314 area_info.version = area_info_version_1;
315 string (area_info.control) = "0"b;
316 area_info.extend = "1"b;
317 area_info.zero_on_free = "1"b;
318 area_info.owner = iomodule_name;
319 area_info.size = sys_info$max_seg_size;
320 area_info.areap = null;
321 adp = null;
322
323 if iocbp -> iocb.attach_descrip_ptr ^= null then do;
324 code = error_table_$not_detached;
325 call abort_attach ("^a", iocbp -> iocb.name);
326 end;
327
328 call define_area_ (area_infop, code);
329 if code ^= 0 then call abort_attach ("Unable to allocate temp area.", "");
330 allocate ad in (area_info.areap -> work_area);
331 unspec (ad) = "0"b;
332 ad.work_areap = area_info.areap;
333
334
335
336 if hbound (arg_option, 1) < 1 then do;
337 code = error_table_$wrong_no_of_args;
338 call abort_attach ("Bad attach description.", "");
339 end;
340 ad.device = arg_option (1);
341 ad.block_len, ad.max_block_len = 256;
342 ad.transparent = "1"b;
343 ad.ascii = "1"b;
344 ad.delay = 0;
345 ad.bid_limit = 30;
346 ad.ttd_time = 2;
347 ad.ttd_limit = 30;
348 ad.output_etb_mode = "0"b;
349 ad.use_etb = "0"b;
350 dma.dial_qual = "";
351 do i = 2 to hbound (arg_option, 1);
352 if arg_option (i) = "-transparent" then ad.transparent = "1"b;
353 else if arg_option (i) = "-nontransparent" then ad.transparent = "0"b;
354 else if arg_option (i) = "-ascii" then do;
355 ad.ascii = "1"b;
356 end;
357 else if arg_option (i) = "-ebcdic" then do;
358 ad.ascii = "0"b;
359 end;
360 else if arg_option (i) = "-size" then do;
361 ad.block_len, ad.max_block_len = cv_dec_arg ();
362 if (ad.block_len < 6) | (ad.block_len > 2000) then
363 call abort_attach ("Invalid block size: ^a", (arg_option (i)));
364 end;
365 else if arg_option (i) = "-delay" then ad.delay = 1000 * cv_dec_arg ();
366 else if arg_option (i) = "-output_etb" then ad.output_etb_mode, ad.use_etb = "1"b;
367 else if arg_option (i) = "-output_etx" then ad.output_etb_mode, ad.use_etb = "0"b;
368 else if arg_option (i) = "-bretb" then ad.break_on_etb = "1"b;
369 else if arg_option (i) = "-breot" then ad.break_on_eot = "1"b;
370 else if arg_option (i) = "-hangup" then ad.hangup_sw = "1"b;
371 else if arg_option (i) = "-ibm3270_mode" then ad.ibm3270_mode = "1"b;
372 else if arg_option (i) = "-hasp_mode" then ad.hasp_mode = "1"b;
373 else if arg_option (i) = "-master" then ad.master_sw = "1"b;
374 else if arg_option (i) = "-slave" then ad.slave_sw = "1"b;
375 else if arg_option (i) = "-bid_limit" then ad.bid_limit = cv_dec_arg ();
376 else if arg_option (i) = "-ttd_time" then ad.ttd_time = cv_dec_arg ();
377 else if arg_option (i) = "-ttd_limit" then ad.ttd_limit = cv_dec_arg ();
378 else if arg_option (i) = "-multi_record" then do;
379 ad.multi_record = "1"b;
380 ad.multi_record_limit = 0;
381 if i < hbound (arg_option, 1) then
382 if substr (arg_option (i+1), 1, 1) ^= "-" then
383 ad.multi_record_limit = cv_dec_arg ();
384 end;
385 else if arg_option (i) = "-auto_call" then do;
386 i = i + 1;
387 if i > hbound (arg_option, 1) then do;
388 code = error_table_$noarg;
389 call abort_attach ("No phone number after -auto_call", "");
390 end;
391 dma.dial_qual = arg_option (i);
392 end;
393 else if arg_option (i) = "-debug_log" then ad.log_sw = "1"b;
394 else do;
395 code = error_table_$badopt;
396 call abort_attach ("^a", (arg_option (i)));
397 end;
398 end;
399
400
401
402 ad.nchan = 1;
403 call ipc_$create_ev_chn (ad.attach_channel, code);
404 if code ^= 0 then do;
405 call convert_ipc_code_ (code);
406 call abort_attach ("Unable to create event channel", "");
407 end;
408 dma.version = 1;
409 dma.event_channel = ad.attach_channel;
410 dma.channel_name = ad.device;
411 if dma.dial_qual = "" then call dial_manager_$privileged_attach (addr (dma), code);
412 else call dial_manager_$dial_out (addr (dma), code);
413 if code = error_table_$action_not_performed | code = error_table_$resource_attached
414 then go to maybe_mine_already;
415 if code ^= 0 then call abort_attach ("From dial_manager_ attaching ^a", ad.device);
416 call block (ad.attach_channel, 1);
417 if code ^= 0 then call abort_attach ("From ipc_$block waiting for ^a attachment.", ad.device);
418
419 call convert_dial_message_ (unspec (event_info.message), dial_msg_chan, dial_msg_module,
420 dial_msg_ndialed, dial_msg_flags, code);
421 if code ^= 0 then call abort_attach ("From dial_manager_ attaching ^a", ad.device);
422 maybe_mine_already:
423 ad.channel = 0;
424
425
426
427 if ad.ibm3270_mode then go to use_std_chan;
428 call hcs_$assign_channel (ad.channel, code);
429 if code ^= 0 then do;
430 use_std_chan: call ipc_$create_ev_chn (ad.channel, code);
431 if code ^= 0 then do;
432 call convert_ipc_code_ (code);
433 ad.channel = 0;
434 call abort_attach ("Unable to create event channel.", "");
435 end;
436 end;
437
438
439
440 call ipc_$create_ev_chn (ad.timer_channel, code);
441 if code ^= 0 then do;
442 call convert_ipc_code_ (code);
443 ad.timer_channel = 0;
444 call abort_attach ("Unable to create event channel", "");
445 end;
446
447
448
449 ad.input_buf_len, ad.output_buf_len = 0;
450 ad.input_buf_ptr, ad.output_buf_ptr = null;
451 ad.input_blockp = null;
452 ad.last_input_blockp = null;
453 call set_control_chars;
454
455
456
457 if ad.log_sw then do;
458 order = rtrim (iocbp -> iocb.name) || ".log";
459 call iox_$attach_name (order, ad.log_iocbp, "vfile_ " || rtrim (order), null, code);
460 if code = 0 then do;
461 call iox_$open (ad.log_iocbp, Sequential_output, "0"b, code);
462 if code ^= 0 then do;
463 call com_err_ (code, iomodule_name, "Opening log ^a", order);
464 call iox_$detach_iocb (ad.log_iocbp, code);
465 ad.log_sw = "0"b;
466 end;
467 end;
468 else do;
469 call com_err_ (code, iomodule_name, "attaching log ^a", order);
470 ad.log_sw = "0"b;
471 end;
472 end;
473
474
475
476 call hcs_$tty_attach ((ad.device), ad.channel, ad.tty_index, state, code);
477 if code ^= 0 then call abort_attach ("Unable to attach ^a.", ad.device);
478 if code = 0 then ad.tty_attached = "1"b;
479 mode_data.req_len = length (mode_data.req);
480 mode_data.req = "rawi,rawo";
481 call hcs_$tty_order (ad.tty_index, "modes", addr (mode_data), state, code);
482 call check_error_code;
483 if code ^= 0 then call abort_attach ("Unable to set rawi,rawo modes.", "");
484 call hcs_$tty_order (ad.tty_index, "set_input_message_size", addr (ad.block_len), state, code);
485 call check_error_code;
486 if code ^= 0 then call abort_attach ("Unable to set message size.", "");
487
488 if ad.ibm3270_mode then do;
489 call line_control (SET_3270_MODE, 0);
490 if code ^= 0 then call abort_attach ("Unable to set 3270 mode", "");
491 end;
492 if ad.hasp_mode then do;
493 call line_control (SET_HASP_MODE, 0);
494 if code ^= 0 then call abort_attach ("Unable to set hasp mode.", "");
495 if ad.master_sw | ad.slave_sw then do;
496 call line_control (SET_MASTER_SLAVE_MODE, bin (ad.master_sw));
497 if code ^= 0 then call abort_attach ("Unable to set master or slave mode", "");
498 end;
499 end;
500 call line_control (SET_BID_LIMIT, ad.bid_limit);
501 if code ^= 0 then call abort_attach ("Unable to set bid limit.", "");
502 call line_control (CONFIGURE, bin (ad.transparent || ^ad.ascii));
503 if code ^= 0 then call abort_attach ("Unable to configure line.", "");
504 call line_control2 (SET_TTD_PARAMS, ad.ttd_time, ad.ttd_limit);
505 if code ^= 0 then call abort_attach ("Unable to set ttd params.", "");
506
507
508
509 ad.attach_description = iomodule_name;
510 do i = 1 to hbound (arg_option, 1);
511 ad.attach_description = ad.attach_description || " ";
512 ad.attach_description = ad.attach_description || arg_option (i);
513 end;
514 call hcs_$set_ips_mask ("0"b, mask);
515 iocbp -> iocb.attach_descrip_ptr = addr (ad.attach_description);
516 iocbp -> iocb.attach_data_ptr = adp;
517 iocbp -> iocb.open = bisync_open;
518 iocbp -> iocb.detach_iocb = bisync_detach;
519 call iox_$propagate (iocbp);
520 call hcs_$reset_ips_mask (mask, mask);
521 attach_return:
522 return;
523
524
525
526 cv_dec_arg: proc returns (fixed bin);
527
528 i = i + 1;
529 if i > hbound (arg_option, 1) then do;
530 code = error_table_$noarg;
531 call abort_attach ("No argument after ^a.", (arg_option (i-1)));
532 end;
533 on conversion go to bad_dec_arg;
534 return (bin (arg_option (i)));
535
536 bad_dec_arg:
537 code = 0;
538 call abort_attach ("Invalid decimal number. ^a", (arg_option (i)));
539
540 end cv_dec_arg;
541
542
543
544 abort_attach: proc (str1, str2);
545
546 dcl (str1, str2) char (*) aligned;
547
548 if com_err_sw then call com_err_ (code, iomodule_name, str1, str2);
549 if code = 0 then code = error_table_$badopt;
550 arg_code = code;
551
552 if adp ^= null then do;
553 if ad.tty_attached then call hcs_$tty_detach (ad.tty_index, 0, state, code);
554 if ad.channel ^= 0 then call ipc_$delete_ev_chn (ad.channel, code);
555 if ad.timer_channel ^= 0 then call ipc_$delete_ev_chn (ad.timer_channel, code);
556 if ad.attach_channel ^= 0 then call ipc_$delete_ev_chn (ad.attach_channel, code);
557 end;
558 if area_info.areap ^= null then call release_area_ (area_info.areap);
559 go to attach_return;
560
561 end abort_attach;
562
563 ^L
564
565
566 bisync_detach: entry (arg_iocbp, arg_code);
567
568 iocbp = arg_iocbp;
569 arg_code, code = 0;
570
571 adp = iocbp -> iocb.attach_data_ptr;
572
573 if ad.log_sw then do;
574 call iox_$close (ad.log_iocbp, code);
575 call iox_$detach_iocb (ad.log_iocbp, code);
576 end;
577
578 call hcs_$set_ips_mask ("0"b, mask);
579
580 if ad.attach_channel ^= 0 then do;
581 if ad.attach_channel_is_call then
582 call ipc_$decl_ev_wait_chn (ad.attach_channel, (0));
583 end;
584
585 if ad.hangup_sw then call hcs_$tty_order (ad.tty_index, "hangup", null, state, code);
586 call hcs_$tty_detach (ad.tty_index, 0, state, code);
587 dma.version = 1;
588 dma.event_channel = ad.attach_channel;
589 dma.channel_name = ad.device;
590 dma.dial_qual = "";
591 if ad.hangup_sw then call dial_manager_$release_channel (addr (dma), code);
592 else call dial_manager_$release_channel_no_hangup (addr (dma), code);
593 call ipc_$delete_ev_chn (ad.channel, code);
594 call ipc_$delete_ev_chn (ad.timer_channel, code);
595 call ipc_$delete_ev_chn (ad.attach_channel, code);
596 iocbp -> iocb.attach_descrip_ptr = null;
597 call iox_$propagate (iocbp);
598 call hcs_$reset_ips_mask (mask, mask);
599 call release_area_ (addr (work_area));
600 return;
601 ^L
602
603
604 bisync_open: entry (arg_iocbp, arg_mode, arg_sw, arg_code);
605
606 iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
607 arg_code, code = 0;
608 adp = iocbp -> iocb.attach_data_ptr;
609
610 open_mode = arg_mode;
611 if ^((open_mode = Stream_input) | (open_mode = Stream_output) | (open_mode = Stream_input_output)) then do;
612 arg_code = error_table_$bad_mode;
613 return;
614 end;
615
616 call hcs_$tty_state (ad.tty_index, state, code);
617 if code ^= 0 then do;
618 arg_code = code;
619 return;
620 end;
621
622 ad.open_description = rtrim (iox_modes (open_mode));
623 ad.write_error_code = 0;
624
625 call hcs_$set_ips_mask ("0"b, mask);
626 if ((open_mode = Stream_input) | (open_mode = Stream_input_output)) then do;
627 iocbp -> iocb.get_chars = bisync_get_chars;
628 iocbp -> iocb.get_line = bisync_get_line;
629 iocbp -> iocb.position = bisync_position;
630 iocbp -> iocb.control = bisync_control;
631 call line_control (ACCEPT_BID, 0);
632 end;
633 ad.input_buf_len = 2 * ad.block_len;
634 allocate input_block in (work_area);
635 ad.last_input_blockp = ad.input_blockp;
636 ad.input_buf_ptr = addr (input_block.input_buffer);
637 ad.unscanned_data_len = 0;
638 ad.scanned_data_len = 0;
639 ad.input_state = 1;
640 ad.output_buf_used = 0;
641 ad.saved_eot = "0"b;
642 if ((open_mode = Stream_output) | (open_mode = Stream_input_output)) then do;
643 iocbp -> iocb.put_chars = bisync_put_chars;
644 iocbp -> iocb.control = bisync_control;
645 ad.output_buf_len = ad.block_len + BISYNC_OVERHEAD;
646 allocate output_buffer in (work_area);
647 ad.output_buf_left = ad.output_buf_len;
648 ad.output_mode = "1"b;
649 end;
650
651 iocbp -> iocb.close = bisync_close;
652 iocbp -> iocb.open_descrip_ptr = addr (ad.open_description);
653 call iox_$propagate (iocbp);
654 call hcs_$reset_ips_mask (mask, mask);
655 return;
656 ^L
657
658
659 bisync_close: entry (arg_iocbp, arg_code);
660
661 iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
662 arg_code, code = 0;
663 adp = iocbp -> iocb.attach_data_ptr;
664
665
666 if ad.output_mode then do;
667 if ad.multi_record & (ad.output_buf_used > 0) then call transmit_block_timed (30);
668 else time_out = "0"b;
669 if ^time_out then do;
670 substr (output_buffer, 1, 1) = ad.eot;
671 ad.output_buf_used = 1;
672 call transmit_block_timed (30);
673 end;
674 free output_buffer;
675 end;
676 call internal_resetread;
677 free input_block;
678
679 call hcs_$set_ips_mask ("0"b, mask);
680 iocbp -> iocb.open_descrip_ptr = null;
681 iocbp -> iocb.open = bisync_open;
682 iocbp -> iocb.detach_iocb = bisync_detach;
683 iocbp -> iocb.control = iox_$err_no_operation;
684 call iox_$propagate (iocbp);
685 call hcs_$reset_ips_mask (mask, mask);
686 return;
687
688 ^L
689
690
691 bisync_put_chars: entry (arg_iocbp, arg_data_ptr, arg_data_len, arg_code);
692
693 iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
694 arg_code, code = 0;
695 adp = iocbp -> iocb.attach_data_ptr;
696 data_ptr = arg_data_ptr;
697 data_len = arg_data_len;
698
699 if data_len < 0 then do;
700 arg_code = error_table_$bad_arg;
701 return;
702 end;
703
704 if ad.write_error_code ^= 0 then do;
705 rpt_write_error:
706 arg_code = ad.write_error_code;
707 ad.write_error_code = 0;
708 return;
709 end;
710
711 real_transparent = ad.transparent & ^ad.temp_nontransparent;
712 ad.temp_nontransparent = "0"b;
713
714 remaining_len = data_len;
715 offset = 1;
716
717 do while (remaining_len >= 0);
718 if real_transparent then call format_transparent_block;
719 else call format_nontransparent_block;
720 if ad.multi_record & (remaining_len < 0) then do;
721 if ad.multi_record_limit = 0 then return;
722 if ad.record_count < ad.multi_record_limit then return;
723 end;
724 call transmit_block;
725 if ad.write_error_code ^= 0 then go to rpt_write_error;
726 if code ^= 0 then do;
727 arg_code = code;
728 return;
729 end;
730 end;
731
732 return;
733 ^L
734
735
736 format_nontransparent_block: proc;
737
738 dcl (cl, dl) fixed bin;
739 dcl etb_sw bit (1);
740
741 if ad.ascii then cl = 3;
742 else cl = 4;
743
744 if (remaining_len + cl) > ad.output_buf_left then do;
745 if ad.output_buf_used > 0 then return;
746 dl = ad.output_buf_left - cl;
747 etb_sw = "1"b;
748 end;
749 else do;
750 dl = remaining_len;
751 etb_sw = "0"b;
752 end;
753
754 if ad.output_buf_used > 0 then
755 substr (output_buffer, ad.last_etx, 1) = ad.itb;
756 substr (output_buffer, ad.output_buf_used+1, 1) = ad.stx;
757 if dl > 0 then
758 substr (output_buffer, ad.output_buf_used+2, dl) = substr (data_arg, offset, dl);
759 remaining_len = remaining_len - dl;
760 offset = offset + dl;
761 ad.last_etx = ad.output_buf_used + dl + 2;
762 if etb_sw | ad.use_etb then substr (output_buffer, ad.last_etx, 1) = ad.etb;
763 else substr (output_buffer, ad.last_etx, 1) = ad.etx;
764 ad.output_buf_used = ad.output_buf_used + dl + 2;
765 ad.output_buf_left = ad.output_buf_left - dl - 2;
766 if ad.ascii then do;
767 ad.output_buf_used = ad.output_buf_used + 1;
768 substr (output_buffer, ad.output_buf_used, 1) = low (1);
769 ad.output_buf_left = ad.output_buf_left - 1;
770 end;
771 else ad.output_buf_left = ad.output_buf_left - 2;
772
773 ad.record_count = ad.record_count + 1;
774 if remaining_len = 0 then remaining_len = -1;
775 return;
776
777 end format_nontransparent_block;
778 ^L
779
780
781 format_transparent_block: proc;
782
783 dcl (i, dl, real_chars, moved) fixed bin;
784 dcl etb_sw bit (1);
785
786 if (remaining_len + 6) > ad.output_buf_left then do;
787 if ad.output_buf_used > 0 then return;
788 dl = ad.output_buf_left - 6;
789 etb_sw = "1"b;
790 end;
791 else do;
792 dl = remaining_len;
793 etb_sw = "0"b;
794 end;
795
796 format_transparent_loop:
797 real_chars = dl + 4;
798 i = count_dle (substraddr (data_arg, offset), dl);
799 if i > 0 then
800 if (real_chars + i) > ad.output_buf_left then do;
801 if ad.output_buf_used > 0 then return;
802 dl = dl - 1;
803 etb_sw = "1"b;
804 go to format_transparent_loop;
805 end;
806
807 if ad.output_buf_used > 0 then
808 substr (output_buffer, ad.last_etx, 1) = ad.itb;
809
810 substr (output_buffer, ad.output_buf_used+1, 1) = ad.dle;
811 substr (output_buffer, ad.output_buf_used+2, 1) = ad.stx;
812 ad.output_buf_used = ad.output_buf_used + 2;
813 ad.output_buf_left = ad.output_buf_left - 2;
814 moved = 0;
815 do while (moved < dl);
816 i = index (substr (data_arg, offset, dl - moved), ad.dle);
817 if i = 1 then do;
818 substr (output_buffer, ad.output_buf_used+1, 1) = ad.dle;
819 substr (output_buffer, ad.output_buf_used+2, 1) = ad.dle;
820 ad.output_buf_used = ad.output_buf_used + 2;
821 ad.output_buf_left = ad.output_buf_left - 2;
822 offset = offset + 1;
823 moved = moved + 1;
824 remaining_len = remaining_len - 1;
825 end;
826 else do;
827 if i = 0 then i = dl - moved;
828 else i = i - 1;
829 substr (output_buffer, ad.output_buf_used+1, i) = substr (data_arg, offset, i);
830 ad.output_buf_used = ad.output_buf_used + i;
831 ad.output_buf_left = ad.output_buf_left - i;
832 offset = offset + i;
833 moved = moved + i;
834 remaining_len = remaining_len - i;
835 end;
836 end;
837 substr (output_buffer, ad.output_buf_used+1, 1) = ad.dle;
838 if etb_sw | ad.use_etb then substr (output_buffer, ad.output_buf_used+2, 1) = ad.etb;
839 else substr (output_buffer, ad.output_buf_used+2, 1) = ad.etx;
840 ad.last_etx = ad.output_buf_used + 2;
841 ad.output_buf_used = ad.output_buf_used + 2;
842 ad.output_buf_left = ad.output_buf_left - 4;
843
844 ad.record_count = ad.record_count + 1;
845 if remaining_len = 0 then remaining_len = -1;
846 return;
847
848 end format_transparent_block;
849
850
851
852 count_dle: proc (p, l) returns (fixed bin);
853
854 dcl p ptr;
855 dcl l fixed bin;
856 dcl c char (l) based (p);
857 dcl (i, j, k) fixed bin;
858
859 if l = 0 then return (0);
860 i = 1;
861 j = 0;
862 do while (i <= l);
863 k = index (substr (c, i), ad.dle);
864 if k = 0 then return (j);
865 j = j + 1;
866 i = i + k;
867 end;
868 return (j);
869
870 end count_dle;
871 ^L
872
873
874 transmit_block: proc;
875
876 dcl (i, j) fixed bin (21);
877 dcl p ptr;
878 dcl time_limit bit (1) init ("0"b);
879
880 dcl 1 write_status aligned,
881 2 ev_chn fixed bin (71),
882 2 output_pending bit (1) unal;
883
884 transmit_block_start:
885 i = 0;
886 do while (i < ad.output_buf_used);
887
888 write_status.output_pending = "1"b;
889 do while (write_status.output_pending);
890 call hcs_$tty_order (ad.tty_index, "write_status", addr (write_status), state, code);
891 call check_error_code;
892 if ad.write_error_code ^= 0 then return;
893 if code ^= 0 then go to transmit_end;
894 if write_status.output_pending then do;
895 call hide_away_input;
896 if code ^= 0 then return;
897 if ad.write_error_code ^= 0 then return;
898 if time_limit then do;
899 call set_time (n_sec);
900 call block (ad.channel, 2);
901 end;
902 else call block (ad.channel, 1);
903 if code ^= 0 then go to transmit_end;
904 if event_info.channel_id = ad.timer_channel then do;
905 time_out = "1"b;
906 go to transmit_end;
907 end;
908 end;
909 end;
910
911 if ad.delay > 0 then call timer_manager_$sleep (ad.delay, "10"b);
912
913 p = substraddr (output_buffer, i+1);
914 call hcs_$tty_write (ad.tty_index, p, 0, ad.output_buf_used - i, j, state, code);
915 call check_error_code;
916 if ad.write_error_code ^= 0 then return;
917 if code ^= 0 then go to transmit_end;
918 if ad.log_sw then call iox_$write_record (ad.log_iocbp, p, j, (0));
919 i = i + j;
920 if i < ad.output_buf_used then do;
921 call hide_away_input;
922 if code ^= 0 then return;
923 if ad.write_error_code ^= 0 then return;
924 end;
925 end;
926
927 code = 0;
928 transmit_end:
929 ad.output_buf_used = 0;
930 ad.output_buf_left = ad.block_len;
931 ad.record_count = 0;
932
933 return;
934
935 transmit_block_timed: entry (n_sec);
936
937 dcl n_sec fixed bin;
938
939 time_limit = "1"b;
940 time_out = "0"b;
941 go to transmit_block_start;
942
943 end transmit_block;
944 ^L
945
946
947 bisync_get_chars: entry (arg_iocbp, arg_buf_ptr, arg_buf_len, arg_data_len, arg_code);
948
949 iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
950 adp = iocbp -> iocb.attach_data_ptr;
951 buf_ptr = arg_buf_ptr;
952 buf_len = arg_buf_len;
953 arg_data_len, data_len = 0;
954 remaining_len = buf_len;
955 order_sw = "0"b;
956 hbuf_ptr = null;
957
958 get_chars_join:
959 code, arg_code = 0;
960 header_found, data_found = "0"b;
961
962 if ad.saved_eot then do;
963 ad.saved_eot = "0"b;
964 eot_found = "1"b;
965 go to get_chars_return;
966 end;
967
968 get_chars_retry:
969 etb_found = "0"b;
970 soh_found = "0"b;
971 etx_found = "0"b;
972 stx_found = "0"b;
973 eot_found = "0"b;
974 do while ((remaining_len > 0) & ^etx_found);
975 if ad.scanned_data_len > 0 then
976 call move_scanned_data (min (ad.scanned_data_len, remaining_len));
977 else do;
978 call scan_more_data;
979 if code ^= 0 then do;
980 arg_code = code;
981 return;
982 end;
983 if eot_found then do;
984 if ^(header_found | data_found) then go to get_chars_return;
985 ad.saved_eot = "1"b;
986 go to get_chars_return;
987 end;
988 end;
989 end;
990
991 if (data_len = 0) & etx_found & ^(stx_found | soh_found) then go to get_chars_retry;
992
993
994 get_chars_return:
995 if order_sw then go to get_chars_order_return;
996 if eot_found then code = error_table_$end_of_info;
997 arg_data_len = data_len;
998 return;
999 ^L
1000
1001
1002 get_chars_order:
1003 buf_ptr = get_chars_info.buf_ptr;
1004 buf_len = get_chars_info.buf_len;
1005 remaining_len = get_chars_info.buf_len;
1006 hbuf_ptr = get_chars_info.hbuf_ptr;
1007 hbuf_len = get_chars_info.hbuf_len;
1008 data_len, header_len = 0;
1009 get_chars_info.data_len = 0;
1010 get_chars_info.header_len = 0;
1011 string (get_chars_info.flags) = "0"b;
1012 order_sw = "1"b;
1013 go to get_chars_join;
1014
1015
1016
1017 get_chars_order_return:
1018 if eot_found then get_chars_info.eot = "1"b;
1019 else do;
1020 if header_found then do;
1021 get_chars_info.header_len = header_len;
1022 get_chars_info.soh = "1"b;
1023 end;
1024 if data_found then do;
1025 get_chars_info.data_len = data_len;
1026 if etb_found then get_chars_info.etb = "1"b;
1027 else if etx_found then get_chars_info.etx = "1"b;
1028 end;
1029 end;
1030 go to control_return;
1031 ^L
1032
1033
1034 bisync_get_line: entry (arg_iocbp, arg_buf_ptr, arg_buf_len, arg_data_len, arg_code);
1035
1036 iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
1037 adp = iocbp -> iocb.attach_data_ptr;
1038 buf_ptr = arg_buf_ptr;
1039 buf_len = arg_buf_len;
1040 arg_data_len, data_len = 0;
1041 arg_code, code = 0;
1042 remaining_len = buf_len;
1043 nl_found = "0"b;
1044 ad.saved_eot = "0"b;
1045
1046 do while ((remaining_len > 0) & ^nl_found);
1047 if ad.scanned_data_len > 0 then do;
1048 i = index (scanned_data, nl);
1049 if i = 0 then i = ad.scanned_data_len;
1050 else nl_found = "1"b;
1051 call move_scanned_data (min (i, remaining_len));
1052 end;
1053 else do;
1054 call scan_more_data;
1055 if code ^= 0 then do;
1056 arg_code = code;
1057 return;
1058 end;
1059 end;
1060 end;
1061
1062 if data_len > 0 then if substr (buf_arg, data_len, 1) ^= nl then
1063 arg_code = error_table_$long_record;
1064 arg_data_len = data_len;
1065 return;
1066
1067 ^L
1068
1069
1070 scan_more_data: proc;
1071
1072 dcl (i, j) fixed bin (21);
1073 dcl block_ok bit (1);
1074 dcl p ptr;
1075
1076 block_ok = "1"b;
1077 go to get_more_data;
1078
1079 scan_more_data_noblock: entry;
1080 block_ok = "0"b;
1081
1082 get_more_data: code = 0;
1083 do while (ad.unscanned_data_len = 0);
1084 if input_block.next_blockp = null then do;
1085 call hcs_$tty_read (ad.tty_index, ad.input_buf_ptr, 0, ad.input_buf_len, i, state, code);
1086 call check_error_code;
1087 if code ^= 0 then return;
1088 end;
1089 else do;
1090 p = input_block.next_blockp;
1091 free input_block;
1092 ad.input_blockp = p;
1093 ad.input_buf_ptr = addr (input_block.input_buffer);
1094 i = input_block.data_len;
1095 end;
1096 if i = 0 then do;
1097 if ^block_ok then return;
1098 call block (ad.channel, 1);
1099 if code ^= 0 then return;
1100 end;
1101 else do;
1102 if ad.log_sw then call iox_$write_record (ad.log_iocbp, ad.input_buf_ptr, i, (0));
1103 ad.unscanned_data_len = i;
1104 ad.unscanned_data_ptr = ad.input_buf_ptr;
1105 end;
1106 end;
1107
1108
1109
1110 if ad.transparent then go to get_data_trans (ad.input_state);
1111 else go to get_data_non_trans (ad.input_state);
1112
1113 get_data_non_trans (1):
1114 if substr (unscanned_data, 1, 1) = ad.stx then do;
1115 stx_found = "1"b;
1116 ad.input_state = 2;
1117 call advance_unscanned_data (1);
1118 go to get_more_data;
1119 end;
1120 if substr (unscanned_data, 1, 1) = ad.soh then do;
1121 soh_found = "1"b;
1122 ad.input_state = 6;
1123 call advance_unscanned_data (1);
1124 go to get_more_data;
1125 end;
1126 if ^ad.break_on_eot | (substr (unscanned_data, 1, 1) ^= ad.eot) then do;
1127 call advance_unscanned_data (1);
1128 go to get_more_data;
1129 end;
1130 call advance_unscanned_data (1);
1131 eot_found = "1"b;
1132 return;
1133
1134 get_data_non_trans (2):
1135 i = index (unscanned_data, ad.etx);
1136 if i = 1 then do;
1137 call advance_unscanned_data (1);
1138 etx_found = "1"b;
1139 if ad.ascii then ad.input_state = 3;
1140 else ad.input_state = 1;
1141 return;
1142 end;
1143 if ad.multi_record then do;
1144 j = index (unscanned_data, ad.itb);
1145 if j ^= 0 then do;
1146 if j = 1 then do;
1147 call advance_unscanned_data (1);
1148 etx_found = "1"b;
1149 if ad.ascii then ad.input_state = 4;
1150 else ad.input_state = 5;
1151 return;
1152 end;
1153 else if i = 0 then i = j;
1154 else i = min (i, j);
1155 end;
1156 end;
1157
1158 if i = 0 then i = ad.unscanned_data_len;
1159 else i = i - 1;
1160 j = index (unscanned_data, ad.etb);
1161 if j = 1 then do;
1162 call advance_unscanned_data (1);
1163 if ad.ascii then ad.input_state = 3;
1164 else ad.input_state = 1;
1165 if ad.break_on_etb then do;
1166 etb_found = "1"b;
1167 etx_found = "1"b;
1168 return;
1169 end;
1170 else go to get_more_data;
1171 end;
1172 if j ^= 0 then i = min (i, j-1);
1173 ad.scanned_data_len = i;
1174 ad.scanned_data_ptr = ad.unscanned_data_ptr;
1175 call advance_unscanned_data (i);
1176 return;
1177
1178 get_data_non_trans (3):
1179 call advance_unscanned_data (1);
1180 ad.input_state = 1;
1181 go to get_more_data;
1182
1183 get_data_non_trans (4):
1184 call advance_unscanned_data (1);
1185 ad.input_state = 5;
1186 go to get_more_data;
1187
1188 get_data_non_trans (5):
1189 if substr (unscanned_data, 1, 1) = ad.stx then ad.input_state = 1;
1190 else do;
1191 stx_found = "1"b;
1192 ad.input_state = 2;
1193 end;
1194 go to get_more_data;
1195
1196 get_data_non_trans (6):
1197 i = index (unscanned_data, ad.etx);
1198 if i = 1 then do;
1199 get_data_non_trans_6a:
1200 call advance_unscanned_data (1);
1201 etx_found = "1"b;
1202 if ad.ascii then ad.input_state = 3;
1203 else ad.input_state = 1;
1204 return;
1205 end;
1206 j = index (unscanned_data, ad.etb);
1207 if i = 0 then i = j;
1208 else if j ^= 0 then i = min (i, j);
1209 j = index (unscanned_data, ad.stx);
1210 if i = 0 then i = j;
1211 else if j ^= 0 then i = min (i, j);
1212 if i = 0 then do;
1213 ad.scanned_data_len = ad.unscanned_data_len;
1214 ad.scanned_data_ptr = ad.unscanned_data_ptr;
1215 ad.unscanned_data_len = 0;
1216 return;
1217 end;
1218 if i = 1 then do;
1219 if substr (unscanned_data, 1, 1) = ad.stx then do;
1220 call advance_unscanned_data (1);
1221 stx_found = "1"b;
1222 soh_found = "0"b;
1223 ad.input_state = 2;
1224 go to get_more_data;
1225 end;
1226 if substr (unscanned_data, 1, 1) = ad.etb & ^ad.break_on_etb then do;
1227 call advance_unscanned_data (1);
1228 if ad.ascii then ad.input_state = 3;
1229 else ad.input_state = 1;
1230 go to get_more_data;
1231 end;
1232 etb_found = (substr (unscanned_data, 1, 1) = ad.etb);
1233 go to get_data_non_trans_6a;
1234 end;
1235 i = i - 1;
1236 ad.scanned_data_len = i;
1237 ad.scanned_data_ptr = ad.unscanned_data_ptr;
1238 call advance_unscanned_data (i);
1239 return;
1240
1241
1242 get_data_trans (1):
1243 i = index (unscanned_data, ad.dle);
1244 if i = 0 then do;
1245 ad.unscanned_data_len = 0;
1246 go to get_more_data;
1247 end;
1248 call advance_unscanned_data (i);
1249 ad.input_state = 2;
1250 go to get_more_data;
1251
1252 get_data_trans (2):
1253 if substr (unscanned_data, 1, 1) = ad.stx then do;
1254 call advance_unscanned_data (1);
1255 ad.input_state = 3;
1256 stx_found = "1"b;
1257 go to get_more_data;
1258 end;
1259 ad.input_state = 1;
1260 go to get_more_data;
1261
1262 get_data_trans (3):
1263 i = index (unscanned_data, ad.dle);
1264 if i = 1 then do;
1265 call advance_unscanned_data (1);
1266 ad.input_state = 4;
1267 go to get_more_data;
1268 end;
1269 if i = 0 then i = ad.unscanned_data_len;
1270 else i = i-1;
1271 ad.scanned_data_len = i;
1272 ad.scanned_data_ptr = ad.unscanned_data_ptr;
1273 call advance_unscanned_data (i);
1274 return;
1275
1276 get_data_trans (4):
1277 if substr (unscanned_data, 1, 1) = ad.dle then do;
1278 ad.scanned_data_len = 1;
1279 ad.scanned_data_ptr = ad.unscanned_data_ptr;
1280 ad.input_state = 3;
1281 call advance_unscanned_data (1);
1282 return;
1283 end;
1284 if substr (unscanned_data, 1, 1) = ad.etb then do;
1285 call advance_unscanned_data (1);
1286 ad.input_state = 1;
1287 if ad.break_on_etb then do;
1288 etx_found = "1"b;
1289 return;
1290 end;
1291 else go to get_more_data;
1292 end;
1293 if substr (unscanned_data, 1, 1) = ad.etx then do;
1294 trans_etx: call advance_unscanned_data (1);
1295 ad.input_state = 1;
1296 etx_found = "1"b;
1297 return;
1298 end;
1299 if ad.multi_record then if substr (unscanned_data, 1, 1) = ad.itb then go to trans_etx;
1300 ad.scanned_data_ptr = addr (ad.dle);
1301 ad.scanned_data_len = 1;
1302 ad.input_state = 3;
1303 return;
1304
1305 end scan_more_data;
1306
1307
1308
1309 move_scanned_data: proc (amt);
1310
1311 dcl amt fixed bin (21);
1312 dcl i fixed bin (21);
1313
1314 if soh_found then do;
1315 if hbuf_ptr ^= null then do;
1316 i = min (amt, hbuf_len - header_len);
1317 if i > 0 then substr (header_arg, header_len + 1, i) = substr (scanned_data, 1, i);
1318 header_len = header_len + i;
1319 call advance_scanned_data (amt);
1320 header_found = "1"b;
1321 end;
1322 end;
1323 else do;
1324 substr (buf_arg, data_len + 1, amt) = substr (scanned_data, 1, amt);
1325 data_len = data_len + amt;
1326 call advance_scanned_data (amt);
1327 remaining_len = remaining_len - amt;
1328 data_found = "1"b;
1329 end;
1330 return;
1331
1332 end move_scanned_data;
1333
1334
1335
1336 advance_unscanned_data: proc (amt);
1337
1338 dcl amt fixed bin (21);
1339
1340 ad.unscanned_data_ptr = substraddr (unscanned_data, amt+1);
1341 ad.unscanned_data_len = ad.unscanned_data_len - amt;
1342 return;
1343
1344 end advance_unscanned_data;
1345
1346
1347
1348 advance_scanned_data: proc (amt);
1349
1350 dcl amt fixed bin (21);
1351
1352 ad.scanned_data_ptr = substraddr (scanned_data, amt+1);
1353 ad.scanned_data_len = ad.scanned_data_len - amt;
1354 return;
1355
1356 end advance_scanned_data;
1357
1358
1359
1360
1361
1362
1363 hide_away_input: proc;
1364
1365 dcl 1 read_status aligned automatic like rw_status;
1366 dcl p ptr;
1367
1368 read_status.flag = "1"b;
1369 do while (read_status.flag);
1370 call hcs_$tty_order (ad.tty_index, "read_status", addr (read_status), state, code);
1371 call check_error_code;
1372 if code ^= 0 then return;
1373 if read_status.flag then do;
1374 allocate input_block in (work_area) set (p);
1375 call hcs_$tty_read (ad.tty_index, addr (p -> input_block.input_buffer), 0, ad.input_buf_len,
1376 p -> input_block.data_len, state, code);
1377 call check_error_code;
1378 if code ^= 0 then do;
1379 free p -> input_block;
1380 return;
1381 end;
1382 if p -> input_block.data_len > 0 then do;
1383 ad.last_input_blockp -> input_block.next_blockp = p;
1384 ad.last_input_blockp = p;
1385 end;
1386 else free p -> input_block;
1387 end;
1388 end;
1389 return;
1390
1391 end hide_away_input;
1392 ^L
1393
1394
1395 bisync_control: entry (arg_iocbp, arg_order, arg_info_ptr, arg_code);
1396
1397 iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
1398 adp = iocbp -> iocb.attach_data_ptr;
1399 info_ptr = arg_info_ptr;
1400 arg_code, code = 0;
1401 order = arg_order;
1402
1403 i = 0;
1404 if order = "resetread" then do;
1405 i = 1;
1406 call internal_resetread;
1407 end;
1408 else if order = "resetwrite" then do;
1409 i = 2;
1410 ad.output_buf_used = 0;
1411 ad.output_buf_left = ad.output_buf_len;
1412 end;
1413 else if order = "abort" then do;
1414 i = 3;
1415 call internal_resetread;
1416 ad.output_buf_used = 0;
1417 ad.output_buf_left = ad.output_buf_len;
1418 end;
1419 if i ^= 0 then call hcs_$tty_abort (ad.tty_index, (i), state, code);
1420
1421 else if order = "event_info" then do;
1422 event_info_channel = ad.channel;
1423 code = 0;
1424 end;
1425
1426 else if order = "read_status" then do;
1427 code = 0;
1428 rw_status.channel = ad.channel;
1429 if ad.scanned_data_len > 0 then rw_status.flag = "1"b;
1430 else if ad.saved_eot then rw_status.flag = "1"b;
1431 else do;
1432 retry_read_status: eot_found, etx_found, stx_found, soh_found, etb_found = "0"b;
1433 call scan_more_data_noblock;
1434 if ad.scanned_data_len > 0 then rw_status.flag = "1"b;
1435 else if eot_found then do;
1436 ad.saved_eot = "1"b;
1437 rw_status.flag = "1"b;
1438 end;
1439 else if etx_found then go to retry_read_status;
1440 else rw_status.flag = "0"b;
1441 code = 0;
1442 end;
1443 end;
1444
1445 else if order = "set_bid_limit" then do;
1446 ad.bid_limit = order_val;
1447 call line_control (SET_BID_LIMIT, ad.bid_limit);
1448 end;
1449
1450 else if order = "get_bid_limit" then do;
1451 order_val = ad.bid_limit;
1452 code = 0;
1453 end;
1454
1455 else if order = "set_bsc_modes" then do;
1456 ad.transparent = bsc_modes.transparent;
1457 ad.ascii = ^bsc_modes.ebcdic;
1458 call line_control (CONFIGURE, bin (ad.transparent || ^ad.ascii));
1459 call set_control_chars;
1460 end;
1461
1462 else if order = "get_bsc_modes" then do;
1463 bsc_modes.transparent = ad.transparent;
1464 bsc_modes.ebcdic = ^ad.ascii;
1465 code = 0;
1466 end;
1467
1468 else if order = "runout" then do;
1469 code = 0;
1470
1471 if ad.output_etb_mode then do;
1472 ad.use_etb = "0"b;
1473
1474 call iocbp -> iocb.put_chars (iocbp, addr (empty_buffer), 0, code);
1475 ad.use_etb = "1"b;
1476 end;
1477
1478 if ad.multi_record & code = 0 then
1479 if ad.output_mode then
1480 if ad.output_buf_used > 0 then
1481 call transmit_block;
1482 if ad.write_error_code ^= 0 & code = 0 then do;
1483 code = ad.write_error_code;
1484 ad.write_error_code = 0;
1485 end;
1486
1487 end;
1488
1489 else if order = "set_size" then do;
1490 if order_val > ad.max_block_len then code = error_table_$buffer_big;
1491 else do;
1492 ad.block_len = order_val;
1493 if ad.output_mode then
1494 ad.output_buf_left = max (0, ad.block_len - ad.output_buf_used);
1495 code = 0;
1496 end;
1497 end;
1498
1499 else if order = "get_size" then do;
1500 order_val = ad.block_len;
1501 code = 0;
1502 end;
1503
1504 else if order = "set_multi_record_mode" then do;
1505 code = 0;
1506 if info_ptr = null then do;
1507 ad.multi_record = "1"b;
1508 ad.multi_record_limit = 0;
1509 end;
1510 else do;
1511 ad.multi_record_limit = max (0, order_val);
1512 ad.multi_record = (ad.multi_record_limit ^= 1);
1513 end;
1514 end;
1515
1516 else if order = "get_multi_record_mode" then do;
1517 if ^ad.multi_record then order_val = 1;
1518 else order_val = ad.multi_record_limit;
1519 code = 0;
1520 end;
1521
1522 else if order = "hangup_proc" then do;
1523 call ipc_$decl_ev_call_chn (ad.attach_channel, hangup_proc.entry_var, hangup_proc.data_ptr,
1524 hangup_proc.prior, code);
1525 if code ^= 0 then call convert_ipc_code_ (code);
1526 if code = 0 then ad.attach_channel_is_call = "1"b;
1527 end;
1528
1529 else if order = "send_nontransparent_msg" then do;
1530 call iox_$control (iocbp, "runout", null, code);
1531 if code = 0 then do;
1532 ad.temp_nontransparent = "1"b;
1533 call iox_$put_chars (iocbp, addr (order_msg.data), length (order_msg.data), code);
1534 ad.temp_nontransparent = "0"b;
1535 if code = 0 then call iox_$control (iocbp, "runout", null, code);
1536 end;
1537 end;
1538
1539 else if order = "end_write_mode" then call end_write_mode;
1540
1541 else if order = "set_polling_addr" then do;
1542 if info_ptr = null then do;
1543 valchar.data_len = 0;
1544 valchar.data = "";
1545 end;
1546 else do;
1547 valchar.data_len = min (order_msg.data_len, length (valchar.data));
1548 valchar.data = order_msg.data;
1549 end;
1550 call line_control_val_set (SET_POLLING_ADDR);
1551 end;
1552
1553 else if order = "poll" then call line_control (START_POLL, 0);
1554
1555 else if order = "get_chars" then go to get_chars_order;
1556
1557 else if order = "io_call" then call bisync_io_call;
1558
1559 else do;
1560 call hcs_$tty_order (ad.tty_index, order, info_ptr, state, code);
1561 call check_error_code;
1562 if order = "write_status" then do;
1563 rw_status.channel = ad.channel;
1564 if ad.write_error_code ^= 0 then do;
1565 code = ad.write_error_code;
1566 ad.write_error_code = 0;
1567 end;
1568 end;
1569 end;
1570
1571 control_return:
1572 arg_code = code;
1573 return;
1574
1575
1576
1577 internal_resetread: proc;
1578
1579 dcl p ptr;
1580
1581 ad.input_state = 1;
1582 ad.scanned_data_len, ad.unscanned_data_len = 0;
1583 ad.saved_eot = "0"b;
1584
1585 do while (input_block.next_blockp ^= null);
1586 p = input_block.next_blockp;
1587 free input_block;
1588 ad.input_blockp = p;
1589 ad.input_buf_ptr = addr (input_block.input_buffer);
1590 end;
1591 return;
1592
1593 end internal_resetread;
1594 ^L
1595
1596
1597
1598 end_write_mode: proc;
1599
1600 dcl 1 write_status aligned automatic like rw_status;
1601
1602 if ^ad.output_mode then do;
1603 code = error_table_$no_operation;
1604 return;
1605 end;
1606
1607 if ad.multi_record & (ad.output_buf_used) > 0 then do;
1608 call transmit_block;
1609 if code ^= 0 then return;
1610 if ad.write_error_code ^= 0 then do;
1611 end_write_mode_err:
1612 code = ad.write_error_code;
1613 ad.write_error_code = 0;
1614 return;
1615 end;
1616 end;
1617 substr (output_buffer, 1, 1) = ad.eot;
1618 ad.output_buf_used = 1;
1619 call transmit_block;
1620 if code ^= 0 then return;
1621 if ad.write_error_code ^= 0 then go to end_write_mode_err;
1622
1623
1624
1625 write_status.flag = "1"b;
1626 do while (write_status.flag);
1627 call hcs_$tty_order (ad.tty_index, "write_status", addr (write_status), state, code);
1628 call check_error_code;
1629 if code ^= 0 then return;
1630 if ad.write_error_code ^= 0 then go to end_write_mode_err;
1631 if write_status.flag then do;
1632 call hide_away_input;
1633 if code ^= 0 then return;
1634 if ad.write_error_code ^= 0 then go to end_write_mode_err;
1635 call block (ad.channel, 1);
1636 if code ^= 0 then return;
1637 end;
1638 end;
1639
1640
1641
1642 end_write_mode0:
1643 call set_time (5);
1644 end_write_mode1:
1645 call block (ad.channel, 2);
1646 if code ^= 0 then return;
1647 if event_info.channel_id ^= ad.timer_channel then do;
1648 call hide_away_input;
1649 if code ^= 0 then return;
1650 if ad.write_error_code ^= 0 then go to end_write_mode_err;
1651 go to end_write_mode1;
1652 end;
1653
1654
1655
1656 call check_line_status;
1657 if code ^= 0 & code ^= error_table_$no_line_status then return;
1658 ad.fnp_output_pending = "0"b;
1659 ad.fnp_output_reported = "0"b;
1660 if ad.write_error_code ^= 0 then go to end_write_mode_err;
1661
1662
1663
1664 call line_control (REPORT_WRITE_STATUS, 0);
1665 if code ^= 0 then return;
1666 if ad.write_error_code ^= 0 then go to end_write_mode_err;
1667 call set_time (5);
1668 call block (ad.channel, 2);
1669 if code ^= 0 then return;
1670 if event_info.channel_id ^= ad.timer_channel then do;
1671 call hide_away_input;
1672 if code ^= 0 then return;
1673 if ad.write_error_code ^= 0 then go to end_write_mode_err;
1674 if ad.fnp_output_reported then do;
1675 if ad.fnp_output_pending then go to end_write_mode1;
1676 else return;
1677 end;
1678 end;
1679 go to end_write_mode0;
1680
1681 end end_write_mode;
1682 ^L
1683
1684
1685 bisync_io_call: proc;
1686
1687 dcl i fixed bin;
1688 dcl p ptr;
1689 dcl 1 info aligned,
1690 2 id char (4),
1691 2 baud_rate fixed bin (17) unal,
1692 2 reserved bit (54) unal,
1693 2 type fixed bin;
1694
1695 dcl 1 auto_rw_status aligned like rw_status automatic;
1696 dcl event_info_channel fixed bin (71);
1697 dcl 1 auto_bsc_modes like bsc_modes aligned automatic;
1698 dcl 1 order_msg aligned based (p),
1699 2 data_len fixed bin,
1700 2 data char (i);
1701 dcl get_chars_data char (i) based;
1702 dcl 1 auto_get_chars_info like get_chars_info aligned automatic;
1703
1704 io_call_infop = info_ptr;
1705 order = io_call_info.order_name;
1706 caller = io_call_info.caller_name;
1707 rpt = io_call_info.report;
1708 err = io_call_info.error;
1709
1710 if order = "info" then do;
1711 call iox_$control (iocbp, "info", addr (info), code);
1712 if code = 0 then
1713 call rpt ("^a: Terminal id=""^a"", baud_rate=^d, type=^d.",
1714 caller, info.id, info.baud_rate, info.type);
1715 end;
1716
1717 else if order = "read_status" then do;
1718 info_ptr = addr (auto_rw_status);
1719 call iox_$control (iocbp, "read_status", info_ptr, code);
1720 if code = 0 then
1721 call rpt ("^a: Event channel=^.3b, input is ^[^;not ^]available.",
1722 caller, unspec (rw_status.channel), rw_status.flag);
1723 end;
1724
1725 else if order = "write_status" then do;
1726 info_ptr = addr (auto_rw_status);
1727 call iox_$control (iocbp, "write_status", info_ptr, code);
1728 if code = 0 then
1729 call rpt ("^a: Event channel=^.3b, output is ^[^;not ^]pending.",
1730 caller, unspec (rw_status.channel), rw_status.flag);
1731 end;
1732
1733 else if order = "event_info" then do;
1734 call iox_$control (iocbp, "event_info", addr (event_info_channel), code);
1735 if code = 0 then call rpt ("^a: Event channel=^.3b",
1736 caller, unspec (event_info_channel));
1737 end;
1738
1739 else if order = "set_bid_limit" then do;
1740 i = cv_io_call_dec_arg (1);
1741 call iox_$control (iocbp, "set_bid_limit", addr (i), code);
1742 end;
1743
1744 else if order = "get_bid_limit" then do;
1745 call iox_$control (iocbp, "get_bid_limit", addr (i), code);
1746 if code = 0 then call rpt ("^a: Bisync bid limit is ^d retries.",
1747 caller, i);
1748 end;
1749
1750 else if order = "set_bsc_modes" then do;
1751 auto_bsc_modes.transparent = "1"b;
1752 auto_bsc_modes.ebcdic = "0"b;
1753 auto_bsc_modes.fill = "0"b;
1754 do i = 1 to io_call_info.nargs;
1755 if io_call_info.args (i) = "ascii" then auto_bsc_modes.ebcdic = "0"b;
1756 else if io_call_info.args (i) = "ebcdic" then auto_bsc_modes.ebcdic = "1"b;
1757 else if io_call_info.args (i) = "transparent" then auto_bsc_modes.transparent = "1"b;
1758 else if io_call_info.args (i) = "nontransparent" then auto_bsc_modes.transparent = "0"b;
1759 else do;
1760 call err (error_table_$badopt, caller,
1761 "Invalid bisync mode: ^a", io_call_info.args (i));
1762 code = 0;
1763 return;
1764 end;
1765 end;
1766 call iox_$control (iocbp, "set_bsc_modes", addr (auto_bsc_modes), code);
1767 end;
1768
1769 else if order = "get_bsc_modes" then do;
1770 call iox_$control (iocbp, "get_bsc_modes", addr (auto_bsc_modes), code);
1771 if code = 0 then
1772 call rpt ("^a: Current bisync mode is ^[non^]transparent ^[ebcdic^;ascii^].",
1773 caller, ^auto_bsc_modes.transparent, auto_bsc_modes.ebcdic);
1774 end;
1775
1776 else if order = "set_size" then do;
1777 i = cv_io_call_dec_arg (1);
1778 call iox_$control (iocbp, "set_size", addr (i), code);
1779 end;
1780
1781 else if order = "get_size" then do;
1782 call iox_$control (iocbp, "get_size", addr (i), code);
1783 if code = 0 then call rpt ("^a: Bisync block size is ^d characters.",
1784 caller, i);
1785 end;
1786
1787 else if order = "set_multi_record_mode" then do;
1788 if io_call_info.nargs = 0 then call iox_$control (iocbp, "set_multi_record_mode", null, code);
1789 else do;
1790 i = cv_io_call_dec_arg (1);
1791 call iox_$control (iocbp, "set_multi_record_mode", addr (i), code);
1792 end;
1793 end;
1794
1795 else if order = "get_multi_record_mode" then do;
1796 call iox_$control (iocbp, "get_multi_record_mode", addr (i), code);
1797 if code = 0 then call rpt ("^a: Bisync blocks contain ^[^d^;unlimited^s^] record^[s^].",
1798 caller, (i ^= 0), i, (i ^= 1));
1799 end;
1800
1801 else if order = "send_nontransparent_msg" then do;
1802 if io_call_info.nargs = 0 then code = error_table_$noarg;
1803 else do;
1804 i = length (io_call_info.args (1));
1805 allocate order_msg in (work_area);
1806 order_msg.data_len = i;
1807 order_msg.data = io_call_info.args (1);
1808 call iox_$control (iocbp, "send_nontransparent_msg", p, code);
1809 free order_msg;
1810 end;
1811 end;
1812
1813 else if order = "set_polling_addr" then do;
1814 if io_call_info.nargs = 0 then call iox_$control (iocbp, "set_polling_addr", null, code);
1815 else do;
1816 i = length (io_call_info.args (1));
1817 allocate order_msg in (work_area);
1818 order_msg.data_len = i;
1819 order_msg.data = io_call_info.args (1);
1820 call iox_$control (iocbp, "set_polling_addr", p, code);
1821 free order_msg;
1822 end;
1823 end;
1824
1825 else if order = "get_chars" then do;
1826 i = cv_io_call_dec_arg (1);
1827 info_ptr = addr (auto_get_chars_info);
1828 allocate get_chars_data in (work_area) set (get_chars_info.buf_ptr);
1829 allocate get_chars_data in (work_area) set (get_chars_info.hbuf_ptr);
1830 get_chars_info.buf_len, get_chars_info.hbuf_len = i;
1831 call iox_$control (iocbp, "get_chars", addr (auto_get_chars_info), code);
1832 if code = 0 then do;
1833 if get_chars_info.eot then call rpt ("^a: EOT read.", caller);
1834 if get_chars_info.soh then call rpt ("^a: Header: ^a", caller,
1835 substr (get_chars_info.hbuf_ptr -> get_chars_data, 1, get_chars_info.header_len));
1836 if get_chars_info.data_len > 0 then call rpt ("^a: Data^[(ETX)^]^[(ETB)^]: ^a", caller,
1837 get_chars_info.etx, get_chars_info.etb,
1838 substr (get_chars_info.buf_ptr -> get_chars_data, 1, get_chars_info.data_len));
1839 end;
1840 free get_chars_info.buf_ptr -> get_chars_data;
1841 free get_chars_info.hbuf_ptr -> get_chars_data;
1842 end;
1843
1844 else call iox_$control (iocbp, (order), null, code);
1845
1846 return;
1847
1848 end bisync_io_call;
1849
1850
1851
1852
1853 cv_io_call_dec_arg: proc (n) returns (fixed bin);
1854
1855 dcl n fixed bin;
1856
1857 if n > io_call_info.nargs then do;
1858 code = error_table_$noarg;
1859 go to control_return;
1860 end;
1861
1862 on conversion go to cv_io_call_dec_arg_err;
1863 return (bin (io_call_info.args (n)));
1864
1865 cv_io_call_dec_arg_err:
1866 call err (0, caller, "Invalid decimal argument: ^a", io_call_info.args (n));
1867 code = 0;
1868 go to control_return;
1869
1870 end cv_io_call_dec_arg;
1871 ^L
1872
1873
1874 bisync_position: entry (arg_iocbp, arg_pos_type, arg_pos_value, arg_code);
1875
1876 iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
1877 adp = iocbp -> iocb.attach_data_ptr;
1878 pos_type = arg_pos_type;
1879 pos_value = arg_pos_value;
1880 arg_code, code = 0;
1881
1882 if ((pos_type ^= 0) & (pos_type ^= 3)) | (pos_value < 0) then do;
1883 arg_code = error_table_$bad_arg;
1884 return;
1885 end;
1886
1887 if pos_type = 3 then do while (pos_value > 0);
1888 i = min (pos_value, ad.scanned_data_len);
1889 if i > 0 then do;
1890 call advance_scanned_data (i);
1891 pos_value = pos_value - i;
1892 end;
1893 else do;
1894 call scan_more_data;
1895 if code ^= 0 then do;
1896 arg_code = code;
1897 return;
1898 end;
1899 end;
1900 end;
1901
1902 else do while (pos_value > 0);
1903 if ad.scanned_data_len > 0 then do;
1904 i = index (scanned_data, nl);
1905 if i = 0 then ad.scanned_data_len = 0;
1906 else do;
1907 pos_value = pos_value - 1;
1908 call advance_scanned_data (i);
1909 end;
1910 end;
1911 else do;
1912 call scan_more_data;
1913 if code ^= 0 then do;
1914 arg_code = code;
1915 return;
1916 end;
1917 end;
1918 end;
1919
1920 arg_code = 0;
1921
1922 return;
1923 ^L
1924
1925
1926 line_control: proc (op, val1);
1927
1928 dcl (op, val1, val2) fixed bin;
1929
1930 line_ctl.val = 0;
1931 line_control_join:
1932 line_ctl.val (1) = val1;
1933
1934 line_control_val_set: entry (op);
1935
1936 line_ctl.op = op;
1937 call hcs_$tty_order (ad.tty_index, "line_control", addr (line_ctl), state, code);
1938 call check_error_code;
1939 return;
1940
1941 line_control2: entry (op, val1, val2);
1942
1943 line_ctl.val = 0;
1944 line_ctl.val (2) = val2;
1945 go to line_control_join;
1946
1947 end line_control;
1948
1949
1950
1951 check_error_code: proc;
1952
1953 if code = 0 then return;
1954 if code ^= error_table_$line_status_pending then return;
1955 call check_line_status;
1956 return;
1957
1958 end check_error_code;
1959
1960 check_line_status: proc;
1961
1962 call hcs_$tty_order (ad.tty_index, "line_status", addr (line_stat), state, code);
1963 if code ^= 0 then return;
1964 if line_stat.op = BID_FAILED then code = error_table_$bisync_bid_fail;
1965 else if line_stat.op = BAD_BLOCK then code = error_table_$bisync_block_bad;
1966 else if line_stat.op = REVERSE_INTERRUPT then code = error_table_$bisync_reverse_interrupt;
1967 else if line_stat.op = TOO_MANY_NAKS then code = error_table_$device_parity;
1968 else if line_stat.op = FNP_WRITE_STATUS then do;
1969 ad.fnp_output_reported = "1"b;
1970 ad.fnp_output_pending = (line_stat.val (1) = 1);
1971 end;
1972
1973 if code ^= 0 then do;
1974 ad.write_error_code = code;
1975 code = 0;
1976 end;
1977 return;
1978
1979 end check_line_status;
1980 ^L
1981
1982
1983 set_control_chars: proc;
1984
1985 unspec (ad.stx) = "002"b3;
1986 unspec (ad.etx) = "003"b3;
1987 unspec (ad.dle) = "020"b3;
1988 unspec (ad.itb) = "037"b3;
1989 unspec (ad.soh) = "001"b3;
1990 if ad.ascii then do;
1991 unspec (ad.etb) = "027"b3;
1992 unspec (ad.eot) = "004"b3;
1993 end;
1994 else do;
1995 unspec (ad.etb) = "046"b3;
1996 unspec (ad.eot) = "067"b3;
1997 end;
1998 return;
1999
2000 end set_control_chars;
2001
2002
2003
2004 block: proc (chan_id, nchan);
2005
2006 dcl chan_id fixed bin(71);
2007 dcl nchan fixed bin;
2008
2009 ad.channel_id = chan_id;
2010 ad.nchan = nchan;
2011 call ipc_$block (addr (ad.wait_list), addr (event_info), code);
2012 if code ^= 0 then call convert_ipc_code_ (code);
2013 return;
2014
2015 end block;
2016
2017
2018
2019 set_time: proc (n_sec);
2020
2021 dcl n_sec fixed bin;
2022
2023 call timer_manager_$reset_alarm_wakeup (ad.timer_channel);
2024 call ipc_$drain_chn (ad.timer_channel, code);
2025 call timer_manager_$alarm_wakeup ((n_sec), "11"b, ad.timer_channel);
2026 return;
2027
2028 end set_time;
2029
2030
2031
2032 substraddr: proc (c, n) returns (ptr);
2033
2034 dcl c char (*);
2035 dcl n fixed bin (21);
2036 dcl ca (n) char (1) based (addr (c));
2037
2038 return (addr (ca (n)));
2039
2040 end substraddr;
2041
2042
2043
2044 %include area_info;
2045 %page;
2046 %include bisync_line_data;
2047 %page;
2048 %include iocb;
2049 %page;
2050 %include iox_modes;
2051 %page;
2052 %include io_call_info;
2053
2054 end bisync_;