g115_.pl1 08/30/82 1519.8rew 08/30/82 1138.3 373707 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ g115_: proc; return; /* not a legal entry */ /* Rewritten by D. Vinograd, 11/77, to make the G115 an iox based module for MR 6.1 */ /* Modified by J. Nicholls 7/78 to change full_cc to rr_cnt to use reocrd counting instead of character counting */ /* Modified by D. Vinograd, 10/78, for compatibility with MCS 3.3 and above */ /* Modified by J. C. Whitmore, 11/78, to make all attach options consistent with the remote_xxx_ dims */ /* Modified by J. C. Whitmore, 3/79, to correct size and initialization of delay variable */ /* Modified by J. C. Whitmore, 8/79, grossley changed to accept binary output mode and multiple channels per process */ /* Parameters */ dcl a_code fixed bin (35) parameter; dcl (a_new_mode, a_old_mode) char (*) parameter; dcl a_nelem fixed bin (21) parameter; dcl a_nelemt fixed bin (21) parameter; dcl a_devx fixed bin parameter; dcl a_ddp ptr parameter; dcl a_adp ptr parameter; dcl a_bufp ptr parameter; dcl a_iocbp ptr parameter; dcl a_option (*) char (*) var parameter; dcl a_comerr_sw bit (1) parameter; dcl a_open_mode fixed bin parameter; dcl a_order char (*) parameter; dcl a_infop ptr parameter; /* Automatic */ dcl attach_description char (256) var; dcl bufp ptr; dcl chn fixed bin (71); dcl code fixed bin (35); dcl comerr_sw bit (1) init ("0"b); dcl comm char (32); dcl delay fixed bin (35); dcl device char (32); dcl device_type fixed bin; dcl dial_msg_chan char (32); /* Variables for dial manager */ dcl dial_msg_module char (32); dcl dial_msg_ndialed fixed bin; dcl dummy_arg char (32); dcl i fixed bin; dcl ignore fixed bin (35); dcl infop ptr; dcl iocbp ptr; dcl level fixed bin; dcl mask bit (36); dcl max_length fixed bin; dcl open_mode fixed bin; dcl order char (32); dcl state fixed bin; dcl temp_ptr ptr; dcl terminal_type char (32); dcl tty char (32); /* Internal Static */ dcl attach_areap ptr int static init (null); /* pointer to attach_area */ dcl first_device_data_p ptr int static init (null); /* head of chain of device data structures */ dcl last_device_data_p ptr int static init (null); /* tail of this chain */ dcl static_comerr_sw bit (1) int static init ("0"b); /* to force error messages during debug */ /* Based variables */ dcl attach_area area (262144) based (attach_areap); /* space for device_data and attach data structures */ dcl info_string char (32) based (infop); /* for the control entry */ /* External Entries */ dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); dcl get_process_id_ entry () returns (bit (36)); dcl get_ttt_info_ entry (ptr, fixed bin (35)); dcl hcs_$tty_abort entry (fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$decl_ev_wait_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_$block entry (ptr, ptr, fixed bin (35)); dcl hcs_$tty_attach entry (char (*), fixed bin (71), fixed bin, fixed bin, fixed bin (35)); dcl ioa_ entry options (variable); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl hcs_$tty_detach entry (fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl g115_io_$read_status entry (ptr, ptr, fixed bin (35)); dcl g115_io_$write entry (ptr, ptr, fixed bin (35)); dcl hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35)); dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl convert_ipc_code_ entry (fixed bin (35)); dcl dial_manager_$privileged_attach entry (ptr, fixed bin (35)); dcl dial_manager_$release_channel entry (ptr, fixed bin (35)); dcl dial_manager_$dial_out 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 com_err_ entry options (variable); dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl continue_to_signal_ entry (fixed bin (35)); dcl iox_$err_no_operation entry; dcl hcs_$set_ips_mask entry (bit (36), bit (36)); dcl iox_$propagate entry (ptr); dcl hcs_$reset_ips_mask entry (bit (36), bit (36)); dcl g115_protocol_$write entry (ptr, ptr, ptr, fixed bin (21), fixed bin (35)); dcl g115_protocol_$read entry (ptr, ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); /* Builtins and Conditions */ dcl (null, addr, hbound, length, rtrim, ltrim, unspec, empty) builtin; dcl cleanup condition; dcl any_other condition; /* Error Table Entries */ dcl error_table_$bad_conversion fixed bin (35) ext; dcl error_table_$noarg fixed bin (35) ext; dcl error_table_$line_status_pending ext fixed bin (35); dcl error_table_$action_not_performed ext fixed bin (35); dcl error_table_$ionmat ext fixed bin (35); dcl error_table_$wrong_no_of_args ext fixed bin (35); dcl error_table_$badopt ext fixed bin (35); dcl error_table_$bad_mode ext fixed bin (35); dcl error_table_$multiple_io_attachment ext fixed bin (35); dcl error_table_$invalid_read ext fixed bin (35); dcl error_table_$invalid_write ext fixed bin (35); dcl error_table_$not_attached fixed bin (35) ext; dcl error_table_$not_detached fixed bin (35) ext; dcl error_table_$not_open fixed bin (35) ext; dcl error_table_$not_closed fixed bin (35) ext; dcl error_table_$no_operation fixed bin (35) ext; dcl error_table_$io_no_permission fixed bin (35) ext; dcl error_table_$resource_attached fixed bin (35) ext; /* Constants */ dcl devices (4) char (32) static options (constant) init ("reader", "printer", "teleprinter", "punch"); /* Line Control and Status Values */ dcl set_g115_remote_mode fixed bin int static init (3) options (constant); dcl test_for_fnp_output fixed bin int static init (5) options (constant); dcl reset_g115_remote_mode fixed bin int static static init (6) options (constant); dcl fnp_output_pending fixed bin int static init (8) options (constant); /* Structures */ dcl 1 line_status aligned, /* for the Ring 0 line_status order */ (2 value, 2 mbz1, 2 mbz2, 2 mbz3) fixed bin unal; dcl 1 hangup_proc aligned based (infop), /* Data for hangup_proc order */ 2 entry_var entry variable, 2 data_ptr ptr, 2 prior fixed bin; dcl 1 info_structure aligned based (infop), /* for the read_status control order */ 2 ev_chan fixed bin (71), 2 input_available bit (1); dcl 1 modes aligned, /* for the Ring 0 tty modes order */ 2 len fixed bin, 2 str char (256); dcl 1 event_info aligned, /* data returned by ipc_$block */ 2 channel_id fixed bin (71), /* event channel which signalled this wakeup */ 2 message fixed bin (71), /* 72 bit event message from sender */ 2 sender bit (36), /* process id of sending process */ 2 origin, 3 dev_signal bit (18) unal, 3 ring bit (18) unal, 2 channel_index fixed bin (17); /* index of channel_id in the wait list we blocked on */ dcl 1 dial_msg_flags aligned, /* data returned from convert_dial_message_ */ 2 dialed_up bit (1) unal, 2 hung_up bit (1) unal, 2 control bit (1) unal, 2 pad bit (33) unal; dcl 1 dma aligned, /* data for dial_manager_ to attach, dial_out or allow dials */ 2 version fixed bin, /* this is the version 1 structure */ 2 dial_qual char (22), /* phone number for dial_out, qualifier for allow dials */ 2 dial_mgr_ev_chan fixed bin (71), /* IPC chan for Ans. Serv. to notify us on */ 2 device_name char (32); /* name of the tty channel we want to have assigned */ dcl 1 dial_wait_list aligned, /* IPC wait list for blocking after calling dial_manager_ */ 2 nchan fixed bin init (1), /* number of channels in this list: always 1 */ 2 dummy_word fixed bin, /* so the next will be on even word */ 2 dial_mgr_ev_chan fixed bin (71); %include iocb; %include iox_modes; %include io_call_info; %include g115_attach_data; %include g115_device_data; %include g115_message; %include G115; %include remote_ttt_info; g115_attach: entry (a_iocbp, a_option, a_comerr_sw, a_code); comerr_sw = static_comerr_sw | a_comerr_sw; /* print error messages if either switch is on */ adp, device_data_p = null; /* no attach data or device data structures defined yet */ terminal_type, tty, comm, device = ""; delay, code, a_code = 0; iocbp = a_iocbp; /* copy the input iocb pointer */ if iocbp -> iocb.attach_descrip_ptr ^= null then do; /* already used? */ code = error_table_$not_detached; call abort_attach ("Already attached", ""); end; if hbound (a_option, 1) < 1 then do; code = error_table_$wrong_no_of_args; call abort_attach ("No attach description", ""); end; if attach_areap = null then do; /* make an area for attach data structures */ call get_temp_segment_ ("g115_attach", attach_areap, code); if code ^= 0 then call abort_attach ("Unable to create temp segment", ""); attach_area = empty; /* initialize the area */ end; on cleanup call clean_up_handler; dma.dial_qual = ""; /* prepare for call to dial manager */ attach_description = "g115_"; /* start building att desc which we will tell iox_ about */ do i = 1 to hbound (a_option, 1); attach_description = attach_description || " " || a_option (i); if a_option (i) = "-device" then device = get_option_arg (i); else if a_option (i) = "-tty" then tty = get_option_arg (i); else if a_option (i) = "-comm" then comm = get_option_arg (i); else if a_option (i) = "-auto_call" then dma.dial_qual = get_option_arg (i); else if a_option (i) = "-ascii" then; /* ignore ascii/ebcdic specification */ else if a_option (i) = "-physical_line_length" | a_option (i) = "-pll" then dummy_arg = get_option_arg (i); /* ignore -pll N but no error */ else if a_option (i) = "-terminal_type" | a_option (i) = "-ttp" then terminal_type = get_option_arg (i); else if a_option (i) = "-delay" then do; delay = cv_dec_check_ ((get_option_arg (i)), code); if code ^= 0 | delay < 0 then do; code = error_table_$bad_conversion; call abort_attach ("Invalid delay value", (a_option (i))); end; end; else do; code = error_table_$badopt; call abort_attach ("Invalid attach description option", (a_option (i))); end; end; if comm ^= "rci" then do; code = error_table_$badopt; /* indicate bad, but not which one???? */ call abort_attach ("Invalid or missing -comm option", (comm)); end; if tty = "" then do; code = error_table_$badopt; call abort_attach ("No ""-tty"" option given", ""); end; do i = 1 to hbound (devices, 1) while (device ^= devices (i)); end; if i > hbound (devices, 1) then do; code = error_table_$badopt; call abort_attach ("Invalid device specified", (device)); end; else device_type = i; do temp_ptr = first_device_data_p repeat (temp_ptr -> g115_device_data.fwd_ptr) while (temp_ptr ^= null & device_data_p = null); if temp_ptr -> g115_device_data.tty_name = tty then /* channel already defined ? */ device_data_p = temp_ptr; /* then grab the ptr and exit loop */ end; if device_data_p = null then do; /* first init for this device */ call ipc_$create_ev_chn (dial_wait_list.dial_mgr_ev_chan, code); if code ^= 0 then call abort_attach ("Unable to create dial event channel", ""); dma.version = 1; /* Setup dial manager request structure */ dma.dial_mgr_ev_chan = dial_wait_list.dial_mgr_ev_chan; dma.device_name = tty; /* say which tty channel we want */ if dma.dial_qual = "" /* normal attach or auto_call (dial_out) */ 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", (tty)); dial_wait: call ipc_$block (addr (dial_wait_list), addr (event_info), code); /* wait for Answering Service to give us the device */ if code ^= 0 then do; call convert_ipc_code_ (code); call abort_attach ("From ipc_$block waiting for ^a attachment.", (tty)); end; /* Call convert_dial_message_ so it can update it's table of attached channels */ 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", (tty)); if ^dial_msg_flags.dialed_up then do; /* OOPS - we got a wakeup for some other event - PUNT */ call com_err_ (0, "g115_", "Dial message received: ^[HANGUP^;CONTROL^] on channel: ^a", dial_msg_flags.hung_up, dial_msg_chan); go to dial_wait; /* wait for our channel */ end; maybe_mine_already: call create_device_data (device_data_p); /* allocate structure and link it */ call init_g115_device_data (device_data_p, code); /* then initialize it for this tty device */ if code ^= 0 then call abort_attach ("Unable to initialize device data", ""); g115_device_data.tty_name = tty; /* save name for future attaches */ g115_device_data.dial_mgr_ev_chan = dial_wait_list.dial_mgr_ev_chan; g115_device_data.delay = delay; /* use the value from attach options */ /* set up IPC wait list to use for input/output blocking: two channels, tty and timeout */ call ipc_$create_ev_chn (g115_device_data.tty_ev_channel, code); /* create ring 0 tty event channel */ if code ^= 0 then call abort_attach ("Unable to create tty event channel", "");; call ipc_$create_ev_chn (g115_device_data.timeout_ev_channel, code); if code ^= 0 then call abort_attach ("Unable to create timeout event channel", "");; g115_device_data.nchan = 2; call hcs_$tty_attach (tty, g115_device_data.tty_ev_channel, g115_device_data.devx, state, code); if state ^= 5 then code = error_table_$io_no_permission; if code ^= 0 then call abort_attach ("Unable to attach communications channel.", ""); modes.str = "rawo,rawi,^hndlquit"; modes.len = length (modes.str); /* set the max size for return info */ call hcs_$tty_order (g115_device_data.devx, "modes", addr (modes), state, code); if state ^= 5 then code = error_table_$io_no_permission; if code ^= 0 then call abort_attach ("Unable to set initial modes", ""); max_length = G115.max_msg_len + 10; /* tell ring 0 the largest msg we will see */ call hcs_$tty_order (g115_device_data.devx, "set_input_message_size", addr (max_length), state, code); if state ^= 5 then code = error_table_$io_no_permission; if code ^= 0 then call abort_attach ("Unable to set input message size", ""); end; allocate g115_attach_data in (attach_area) set (adp); /* get a place for the attach data structure */ unspec (g115_attach_data) = "0"b; /* initialize the attach data structure */ g115_attach_data.device_type = device_type; /* record the device type code (fixed bin) */ g115_attach_data.device = device; /* set device name in here (char) */ g115_attach_data.attach_description = attach_description; g115_attach_data.device_ptr = device_data_p; /* point it back to the device block */ /* define the media code for this attachment */ if device_type = teleprinter then g115_attach_data.media_code = G115.teleprinter_mc; else if device_type = printer then g115_attach_data.media_code = G115.printer_mc; else if device_type = punch then g115_attach_data.media_code = G115.punch_bcd_mc; /* default data type */ else g115_attach_data.media_code = ""; /* others are input devices */ /* set default ttt data */ g115_attach_data.terminal_type = terminal_type; g115_attach_data.kill_char = "@"; g115_attach_data.erase_char = "#"; g115_attach_data.ttt_bits = "1"b; g115_attach_data.ttt_ptrs = null; if g115_attach_data.device_type = reader then g115_attach_data.canonicalize_input = "0"b; if g115_attach_data.terminal_type ^= "" then do; call get_ttt_info_ (addr (g115_attach_data.ttt_info), code); if code ^= 0 then call abort_attach ("Unknown terminal type specified", ""); end; mask = "0"b; on any_other call any_other_handler; call hcs_$set_ips_mask ("0"b, mask); iocbp -> iocb.attach_descrip_ptr = addr (g115_attach_data.attach_description); iocbp -> iocb.attach_data_ptr = adp; iocbp -> iocb.open = g115_open; iocbp -> iocb.detach_iocb = g115_detach; iocbp -> iocb.control = iox_$err_no_operation; iocbp -> iocb.position = iox_$err_no_operation; iocbp -> iocb.modes = iox_$err_no_operation; iocbp -> iocb.put_chars = iox_$err_no_operation; iocbp -> iocb.get_chars = iox_$err_no_operation; iocbp -> iocb.get_line = iox_$err_no_operation; iocbp -> iocb.read_record = iox_$err_no_operation; iocbp -> iocb.write_record = iox_$err_no_operation; g115_device_data.attach_count = g115_device_data.attach_count + 1; /* count up attaches */ call iox_$propagate (iocbp); revert cleanup; call hcs_$reset_ips_mask (mask, mask); revert any_other; code = 0; attach_return: a_code = code; /* pass back any error codes */ return; g115_open: entry (a_iocbp, a_open_mode, a_comerr_sw, a_code); a_code, code = 0; /* be sure to initialize */ iocbp = a_iocbp -> iocb.actual_iocb_ptr; adp = iocbp -> iocb.attach_data_ptr; device_data_p = g115_attach_data.device_ptr; if adp = null | device_data_p = null then do; a_code = error_table_$not_attached; return; end; if g115_device_data.hangup_signalled then do; /* Illegal if we sent a hangup to the device */ a_code = error_table_$io_no_permission; return; end; open_mode = a_open_mode; if ^((open_mode = Stream_input) | (open_mode = Stream_output) | (open_mode = Stream_input_output)) then do; a_code = error_table_$bad_mode; return; end; g115_attach_data.open_description = rtrim (iox_modes (open_mode)); mask = "0"b; on any_other call any_other_handler; call hcs_$set_ips_mask ("0"b, mask); if ((open_mode = Stream_input) | (open_mode = Stream_input_output)) then do; iocbp -> iocb.get_chars = g115_get_chars; iocbp -> iocb.get_line = g115_get_chars; end; if ((open_mode = Stream_output) | (open_mode = Stream_input_output)) then do; iocbp -> iocb.put_chars = g115_put_chars; end; iocbp -> iocb.read_record = iox_$err_no_operation; iocbp -> iocb.write_record = iox_$err_no_operation; iocbp -> iocb.control = g115_control; iocbp -> iocb.modes = g115_modes; iocbp -> iocb.close = g115_close; iocbp -> iocb.open_descrip_ptr = addr (g115_attach_data.open_description); call iox_$propagate (iocbp); call hcs_$reset_ips_mask (mask, mask); revert any_other; return; g115_close: entry (a_iocbp, a_code); a_code, code = 0; /* be sure to initialize */ iocbp = a_iocbp -> iocb.actual_iocb_ptr; adp = iocbp -> iocb.attach_data_ptr; device_data_p = g115_attach_data.device_ptr; if adp = null | device_data_p = null then do; a_code = error_table_$not_attached; return; end; if iocbp -> iocb.open_descrip_ptr = null then do; a_code = error_table_$not_open; return; end; mask = "0"b; on any_other call any_other_handler; call hcs_$set_ips_mask ("0"b, mask); iocbp -> iocb.open_descrip_ptr = null; iocbp -> iocb.open = g115_open; iocbp -> iocb.detach_iocb = g115_detach; iocbp -> iocb.control = iox_$err_no_operation; iocbp -> iocb.position = iox_$err_no_operation; iocbp -> iocb.modes = iox_$err_no_operation; iocbp -> iocb.put_chars = iox_$err_no_operation; iocbp -> iocb.get_chars = iox_$err_no_operation; iocbp -> iocb.get_line = iox_$err_no_operation; iocbp -> iocb.read_record = iox_$err_no_operation; iocbp -> iocb.write_record = iox_$err_no_operation; call iox_$propagate (iocbp); call hcs_$reset_ips_mask (mask, mask); return; g115_get_chars: entry (a_iocbp, a_bufp, a_nelem, a_nelemt, a_code); /* This is an entry to get the next record from an input message block. The data is written into a_bufp -> buffer without any G115 media codes or record separators. The calling procedure must add on a trailing NL char if desired. */ a_code, code = 0; /* be sure to initialize */ iocbp = a_iocbp -> iocb.actual_iocb_ptr; adp = iocbp -> iocb.attach_data_ptr; device_data_p = g115_attach_data.device_ptr; if adp = null | device_data_p = null then do; a_code = error_table_$not_attached; return; end; if g115_device_data.hangup_signalled then do; /* Illegal if we sent a hangup to the device */ a_code = error_table_$io_no_permission; return; end; if g115_attach_data.device_type = printer | /* not a readable device */ g115_attach_data.device_type = punch then do; a_code = error_table_$invalid_read; return; end; call g115_protocol_$read (adp, device_data_p, a_bufp, a_nelem, a_nelemt, a_code); /* pass on read */ return; g115_put_chars: entry (a_iocbp, a_bufp, a_nelem, a_code); /* This is an entry to write a record which may be a partial or complete G115 message block. The record format is a string of ASCII characters without any media code or record separator characters. If the attachment is for the printer device, the last character of the input record is a slew control character. */ a_code, code = 0; /* be sure to initialize */ iocbp = a_iocbp -> iocb.actual_iocb_ptr; adp = iocbp -> iocb.attach_data_ptr; device_data_p = g115_attach_data.device_ptr; if adp = null | device_data_p = null then do; a_code = error_table_$not_attached; return; end; if g115_device_data.hangup_signalled then do; /* Illegal if we sent a hangup to the device */ a_code = error_table_$io_no_permission; return; end; if g115_attach_data.device_type = reader then do; a_code = error_table_$invalid_write; return; end; call g115_protocol_$write (adp, device_data_p, a_bufp, a_nelem, a_code); return; g115_modes: entry (a_iocbp, a_new_mode, a_old_mode, a_code); a_code, code = 0; /* be sure to initialize */ iocbp = a_iocbp -> iocb.actual_iocb_ptr; adp = iocbp -> iocb.attach_data_ptr; device_data_p = g115_attach_data.device_ptr; if adp = null | device_data_p = null then do; a_code = error_table_$not_attached; return; end; if g115_device_data.hangup_signalled then do; /* Illegal if we sent a hangup to the device */ a_code = error_table_$io_no_permission; return; end; a_old_mode = ""; /* initialize return string */ if a_new_mode = "non_edited" then g115_attach_data.edited = "0"b; else if a_new_mode = "default" then g115_attach_data.edited = "1"b; else do; modes.str = a_new_mode; modes.len = length (modes.str); /* set the max size for return info */ M_1: call hcs_$tty_order (g115_device_data.devx, "modes", addr (modes), state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to M_1; a_old_mode = modes.str; /* copy back the old value */ end; a_code = code; return; g115_control: entry (a_iocbp, a_order, a_infop, a_code); a_code, code = 0; /* be sure to initialize */ iocbp = a_iocbp -> iocb.actual_iocb_ptr; adp = iocbp -> iocb.attach_data_ptr; device_data_p = g115_attach_data.device_ptr; if adp = null | device_data_p = null then do; a_code = error_table_$not_attached; return; end; if g115_device_data.hangup_signalled then do; /* Illegal if we sent a hangup to the device */ a_code = error_table_$io_no_permission; return; end; order = a_order; /* get the order name */ infop = a_infop; /* and the data pointer */ if order = "io_call" then do; /* check this first so we can redefine the order */ if infop = null then do; bad_call: a_code = error_table_$no_operation; /* say we didn't do it */ return; end; order = infop -> io_call_info.order_name; /* get the new order name */ infop = null; /* make this cheap, only a few orders accepted */ end; if order = "hangup" then do; dma.version = 1; /* make structure for call to dial_manager_ */ dma.dial_mgr_ev_chan = g115_device_data.dial_mgr_ev_chan; dma.device_name = g115_device_data.tty_name; dma.dial_qual = ""; call ipc_$decl_ev_wait_chn (g115_device_data.dial_mgr_ev_chan, code); /* in case a hangup_proc order was given */ call dial_manager_$release_channel (addr (dma), code); if code ^= 0 then call hcs_$tty_order (g115_device_data.devx, order, infop, state, (0)); /* pass it on */ g115_device_data.hangup_signalled = "1"b; /* this will end all but close and detach */ code = 0; /* say it was good, since they MUST close and detach */ end; else if order = "select_device" then do; /* order to set device type for next write */ if infop = null then go to bad_call; /* this order requires this pointer */ if info_string = "teleprinter" then do; g115_attach_data.media_code = G115.teleprinter_mc; end; else if info_string = "punch" then do; /* g115_attach_data.media_code = G115.punch_bcd_mc; */ end; else if info_string = "printer" then do; g115_attach_data.media_code = G115.printer_mc; end; else if info_string = "reader" then do; g115_attach_data.media_code = G115.bcd_input_mc; /* character only */ end; else do; /* not a legal value, tell the caller */ code = error_table_$action_not_performed; end; end; else if order = "runout" then do; msgp = g115_device_data.outp (g115_device_data.level + 1); /* buffer we would write into */ if msgp = null then return; /* in case it was not allocated yet */ if g115_message.text_char_count = 0 then return; /* make it fast if nothing to runout */ if ^g115_message.being_changed then /* only write consistent messages */ call g115_io_$write (device_data_p, msgp, code); g115_message.text_char_count = 0; /* mark this as written */ g115_message.fmt_code = ""b; g115_message.being_changed = "0"b; call timer_manager_$sleep ((g115_device_data.delay), "10"b); end; else if order = "hangup_proc" then do; if infop = null then go to bad_call; /* this order requires this pointer */ call ipc_$decl_ev_call_chn (g115_device_data.dial_mgr_ev_chan, hangup_proc.entry_var, hangup_proc.data_ptr, hangup_proc.prior, code); if code ^= 0 then call convert_ipc_code_ (code); end; else if order = "reset" then do; if g115_attach_data.device_type = punch then g115_attach_data.media_code = G115.punch_bcd_mc; end; else if order = "binary_punch" then do; if g115_attach_data.device_type ^= punch then go to bad_call; g115_attach_data.media_code = G115.punch_bin_mc; /* all future records will be binary coded */ end; else if order = "read_status" then do; /* order to get read status */ if infop = null then go to bad_call; /* this order requires this pointer */ info_structure.ev_chan = g115_device_data.tty_ev_channel; /* return ev chn on which read will return */ info_structure.input_available = "0"b; /* none yet */ msgp = g115_device_data.first_bp; /* set auto reference ptr */ follow_chain: if g115_message.rec_count > 0 then do; /* input is ready */ info_structure.input_available = "1"b; /* go to it daemons */ return; end; if g115_message.next_bp ^= null then do; /* if a chain exists, check it out */ msgp = g115_message.next_bp; go to follow_chain; end; call g115_io_$read_status (device_data_p, infop, code); /* check for any ring-0 data */ end; else if order = "end_write_mode" then do; call iox_$control (iocbp, "runout", null, code); if code ^= 0 then return; line_status.value = fnp_output_pending; do while (line_status.value = fnp_output_pending); C_1: line_status.value = test_for_fnp_output; call hcs_$tty_order (g115_device_data.devx, "line_control", addr (line_status), state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to C_1; call timer_manager_$sleep (1, "11"b); /* give fnp a chance to digest line_control */ call hcs_$tty_order (g115_device_data.devx, "line_status", addr (line_status), state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to C_1; if line_status.value = fnp_output_pending then call timer_manager_$sleep (10, "11"b); end; end; else if order = "resetread" then do; msgp = g115_device_data.first_bp; bufp = g115_message.next_bp; /* find next input buffer in chain */ unspec (g115_message) = "0"b; /* clear out everything */ g115_message.next_bp = null; /* mark as chain end */ g115_device_data.last_bp = msgp; /* " " */ do while (bufp ^= null); msgp = bufp; bufp = g115_message.next_bp; /* walk the chain */ free msgp -> g115_message in (buffer_area); /* Poof, it's gone */ end; C_2: call hcs_$tty_abort (g115_device_data.devx, 1, state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to C_2; end; else if order = "resetwrite" then do; msgp = g115_device_data.outp (g115_device_data.level); g115_message.text_char_count = 0; g115_message.fmt_code = "0"b; C_3: call hcs_$tty_abort (g115_device_data.devx, 2, state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to C_3; end; else if order = "set_remote_mode" then do; /* order to tell control tables to act as L6 */ C_4: line_status.value = set_g115_remote_mode; /* set the proper value */ call hcs_$tty_order (g115_device_data.devx, "line_control", addr (line_status), state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to C_4; end; else if order = "reset_remote_mode" then do; /* order to tell control tables to act as host */ C_5: line_status.value = reset_g115_remote_mode; call hcs_$tty_order (g115_device_data.devx, "line_control", addr (line_status), state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to C_5; end; else do; C_6: call hcs_$tty_order (g115_device_data.devx, order, infop, state, code); /* pass it on */ if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to C_6; end; a_code = code; return; g115_detach: entry (a_iocbp, a_code); /* entry to detach device */ a_code, code = 0; /* be sure to initialize */ iocbp = a_iocbp -> iocb.actual_iocb_ptr; adp = iocbp -> iocb.attach_data_ptr; device_data_p = g115_attach_data.device_ptr; if adp = null | device_data_p = null then do; a_code = error_table_$not_attached; return; end; if iocbp -> iocb.open_descrip_ptr ^= null then do; a_code = error_table_$not_closed; return; end; mask = "0"b; on any_other call any_other_handler; call hcs_$set_ips_mask ("0"b, mask); iocbp -> iocb.attach_descrip_ptr = null; call iox_$propagate (iocbp); g115_device_data.attach_count = g115_device_data.attach_count - 1; /* count down for detach */ call cleanup_and_detach (a_code); call hcs_$reset_ips_mask (mask, mask); return; as_init: entry (a_devx, a_ddp, a_adp, a_code); if attach_areap = null then do; call get_temp_segment_ ("g115_attach", attach_areap, a_code); if a_code ^= 0 then return; attach_area = empty; end; call create_device_data (device_data_p); /* make a new block for AS */ call init_g115_device_data (device_data_p, a_code); if a_code ^= 0 then return; g115_device_data.tty_name = "as_tty"; /* make up a dummy name for now */ g115_device_data.devx = a_devx; g115_device_data.dial_mgr_ev_chan = 0; g115_device_data.tty_ev_channel = 0; g115_device_data.timeout_ev_channel = 0; g115_device_data.as_priv_no_block = "1"b; /* this is the answering service! */ allocate g115_attach_data in (attach_area) set (adp); g115_attach_data.media_code = G115.teleprinter_mc; /* answering service is only a teleprinter */ g115_attach_data.device = "teleprinter"; g115_attach_data.device_type = teleprinter; g115_attach_data.attach_description = "AS_direct_attach"; g115_attach_data.open_description = "stream_input_output"; g115_attach_data.device_ptr = device_data_p; g115_attach_data.terminal_type = ""; g115_attach_data.kill_char = "@"; g115_attach_data.erase_char = "#"; g115_attach_data.ttt_bits = "1"b; g115_attach_data.ttt_ptrs = null; a_ddp = device_data_p; a_adp = adp; return; as_detach: entry (a_devx, a_ddp, a_adp, a_code); adp = a_adp; device_data_p = a_ddp; free adp -> g115_attach_data in (attach_area); call release_temp_segment_ ("g115_io_buffer", g115_device_data.buffer_areap, a_code); call delete_device_data (device_data_p); /* remove from the chain */ return; flip_comerr_sw: entry; static_comerr_sw = ^static_comerr_sw; /* change the bit */ call ioa_ ("g115_: Static com_err_ switch is ^[on^;off^]", static_comerr_sw); return; cleanup_and_detach: proc (ec); dcl ec fixed bin (35); dcl ignore fixed bin (35); if adp ^= null then free adp -> g115_attach_data in (attach_area); if device_data_p ^= null then /* check on deleting the device data */ if g115_device_data.attach_count < 1 then do; /* no more streams attached, free block */ if ^g115_device_data.hangup_signalled then do; /* hang up the line if caller didn't */ dma.version = 1; /* make structure for call to dial_manager_ */ dma.dial_mgr_ev_chan = g115_device_data.dial_mgr_ev_chan; dma.device_name = g115_device_data.tty_name; dma.dial_qual = ""; call ipc_$decl_ev_wait_chn (g115_device_data.dial_mgr_ev_chan, ignore); /* in case a hangup_proc order was given */ call dial_manager_$release_channel (addr (dma), ignore); if code ^= 0 then call hcs_$tty_order (g115_device_data.devx, order, infop, state, ignore); /* pass it on */ end; do chn = g115_device_data.tty_ev_channel, g115_device_data.timeout_ev_channel, g115_device_data.dial_mgr_ev_chan; call ipc_$delete_ev_chn (chn, ignore); end; call hcs_$tty_detach (g115_device_data.devx, 0, state, ec); call release_temp_segment_ ("g115_io_buffer", g115_device_data.buffer_areap, ignore); call delete_device_data (device_data_p); /* remove from the chain */ end; end cleanup_and_detach; get_option_arg: proc (idx) returns (char (*) var); /* this proc is used to do multiple tests and assignments within a one line then clause of an if statement */ dcl idx fixed bin; idx = idx + 1; /* bump the current option index, to find the option arg */ if idx > hbound (a_option, 1) then do; /* still in range? */ code = error_table_$noarg; /* tell process it left out an arg */ call abort_attach ("No argument after ", (a_option (i - 1))); end; attach_description = attach_description || " " || a_option (idx); /* include the arg in attach description */ return (a_option (idx)); end get_option_arg; abort_attach: proc (control_string, arg_value); /* this proc handles attach errors */ dcl (control_string, arg_value) char (*) aligned; dcl saved_code fixed bin (35); if comerr_sw then call com_err_ (code, "g115_", control_string, arg_value); saved_code = code; /* keep a copy */ call cleanup_and_detach (code); if saved_code ^= 0 then code = saved_code; /* use former reason if any */ go to attach_return; /* non local transfer to finish off the abort */ end abort_attach; any_other_handler: proc; /* this is the any_other handler to protect us while masked against IPS signals */ if mask then call hcs_$reset_ips_mask (mask, mask); mask = ""b; call continue_to_signal_ (code); return; end any_other_handler; clean_up_handler: proc; /* this is the cleanup condition handler for errors during the attach entry */ call cleanup_and_detach (ignore); return; end clean_up_handler; init_g115_device_data: proc (ddp, ec); dcl ddp ptr; dcl ec fixed bin (35); dcl msgp ptr; dcl bp ptr; ddp -> g115_device_data.tty_name = ""; /* let the main proc define this */ ddp -> g115_device_data.fmt_code.control = G115.special_nc; ddp -> g115_device_data.fmt_code.data = G115.info_s_c; /* data will be compressed and split */ ddp -> g115_device_data.write_split, ddp -> g115_device_data.write_compress = "1"b; /* for easy test */ ddp -> g115_device_data.delay = 50000; /* default to 50 msec for AS */ ddp -> g115_device_data.level = 0; /* the write invocation level */ ddp -> g115_device_data.outp (*) = null; ddp -> g115_device_data.process_id = get_process_id_ (); /* record our process id for wakeups */ /* make an area for allocation of input/output buffers */ call get_temp_segment_ ("g115_io_buffer", ddp -> g115_device_data.buffer_areap, ec); if ec ^= 0 then return; bp = ddp -> g115_device_data.buffer_areap; /* get short pointer name */ bp -> buffer_area = empty; /* initialize the area */ allocate g115_message in (bp -> buffer_area) set (ddp -> g115_device_data.template_ptr); /* OUTPUT buffer */ msgp = ddp -> g115_device_data.template_ptr; /* for easy structure reference */ /* set up the template output buffer for speed later */ unspec (msgp -> g115_message) = "0"b; /* set everything to zero */ msgp -> g115_message.next_bp = null; /* output buffers are not chained */ msgp -> g115_message.soh = G115.soh_char; msgp -> g115_message.addr_code = G115.addr_code_char; msgp -> g115_message.op_code.use = "1"b; msgp -> g115_message.id_code = G115.id_code_char; msgp -> g115_message.stx = G115.stx_char; msgp -> g115_message.etx = G115.etx_char; allocate g115_message in (bp -> buffer_area) set (ddp -> g115_device_data.first_bp); /* INPUT buffer */ msgp, ddp -> g115_device_data.last_bp = ddp -> g115_device_data.first_bp; /* set the chain */ unspec (msgp -> g115_message) = "0"b; /* make it clean */ msgp -> g115_message.next_bp = null; return; end init_g115_device_data; create_device_data: proc (ddp); /* this proc allocates a copy of g115_device_data and threads it into the list */ dcl ddp ptr; allocate g115_device_data in (attach_area) set (ddp); unspec (ddp -> g115_device_data) = "0"b; /* set everything to zero */ ddp -> g115_device_data.back_ptr = last_device_data_p; /* point back to previous tail */ ddp -> g115_device_data.fwd_ptr = null; /* this is the new tail of the chain */ if last_device_data_p ^= null /* if tail already exists */ then last_device_data_p -> g115_device_data.fwd_ptr = ddp; /* link it to this block */ else first_device_data_p = ddp; /* otherwise start the chain */ last_device_data_p = ddp; /* record the new tail */ return; delete_device_data: entry (ddp); /* this entry removes a link in the chain and frees the data block */ if ddp -> g115_device_data.back_ptr = null then /* was this the head of the chain? */ first_device_data_p = ddp -> g115_device_data.fwd_ptr; /* make the next one the head */ else ddp -> g115_device_data.back_ptr -> g115_device_data.fwd_ptr = ddp -> g115_device_data.fwd_ptr; /* move our fwd ptr to previous block */ if ddp -> g115_device_data.fwd_ptr = null then /* was this the tail of the chain */ last_device_data_p = ddp -> g115_device_data.back_ptr; /* make previous the new tail */ else ddp -> g115_device_data.fwd_ptr -> g115_device_data.back_ptr = ddp -> g115_device_data.back_ptr; /* move our back ptr to next block */ free ddp -> g115_device_data in (attach_area); ddp = null; /* just to be sure */ return; end create_device_data; line_status_pending: proc (ec) returns (bit (1)); dcl ec fixed bin (35); /* this proc returns true if there was a line status code and we cleared the line, ready for a retry */ if ec = 0 then return ("0"b); /* avoid a loop for normal case */ do while (ec = error_table_$line_status_pending); call hcs_$tty_order (g115_device_data.devx, "line_status", addr (line_status), state, ec); if state ^= 5 then ec = error_table_$io_no_permission; end; if ec = 0 then return ("1"b); /* OK to retry */ return ("0"b); /* Do not retry */ end line_status_pending; end g115_;  g115_as_.pl1 02/06/80 1358.4rew 02/06/80 1131.0 95607 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ g115_as_: proc; /* g115_as_ - procedure to interface answering service when it needs to communicate VIA G115 protocol. The tty_index entry must be called first to establish a data structure for the device. The other entries rely on the presence of this data structure. */ /* coded 07/11/75 by Bob Adsit */ /* Modified by J. C. Whitmore, 9/79, during restructure of g115_ I/O module. */ dcl a_asw fixed bin parameter; dcl a_bufp ptr parameter; dcl a_code fixed bin (35); dcl a_device char (*) parameter; dcl a_devx fixed bin parameter; dcl a_dflag fixed bin parameter; dcl a_event fixed bin (71) parameter; dcl a_nelem fixed bin parameter; dcl a_nelemt fixed bin parameter; dcl a_new_mode char (*) parameter; dcl a_offset fixed bin parameter; dcl a_old_mode char (*) parameter; dcl a_order char (*) parameter; dcl a_orderp ptr parameter; dcl a_proc_id bit (36) aligned; dcl a_state fixed bin parameter; dcl io_buff char (322) aligned; dcl io_data char (322) var; dcl dd_idx fixed bin; dcl pos fixed bin; dcl state fixed bin; dcl idx fixed bin; dcl based_string char (322) based; dcl (addr, addrel, index, length, rtrim, substr, translate, null, hbound) builtin; dcl error_table_$namedup fixed bin (35) ext; dcl error_table_$noentry fixed bin (35) ext; dcl error_table_$notalloc fixed bin (35) ext; dcl error_table_$io_no_permission ext fixed bin (35); dcl NL char (1) int static options (constant) init (" "); dcl 1 dd aligned static, /* device data structure on active channels */ 2 last_used fixed bin init (0), /* last entry defined in the array */ 2 free_idx fixed bin init (-1), /* head of the free list of entries */ 2 entries (100), /* array of entries larger than ever needed */ 3 next_idx fixed bin init ((100) 0), /* next entry in the chain - (100) 0 = end */ 3 devx fixed bin init ((100) 0), /* the device index for Ring 0 */ 3 adp ptr init ((100) null), /* pointer to the attach data structure for devx */ 3 ddp ptr init ((100) null); /* pointer to the device data structure for devx */ dcl 1 modes aligned, 2 len fixed bin, 2 str char (256); dcl (lower_case init ("abcdefghijklmnopqrstuvwxyz"), upper_case init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ")) char (26) int static options (constant); 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 g115_$as_init entry (fixed bin, ptr, ptr, fixed bin (35)); dcl g115_$as_detach entry (fixed bin, ptr, ptr, fixed bin (35)); dcl g115_protocol_$read entry (ptr, ptr, ptr, fixed bin, fixed bin, fixed bin (35)); dcl g115_protocol_$write entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); dcl hcs_$tty_index entry (char (*), fixed bin, fixed bin, fixed bin (35)); dcl hcs_$tty_event entry (fixed bin, fixed bin (71), 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 hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35)); dcl hcs_$tty_detach_new_proc entry (fixed bin, bit (36) aligned, fixed bin, fixed bin (35)); %include g115_device_data; %include g115_attach_data; %include remote_ttt_info; as_index: entry (a_device, a_devx, a_state, a_code); /* This is the entry first called by answering service to set up the attachment through g115 */ call hcs_$tty_index (a_device, a_devx, a_state, a_code); /* get the device index of the channel */ if a_code ^= 0 then return; call make_dd_entry (a_devx, dd_idx, a_code); /* get a place to save attachment data ptrs */ if a_code ^= 0 then return; call g115_$as_init (a_devx, device_data_p, adp, a_code); if a_code ^= 0 then do; drop_entry: call delete_dd_entry (dd_idx); /* remove the entry we made */ if device_data_p ^= null then call g115_$as_detach (a_devx, device_data_p, adp, (0)); return; end; dd.ddp (dd_idx) = device_data_p; /* save these for the future */ dd.adp (dd_idx) = adp; g115_attach_data.device = a_device; /* record the device name given us */ call ipc_$create_ev_chn (g115_device_data.tty_ev_channel, a_code); /* create ev chan for ring 0 */ if a_code ^= 0 then go to drop_entry; call ipc_$create_ev_chn (g115_device_data.timeout_ev_channel, a_code); /* and one for timeout on blocking */ if a_code ^= 0 then go to drop_entry; return; as_event: entry (a_devx, a_event, a_state, a_code); /* This entry defines the event channel that AS will block on (listen to) */ call find_dd_entry (a_devx, dd_idx, a_code); /* get the structure ptr info */ if a_code ^= 0 then return; device_data_p = dd.ddp (dd_idx); /* get the pointer to g115_device_data */ g115_device_data.as_ev_chan = a_event; /* save the event channel for g115_io_ */ call hcs_$tty_event (a_devx, a_event, a_state, a_code); /* set the AS event channel in ring 0 */ return; as_detach: entry (a_devx, a_dflag, a_state, a_code); call find_dd_entry (a_devx, dd_idx, a_code); /* get the device data index */ if a_code ^= 0 then return; device_data_p = dd.ddp (dd_idx); /* copy the structure pointers */ adp = dd.adp (dd_idx); call ipc_$delete_ev_chn (g115_device_data.tty_ev_channel, a_code); /* don't check the code, just try */ call ipc_$delete_ev_chn (g115_device_data.timeout_ev_channel, a_code); call g115_$as_detach (a_devx, device_data_p, adp, a_code); a_state = 1; call delete_dd_entry (dd_idx); return; as_detach_new_proc: entry (a_devx, a_proc_id, a_state, a_code); call hcs_$tty_detach_new_proc (a_devx, a_proc_id, a_state, a_code); return; as_order: entry (a_devx, a_order, a_orderp, a_state, a_code); call hcs_$tty_order (a_devx, a_order, a_orderp, a_state, a_code); return; as_changemode: entry (a_devx, a_new_mode, a_old_mode, a_code); modes.len = length (modes.str); /* set the max size for return info */ modes.str = a_new_mode; call hcs_$tty_order (a_devx, "modes", addr (modes), state, a_code); if state ^= 5 then a_code = error_table_$io_no_permission; a_old_mode = modes.str; /* copy back the old modes from Ring 0 */ return; as_state: entry (a_devx, a_state, a_code); call hcs_$tty_state (a_devx, a_state, a_code); return; as_abort: entry (a_devx, a_asw, a_state, a_code); call hcs_$tty_abort (a_devx, a_asw, a_state, a_code); return; as_write: as_write_force: entry (a_devx, a_bufp, a_offset, a_nelem, a_nelemt, a_state, a_code); call find_dd_entry (a_devx, dd_idx, a_code); /* get the device data index */ if a_code ^= 0 then return; device_data_p = dd.ddp (dd_idx); /* define the structure pointers */ adp = dd.adp (dd_idx); io_buff = substr (addrel (a_bufp, a_offset) -> based_string, 1, a_nelem); /* be sure we fit into a message */ call g115_protocol_$write (adp, device_data_p, addr (io_buff), a_nelem, a_code); a_nelemt = a_nelem; return; as_read: entry (a_devx, a_bufp, a_offset, a_nelem, a_nelemt, a_state, a_code); call find_dd_entry (a_devx, dd_idx, a_code); if a_code ^= 0 then return; device_data_p = dd.ddp (dd_idx); /* define the structure pointers */ adp = dd.adp (dd_idx); call g115_protocol_$read (adp, device_data_p, addr (io_buff), length (io_buff), a_nelemt, a_code); if a_code ^= 0 | a_nelemt = 0 then return; /* none yet */ io_buff = substr (io_buff, 1, a_nelemt); /* remove any cruft */ io_data = ""; /* clear the output string */ pos = 1; /* go through io_buff starting with char 1 */ idx = index (io_buff, "\"); /* look for upper case escapes */ do while (idx > 0); /* loop processing all escapes */ io_data = io_data || translate (substr (io_buff, pos, idx - 1), lower_case, upper_case) || substr (io_buff, pos + idx, 1); /* omit the backslash and take following char as is */ pos = pos + idx + 1; idx = index (substr (io_buff, pos), "\"); /* look for next one */ end; io_data = io_data || translate (substr (io_buff, pos), lower_case, upper_case); /* add in the last part */ io_data = rtrim (io_data) || NL; /* and make it look like tty input */ if length (io_data) > a_nelem then a_nelemt = a_nelem; /* only give back up to limit */ else a_nelemt = length (io_data); substr (addrel (a_bufp, a_offset) -> based_string, 1, a_nelemt) = io_data; /* return the data */ return; make_dd_entry: proc (a_devx, dd_idx, ec); dcl a_devx fixed bin; dcl dd_idx fixed bin; dcl ec fixed bin (35); dcl idx fixed bin; dd_idx = 0; /* initialize output index */ do idx = 1 to dd.last_used while (dd_idx = 0); /* look for a duplicate entry */ if dd.next_idx (idx) = 0 then /* not in free list */ if dd.devx (idx) = a_devx then dd_idx = idx; /* found a match */ end; if dd_idx = 0 then do; /* must make an entry */ if dd.free_idx < 0 then do; /* no free entries, extend max used */ if dd.last_used = hbound (dd.entries, 1) then do; ec = error_table_$notalloc; return; end; dd_idx, dd.last_used = dd.last_used + 1; /* bump the count */ end; else do; /* take a free entry */ dd_idx = dd.free_idx; dd.free_idx = dd.next_idx (dd_idx); /* shorten chain by one link */ dd.next_idx (dd_idx) = 0; /* remove this from the chain */ end; dd.devx (dd_idx) = a_devx; /* assign the new device index */ end; else ec = error_table_$namedup; /* found a match! WHY? */ return; find_dd_entry: entry (a_devx, dd_idx, ec); dd_idx = 0; /* initialize output index */ do idx = 1 to dd.last_used while (dd_idx = 0); /* look for a duplicate entry */ if dd.next_idx (idx) = 0 then /* not in free list */ if dd.devx (idx) = a_devx then dd_idx = idx; /* found a match */ end; if dd_idx = 0 then ec = error_table_$noentry; return; delete_dd_entry: entry (dd_idx); dd.devx (dd_idx) = 0; /* make the entry invalid */ dd.ddp (dd_idx) = null; dd.adp (dd_idx) = null; dd.next_idx (dd_idx) = dd.free_idx; /* put at the head of the free chain */ dd.free_idx = dd_idx; return; end make_dd_entry; end g115_as_;  g115_conv_.alm 02/02/88 1719.3r w 02/02/88 1534.2 32886 " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** " G115_CONV_ - Conversion for G115 remote printer. " coded 12/12/74 by Noel I. Morris " Modified 6/23/75 by Noel I. Morris " Modified 04/10/77 by Bob Franklin to change top of inside page char " and dont slew on punch " Modified by D. Vinograd, 7/78, to separate the teleprinter, printer, and punch entries " Modified by J. C. Whitmore, 11/78, to make all top of page slews the same " Modified by J. C. Whitmore, 9/79, to move protocol features to g115_protocol_.pl1 " This module performs the necessary conversion for printing on the " G115 remote printer. " " The manner in which this procedure is utilized is described in detail " in the listing of prt_conv_. " " A media code character will be inserted at the beginning of each " output line. name g115_conv_ segdef teleprinter segdef printer segdef punch even temp char temp device_code 1 = printer, 0 = all others teleprinter: punch: tra g115_send_init tra g115_send_chars tra g115_send_slew_pattern tra g115_send_slew_count printer: tra g115_send_printer_init tra g115_send_chars tra g115_send_slew_pattern tra g115_send_slew_count " include prt_conv_info " g115_send_init: ldq 0,du set the all other device code stq device_code and save for later tra end_init g115_send_printer_init: ldq 1,du set the printer code stq device_code and save for later end_init: tra sb|0 return to caller " g115_send_chars: eaq 0,2 white space count in QU tmoz nospace skip if no white space " insert spaces as requested, compression is done at the next level mlr (),(pr,rl),fill(040) insert requisite number of blanks desc9a *,0 .. desc9a bb|0,qu .. a9bd bb|0,qu bump output pointer nospace: mlr (pr,rl),(pr,rl) copy characters into bb -> out_string desc9a bp|0,au .. desc9a bb|0,au .. a9bd bp|0,au step input and output pointers a9bd bb|0,au .. eax2 0 make sure X2 now zero tra pr7|0 return to caller " g115_send_slew_pattern: ldq device_code see if this is a printer tze return_to_caller if not, there is no slew ldq =1a ,du load the FF slew code set_slew: stq char save the slew code eax7 1 we will add one char to the output mlr (pr,rl),(pr,rl) copy into output desc9a char,x7 .. desc9a bb|0,x7 .. a9bd bb|0,7 .. return_to_caller: tra sb|0 return to caller " g115_send_slew_count: ldq device_code see if this is a printer tze no_slew if not, there is no slew eaq 0,al count in QU sbla 15,dl decrement A by 15, residue will come later tmoz *+2 can only take 15 lines at a time ldq 15,du if > 15, take 15 for now ldq skip,qu get correct skip character tra set_slew join common code no_slew: " just say we did it and return lda 0,dl clear the residue count tra sb|0 and return " GRTS codes for slew of N lines skip: aci "0" slew 0 lines aci "1" slew 1 line aci "2" slew 2 lines aci "3" slew 3 lines aci "4" slew 4 lines aci "5" slew 5 lines aci "6" slew 6 lines aci "7" slew 7 lines aci "8" slew 8 lines aci "9" slew 9 lines aci "[" slew 10 lines aci "#" slew 11 lines aci "@" slew 12 lines aci ":" slew 13 lines aci ">" slew 14 lines aci "?" slew 15 lines end  g115_io_.pl1 02/06/80 1358.4rew 02/06/80 1131.0 132318 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ g115_io_$write: proc (a_ddp, a_msgp, a_code); /* this procedure handles the actual read and writing of the data to the L6-RBF via hcs_$tty calls. */ /* Coded 4/30/74 by Mike Grady */ /* Modified 06/10/75 by Bob Adsit to move line_status to MCS/355 */ /* Modified 04/10/77 by Bob Franklin to fix many bugs. Now multiple blocks must be unpacked on input in g115_message, special control records must be ignored, etc. Ignore Quit error on Writes. */ /* Modified to handle multiple buffers, line control orders and fit into the iox_ based total g115 package June 1978 by D. Vinograd */ /* Modified by J. Nicholls 7/78 to count records instead of characters */ /* Modified by J. Nicholls Sept 78 to buffer input in ring 4, since the fnp dia channel may become clogged if the input sets in ring 0. Thus if output is pending and input is available, we will read a record and buffer it, and keep trying until output is not pending and input is completed. If no more input, we'll go blocked; if no output pending, task is accomplished and we'll continue. */ /* Modified by J. C. Whitmore, 9/79, renamed g115_message_ to g115_io_ and restructured completely */ dcl a_ddp ptr parameter; dcl a_msgp ptr parameter; dcl a_infop ptr parameter; dcl a_code fixed bin (35) parameter; dcl msg_block_ptr ptr; dcl nelemt fixed bin; dcl nelem fixed bin; dcl offset fixed bin; dcl idx fixed bin; dcl state fixed bin; dcl code fixed bin (35); dcl ec fixed bin (35); dcl send_wakeup bit (1) init ("0"b); /* set if we should send a wakeup to previous (if any) invocation */ dcl read_status_entry bit (1); dcl quit_code fixed bin (35) int static init (3000005) options (constant); /* quit occurred */ dcl 1 line_status aligned, (2 value, 2 mbz1, 2 mbz2, 2 mbz3) fixed bin unal; dcl 1 info aligned based, 2 pad fixed bin (71), 2 input_available bit (1); dcl 1 io_status aligned, 2 pad fixed bin (71), 2 io_pending bit (1); dcl 1 event_info aligned, /* wakeup information */ 2 channel_id fixed bin (71) aligned, /* channel over which to send wakeup */ 2 message char (8) aligned, /* event message */ 2 sender bit (36) aligned, /* process id of sending process */ 2 origin, 3 dev_signal bit (18) unaligned, /* ON if event occurred as result of i/o interrupt */ 3 ring bit (18) unaligned, /* sender's validation level */ 2 wait_list_index fixed bin aligned; dcl convert_ipc_code_ entry (fixed bin (35)); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl hcs_$tty_write entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl hphcs_$tty_write_force entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl hcs_$tty_get_line entry (fixed bin, ptr, fixed bin, fixed bin, fixed bin, bit (1), fixed bin, fixed bin (35)); dcl hcs_$tty_order entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35)); dcl hcs_$tty_event entry (fixed bin, fixed bin (71), fixed bin, fixed bin (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl ipc_$mask_ev_calls entry (fixed bin (35)); dcl ipc_$unmask_ev_calls entry (fixed bin (35)); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl error_table_$net_timeout ext fixed bin (35); dcl error_table_$line_status_pending ext fixed bin (35); dcl error_table_$io_no_permission ext fixed bin (35); dcl error_table_$improper_data_format ext fixed bin (35); dcl (addr, null, unspec) builtin; %include g115_device_data; %include g115_message; %include G115; /* g115_io_$write: proc (a_ddp, a_msgp, a_code); */ /* This procedure writes messages to the L6-RBF and will read input if output is still pending. */ read_status_entry = "0"b; /* this is not the read_status entry */ a_code, code = 0; /* set error code to 0 */ msgp = a_msgp; device_data_p = a_ddp; if g115_message.text_char_count = 0 | g115_message.being_changed then do; a_code = error_table_$improper_data_format; return; end; nelem = g115_message.text_char_count + 8; /* add in header-trailer to get actual length of message */ msg_block_ptr = addr (msgp -> g115_msg_block); /* get addr for tty_write */ offset = 0; if g115_device_data.as_priv_no_block then go to ANS_SERVICE; /* special section for answering service */ check_write_completion: call check_write_status (code); /* set the io_status structure */ if code ^= 0 then go to RETURN; do while (io_status.io_pending); /* if output is still in Ring 0, check for input */ call hcs_$tty_order (g115_device_data.devx, "read_status", addr (io_status), state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to check_write_completion; if code ^= 0 then go to RETURN; if io_status.io_pending then do; /* if we have input, get it out of Ring 0 */ allocate g115_message in (buffer_area) set (msgp); unspec (g115_message) = "0"b; /* be sure it is clear */ g115_message.next_bp = null; g115_device_data.last_bp -> g115_message.next_bp = msgp; /* add to chain */ g115_device_data.last_bp = msgp; send_wakeup = "1"b; /* tell reader about input */ call read_message (msgp, code); /* read one message and verify it */ if code ^= 0 then go to RETURN; end; else do; /* output pending and no input, so just wait */ call block (code); if code ^= 0 then go to RETURN;; end; call check_write_status (code); /* check for output pending and loop back */ if code ^= 0 then go to RETURN; end; try_write: nelemt, state = 0; call hcs_$tty_write (g115_device_data.devx, msg_block_ptr, offset, nelem, nelemt, state, code); if state ^= 5 then code = error_table_$io_no_permission; if code = quit_code then go to try_write; /* ignore quit error its been reset */ if line_status_pending (code) then go to try_write; if code ^= 0 then go to RETURN; if nelem = nelemt then go to RETURN; /* all data was accepted by ring 0 */ nelem = nelem - nelemt; /* only a portion was sent, try to send remainder */ offset = offset + nelemt; go to check_write_completion; /* ===== SPECIAL SECTION FOR THE ANSWERING SERVICE ===== */ ANS_SERVICE: /* We cannot allow the answering service to block on output indefinitely. So we use a timeout of 3 seconds if there is already output pending. The event channel we block on must be different from the normal answering service channel so we change it each time. */ call hcs_$tty_event (g115_device_data.devx, g115_device_data.tty_ev_channel, state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to ANS_SERVICE; /* try all over */ if code ^= 0 then go to RETURN; call check_write_status (code); /* Check for output pending */ if code ^= 0 then go to ANS_RETURN; /* really screwed up, will have to be dropped */ do while (io_status.io_pending); /* if told to wait */ call ipc_$mask_ev_calls (ec); /* stop answering service for a second */ call ipc_$drain_chn (g115_device_data.timeout_ev_channel, ec); /* be sure it is clear */ call timer_manager_$alarm_wakeup (3, "11"b, g115_device_data.timeout_ev_channel); /* 3 seconds max */ call block (code); /* wait for completion or timeout */ call ipc_$unmask_ev_calls (ec); /* ALWAYS reset the event call mask */ if code ^= 0 then go to ANS_RETURN; /* check code from block, timeout is fatal */ call timer_manager_$reset_alarm_wakeup (g115_device_data.timeout_ev_channel); /* made it */ call check_write_status (code); if code ^= 0 then go to ANS_RETURN; end; call hphcs_$tty_write_force (g115_device_data.devx, msg_block_ptr, offset, nelem, nelemt, state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to ANS_SERVICE; /* start all over */ ANS_RETURN: /* ALWAYS attempt to return the normal event channel to Ring 0 - error or not */ call hcs_$tty_event (g115_device_data.devx, g115_device_data.as_ev_chan, state, ec); if code = 0 then code = ec; /* give other errors priority */ go to RETURN; /* common return code (See read entry) */ check_write_status: proc (code); dcl code fixed bin (35); call ipc_$drain_chn (g115_device_data.tty_ev_channel, code); /* clear wakeups? */ retry_ws: call hcs_$tty_order (g115_device_data.devx, "write_status", addr (io_status), state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to retry_ws; return; end check_write_status; line_status_pending: proc (code) returns (bit (1)); /* this procedure simply clears any pending line status and throws it away */ dcl code fixed bin (35); if code = 0 then return ("0"b); /* avoid a loop for normal case */ do while (code = error_table_$line_status_pending); call hcs_$tty_order (g115_device_data.devx, "line_status", addr (line_status), state, code); if state ^= 5 then code = error_table_$io_no_permission; end; if code = 0 then return ("1"b); /* OK to retry the operation */ return ("0"b); /* do not attempt a retry */ end line_status_pending; block: proc (code); /* this procedure blocks on the pre-defined wait list for the device and waits for a wakeup from ring 0 */ dcl code fixed bin (35); event_info.wait_list_index = 0; /* initialize test value */ call ipc_$block (addr (g115_device_data.wait_list), addr (event_info), code); if event_info.wait_list_index = 2 then code = error_table_$net_timeout; else if code ^= 0 then call convert_ipc_code_ (code); send_wakeup = "1"b; /* we may have stolen a wakeup, so give it back */ return; end block; read: entry (a_ddp, a_msgp, a_code); /* This entry reads a message from ring 0 and puts it into the message buffer defined by a_msgp */ device_data_p = a_ddp; /* define the g115_device_data for this invocation */ msgp = a_msgp; read_status_entry = "0"b; /* this is not the read_status entry */ go to READ_COMMON; read_status: entry (a_ddp, a_infop, a_code); /* This entry tries to read a message from ring zero (if available) and saves it in the last input buffer of the chain. It sets the input_available flag in the structure a_infop -> info if there is a valid record count in the message read. */ device_data_p = a_ddp; /* define the g115_device_data for this invocation */ msgp = g115_device_data.last_bp; /* get ptr to tail buffer of chain */ if g115_message.rec_count > 0 then do; /* something there? */ a_infop -> info.input_available = "1"b; /* tell caller */ a_code = 0; return; end; read_status_entry = "1"b; /* this is the read_status entry */ READ_COMMON: a_code, code = 0; call read_message (msgp, code); if code ^= 0 then go to RETURN; if read_status_entry then /* see if the message was good */ if g115_message.rec_count > 0 then a_infop -> info.input_available = "1"b; /* OK to read */ RETURN: /* this is the common exit point for this external procedure */ a_code = code; /* copy back any status */ /* If we went blocked, we may have taken a wakeup from a read_status then block sequence. */ /* So we will send back a wakeup unconditionally if we went blocked at all, just in case. */ if send_wakeup then call hcs_$wakeup (g115_device_data.process_id, g115_device_data.tty_ev_channel, 0, code); return; read_message: proc (msgp, code); dcl msgp ptr; dcl code fixed bin (35); dcl msg_len fixed bin; dcl offset fixed bin; dcl read_ptr ptr; dcl max_len fixed bin; dcl etx_found bit (1); msgp -> g115_message.last_char_read = 0; /* reset state variables */ msgp -> g115_message.text_char_count = 0; msgp -> g115_message.rec_count = 0; offset = 0; /* hardcore read offset */ max_len = G115.max_msg_len + 8; /* SOH -> STX = 7, ETX = 1, total = 8 chars */ read_ptr = addr (msgp -> g115_message.g115_msg_block); /* where ring 0 should put the message */ try_read: etx_found = "0"b; msg_len, state = 0; call hcs_$tty_get_line (g115_device_data.devx, read_ptr, offset, max_len - offset, msg_len, etx_found, state, code); if state ^= 5 then code = error_table_$io_no_permission; if line_status_pending (code) then go to try_read; if code ^= 0 then return; if msg_len < 1 then do; /* no meat to the message */ if g115_message.text_char_count = 0 then /* on partial read wait for complete msg */ if read_status_entry | g115_device_data.as_priv_no_block then return; /* for these cases, don't wait for a message */ call block (code); /* wait for the message (or remainder) to arrive */ if code ^= 0 then return; go to try_read; /* should get it this time */ end; if msgp -> g115_message.text_char_count = 0 then /* allow for message header? (SOH -> STX = 7 chars) */ msgp -> g115_message.text_char_count = msg_len - 7; else msgp -> g115_message.text_char_count = msgp -> g115_message.text_char_count + msg_len; if etx_found then /* when complete, take the ETX char out of the count */ msgp -> g115_message.text_char_count = msgp -> g115_message.text_char_count - 1; else do; offset = msgp -> g115_message.text_char_count + 7; /* next read follows last char read */ go to try_read; end; /* count the records in the message */ do idx = 1 to g115_message.text_char_count; if g115_message.text (idx) = G115.RS then /* look for record separators (RS) */ g115_message.rec_count = g115_message.rec_count + 1; /* add up full records */ end; if g115_message.text (g115_message.text_char_count) ^= G115.RS then /* if last char is not RS, record is split */ g115_message.rec_count = g115_message.rec_count + 1; /* add partial record to count */ return; end read_message; end g115_io_$write;  g115_protocol_.pl1 02/14/80 1738.9rew 02/14/80 1738.1 186624 /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ g115_protocol_$write: proc (a_adp, a_ddp, a_bufp, a_nelem, a_code); /* This procedure performs all the message blocking and formatting required by the G115 Remote Computer Interface protocol. Input and output are in the form of records, where one record may be a partial message, a full message or must be split across messages. On output, records are packed into messages. The message is sent when it becomes full or when the format code of the message must be changed. Each record of a message begins with a media code which defines the target device (e.g. printer, bcd punch, binary punch, teleprinter) On input, only character data is allowed. This may be for the teleprinter (operator commands) or for the card_input facility, but we can't tell which one (a deficiency in the protocol). */ /* Adapted from the original program g115_io_ by J. C. Whitmore, 9/79 */ dcl a_adp ptr parameter; dcl a_ddp ptr parameter; dcl a_bufp ptr parameter; dcl a_nelem fixed bin parameter; dcl a_nelemt fixed bin parameter; dcl a_code parameter; dcl bufp ptr; dcl nelem fixed bin; dcl code fixed bin (35); dcl binary_record bit (960) aligned; /* one binary card image */ dcl level fixed bin; /* automatic version of our invocation level */ dcl format_code bit (9); dcl slew_char char (1); dcl io_data char (646) var; /* data part of an input or output record */ dcl io_record char (648) var; /* the full record with media code and record separator */ dcl idx fixed bin; /* index variable */ dcl CC_index fixed bin; /* where the next compression char sits */ dcl temp_buffer char (648) var; dcl test_char char (1); dcl rep_count fixed bin; /* number of repeated chars in compression sequence */ dcl bcd_count fixed bin; /* number of 6-bit elements in data to be output */ dcl space_left fixed bin; /* number of chars remaining in current message block */ dcl count_char char (1); /* ASCII char representing BCD equiv compression count */ dcl mess_p ptr; /* temporary pointer to partial input message */ dcl mess_len fixed bin; /* length of partial input message */ dcl remaining_message char (mess_len) based (mess_p); /* the partial input message */ dcl six_bit_number (bcd_count) fixed bin (6) unsigned unal based; dcl data_string char (nelem) based; /* input data for the write entry */ /* or output data for the read entry */ dcl data_bit_string bit (nelem) based; /* for binary punch, record length is in bits */ dcl based_record char (record_len) based; dcl record_len fixed bin; dcl rec_p ptr; dcl convert_string_$input entry (char (*) var, ptr, char (*) var, fixed bin (35)); dcl convert_string_$output entry (char (*) var, ptr, char (*) var, fixed bin (35)); dcl g115_io_$write entry (ptr, ptr, fixed bin (35)); dcl g115_io_$read entry (ptr, ptr, fixed bin (35)); dcl (addr, null, length, substr, copy, index, divide, maxlength) builtin; dcl (error_table_$eof_record, error_table_$too_many_buffers, error_table_$no_operation, error_table_$improper_data_format, error_table_$long_record, error_table_$data_loss) fixed bin (35) ext; dcl legal_slew_chars char (19) int static options (constant) init (" 0123456789[#@:>?AB"); /* printer slew codes, in order: */ /* Top of Form - space */ /* slew 0 to 15 lines - 0...? */ /* VFU_1 - A, VFU_2 - B */ dcl bcd_equiv_string char (64) unal int static options (constant) init ("0123456789[#@:>? ABCDEFGHI&.](<\^JKLMNOPQR-$*);'+/STUVWXYZ_,%=""!"); dcl bcd_equiv (0:63) char (1) unal defined (bcd_equiv_string); /* 6-bit index to get equiv ASCII char */ dcl bcd_equiv_overlay char (63) defined (bcd_equiv_string) pos (2); /* overlay of bcd_equiv_string starting at element 2 */ dcl cleanup condition; %include g115_device_data; %include g115_message; %include G115; %include g115_attach_data; %include remote_ttt_info; /* g115_protocol_$write: proc (a_adp, a_ddp, a_bufp, a_nelem, a_code); */ /* This entry takes a record described by a_bufp -> output_string (a_nelem) and prepares it to be sent to the remote computer. The message defined by g115_device_data.outp (level) -> g115_message.g115_msg_block is used to accumulate records until the 324 char message block is full (or almost). Then it is sent to the remote computer by calling g115_io_$write. The current message block is kept in a consistent state at all times so it can be "runout" by the subsystem at any time. A cleanup handler is used to insure that any message being updated was not left in an inconsistent state. The attach data for the switch performing the write defines the media code (i.e. target device). A single message block can contain records for several devices as long as the format code of the entire message is constant for all records. The format code for the teleprinter device is different than for printer and punch data. Also, records for the teleprinter are sent immediately, one record per message block, and must not be compressed or split across messages. If the media code is printer, the last char of the input string must be the slew control character. If the media code is binary punch, the input string is a record of 1 to 960 bits as defined by a_nelem. The input string is taken 6-bits at a time and converted to an ASCII character equivalent to the BCD representation of the 6-bits. */ a_code, code = 0; adp = a_adp; device_data_p = a_ddp; nelem = a_nelem; bufp = a_bufp; if g115_attach_data.media_code = G115.punch_bin_mc then do; /* length of binary input is different */ if nelem > length (binary_record) then go to NO_ROOM; /* too many bits for one card */ end; else if nelem > maxlength (io_data) then do; /* internal buffer limit for character records */ NO_ROOM: a_code = error_table_$long_record; return; end; if g115_device_data.level = hbound (g115_device_data.outp, 1) then do; a_code = error_table_$too_many_buffers; return; end; g115_device_data.level = g115_device_data.level + 1; /* set buffer level for this invocation */ level = g115_device_data.level; /* save a copy in automatic storage */ msgp = g115_device_data.outp (level); /* get the output buffer for this level */ if msgp = null then do; /* if not allocated, do it (never free output buffers) */ allocate g115_message in (buffer_area) set (g115_device_data.outp (level)); msgp = g115_device_data.outp (level); /* set ref ptr for structure */ g115_message = g115_device_data.template_ptr -> g115_message; /* initialize it */ end; on cleanup begin; /* check out the status of the message defined by this invocation */ if g115_message.being_changed | g115_device_data.level > 1 then do; /* flush inconsistent or higher level messages */ msgp -> g115_message.text_char_count = 0; msgp -> g115_message.rec_count = 0; msgp -> g115_message.fmt_code = "0"b; msgp -> g115_message.being_changed = "0"b; /* OK now */ end; g115_device_data.level = g115_device_data.level - 1; /* back to value when called */ end; /* define the format code for this record */ if g115_attach_data.device_type = teleprinter then format_code = g115_device_data.fmt_code.control; else format_code = g115_device_data.fmt_code.data; if g115_message.text_char_count > 0 then /* if there are records waiting */ if g115_message.fmt_code ^= format_code then do; /* and the format code is changing */ call send_message_block (code); /* then send the partial block */ if code ^= 0 then go to WRITE_RETURN; end; g115_message.fmt_code = format_code; /* this may be redundant at times, but cheap ... */ /* start special processing of text */ if g115_attach_data.device_type = printer then do; /* for the printer, check the slew char */ slew_char = substr (bufp -> data_string, nelem, 1); /* slew code is the last char of input data */ if index (legal_slew_chars, slew_char) = 0 then /* if slew code not defined ... */ slew_char = "1"; /* default to single new line */ nelem = nelem - 1; /* process remaining text up to the slew char */ end; if g115_attach_data.media_code = G115.punch_bin_mc then do; /* Binary Punch Output */ binary_record = bufp -> data_bit_string; /* align data and pad with zeros */ bufp = addr (binary_record); /* use our copy now */ bcd_count = divide (nelem + 5, 6, 0); /* number of 6-bit elements */ io_data = ""; /* clear the conversion string */ do idx = 1 to bcd_count; /* get six bits as unsigned fixed bin index */ io_data = io_data || bcd_equiv (bufp -> six_bit_number (idx)); /* output ASCII - bcd equiv of index */ end; end; else do; /* Character Output */ temp_buffer = bufp -> data_string; /* put data into local buffer */ if length (temp_buffer) > 0 then do; /* do any escape and/or translation processing */ call convert_string_$output (temp_buffer, addr (g115_attach_data.ttt_info), io_data, code); if code ^= 0 then go to WRITE_RETURN; end; else io_data = ""; /* no data, could be just a printer slew record */ end; /* are we supposed to compress multiple characters (NOT allowed for teleprinter output) */ if g115_device_data.write_compress & g115_attach_data.device_type ^= teleprinter then do; temp_buffer = io_data; /* copy into temp buffer */ io_data = ""; /* clear output and rebuild */ idx = 1; do while (idx <= length (temp_buffer)); /* loop through the input string */ test_char = substr (temp_buffer, idx, 1); /* find next char */ rep_count = verify (substr (temp_buffer, idx), test_char) - 1; /* how many are there? */ if rep_count < 1 then /* remainder of string is the same */ rep_count = length (temp_buffer) - idx + 1; /* see how many */ if rep_count > 3 then do; /* compress if more than three in a row */ if rep_count > 64 then rep_count = 64; /* only compress 64 at a time */ count_char = bcd_equiv (rep_count - 1); /* don't include first char in repitition count */ io_data = io_data || test_char || G115.CC || count_char; end; else do; /* put in a few (1 to 3) of the char */ io_data = io_data || substr (temp_buffer, idx, rep_count); end; idx = idx + rep_count; /* bump the index */ end; end; /* format the data into a legal G115 record: [] */ if g115_attach_data.device_type = printer then io_record = g115_attach_data.media_code || io_data || slew_char || G115.RS; else io_record = g115_attach_data.media_code || io_data || G115.RS; record_len = length (io_record); /* set the length of the based record */ if g115_attach_data.device_type = teleprinter & record_len > G115.max_msg_len then go to NO_ROOM; /* teleprinter records cannot be split */ /* this is the critical part of the code, add the record to the current message */ space_left = G115.max_msg_len - g115_message.text_char_count; if record_len > space_left then do; /* won't fit completely (can't happen for the teleprinter) */ if g115_device_data.write_split then do; /* can we add part of it to current message block */ g115_message.being_changed = "1"b; /* mark as inconsistent */ rec_p = addr (g115_message.etx); /* get ptr to start of next record */ substr (rec_p -> based_record, 1, space_left) = substr (io_record, 1, space_left); g115_message.text_char_count = g115_message.text_char_count + space_left; g115_message.etx = G115.etx_char; /* put back the closing ETX */ g115_message.being_changed = "0"b; /* message is now back to normal */ io_record = substr (io_record, space_left + 1); /* save the part not sent */ record_len = length (io_record); /* define new based record length */ end; call send_message_block (code); /* send off the current block and start a new one */ if code ^= 0 then go to WRITE_RETURN; end; g115_message.being_changed = "1"b; /* tell handler message is inconsistent */ rec_p = addr (g115_message.etx); /* find start of next record */ rec_p -> based_record = io_record; /* add in the record (or the last part of split) */ g115_message.text_char_count = g115_message.text_char_count + record_len; g115_message.etx = G115.etx_char; g115_message.being_changed = "0"b; /* back to a legal message again */ /* All is safe now, the message is again consistent and ready to transmit. See if we should send it now or wait. Protocol says that there can only be one record per message for the teleprinter, so always send teleprinter output. Otherwise wait til there is enough to keep the line overhead down or til the caller wants a runout. The exception to this rule is that if this invocation level is greater than 1, we should send the message because we may not get back to this level again to fill up the block. */ if g115_attach_data.device_type = teleprinter then call send_message_block (code); else if level > 1 then call send_message_block (code); else if g115_message.text_char_count > 300 then call send_message_block (code); /* if close to full, why wait? */ WRITE_RETURN: a_code = code; /* copy back the code */ g115_device_data.level = g115_device_data.level - 1; /* pop the invocation level */ revert cleanup; /* be sure we don't do it twice */ return; send_message_block: proc (code); dcl code fixed bin (35); code = 0; if ^g115_message.being_changed then do; /* if not consistent, quietly flush it */ call g115_io_$write (device_data_p, msgp, code); if code ^= 0 then return; end; g115_message.text_char_count = 0; /* make this message block clean again */ g115_message.being_changed = ""b; return; end send_message_block; read: entry (a_adp, a_ddp, a_bufp, a_nelem, a_nelemt, a_code); /* This entry is used to read one record of a message block from the remote computer. Only character data is accepted, and we have no way of knowing if the data is for the reader device or for the operator. The caller wants the data to be put into the string a_bufp -> data_string (a_nelem). The record may be shorter than a_nelem, so we tell how many were in the record by setting a_nelemt. If the record is greater than a_nelem, we return as many as possible, throw away the extra and return error_table_$data_loss as a status code. */ a_code, code, a_nelemt = 0; /* init return stuff */ adp = a_adp; device_data_p = a_ddp; bufp = a_bufp; nelem = a_nelem; if nelem < 1 then do; /* read zero length record? */ a_code = error_table_$no_operation; return; end; msgp = g115_device_data.first_bp; /* get pointer to first input buffer */ if g115_message.rec_count < 1 then do; /* is this block finished? */ call get_next_message (msgp, code); /* find a new message to process */ if code ^= 0 then go to READ_RETURN; end; /* at this point msgp should point to a valid data block (unless this is the Answering Service) */ if msgp -> g115_message.rec_count < 1 then return; /* no data */ /* The input message block consists of one or more records of the form: we want to give the caller the text_data part of the next unprocessed record */ test_char = g115_message.text (g115_message.last_char_read + 1); /* pickup the media code of next record */ if test_char ^= G115.bcd_input_mc then do; /* force the issue, ignore binary input */ g115_message.text_char_count = 0; g115_message.rec_count = 0; /* for now, kill the whole record */ code = error_table_$improper_data_format; go to READ_RETURN; end; mess_p = addr (g115_message.text (g115_message.last_char_read + 2)); /* pointer to (after media code) */ mess_len = g115_message.text_char_count - g115_message.last_char_read - 1; /* length of remaining message */ g115_message.last_char_read = g115_message.last_char_read + 1; /* we have used up the media code */ io_data = ""; /* clear the buffer */ idx = index (remaining_message, G115.RS); /* find record separator which ends record */ do while (idx = 0); /* collect split records if any */ if length (io_data) + mess_len > maxlength (io_data) then do; /* will it fit */ LONG_RECORD: a_code = error_table_$long_record; return; end; io_data = io_data || remaining_message; /* first part of record is all this remaining message */ call get_next_message (msgp, code); /* rest of record should be in next message */ if code ^= 0 then goto READ_RETURN; mess_p = addr (g115_message.text (1)); /* define the new remaining message string */ mess_len = g115_message.text_char_count; /* continuation of record has no media code */ idx = index (remaining_message, G115.RS); /* look for the record separator */ if length (io_data) + idx > maxlength (io_data) then go to LONG_RECORD; end; io_data = io_data || substr (remaining_message, 1, idx - 1); /* last of record text less separator (G115.RS) */ g115_message.last_char_read = g115_message.last_char_read + idx; /* record the last char that was used */ g115_message.rec_count = g115_message.rec_count - 1; /* decrement input count in message */ /* The text_data can contain compressed data of the form: Where: * repeat_char is the actual character that appears 3 to 64 times in a row. * G115.CC is the compression code - 037 octal. * count_char is an ASCII char, the equivalent 6-bit BCD value of which is the fixed bin * representation of the number of times the repeat char is repeated AFTER the first occurance. * (i.e. count_char "[" represents the number 10, thus 11 repeat_chars should appear * in the output data after de-compression.) */ temp_buffer = ""; /* get ready to rebuild the data in the temporary */ idx = 1; /* start looking from the first char in the record */ CC_index = index (io_data, G115.CC); /* look for a compression code (CC) */ do while (CC_index > 0); /* loop de-compressing record */ temp_buffer = temp_buffer || substr (io_data, idx, CC_index - 1); /* copy all up to compression code */ test_char = substr (io_data, idx + CC_index - 2, 1); /* pick up repeated char (before CC) */ idx = idx + CC_index + 1; /* move index to next unprocessed char */ count_char = substr (io_data, idx - 1, 1); /* this represents number of repeates */ rep_count = index (bcd_equiv_overlay, count_char); /* convert to fixed bin */ temp_buffer = temp_buffer || copy (test_char, rep_count); CC_index = index (substr (io_data, idx), G115.CC); /* look for next compression code */ end; temp_buffer = temp_buffer || substr (io_data, idx); /* copy remainder of input */ /* do any escape and/or translation processing */ call convert_string_$input (temp_buffer, addr (g115_attach_data.ttt_info), io_data, code); if code ^= 0 then go to READ_RETURN; if io_data = "++EOF" | io_data = "++eof" then code = error_table_$eof_record; /* set end-of-file code */ record_len = length (io_data); if nelem < record_len then do; /* not enough room to return all */ code = error_table_$data_loss; /* give warning */ record_len = nelem; end; substr (bufp -> data_string, 1, record_len) = substr (io_data, 1, record_len); /* give data to caller */ a_nelemt = record_len; READ_RETURN: a_code = code; return; get_next_message: proc (msgp, code); dcl msgp ptr; dcl code fixed bin (35); code = 0; /* see if there is a chain of messages already */ follow_chain: if msgp -> g115_message.next_bp = null then /* must read a message from Ring 0 */ call g115_io_$read (device_data_p, msgp, code); else do; /* chain of input blocks exist, go to the next one */ g115_device_data.first_bp = g115_message.next_bp; free msgp -> g115_message in (buffer_area); msgp = g115_device_data.first_bp; if msgp -> g115_message.rec_count = 0 then go to follow_chain; /* if empty, try again */ end; return; end get_next_message; end g115_protocol_$write; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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