/****^  ***********************************************************
        *                                                         *
        * Copyright, (C) BULL HN Information Systems Inc., 1989   *
        *                                                         *
        * Copyright, (C) Honeywell Information Systems Inc., 1982 *
        *                                                         *
        * Copyright (c) 1972 by Massachusetts Institute of        *
        * Technology and Honeywell Information Systems, Inc.      *
        *                                                         *
        *********************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-28,Beattie), approve(86-07-28,MCR7482),
     audit(86-09-29,Brunelle), install(86-10-07,MR12.0-1177):
     Optionally allow bisync_ to send ETBs between records of a block instead
     of only ETXs.
  2) change(89-04-25,Beattie), approve(89-05-15,MCR8107),
     audit(89-06-15,Brunelle), install(89-06-22,MR12.3-1061):
     Change declaration of offset variable in the substraddr internal
     procedure to fixed bin 21 to allow referencing all characters within
     a segment.  Fixes problem in TR20276.
                                                   END HISTORY COMMENTS */


/* BISYNC_: An I/O module for doing I/O over a binary synchronous communications line. */

/* Coded November 1976 by Larry Johnson */
/* Modified April 1984 by Charley Marker:
   a) Changed to use a fast event channel only for ring 0 calls.
   b) Changed abort_attach to call hcs_$tty_detach if needed.
   c) Changed to check if ad.attach_channel is event call and if it is make it event wait. */
bisync_: proc;

/* Parameters */

dcl  arg_iocbp ptr;
dcl  arg_option (*) char (*) var;			/* Options for attach */
dcl  arg_sw bit (1);				/* Com_err_ switch for attach */
dcl  arg_code fixed bin (35);
dcl  arg_mode fixed bin;				/* The open mode */
dcl  arg_buf_ptr ptr;
dcl  arg_data_ptr ptr;
dcl  arg_buf_len fixed bin (21);
dcl  arg_data_len fixed bin (21);
dcl  arg_pos_type fixed bin;
dcl  arg_pos_value fixed bin (21);
dcl  arg_order char (*);
dcl  arg_info_ptr ptr;

/* Automatic */

dcl  com_err_sw bit (1);				/* Set if com_err_ sould be called on attach error */
dcl  adp ptr;					/* Pointer to attach data */
dcl  code fixed bin (35);
dcl  iocbp ptr;
dcl  empty_buffer char (1) init ("");			/* an empty buffer for ETB mode */
dcl  mask bit (36) aligned;				/* For setting ips mask */
dcl  state fixed bin;
dcl  i fixed bin (21);
dcl  open_mode fixed bin;
dcl  remaining_len fixed bin (21);
dcl  offset fixed bin (21);
dcl  data_ptr ptr;
dcl  data_len fixed bin (21);
dcl  header_len fixed bin (21);
dcl  buf_ptr ptr;
dcl  buf_len fixed bin (21);
dcl  hbuf_ptr ptr;
dcl  hbuf_len fixed bin (21);
dcl  order_sw bit (1);
dcl  etb_found bit (1);
dcl  etx_found bit (1);
dcl  stx_found bit (1);
dcl  eot_found bit (1);
dcl  soh_found bit (1);
dcl  header_found bit (1);
dcl  data_found bit (1);
dcl  nl_found bit (1);
dcl  order char (32);
dcl  info_ptr ptr;
dcl  pos_type fixed bin;
dcl  pos_value fixed bin (21);
dcl  caller char (32);
dcl (rpt, err) entry variable options (variable);
dcl 1 my_area_info like area_info aligned automatic;
dcl  real_transparent bit (1);
dcl  time_out bit (1);

dcl 1 event_info aligned,
    2 channel_id fixed bin (71),
    2 message fixed bin (71),
    2 sender bit (36),
    2 origon,
      3 dev_signal bit (18) unal,
      3 ring bit (18) unal,
    2 channel_index fixed bin (17);

dcl 1 mode_data aligned,
    2 req_len fixed bin,
    2 req char (256);

dcl  dial_msg_chan char (6);				/* Variables for dial manager */
dcl  dial_msg_module char (32);
dcl  dial_msg_ndialed fixed bin;

dcl 1 dma aligned,
    2 version fixed bin,
    2 dial_qual char (22),
    2 event_channel fixed bin (71),
    2 channel_name char (32);

dcl 1 dial_msg_flags aligned,
    2 dialed_up bit (1) unal,
    2 hung_up bit (1) unal,
    2 control bit (1) unal,
    2 pad bit (33) unal;

/* Constants */

dcl  BISYNC_OVERHEAD fixed bin int static options (constant) init (8);
dcl  iomodule_name char (7) int static options (constant) init ("bisync_");
dcl  nl char (1) int static options (constant) init ("
");

/* External stuff */

dcl  define_area_ entry (ptr, fixed bin (35));
dcl  release_area_ entry (ptr);
dcl  ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35));
dcl  ipc_$decl_ev_wait_chn entry (fixed bin(71), fixed bin(35));
dcl  ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
dcl  hcs_$assign_channel entry (fixed bin (71), fixed bin (35));
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  hcs_$tty_attach entry (char (*), fixed bin (71), fixed bin, fixed bin, fixed bin (35));
dcl  hcs_$tty_detach entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
dcl  hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned);
dcl  hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned);
dcl  iox_$propagate entry (ptr);
dcl  iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl  com_err_ entry options (variable);
dcl  hcs_$tty_write entry (fixed bin, ptr, fixed bin (21), fixed bin (21), fixed bin (21), fixed bin, fixed bin (35));
dcl  hcs_$tty_read entry (fixed bin, ptr, fixed bin (21), fixed bin (21), fixed bin (21), fixed bin, fixed bin (35));
dcl  hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35));
dcl  hcs_$tty_abort entry (fixed bin, fixed bin, fixed bin, fixed bin (35));
dcl  hcs_$tty_state entry (fixed bin, fixed bin, fixed bin (35));
dcl  ipc_$block entry (ptr, ptr, fixed bin (35));
dcl  timer_manager_$sleep entry (fixed bin (71), bit (2));
dcl  timer_manager_$reset_alarm_wakeup entry (fixed bin (71));
dcl  timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));
dcl  dial_manager_$privileged_attach entry (ptr, fixed bin (35));
dcl  dial_manager_$dial_out entry (ptr, fixed bin (35));
dcl  dial_manager_$release_channel entry (ptr, fixed bin(35));
dcl  dial_manager_$release_channel_no_hangup entry (ptr, fixed bin(35));
dcl  convert_dial_message_ entry (bit (72) aligned, char (*), char (*), fixed bin, 1 like dial_msg_flags aligned,
     fixed bin (35));
dcl  iox_$control entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$attach_name entry (char (*), ptr, char (*), ptr, fixed bin (35));
dcl  iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  iox_$write_record entry (ptr, ptr, fixed bin (21), fixed bin (35));
dcl  iox_$close entry (ptr, fixed bin (35));
dcl  iox_$detach_iocb entry (ptr, fixed bin (35));
dcl  iox_$err_no_operation entry;

dcl (addr, bin, hbound, index, length, low, max, min, null, rtrim, string, substr, unspec) builtin;

dcl  sys_info$max_seg_size ext fixed bin (35);
dcl  error_table_$buffer_big ext fixed bin (35);
dcl  error_table_$bad_arg ext fixed bin (35);
dcl  error_table_$bad_mode ext fixed bin (35);
dcl  error_table_$bisync_bid_fail ext fixed bin (35);
dcl  error_table_$bisync_reverse_interrupt ext fixed bin (35);
dcl  error_table_$long_record ext fixed bin (35);
dcl  error_table_$line_status_pending ext fixed bin (35);
dcl  error_table_$not_detached ext fixed bin (35);
dcl  error_table_$wrong_no_of_args ext fixed bin (35);
dcl  error_table_$noarg ext fixed bin (35);
dcl  error_table_$no_operation ext fixed bin (35);
dcl  error_table_$no_line_status ext fixed bin (35);
dcl  error_table_$badopt ext fixed bin (35);
dcl  error_table_$device_parity ext fixed bin (35);
dcl  error_table_$action_not_performed ext fixed bin (35);
dcl  error_table_$bisync_block_bad ext fixed bin (35);
dcl  error_table_$end_of_info ext fixed bin (35);
dcl  error_table_$resource_attached ext fixed bin (35);
         
dcl  conversion condition;

/* Attach data block */

dcl 1 ad aligned based (adp),
    2 work_areap ptr,				/* Pointer to work area containing this structure */
    2 device char (6),				/* Name of channel attached */
    2 attach_description char (256) var,
    2 open_description char (24) var,
    2 wait_list aligned,
      3 nchan fixed bin,				/* Number of channels to block on */
      3 channel_id fixed bin (71),			/* Channel to block on */
      3 timer_channel fixed bin (71),			/* Second channel when timer needed */
    2 attach_channel fixed bin (71),                        /* Answering service channel for attachments */
    2 channel fixed bin (71),			          /* The channel for Ring 0 */
    2 delay fixed bin (71),				/* Delay in microseconds between writes */
    2 log_iocbp ptr,				/* Logging IOCB, if enabled */
    2 tty_index fixed bin,				/* Index given to line at assignment */
    2 bid_limit fixed bin,				/* Number of times to retry line bid */
    2 ttd_time fixed bin,				/* Time between ttds */
    2 ttd_limit fixed bin,				/* Maximum number to send */
    2 transparent bit (1),				/* Set if in transparent mode */
    2 ascii bit (1),				/* Set if in ascii mode, reset if ebcdic */
    2 attach_channel_is_call bit (1),	                    /* Set if the attach channel has been converted to event call */
    2 temp_nontransparent bit (1),			/* Temporarily non-transparent for 1 msg */
    2 break_on_etb bit (1),				/* Set if ok to break on etb, otherwise wait for etx */
    2 break_on_eot bit (1),				/* Must watch for eots */
    2 saved_eot bit (1),				/* Must report eot on next get_chars */
    2 output_mode bit (1),				/* Set if open for one of output modes */
    2 hangup_sw bit (1),				/* If set, hangup on detach */
    2 fnp_output_reported bit (1),			/* If set, FNP reported write status */
    2 fnp_output_pending bit (1),			/* Output status, valid if prev bit set */
    2 ibm3270_mode bit (1),				/* IBM 3270 mode selected in attach */
    2 hasp_mode bit (1),				/* Running in hasp mode */
    2 master_sw bit (1),				/* Master mode requested */
    2 slave_sw bit (1),				/* Slave mode requested */
    2 tty_attached bit (1),	                              /* Set after a successful call to hcs_$tty_attach */
    2 multi_record bit (1),				/* Set if doing blocking and unblocking */
    2 output_etb_mode bit (1),			/* set if output with ETB is selected */
    2 use_etb bit (1),				/* controls when ETBs are used when in output_etb_mode */
    2 multi_record_limit fixed bin,			/* Max count of records per block */
    2 record_count fixed bin,				/* Records in current block */
    2 write_error_code fixed bin (35),			/* Error code from a prior write */
    2 log_sw bit (1),				/* Set if logging enabled */
    2 stx char (1),					/* Start of text character */
    2 etx char (1),					/* End of text character */
    2 etb char (1),					/* End of text block character */
    2 dle char (1),					/* Data link escape character */
    2 eot char (1),					/* End of transmission char */
    2 itb char (1),					/* End of intermediate text block */
    2 soh char (1),					/* Start of header */
    2 scanned_data_len fixed bin (21),			/* Length of input data already scanned */
    2 scanned_data_ptr ptr,				/* Pointer to input data already scanned */
    2 unscanned_data_len fixed bin (21),		/* Length of input data read but not scanned */
    2 unscanned_data_ptr ptr,				/* Pointer to input_ data read but not scanned */
    2 input_state fixed bin,				/* Current state of input buffer scan */
    2 block_len fixed bin (21),			/* Length of text blocks */
    2 max_block_len fixed bin (21),			/* Max length of text block (set at attach) */
    2 input_blockp ptr,				/* Pointer to block with input buffer */
    2 last_input_blockp ptr,				/* Last input block in chain */
    2 input_buf_len fixed bin (21),			/* Length of input buffer */
    2 input_buf_ptr ptr,				/* Address of input buffer */
    2 output_buf_len fixed bin (21),			/* Length of output buffer */
    2 output_buf_ptr ptr,				/* Address of output buffer */
    2 output_buf_used fixed bin (21),			/* Number of chars in output buffer */
    2 output_buf_left fixed bin (21),			/* Unused space in output buffer */
    2 last_etx fixed bin (21);			/* Index to last etx stored in output buffer */

dcl  output_buffer char (ad.output_buf_len) based (ad.output_buf_ptr);
dcl  unscanned_data char (ad.unscanned_data_len) based (ad.unscanned_data_ptr);
dcl  scanned_data char (ad.scanned_data_len) based (ad.scanned_data_ptr);
dcl  work_area area based (ad.work_areap);

dcl 1 input_block aligned based (ad.input_blockp),
    2 next_blockp ptr init (null),
    2 data_len fixed bin (21),
    2 input_buffer char (ad.input_buf_len);

dcl  data_arg char (data_len) based (data_ptr);
dcl  buf_arg char (buf_len) based (buf_ptr);
dcl  header_arg char (hbuf_len) based (hbuf_ptr);

/* Based things for orders */

dcl  event_info_channel fixed bin (71) based (info_ptr);
dcl 1 rw_status aligned based (info_ptr),		/* For read_status and write_status */
    2 channel fixed bin (71),
    2 flag bit (1);
dcl  order_val fixed bin based (info_ptr);		/* For orders which take a single number */
dcl 1 bsc_modes aligned based (info_ptr),		/* For setting modes */
    2 transparent bit (1) unal,
    2 ebcdic bit (1) unal,
    2 fill bit (34) unal;
dcl 1 hangup_proc aligned based (info_ptr),		/* Data for hangup_proc order */
    2 entry_var entry variable,
    2 data_ptr ptr,
    2 prior fixed bin;
dcl 1 order_msg aligned based (info_ptr),		/* For orders that use varying strings */
    2 data_len fixed bin,
    2 data char (order_msg.data_len);

dcl 1 get_chars_info aligned based (info_ptr),		/* For get_chars order */
    2 buf_ptr ptr,					/* Addr of callers buffer */
    2 buf_len fixed bin (21),				/* Length of callers buffer */
    2 data_len fixed bin (21),			/* Length of data return */
    2 hbuf_ptr ptr,					/* Addr of callers of header buffer */
    2 hbuf_len fixed bin (21),			/* Length of callers header buffer */
    2 header_len fixed bin (21),			/* Length of header return */
    2 flags,
      3 etx bit (1) unal,				/* Data ended with etx */
      3 etb bit (1) unal,				/* Data ended with etb */
      3 soh bit (1) unal,				/* Data had header */
      3 eot bit (1) unal,				/* Data was eot */
      3 pad bit (32) unal;


/* Attach entry point */

bisync_attach: entry (arg_iocbp, arg_option, arg_sw, arg_code);

	iocbp = arg_iocbp;
	com_err_sw = arg_sw;
	arg_code, code = 0;

	area_infop = addr (my_area_info);
	area_info.version = area_info_version_1;
	string (area_info.control) = "0"b;
	area_info.extend = "1"b;
	area_info.zero_on_free = "1"b;
	area_info.owner = iomodule_name;
	area_info.size = sys_info$max_seg_size;
	area_info.areap = null;
	adp = null;

	if iocbp -> iocb.attach_descrip_ptr ^= null then do;
	     code = error_table_$not_detached;
	     call abort_attach ("^a", iocbp -> iocb.name);
	end;

	call define_area_ (area_infop, code);
	if code ^= 0 then call abort_attach ("Unable to allocate temp area.", "");
	allocate ad in (area_info.areap -> work_area);
	unspec (ad) = "0"b;
	ad.work_areap = area_info.areap;

/* Process options */

	if hbound (arg_option, 1) < 1 then do;		/* Must be exactly one */
	     code = error_table_$wrong_no_of_args;
	     call abort_attach ("Bad attach description.", "");
	end;
	ad.device = arg_option (1);
	ad.block_len, ad.max_block_len = 256;		/* Default length */
	ad.transparent = "1"b;
	ad.ascii = "1"b;
	ad.delay = 0;
	ad.bid_limit = 30;
	ad.ttd_time = 2;
	ad.ttd_limit = 30;
	ad.output_etb_mode = "0"b;			/* off by default */
	ad.use_etb = "0"b;
	dma.dial_qual = "";				/* Space for phone number */
	do i = 2 to hbound (arg_option, 1);
	     if arg_option (i) = "-transparent" then ad.transparent = "1"b;
	     else if arg_option (i) = "-nontransparent" then ad.transparent = "0"b;
	     else if arg_option (i) = "-ascii" then do;
		ad.ascii = "1"b;
	     end;
	     else if arg_option (i) = "-ebcdic" then do;
		ad.ascii = "0"b;
	     end;
	     else if arg_option (i) = "-size" then do;
		ad.block_len, ad.max_block_len = cv_dec_arg (); /* Get size value */
		if (ad.block_len < 6) | (ad.block_len > 2000) then
		     call abort_attach ("Invalid block size: ^a", (arg_option (i)));
	     end;
	     else if arg_option (i) = "-delay" then ad.delay = 1000 * cv_dec_arg ();
	     else if arg_option (i) = "-output_etb" then ad.output_etb_mode, ad.use_etb = "1"b;
	     else if arg_option (i) = "-output_etx" then ad.output_etb_mode, ad.use_etb = "0"b;
	     else if arg_option (i) = "-bretb" then ad.break_on_etb = "1"b;
	     else if arg_option (i) = "-breot" then ad.break_on_eot = "1"b;
	     else if arg_option (i) = "-hangup" then ad.hangup_sw = "1"b;
	     else if arg_option (i) = "-ibm3270_mode" then ad.ibm3270_mode = "1"b;
	     else if arg_option (i) = "-hasp_mode" then ad.hasp_mode = "1"b;
	     else if arg_option (i) = "-master" then ad.master_sw = "1"b;
	     else if arg_option (i) = "-slave" then ad.slave_sw = "1"b;
	     else if arg_option (i) = "-bid_limit" then ad.bid_limit = cv_dec_arg ();
	     else if arg_option (i) = "-ttd_time" then ad.ttd_time = cv_dec_arg ();
	     else if arg_option (i) = "-ttd_limit" then ad.ttd_limit = cv_dec_arg ();
	     else if arg_option (i) = "-multi_record" then do;
		ad.multi_record = "1"b;
		ad.multi_record_limit = 0;		/* Assume no limit on records per block */
		if i < hbound (arg_option, 1) then	/* See if limit specified */
		     if substr (arg_option (i+1), 1, 1) ^= "-" then
			ad.multi_record_limit = cv_dec_arg ();
	     end;
	     else if arg_option (i) = "-auto_call" then do;
		i = i + 1;
		if i > hbound (arg_option, 1) then do;
		     code = error_table_$noarg;
		     call abort_attach ("No phone number after -auto_call", "");
		end;
		dma.dial_qual = arg_option (i);
	     end;
	     else if arg_option (i) = "-debug_log" then ad.log_sw = "1"b;
	     else do;
		code = error_table_$badopt;
		call abort_attach ("^a", (arg_option (i)));
	     end;
	end;

/* Get bisync channel from answering service. */

	ad.nchan = 1;
	call ipc_$create_ev_chn (ad.attach_channel, code);	/* Need normal event chan for this part */
	if code ^= 0 then do;
	     call convert_ipc_code_ (code);
	     call abort_attach ("Unable to create event channel", "");
	end;
	dma.version = 1;				/* Setup dial manager data structure */
	dma.event_channel = ad.attach_channel;
	dma.channel_name = ad.device;
	if dma.dial_qual = "" then call dial_manager_$privileged_attach (addr (dma), code);
	else call dial_manager_$dial_out (addr (dma), code);
	if code = error_table_$action_not_performed | code = error_table_$resource_attached
	     then go to maybe_mine_already;
	if code ^= 0 then call abort_attach ("From dial_manager_ attaching ^a", ad.device);
	call block (ad.attach_channel, 1);                     /* Wait for answering service */
	if code ^= 0 then call abort_attach ("From ipc_$block waiting for ^a attachment.", ad.device);

	call convert_dial_message_ (unspec (event_info.message), dial_msg_chan, dial_msg_module,
	     dial_msg_ndialed, dial_msg_flags, code);
	if code ^= 0 then call abort_attach ("From dial_manager_ attaching ^a", ad.device);
maybe_mine_already:
	ad.channel = 0;

/* Setup event channel */

	if ad.ibm3270_mode then go to use_std_chan;
	call hcs_$assign_channel (ad.channel, code);	/* Try fast one first  */
	if code ^= 0 then do;
use_std_chan:  call ipc_$create_ev_chn (ad.channel, code);	/* Try normal one */
	     if code ^= 0 then do;
		call convert_ipc_code_ (code);
		ad.channel = 0;
		call abort_attach ("Unable to create event channel.", "");
	     end;
	end;

/* Create second event channel for timer */

	call ipc_$create_ev_chn (ad.timer_channel, code);
	if code ^= 0 then do;
	     call convert_ipc_code_ (code);
	     ad.timer_channel = 0;
	     call abort_attach ("Unable to create event channel", "");
	end;

/* Initialize IOCB variables */

	ad.input_buf_len, ad.output_buf_len = 0;
	ad.input_buf_ptr, ad.output_buf_ptr = null;
	ad.input_blockp = null;
	ad.last_input_blockp = null;
	call set_control_chars;			/* Set up control chars for this mode */

/* Setup logging IOCB if requested */

	if ad.log_sw then do;
	     order = rtrim (iocbp -> iocb.name) || ".log"; /* Name of switch and segment */
	     call iox_$attach_name (order, ad.log_iocbp, "vfile_ " || rtrim (order), null, code);
	     if code = 0 then do;
		call iox_$open (ad.log_iocbp, Sequential_output, "0"b, code);
		if code ^= 0 then do;
		     call com_err_ (code, iomodule_name, "Opening log ^a", order);
		     call iox_$detach_iocb (ad.log_iocbp, code);
		     ad.log_sw = "0"b;
		end;
	     end;
	     else do;
		call com_err_ (code, iomodule_name, "attaching log ^a", order);
		ad.log_sw = "0"b;
	     end;
	end;

/* Attach the device */

	call hcs_$tty_attach ((ad.device), ad.channel, ad.tty_index, state, code);
	if code ^= 0 then call abort_attach ("Unable to attach ^a.", ad.device);
	if code = 0 then ad.tty_attached = "1"b;
	mode_data.req_len = length (mode_data.req);
	mode_data.req = "rawi,rawo";
	call hcs_$tty_order (ad.tty_index, "modes", addr (mode_data), state, code);
	call check_error_code;
	if code ^= 0 then call abort_attach ("Unable to set rawi,rawo modes.", "");
	call hcs_$tty_order (ad.tty_index, "set_input_message_size", addr (ad.block_len), state, code);
	call check_error_code;
	if code ^= 0 then call abort_attach ("Unable to set message size.", "");

	if ad.ibm3270_mode then do;
	     call line_control (SET_3270_MODE, 0);
	     if code ^= 0 then call abort_attach ("Unable to set 3270 mode", "");
	end;
	if ad.hasp_mode then do;
	     call line_control (SET_HASP_MODE, 0);
	     if code ^= 0 then call abort_attach ("Unable to set hasp mode.", "");
	     if ad.master_sw | ad.slave_sw then do;
		call line_control (SET_MASTER_SLAVE_MODE, bin (ad.master_sw));
		if code ^= 0 then call abort_attach ("Unable to set master or slave mode", "");
	     end;
	end;
	call line_control (SET_BID_LIMIT, ad.bid_limit);
	if code ^= 0 then call abort_attach ("Unable to set bid limit.", "");
	call line_control (CONFIGURE, bin (ad.transparent || ^ad.ascii));
	if code ^= 0 then call abort_attach ("Unable to configure line.", "");
	call line_control2 (SET_TTD_PARAMS, ad.ttd_time, ad.ttd_limit);
	if code ^= 0 then call abort_attach ("Unable to set ttd params.", "");

/* Now mask and complete the iocb */

	ad.attach_description = iomodule_name;
	do i = 1 to hbound (arg_option, 1);
	     ad.attach_description = ad.attach_description || " ";
	     ad.attach_description = ad.attach_description || arg_option (i);
	end;
	call hcs_$set_ips_mask ("0"b, mask);
	iocbp -> iocb.attach_descrip_ptr = addr (ad.attach_description);
	iocbp -> iocb.attach_data_ptr = adp;
	iocbp -> iocb.open = bisync_open;
	iocbp -> iocb.detach_iocb = bisync_detach;
	call iox_$propagate (iocbp);
	call hcs_$reset_ips_mask (mask, mask);
attach_return:
	return;

/* Internal procedure to handle decimal args */

cv_dec_arg: proc returns (fixed bin);

	     i = i + 1;				/* Advance to next arg */
	     if i > hbound (arg_option, 1) then do;
		code = error_table_$noarg;
		call abort_attach ("No argument after ^a.", (arg_option (i-1)));
	     end;
	     on conversion go to bad_dec_arg;
	     return (bin (arg_option (i)));

bad_dec_arg:
	     code = 0;
	     call abort_attach ("Invalid decimal number. ^a", (arg_option (i)));

	end cv_dec_arg;

/* Internal procedure to handle attach errors */

abort_attach: proc (str1, str2);

dcl (str1, str2) char (*) aligned;

	     if com_err_sw then call com_err_ (code, iomodule_name, str1, str2);
	     if code = 0 then code = error_table_$badopt;
	     arg_code = code;

	     if adp ^= null then do;
		if ad.tty_attached then call hcs_$tty_detach (ad.tty_index, 0, state, code); 
		if ad.channel ^= 0 then call ipc_$delete_ev_chn (ad.channel, code);	
		if ad.timer_channel ^= 0 then call ipc_$delete_ev_chn (ad.timer_channel, code);
		if ad.attach_channel ^= 0 then call ipc_$delete_ev_chn (ad.attach_channel, code);
	     end;
	     if area_info.areap ^= null then call release_area_ (area_info.areap);
	     go to attach_return;

	end abort_attach;


/* Detach entry point */

bisync_detach: entry (arg_iocbp, arg_code);

	iocbp = arg_iocbp;
	arg_code, code = 0;

	adp = iocbp -> iocb.attach_data_ptr;

	if ad.log_sw then do;
	     call iox_$close (ad.log_iocbp, code);
	     call iox_$detach_iocb (ad.log_iocbp, code);
	end;

	call hcs_$set_ips_mask ("0"b, mask);

	if ad.attach_channel ^= 0 then do;
	     if ad.attach_channel_is_call then
		call ipc_$decl_ev_wait_chn (ad.attach_channel, (0));
	end;

	if ad.hangup_sw then call hcs_$tty_order (ad.tty_index, "hangup", null, state, code);
	call hcs_$tty_detach (ad.tty_index, 0, state, code);
	dma.version = 1;				/* Setup dial manager data structure */
	dma.event_channel = ad.attach_channel;
	dma.channel_name = ad.device;
	dma.dial_qual = "";
	if ad.hangup_sw then call dial_manager_$release_channel (addr (dma), code);
	else call dial_manager_$release_channel_no_hangup (addr (dma), code);
	call ipc_$delete_ev_chn (ad.channel, code);
	call ipc_$delete_ev_chn (ad.timer_channel, code);
	call ipc_$delete_ev_chn (ad.attach_channel, code);
	iocbp -> iocb.attach_descrip_ptr = null;
	call iox_$propagate (iocbp);
	call hcs_$reset_ips_mask (mask, mask);
	call release_area_ (addr (work_area));
	return;

/* Open entry point */

bisync_open: entry (arg_iocbp, arg_mode, arg_sw, arg_code);

	iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
	arg_code, code = 0;
	adp = iocbp -> iocb.attach_data_ptr;

	open_mode = arg_mode;
	if ^((open_mode = Stream_input) | (open_mode = Stream_output) | (open_mode = Stream_input_output)) then do;
	     arg_code = error_table_$bad_mode;
	     return;
	end;

	call hcs_$tty_state (ad.tty_index, state, code);	/* See if I own channel */
	if code ^= 0 then do;
	     arg_code = code;
	     return;
	end;

	ad.open_description = rtrim (iox_modes (open_mode));
	ad.write_error_code = 0;

	call hcs_$set_ips_mask ("0"b, mask);
	if ((open_mode = Stream_input) | (open_mode = Stream_input_output)) then do;
	     iocbp -> iocb.get_chars = bisync_get_chars;
	     iocbp -> iocb.get_line = bisync_get_line;
	     iocbp -> iocb.position = bisync_position;
	     iocbp -> iocb.control = bisync_control;
	     call line_control (ACCEPT_BID, 0);		/* We can accept line bids now */
	end;
	ad.input_buf_len = 2 * ad.block_len;		/* Make generous input buffer */
	allocate input_block in (work_area);
	ad.last_input_blockp = ad.input_blockp;
	ad.input_buf_ptr = addr (input_block.input_buffer);
	ad.unscanned_data_len = 0;
	ad.scanned_data_len = 0;
	ad.input_state = 1;
	ad.output_buf_used = 0;
	ad.saved_eot = "0"b;
	if ((open_mode = Stream_output) | (open_mode = Stream_input_output)) then do;
	     iocbp -> iocb.put_chars = bisync_put_chars;
	     iocbp -> iocb.control = bisync_control;
	     ad.output_buf_len = ad.block_len + BISYNC_OVERHEAD;
	     allocate output_buffer in (work_area);
	     ad.output_buf_left = ad.output_buf_len;
	     ad.output_mode = "1"b;			/* One of output modes selected */
	end;

	iocbp -> iocb.close = bisync_close;
	iocbp -> iocb.open_descrip_ptr = addr (ad.open_description);
	call iox_$propagate (iocbp);
	call hcs_$reset_ips_mask (mask, mask);
	return;

/* Close entry point */

bisync_close: entry (arg_iocbp, arg_code);

	iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
	arg_code, code = 0;
	adp = iocbp -> iocb.attach_data_ptr;


	if ad.output_mode then do;			/* If doing output */
	     if ad.multi_record & (ad.output_buf_used > 0) then call transmit_block_timed (30);
	     else time_out = "0"b;
	     if ^time_out then do;
		substr (output_buffer, 1, 1) = ad.eot;	/* Build eot message */
		ad.output_buf_used = 1;
		call transmit_block_timed (30);
	     end;
	     free output_buffer;
	end;
	call internal_resetread;
	free input_block;

	call hcs_$set_ips_mask ("0"b, mask);
	iocbp -> iocb.open_descrip_ptr = null;
	iocbp -> iocb.open = bisync_open;
	iocbp -> iocb.detach_iocb = bisync_detach;
	iocbp -> iocb.control = iox_$err_no_operation;
	call iox_$propagate (iocbp);
	call hcs_$reset_ips_mask (mask, mask);
	return;


/* Put_chars entry point */

bisync_put_chars: entry (arg_iocbp, arg_data_ptr, arg_data_len, arg_code);

	iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
	arg_code, code = 0;
	adp = iocbp -> iocb.attach_data_ptr;
	data_ptr = arg_data_ptr;
	data_len = arg_data_len;

	if data_len < 0 then do;
	     arg_code = error_table_$bad_arg;
	     return;
	end;

	if ad.write_error_code ^= 0 then do;		/* Left over error to report */
rpt_write_error:
	     arg_code = ad.write_error_code;
	     ad.write_error_code = 0;
	     return;
	end;

	real_transparent = ad.transparent & ^ad.temp_nontransparent;
	ad.temp_nontransparent = "0"b;

	remaining_len = data_len;			/* This is decremented as data is sent */
	offset = 1;				/* Current character in data to send */

	do while (remaining_len >= 0);
	     if real_transparent then call format_transparent_block;
	     else call format_nontransparent_block;
	     if ad.multi_record & (remaining_len < 0) then do; /* May not want to write this yet */
		if ad.multi_record_limit = 0 then return; /* No limit on records per block */
		if ad.record_count < ad.multi_record_limit then return; /* There is a limit but not reached yet */
	     end;
	     call transmit_block;			/* And ship it */
	     if ad.write_error_code ^= 0 then go to rpt_write_error;
	     if code ^= 0 then do;
		arg_code = code;
		return;
	     end;
	end;

	return;

/* Internal procedure to format a nontransparent bisync data block for a put_chars call. */

format_nontransparent_block: proc;

dcl (cl, dl) fixed bin;
dcl  etb_sw bit (1);

	     if ad.ascii then cl = 3;			/* Number of ctl chars, stx,etx,lrc */
	     else cl = 4;				/* Just stx,etx,bcc,bcc */

	     if (remaining_len + cl) > ad.output_buf_left then do; /* Won't fit fully in current block */
		if ad.output_buf_used > 0 then return;	/* Return to dump what is already in buffer */
		dl = ad.output_buf_left - cl;		/* Take the biggest chunk possible */
		etb_sw = "1"b;			/* Since we are splitting a msg, use an etb */
	     end;
	     else do;				/* New message will fit in current block */
		dl = remaining_len;
		etb_sw = "0"b;			/* Can end with etx */
	     end;

	     if ad.output_buf_used > 0 then		/* Change previous record in block to end in itb */
		substr (output_buffer, ad.last_etx, 1) = ad.itb;
	     substr (output_buffer, ad.output_buf_used+1, 1) = ad.stx;
	     if dl > 0 then				/* Copy real data */
		substr (output_buffer, ad.output_buf_used+2, dl) = substr (data_arg, offset, dl);
	     remaining_len = remaining_len - dl;
	     offset = offset + dl;
	     ad.last_etx = ad.output_buf_used + dl + 2;	/* Remember position of last etx */
	     if etb_sw | ad.use_etb then substr (output_buffer, ad.last_etx, 1) = ad.etb;
	     else substr (output_buffer, ad.last_etx, 1) = ad.etx;
	     ad.output_buf_used = ad.output_buf_used + dl + 2;
	     ad.output_buf_left = ad.output_buf_left - dl - 2;
	     if ad.ascii then do;			/* Must allow for lrc */
		ad.output_buf_used = ad.output_buf_used + 1;
		substr (output_buffer, ad.output_buf_used, 1) = low (1);
		ad.output_buf_left = ad.output_buf_left - 1;
	     end;
	     else ad.output_buf_left = ad.output_buf_left - 2; /* Adjust for bcc,bcc */

	     ad.record_count = ad.record_count + 1;
	     if remaining_len = 0 then remaining_len = -1; /* This is flag meaning done */
	     return;

	end format_nontransparent_block;

/* Internal procedure to format a bisync transparent block */

format_transparent_block: proc;

dcl (i, dl, real_chars, moved) fixed bin;
dcl  etb_sw bit (1);

	     if (remaining_len + 6) > ad.output_buf_left then do; /* Not all data will fit in current block */
		if ad.output_buf_used > 0 then return;	/* If partially full block, return to transmit it */
		dl = ad.output_buf_left - 6;		/* Compute max that will fit */
		etb_sw = "1"b;			/* Indicate what block is being split */
	     end;
	     else do;				/* It seems all data will fit (it may not because of dle's) */
		dl = remaining_len;
		etb_sw = "0"b;
	     end;

format_transparent_loop:
	     real_chars = dl + 4;			/* Number of characters that will go in buffer */
	     i = count_dle (substraddr (data_arg, offset), dl);
	     if i > 0 then				/* There are dle's in the string */
		if (real_chars + i) > ad.output_buf_left then do; /* Which will cause overflow */
		     if ad.output_buf_used > 0 then return; /* Dump partially fill block first */
		     dl = dl - 1;			/* Use one less character */
		     etb_sw = "1"b;			/* Indicate a block is being split */
		     go to format_transparent_loop;
		end;

	     if ad.output_buf_used > 0 then		/* Change last etx to an itb */
		substr (output_buffer, ad.last_etx, 1) = ad.itb;

	     substr (output_buffer, ad.output_buf_used+1, 1) = ad.dle; /* Start new block */
	     substr (output_buffer, ad.output_buf_used+2, 1) = ad.stx;
	     ad.output_buf_used = ad.output_buf_used + 2;
	     ad.output_buf_left = ad.output_buf_left - 2;
	     moved = 0;
	     do while (moved < dl);			/* Copy the real data, doubleing dles */
		i = index (substr (data_arg, offset, dl - moved), ad.dle); /* Check for dle */
		if i = 1 then do;			/* Next char is a dle */
		     substr (output_buffer, ad.output_buf_used+1, 1) = ad.dle;
		     substr (output_buffer, ad.output_buf_used+2, 1) = ad.dle;
		     ad.output_buf_used = ad.output_buf_used + 2;
		     ad.output_buf_left = ad.output_buf_left - 2;
		     offset = offset + 1;
		     moved = moved + 1;
		     remaining_len = remaining_len - 1;
		end;
		else do;				/* First char is not a dle */
		     if i = 0 then i = dl - moved;	/* No dle's */
		     else i = i - 1;		/* Used stuff before dle */
		     substr (output_buffer, ad.output_buf_used+1, i) = substr (data_arg, offset, i);
		     ad.output_buf_used = ad.output_buf_used + i;
		     ad.output_buf_left = ad.output_buf_left - i;
		     offset = offset + i;
		     moved = moved + i;
		     remaining_len = remaining_len - i;
		end;
	     end;
	     substr (output_buffer, ad.output_buf_used+1, 1) = ad.dle; /* Finish up block */
	     if etb_sw | ad.use_etb then substr (output_buffer, ad.output_buf_used+2, 1) = ad.etb;
	     else substr (output_buffer, ad.output_buf_used+2, 1) = ad.etx;
	     ad.last_etx = ad.output_buf_used + 2;
	     ad.output_buf_used = ad.output_buf_used + 2;
	     ad.output_buf_left = ad.output_buf_left - 4; /* Adjust for dle,(etx|etb|itb),bcc,bcc */

	     ad.record_count = ad.record_count + 1;
	     if remaining_len = 0 then remaining_len = -1;
	     return;

	end format_transparent_block;

/* Function for counting dles in a string */

count_dle: proc (p, l) returns (fixed bin);

dcl  p ptr;
dcl  l fixed bin;
dcl  c char (l) based (p);
dcl (i, j, k) fixed bin;

	     if l = 0 then return (0);
	     i = 1;
	     j = 0;				/* The count */
	     do while (i <= l);
		k = index (substr (c, i), ad.dle);
		if k = 0 then return (j);
		j = j + 1;
		i = i + k;
	     end;
	     return (j);

	end count_dle;

/* Internal procedure to transmit a bisync block during a put_chars operation */

transmit_block: proc;

dcl (i, j) fixed bin (21);
dcl  p ptr;
dcl  time_limit bit (1) init ("0"b);

dcl 1 write_status aligned,
    2 ev_chn fixed bin (71),
    2 output_pending bit (1) unal;

transmit_block_start:
	     i = 0;				/* Characters transmitted so far */
	     do while (i < ad.output_buf_used);		/* Loop until everything sent */

		write_status.output_pending = "1"b;
		do while (write_status.output_pending); /* Wait until all data shipped out */
		     call hcs_$tty_order (ad.tty_index, "write_status", addr (write_status), state, code);
		     call check_error_code;
		     if ad.write_error_code ^= 0 then return;
		     if code ^= 0 then go to transmit_end;
		     if write_status.output_pending then do; /* Really must wait */
			call hide_away_input;	/* Flush out any input before blocking */
			if code ^= 0 then return;
			if ad.write_error_code ^= 0 then return;
			if time_limit then do;
			     call set_time (n_sec);
			     call block (ad.channel, 2);
			end;
			else call block (ad.channel, 1);
			if code ^= 0 then go to transmit_end;
			if event_info.channel_id = ad.timer_channel then do; /* Timed out */
			     time_out = "1"b;
			     go to transmit_end;
			end;
		     end;
		end;

		if ad.delay > 0 then call timer_manager_$sleep (ad.delay, "10"b);

		p = substraddr (output_buffer, i+1);	/* Addr of next character to send */
		call hcs_$tty_write (ad.tty_index, p, 0, ad.output_buf_used - i, j, state, code);
		call check_error_code;
		if ad.write_error_code ^= 0 then return;
		if code ^= 0 then go to transmit_end;
		if ad.log_sw then call iox_$write_record (ad.log_iocbp, p, j, (0));
		i = i + j;			/* Accumulate length sent */
		if i < ad.output_buf_used then do;
		     call hide_away_input;
		     if code ^= 0 then return;
		     if ad.write_error_code ^= 0 then return;
		end;
	     end;

	     code = 0;
transmit_end:
	     ad.output_buf_used = 0;
	     ad.output_buf_left = ad.block_len;
	     ad.record_count = 0;

	     return;

transmit_block_timed: entry (n_sec);			/* Call here with deadline */

dcl  n_sec fixed bin;

	     time_limit = "1"b;
	     time_out = "0"b;
	     go to transmit_block_start;

	end transmit_block;

/* Get_chars entry point */

bisync_get_chars: entry (arg_iocbp, arg_buf_ptr, arg_buf_len, arg_data_len, arg_code);

	iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	buf_ptr = arg_buf_ptr;
	buf_len = arg_buf_len;
	arg_data_len, data_len = 0;
	remaining_len = buf_len;
	order_sw = "0"b;				/* Not called as order */
	hbuf_ptr = null;

get_chars_join:
	code, arg_code = 0;
	header_found, data_found = "0"b;

	if ad.saved_eot then do;
	     ad.saved_eot = "0"b;
	     eot_found = "1"b;
	     go to get_chars_return;
	end;

get_chars_retry:
	etb_found = "0"b;
	soh_found = "0"b;
	etx_found = "0"b;
	stx_found = "0"b;
	eot_found = "0"b;
	do while ((remaining_len > 0) & ^etx_found);	/* Loop until request satisfied */
	     if ad.scanned_data_len > 0 then		/* Return scanned data if any present * */
		call move_scanned_data (min (ad.scanned_data_len, remaining_len));
	     else do;
		call scan_more_data;
		if code ^= 0 then do;
		     arg_code = code;
		     return;
		end;
		if eot_found then do;
		     if ^(header_found | data_found) then go to get_chars_return;
		     ad.saved_eot = "1"b;		/* Otherwise, must report later */
		     go to get_chars_return;
		end;
	     end;
	end;

	if (data_len = 0) & etx_found & ^(stx_found | soh_found) then go to get_chars_retry;
						/* This means the etx we found was really from the prev block */

get_chars_return:
	if order_sw then go to get_chars_order_return;	/* Called as order */
	if eot_found then code = error_table_$end_of_info;
	arg_data_len = data_len;
	return;

/* Get_chars order starts here */

get_chars_order:
	buf_ptr = get_chars_info.buf_ptr;		/* Copy data from structure */
	buf_len = get_chars_info.buf_len;
	remaining_len = get_chars_info.buf_len;
	hbuf_ptr = get_chars_info.hbuf_ptr;		/* Likewise for header */
	hbuf_len = get_chars_info.hbuf_len;
	data_len, header_len = 0;
	get_chars_info.data_len = 0;
	get_chars_info.header_len = 0;
	string (get_chars_info.flags) = "0"b;
	order_sw = "1"b;
	go to get_chars_join;

/* Come here at end of get_chars operation invoked as order */

get_chars_order_return:
	if eot_found then get_chars_info.eot = "1"b;
	else do;					/* Have real data */
	     if header_found then do;
		get_chars_info.header_len = header_len;
		get_chars_info.soh = "1"b;
	     end;
	     if data_found then do;
		get_chars_info.data_len = data_len;
		if etb_found then get_chars_info.etb = "1"b;
		else if etx_found then get_chars_info.etx = "1"b;
	     end;
	end;
	go to control_return;

/* Get_line entry point */

bisync_get_line: entry (arg_iocbp, arg_buf_ptr, arg_buf_len, arg_data_len, arg_code);

	iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	buf_ptr = arg_buf_ptr;
	buf_len = arg_buf_len;
	arg_data_len, data_len = 0;
	arg_code, code = 0;
	remaining_len = buf_len;
	nl_found = "0"b;
	ad.saved_eot = "0"b;

	do while ((remaining_len > 0) & ^nl_found);
	     if ad.scanned_data_len > 0 then do;	/* Look at available data */
		i = index (scanned_data, nl);
		if i = 0 then i = ad.scanned_data_len;	/* No new-line */
		else nl_found = "1"b;
		call move_scanned_data (min (i, remaining_len));
	     end;
	     else do;
		call scan_more_data;
		if code ^= 0 then do;
		     arg_code = code;
		     return;
		end;
	     end;
	end;

	if data_len > 0 then if substr (buf_arg, data_len, 1) ^= nl then
		arg_code = error_table_$long_record;
	arg_data_len = data_len;
	return;


/* Procedure to scan some more of the input buffer */

scan_more_data: proc;

dcl (i, j) fixed bin (21);
dcl  block_ok bit (1);				/* Set if ok to block waiting for data */
dcl  p ptr;

	     block_ok = "1"b;			/* Ok to block at normal entry */
	     go to get_more_data;

scan_more_data_noblock: entry;			/* Entry called to test, blocking not permitted */
	     block_ok = "0"b;

get_more_data: code = 0;
	     do while (ad.unscanned_data_len = 0);	/* First need data to scan */
		if input_block.next_blockp = null then do; /* No extra input buffers waiting */
		     call hcs_$tty_read (ad.tty_index, ad.input_buf_ptr, 0, ad.input_buf_len, i, state, code);
		     call check_error_code;
		     if code ^= 0 then return;
		end;
		else do;				/* Free current buffer and switch to new one already full */
		     p = input_block.next_blockp;	/* Save pointer to next block */
		     free input_block;
		     ad.input_blockp = p;
		     ad.input_buf_ptr = addr (input_block.input_buffer); /* New buffer */
		     i = input_block.data_len;	/* Will never be 0 */
		end;
		if i = 0 then do;			/* Must wait for data */
		     if ^block_ok then return;
		     call block (ad.channel, 1);
		     if code ^= 0 then return;
		end;
		else do;				/* Read something */
		     if ad.log_sw then call iox_$write_record (ad.log_iocbp, ad.input_buf_ptr, i, (0));
		     ad.unscanned_data_len = i;
		     ad.unscanned_data_ptr = ad.input_buf_ptr;
		end;
	     end;

/* Now dispatch of current state of input scan and the data type */

	     if ad.transparent then go to get_data_trans (ad.input_state);
	     else go to get_data_non_trans (ad.input_state);

get_data_non_trans (1):				/* Looking for stx in non_transparent mode */
	     if substr (unscanned_data, 1, 1) = ad.stx then do; /* Found data */
		stx_found = "1"b;
		ad.input_state = 2;
		call advance_unscanned_data (1);
		go to get_more_data;
	     end;
	     if substr (unscanned_data, 1, 1) = ad.soh then do; /* Found header */
		soh_found = "1"b;
		ad.input_state = 6;
		call advance_unscanned_data (1);
		go to get_more_data;
	     end;
	     if ^ad.break_on_eot | (substr (unscanned_data, 1, 1) ^= ad.eot) then do; /* Nothing else matters but eot */
		call advance_unscanned_data (1);
		go to get_more_data;
	     end;
	     call advance_unscanned_data (1);		/* Move over eot */
	     eot_found = "1"b;
	     return;

get_data_non_trans (2):				/* In middle of block, looking for etb or etx */
	     i = index (unscanned_data, ad.etx);
	     if i = 1 then do;			/* End of block */
		call advance_unscanned_data (1);	/* Move over etx */
		etx_found = "1"b;
		if ad.ascii then ad.input_state = 3;	/* State 3 to skip lrc character */
		else ad.input_state = 1;
		return;
	     end;
	     if ad.multi_record then do;		/* Must check for itbs */
		j = index (unscanned_data, ad.itb);
		if j ^= 0 then do;			/* There is one */
		     if j = 1 then do;		/* Next char is itb */
			call advance_unscanned_data (1);
			etx_found = "1"b;		/* Treat like etx */
			if ad.ascii then ad.input_state = 4; /* Go skip lrc */
			else ad.input_state = 5;
			return;
		     end;
		     else if i = 0 then i = j;	/* If no etx, use itb */
		     else i = min (i, j);		/* Otherwise use wat comes first */
		end;
	     end;

	     if i = 0 then i = ad.unscanned_data_len;	/* All good data */
	     else i = i - 1;			/* Use stuff before etx */
	     j = index (unscanned_data, ad.etb);	/* Check for etb too */
	     if j = 1 then do;			/* Found etb before etx */
		call advance_unscanned_data (1);	/* Over etb */
		if ad.ascii then ad.input_state = 3;	/* Skp lrc in non-transparent ascii */
		else ad.input_state = 1;		/* Back to stx search if ebcdic */
		if ad.break_on_etb then do;		/* If break wanted here */
		     etb_found = "1"b;
		     etx_found = "1"b;
		     return;
		end;
		else go to get_more_data;
	     end;
	     if j ^= 0 then i = min (i, j-1);		/* If etb present, used data before etb or etx */
	     ad.scanned_data_len = i;			/* Amount of good data found */
	     ad.scanned_data_ptr = ad.unscanned_data_ptr;
	     call advance_unscanned_data (i);
	     return;

get_data_non_trans (3):				/* Skip over lrc character after etx or etb */
	     call advance_unscanned_data (1);
	     ad.input_state = 1;
	     go to get_more_data;

get_data_non_trans (4):				/* Skip lrc after itb */
	     call advance_unscanned_data (1);
	     ad.input_state = 5;
	     go to get_more_data;

get_data_non_trans (5):				/* Check for optional stx after itb */
	     if substr (unscanned_data, 1, 1) = ad.stx then ad.input_state = 1; /* Its there */
	     else do;				/* Not there, pretend it is */
		stx_found = "1"b;
		ad.input_state = 2;
	     end;
	     go to get_more_data;

get_data_non_trans (6):				/* Scanning data in header */
	     i = index (unscanned_data, ad.etx);	/* Look for etx */
	     if i = 1 then do;			/* First char */
get_data_non_trans_6a:
		call advance_unscanned_data (1);
		etx_found = "1"b;
		if ad.ascii then ad.input_state = 3;
		else ad.input_state = 1;
		return;
	     end;
	     j = index (unscanned_data, ad.etb);	/* Also look for etb */
	     if i = 0 then i = j;			/* If no etx, use etb */
	     else if j ^= 0 then i = min (i, j);	/* Otherwise use what comes first */
	     j = index (unscanned_data, ad.stx);	/* This may also terminate header */
	     if i = 0 then i = j;			/* If no etb or etx, use stx */
	     else if j ^= 0 then i = min (i, j);	/* Otherwise use what comes first */
	     if i = 0 then do;			/* Didnt find any special chars */
		ad.scanned_data_len = ad.unscanned_data_len; /* All data is part of header */
		ad.scanned_data_ptr = ad.unscanned_data_ptr;
		ad.unscanned_data_len = 0;
		return;
	     end;
	     if i = 1 then do;			/* Control char is first */
		if substr (unscanned_data, 1, 1) = ad.stx then do; /* Start of text portion */
		     call advance_unscanned_data (1);
		     stx_found = "1"b;		/* In data */
		     soh_found = "0"b;		/* Not in header */
		     ad.input_state = 2;
		     go to get_more_data;
		end;
		if substr (unscanned_data, 1, 1) = ad.etb & ^ad.break_on_etb then do;
		     call advance_unscanned_data (1);	/* Ignore etb */
		     if ad.ascii then ad.input_state = 3;
		     else ad.input_state = 1;
		     go to get_more_data;
		end;
		etb_found = (substr (unscanned_data, 1, 1) = ad.etb);
		go to get_data_non_trans_6a;
	     end;
	     i = i - 1;				/* Number of data chars in header */
	     ad.scanned_data_len = i;
	     ad.scanned_data_ptr = ad.unscanned_data_ptr;
	     call advance_unscanned_data (i);
	     return;


get_data_trans (1):					/* Looking for  dle-stx sequence */
	     i = index (unscanned_data, ad.dle);	/* First, find the dle */
	     if i = 0 then do;			/* No dle, throw away data */
		ad.unscanned_data_len = 0;
		go to get_more_data;
	     end;
	     call advance_unscanned_data (i);		/* Advance past dle */
	     ad.input_state = 2;
	     go to get_more_data;

get_data_trans (2):					/* Found dle, next char should be stx */
	     if substr (unscanned_data, 1, 1) = ad.stx then do;
		call advance_unscanned_data (1);	/* Move over stx */
		ad.input_state = 3;			/* In std input state to read data now */
		stx_found = "1"b;
		go to get_more_data;
	     end;
	     ad.input_state = 1;			/* Dle-stx not found */
	     go to get_more_data;			/* Back to look for another dle */

get_data_trans (3):					/* In text of message, but be careful of dles */
	     i = index (unscanned_data, ad.dle);
	     if i = 1 then do;			/* Found a dle */
		call advance_unscanned_data (1);	/* Over dle */
		ad.input_state = 4;			/* Must analyze next character */
		go to get_more_data;
	     end;
	     if i = 0 then i = ad.unscanned_data_len;	/* If no dle, all text is good */
	     else i = i-1;
	     ad.scanned_data_len = i;			/* Length of real text found */
	     ad.scanned_data_ptr = ad.unscanned_data_ptr;
	     call advance_unscanned_data (i);
	     return;

get_data_trans (4):					/* Check text char after a dle */
	     if substr (unscanned_data, 1, 1) = ad.dle then do; /* Double dle */
		ad.scanned_data_len = 1;		/* Setup as 1 good dle character */
		ad.scanned_data_ptr = ad.unscanned_data_ptr;
		ad.input_state = 3;
		call advance_unscanned_data (1);
		return;
	     end;
	     if substr (unscanned_data, 1, 1) = ad.etb then do; /* End of text block */
		call advance_unscanned_data (1);	/* Throw away etb */
		ad.input_state = 1;			/* Looking for stx now */
		if ad.break_on_etb then do;		/* Break wanted here */
		     etx_found = "1"b;
		     return;
		end;
		else go to get_more_data;
	     end;
	     if substr (unscanned_data, 1, 1) = ad.etx then do; /* Real end of message */
trans_etx:	call advance_unscanned_data (1);
		ad.input_state = 1;
		etx_found = "1"b;
		return;
	     end;
	     if ad.multi_record then if substr (unscanned_data, 1, 1) = ad.itb then go to trans_etx;
	     ad.scanned_data_ptr = addr (ad.dle);	/* A dle-?? found, treat as data */
	     ad.scanned_data_len = 1;			/* Setup to return a dle first */
	     ad.input_state = 3;			/* Then the n ext char as regular data */
	     return;

	end scan_more_data;

/* Procedure to move characters to users output buffer */

move_scanned_data: proc (amt);

dcl  amt fixed bin (21);
dcl  i fixed bin (21);

	     if soh_found then do;			/* Moving header */
		if hbuf_ptr ^= null then do;		/* Caller gave a place */
		     i = min (amt, hbuf_len - header_len);
		     if i > 0 then substr (header_arg, header_len + 1, i) = substr (scanned_data, 1, i);
		     header_len = header_len + i;
		     call advance_scanned_data (amt);
		     header_found = "1"b;
		end;
	     end;
	     else do;
		substr (buf_arg, data_len + 1, amt) = substr (scanned_data, 1, amt);
		data_len = data_len + amt;
		call advance_scanned_data (amt);
		remaining_len = remaining_len - amt;
		data_found = "1"b;
	     end;
	     return;

	end move_scanned_data;

/* Procedure to  more the pointer in the unscanned data area */

advance_unscanned_data: proc (amt);

dcl  amt fixed bin (21);

	     ad.unscanned_data_ptr = substraddr (unscanned_data, amt+1);
	     ad.unscanned_data_len = ad.unscanned_data_len - amt;
	     return;

	end advance_unscanned_data;

/* Procedure to move pointer in the scanned data area */

advance_scanned_data: proc (amt);

dcl  amt fixed bin (21);

	     ad.scanned_data_ptr = substraddr (scanned_data, amt+1);
	     ad.scanned_data_len = ad.scanned_data_len - amt;
	     return;

	end advance_scanned_data;

/* This procedure is called before going blocked on output. it will flush ring 0
   of any input that may have come in so that the write has a chance of going
   out. any input found is chained on to an input buffer chain to be found of the
   next read call */

hide_away_input: proc;

dcl 1 read_status aligned automatic like rw_status;
dcl  p ptr;

	     read_status.flag = "1"b;
	     do while (read_status.flag);		/* Loop as long as there is data */
		call hcs_$tty_order (ad.tty_index, "read_status", addr (read_status), state, code);
		call check_error_code;
		if code ^= 0 then return;
		if read_status.flag then do;		/* There is data */
		     allocate input_block in (work_area) set (p); /* Get a buffer */
		     call hcs_$tty_read (ad.tty_index, addr (p -> input_block.input_buffer), 0, ad.input_buf_len,
			p -> input_block.data_len, state, code);
		     call check_error_code;
		     if code ^= 0 then do;
			free p -> input_block;
			return;
		     end;
		     if p -> input_block.data_len > 0 then do;
			ad.last_input_blockp -> input_block.next_blockp = p;
			ad.last_input_blockp = p;
		     end;
		     else free p -> input_block;	/* Free empty buffer */
		end;
	     end;
	     return;

	end hide_away_input;

/* Control entry point */

bisync_control: entry (arg_iocbp, arg_order, arg_info_ptr, arg_code);

	iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	info_ptr = arg_info_ptr;
	arg_code, code = 0;
	order = arg_order;

	i = 0;					/* In case order is resetread, resetwrite, or abort */
	if order = "resetread" then do;
	     i = 1;
	     call internal_resetread;
	end;
	else if order = "resetwrite" then do;
	     i = 2;
	     ad.output_buf_used = 0;
	     ad.output_buf_left = ad.output_buf_len;
	end;
	else if order = "abort" then do;
	     i = 3;
	     call internal_resetread;
	     ad.output_buf_used = 0;
	     ad.output_buf_left = ad.output_buf_len;
	end;
	if i ^= 0 then call hcs_$tty_abort (ad.tty_index, (i), state, code);

	else if order = "event_info" then do;
	     event_info_channel = ad.channel;
	     code = 0;
	end;

	else if order = "read_status" then do;		/* See if input available */
	     code = 0;
	     rw_status.channel = ad.channel;
	     if ad.scanned_data_len > 0 then rw_status.flag = "1"b; /* There is and I already have it */
	     else if ad.saved_eot then rw_status.flag = "1"b;
	     else do;
retry_read_status:	eot_found, etx_found, stx_found, soh_found, etb_found = "0"b;
		call scan_more_data_noblock;		/* Try scanning some more input */
		if ad.scanned_data_len > 0 then rw_status.flag = "1"b; /* That worked */
		else if eot_found then do;		/* This is data too */
		     ad.saved_eot = "1"b;		/* But save it for the get chars call */
		     rw_status.flag = "1"b;
		end;
		else if etx_found then go to retry_read_status; /* Ignore extra etx */
		else rw_status.flag = "0"b;		/* No data anywhere */
		code = 0;
	     end;
	end;

	else if order = "set_bid_limit" then do;
	     ad.bid_limit = order_val;
	     call line_control (SET_BID_LIMIT, ad.bid_limit);
	end;

	else if order = "get_bid_limit" then do;
	     order_val = ad.bid_limit;
	     code = 0;
	end;

	else if order = "set_bsc_modes" then do;
	     ad.transparent = bsc_modes.transparent;
	     ad.ascii = ^bsc_modes.ebcdic;
	     call line_control (CONFIGURE, bin (ad.transparent || ^ad.ascii));
	     call set_control_chars;
	end;

	else if order = "get_bsc_modes" then do;
	     bsc_modes.transparent = ad.transparent;
	     bsc_modes.ebcdic = ^ad.ascii;
	     code = 0;
	end;

	else if order = "runout" then do;
	     code = 0;

	     if ad.output_etb_mode then do;		/* calls bisync_$bisync_put_chars which already */
		ad.use_etb = "0"b;			/* knows all the right things to do */
						/* to transmit an empty record with an ETX */
		call iocbp -> iocb.put_chars (iocbp, addr (empty_buffer), 0, code);
		ad.use_etb = "1"b;
	     end;

	     if ad.multi_record & code = 0 then
		if ad.output_mode then
		     if ad.output_buf_used > 0 then
			call transmit_block;	/* Dump last block */
	     if ad.write_error_code ^= 0 & code = 0 then do;
		code = ad.write_error_code;
		ad.write_error_code = 0;
	     end;

	end;					/* if order = "runout" */

	else if order = "set_size" then do;
	     if order_val > ad.max_block_len then code = error_table_$buffer_big;
	     else do;
		ad.block_len = order_val;
		if ad.output_mode then		/* Maybe doing output */
		     ad.output_buf_left = max (0, ad.block_len - ad.output_buf_used);
		code = 0;
	     end;
	end;

	else if order = "get_size" then do;
	     order_val = ad.block_len;
	     code = 0;
	end;

	else if order = "set_multi_record_mode" then do;
	     code = 0;
	     if info_ptr = null then do;
		ad.multi_record = "1"b;
		ad.multi_record_limit = 0;
	     end;
	     else do;
		ad.multi_record_limit = max (0, order_val);
		ad.multi_record = (ad.multi_record_limit ^= 1);
	     end;
	end;

	else if order = "get_multi_record_mode" then do;
	     if ^ad.multi_record then order_val = 1;
	     else order_val = ad.multi_record_limit;
	     code = 0;
	end;

	else if order = "hangup_proc" then do;
	     call ipc_$decl_ev_call_chn (ad.attach_channel, hangup_proc.entry_var, hangup_proc.data_ptr,
		hangup_proc.prior, code);
	     if code ^= 0 then call convert_ipc_code_ (code);
	     if code = 0 then ad.attach_channel_is_call = "1"b;
	end;

	else if order = "send_nontransparent_msg" then do;
	     call iox_$control (iocbp, "runout", null, code);
	     if code = 0 then do;
		ad.temp_nontransparent = "1"b;
		call iox_$put_chars (iocbp, addr (order_msg.data), length (order_msg.data), code);
		ad.temp_nontransparent = "0"b;
		if code = 0 then call iox_$control (iocbp, "runout", null, code);
	     end;
	end;

	else if order = "end_write_mode" then call end_write_mode;

	else if order = "set_polling_addr" then do;
	     if info_ptr = null then do;
		valchar.data_len = 0;
		valchar.data = "";
	     end;
	     else do;
		valchar.data_len = min (order_msg.data_len, length (valchar.data));
		valchar.data = order_msg.data;
	     end;
	     call line_control_val_set (SET_POLLING_ADDR);
	end;

	else if order = "poll" then call line_control (START_POLL, 0);

	else if order = "get_chars" then go to get_chars_order;

	else if order = "io_call" then call bisync_io_call;

	else do;
	     call hcs_$tty_order (ad.tty_index, order, info_ptr, state, code);
	     call check_error_code;
	     if order = "write_status" then do;
		rw_status.channel = ad.channel;
		if ad.write_error_code ^= 0 then do;
		     code = ad.write_error_code;
		     ad.write_error_code = 0;
		end;
	     end;
	end;

control_return:
	arg_code = code;
	return;

/* Internal procedure to do resetread on internal I/O module buffers */

internal_resetread: proc;

dcl  p ptr;

	     ad.input_state = 1;
	     ad.scanned_data_len, ad.unscanned_data_len = 0;
	     ad.saved_eot = "0"b;

	     do while (input_block.next_blockp ^= null);
		p = input_block.next_blockp;
		free input_block;
		ad.input_blockp = p;
		ad.input_buf_ptr = addr (input_block.input_buffer);
	     end;
	     return;

	end internal_resetread;

/* Procedure to implement the end_write_mode order */
/* This order waits for the fnp to transmit the last output block */

end_write_mode: proc;

dcl 1 write_status aligned automatic like rw_status;

	     if ^ad.output_mode then do;
		code = error_table_$no_operation;
		return;
	     end;

	     if ad.multi_record & (ad.output_buf_used) > 0 then do; /* Write last block */
		call transmit_block;
		if code ^= 0 then return;
		if ad.write_error_code ^= 0 then do;
end_write_mode_err:
		     code = ad.write_error_code;
		     ad.write_error_code = 0;
		     return;
		end;
	     end;
	     substr (output_buffer, 1, 1) = ad.eot;	/* EOT to end transmission */
	     ad.output_buf_used = 1;
	     call transmit_block;
	     if code ^= 0 then return;
	     if ad.write_error_code ^= 0 then go to end_write_mode_err;

/* Get the data out of ring 0 */

	     write_status.flag = "1"b;
	     do while (write_status.flag);
		call hcs_$tty_order (ad.tty_index, "write_status", addr (write_status), state, code);
		call check_error_code;
		if code ^= 0 then return;
		if ad.write_error_code ^= 0 then go to end_write_mode_err;
		if write_status.flag then do;
		     call hide_away_input;
		     if code ^= 0 then return;
		     if ad.write_error_code ^= 0 then go to end_write_mode_err;
		     call block (ad.channel, 1);
		     if code ^= 0 then return;
		end;
	     end;

/* Wait 5 seconds for things to settle down */

end_write_mode0:
	     call set_time (5);
end_write_mode1:
	     call block (ad.channel, 2);
	     if code ^= 0 then return;
	     if event_info.channel_id ^= ad.timer_channel then do; /* Wakeup on device channel */
		call hide_away_input;
		if code ^= 0 then return;
		if ad.write_error_code ^= 0 then go to end_write_mode_err;
		go to end_write_mode1;
	     end;

/* Flush any existing write status */

	     call check_line_status;
	     if code ^= 0 & code ^= error_table_$no_line_status then return;
	     ad.fnp_output_pending = "0"b;
	     ad.fnp_output_reported = "0"b;
	     if ad.write_error_code ^= 0 then go to end_write_mode_err;

/* See if fnp is done writing */

	     call line_control (REPORT_WRITE_STATUS, 0);
	     if code ^= 0 then return;
	     if ad.write_error_code ^= 0 then go to end_write_mode_err;
	     call set_time (5);
	     call block (ad.channel, 2);
	     if code ^= 0 then return;
	     if event_info.channel_id ^= ad.timer_channel then do;
		call hide_away_input;
		if code ^= 0 then return;
		if ad.write_error_code ^= 0 then go to end_write_mode_err;
		if ad.fnp_output_reported then do;
		     if ad.fnp_output_pending then go to end_write_mode1;
		     else return;
		end;
	     end;
	     go to end_write_mode0;			/* Try all over again */

	end end_write_mode;

/* Subroutine to do the io_call order for bisync_ */

bisync_io_call: proc;

dcl  i fixed bin;
dcl  p ptr;
dcl 1 info aligned,					/* For info order */
    2 id char (4),
    2 baud_rate fixed bin (17) unal,
    2 reserved bit (54) unal,
    2 type fixed bin;

dcl 1 auto_rw_status aligned like rw_status automatic;
dcl  event_info_channel fixed bin (71);
dcl 1 auto_bsc_modes like bsc_modes aligned automatic;
dcl 1 order_msg aligned based (p),
    2 data_len fixed bin,
    2 data char (i);
dcl  get_chars_data char (i) based;
dcl 1 auto_get_chars_info like get_chars_info aligned automatic;

	     io_call_infop = info_ptr;
	     order = io_call_info.order_name;
	     caller = io_call_info.caller_name;
	     rpt = io_call_info.report;
	     err = io_call_info.error;

	     if order = "info" then do;
		call iox_$control (iocbp, "info", addr (info), code);
		if code = 0 then
		     call rpt ("^a: Terminal id=""^a"", baud_rate=^d, type=^d.",
		     caller, info.id, info.baud_rate, info.type);
	     end;

	     else if order = "read_status" then do;
		info_ptr = addr (auto_rw_status);
		call iox_$control (iocbp, "read_status", info_ptr, code);
		if code = 0 then
		     call rpt ("^a: Event channel=^.3b, input is ^[^;not ^]available.",
		     caller, unspec (rw_status.channel), rw_status.flag);
	     end;

	     else if order = "write_status" then do;
		info_ptr = addr (auto_rw_status);
		call iox_$control (iocbp, "write_status", info_ptr, code);
		if code = 0 then
		     call rpt ("^a: Event channel=^.3b, output is ^[^;not ^]pending.",
		     caller, unspec (rw_status.channel), rw_status.flag);
	     end;

	     else if order = "event_info" then do;
		call iox_$control (iocbp, "event_info", addr (event_info_channel), code);
		if code = 0 then call rpt ("^a: Event channel=^.3b",
		     caller, unspec (event_info_channel));
	     end;

	     else if order = "set_bid_limit" then do;
		i = cv_io_call_dec_arg (1);
		call iox_$control (iocbp, "set_bid_limit", addr (i), code);
	     end;

	     else if order = "get_bid_limit" then do;
		call iox_$control (iocbp, "get_bid_limit", addr (i), code);
		if code = 0 then call rpt ("^a: Bisync bid limit is ^d retries.",
		     caller, i);
	     end;

	     else if order = "set_bsc_modes" then do;
		auto_bsc_modes.transparent = "1"b;
		auto_bsc_modes.ebcdic = "0"b;
		auto_bsc_modes.fill = "0"b;
		do i = 1 to io_call_info.nargs;
		     if io_call_info.args (i) = "ascii" then auto_bsc_modes.ebcdic = "0"b;
		     else if io_call_info.args (i) = "ebcdic" then auto_bsc_modes.ebcdic = "1"b;
		     else if io_call_info.args (i) = "transparent" then auto_bsc_modes.transparent = "1"b;
		     else if io_call_info.args (i) = "nontransparent" then auto_bsc_modes.transparent = "0"b;
		     else do;
			call err (error_table_$badopt, caller,
			     "Invalid bisync mode: ^a", io_call_info.args (i));
			code = 0;
			return;
		     end;
		end;
		call iox_$control (iocbp, "set_bsc_modes", addr (auto_bsc_modes), code);
	     end;

	     else if order = "get_bsc_modes" then do;
		call iox_$control (iocbp, "get_bsc_modes", addr (auto_bsc_modes), code);
		if code = 0 then
		     call rpt ("^a: Current bisync mode is ^[non^]transparent ^[ebcdic^;ascii^].",
		     caller, ^auto_bsc_modes.transparent, auto_bsc_modes.ebcdic);
	     end;

	     else if order = "set_size" then do;
		i = cv_io_call_dec_arg (1);
		call iox_$control (iocbp, "set_size", addr (i), code);
	     end;

	     else if order = "get_size" then do;
		call iox_$control (iocbp, "get_size", addr (i), code);
		if code = 0 then call rpt ("^a: Bisync block size is ^d characters.",
		     caller, i);
	     end;

	     else if order = "set_multi_record_mode" then do;
		if io_call_info.nargs = 0 then call iox_$control (iocbp, "set_multi_record_mode", null, code);
		else do;
		     i = cv_io_call_dec_arg (1);
		     call iox_$control (iocbp, "set_multi_record_mode", addr (i), code);
		end;
	     end;

	     else if order = "get_multi_record_mode" then do;
		call iox_$control (iocbp, "get_multi_record_mode", addr (i), code);
		if code = 0 then call rpt ("^a: Bisync blocks contain ^[^d^;unlimited^s^] record^[s^].",
		     caller, (i ^= 0), i, (i ^= 1));
	     end;

	     else if order = "send_nontransparent_msg" then do;
		if io_call_info.nargs = 0 then code = error_table_$noarg;
		else do;
		     i = length (io_call_info.args (1));
		     allocate order_msg in (work_area);
		     order_msg.data_len = i;
		     order_msg.data = io_call_info.args (1);
		     call iox_$control (iocbp, "send_nontransparent_msg", p, code);
		     free order_msg;
		end;
	     end;

	     else if order = "set_polling_addr" then do;
		if io_call_info.nargs = 0 then call iox_$control (iocbp, "set_polling_addr", null, code);
		else do;
		     i = length (io_call_info.args (1));
		     allocate order_msg in (work_area);
		     order_msg.data_len = i;
		     order_msg.data = io_call_info.args (1);
		     call iox_$control (iocbp, "set_polling_addr", p, code);
		     free order_msg;
		end;
	     end;

	     else if order = "get_chars" then do;
		i = cv_io_call_dec_arg (1);		/* Get buffer size */
		info_ptr = addr (auto_get_chars_info);
		allocate get_chars_data in (work_area) set (get_chars_info.buf_ptr);
		allocate get_chars_data in (work_area) set (get_chars_info.hbuf_ptr);
		get_chars_info.buf_len, get_chars_info.hbuf_len = i;
		call iox_$control (iocbp, "get_chars", addr (auto_get_chars_info), code);
		if code = 0 then do;		/* It worked */
		     if get_chars_info.eot then call rpt ("^a: EOT read.", caller);
		     if get_chars_info.soh then call rpt ("^a: Header: ^a", caller,
			substr (get_chars_info.hbuf_ptr -> get_chars_data, 1, get_chars_info.header_len));
		     if get_chars_info.data_len > 0 then call rpt ("^a: Data^[(ETX)^]^[(ETB)^]: ^a", caller,
			get_chars_info.etx, get_chars_info.etb,
			substr (get_chars_info.buf_ptr -> get_chars_data, 1, get_chars_info.data_len));
		end;
		free get_chars_info.buf_ptr -> get_chars_data;
		free get_chars_info.hbuf_ptr -> get_chars_data;
	     end;

	     else call iox_$control (iocbp, (order), null, code);

	     return;

	end bisync_io_call;


/* Procedure used to convert a decimal arg during an io_call order */

cv_io_call_dec_arg: proc (n) returns (fixed bin);

dcl  n fixed bin;

	     if n > io_call_info.nargs then do;
		code = error_table_$noarg;
		go to control_return;
	     end;

	     on conversion go to cv_io_call_dec_arg_err;
	     return (bin (io_call_info.args (n)));

cv_io_call_dec_arg_err:
	     call err (0, caller, "Invalid decimal argument: ^a", io_call_info.args (n));
	     code = 0;
	     go to control_return;

	end cv_io_call_dec_arg;

/* Position entry point */

bisync_position: entry (arg_iocbp, arg_pos_type, arg_pos_value, arg_code);

	iocbp = arg_iocbp -> iocb.actual_iocb_ptr;
	adp = iocbp -> iocb.attach_data_ptr;
	pos_type = arg_pos_type;
	pos_value = arg_pos_value;
	arg_code, code = 0;

	if ((pos_type ^= 0) & (pos_type ^= 3)) | (pos_value < 0) then do; /* Bad args */
	     arg_code = error_table_$bad_arg;
	     return;
	end;

	if pos_type = 3 then do while (pos_value > 0);	/* Skip over chars */
	     i = min (pos_value, ad.scanned_data_len);
	     if i > 0 then do;			/* Some available to skip */
		call advance_scanned_data (i);
		pos_value = pos_value - i;
	     end;
	     else do;
		call scan_more_data;		/* Need more chars */
		if code ^= 0 then do;
		     arg_code = code;
		     return;
		end;
	     end;
	end;

	else do while (pos_value > 0);		/* Skip over lines */
	     if ad.scanned_data_len > 0 then do;	/* Have data to look at */
		i = index (scanned_data, nl);		/* Find end of line */
		if i = 0 then ad.scanned_data_len = 0;	/* No nl, throw data away */
		else do;
		     pos_value = pos_value - 1;
		     call advance_scanned_data (i);	/* Skip data to new-line */
		end;
	     end;
	     else do;				/* Need more data */
		call scan_more_data;
		if code ^= 0 then do;
		     arg_code = code;
		     return;
		end;
	     end;
	end;

	arg_code = 0;

	return;

/* Procedure to do a line control order */

line_control: proc (op, val1);

dcl (op, val1, val2) fixed bin;

	     line_ctl.val = 0;
line_control_join:
	     line_ctl.val (1) = val1;

line_control_val_set: entry (op);

	     line_ctl.op = op;
	     call hcs_$tty_order (ad.tty_index, "line_control", addr (line_ctl), state, code);
	     call check_error_code;
	     return;

line_control2: entry (op, val1, val2);

	     line_ctl.val = 0;
	     line_ctl.val (2) = val2;
	     go to line_control_join;

	end line_control;

/* Procedure for checking error codes and fetching line_status if required */

check_error_code: proc;

	     if code = 0 then return;
	     if code ^= error_table_$line_status_pending then return;
	     call check_line_status;
	     return;

	end check_error_code;

check_line_status: proc;

	     call hcs_$tty_order (ad.tty_index, "line_status", addr (line_stat), state, code);
	     if code ^= 0 then return;
	     if line_stat.op = BID_FAILED then code = error_table_$bisync_bid_fail;
	     else if line_stat.op = BAD_BLOCK then code = error_table_$bisync_block_bad;
	     else if line_stat.op = REVERSE_INTERRUPT then code = error_table_$bisync_reverse_interrupt;
	     else if line_stat.op = TOO_MANY_NAKS then code = error_table_$device_parity;
	     else if line_stat.op = FNP_WRITE_STATUS then do;
		ad.fnp_output_reported = "1"b;
		ad.fnp_output_pending = (line_stat.val (1) = 1);
	     end;

	     if code ^= 0 then do;
		ad.write_error_code = code;		/* Save for later */
		code = 0;
	     end;
	     return;

	end check_line_status;

/* Set bisync control characters for current mode */

set_control_chars: proc;

	     unspec (ad.stx) = "002"b3;
	     unspec (ad.etx) = "003"b3;
	     unspec (ad.dle) = "020"b3;
	     unspec (ad.itb) = "037"b3;
	     unspec (ad.soh) = "001"b3;
	     if ad.ascii then do;
		unspec (ad.etb) = "027"b3;
		unspec (ad.eot) = "004"b3;
	     end;
	     else do;
		unspec (ad.etb) = "046"b3;
		unspec (ad.eot) = "067"b3;
	     end;
	     return;

	end set_control_chars;

/* Interal procedure to block */

block:	proc (chan_id, nchan);

dcl  chan_id fixed bin(71);                                 /* Event channel to block on */
dcl  nchan fixed bin;				/* Number of channels to block on */

	     ad.channel_id = chan_id;
               ad.nchan = nchan;
	     call ipc_$block (addr (ad.wait_list), addr (event_info), code);
	     if code ^= 0 then call convert_ipc_code_ (code);
	     return;

	end block;

/* Set a timer */

set_time:	proc (n_sec);

dcl  n_sec fixed bin;

	     call timer_manager_$reset_alarm_wakeup (ad.timer_channel);
	     call ipc_$drain_chn (ad.timer_channel, code);
	     call timer_manager_$alarm_wakeup ((n_sec), "11"b, ad.timer_channel);
	     return;

	end set_time;

/* Builtin function substraddr until it is real */

substraddr: proc (c, n) returns (ptr);

dcl  c char (*);
dcl  n fixed bin (21);
dcl  ca (n) char (1) based (addr (c));

	     return (addr (ca (n)));

	end substraddr;

/**/

%include area_info;
%page;
%include bisync_line_data;
%page;
%include iocb;
%page;
%include iox_modes;
%page;
%include io_call_info;

     end bisync_;


*/
                                          -----------------------------------------------------------


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

*/