channel_manager.pl1 11/11/89 1132.7r w 11/11/89 0824.9 134091 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ channel_manager: procedure; /* This procedure accepts calls to perform various channel management functions. Each such call is directed through a transfer vector to the appropriate module according to channel type and functional type. The specified channel is locked before forwarding the call and unlocked upon return. */ /* Coded 7/31/78 by J. Stern */ /* Tracing added February 1980 */ /* Metering added April 1980 by C. Hornig */ /* Metering corrected October 1980 by Robert Coren to avoid double-counting of output characters */ /* copy_meters control added December 1980 by Robert Coren */ /* Modified 6 Apr 82, W. Olin Sibert, to add TIMER interrupt handling */ /* Parameters */ dcl pm_devx fixed bin; dcl pm_info_ptr ptr; dcl pm_chain_ptr ptr; dcl pm_more_input_flag bit (1) aligned; dcl pm_control_type char (*); dcl pm_modes_change_list_ptr ptr; dcl pm_modes char (*); dcl pm_int_type fixed bin; dcl pm_int_data bit (72) aligned; dcl pm_code fixed bin (35); /* Automatic */ dcl queued_entry bit (1) aligned; dcl int_type fixed bin; dcl devx fixed bin; dcl subchan fixed bin; dcl locked bit (1) aligned; dcl minor_lctep ptr; dcl time_in fixed bin (71); /* Based */ dcl 1 minor_lcte aligned like lcte based (minor_lctep); /* Conditions */ dcl cleanup condition; /* Constants */ dcl crash_system fixed bin int static options (constant) init (1); dcl int_type_names (17) char (16) aligned static options (constant) init ("dialup", "hangup", "crash", "send_output", "input_available", "accept_input", "input_rejected", "quit", "line_status", "dial_status", "wru_timeout", "space_available", "ack_echnego_init", "ack_echnego_stop", "timer", "user", "masked"); /* External static */ dcl pds$process_id bit (36) ext; dcl pds$virtual_delta fixed bin (71) ext; /* Builtins */ dcl (addr, clock, null, pointer, rel, unspec) builtin; /* Entries */ dcl mcs_trace entry options (variable); dcl mcs_trace$buffer_chain entry (fixed bin, pointer); dcl tty_lock$lock_channel entry (fixed bin, fixed bin (35)); dcl tty_lock$unlock_channel entry (fixed bin); dcl tty_lock$lock_channel_int entry (fixed bin, fixed bin, bit (72) aligned, bit (1) aligned); dcl tty_lock$unlock_channel_int entry (fixed bin); dcl tty_lock$queue_interrupt entry (fixed bin, fixed bin, bit (72) aligned, fixed bin); dcl syserr entry options (variable); %page; /* * * * * * * * * * READ * * * * * * * * * * */ read: entry (pm_devx, pm_chain_ptr, pm_more_input_flag, pm_code); call setup_major (subchan); if tty_buf.trace.enable then if tty_buf.trace.read then call mcs_trace (pm_devx, "read"); on cleanup call unlock_channel (); call lock_channel (); read_ev = make_entry (READ, (lcte.channel_type)); call read_ev ((lcte.data_base_ptr), subchan, pm_chain_ptr, pm_more_input_flag, pm_code); if pm_code = 0 then if pm_chain_ptr ^= null () then do blockp = pm_chain_ptr /* walk chain to count bytes */ repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b); minor_lcte.meters.in_bytes = minor_lcte.meters.in_bytes + buffer.tally; end; call unlock_channel (); if tty_buf.trace.enable then if tty_buf.trace.read then do; call mcs_trace (pm_devx, "read: ^[code ^d ^;^s^]^[chain at ^p ^;^s^]^[more_input^]", (pm_code ^= 0), pm_code, (pm_chain_ptr ^= null ()), pm_chain_ptr, pm_more_input_flag); if tty_buf.trace.data then call mcs_trace$buffer_chain (pm_devx, pm_chain_ptr); end; call meter_call (minor_lcte.meters.in); return; /* * * * * * * * * * WRITE * * * * * * * * * * */ write: entry (pm_devx, pm_chain_ptr, pm_code); call setup_major (subchan); if tty_buf.trace.enable then if tty_buf.trace.write then do; call mcs_trace (pm_devx, "write: ^p: ^d bytes ^[etc.^]", pm_chain_ptr, pm_chain_ptr -> buffer.tally, (pm_chain_ptr -> buffer.next ^= 0)); if tty_buf.trace.data then call mcs_trace$buffer_chain (pm_devx, pm_chain_ptr); end; on cleanup call unlock_channel (); call lock_channel (); do blockp = pm_chain_ptr /* walk chain to count bytes */ repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b); minor_lcte.meters.out_bytes = minor_lcte.meters.out_bytes + buffer.tally; end; write_ev = make_entry (WRITE, (lcte.channel_type)); call write_ev ((lcte.data_base_ptr), subchan, pm_chain_ptr, pm_code); if pm_chain_ptr ^= null () /* multiplexer didn't take it all */ then do blockp = pm_chain_ptr /* subtract out those it didn't take */ repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b); minor_lcte.meters.out_bytes = minor_lcte.meters.out_bytes - buffer.tally; end; call unlock_channel (); if tty_buf.trace.enable then if tty_buf.trace.write then if (pm_chain_ptr ^= null ()) | (pm_code ^= 0) then call mcs_trace (pm_devx, "write: ^[code ^d ^;^s^]chain left at ^p", pm_code, pm_chain_ptr); call meter_call (minor_lcte.meters.out); return; /* * * * * * * * * * CONTROL * * * * * * * * * */ control: entry (pm_devx, pm_control_type, pm_info_ptr, pm_code); call setup_major (subchan); if tty_buf.trace.enable then if tty_buf.trace.control then call mcs_trace (pm_devx, "control: ^a ^p", pm_control_type, pm_info_ptr); on cleanup call unlock_channel (); call lock_channel (); control_ev = make_entry (CONTROL, (lcte.channel_type)); call control_ev ((lcte.data_base_ptr), subchan, pm_control_type, pm_info_ptr, pm_code); call unlock_channel (); call meter_call (minor_lcte.meters.control); if pm_control_type = "copy_meters" /* we have to do something about this */ then minor_lcte.saved_meters_ptr -> saved_meters = minor_lcte.meters; else if pm_control_type = "get_meters" /* this too */ then call get_lc_meters; return; /* * * * * * * * * * SET_MODES * * * * * * * * * * */ set_modes: entry (pm_devx, pm_modes_change_list_ptr, pm_code); call setup_major (subchan); if tty_buf.trace.enable then if tty_buf.trace.modes then call mcs_trace (pm_devx, "set_modes: ^p", pm_modes_change_list_ptr); on cleanup call unlock_channel (); call lock_channel (); set_modes_ev = make_entry (SET_MODES, (lcte.channel_type)); call set_modes_ev ((lcte.data_base_ptr), subchan, pm_modes_change_list_ptr, pm_code); call unlock_channel (); call meter_call (minor_lcte.meters.control); return; /* * * * * * * * * * * CHECK_MODES * * * * * * * * * */ check_modes: entry (pm_devx, pm_modes_change_list_ptr, pm_code); call setup_major (subchan); if tty_buf.trace.enable then if tty_buf.trace.modes then call mcs_trace (pm_devx, "check_modes: ^p", pm_modes_change_list_ptr); on cleanup call unlock_channel (); call lock_channel (); check_modes_ev = make_entry (CHECK_MODES, (lcte.channel_type)); call check_modes_ev ((lcte.data_base_ptr), subchan, pm_modes_change_list_ptr, pm_code); call unlock_channel (); call meter_call (minor_lcte.meters.control); return; /* * * * * * * * * * * GET_MODES * * * * * * * * * */ get_modes: entry (pm_devx, pm_modes, pm_code); call setup_major (subchan); if tty_buf.trace.enable then if tty_buf.trace.modes then call mcs_trace (pm_devx, "get_modes"); on cleanup call unlock_channel (); call lock_channel (); get_modes_ev = make_entry (GET_MODES, (lcte.channel_type)); call get_modes_ev ((lcte.data_base_ptr), subchan, pm_modes, pm_code); call unlock_channel (); call meter_call (minor_lcte.meters.control); return; /* * * * * * * * * * INTERRUPT * * * * * * * * * * */ interrupt: entry (pm_devx, pm_int_type, pm_int_data); queued_entry = "0"b; interrupt_common: int_type = pm_int_type; call setup (); on cleanup call syserr (crash_system, "channel_manager: Cleanup while processing interrupt for devx ^d.", devx); if ^queued_entry then do; call tty_lock$lock_channel_int (devx, int_type, pm_int_data, locked); if ^locked then do; if tty_buf.trace.enable then if tty_buf.trace.interrupt then call mcs_trace (devx, "int: queued ^a ^24.3b", int_type_names (int_type), pm_int_data); return; /* All finished: interrupt was queued for (locked) channel */ end; end; if tty_buf.trace.enable then if tty_buf.trace.interrupt then do; call mcs_trace (devx, "int: proc ^[queued ^]^a ^24.3b", queued_entry, int_type_names (int_type), pm_int_data); if int_type = ACCEPT_INPUT then if tty_buf.trace.data then do; unspec (rtx_info) = pm_int_data; call mcs_trace$buffer_chain (devx, pointer (ttybp, rtx_info.chain_head)); end; end; interrupt_ev = make_entry (INTERRUPT, (lcte.channel_type)); call interrupt_ev ((lcte.data_base_ptr), int_type, pm_int_data); if ^queued_entry then call tty_lock$unlock_channel_int (devx); if /* case */ int_type = ACCEPT_INPUT then do; unspec (rtx_info) = pm_int_data; lcte.meters.in_bytes = lcte.meters.in_bytes + rtx_info.input_count; call meter_interrupt (lcte.meters.in); end; else if int_type = SEND_OUTPUT then do; call meter_interrupt (lcte.meters.out); end; else call meter_interrupt (lcte.meters.control); return; /* * * * * * * * * * QUEUED_INTERRUPT * * * * * * * * * */ queued_interrupt: entry (pm_devx, pm_int_type, pm_int_data); /* called with channel already locked */ queued_entry = "1"b; go to interrupt_common; /* * * * * * * * * * INTERRUPT_LATER * * * * * * * * * */ interrupt_later: entry (pm_devx, pm_int_type, pm_int_data); /* This entry is used to queue an interrupt for a subchannel unconditionally; the interrupt is processed when it is time to unlock the major channel */ int_type = pm_int_type; call setup (); if tty_buf.trace.enable then if tty_buf.trace.interrupt then call mcs_trace (devx, "int: queued ^a ^24.3b", int_type_names (int_type), pm_int_data); on cleanup call syserr (crash_system, "channel_manager: Cleanup while queuing interrupt for devx ^d.", devx); call tty_lock$queue_interrupt ((lcte.major_channel_devx), int_type, pm_int_data, devx); return; /* * * * * * * * * SETUP * * * * * * * * * */ setup: proc; locked = "0"b; ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; time_in = clock () - pds$virtual_delta; devx = pm_devx; if devx < 1 | devx > lct.max_no_lctes then call syserr (crash_system, "channel_manager: Invalid devx specified. ^o", devx); lctep = addr (lct.lcte_array (devx)); cmtvp = addr (cmtv$cmtv); end setup; /* setup */ /* * * * * * * * * * * SETUP_MAJOR * * * * * * * ** */ setup_major: proc (subchan); dcl subchan fixed bin; call setup (); minor_lctep = lctep; if lcte.lock ^= pds$process_id then call syserr (crash_system, "channel_manager: Channel not locked by process. (devx = ^o)", devx); subchan = lcte.subchannel; devx = lcte.major_channel_devx; lctep = addr (lct.lcte_array (devx)); end setup_major; /* setup_major */ /* * * * * * * * * * METER_CALL * * * * * * * * * */ meter_call: procedure (Meters); dcl 1 Meters aligned like lcte.meters.in; Meters.calls = Meters.calls + 1; Meters.call_time = Meters.call_time + clock () - pds$virtual_delta - time_in; return; /* * * * * * * * * * METER_INTERRUPT * * * * * * * * * */ meter_interrupt: entry (Meters); Meters.interrupts = Meters.interrupts + 1; Meters.interrupt_time = Meters.interrupt_time + clock () - pds$virtual_delta - time_in; return; end meter_call; /* * * * * * * * * * GET_LC_METERS * * * * * * * * * * */ get_lc_meters: proc; /* return logical channel meters in response to get_meters order */ dcl lcmp ptr; dcl info_ptr ptr; info_ptr = pm_info_ptr; info_ptr -> get_comm_meters_info.parent_type = lcte.channel_type; lcmp = info_ptr -> get_comm_meters_info.logical_chan_ptr; lcmp -> logical_chan_meters.current_meters = minor_lcte.meters; lcmp -> logical_chan_meters.saved_meters = minor_lcte.saved_meters_ptr -> saved_meters; return; end get_lc_meters; /* * * * * * * * * * MAKE_ENTRY * * * * * * * * * * */ make_entry: proc (entry_type, chan_type) returns (entry variable); /* kludges together an entry variable */ dcl entry_type fixed bin; dcl chan_type fixed bin; dcl code_ptr ptr; dcl code_word fixed bin based (code_ptr); dcl new_entry entry variable; dcl 1 entry_var aligned, 2 code_ptr ptr, 2 env_ptr ptr; code_ptr = addr (cmtv.entries (entry_type, cmtv.chan_type_index (chan_type))); if code_word = 0 /* undefined entry point */ then new_entry = undefined_entry; else do; entry_var.code_ptr = code_ptr; entry_var.env_ptr = null; unspec (new_entry) = unspec (entry_var); end; return (new_entry); end make_entry; /* get_entry */ undefined_entry: procedure; /* for bad cmtv pointers */ return; end undefined_entry; /* * * * * * * * * * * * LOCK_CHANNEL * * * * * * * * * */ lock_channel: proc; dcl code fixed bin (35); if lcte.special_lock /* not for us to lock */ then return; call tty_lock$lock_channel (devx, code); if code ^= 0 then call syserr (crash_system, "channel_manager: Cannot lock channel for devx ^o (code = ^o)", devx, code); locked = "1"b; end lock_channel; /* lock_channel */ /* * * * * * * * * * * UNLOCK_CHANNEL * * * * * * * * * * */ unlock_channel: proc; if locked then call tty_lock$unlock_channel (devx); locked = "0"b; end unlock_channel; /* unlock_channel */ %include lct; %include cmtv; %include tty_buf; %include mcs_interrupt_info; %include tty_buffer_block; %include get_comm_meters_info; end; /* channel_manager_ */ /* BEGIN MESSAGE DOCUMENTATION Message: channel_manager: Cleanup while processing interrupt for devx N. S: $crash T: $run M: The cleanup condition was signalled while processing an interrupt for the channel with devx N. A: $inform Message: channel_manager: Error while processing interrupt for devx N. REASON S: $crash T: $run M: An error occurred while processing an interrupt for the channel with devx N. The specific kind of error is explained by REASON. END MESSAGE DOCUMENTATION */  cmtv.alm 11/11/89 1132.7rew 11/11/89 0824.9 82323 " *********************************************************** " * * " * Copyright, (C) BULL HN Information Systems Inc., 1989 * " * * " * Copyright, (C) Honeywell Bull Inc., 1988 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " HISTORY COMMENTS: " 1) change(88-06-15,Berno), approve(88-07-13,MCR7928), " audit(88-07-05,Parisek), install(88-07-19,MR12.2-1061): " Add transfers to the uncp multiplexer interface for the DSA gateway. " 2) change(88-07-07,Beattie), approve(88-06-27,MCR7926), " audit(88-08-03,Brunelle), install(88-08-08,MR12.2-1082): " Add transfers for X.25 lap multiplexer. " 3) change(89-03-20,Parisek), approve(89-06-01,MCR8110), " audit(89-10-09,Farley), install(89-10-25,MR12.3-1100): " Add transfers to protocol_mpx entries. " END HISTORY COMMENTS """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " " cmtv --- channel manager transfer vector " " This source segment defines a data base containing a transfer " vector used by the channel_manager and priv_channel_manager " procedures. It has the following structure: " " " dcl 1 cmtv aligned based (addr (cmtv$)), " 2 no_channel_types fixed bin, " 2 pad fixed bin, " 2 chan_type_index (0:16) fixed bin, " 2 entries (no_entry_types, 0 refer (cmtv.no_channel_types)) bit (72); " " " Created 9/21/78 by J. Stern """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" macro prologue name cmtv set .cur_index,0 set .tty_index,0 set .fnp_index,0 set .user1_index,0 set .user2_index,0 set .user3_index,0 set .user4_index,0 set .user5_index,0 set .ibm3270_index,0 set .vip7760_index,0 set .sty_index,0 set .lap_index,0 set .x25_index,0 set .hasp_index,0 set .uncp_index,0 set .cxi_index,0 set .system1_index,0 set .protocol_index,0 &end macro epilogue use .text. segdef cmtv cmtv: null zero 0,.cur_index dec 0 zero 0,.tty_index zero 0,.fnp_index zero 0,.user1_index zero 0,.user2_index zero 0,.user3_index zero 0,.user4_index zero 0,.user5_index zero 0,.ibm3270_index zero 0,.vip7760_index zero 0,.sty_index zero 0,.lap_index zero 0,.x25_index zero 0,.hasp_index zero 0,.uncp_index zero 0,.cxi_index zero 0,.system1_index zero 0,.protocol_index join /text/.init_channel. join /text/.terminate_channel. join /text/.init_multiplexer. join /text/.terminate_multiplexer. join /text/.start. join /text/.stop. join /text/.shutdown. join /text/.priv_control. join /text/.hpriv_control. join /text/.read. join /text/.write. join /text/.control. join /text/.set_modes. join /text/.check_modes. join /text/.get_modes. join /text/.interrupt. maclist on end &end " The following macros define valid entry type names: macro init_channel &end macro terminate_channel &end macro init_multiplexer &end macro terminate_multiplexer &end macro start &end macro stop &end macro shutdown &end macro priv_control &end macro hpriv_control &end macro read &end macro write &end macro control &end macro set_modes &end macro check_modes &end macro get_modes &end macro interrupt &end " The following macros define valid channel type names: macro tty &end macro fnp &end macro user1 &end macro user2 &end macro user3 &end macro user4 &end macro user5 &end macro ibm3270 &end macro vip7760 &end macro sty &end macro lap &end macro x25 &end macro hasp &end macro uncp &end macro cxi &end macro system1 &end macro protocol &end macro add_entry &1 use .&1. getlp tra &2$&1 set .&1_incr,0 &end macro type &1 set .cur_index,.cur_index+1 set .&1_index,.cur_index set .init_channel_incr,2 set .terminate_channel_incr,2 set .init_multiplexer_incr,2 set .terminate_multiplexer_incr,2 set .start_incr,2 set .stop_incr,2 set .shutdown_incr,2 set .priv_control_incr,2 set .hpriv_control_incr,2 set .read_incr,2 set .write_incr,2 set .control_incr,2 set .set_modes_incr,2 set .check_modes_incr,2 set .get_modes_incr,2 set .interrupt_incr,2 &R3&( add_entry &i,&2 &) use .init_channel. bss ,.init_channel_incr use .terminate_channel. bss ,.terminate_channel_incr use .init_multiplexer. bss ,.init_multiplexer_incr use .terminate_multiplexer. bss ,.terminate_multiplexer_incr use .start. bss ,.start_incr use .stop. bss ,.stop_incr use .shutdown. bss ,.shutdown_incr use .priv_control. bss ,.priv_control_incr use .hpriv_control. bss ,.hpriv_control_incr use .read. bss ,.read_incr use .write. bss ,.write_incr use .control. bss ,.control_incr use .set_modes. bss ,.set_modes_incr use .check_modes. bss ,.check_modes_incr use .get_modes. bss ,.get_modes_incr use .interrupt. bss ,.interrupt_incr &end maclist off " The transfer vector definition has the following syntax: " " " := prologue epilogue " := | " := type , , " := | , " := | ( , ) " := tty | fnp | user1 | user2 | user3 | user4 | user5 | ibm3270 " | vip7760 | sty | lap | x25 | hasp | uncp | cxi | system1 " | protocol " := init_channel | terminate_channel | init_multiplexer | terminate_multiplexer | start | stop | shutdown | priv_control | hpriv_control | read | write | control | set_modes | check_modes | get_modes | interrupt " := {the name of a procedure segment} " := {the name of a procedure segment} " " " Each "type" statement defines a channel type. " It specifies the valid entry types for the channel type. " It specifies the transfer vector target for each valid entry type. " The transfer vector target for an entry type is an entrypoint " in a procedure segment. " The name of the entrypoint is always the name of the entry type. " The segment name may optionally be specified by a local segment name. " If no local segment name is given, then the global segment name is used. prologue type tty,tty_index, init_channel, terminate_channel, (interrupt,tty_interrupt) type fnp,fnp_multiplexer, init_multiplexer, terminate_multiplexer, start, stop, shutdown, priv_control, hpriv_control, read, write, control, set_modes, check_modes, get_modes type vip7760,polled_vip_mpx, (init_multiplexer,priv_polled_vip_mpx), (terminate_multiplexer,priv_polled_vip_mpx), (start,priv_polled_vip_mpx), (stop,priv_polled_vip_mpx), (shutdown,priv_polled_vip_mpx), (hpriv_control,priv_polled_vip_mpx), (priv_control,priv_polled_vip_mpx), read, write, check_modes, set_modes, get_modes, control, interrupt type ibm3270,ibm3270_mpx, (init_multiplexer,priv_ibm3270_mpx), (terminate_multiplexer,priv_ibm3270_mpx), (start,priv_ibm3270_mpx), (stop,priv_ibm3270_mpx), (shutdown,priv_ibm3270_mpx), (priv_control,priv_ibm3270_mpx), (hpriv_control,priv_ibm3270_mpx), control, read, check_modes, set_modes, get_modes, write, interrupt type lap,lap_simplex, init_multiplexer,terminate_multiplexer, start,stop,shutdown, hpriv_control,priv_control,control, check_modes,set_modes,get_modes, write, interrupt type x25,x25_mpx, (init_multiplexer,priv_x25_mpx), (terminate_multiplexer,priv_x25_mpx), (start,priv_x25_mpx), (stop,priv_x25_mpx), (shutdown,priv_x25_mpx), (hpriv_control,priv_x25_mpx), (priv_control,priv_x25_mpx), control, check_modes,set_modes,get_modes, write, interrupt type sty,sty_mpx, init_multiplexer,terminate_multiplexer, start,stop,shutdown, read,write,control, get_modes,set_modes,check_modes type hasp,hasp_mpx, (init_multiplexer,priv_hasp_mpx), (terminate_multiplexer,priv_hasp_mpx), (start,priv_hasp_mpx), (stop,priv_hasp_mpx), (shutdown,priv_hasp_mpx), (priv_control,priv_hasp_mpx), (hpriv_control,priv_hasp_mpx), read,write,interrupt,control, check_modes,set_modes,get_modes type uncp,uncp_multiplexer, init_multiplexer, terminate_multiplexer, start, stop, shutdown, priv_control, hpriv_control, read, write, control, set_modes, check_modes, get_modes type protocol,protocol_mpx, init_multiplexer, terminate_multiplexer, start, stop, shutdown, priv_control, hpriv_control, interrupt epilogue  dn355.pl1 11/11/89 1132.7r w 11/11/89 0824.9 521658 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,insnl,delnl,^ifthendo */ dn355: procedure; return; /* should never be called here */ /* Date last modified and reason Written 10/08/74 by F. A. Canali for new tty dim Modified by Robert Coren and Mike Grady to fix bugs and add features Modified by Robert Coren 10/08/75 for multiple 355s Modified by J. Stern 04/22/77 to introduce WTCBs Modified by J. Stern 06/23/77 to behave correctly when no submailboxes available Modified by J. Stern 07/28/77 to use all 3 words of command data in submailbox Modified Jan.-Feb. 1978 to use variable-size output buffers and fix some bugs Modified 3/13/78 by Robert Coren to use clock builtin instead of clock_ and to get correct time at hangup_fnp_lines entry Modified August 1978 by Robert Coren for demultiplexing Modified November 8, 1978 by Robert Coren to introduce FNP-initiated mailboxes Modified July 2 1979 by B. Greenberg for negotiated echo. Modified March 1980 by Robert Coren to eliminate use of circular buffer. Modified April 1980 by Robert Coren to add metering information. Modified 1980 December by Art Beattie to ignore interrupts in invalid levels. Also allowed command_data for send_wcd operations to be 216 bits long (6 * 36-bit word). Corrected error message documentation. Modified December 1980 by Robert Coren to handle report_meters opcode Modified April 1981 by Chris Jones for io_manager conversion Modified September 1981 by Robert Coren to record character counts in LCTE meters and to force COLTS buffer size to maximum Modified February 1982 by C. Hornig for MR10 io_manager. Modified June 1982 by Robert Coren to process "line_masked" opcode. Modified 1984-07-28 BIM for dn355_boot_interrupt$system_fault. Modified 1984-07-30 BIM for paged mode IOM. Modified September 1984 by Robert Coren to use include file to define delay queue entries */ /****^ HISTORY COMMENTS: 1) change(86-04-23,Coren), approve(86-04-23,MCR7300), audit(86-06-19,Beattie), install(86-07-08,MR12.0-1089): To handle 8-word echo-break tables. 2) change(86-06-19,Kissel), approve(86-07-30,MCR7475), audit(86-09-04,Coren), install(86-10-09,MR12.0-1181): Changed to support the new tty event message format declared in net_event_message.incl.pl1 which replaces tty_event_message.incl.pl1. 3) change(87-07-20,Farley), approve(88-02-24,MCR7791), audit(88-03-09,Beattie), install(88-03-15,MR12.2-1035): Changed no response loop to use a real time constant and retry the timeout or error one time along with reporting the problem. If no response occurs after the retry then the FNP will be crashed. END HISTORY COMMENTS */ %page; interrupt: entry (x_dno, x_level, x_status); /* entry from iom_manager */ dcl x_dno fixed bin (35); /* index from assignment time */ dcl x_level fixed bin (3); /* interrupt level */ dcl x_status bit (36) aligned; /* status after special or fault */ if tc_data$system_shutdown ^= 0 then return; /* ignore 355's if shut down in progress */ interrupt_entry = "1"b; call setup; level = x_level; /* copy level to local stack */ if datanet_info.trace then do; if level ^= 3 | ^fnp_info.running then syserr_severity = just_tell; else syserr_severity = log; call syserr (syserr_severity, "dn355: FNP ^a level ^d status ^w^[ running^]^[ bootloading^]^[ t_and_d_in_progress^]", fnp_name, level, x_status, fnp_info.running, fnp_info.bootloading, fnp_info.t_and_d_in_progress); end; if level ^= 3 & level ^= 7 then do; /* if not a good interrupt level */ call syserr (beeper, "dn355: FNP ^a invalid interrupt level ^o", fnp_name, level); if fnp_info.bootloading then if level = 1 /* system fault */ then call dn355_boot_interrupt$system_fault (dno); return; /* lets hope its benign */ end; if (^fnp_info.t_and_d_in_progress) & (^fnp_info.running) & (^fnp_info.bootloading) then return; /* spurious interrupt */ if ^stac (addr (lcte.lock), pds$processid) /* somebody else has it */ then do; do while (^stac (addr (fnp_info.queue_lock), pds$processid)); end; if level = 7 then fnp_info.level_7_pending = "1"b; else fnp_info.level_3_pending = "1"b; if stac (addr (lcte.lock), pds$processid) /* in case it got unlocked meanwhile */ then call process_int_queue ("0"b); else if ^stacq (fnp_info.queue_lock, "0"b, pds$processid) then call syserr (crash_system, "dn355: inconsistent queue lock"); end; else do; call process_int (level); do while (^stac (addr (fnp_info.queue_lock), pds$processid)); end; /* check the queue to see if anything came in while we had the lock */ call process_int_queue ("0"b); end; return; global_exit: /* if abort out of an internal proc */ if interrupt_entry then do; if stacq (lcte.lock, "0"b, pds$processid) /* make sure we undo anything we did */ then if lcte.notify_reqd then do; lcte.notify_reqd = "0"b; call pxss$notify (tty_ev); end; lcte.locked_for_interrupt = "0"b; end; return; /* entry to send a command to the FNP */ send_wcd: entry (a_fnpp, a_pcbp, opa, chrsa, data); dcl a_fnpp ptr, /* parameters */ a_pcbp ptr, opa fixed bin (8), data bit (*), chrsa fixed bin (8); /* numeric */ dcl tdata bit (8 * 36); /* could be up to 8 words for set_echnego_break_table */ dcl data_len fixed bin (8); pcbp = a_pcbp; go to send_join; send_global_wcd: entry (a_fnpp, opa, chrsa, data); pcbp = null (); send_join: interrupt_entry = "0"b; fnpp = a_fnpp; ttybp = addr (tty_buf$); /* get ptr to tty buf */ infop = addr (dn355_data$); /* and dn 355 info */ lctep = fnp_info.lcte_ptr; operation = opa; /* and copy op to local stack */ if ^fnp_info.running /* can't talk to it if it's not listening */ then return; no_response = "0"b; dno = fnp_info.fnp_number; mbxp = fnp_info.mbx_pt; /* get pointer to mailbox */ data_len = min (length (tdata), chrsa); /* compute bit length of command data */ if data_len > 0 then tdata = substr (data, 1, data_len); else tdata = "0"b; i = index (used_string, "0"b); /* find a free sub mbx */ if i = 0 /* no submailbox */ then do; call make_q_entry (operation, data_len, tdata); fnp_info.mbx_unavailable = fnp_info.mbx_unavailable + 1; /* form q entry element from data */ end; else do; /* we have a sub mbx, ship it off to the 355 */ subp = addr (datanet_mbx.dn355_sub_mbxes (i - 1)); /* get sub mbx addr */ if pcbp ^= null () then do; string (sub_mbx.line_number) = string (pcb.line_number); /* move line number to sub mbx */ devx = pcb.devx; end; else string (sub_mbx.line_number) = "0"b; /* unless no pcb (global call) */ sub_mbx.op_code = operation; /* set sub mbx op */ sub_mbx.cmd_data_len = divide (data_len, 6, 17, 0); /* set data length */ if operation = accept_direct_output /* if output op */ then do; if ^pcb.flags.dialed /* output without a dialup? */ then call throw_away_output; /* discard it */ else call process_send_output (i - 1, "0"b); end; else if operation = set_echnego_break_table then do; if pcb.flags.dialed then call send_echo_table (i - 1, tdata); end; else do; sub_mbx.io_cmd = wcd; /* set write control data cmd */ smbx_cmd_data_long = substr (tdata, 1, data_len); /* move command data to sub mbx */ call send_mbx (i - 1); /* ship the mbx off to the 355 */ fnp_info.output_control_transactions = fnp_info.output_control_transactions + 1; end; if no_response then call report_fnp_no_response; end; return; /* return to caller */ process_interrupt_queue: entry (x_dno); interrupt_entry = "0"b; call setup; on cleanup call check_lock; masked = "1"b; /* have to mask and wire while holding queue lock */ call pmut$wire_and_mask (wire_arg, wire_ptr); do while (^stac (addr (fnp_info.queue_lock), pds$processid)); end; queue_locked = "1"b; call process_int_queue ("1"b); return; setup: proc; ttybp = addr (tty_buf$); /* get addr of tty buffer segment */ dno = x_dno; /* copy 355 number to local stack */ infop = addr (dn355_data$); /* get address of 355 info segment */ fnpp = addr (datanet_info.per_datanet (dno)); fnp_name = fnp_info.fnp_tag; mbxp = fnp_info.mbx_pt; /* get mailbox pointer */ lctep = fnp_info.lcte_ptr; return; end setup; process_int_queue: proc (caller_masked); /* called with queue locked. Empties the queue, and must unlock it when done */ dcl caller_masked bit (1); /* indicates whether caller explicitly called pmut$wire_and_mask */ do while (dequeue (level)); fnp_info.processed_from_q = fnp_info.processed_from_q + 1; /* meter */ if ^stacq (fnp_info.queue_lock, "0"b, pds$processid) then call syserr (crash_system, "dn355: inconsistent queue lock"); queue_locked = "0"b; if caller_masked then call pmut$unwire_unmask (wire_arg, wire_ptr); masked = "0"b; call process_int (level); if caller_masked then do; /* if we unmasked, we have to mask again */ masked = "1"b; call pmut$wire_and_mask (wire_arg, wire_ptr); end; do while (^stac (addr (fnp_info.queue_lock), pds$processid)); end; queue_locked = "1"b; end; lcte.locked_for_interrupt = "0"b; if ^stacq (lcte.lock, "0"b, pds$processid) then call syserr (crash_system, "dn355: LCTE lock ^^= processid"); if ^stacq (fnp_info.queue_lock, "0"b, pds$processid) then call syserr (crash_system, "dn355: inconsistent queue lock"); queue_locked = "0"b; if caller_masked then call pmut$unwire_unmask (wire_arg, wire_ptr); masked = "0"b; if lcte.notify_reqd then do; lcte.notify_reqd = "0"b; call pxss$notify (tty_ev); end; return; dequeue: proc (a_level) returns (bit (1)); dcl a_level fixed bin; if fnp_info.level_3_pending then do; fnp_info.level_3_pending = "0"b; a_level = 3; return ("1"b); end; else if fnp_info.level_7_pending then do; fnp_info.level_7_pending = "0"b; a_level = 7; return ("1"b); end; else return ("0"b); end /* dequeue */; end /* process_int_queue */; process_int: proc (a_level); /* internal procedure to process an interrupt, either when it occurs or from the queue */ dcl a_level fixed bin; level = a_level; lcte.locked_for_interrupt = "1"b; if level = 7 then do; /* emergency interrupt */ if fnp_info.t_and_d_in_progress then do; if fnp_info.t_and_d_lev_7_occurred then return; fnp_info.t_and_d_lev_7_occurred = "1"b; t_and_d_join: if fnp_info.t_and_d_notify_requested then do; call pxss$notify (tty_ev); fnp_info.t_and_d_notify_requested = "0"b; end; unspec (auto_net_event_message) = "0"b; auto_net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; auto_net_event_message.network_type = MCS_NETWORK_TYPE; auto_net_event_message.handle = dno; auto_net_event_message.type = level; unspec (net_event_message_arg) = unspec (auto_net_event_message); call pxss$unique_ring_0_wakeup (fnp_info.boot_process_id, fnp_info.boot_ev_chan, net_event_message_arg, 0); return; end; /* figure out reason for crash according to data in mailbox header */ fault_type = datanet_mbx.crash_data.fault_code; if fault_type > hbound (dn355_messages$fault_names, 1) | fault_type < 0 then fault_name = "unknown fault"; else fault_name = dn355_messages$fault_names (fault_type); call syserr (beeper, "dn355: emergency interrupt from FNP ^a: ^a", fnp_info.fnp_tag, fault_name); if datanet_mbx.crash_data.ic ^= 0 then call syserr (just_tell, "FNP instruction counter = ^6o", datanet_mbx.crash_data.ic); if fault_type = iom_channel_fault then call syserr (just_tell, "channel ^o, fault status = ^6o", datanet_mbx.crash_data.fault_word, datanet_mbx.crash_data.iom_fault_status); else if fault_type = illegal_opcode then if dn355_word.opcode = die_code /* did 355 crash deliberately? */ then do; modulep = addr (dn355_messages$per_module); module_num = fixed (dn355_word.modnum, 4); if module_num > 0 & module_num <= hbound (dn355_modules.list_offset, 1) & dn355_word.crash_code > 0 & dn355_word.crash_code <= hbound (modulep -> message_offset, 1) then do; reasonp = ptr (modulep, dn355_modules.list_offset (module_num)); reasonp = ptr (reasonp, reasonp -> message_offset (dn355_word.crash_code)); call syserr (just_tell, "^a: ^a", dn355_modules.name (module_num), dn355_reason.msg); end; end; call report_fnp_crash; /* report it and hang up lines */ return; /* done with this interrupt */ end; /* level must be 3, a normal everyday 355 interrupt */ if fnp_info.bootloading /* if this is bootload status */ then do; call dn355_boot_interrupt (dno); /* let special routine figure it out */ return; end; if fnp_info.t_and_d_in_progress then do; if fnp_info.t_and_d_lev_3_occurred then return; fnp_info.t_and_d_lev_3_occurred = "1"b; go to t_and_d_join; end; if ^fnp_info.running /* if this interrupt is premature, ignore it */ then return; no_response = "0"b; /* initially */ if fnp_info.count > 0 /* had we had to wait for a free mbx? */ then call process_q; /* process any submailboxes which have been returned by the 355 */ timw = ldac (addr (datanet_mbx.term_inpt_mpx_wd));/* get timw and clear */ do i = 0 to 7; /* loop over submailbox indicators */ if timwb (i) & ^no_response then do; /* if mailbox was returned by 355 then we have something to do */ subp = addr (datanet_mbx.dn355_sub_mbxes (i)); /* get pointer to sub mailbox */ datanet_mbx.mbx_used_flags.used (i) = "0"b; /* clear submailbox used flag */ datanet_mbx.num_in_use = datanet_mbx.num_in_use - 1; fnp_info.cumulative_mbx_in_use = fnp_info.cumulative_mbx_in_use + datanet_mbx.num_in_use; fnp_info.mbx_in_use_updated = fnp_info.mbx_in_use_updated + 1; if sub_mbx.io_cmd = wcd then do; if sub_mbx.op_code = dump_mem | sub_mbx.op_code = patch_mem then do; fnp_info.dump_patch_in_progress = "0"b; call pxss$notify (FNP_DUMP_PATCH_EVENT); end; else if sub_mbx.op_code = report_meters then do; call get_line_number; if devx = -1 then if fnp_info.get_meters_waiting /* fnp_multiplexer is waiting for global meters */ then do; fnp_info.get_meters_waiting = "0"b; call pxss$notify (FNP_METER_EVENT); end; else ; /* copy_meters for whole FNP shouldn't arise */ else if pcb.get_meters_waiting/* waiting for channel's meters */ then do; pcb.get_meters_waiting = "0"b; call pxss$notify (FNP_METER_EVENT); end; else pcb.copied_meters_ready = "1"b; /* must be copy_meters, mark it so call side can copy them to unwired */ end; end; /* just free submbx */ else do; call get_line_number; if sub_mbx.io_cmd = wtx then do; /* check for write text */ pcb.output_mbx_pending = "0"b; dcwlptr = addr (fnp_info.dcw_list_array_ptr -> dcw_list_array (i)); chain_head_ptr = ptr (ttybp, bin (dcw_list (1).dcw_ptr, 18) - (tty_buf.absorig + dataoff)); call tty_space_man$free_chain ((pcb.devx), OUTPUT, chain_head_ptr); /* and the output chain */ if sub_mbx.command_data (1) ^= "0"b /* immediate send-output */ then call process_send_output (i, "1"b); end; else do; call syserr (beeper, "dn355: unrecognized io command ^o from FNP ^a for line ^o", sub_mbx.io_cmd, fnp_info.fnp_tag, bin (string (sub_mbx.line_number), 10)); /* complain */ call report_fnp_crash; /* act as if FNP crashed */ return; end; end; end; end; do i = 8 to 11; /* now look at FNP-initiated mailboxes */ if timwb (i) & ^no_response then do; subp = addr (datanet_mbx.fnp_sub_mbxes (i - 8)); call get_line_number; if sub_mbx.io_cmd = rcd then do; /* check for control stuff */ if (sub_mbx.op_code = accept_direct_input) | (sub_mbx.op_code = send_output) | (sub_mbx.op_code = input_in_mailbox) then do; fnp_info.bleft_355 = fnp_sub_mbx.n_free_buffers - 4; /* get the buffer count from 355 */ if fnp_info.bleft_355 < 0 then /* if above was too much correction */ fnp_info.bleft_355 = 0; /* make it safe */ if fnp_info.free_size > 16000000000 then do; fnp_info.free_size = 0; fnp_info.free_count = 0; end; fnp_info.free_size = fnp_info.free_size + fnp_info.bleft_355; fnp_info.free_count = fnp_info.free_count + 1; end; if sub_mbx.op_code = accept_direct_input | sub_mbx.op_code = input_in_mailbox then fnp_info.input_data_transactions = fnp_info.input_data_transactions + 1; else fnp_info.input_control_transactions = fnp_info.input_control_transactions + 1; if sub_mbx.op_code = accept_new_terminal then do; /* check for new terminal on line */ pcb.line_type, dialup_info.line_type = bin (sub_mbx.command_data (1), 17); if sub_mbx.command_data (2) then pcb.baud_rate = baud_table (bin (sub_mbx.command_data (2), 17)); do j = 1 to n_sync_line_types while (sync_line_type (j) ^= pcb.line_type); end; pcb.sync_line = (j <= n_sync_line_types); if ^pcb.sync_line /* asynchronous */ then bits_per_char = 10; else bits_per_char = 8; /* assumption for synchronous lines */ max_buf_chars = divide (divide (pcb.baud_rate, bits_per_char, 17, 0), buf_per_second, 17, 0); pcb.max_buf_size = min (16 * divide (max_buf_chars + 67, 64, 17, 0), 128); /* round up to multiple of 16 words */ if pcb.line_type = LINE_COLTS then pcb.max_buf_size = 128; /* COLTS channel always gets big buffers */ dialup_info.baud_rate = pcb.baud_rate; dialup_info.max_buf_size = pcb.max_buf_size; dialup_info.buffer_pad = 0; dialup_info.receive_mode_device = (dialup_info.line_type = LINE_ETX); dialup_info.pad = "0"b; pcb.dialed = "1"b; sub_mbx.op_code = terminal_accepted; /* inform 355 that term is ok */ sub_mbx.cmd_data_len = 3; /* we will put write buffer threshold in command data */ if ^pcb.high_speed /* less than 1200 baud */ then addr (sub_mbx.command_data) -> unal_number = 2; /* set low write buffer threshold */ else addr (sub_mbx.command_data) -> unal_number = 4; /* set high write buffer threshold */ sub_mbx.io_cmd = wcd; call return_mbx (i); interrupt_info = unspec (dialup_info); call channel_manager$interrupt (devx, DIALUP, interrupt_info); end; else if sub_mbx.op_code = disconnected_line then do; /* see if line just hung up */ pcb.dialed = "0"b; call throw_away_output; call channel_manager$interrupt (devx, HANGUP, ""b); call free_mbx (i); end; else if sub_mbx.op_code = wru_timeout then do; /* 355 couldn't get answerback */ if pcb.dialed then call channel_manager$interrupt (devx, WRU_TIMEOUT, ""b); call free_mbx (i); end; else if sub_mbx.op_code = break_condition then do; /* check for break */ if pcb.dialed then do; if pcb.hndlquit then call throw_away_output; call channel_manager$interrupt (devx, QUIT, ""b); end; call free_mbx (i); end; else if sub_mbx.op_code = send_output then do; /* is this request for output? */ call free_mbx (i); if pcb.dialed then call process_send_output (-1, "1"b); /* -1 indicates no current mailbox */ end; else if sub_mbx.op_code = accept_direct_input then do; /* check for input from terminal */ if pcb.dialed then call process_accept_input; else do; sub_mbx.io_cmd = wcd; /* we'll tell him to hang up */ sub_mbx.op_code = disconnect_this_line; call return_mbx (i); end; end; else if sub_mbx.op_code = error_message then do; /* error message from 355 */ offset = bin (error_msg.data (1), 18); /* get which error message this is */ if offset > 0 & offset <= hbound (dn355_messages$error_messages, 1) then do; offset = dn355_messages$error_messages (offset); /* offset of message */ reasonp = addr (dn355_messages$error_messages); /* get ptr */ reasonp = ptr (reasonp, offset); /* now we have message */ reason_msg = dn355_reason.msg; end; else reason_msg = "unrecognized error ^o ^o ^o"; do ix = 1 to 3; full_words (ix) = bin (error_msg.data (ix + 1), 18); end; call syserr (just_tell, "dn355: Message from FNP ^a: " || reason_msg, fnp_info.fnp_tag, full_words); call free_mbx (i); end; else if sub_mbx.op_code = input_in_mailbox then do; if pcb.dialed then call process_input_in_mbx; else do; sub_mbx.io_cmd = wcd; /* tell him to give up */ sub_mbx.op_code = disconnect_this_line; call return_mbx (i); end; end; else if sub_mbx.op_code >= first_acu_op_code & sub_mbx.op_code <= last_acu_op_code then do; /* acu failure */ interrupt_info = bit (bin (sub_mbx.op_code, 9)); call channel_manager$interrupt (devx, DIAL_STATUS, interrupt_info); call free_mbx (i); end; else if sub_mbx.op_code = line_status then do; /* some status from fnp */ interrupt_info = substr (unspec (sub_mbx.command_data), 1, 72); call channel_manager$interrupt (devx, LINE_STATUS, interrupt_info); call free_mbx (i); end; else if sub_mbx.op_code = ack_echnego_init then do; call free_mbx (i); call channel_manager$interrupt (devx, ACKNOWLEDGE_ECHNEGO_INIT, "0"b); end; else if sub_mbx.op_code = ack_echnego_stop then do; call free_mbx (i); call channel_manager$interrupt (devx, ACKNOWLEDGE_ECHNEGO_STOP, "0"b); end; else if sub_mbx.op_code = line_masked then do; /* see if channel was masked */ pcb.dialed, pcb.listen = "0"b; call throw_away_output; call syserr (just_tell, "dn355: FNP masked channel ^a.h^d^[0^;^]^d for excessive interrupts", fnp_info.fnp_tag, binary (sub_mbx.line_number.la_no, 3), (binary (sub_mbx.line_number.slot_no, 6) < 10), binary (sub_mbx.line_number.slot_no, 6)); call channel_manager$interrupt (devx, MASKED, ""b); call free_mbx (i); end; else do; call syserr (beeper, "dn355: unrecognized op code ^o with rcd from FNP ^a for devx ^o", sub_mbx.op_code, fnp_info.fnp_tag, devx); /* someone goofed */ call report_fnp_crash; return; end; end; else if sub_mbx.io_cmd = rtx then call process_rtx; /* check for read text */ else do; call syserr (beeper, "dn355: unrecognized io command ^o from FNP ^a for line ^o", sub_mbx.io_cmd, fnp_info.fnp_tag, bin (string (sub_mbx.line_number), 10)); /* complain */ call report_fnp_crash; /* give up on this FNP */ return; end; end; end; if ^no_response /* assuming we believe FNP is still there */ then if fnp_info.count > 0 then call process_q; if no_response /* if someone discovered that the FNP was gone */ then call report_fnp_no_response; return; end /* process_int */; process_q: proc; /* process the queue of mailbox operations that could not be performed because no mailboxes wre available */ q_first = fnp_info.cur_ptr; q_count = fnp_info.count; i = 1; /* preset while variable */ do while (q_count > 0 & i > 0); i = index (used_string, "0"b); if i > 0 /* now we can have one */ then do; subp = addr (datanet_mbx.dn355_sub_mbxes (i - 1)); qptr = ptr (ttybp, q_first); if q_entry.pcb_offset ^= "0"b /* for a specific channel */ then do; pcbp = ptr (ttybp, q_entry.pcb_offset); string (sub_mbx.line_number) = string (pcb.line_number); devx = pcb.devx; end; else string (sub_mbx.line_number) = ""b; if q_entry.opcode = accept_direct_output then if pcb.dialed then call process_send_output (i - 1, "0"b); else ; else if q_entry.opcode = set_echnego_break_table then if pcb.dialed then call send_echo_table (i - 1, q_entry.cmd_data); else ; else do; sub_mbx.io_cmd = wcd; sub_mbx.op_code = q_entry.opcode; sub_mbx.cmd_data_len = divide (q_entry.cmd_count, 6, 8, 0); smbx_cmd_data_long = substr (q_entry.cmd_data, 1, q_entry.cmd_count); call send_mbx (i - 1); fnp_info.output_control_transactions = fnp_info.output_control_transactions + 1; end; if no_response /* give up in this case */ then go to update_q_ptrs; q_first = q_entry.next; /* on to next queue entry */ q_count = q_count - 1; call tty_space_man$free_space (size (q_entry), qptr); end; else fnp_info.mbx_unavailable = fnp_info.mbx_unavailable + 1; end; update_q_ptrs: fnp_info.cur_ptr = q_first; fnp_info.count = q_count; if q_count = 0 then fnp_info.last_ptr = 0; return; end /* process_q */; /* internal subroutine to process send output */ process_send_output: proc (a_mbx_num, interrupt_entry); dcl a_mbx_num fixed bin; /* -1 indicates mailbox not already allocated */ dcl mbx_num fixed bin; dcl interrupt_entry bit (1) aligned; /* indicates whether or not called on interrupt side */ mbx_num = a_mbx_num; if pcb.end_frame | pcb.output_mbx_pending /* if we're waiting for form-feed or we got delayed */ then do; pcb.flags.send_output = "1"b; /* we'll want output eventually */ return; /* don't do anything else */ end; if pcb.write_first = 0 then do; pcb.flags.send_output = "1"b; /* if no output then just set flag */ call channel_manager$interrupt (devx, SEND_OUTPUT, ""b); end; else do; if mbx_num = -1 /* caller didn't supply one */ then do; mbx_num = index (used_string, "0"b) - 1;/* find a free one */ if mbx_num = -1 /* still? we didn't get one */ then do; call make_q_entry (accept_direct_output, 0, ""b); fnp_info.mbx_unavailable = fnp_info.mbx_unavailable + 1; return; /* we'll catch it later */ end; else do; subp = addr (datanet_mbx.dn355_sub_mbxes (mbx_num)); string (sub_mbx.line_number) = string (pcb.line_number); end; end; pcb.flags.send_output = "0"b; /* make sure flag clear */ dcwlptr = addr (fnp_info.dcw_list_array_ptr -> dcw_list_array (mbx_num)); sub_mbx.data_addr = bit (bin (bin (rel (dcwlptr), 18) + tty_buf.absorig, 18), 18); output_limit = max ( min (divide ((fnp_info.bleft_355 - tc_data$fnp_buffer_threshold) * 60, output_bpart, 17, 0), max_chain_len * 4 * (pcb.max_buf_size - 1)), 1); output_chars = 0; /* none so far */ continue = "1"b; do j = 1 to max_chain_len while (pcb.write_first ^= 0 & output_chars < output_limit & continue); /* set up dcw list */ dcw_list (j).dcw_ptr = bit (bin (pcb.write_first + dataoff + tty_buf.absorig, 18), 18); /* set dcw abs addr */ blockp = ptr (ttybp, pcb.write_first); /* get ptr to buffer */ if buffer.tally = 0 /* we don't want this in a dcw */ then call syserr (crash_system, "dn355: output buffer at ^o has zero tally", pcb.write_first); dcw_list (j).dcw_tally = bit (buffer.tally, 9); /* set dcw tally from buffer */ dcw_list (j).pad = "0"b; /* 355 depends on this */ pcb.write_first = buffer.next; /* now bump to next buffer */ pcb.write_cnt = pcb.write_cnt - buffer.tally; /* decrement count of chars in chain */ output_chars = output_chars + buffer.tally; /* keep count of characters sent */ if buffer.flags.end_of_page /* if this buffer fills a page/screen */ then do; pcb.flags.end_frame = "1"b; /* remember it */ continue = "0"b; /* terminate the loop */ end; end; chain_len = max (j - 1, 1); /* this is now the length of the chain */ sub_mbx.word_cnt = chain_len; /* we have maximum length dcw list */ sub_mbx.op_code = accept_direct_output; /* and do not have last buffer */ sub_mbx.command_data (1) = "0"b; /* make sure it starts clean */ sub_mbx.io_cmd = wtx; /* set write text io command */ pcb.output_mbx_pending = "1"b; buffer.next = 0; /* indicate end of active write block */ call send_mbx (mbx_num); /* ship sub mbx off to 355 */ fnp_info.output_data_transactions = fnp_info.output_data_transactions + 1; lcte.meters.out_bytes = lcte.meters.out_bytes + output_chars; /* meter */ if /* tree */ pcb.write_first = 0 then do; /* see if we ran out of buffers */ pcb.write_last = 0; /* zero ptr to last */ if interrupt_entry then call channel_manager$interrupt (devx, SEND_OUTPUT, ""b); /* wakeup the user */ end; else if chain_len < max_chain_len & ^pcb.flags.end_frame /* must have stopped because there wasn't enough space */ then fnp_info.fnp_space_restricted_output = fnp_info.fnp_space_restricted_output + 1; end; return; /* and return to caller */ end; /* internal subroutine to process set_echnego_break_table operation */ /* Because the echo table is 8 words long, it won't fit in a sub_mbx, so we have to send the FNP the address so it can read the table. To avoid extra storage overhead, and the necessity of freeing storage when the operation completes, the table is put in the dcw_list area corresponding to the mailbox. */ send_echo_table: procedure (mbx_num, table_bits); dcl mbx_num fixed bin; dcl table_bits bit (8 * 36); dcl table_ptr pointer; dcl bits_to_send bit (8 * 36) based; if ^pcb.dialed then return; table_ptr = addr (fnp_info.dcw_list_array_ptr -> dcw_list_array (mbx_num)); table_ptr -> bits_to_send = table_bits; sub_mbx.op_code = set_echnego_break_table; sub_mbx.io_cmd = wcd; sub_mbx.data_addr = bit (bin (bin (rel (table_ptr), 18) + tty_buf.absorig, 18), 18); sub_mbx.word_cnt = 8; call send_mbx (mbx_num); fnp_info.output_control_transactions = fnp_info.output_control_transactions + 1; return; end send_echo_table; /* internal procedure to respond to accept_input mailbox */ process_accept_input: proc; dcl tally fixed bin; dcl buf_size fixed bin; dcl prev_blockp ptr; input_count = input_sub_mbx.n_chars; /* get char count */ j = divide (input_count + 3, 4, 17, 0); /* compute number of words of circular buffer needed */ if enough_input_space (j) & pcb.read_first = 0 then do; do k = 1 to input_sub_mbx.n_buffers; tally = input_sub_mbx.dcw (k).tally; buf_size = 16 * divide (tally + 67, 64, 17, 0); /* get next higher multiple of 16 words */ call tty_space_man$get_buffer (devx, buf_size, INPUT, blockp); if blockp = null () /* couldn't get the space */ then do; if pcb.read_first ^= 0 /* if we started building a chain */ then call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, pcb.read_first)); pcb.read_first = 0; go to reject; end; if pcb.read_first = 0 then pcb.read_first = bin (rel (blockp)); else prev_blockp -> buffer.next = bin (rel (blockp)); buffer.tally = tally; input_sub_mbx.dcw (k).abs_addr = bit (bin (tty_buf.absorig + bin (rel (addr (buffer.chars))), 24), 24); /* point DCW at data portion of buffer */ prev_blockp = blockp; end; pcb.read_last = bin (rel (blockp)); sub_mbx.op_code = input_accepted; /* inform 355 that we will take input now */ sub_mbx.io_cmd = rtx; call return_mbx (i); end; else do; reject: sub_mbx.io_cmd = wcd; sub_mbx.op_code = reject_request_temp; /* inform 355 that we can not accept input at the present time */ call return_mbx (i); fnp_info.input_reject_count = fnp_info.input_reject_count + 1; call channel_manager$interrupt (devx, INPUT_REJECTED, ""b); end; end /* process_accept_input */; /* internal proc to process rtx */ process_rtx: proc; dcl real_word_cnt fixed bin; dcl n_words fixed bin; dcl buf_size fixed bin; dcl source_ptr ptr; dcl target_ptr ptr; fnp_info.input_data_transactions = fnp_info.input_data_transactions + 1; real_word_cnt = input_sub_mbx.n_chars; lcte.meters.in_bytes = lcte.meters.in_bytes + real_word_cnt; rtx_info.break_char = substr (input_sub_mbx.command_data, 18, 1); call check_ff ("0"b); /* see if input ends with a form feed */ input_count = real_word_cnt; if input_count ^= 0 /* must have been a single FF that we discarded */ then do; rtx_info.output_in_fnp = substr (input_sub_mbx.command_data, 17, 1); rtx_info.output_in_ring_0 = (pcb.write_first ^= 0); rtx_info.input_count = input_count; rtx_info.chain_head = bit (pcb.read_first, 18); rtx_info.chain_tail = bit (pcb.read_last, 18); interrupt_info = unspec (rtx_info); call channel_manager$interrupt (devx, ACCEPT_INPUT, interrupt_info); end; else call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, pcb.read_first)); pcb.read_first, pcb.read_last = 0; call free_mbx (i); return; /* and return to caller */ process_input_in_mbx: entry; /* we will copy input directly from mailbox into one buffer (if possible) */ numchars = fnp_sub_mbx.n_chars; rtx_info.break_char = substr (fnp_sub_mbx.command_data, 18, 1); call check_ff ("1"b); if numchars > 0 then do; n_words = divide (numchars + 3, 4, 17, 0); if enough_input_space (n_words) then do; buf_size = 16 * (divide (n_words + 17, 16, 17, 0)); /* get next multiple of 16 words */ call tty_space_man$get_buffer (devx, buf_size, INPUT, blockp); if blockp = null then go to not_enough_space; source_ptr = addr (fnp_sub_mbx.input_data); target_ptr = addr (buffer.chars); target_ptr -> chars = source_ptr -> chars; buffer.tally = numchars; rtx_info.output_in_fnp = substr (fnp_sub_mbx.command_data, 17, 1); rtx_info.output_in_ring_0 = (pcb.write_first ^= 0); rtx_info.input_count = numchars; rtx_info.chain_head, rtx_info.chain_tail = rel (blockp); /* only one buffer */ lcte.meters.in_bytes = lcte.meters.in_bytes + numchars; interrupt_info = unspec (rtx_info); call channel_manager$interrupt (devx, ACCEPT_INPUT, interrupt_info); call free_mbx (i); end; else do; /* space test failed */ not_enough_space: sub_mbx.io_cmd = wcd; /* tell him we can't take it */ sub_mbx.op_code = reject_request_temp; call return_mbx (i); call channel_manager$interrupt (devx, INPUT_REJECTED, ""b); end; end; else call free_mbx (i); /* nothing there except form_feed */ return; check_ff: proc (in_mbx); /* internal procedure to check input for form-feed */ dcl in_mbx bit (1); rtx_info.formfeed_present = "0"b; /* for now */ if pcb.sync_line /* form feeds not interesting in this case */ then return; if in_mbx then do; bufp = addr (fnp_sub_mbx.input_data); chars_left = numchars; end; else do; blockp = ptr (ttybp, pcb.read_last); chars_left = buffer.tally; bufp = addr (buffer.chars); end; if substr (bufp -> input_chars, chars_left, 1) = form_feed /* yup, input ends with FF */ then rtx_info.formfeed_present = "1"b; if pcb.flags.end_frame & rtx_info.break_char /* time to restart suspended output */ then do; if (chars_left <= 2) then if verify (substr (bufp -> input_chars, 1, chars_left), ff_cr_lf) = 0 then do; /* this input is just to restart output, discard it */ if in_mbx then numchars = 0; else real_word_cnt = 0; end; pcb.flags.end_frame = "0"b; if pcb.flags.send_output /* more output to ship */ then if pcb.write_first ^= 0 /* it's waiting in tty_buf */ then call make_q_entry (accept_direct_output, 0, ""b); /* we'll get to it shortly */ else call channel_manager$interrupt (devx, SEND_OUTPUT, ""b); end; end /* check_ff */; end /* process_rtx */; /* internal proc to check if this channel can have input space */ enough_input_space: proc (count) returns (bit (1)); dcl count fixed bin; lctp = tty_buf.lct_ptr; chan_lctep = addr (lct.lcte_array (devx)); return (chan_lctep -> lcte.input_words + count <= divide (tty_buf.bleft, input_bpart, 17, 0)); end /* enough_input_space */; /* internal proc to put an element onto delay queue */ make_q_entry: proc (opc, cnt, databits); dcl (opc, cnt) fixed bin (8), /* parameters */ databits bit (8 * 36); call tty_space_man$get_space (size (q_entry), new_qp); if new_qp = null then do; call syserr (crash_system, "dn355: unable to allocate block for delay queue"); return; end; new_qrel = bin (rel (new_qp)); if fnp_info.cur_ptr = 0 /* nothing in the queue yet */ then fnp_info.cur_ptr = new_qrel; else do; qptr = ptr (ttybp, fnp_info.last_ptr); q_entry.next = new_qrel; /* make the preceding entry point to the new one */ end; fnp_info.last_ptr = new_qrel; qptr = new_qp; fnp_info.count = fnp_info.count + 1; fnp_info.q_entries_made = fnp_info.q_entries_made + 1; q_entry.opcode = opc; /* set q element op code */ q_entry.cmd_count = cnt; /* and command count */ if pcbp ^= null () then q_entry.pcb_offset = rel (pcbp); else q_entry.pcb_offset = "0"b; q_entry.next = 0; q_entry.cmd_data = databits; /* move data to q element */ return; /* return to caller */ end; /* internal procedure to derive devx & PCB pointer from mailbox line number */ get_line_number: proc; dcl x fixed bin; if string (sub_mbx.line_number) = "0"b then do; /* some type of global request */ do x = 1 to hbound (global_opcodes, 1) while (sub_mbx.op_code ^= global_opcodes (x)); end; /* make sure it really is */ if x > hbound (global_opcodes, 1) then do; /* else can the FNP */ call syserr (beeper, "dn355: line number of 0 with non-global opcode in submbx ^o, FNP ^a", i, fnp_info.fnp_tag); call report_fnp_crash; go to global_exit; end; pcbp = null; devx = -1; end; else do; n_pcbs = fnp_info.no_of_channels; if string (sub_mbx.line_number) = TANDD_LINE_NUMBER /* don't decode this, go straight to it */ then pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (fnp_info.tandd_pcbx)); else do; lano = sub_mbx.line_number.la_no; /* get line adapter number for devx lookup */ if sub_mbx.is_hsla then j = fnp_info.hsla_idx (fixed (lano)); else j = fnp_info.lsla_idx (fixed (lano)); /* get starting position */ do j = j to n_pcbs; /* loop thru devx table */ pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (j)); if string (pcb.line_number) = string (sub_mbx.line_number) then go to match; /* check for right slot */ end; call syserr (beeper, "dn355: no slot number match for sub mbx ^o, FNP ^a", i, fnp_info.fnp_tag); /* bitch */ call report_fnp_crash; go to global_exit; end; match: devx = pcb.devx; /* copy devx to automatic */ end; return; end /* get_line_number */; /* internal procedure to ship sub mbx off to 355 */ send_mbx: return_mbx: proc (a_mbx_no); dcl a_mbx_no fixed bin; dcl mbx_no fixed bin; dcl pcw_error bit (1); dcl timeout_time fixed bin (71); dcl 1 ima aligned like io_manager_arg; mbx_no = a_mbx_no; go to test_pcw; free_mbx: entry (a_mbx_no); /* this for those which haven't been rewritten */ mbx_no = a_mbx_no + 4; /* use different interrupt level for freeing */ test_pcw: if ^fnp_info.io_manager_assigned then do; no_response = "1"b; /* lie, but effectively */ return; end; no_response = "0"b; if datanet_mbx.dia_pcw.command ^= "0"b then do; /* first a quick check to save time */ wait_for_response: timeout_time = clock () + TWO_SECONDS; do while ((clock () < timeout_time) & (datanet_mbx.dia_pcw.command ^= "0"b)); /* loop until dia picks up last command */ end; if datanet_mbx.dia_pcw.error | datanet_mbx.dia_pcw.command ^= "0"b then do; if ^no_response then do; pcw_error = datanet_mbx.dia_pcw.error; no_response = "1"b; datanet_mbx.dia_pcw.error = "0"b; string (datanet_mbx.dia_pcw) = dn355_util$compute_parity (string (datanet_mbx.dia_pcw)); /* recompute parity */ ima.chx = fnp_info.io_manager_chx; ima.ptp = fnp_info.ptp; call io_manager$connect_direct (ima); /* re-kick FNP */ call syserr (just_tell, "dn355: ^[Error^;Timeout^] sending mailbox interrupt to FNP ^a, will retry.", pcw_error, fnp_info.fnp_tag); goto wait_for_response; end; end; else goto send_new_connect; end; else do; send_new_connect: no_response = "0"b; if mbx_no < 8 /* one of ours */ then do; datanet_mbx.mbx_used_flags.used (mbx_no) = "1"b; datanet_mbx.num_in_use = datanet_mbx.num_in_use + 1; fnp_info.max_mbx_in_use = max (fnp_info.max_mbx_in_use, datanet_mbx.num_in_use); fnp_info.cumulative_mbx_in_use = fnp_info.cumulative_mbx_in_use + datanet_mbx.num_in_use; fnp_info.mbx_in_use_updated = fnp_info.mbx_in_use_updated + 1; end; /* set used flag */ string (datanet_mbx.dia_pcw) = initial_pcw; /* initialize pcw */ datanet_mbx.dia_pcw.mbx_no = bit (fixed (mbx_no, 6), 6); /* set sub mbx number */ string (datanet_mbx.dia_pcw) = dn355_util$compute_parity (string (datanet_mbx.dia_pcw)); /* set the parity bit; bit 22 */ ima.chx = fnp_info.io_manager_chx; ima.ptp = fnp_info.ptp; call io_manager$connect_direct (ima); /* kick 355 */ return; /* return to caller */ end; end send_mbx; /* entry and internal proc to hangup all lines on an FNP */ hangup_fnp_lines: entry (a_fnp_no); dcl a_fnp_no fixed bin; ttybp = addr (tty_buf$); infop = addr (dn355_data$); call hangup_fnp (a_fnp_no); return; hangup_fnp: proc (fnp_no); dcl fnp_no fixed bin; fnpp = addr (datanet_info.per_datanet (fnp_no)); n_pcbs = fnp_info.no_of_channels; do j = 1 to n_pcbs; pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (j)); if pcb.dialed then do; call throw_away_output; call channel_manager$interrupt ((pcb.devx), CRASH, ""b); end; end; if fnp_info.count > 0 /* get rid of any outstanding delay queue entries */ then do; q_count = fnp_info.count; q_first = fnp_info.cur_ptr; do q_count = q_count to 0 by -1 while (q_first ^= 0); qptr = ptr (ttybp, q_first); /* get real pointer to queue entry */ q_first = qptr -> q_entry.next; /* save pointer to next one */ call tty_space_man$free_space (size (q_entry), qptr); end; fnp_info.count, fnp_info.cur_ptr, fnp_info.last_ptr = 0; end; end; throw_away_output: proc; /* throws away pending write chain on quit and hangup */ if pcb.write_first ^= 0 then do; call tty_space_man$free_chain ((pcb.devx), OUTPUT, ptr (ttybp, pcb.write_first)); pcb.write_first, pcb.write_last, pcb.write_cnt = 0; end; pcb.end_frame = "0"b; return; end /* throw_away_output */; /* internal procedure to report that DIA never set PCW to 0 */ report_fnp_no_response: proc; call syserr (beeper, "dn355: FNP ^a did not respond to mailbox interrupt", fnp_info.fnp_tag); call report_fnp_crash; /* treat it like a crash */ return; end /* report_fnp_no_response */; /* internal procedure to tell initializer and clean up when FNP crashes */ report_fnp_crash: proc; fnp_info.running = "0"b; /* it isn't any more */ if fnp_info.dump_patch_in_progress /* somebody's waiting for this */ then call pxss$notify (FNP_DUMP_PATCH_EVENT); /* don't let them wait forever */ if ^fnp_info.bootloading /* if we weren't still loading it */ then /* now report hangups for all lines that were dialed to it */ call hangup_fnp (dno); else fnp_info.bootloading = "0"b; auto_fnp_msg.state = FNP_DOWN; /* tell the responsible process */ auto_fnp_msg.fnp_no = dno; auto_fnp_msg.flags = "0"b; unspec (fnp_event_message) = unspec (auto_fnp_msg); call pxss$ring_0_wakeup (fnp_info.boot_process_id, fnp_info.boot_ev_chan, fnp_event_message, 0); return; end report_fnp_crash; check_lock: proc; /* the cleanup procedure -- makes sure we don't crawl out with lock set */ if queue_locked then call syserr (crash_system, "dn355: attempted crawlout with FNP queue locked"); else if masked then call pmut$unwire_unmask (wire_arg, wire_ptr);/* it's probably too late, but just in case */ return; end check_lock; %page; /* Main program declarations */ dcl (dcwlptr, bufp, qptr) ptr, /* random pointers used */ timw fixed bin (24), /* local slot for mailbox timw */ (level, dno, i, ix, q_first, q_count, chars_left, numchars, k, j, chain_len) fixed bin, /* random halfwords used */ devx fixed bin, /* index of current channel */ operation fixed bin (8), /* local slot for delay queue operation */ lano bit (3) unal; /* local slot for line number */ dcl fnp_name char (1) aligned; /* for syserr calls */ dcl no_response bit (1) aligned; /* set by send_mbx to indicate that DIA didn't respond */ dcl interrupt_entry bit (1); /* whether entered through dn355$interrupt */ dcl input_count fixed bin; /* count sent with accept_dir_input */ dcl chan_lctep ptr; /* pointer to subchannel's LCTE */ dcl chain_head_ptr ptr; /* pointer to output chain to be freed */ dcl output_limit fixed bin; /* maximum number of output chars to be sent at once */ dcl output_chars fixed bin; /* number of output chars sent so far */ dcl bits_per_char fixed bin; dcl max_buf_chars fixed bin; /* number of characters to go in largest buffer at this speed */ dcl wire_arg fixed bin (71); dcl wire_ptr ptr; dcl masked bit (1); dcl queue_locked bit (1); dcl continue bit (1); /* for premature termination of loops */ dcl offset fixed bin; /* offset of error message in dn355_messages */ dcl syserr_severity fixed bin (35); /* Codes used for syserr are declared here because syserr_constants.incl.pl1 cannot be used, owing to a naming conflict with mcs_interrupt_info.incl.pl1. */ dcl ( dataoff init (1), /* offset in buffer of data */ max_chain_len init (16), /* maximum dcw chain length */ just_tell init (0), /* syserr message, no alarm */ beeper init (3), /* syserr ring beeper */ log init (4), crash_system init (1) ) fixed bin int static options (constant); /* argument to syserr */ dcl FNP_DOWN fixed bin int static options (constant) init (2); dcl initial_pcw bit (36) int static init ("000000000000000000000000000000111001"b); /* initial dia pcw */ dcl TANDD_LINE_NUMBER bit (10) int static options (constant) init ((10)"1"b); /* i.e., 1777 octal */ dcl TWO_SECONDS fixed bin (71) int static options (constant) init (2000000); /* used to wait for DIA to clear PCW */ dcl timwb (0:11) bit (1) based (addr (timw)), /* timw as a bit array */ used_string bit (8) based (addr (datanet_mbx.mbx_used_flags.used (0))); /* mailbox used flags as a bit string */ dcl (addr, binary, substr, stac, stacq, string, ptr, rel, index, fixed, divide, bin, max, min, null, length, bit, unspec, hbound, size, verify, clock) builtin; /* builtin functions used */ dcl unal_number fixed bin (17) unal based, /* handy way of referencing an unaligned number */ chars char (numchars) based; /* handy way of moving character strings */ dcl input_chars char (chars_left) based; /* for scanning entire input */ dcl smbx_cmd_data_long bit (216) unaligned based (addr (sub_mbx.command_data)); dcl tc_data$system_shutdown ext fixed bin; /* external variables used */ dcl tc_data$fnp_buffer_threshold ext static fixed bin; dcl pds$processid bit (36) aligned ext static; dcl ff_cr_lf char (3) int static options (constant) init (" "); dcl form_feed init (" ") char (1) int static options (constant); dcl syserr entry options (variable), /* external entries called */ ldac entry (ptr) returns (fixed bin (24)), dn355_util$compute_parity entry (bit (36)) returns (bit (36)), ( dn355_boot_interrupt, dn355_boot_interrupt$system_fault ) entry (fixed bin), pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)), pxss$unique_ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)), pxss$notify entry (fixed bin); dcl pmut$wire_and_mask entry (fixed bin (71), ptr); dcl pmut$unwire_unmask entry (fixed bin (71), ptr); dcl 1 auto_net_event_message aligned like net_event_message; dcl 1 auto_fnp_msg aligned like fnp_msg; dcl fnp_event_message fixed bin (71); dcl 1 dcw_list (max_chain_len) aligned based (dcwlptr), /* dcw list for output */ 2 dcw_ptr bit (18) unal, /* pointer to buffer */ 2 pad bit (9) unal, /* unused */ 2 dcw_tally bit (9) unal; /* tally */ dcl 1 dcw_list_array (0:7) aligned based, 2 dcw_list_template (max_chain_len) like dcw_list; dcl 1 q_entry aligned like fnp_queue_entry based (qptr); dcl new_qp ptr; /* temporary to newly-allocated block */ dcl new_qrel fixed bin; dcl 1 dn355_word unal based (addr (datanet_mbx.fault_word)), /* format of 355 crash word */ 2 modnum bit (4), /* module number (1 - 8) */ 2 opcode fixed bin (4), 2 crash_code fixed bin (8); /* used to index list of messages */ dcl fault_type fixed bin; /* 355 fault code */ dcl fault_name char (16); /* 355 fault name */ dcl module_num fixed bin; /* 355 module number */ dcl iom_channel_fault fixed bin int static init (9); dcl illegal_opcode fixed bin int static init (3); dcl die_code fixed bin int static init (9); dcl 1 error_msg aligned based (addr (sub_mbx.command_data (1))), /* error message data */ 2 data (4) bit (18) unal; dcl full_words (3) fixed bin; dcl reason_msg char (64); dcl cleanup condition; %page; %include baud_rates; %page; %include channel_manager_dcls; %page; %include dn355_data; %page; %include dn355_mailbox; %page; %include dn355_messages; %page; %include fnp_mpx_msg_; %page; %include fnp_queue_entry; %page; %include io_manager_dcls; %page; %include lct; %page; %include line_types; %page; %include mailbox_ops; %page; %include mcs_interrupt_info; %page; %include net_event_message; %page; %include pcb; %page; %include tty_buf; %page; %include tty_buffer_block; %page; %include tty_space_man_dcls; %page; /* BEGIN MESSAGE DOCUMENTATION Message: dn355: FNP X invalid interrupt level N S: $beep T: $run M: An FNP interrupt has been received from frontend X with an invalid interrupt level of octal value N and will be ignored. If this message is displayed when a DN6670 is being powered up, this message can be ignored. If this message occurs under any other circumstances, there might be something wrong with the system's interface with the FNP and should be investigated by FE representatives. A: $inform Message: dn355: emergency interrupt from FNP X: FAULT .br FNP instruction counter = IC .br channel CHN, fault status = FS .br FNP_MODULE: REASON_FOR_CRASH S: $beep T: $run M: An emergency interrupt has been received from FNP X indicating it has crashed. All lines dialed to FNP X will be hung up. The crash was nominally caused by a fault of type FAULT. Lines following the first line of the message appear only in certain cases and provide additional information about the nature of the crash. A: The system will automatically attempt to reboot the crashed FNP. Subsequent messages will indicate the success or failure of this attempt. No action is required now, but action may be required if the automatic reboot fails. Message: dn355: no slot number match for sub mbx N, FNP X S: $beeper T: $run M: An error has occurred processing submailbox N for FNP X. The submailbox indicates a line number for which no match could be found. A: $inform Message: dn355: Message from FNP X: MESSAGE S: $info T: $run M: An error has been detected by FNP X as explained by MESSAGE. A: No action is required by the operator to deal with the error mentioned in the message. Action may be required by appropriate personnel to correct the problem that caused the error and undo what the FNP may have done to continue operation. This may require shutting down the FNP for repairs by Field Engineering and reboot of the FNP to restore full operation. Message: dn355: FNP masked channel NAME for excessive interrupts S: $info T: $run M: The FNP has masked the channel whose name is NAME because it was generating interrupts faster than they could be handled. A: The interruptions can be caused by any number of problems. This can be caused by the dataset leads changing too fast for the FNP software to handle properly; disconnecting or connecting FNP cables, powering off or on a hardwired terminal, a bad modem, etc. It is also possible that the FNP channel hardware is defective. Future attempts to use this channel may possibly crash the FNP. CS representatives may need to be called to investigate. An "attach" command will be necessary to put the channel back in service. Message: dn355: unrecognized op code OPCODE with rcd from FNP X for devx N S: $beeper T: $run M: An invalid op code, OPCODE, has been received from FNP X for device index N in a mailbox containing an rcd (read control data) command. A: $inform Message: dn355: unrecognized io command C from FNP X for line N S: $beeper T: $run M: An invalid io command was received from FNP X for line N. C is the octal representation of the command. A: $inform Message: dn355: output buffer at N has zero tally S: $crash T: $run M: An output buffer with a zero tally has been found at offset N in the segment tty_buf. A: $inform Message: dn355: unable to allocate block for delay queue S: $crash T: $run M: There was insufficient space left in tty_buf to allocate a block in which to build a delay queue. A: $inform Message: dn355: FNP X did not respond to mailbox interrupt S: $beep T: $run M: An attempt to interrupt FNP X was unsuccessful. The FNP is assumed to be down. A: The system will automatically attempt to reboot the crashed FNP. Subsequent messages will indicate the success or failure of this attempt. No action is required now, but action may be required if the automatic reboot fails. Message: dn355: inconsistent queue lock S: $crash T: $run M: A process attempted to unlock the interrupt queue lock without having it locked. A: $inform Message: dn355: LCTE lock ^= processid S: $crash T: $run M: The FNP channel lock did not contain the processid of the process attempting to unlock it. Message: dn355: attempted crawlout with FNP queue locked S: $crash T: $run M: An attempt was made to crawl out while an FNP queue lock (a processor lock) was locked. A: $inform Message: dn355: line number of 0 with non-global opcode in submbx N, FNP X S: $beeper T: $run M: Mailbox N from FNP X contained a non-global opcode which requires a non-zero line number. Message: dn355: FNP X level L status S STATE S: $info T: $run M: An interrupt at a level other than 3 (or possibly at level 3 if the FNP is not running) was received from FNP X. S is an octal representation of the status accompanying the interrupt. STATE indicates the current state of the FNP: running, bootloading, or in T&D. This message only appears if tracing is enabled for the specified FNP. A: None required. Message: dn355: Error sending mailbox interrupt to FNP X, will retry. S: $info T: $run M: An error has been detected in the transmission of a mailbox interrupt to the FNP. The transmission will be retried once. A: None required. Message: dn355: Timeout sending mailbox interrupt to FNP X, will retry. S: $info T: $run M: The FNP did not respond within 2 seconds to the previously sent mailbox interrupt. The transmission will be retried once. A: None required. END MESSAGE DOCUMENTATION */ end dn355;  dn355_boot_interrupt.pl1 11/11/89 1132.7r w 11/11/89 0824.9 79146 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * 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-06-05,GJohnson), approve(86-06-05,MCR7387), audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091): Correct error message documentation. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,ifthenstmt,indnoniterend,indcomtxt */ dn355_boot_interrupt: proc (a_fnp_no); /* This procedure is called by dn355 when it receives an interrupt from an FNP * whose "bootloading" flag is on. This program interprets the bootload status * and wakes up the process that initiated the bootload to inform it of the results * of the bootload. * * Written 5/19/76 by Robert S. Coren * Modified 79 June 8 by Art Beattie to handle new config_messages. * Modified 08/26/80 by Robert Coren to ignore spurious bootload interrupts. * Modified 07/14/83 BIM to remove the $emergency entrypoint -- all * its work is done elsewhere. Also assumed that all unwiring * will be done by fnp_util$abort when called from * user ring upon notification of boot failure. * Modified 1984-07-27 BIM for system_fault entrypoint. */ /* PARAMETER */ dcl a_fnp_no fixed bin; /* AUTOMATIC */ dcl fnp_no fixed bin; dcl astep ptr; dcl fnp_tag char (1); dcl igcode fixed bin (35); dcl stat_ptr ptr; dcl major fixed bin; dcl sub_stat fixed bin; dcl event_message fixed bin (71); /* event message used to report result */ dcl offset fixed bin; /* ENTRIES */ dcl syserr options (variable); dcl pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); /* BASED */ dcl fb fixed bin (35) based; dcl 1 fnp_boot_status aligned based (stat_ptr), /* structure of bootload status */ 2 real_status bit (1) unaligned, /* must be "1"b in valid status */ 2 pad1 bit (2) unaligned, 2 major_status bit (3) unaligned, 2 pad2 bit (3) unaligned, 2 substatus fixed bin (8) unal, /* code set by 355, only interesting if major_status is 4 */ 2 channel_no fixed bin (17) unaligned; /* channel no. of LSLA in case of config error */ /* INTERNAL STATIC CONSTANTS */ dcl TELL fixed bin int static options (constant) init (0); /* code for syserr -- print on console only */ dcl BOOTLOAD_OK fixed bin int static options (constant) init (0); dcl CHECKSUM_ERROR fixed bin int static options (constant) init (1); dcl READ_ERROR fixed bin int static options (constant) init (2); dcl GICB_ERROR fixed bin int static options (constant) init (3); dcl INIT_ERROR fixed bin int static options (constant) init (4); dcl UNWIRE_STATUS fixed bin int static options (constant) init (5); dcl MAX_STATUS fixed bin int static options (constant) init (5); dcl FNP_UP fixed bin int static options (constant) init (4); dcl FNP_DOWN fixed bin int static options (constant) init (2); /* BUILTINS */ dcl (addr, bin, hbound, max, ptr, substr) builtin; /* INCLUDE FILES */ %include dn355_messages; %include dn355_data; %include dn355_mailbox; %include fnp_mpx_msg_; fnp_no = a_fnp_no; infop = addr (dn355_data$); fnpp = addr (datanet_info.per_datanet (fnp_no)); mbxp = fnp_info.mbx_pt; fnp_msg_ptr = addr (event_message); fnp_tag = fnp_info.fnp_tag; fnp_msg.fnp_no = fnp_no; stat_ptr = addr (datanet_mbx.crash_data); /* this is where bootload status goes */ if ^fnp_boot_status.real_status /* bad news, status is not for real */ then do; call syserr (TELL, "Invalid bootload interrupt for FNP ^a, status ^w", fnp_tag, stat_ptr -> fb); go to down; end; major = bin (fnp_boot_status.major_status, 3); /* get major status */ /*** BOOTLOAD_OK now comes in for WIRED fnp's, since unwiring is done by user ring in response to bootload completion, or on timeout. */ if major < 0 | major > MAX_STATUS then do; call syserr (TELL, "Unrecognized bootload status ^w for FNP ^a", stat_ptr -> fb, fnp_tag); go to down; end; if major = UNWIRE_STATUS then return; /* this was just to tell us I/O was finished */ offset = dn355_messages$boot_messages (major); /* get message describing major status */ reasonp = ptr (addr (dn355_messages$boot_messages), offset); call syserr (TELL, dn355_reason.msg, fnp_tag); if major = INIT_ERROR /* more info in this case */ then do; sub_stat = max (0, fnp_boot_status.substatus); if sub_stat > hbound (dn355_messages$config_messages, 1) then sub_stat = 0; offset = dn355_messages$config_messages (sub_stat); reasonp = ptr (addr (dn355_messages$config_messages), offset); call syserr (TELL, dn355_reason.msg, fnp_boot_status.channel_no - 9, stat_ptr -> fb); end; if major = BOOTLOAD_OK /* good news */ then do; fnp_msg.state = FNP_UP; fnp_info.running = "1"b; end; else do; /* bad news */ down: call syserr (TELL, "FNP ^a not loaded.", fnp_tag); fnp_msg.state = FNP_DOWN; end; /* now tell process that started bootload */ fnp_info.bootloading = "0"b; /* done now */ call pxss$ring_0_wakeup (fnp_info.boot_process_id, fnp_info.boot_ev_chan, event_message, igcode); return; system_fault: entry (a_fnp_no); fnp_no = a_fnp_no; infop = addr (dn355_data$); fnpp = addr (datanet_info.per_datanet (fnp_no)); mbxp = fnp_info.mbx_pt; fnp_msg_ptr = addr (event_message); fnp_tag = fnp_info.fnp_tag; fnp_msg.fnp_no = fnp_no; stat_ptr = addr (datanet_mbx.crash_data); /* this is where bootload status goes */ go to down; /* BEGIN MESSAGE DOCUMENTATION Message: Invalid bootload interrupt for FNP X, status N S: $info T: When bootloading an FNP M: The FNP responded to the bootload attempt with an interrupt, but the high-order bit of the reported status was not on. N is the reported status (in octal). A: $inform Message: Unrecognized bootload status N for FNP X S: $info T: When bootloading an FNP M: The status reported by an FNP in response to a bootload attempt was not one of the ones recognized. N is the reported status (in octal). A: $inform Message: FNP X loaded successfully S: $info T: When bootloading an FNP M: The FNP bootload has completed successfully. A: This message is for informational purposes only. Message: checksum error in core image for FNP X S: $info T: When bootloading an FNP M: The core image received for loading in the FNP had a checksum error. A: Try to load the FNP again. If the error recurs, either the DIA hardware is failing, or the core image in the Multics hierarchy is damaged. In the latter case, the core image must be rebound. Message: error reading core image for FNP X S: $info T: When bootloading an FNP M: An I/O error was detected by the FNP bootload program while attempting to read the core image into FNP memory. A hardware failure of either the DIA or the Multics IOM is indicated. A: Try the FNP load again. If it fails again, consult Field Engineering. Message: configuration error reported by bootloading program for FNP X S: $info T: When bootloading an FNP M: The FNP bootload program, gicb, found an inconsistency in the FNP configuration. A: $inform Message: configuration error reported by FNP X: DETAILS S: $info T: When bootloading an FNP M: The FNP initialization program detected an error or inconsistency in the FNP configuration. DETAILS is a more specific description of the error. A: If possible, correct the error, either by updating the CDT to reflect the actual configuration, or recabling the FNP. If the error cannot be corrected or is not understood, inform the systems programming staff. Message: FNP X not loaded. S: $info T: When bootloading an FNP M: The attempted bootload was not successful. This message is always preceded by one of the above error messages. A: This message is for informational purposes only. END MESSAGE DOCUMENTATION */ end /* dn355_boot_interrupt */;  dn355_messages.alm 11/11/89 1132.7rew 11/11/89 0825.4 76734 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** name dn355_messages segdef fault_names segdef per_module segdef error_messages segdef boot_messages segdef config_messages " " a comment 'h' after a message means it may indicate " a hardware error per_module: aci 'scheduler ' zero 0,sked_messages aci 'dia_man ' zero 0,dia_messages aci 'interpreter ' zero 0,intp_messages aci 'utilities ' zero 0,util_messages aci 'lsla_man ' zero 0,lsla_messages aci 'hsla_man ' zero 0,hsla_messages aci 'console_man ' zero 0,cons_messages aci 'trace ' zero 0,trac_messages aci 'init ' zero 0,init_messages sked_messages: zero 0,sked_1 zero 0,sked_2 dia_messages: zero 0,dia_1 zero 0,dia_2 zero 0,dia_3 zero 0,dia_4 zero 0,dia_5 zero 0,dia_6 zero 0,dia_7 zero 0,dia_8 zero 0,dia_9 zero 0,dia_10 zero 0,dia_11 zero 0,dia_12 zero 0,dia_13 zero 0,dia_14 zero 0,dia_15 zero 0,dia_16 zero 0,dia_17 zero 0,dia_18 zero 0,dia_19 zero 0,dia_20 zero 0,dia_21 zero 0,dia_22 intp_messages: zero 0,intp_1 zero 0,intp_2 zero 0,intp_3 zero 0,intp_4 zero 0,intp_5 zero 0,intp_6 zero 0,intp_7 zero 0,intp_8 zero 0,intp_9 zero 0,intp_10 zero 0,intp_11 zero 0,intp_12 zero 0,intp_13 zero 0,intp_14 zero 0,intp_15 zero 0,intp_16 zero 0,intp_17 zero 0,dia_10 util_messages: zero 0,util_1 zero 0,util_2 zero 0,util_3 zero 0,util_4 zero 0,util_5 zero 0,util_6 zero 0,intp_7 zero 0,util_8 zero 0,util_9 zero 0,util_10 zero 0,util_11 zero 0,util_12 zero 0,util_13 zero 0,util_14 lsla_messages: zero 0,lsla_1 zero 0,util_8 zero 0,util_9 zero 0,lsla_4 zero 0,lsla_5 zero 0,intp_6 zero 0,intp_7 zero 0,lsla_8 zero 0,lsla_9 zero 0,dia_10 zero 0,lsla_11 hsla_messages: zero 0,hsla_1 zero 0,hsla_2 zero 0,hsla_3 zero 0,hsla_4 zero 0,hsla_5 zero 0,hsla_6 zero 0,hsla_7 zero 0,hsla_8 zero 0,dia_10 zero 0,hsla_10 zero 0,no_message zero 0,hsla_12 zero 0,hsla_13 cons_messages: zero 0,no_message trac_messages: zero 0,dia_10 init_messages: zero 0,dia_10 zero 0,init_2 zero 0,init_3 zero 0,init_4 zero 0,init_5 zero 0,init_6 zero 0,no_message zero 0,init_8 zero 0,init_9 zero 0,init_10 zero 0,init_11 zero 0,init_12 zero 0,init_13 zero 0,init_14 zero 0,init_15 sked_1: acc 'no buffers for delay queue' sked_2: acc 'attempt to run missing routine' dia_1: acc 'mailbox wraparound queue full' dia_2: acc 'unrecoverable i/o error' h dia_3: acc 'more than 5 consecutive i/o errors' h dia_4: acc 'invalid value for tcw' dia_5: acc 'mailbox queue count < 0' dia_6: acc 'invalid mailbox number in wraparound queue' dia_7: acc '3 consecutive mailbox checksum errors' h dia_8: acc 'op-code not valid for i/o command' dia_9: acc 'rcd processed with no queue entries' dia_10: acc 'buffer allocation failed' dia_11: acc 'last buffer in input chain lacks "last" flag' dia_12: acc 'tally for rtx too small' dia_13: acc 'tally for rtx too large' dia_14: acc 'attempt to lock already locked dia' dia_15: acc 'attempt to unlock already unlocked dia' dia_16: acc 'rtx in mailbox, next queue element not accept input' dia_17: acc 'unrecognized i/o command' dia_18: acc 'no dia configured' dia_19: acc 'accept input when no input chain' dia_20: acc 'attempt to chain to invalid output chain' dia_21: acc 'input buffer had zero tally' dia_22: acc 'no entry for line in tib list' intp_1: acc 'x1 = 0 at entry' intp_2: acc 't.cur = 0 at entry' intp_3: acc 'called when not at wait block' intp_4: acc 'type not of form 777xxx' intp_5: acc 'tried to execute status block' intp_6: acc 'unrecognized sub-op in dcw list' intp_7: acc 'outmsg not followed by output_end' intp_8: acc 'unrecognized op block' intp_9: acc 'started block check while check in progress' intp_10: acc 'compare block check without start block check' intp_11: acc 'unrecognized scan type' intp_12: acc 't.type <= 0' intp_13: acc 'error in use of calsub, retsub op blocks' intp_14: acc 'error in use of getext, retext op blocks' intp_15: acc 'error in scan control string' intp_16: acc 'invalid sub-op list to config op' intp_17: acc 'replay attempted with active output chain' util_1: acc 'buffer of size <= 0 requested' util_2: acc 'buffer of more than max size requested' util_3: acc 'tried to free buffer with address < .crbuf' util_4: acc 'tried to free space already free' util_5: acc 'address in block pointer too large' util_6: acc 'invalid interrupt vector' util_8: acc 'kybd/prtr addressing with control set' util_9: acc 'unrecognized type in output sub-op' util_10: acc 'could not allocate buffer for output' util_11: acc 't.olst -> buffer has forward pointer' util_12: acc 'free block size too large' util_13: acc 'attempt to append output to single-message chain' util_14: acc 'attempt to move data with an invalid address' hsla_1: acc 'attempt to modify loc < 1000(8)' hsla_2: acc 'config op is invalid for channel' hsla_3: acc 'read tally started with active input chain' hsla_4: acc 'receive transfer timing error' h hsla_5: acc 'input tally runout' hsla_6: acc 'unable to find cct for modes requested' hsla_7: acc 'xmit transfer timing error' h hsla_8: acc 'hdcw called with no dcw list' hsla_10: acc 'no sfcm addr for line' hsla_12: acc 'houtav called with bad chain' hsla_13: acc 'invalid hsla status' lsla_1: acc 'not in xmit mode after output sub-op' lsla_4: acc 'more than 10 successive re-sync attempts' lsla_5: acc 'send transfer timing error' h lsla_8: acc 'unrecognized receive status' lsla_9: acc 'input icw status does not agree with flag' lsla_11: acc 'output icw status does not agree with flag' no_message: acc 'unrecognized error code' fault_names: aci 'none ' aci 'power on ' aci 'memory parity ' aci 'illegal opcode ' aci 'overflow ' aci 'store fault ' aci 'divide check ' aci 'illegal int ' aci 'extraneous int ' aci 'iom chan fault ' aci 'console abort ' error_messages: zero 0,msg1 zero 0,msg2 zero 0,msg3 zero 0,msg4 zero 0,msg5 zero 0,msg6 zero 0,msg7 zero 0,msg8 zero 0,msg9 zero 0,msg10 msg1: acc 'FNP iom channel fault, channel ^o, fault status ^6w' h msg2: acc 'dia i/o error, status ^6w ^6w' h msg3: acc 'abnormal lsla status ^6w ^6w' h msg4: acc 'excessive hsla interrupts, line ^o, attempting recovery' h msg5: acc 'trouble synchronizing lsla ^o, some lines may not answer' h msg6: acc 'runaway hsla subchannel, line ^o, masking subchannel' h msg7: acc 'unrecognized error code' msg8: acc 'unrecognized error code' msg9: acc 'unrecognized error code' msg10: acc 'unrecognized error code' boot_messages: zero 0,boot_ok zero 0,boot_checksum zero 0,boot_read_err zero 0,boot_gicb_err zero 0,boot_config_err boot_ok: acc 'FNP ^a loaded successfully' boot_checksum: acc 'checksum error in core image for FNP ^a' boot_read_err: acc 'error reading core image for FNP ^a' boot_gicb_err: acc 'configuration error reported by bootloading program for FNP ^a' boot_config_err: acc 'configuration error reported by FNP ^a:' config_messages: zero 0,bad_init zero 0,bad_init zero 0,init_2 zero 0,init_3 zero 0,init_4 zero 0,init_5 zero 0,bad_init zero 0,bad_init zero 0,init_8 zero 0,init_9 zero 0,init_10 zero 0,init_11 zero 0,init_12 zero 0,init_13 zero 0,init_14 zero 0,init_15 init_2: acc 'timer channel not enabled' init_3: acc 'more than one dia configured' init_4: acc 'dia does not exist' init_5: acc 'dia did not respond' init_6: acc 'invalid baud rate specified' init_8: acc 'core image specifies more memory than physically present' init_9: acc 'lsla ^o illegal sync speed' init_10: acc 'lsla ^o failed ten times to init' init_11: acc 'lsla ^o speed not equal desired speed' init_12: acc 'timer switch incorrectly set' init_13: acc 'lsla ^o, actual config does not match CDT' init_14: acc 'pager is disabled or inoperative' init_15: acc 'unable to allocate trace buffer' bad_init: acc 'unrecognized config status ^s^w' end  dn355_util.alm 11/11/89 1132.7rew 11/11/89 0825.4 12888 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " dn355_util: stuff for dn355 best done in ALM. " " compute_parity: compute odd parity on word supplied " by caller (pcw) and set bit 22 in the word " if necessary to make odd parity " " " Created for new tty DIM on 01/13/75 by Mike Grady. " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " name dn355_util " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " COMPUTE_PARITY ENTRY " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " segdef compute_parity compute_parity: lda ap|2,* get word to compute parity on gtb 0 calculate parity on it ana 1,dl test for odd or even tnz 3,ic odd lda =o020000,dl set parity bit (bit 22) orsa ap|4,* .. short_return end  fnp_multiplexer.pl1 11/11/89 1132.7r w 11/11/89 0825.4 546093 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ fnp_multiplexer: proc; /* This is the called multiplexer module for FNP channels. It calls dn355 * to pass mailboxes on to the FNP. Important data structures are: * fnp_info (in dn355_data) : info about the FNP as a whole * pcb (physical channel block) : allocated in tty_buf. Contains per-channel info * */ /* Written 08/15/78 by Robert Coren */ /* Modified 04/11/79 by Robert Coren to handle all modes at once */ /* Modified 06/29/79 by Bernard Greenberg for FNP echo negotiation */ /* Modified 79 Aug 21 by Art Beattie to support 64K DN6670s. */ /* Modified various times in 1980 by Robert Coren to add metering */ /* Modified May 1981 by Robert Coren to keep get_meters order from using user-supplied pointer while FNP channel is locked */ /* Modified late summer 1981 by Robert Coren to handle tandd_attach order and COLTS channel */ /* Modified fall 1981 by Robert Coren to assign smaller buffer sizes */ /* Modified November 1981 by Robert Coren to fix bug whereby terminate_multiplexer didn't initialize ttybp */ /* Modified June 1982 by Robert Coren to correct precision of FNP addresses. */ /* Modified November 1983 by Robert Coren to make priv_control check the pointer set by get_fnp_meters */ /* Modified 83-12-16 BIM for io_manager calls */ /* Modified 84-05-18 BIM for correction to ioa_ strings */ /* Modified 1984-08-02 BIM for bug in shutdown_mpx handling of booting fnp */ /* Modified 1984-09-25 BIM for paged mode fnp load. (page table filling) */ /* Modified September 1984 by Robert Coren to free copied meters in terminate_multiplexer and to exit loop in send_global if FNP is down */ /* Modified November 1984 by Robert Coren to zero pad fields in copied meters so random junk from the FNP doesn't get left in tty_area */ /* Modified November 1984 by Robert Coren to use tty_area_manager to allocate and free saved meters */ /****^ HISTORY COMMENTS: 1) change(86-04-23,Coren), approve(86-04-23,MCR7300), audit(86-06-19,Beattie), install(86-07-08,MR12.0-1089): To process 256-bit echo negotiation break tables. 2) change(86-12-12,Beattie), approve(86-12-17,MECR0005), audit(86-12-12,Brunelle), install(86-12-17,MR12.0-1250): Declare an argument in call to fnp_util$free_page_table to accept the error code being returned. (phx20712) 3) change(86-12-12,Beattie), approve(86-12-29,MCR7598), audit(87-01-07,Brunelle), install(87-01-12,MR12.0-1268): Declare an argument in call to fnp_util$free_page_table to accept the error code being returned. (phx20712) END HISTORY COMMENTS */ %page; /* PARAMETERS */ dcl a_devx fixed bin; /* devx of FNP channel */ dcl a_init_info_ptr ptr; dcl a_fnpp ptr; dcl a_subchan fixed bin; dcl a_chainp ptr; dcl a_mi_flag bit (1) aligned; dcl a_code fixed bin (35); dcl a_output_ptr ptr; dcl a_order char (*); dcl a_data_ptr ptr; dcl a_mode_list_ptr ptr; dcl a_modes char (*); /* AUTOMATIC */ dcl code fixed bin (35); /* standard system error code */ dcl devx fixed bin; /* of FNP channel */ dcl my_chan_name char (1); dcl dno fixed bin; /* FNP number */ dcl pcb_space fixed bin; dcl space_needed fixed bin; dcl output_ptr ptr; /* pointer to caller's output data */ dcl chanx fixed bin; /* index of PCB */ dcl output_length fixed bin; /* number of output characters */ dcl sourcep ptr; dcl (i, j) fixed bin; dcl lastp ptr; /* pointer to last buffer in already-exisitng chain */ dcl order char (32); dcl data_ptr ptr; /* pointer to order info structure */ dcl set_write_status bit (1); dcl locked bit (1); dcl old_mask fixed bin (71); dcl mask_ptwp ptr; dcl queue_locked bit (1); dcl mylock bit (1); dcl opcode fixed bin (8); /* mailbox opcode */ dcl alter_type fixed bin (8); /* alter parameters subop */ dcl check bit (1); dcl mbx_data_len fixed bin; /* in bits */ dcl mbx_data bit (4 * 36) based (addr (mbx_data_long)); dcl mbx_data_long bit (8 * 36); dcl alter_data bit (4 * 36) varying; dcl dumpin bit (1); dcl dumpout bit (1); dcl get_meters bit (1); dcl temp_saved_meters_ptr ptr; dcl meter_ptr ptr; dcl lcmp ptr; dcl fnp_meters_ptr ptr; dcl ret_meters_ptr ptr; dcl local_line_type fixed bin; dcl phone_no_len fixed bin; /* in bits */ dcl phone_digits (32) bit (6); dcl next_digit fixed bin (6) unsigned; /* value of next dialout digit */ dcl digit_pos fixed bin; /* how far along we are in phone number */ dcl opend bit (1); /* whether or not output is pending */ dcl modex fixed bin; dcl mode_name char (8); dcl mode_on bit (1); /* mode to be turned on or off */ dcl mode_set (36) bit (1); dcl hndlquit_set bit (1); dcl base_len fixed bin; dcl block_len fixed bin; dcl chars_per_buf fixed bin; dcl chars_per_sec fixed bin; dcl wire_arg fixed bin (71); dcl wire_ptr ptr; dcl hsla_flag bit (1); dcl old_flag bit (1); dcl pcb_space_ptr ptr; dcl prev_la_no fixed bin; dcl la_no fixed bin; dcl subchan fixed bin; dcl his_fnp_no fixed bin; /* FNP number in supplied channel name */ dcl pcbx fixed bin; dcl found bit (1); dcl past bit (1); dcl n_fnp_words fixed bin; dcl ignore bit (1); dcl name char (32); dcl temp_addr fixed bin; dcl fnp_dump_ptr ptr; dcl dump_patch_space fixed bin; /* amount of space required by an fnp_(dump patch) order */ dcl dump_patch_time fixed bin (71); /* clock time when a dump or patch order was initiated */ dcl 1 dump_fnp_data aligned, /* command data for dump_fnp & patch_fnp */ 2 abs_addr fixed bin (24), /* absolute address of ring-zero buffer */ 2 fnp_addr fixed bin (18) unsigned unaligned, /* address in FNP */ 2 fnp_len fixed bin (18) unsigned unaligned; /* number of 18-bit words */ dcl 1 fnp_break_data aligned, /* command data for fnp_break order */ 2 lineno fixed bin (17) unal, /* line number, derived from tty name */ 2 fnp_addr fixed bin (18) unsigned unal, 2 action fixed bin (17) unal, 2 flags bit (18) unal; dcl 1 echnego_break_table aligned, 2 words (0:15) unaligned, 3 bits bit (16) unaligned, 3 pad bit (2) unaligned; /* BASED */ dcl based_fb_word fixed bin based; dcl based_bit1 bit (1) based; dcl based_bit2 bit (2) based; dcl based_bit18 bit (18) based; dcl based_bit72 bit (72) based; dcl based_bit108 bit (108) based; dcl based_echo_table_bits bit (WIRED_ECHO_BREAK_SIZE + 1) based; dcl fnp_data (n_fnp_words) bit (18) based; dcl phone_chars char (32) varying based; /* phone number passed with dial_out order */ dcl 1 wr_stat aligned based, /* for write_status */ 2 ev_chan fixed bin (71), 2 output_pending bit (1); dcl 1 rd_stat aligned based, /* for read_status */ 2 ev_chan fixed bin (71), 2 input_available bit (1); dcl 1 dump_fnp_info based (data_ptr) aligned, /* structure passed for dump_fnp and patch_fnp */ 2 fnp_address fixed bin (24), 2 fnp_len fixed bin, /* number of 18=bit words */ 2 bufp ptr, /* pointer to caller's buffer */ 2 old_value_ptr ptr; /* pointer to previous values (patch only) */ dcl 1 fnp_break_info aligned based (data_ptr), /* structure passed on fnp_break order */ 2 chan_name char (6), /* tty name, optional */ 2 fnp_addr fixed bin, /* addr in fnp to set break */ 2 action fixed bin, /* request type */ 2 flags bit (36); /* special action flags */ dcl 1 echo_start_data aligned based (data_ptr), /* Echo starting data */ 2 ctr fixed bin (35), /* Synchronization counter */ 2 screenleft fixed bin (35); /* Length left on screen */ /* BUILTINS & CONDITIONS */ dcl (addr, addrel, bin, bit, clock, divide, hbound, length, null, ptr, rel, rtrim, size, stac, stacq, string, substr, unspec) builtin; dcl area condition; /* ENTRIES */ dcl pxss$notify entry (fixed bin); dcl dn355$send_wcd entry (ptr, ptr, fixed bin (8), fixed bin, bit (*)); dcl dn355$send_global_wcd entry (ptr, fixed bin (8), fixed bin, bit (*)); dcl dn355$hangup_fnp_lines entry (fixed bin); dcl dn355$process_interrupt_queue entry (fixed bin); dcl dn355$interrupt entry; dcl fnp_util$fill_page_table entry (fixed bin, fixed bin (35)); dcl fnp_util$free_page_table entry (fixed bin, fixed bin (35)); dcl fnp_util$unwire entry (fixed bin, fixed bin (35)); dcl tty_lock$lock_lcte entry (ptr, fixed bin (35)); dcl tty_area_manager$allocate entry (fixed bin, ptr); dcl tty_area_manager$free entry (fixed bin, ptr); dcl lock$lock_fast entry (pointer); dcl lock$unlock_fast entry (pointer); dcl syserr entry options (variable); dcl syserr$error_code entry options (variable); dcl parse_tty_name_ entry (char (*), fixed bin, bit (1), fixed bin, fixed bin); dcl parse_fnp_name_ entry (char (*), fixed bin); dcl pxss$addevent entry (fixed bin); dcl pxss$delevent entry (fixed bin); dcl pxss$wait entry; /* EXTERNAL STATIC */ dcl ( error_table_$noalloc, error_table_$undefined_order_request, error_table_$bad_mode, error_table_$bad_channel, error_table_$buffer_big, error_table_$invalid_write, error_table_$dev_offset_out_of_bounds, error_table_$seglock, error_table_$mpx_down, error_table_$timeout, error_table_$unimplemented_version, error_table_$no_channel_meters, error_table_$resource_not_free, error_table_$io_assigned, error_table_$io_not_assigned, error_table_$io_not_configured, error_table_$io_not_available, error_table_$invalid_state ) ext static fixed bin (35); dcl pds$processid ext static bit (36) aligned; dcl pds$process_group_id ext static char (32) aligned; /* INTERNAL STATIC */ /* The following are declared here because syserr_constants.incl.pl1 cannot be used, owing to a naming conflict with mcs_interrupt_info.incl.pl1. */ dcl ANNOUNCE fixed bin internal static options (constant) init (0); dcl CRASH_SYSTEM fixed bin internal static options (constant) init (1); dcl DCW_LIST_SIZE fixed bin int static options (constant) init (16); dcl DUMP_PATCH_LIMIT fixed bin (35) int static options (constant) init (10000000); /* i.e., 10 seconds */ /* The following facts about the the lists of modes below are IMPORTANT. * The modes which have corresponding alter_parameters subtypes are the same as the modes * that are valid for asynchronous lines only, and no data is associated with the * alter_parameters other than on/off, with the following exceptions: * blk_xfer and iflow require additional data (buffer sizes) * hndlquit is valid for any line, but is expressed by alter_parameters * * Therefore, hndlquit is handled explicitly, and blk_xfer and iflow must come after those modes having alter_paramters * subop types. Anyone modifying these lists should be aware of this circumstance. */ dcl good_modes (1) char (8) int static options (constant) /* modes recognized for all lines */ init ("hndlquit"); dcl async_only_modes (15) char (8) int static options (constant) /* modes recognized for async lines only */ init ("crecho", "tabecho", "lfecho", "echoplex", "fulldpx", "replay", "polite", "breakall", "prefixnl", "no_outp", "8bit", "oddp", "oflow", "iflow", "blk_xfer"); dcl IFLOW_INDEX fixed bin internal static options (constant) init (14); dcl BLK_XFER_INDEX fixed bin internal static options (constant) init (15); dcl full_dpx_modes (7) char (8) int static options (constant) /* modes requiring full duplex line type */ init ("crecho", "tabecho", "lfecho", "echoplex", "fulldpx", "iflow", "oflow"); dcl mode_alter_types (13) fixed bin (8) int static options (constant) /* alter_paramters subops corresponding to modes */ init (8, /* crecho */ 14, /* tabecho */ 9, /* lfecho */ 20, /* echoplex */ 3, /* fulldpx */ 23, /* replay */ 24, /* polite */ 27, /* breakall */ 28, /* prefixnl */ 33, /* no_outp */ 32, /* 8bit */ 31, /* oddp */ 30); /* oflow */ /* INCLUDE FILES */ %page; %include tty_buf; %page; %include tty_buffer_block; %page; %include lct; %page; %include dn355_data; %page; %include pcb; %page; %include mailbox_ops; %page; %include tty_space_man_dcls; %page; %include line_types; %page; %include mux_init_info; %page; %include io_chnl_util_dcls; %include mcs_modes_change_list; %include flow_control_info; %include channel_manager_dcls; %include mcs_interrupt_info; %include fnp_meters; %include fnp_channel_meters; %include get_comm_meters_info; %include io_manager_dcls; %include mcs_echo_neg_sys; init_multiplexer: entry (a_devx, a_init_info_ptr, a_fnpp, a_code); /* This entry is called to initialize data bases preparatory to loading an FNP * In particular, it initializes the appropriate entry in fnp_info, and allocates * and initializes PCBs */ devx = a_devx; miip = a_init_info_ptr; mii_chan_count = mux_init_info.no_channels; pcb_space_ptr = null (); /* make cleanup safe */ infop = addr (dn355_data$); ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; lcntp = lct.lcnt_ptr; /* get channel name */ if length (rtrim (lcnt.names (devx))) ^= 1 then go to bad_channel; my_chan_name = rtrim (lcnt.names (devx)); call parse_fnp_name_ (my_chan_name, dno); if dno < 0 /* unreasonable name */ then do; bad_channel: a_code = error_table_$bad_channel; go to init_exit; end; fnpp = addr (datanet_info.per_datanet (dno)); call TRACE ("init_multiplexer"); /* only error trace if bad devx */ if my_chan_name ^= fnp_info.fnp_tag then go to bad_channel; if ^tty_buf.fnp_config_flags (dno) then go to bad_channel; call lock$lock_fast (addr (datanet_info.configuration_lock)); /* noone else can configure */ fnp_info.lcte_ptr = addr (lct.lcte_array (devx)); if fnp_info.t_and_d_in_progress /* lcte will be invalid, but still */ then do; code = error_table_$io_not_available; go to init_abort; end; call assign_channel (code); /* under config lock */ if code ^= 0 then go to init_abort; /* it may have been deconfigured while we were farting around */ call fnp_util$fill_page_table ((fnp_info.fnp_number), code); if code ^= 0 then go to init_abort; /* IOI has problems? */ do i = 0 to 2; /* initialize line-number indexes */ fnp_info.hsla_idx (i) = -1; fnp_info.lsla_idx (i) = -1; end; do i = 3 to 5; /* 3 more for LSLAs */ fnp_info.lsla_idx (i) = -1; end; pcb_space = size (pcb) * mii_chan_count; /* get enough space for an array of PCBs */ space_needed = pcb_space + 8 * DCW_LIST_SIZE; call tty_space_man$get_space (space_needed, pcb_space_ptr); if pcb_space_ptr = null /* this would be unfortunate */ then do; a_code = error_table_$noalloc; go to init_abort; end; n_pcbs, fnp_info.no_of_channels = mii_chan_count; pcb_space_ptr -> pcb_array (*).saved_meters_ptr = null (); /* for cleanup */ fnp_info.pcb_array_ptr = pcb_space_ptr; fnp_info.dcw_list_array_ptr = addrel (pcb_space_ptr, pcb_space); string (fnp_info.flags) = "0"b; prev_la_no = -1; /* so test will work right the first time */ old_flag = "1"b; /* HSLA channels (if any) are always first */ /* * The following code assigns line numbers and sets the adapter indexes * It assumes that channels in mux_init_info are sorted in ascending order */ do pcbx = 1 to n_pcbs; pcbp = addr (pcb_space_ptr -> pcb_array (pcbx)); unspec (pcb) = "0"b; pcb.saved_meters_ptr = null (); /* for cleanup dept */ pcb.devx = mux_init_info.channels (pcbx).devx; lctep = addr (lct.lcte_array (pcb.devx)); lcte.subchannel = pcbx; name = mux_init_info.channels (pcbx).name; call parse_tty_name_ (name, his_fnp_no, hsla_flag, la_no, subchan); if his_fnp_no ^= dno then do; code = error_table_$bad_channel; go to init_abort; end; if la_no = 7 then fnp_info.tandd_pcbx = pcbx; else if (la_no ^= prev_la_no | hsla_flag ^= old_flag) /* first subchannel on this adapter */ then do; if hsla_flag then fnp_info.hsla_idx (la_no) = pcbx; else fnp_info.lsla_idx (la_no) = pcbx; prev_la_no = la_no; old_flag = hsla_flag; end; pcb.subchan = subchan; pcb.is_hsla = hsla_flag; pcb.la_no = bit (bin (la_no, 3), 3); if hsla_flag then pcb.slot_no = bit (bin (subchan, 6), 6); /* * lsla slot number has to wait for baud rate supplied at bootload time */ on area begin; code = error_table_$noalloc; go to init_abort; end; call tty_area_manager$allocate (size (fnp_channel_meters), temp_saved_meters_ptr); pcb.saved_meters_ptr = temp_saved_meters_ptr; end; call lock$unlock_fast (addr (datanet_info.configuration_lock)); a_fnpp = fnpp; /* pass this back */ a_code = 0; init_exit: return; init_abort: call TRACE_ERROR ("init_multiplexer", code); call lock$unlock_fast (addr (datanet_info.configuration_lock)); if pcb_space_ptr ^= null then do; do pcbx = 1 to n_pcbs; pcbp = addr (pcb_space_ptr -> pcb_array (pcbx)); if pcb.saved_meters_ptr ^= null () then call tty_area_manager$free (size (fnp_channel_meters), (pcb.saved_meters_ptr)); end; call tty_space_man$free_space (space_needed, pcb_space_ptr); end; a_code = code; return; terminate_multiplexer: entry (a_fnpp, a_code); /* This entry is called after FNP crash or shutdown in order to free PCBs */ fnpp = a_fnpp; ttybp = addr (tty_buf$); infop = addr (dn355_data$); locked = "0"b; call TRACE ("terminate_multiplexer"); call lock; if code ^= 0 then go to terminate_return; if fnp_info.bootloading | fnp_info.wired | fnp_info.running /* bad time to terminate */ then code = error_table_$invalid_state; else do; do i = 1 to fnp_info.no_of_channels; pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (i)); if pcb.write_first ^= 0 then call tty_space_man$free_chain ((pcb.devx), OUTPUT, ptr (ttybp, pcb.write_first)); if pcb.read_first ^= 0 then call tty_space_man$free_chain ((pcb.devx), INPUT, ptr (ttybp, pcb.read_first)); call tty_area_manager$free (size (fnp_channel_meters), (pcb.saved_meters_ptr)); if pcb.copied_meters_offset ^= 0 /* free this if it's there */ then do; call tty_space_man$free_space (size (fnp_channel_meters), ptr (ttybp, pcb.copied_meters_offset)); pcb.copied_meters_offset = 0; end; end; string (fnp_info.flags) = "0"b; call tty_space_man$free_space (size (pcb) * fnp_info.no_of_channels + 8 * DCW_LIST_SIZE, fnp_info.pcb_array_ptr); fnp_info.pcb_array_ptr = null; code = 0; end; if fnp_info.io_manager_assigned then call unassign_channel (code); /* not deconfigured on us */ call fnp_util$free_page_table ((fnp_info.fnp_number), (0)); /* even if we lost the assignment ... */ call unlock; terminate_return: if code ^= 0 then call TRACE_ERROR ("terminate_multiplexer", code); a_code = code; return; start: entry (a_fnpp, a_code); /* entry to enable an FNP by sending "accept_calls" order */ fnpp = a_fnpp; infop = addr (dn355_data$); call TRACE ("start"); chanx = 1; /* this is irrelevant, but will make setup happy */ call setup; if code = 0 then do; call dn355$send_global_wcd (fnpp, accept_calls, 18, bit (bin (bin (rel (addr (tty_buf.free_space)), 18) + tty_buf.absorig, 18), 18)); call unlock; /* setup locked */ end; if code ^= 0 then call TRACE_ERROR ("start", code); a_code = code; return; stop: entry (a_fnpp, a_code); /* entry to disable an FNP from further dialups (by sending dont_accept_calls order) */ fnpp = a_fnpp; infop = addr (dn355_data$); call TRACE ("stop"); chanx = 1; /* as for start entry */ call setup; if code = 0 then do; call dn355$send_global_wcd (fnpp, dont_accept_calls, 0, ""b); call unlock; /* setup locked */ end; if code ^= 0 then call TRACE_ERROR ("stop", code); a_code = code; return; shutdown: entry (a_fnpp, a_code); /* This entry simulates an FNP crash; if the FNP is up, all lines will be hung up */ infop = addr (dn355_data$); fnpp = a_fnpp; if fnpp = null () then do; if datanet_info.trace then call syserr (ANNOUNCE, "fnp_multiplexer$shutdown: Called with null fnp_ptr"); go to shutdown_return; end; call TRACE ("shutdown"); infop = addr (dn355_data$); if fnp_info.wired | fnp_info.bootloading /* do the user ring a favor */ then do; if datanet_info.trace then call syserr (ANNOUNCE, "fnp_multiplexer$shutdown: Called with FNP wired."); call fnp_util$unwire ((fnp_info.fnp_number), code); if code ^= 0 then call syserr$error_code (ANNOUNCE, code, "fnp_multiplexer$shutdown: Failed to unwire fnp."); end; locked = "0"b; if fnp_info.running /* if it's up now */ then do; call lock; call dn355$hangup_fnp_lines ((fnp_info.fnp_number)); fnp_info.running = "0"b; call unlock; end; shutdown_return: a_code = 0; return; read: entry (a_fnpp, a_subchan, a_chainp, a_mi_flag, a_code); /* this is a dummy entry, dn355 never holds input at interrupt time */ a_chainp = null; a_mi_flag = "0"b; a_code = 0; return; write: entry (a_fnpp, a_subchan, a_output_ptr, a_code); fnpp = a_fnpp; chanx = a_subchan; output_ptr = a_output_ptr; call setup; if code ^= 0 then do; a_code = code; return; end; /* figure out length of chain */ blockp = output_ptr; output_length = buffer.tally; /* to start with */ do while (buffer.next ^= 0); blockp = ptr (ttybp, buffer.next); output_length = output_length + buffer.tally; end; if pcb.write_last ^= 0 /* existing write chain */ then do; lastp = ptr (ttybp, pcb.write_last); lastp -> buffer.next = bin (rel (output_ptr)); end; else pcb.write_first = bin (rel (output_ptr)); pcb.write_last = bin (rel (blockp)); /* in any case */ pcb.write_cnt = pcb.write_cnt + output_length; if pcb.send_output /* if the FNP is ready for it */ then call dn355$send_wcd (fnpp, pcbp, accept_direct_output, 0, ""b); code = 0; write_exit: call unlock; if code = 0 then a_output_ptr = null (); /* so caller will know we took it all */ a_code = code; return; control: entry (a_fnpp, a_subchan, a_order, a_data_ptr, a_code); fnpp = a_fnpp; chanx = a_subchan; order = a_order; data_ptr = a_data_ptr; dumpin, dumpout, set_write_status, get_meters = "0"b; /* initialize local variables */ opcode, alter_type = -1; check = "0"b; if order = "read_status" /* there's never any at this level */ then do; data_ptr -> rd_stat.input_available = "0"b; a_code = 0; return; end; else if order = "hangup" then do; mbx_data_len = 0; mbx_data = ""b; opcode = disconnect_this_line; end; else if order = "wru" then do; alter_type = Wru; alter_data = ""b; end; else if order = "interrupt" then do; alter_type = Break; alter_data = ""b; end; else if order = "start_xmit_hd" | order = "stop_xmit_hd" then do; alter_type = Xmit_hold; alter_data = "00000000"b || (order = "start_xmit_hd"); end; else if order = "set_input_message_size" then do; mbx_data = bit (bin (data_ptr -> based_fb_word, 18), 18); opcode = sync_msg_size; end; else if order = "line_control" then do; mbx_data_len = 72; mbx_data = data_ptr -> based_bit72; opcode = line_control; end; else if order = "set_framing_chars" then do; mbx_data_len = 18; mbx_data = data_ptr -> based_bit18; /* two characters are packed in halfword */ opcode = set_framing_chars; end; else if order = "set_delay" then do; mbx_data_len = 108; mbx_data = data_ptr -> based_bit108; /* 6 18-bit values */ opcode = set_delay_table; end; else if order = "abort" /* i.e., resetread or resetwrite */ then do; dumpin = substr (data_ptr -> based_bit2, 2, 1); /* we'll simply save this info for later */ dumpout = substr (data_ptr -> based_bit2, 1, 1); end; else if order = "set_line_type" then do; mbx_data_len = 18; local_line_type = data_ptr -> based_fb_word; if local_line_type <= 0 | local_line_type > max_line_type then go to order_error; check = "1"b; /* we'll have to look at PCB (after locking) */ opcode = set_line_type; end; else if order = "dial_out" then do; /* we have to convert digits (in char. form) to 6-bit BCD */ digit_pos = 0; do i = 1 to length (data_ptr -> phone_chars);/* should never see "X" in phone number */ next_digit = index ("0123456789XXX!", substr (data_ptr -> phone_chars, i, 1)) - 1; /* a value of 13 tells autocall unit to wait for a */ /* dial tone before asking for another dialing digit */ if next_digit >= 0 then if next_digit < 10 | next_digit = 13 then do; /* it's actually a digit */ digit_pos = digit_pos + 1; phone_digits (digit_pos) = bit (next_digit, 6); end; end; phone_no_len = 6 * digit_pos; opcode = dial; check = "1"b; /* special stuff required here too */ end; else if order = "listen" then do; alter_type = Listen; alter_data = "000000001"b; end; else if order = "write_status" then set_write_status = "1"b; else if order = "enter_receive" then do; mbx_data_len = 0; mbx_data = ""b; opcode = enter_receive; end; else if order = "start_negotiated_echo" then do; mbx_data_len = 36; mbx_data = bit (fixed (data_ptr -> echo_start_data.ctr, 18), 18) || bit (fixed (data_ptr -> echo_start_data.screenleft, 18), 18); opcode = start_negotiated_echo; end; else if order = "set_echnego_break_table" then do; mbx_data_len = length (unspec (echnego_break_table)); unspec (echnego_break_table) = ""b; /* Get pads */ do i = 0 to hbound (echnego_break_table.words, 1); echnego_break_table.bits (i) = substr (data_ptr -> based_echo_table_bits, 1 + 16 * i, 16); end; mbx_data_long = unspec (echnego_break_table); opcode = set_echnego_break_table; end; else if order = "init_echo_negotiation" then do; mbx_data_len = 0; mbx_data = ""b; opcode = init_echo_negotiation; end; else if order = "stop_negotiated_echo" then do; mbx_data_len = 0; mbx_data = ""b; opcode = stop_negotiated_echo; end; else if order = "input_flow_control_chars" then do; mbx_data_len = 36; if data_ptr -> input_flow_control_info.resume_seq.count = 0 /* turning it all off */ then mbx_data = ""b; else do; mbx_data = unspec (substr (data_ptr -> input_flow_control_info.suspend_seq.chars, 1, 1)) || unspec (substr (data_ptr -> input_flow_control_info.resume_seq.chars, 1, 1)) || data_ptr -> input_flow_control_info.timeout; if data_ptr -> input_flow_control_info.suspend_seq.count = 0 then substr (mbx_data, 1, 9) = "0"b; /* don't send suspend char if there isn't one */ end; opcode = input_fc_chars; end; else if order = "output_flow_control_chars" then do; mbx_data_len = 36; if data_ptr -> output_flow_control_info.suspend_or_etb_seq.count = 0 /* no chars */ then mbx_data = "0"b; else mbx_data = unspec (substr (data_ptr -> output_flow_control_info.suspend_or_etb_seq.chars, 1, 1)) || unspec (substr (data_ptr -> output_flow_control_info.resume_or_ack_seq.chars, 1, 1)) || data_ptr -> output_flow_control_info.block_acknowledge; opcode = output_fc_chars; end; else if order = "copy_meters" then do; opcode = report_meters; check = "1"b; end; else if order = "get_meters" then do; ret_meters_ptr = data_ptr -> get_comm_meters_info.parent_ptr; if ret_meters_ptr = null () then return; else if ret_meters_ptr -> fnp_chan_meter_struc.version ^= FNP_CHANNEL_METERS_VERSION_1 then do; a_code = error_table_$unimplemented_version; return; end; else get_meters = "1"b; end; else if order = "tandd_attach" then do; /* simulate a dialup without bothering the FNP (channel is hung up already) */ call setup; if code ^= 0 then do; a_code = code; return; end; if pcb.listen | pcb.dialed /* can't have this */ then do; call unlock; a_code = error_table_$resource_not_free; return; end; pcb.dialed = "1"b; pcb.tandd_attached = "1"b; unspec (dialup_info) = ""b; dialup_info.baud_rate = 1200; /* just so it's something */ dialup_info.line_type = LINE_ASCII; /* make everyone's life easier */ dialup_info.max_buf_size = 16; /* COLTS wants small buffers */ call channel_manager$interrupt ((pcb.devx), DIALUP, unspec (dialup_info)); call unlock; a_code = 0; return; end; else do; order_error: a_code = error_table_$undefined_order_request; return; end; code = 0; call setup; if code ^= 0 then do; a_code = code; return; end; if opcode = disconnect_this_line /* hangup */ then do; pcb.listen, pcb.tandd_attached = "0"b; end; if opcode = start_negotiated_echo & (pcb.write_first ^= 0 /* We have queued output */ | pcb.output_mbx_pending) then do; /* The FNP has not take the mbx. */ /* handler re-do it when he sees this. */ call unlock; a_code = error_table_$invalid_write; return; end; if alter_type ^= -1 /* alter_parameters required */ then do; if alter_type = Listen then do; /* need to tell it buffer size */ alter_data = alter_data || fnp_buf_size (); pcb.listen = "1"b; end; mbx_data_len = length (alter_data) + 9; /* 9 bits for subop type */ mbx_data = bit (bin (alter_type, 9), 9) || alter_data; opcode = alter_parameters; end; if opcode ^= -1 /* we do have to send the FNP something */ then do; if check /* anything special about it */ then do; if opcode = set_line_type /* make sure this is OK */ then if pcb.listen then do; /* it isn't */ call unlock; go to order_error; end; else do; mbx_data = bit (bin (local_line_type, 18), 18); do i = 1 to n_sync_line_types while (local_line_type ^= sync_line_type (i)); end; pcb.sync_line = (i <= n_sync_line_types); end; else if opcode = dial /* in this case we have to supply buffer size first */ then do; /* because no listen was done */ mbx_data_len = 36; alter_data = bit (bin (Set_buffer_size, 9), 9) || "000000001"b; mbx_data = alter_data || fnp_buf_size (); call dn355$send_wcd (fnpp, pcbp, alter_parameters, mbx_data_len, mbx_data); mbx_data_len = phone_no_len; mbx_data_long = string (phone_digits); end; else if opcode = report_meters then do; call tty_space_man$get_space (size (fnp_channel_meters), meter_ptr); /* get a buffer for the FNP meters */ if meter_ptr = null () /* couldn't get it */ then do; call unlock; a_code = error_table_$noalloc; return; end; pcb.copied_meters_offset = bin (rel (meter_ptr), 18); mbx_data = bit (bin (tty_buf.absorig + pcb.copied_meters_offset, 18), 18); mbx_data_len = 18; end; end; call dn355$send_wcd (fnpp, pcbp, opcode, mbx_data_len, mbx_data_long); end; else do; if dumpin then call dn355$send_wcd (fnpp, pcbp, alter_parameters, 9, bit (bin (Dumpinput, 9), 9)); if dumpout then do; /* first get rid of any ring 0 output */ if pcb.write_first ^= 0 then do; call tty_space_man$free_chain ((pcb.devx), OUTPUT, ptr (ttybp, pcb.write_first)); pcb.write_first, pcb.write_last, pcb.write_cnt = 0; end; call dn355$send_wcd (fnpp, pcbp, alter_parameters, 9, bit (bin (Dumpoutput, 9), 9)); if pcb.end_frame then do; pcb.end_frame = "0"b; if pcb.send_output then call channel_manager$interrupt ((pcb.devx), SEND_OUTPUT, ""b); end; end; if set_write_status then opend = (pcb.write_first ^= 0); /* this has to be in automatic, return structure isn't wired */ if get_meters then do; call get_fnp_meters ("0"b); call unlock; if code = 0 then ret_meters_ptr -> fnp_chan_meter_struc.synchronous = pcb.sync_line; if fnp_meters_ptr ^= null () then do; if unspec (fnp_meters_ptr -> fnp_channel_meters) = "0"b then code = error_table_$no_channel_meters; else do; ret_meters_ptr -> fnp_chan_meter_struc.current_meters = fnp_meters_ptr -> fnp_channel_meters; ret_meters_ptr -> fnp_chan_meter_struc.saved_meters = pcb.saved_meters_ptr -> fnp_channel_meters; end; call tty_space_man$free_space (size (fnp_channel_meters), fnp_meters_ptr); end; end; end; call unlock; if set_write_status then data_ptr -> wr_stat.output_pending = opend; a_code = code; return; check_modes: entry (a_fnpp, a_subchan, a_mode_list_ptr, a_code); /* this entry is used to determine if this multiplexer understands or accepts a given set of modes */ fnpp = a_fnpp; chanx = a_subchan; mclp = a_mode_list_ptr; if mcl.version ^= mcl_version_2 then do; a_code = error_table_$unimplemented_version; return; end; call setup; /* now we need PCB pointer */ if code ^= 0 then do; a_code = code; return; end; do modex = 1 to mcl.n_entries; mclep = addr (mcl.entries (modex)); mode_name = substr (mcle.mode_name, 1, 8); mode_on = mcle.mode_switch; do i = 1 to hbound (good_modes, 1) while (mode_name ^= good_modes (i)); end; if i <= hbound (good_modes, 1) /* tree */ /* it's one of the ones we always recognize */ then mcle.mpx_mode = "1"b; else do; do i = 1 to hbound (async_only_modes, 1) while (mode_name ^= async_only_modes (i)); end; if i > hbound (async_only_modes, 1) /* we've never heard of this one at all */ then mcle.mpx_mode = "0"b; else do; mcle.mpx_mode = ^pcb.sync_line; /* this mode is meaningful for asynchronous lines only */ do i = 1 to hbound (full_dpx_modes, 1) while (mode_name ^= full_dpx_modes (i)); end; if (mode_name = "no_outp" | mode_name = "8bit" | mode_name = "oddp") & mode_on then if ^pcb.is_hsla then go to bad_mode; if i <= hbound (full_dpx_modes, 1) /* if this was a mode requiring full duplex capability */ then if mode_on then if pcb.line_type ^= LINE_ASCII & pcb.line_type ^= LINE_ASYNC1 & pcb.line_type ^= LINE_ASYNC2 & pcb.line_type ^= LINE_ASYNC3 then do; bad_mode: if mcle.force then mcle.mpx_mode = "0"b; else do; code = error_table_$bad_mode; mcle.error = "1"b; end; end; end; end; end; call unlock; /* setup locked */ a_code = code; return; set_modes: entry (a_fnpp, a_subchan, a_mode_list_ptr, a_code); /* this entry sets a specified set of mode (probably by calling dn355$send_wcd) */ fnpp = a_fnpp; chanx = a_subchan; mclp = a_mode_list_ptr; if mcl.version ^= mcl_version_2 then do; a_code = error_table_$unimplemented_version; return; end; call setup; if code ^= 0 then do; a_code = code; return; end; hndlquit_set = "0"b; string (mode_set) = "0"b; /* nothing set yet */ do modex = 1 to mcl.n_entries; mclep = addr (mcl.entries (modex)); if mcle.mpx_mode /* if this is one we're interested in */ then call process_mode (mcle.mode_name, mcle.mode_switch); end; if mcl.init then do; /* if "init" we must turn off the ones that weren't mentioned */ if ^hndlquit_set then call process_mode ("hndlquit", "0"b); do modex = 1 to hbound (async_only_modes, 1); if ^mode_set (modex) then call process_mode (async_only_modes (modex), "0"b); end; end; call unlock; a_code = code; return; get_modes: entry (a_fnpp, a_subchan, a_modes, a_code); /* this is a dummy, we don't keep records of modes at this level */ a_modes = ""; a_code = 0; return; priv_control: entry (a_fnpp, a_order, a_data_ptr, a_code); /* entry for privileged global orders */ fnpp = a_fnpp; order = a_order; data_ptr = a_data_ptr; if order = "dump_fnp" then do; call setup_fnp; if code ^= 0 then do; a_code = code; return; end; locked = "0"b; call send_global (dump_mem); if code ^= 0 then go to end_dump_mem; /* send_global will wait; come back here after notify */ n_fnp_words = dump_fnp_info.fnp_len; dump_fnp_info.bufp -> fnp_data = fnp_dump_ptr -> fnp_data; end_dump_mem: if code ^= error_table_$timeout /* else we have to abandon the buffer */ then call tty_space_man$free_space (dump_patch_space, fnp_dump_ptr); /* this was allocated by setup_fnp */ ignore = stacq (fnp_info.dump_patch_lock, "0"b, pds$processid); end; else if order = "get_meters" then do; fnp_meterp = data_ptr -> get_comm_meters_info.subchan_ptr; if fnp_meterp ^= null then do; if fnp_meters.version ^= FNP_METERS_VERSION_2 then code = error_table_$unimplemented_version; else do; ttybp = addr (tty_buf$); /* we'll need this */ call lock; if code ^= 0 then do; a_code = code; return; end; call get_fnp_meters ("1"b); if code = 0 then do; fnp_meters.n_channels = fnp_info.no_of_channels; fnp_meters.output_mbx_in_use_cum = fnp_info.cumulative_mbx_in_use; fnp_meters.output_mbx_updates = fnp_info.mbx_in_use_updated; fnp_meters.output_mbx_unavailable = fnp_info.mbx_unavailable; fnp_meters.max_output_mbx_in_use = fnp_info.max_mbx_in_use; fnp_meters.queue_entries_made = fnp_info.q_entries_made; fnp_meters.input_rejects = fnp_info.input_reject_count; fnp_meters.processed_from_q = fnp_info.processed_from_q; fnp_meters.fnp_channel_locked = fnp_info.fnp_channel_locked; fnp_meters.input_data_transactions = fnp_info.input_data_transactions; fnp_meters.output_data_transactions = fnp_info.output_data_transactions; fnp_meters.input_control_transactions = fnp_info.input_control_transactions; fnp_meters.output_control_transactions = fnp_info.output_control_transactions; fnp_meters.fnp_space_restricted_output = fnp_info.fnp_space_restricted_output; fnp_meters.fnp_mem_size = fnp_info.fnp_mem_size; begin; declare iom fixed bin (3); declare chan fixed bin (7); call io_chnl_util$name_to_iom (fnp_info.io_chanid, iom, chan, (0)); fnp_meters.iom_number = iom; fnp_meters.iom_chan_no = chan; end; end; call unlock; if fnp_meters_ptr ^= null () /* let's make sure this is for real */ then do; data_ptr -> get_comm_meters_info.subchan_ptr -> fnp_meters.from_fnp = fnp_meters_ptr -> fnp_global_meters; call tty_space_man$free_space (size (fnp_global_meters), fnp_meters_ptr); end; lctep = fnp_info.lcte_ptr; /* since we don't call channel_manager, */ lcmp = data_ptr -> get_comm_meters_info.logical_chan_ptr; /* we have to copy logical channel data ourselves */ if lcmp ^= null () then do; lcmp -> logical_chan_meters.current_meters = lcte.meters; unspec (lcmp -> logical_chan_meters.saved_meters) = "0"b; /* no saved meters for an FNP */ end; end; end; end; else code = error_table_$undefined_order_request; a_code = code; return; hpriv_control: entry (a_fnpp, a_order, a_data_ptr, a_code); /* entry for highly-privileged global orders */ fnpp = a_fnpp; order = a_order; data_ptr = a_data_ptr; locked = "0"b; code = 0; if order = "patch_fnp" then do; call setup_fnp; if code ^= 0 then do; a_code = code; return; end; n_fnp_words = dump_fnp_data.fnp_len; sourcep = dump_fnp_info.bufp; fnp_dump_ptr -> fnp_data = sourcep -> fnp_data; call syserr (ANNOUNCE, "fnp_multiplexer: patching FNP ^a for ^a:", fnp_info.fnp_tag, pds$process_group_id); /* tell operator about it */ temp_addr = dump_fnp_data.fnp_addr; do i = 1 to dump_fnp_data.fnp_len; call syserr (ANNOUNCE, "^6w from ^6.3b to ^6.3b", temp_addr, dump_fnp_info.old_value_ptr -> fnp_data (i), dump_fnp_info.bufp -> fnp_data (i)); temp_addr = temp_addr + 1; end; call send_global (patch_mem); /* send it off and wait */ if code ^= error_table_$timeout /* else we have to abandon the buffer */ then call tty_space_man$free_space (dump_patch_space, fnp_dump_ptr); /* this was allocated by setup_fnp */ ignore = stacq (fnp_info.dump_patch_lock, "0"b, pds$processid); end; else if order = "fnp_break" then do; call setup_fnp; if code ^= 0 then do; a_code = code; return; end; fnp_break_data.action = fnp_break_info.action; /* copy info */ fnp_break_data.fnp_addr = fnp_break_info.fnp_addr; fnp_break_data.flags = substr (fnp_break_info.flags, 1, 18); name = fnp_break_info.chan_name; if name = "" then fnp_break_data.lineno = -1; /* no line, i.e. any line */ else do; call name_to_pcb (name); if code ^= 0 then do; a_code = code; return; end; fnp_break_data.lineno = bin (string (pcb.line_number)); end; mbx_data = addr (fnp_break_data) -> based_bit72; if ^locked then call lock; if code = 0 then do; call dn355$send_global_wcd (fnpp, fnp_break, 72, mbx_data); call unlock; end; end; else if order = "enable_breakall_mode" then ; else if order = "disable_breakall_mode" then ; else code = error_table_$undefined_order_request; hpriv_exit: a_code = code; return; fnp_lock: entry (a_fnpp, a_code); /* Non-wired lock entry */ fnpp = a_fnpp; call lock; a_code = code; return; fnp_unlock: entry (a_fnpp); fnpp = a_fnpp; mylock = "0"b; locked = "1"b; call unlock; return; setup: proc; /* initial setup for per-channel stuff */ code = 0; /* innocent until proven guilty */ ttybp = addr (tty_buf$); infop = addr (dn355_data$); locked, queue_locked = "0"b; call lock; if code ^= 0 then return; if fnp_info.running then pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (chanx)); else do; call unlock; code = error_table_$mpx_down; return; end; if pcb.copied_meters_ready /* dn355 left them for us */ then if ^lcte.locked_for_interrupt /* make sure we're on call side */ then call save_copied_meters; return; end setup; setup_fnp: proc; dcl (fnp_address, fnp_len) fixed bin (18); /* this procedure is used instead of setup for privileged global orders */ if fnpp = null () then go to setup_fnp_down; code = 0; if fnp_info.mbx_pt = null () /* this one isn't configured */ | ^fnp_info.running /* or it isn't up */ then do; setup_fnp_down: code = error_table_$mpx_down; return; end; ttybp = addr (tty_buf$); infop = addr (dn355_data$); if order = "fnp_break" then return; /* done if break order */ if fnp_info.dump_patch_disabled then do; code = error_table_$timeout; return; end; fnp_address = dump_fnp_info.fnp_address; fnp_len = dump_fnp_info.fnp_len; if order = "dump_fnp" then do; /* check dump params */ if fnp_len <= 0 | fnp_len > 64 then do; bad_fnp_len: code = error_table_$buffer_big; return; end; end; else if order = "patch_fnp" then if fnp_len <= 0 | fnp_len > 32 then go to bad_fnp_len; if (fnp_address < 0) | ((fnp_address + fnp_len) > fnp_info.fnp_mem_size) then do; code = error_table_$dev_offset_out_of_bounds; return; end; if ^stac (addr (fnp_info.dump_patch_lock), pds$processid) /* lock the dump_patch function */ then do; /* if possible */ code = error_table_$seglock; return; end; dump_patch_space = divide (fnp_len + 1, 2, 17, 0); call tty_space_man$get_space (dump_patch_space, fnp_dump_ptr); if fnp_dump_ptr = null /* couldn't get the space */ then do; code = error_table_$noalloc; ignore = stacq (fnp_info.dump_patch_lock, "0"b, pds$processid); return; end; dump_patch_time = clock (); fnp_info.dump_patch_in_progress = "1"b; dump_fnp_data.abs_addr = bin (rel (fnp_dump_ptr)) + tty_buf.absorig; /* dump/patch is paged too ... */ dump_fnp_data.fnp_addr = fnp_address; dump_fnp_data.fnp_len = fnp_len; return; end setup_fnp; save_copied_meters: proc; /* internal procedure called to pick up copied meters left in tty_buf by FNP */ dcl copied_meters_ptr ptr; if pcb.copied_meters_offset ^= 0 /* make sure it's legit */ then do; copied_meters_ptr = ptr (ttybp, pcb.copied_meters_offset); /* zero out pad fields, which contain random junk (possibly input) from the FNP */ if pcb.sync_line then copied_meters_ptr -> fnp_sync_meters.pad (*) = 0; else copied_meters_ptr -> fnp_async_meters.pad (*) = 0; pcb.saved_meters_ptr -> fnp_channel_meters = copied_meters_ptr -> fnp_channel_meters; call tty_space_man$free_space (size (fnp_channel_meters), copied_meters_ptr); /* through with buffer now */ pcb.copied_meters_offset = 0; pcb.copied_meters_ready = "0"b; end; return; end save_copied_meters; process_mode: proc (mode_name, mode_on); dcl mode_name char (*); dcl mode_on bit (1); dcl mode_name_index fixed bin; alter_data = "00000000"b || mode_on; if mode_name = "hndlquit" then do; alter_type = Hndlquit; pcb.hndlquit = mode_on; hndlquit_set = "1"b; end; else if ^pcb.sync_line /* if we haven't already decided what to do */ then do; if mode_name = "blk_xfer" | mode_name = "iflow" /* special stuff here */ then do; if mode_name = "blk_xfer" then do; mode_name_index = BLK_XFER_INDEX; alter_type = Block_xfer; end; else do; mode_name_index = IFLOW_INDEX; alter_type = Input_flow_control; end; if mode_on then do; /* we have to tell it buffer sizes */ chars_per_sec = divide (pcb.baud_rate, 10, 17, 0); base_len, block_len = divide (chars_per_sec, buf_per_second, 17, 0); /* and 1/2 second thereafter */ end; else do; base_len = 56; block_len = 0; end; alter_data = alter_data || bit (bin (base_len, 18), 18) || bit (bin (block_len, 18), 18); mode_set (mode_name_index) = "1"b; end; else do; do i = 1 to hbound (mode_alter_types, 1) while (mode_name ^= async_only_modes (i)); end; /* note that blk_xfer is the last async_mode */ if i > hbound (mode_alter_types, 1) then code = error_table_$bad_mode; else do; alter_type = mode_alter_types (i); mode_set (i) = "1"b; /* this one is set now */ end; end; end; if code = 0 then do; mbx_data = bit (bin (alter_type, 9), 9) || alter_data; call dn355$send_wcd (fnpp, pcbp, alter_parameters, length (alter_data) + 9, mbx_data); end; return; end; send_global: proc (opcode); /* this procedure calls dn355$send_global_wcd for the dump_fnp and patch_fnp orders */ dcl opcode fixed bin (8); call pxss$addevent (FNP_DUMP_PATCH_EVENT); /* so we'll be able to wait */ mbx_data = addr (dump_fnp_data) -> based_bit72; call lock; if code ^= 0 then return; call dn355$send_global_wcd (fnpp, opcode, 72, mbx_data); call unlock; call pxss$wait; /* mustn't do anything till it's done */ do while (fnp_info.dump_patch_in_progress); /* didn't complete yet */ if ^fnp_info.running /* FNP crashed out from under us */ then do; code = error_table_$mpx_down; fnp_info.dump_patch_in_progress = "0"b; /* so we'll get out of loop */ end; else if clock () - dump_patch_time > DUMP_PATCH_LIMIT /* time's up! */ then do; code = error_table_$timeout; /* can this operation */ fnp_info.dump_patch_disabled = "1"b; fnp_info.dump_patch_in_progress = "0"b; call syserr (ANNOUNCE, "fnp_multiplexer: ^[dump^;patch^]_fnp order to FNP ^a timed out.", opcode = dump_mem, fnp_info.fnp_tag); end; else do; /* must be someone else's notify */ call pxss$addevent (FNP_DUMP_PATCH_EVENT); if fnp_info.dump_patch_in_progress /* make sure it still hasn't happened */ then call pxss$wait; else call pxss$delevent (FNP_DUMP_PATCH_EVENT); /* never mind, it's done */ end; end; return; /* all right, we're done */ end send_global; get_fnp_meters: proc (global); /* subroutine to issue request for meters from FNP and wait for them to arrive */ dcl global bit (1) parameter; /* indicates whether subchannel or whole FNP */ dcl space_size fixed bin; dcl fnp_meter_wait_start fixed bin (71); if fnp_info.dump_patch_disabled then do; code = error_table_$timeout; /* don't even try */ fnp_meters_ptr = null (); /* so caller won't try to free space */ return; end; if global then space_size = size (fnp_global_meters); else space_size = size (fnp_channel_meters); call tty_space_man$get_space (space_size, fnp_meters_ptr); if fnp_meters_ptr = null () then do; code = error_table_$noalloc; return; end; mbx_data = bit (bin (tty_buf.absorig + bin (rel (fnp_meters_ptr)), 18), 18); call pxss$addevent (FNP_METER_EVENT); fnp_meter_wait_start = clock (); if global /* it's for whole FNP */ then do; if fnp_info.get_meters_waiting then do; code = error_table_$seglock; /* can't have two going at once */ return; end; fnp_info.get_meters_waiting = "1"b; call dn355$send_global_wcd (fnpp, report_meters, 18, mbx_data); pcbp = fnpp; /* to avoid faults in loop test */ end; else do; pcb.get_meters_waiting = "1"b; call dn355$send_wcd (fnpp, pcbp, report_meters, 18, mbx_data); end; call unlock; /* while waiting */ call pxss$wait; call lock; /* while checking */ do while ((global & fnp_info.get_meters_waiting) | (^global & pcb.get_meters_waiting)); if ^fnp_info.running then do; code = error_table_$mpx_down; go to abort_get_meters; end; else if clock () - fnp_meter_wait_start > DUMP_PATCH_LIMIT then do; code = error_table_$timeout; fnp_info.dump_patch_disabled = "1"b; call syserr (ANNOUNCE, "fnp_multiplexer: get_meters order for FNP ^a^[^s^;, line ^o,^] timed out.", fnp_info.fnp_tag, global, string (pcb.line_number)); abort_get_meters: if global then fnp_info.get_meters_waiting = "0"b; else pcb.get_meters_waiting = "0"b; end; else do; call unlock; /* in case we wait some more */ call pxss$addevent (FNP_METER_EVENT); if (global & fnp_info.get_meters_waiting) | (^global & pcb.get_meters_waiting) /* check if it happened since we checked */ then call pxss$wait; else call pxss$delevent (FNP_METER_EVENT); call lock; end; end; return; end get_fnp_meters; name_to_pcb: proc (name); dcl name char (*); code = 0; call parse_tty_name_ (name, his_fnp_no, hsla_flag, la_no, subchan); call lock; if code ^= 0 then return; if his_fnp_no ^= fnp_info.fnp_number then go to bad_device; if hsla_flag then pcbx = fnp_info.hsla_idx (la_no); else pcbx = fnp_info.lsla_idx (la_no); if pcbx = -1 then go to bad_device; found, past = "0"b; do j = pcbx to fnp_info.no_of_channels while (^past & ^found); pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (j)); if pcb.la_no ^= bit (bin (la_no, 3), 3) then past = "1"b; else if pcb.slot_no = bit (bin (subchan, 6), 6) then found = "1"b; end; if ^found then do; bad_device: call unlock; code = error_table_$bad_channel; return; end; return; end name_to_pcb; lock: proc; /* subroutine to lock the mailbox lock (which incidentally protects PCBs too) */ if fnpp = null () then do; code = error_table_$mpx_down; return; end; code = 0; lctep = fnp_info.lcte_ptr; if lcte.lock = pds$processid /* called as result of our own interrupt? */ then if lcte.locked_for_interrupt then mylock = "1"b; /* remember not to unlock it */ else call syserr (CRASH_SYSTEM, "fnp_multiplexer: mylock error"); else do; mylock = "0"b; call tty_lock$lock_lcte (lctep, code); locked = (code = 0); end; return; end lock; unlock: proc; /* subroutine to release mailbox lock and process queued interrupts */ if locked then if ^mylock then do; call dn355$process_interrupt_queue ((fnp_info.fnp_number)); locked = "0"b; /* it unlocks the channel lock when it's done */ end; return; end unlock; fnp_buf_size: proc returns (bit (18)); /* internal procedure returns correct buffer size for FNP to use, based on baud rate * and synchronous/asynchronous */ do i = 1 to n_sync_line_types while (pcb.line_type ^= sync_line_type (i)); end; if i <= n_sync_line_types then do; pcb.sync_line = "1"b; chars_per_buf = divide (divide (pcb.baud_rate, 8, 17, 0), buf_per_second, 17, 0); end; else do; pcb.sync_line = "0"b; chars_per_buf = 56; /* always minimum for asynchronous */ end; return (bit (bin (chars_per_buf, 18), 18)); end fnp_buf_size; /**** Wired entrypoints to talk to io_manager for both fnp_multiplexer and the fnp_util TandD code. These should be called under the FNP lcte lock. */ declare a_fnp_no fixed bin; declare fnp_no fixed bin; assign: entry (a_fnp_no, a_code); infop = addr (dn355_data$); call TRACE ("assign"); fnp_no = a_fnp_no; fnpp = addr (datanet_info.per_datanet (fnp_no)); call assign_channel (code); a_code = code; return; unassign: entry (a_fnp_no, a_code); fnp_no = a_fnp_no; infop = addr (dn355_data$); call TRACE ("unassign"); fnpp = addr (datanet_info.per_datanet (fnp_no)); call unassign_channel (code); a_code = code; return; assign_channel: procedure (code); declare code fixed bin (35); code = 0; if ^fnp_info.available then do; code = error_table_$io_not_configured; /* "not available" */ go to assign_channel_return; end; if fnp_info.io_manager_assigned then do; code = error_table_$io_assigned; go to assign_channel_return; end; call io_manager$assign (fnp_info.io_manager_chx, fnp_info.io_chanid, dn355$interrupt, (fnp_info.fnp_number), (null ()), code); fnp_info.io_manager_assigned = (code = 0); assign_channel_return: if datanet_info.trace | datanet_info.debug_stop then call syserr (ANNOUNCE, "fnp_multiplexer$assign_channel: Assignment of FNP ^a ^[succeeded^;failed^].", fnp_info.fnp_tag, (code = 0)); if code ^= 0 then call TRACE_ERROR ("assign_channel", code); return; end assign_channel; unassign_channel: procedure (code); declare code fixed bin (35); if ^fnp_info.io_manager_assigned then do; code = error_table_$io_not_assigned; go to unassign_return; end; call io_manager$unassign (fnp_info.io_manager_chx, code); if code = 0 then fnp_info.io_manager_assigned = "0"b; unassign_return: if datanet_info.trace | datanet_info.debug_stop then call syserr$error_code (ANNOUNCE, code, "fnp_multiplexer$unassign_channel: Unassignment of FNP ^a ^[failed^;succeeded^].", fnp_info.fnp_tag, (code ^= 0)); if code ^= 0 then call TRACE_ERROR ("unassign_channel", code); return; end unassign_channel; TRACE: procedure (Entry); declare Entry char (32); if datanet_info.trace then call syserr (ANNOUNCE, "fnp_multiplexer$^a: Tracing call.", Entry); return; TRACE_ERROR: entry (Entry, Code); declare Code fixed bin (35); if datanet_info.trace | datanet_info.debug_stop then call syserr$error_code (ANNOUNCE, Code, "fnp_multiplexer$^a: Tracing error.", Entry); if datanet_info.debug_stop then call syserr (CRASH_SYSTEM, "fnp_multiplexer: debugging stop (type go to continue)."); return; end TRACE; /* BEGIN MESSAGE DOCUMENTATION Message: fnp_multiplexer: patching FNP X for USER: ADDR from XXX to YYY S: $info T: $run M: The memory of FNP X is being patched by the privileged user whose user_id is USER. ADDR is the absolute location in FNP memory that is being patched (in octal); XXX and YYY are the old and new values of the location respectively (also in octal). The second line may be repeated (with different values) if more than one word is being patched. A: This information is for logging purposes. Message: fnp_multiplexer: mylock error S: $crash T: $run M: An attempt has been made to lock an FNP channel lock to a process that already has it locked. A: $inform Message: fnp_multiplexer: NAME order to FNP X timed out. S: $info T: $run M: NAME is "get_meters", "dump_fnp", or "patch_fnp". The named order to FNP X failed to complete within 10 seconds. The buffer space associated with the order has been abandoned, and get_meters, dump, and patch orders to that FNP are disabled until the FNP is reloaded. A: $inform Message: fnp_multiplexer: get_meters order for FNP X, line N, timed out. S: $info T: $run M: A get_meters order for line N of FNP X failed to complete within 10 seconds. The buffer space associated with the order has been abandoned, and get_meters, dump, and patch orders to that FNP are disabled until the FNP is reloaded. Message: fnp_multiplexer$shutdown: Failed to unwire fnp. ERROR. S: $info T: $run M: An attempt to unwire the pages used for I/O to an FNP failed at FNP shutdown. ERROR contains the message derived from a standard system error code. A: $inform Message: fnp_multiplexer$shutdown: Called with null fnp_ptr S: $info T: $run M: A call was made to the shutdown entry with a null pointer to fnp_info. This message only appears if tracing is enabled for the specified FNP. A: $inform Message: fnp_multiplexer$shutdown: Called with FNP wired. S: $info T: $run M: A call was made to the shutdown entry while the pages for I/O for an FNP were still wired. This message only appears if tracing is enabled for the specified FNP. A: none required. Message: fnp_multiplexer$assign_channel: Assignment of FNP X {succeeded | failed}. S: $info T: $run M: Indicates the result of a call to io_manager$assign for FNP X. This message only appears if tracing is enabled for the specified FNP. A: none required. Message: fnp_multiplexer$unassign_channel: Unassignment of FNP X {succeeded | failed}. S: $info T: $run M: Indicates the result of a call to io_manager$unassign for FNP X. This message only appears if tracing is enabled for the specified FNP. A: none required. Message: fnp_multiplexer$ENTRY: Tracing call. S: $info T: $run M: A call was made to the ENTRY entry. This message only appears if tracing is enabled for the specified FNP. A: none required. Message: fnp_multiplexer$ENTRY: Tracing error. ERROR. S: $info T: $run M: The error code represented by ERROR was encountered by ENTRY. This message only appears if tracing is enabled for the specified FNP. A: none required. Message: fnp_multiplexer: debugging stop (type go to continue). S: $crash T: $run M: An error has been encountered in setting up an FNP, and debugging mode is turned on. A: Use BCE commands to analyze the condition, if necessary; type "go" to resume system operation. END MESSAGE DOCUMENTATION */ end fnp_multiplexer;  fnp_util.pl1 11/11/89 1132.7r w 11/11/89 0825.4 398187 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * 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-06-05,GJohnson), approve(86-06-05,MCR7387), audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091): Correct error message documentation. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,^ifthendo */ fnp_util: procedure; /* This procedure contains entries called through hphcs_ used to load and dump an * FNP. The "wire" entry is used to wire the segment containing the core image so that * DIA I/O will be possible; the "load" entry initiates the bootload I/O; the * "release" entry releases the aste of the coreimage. * The "fdump" entry dumps all of FNP memory into a segment supplied * by the caller. * * Written 5/19/76 by Robert S. Coren * Modified 10/28/76 by Robert S. Coren to save version number and report core image name * Modified 04/15/77 by Robert S. Coren to correct bug in queue buffer freeing * Modified 9/27/78 by J. Stern for multiplexing changes * Modified 79 May 14 by Art Beattie to get memory size and FNP type from caller for fdump entry. * Modified April 1981 by Chris Jones for io_manager conversion * Modified February 1982 by C. Hornig for MR10 io_manager. * Modified 830714 BIM to remove the release entrypoint. abort is suffcient. * Modified 83-12-20 BIM for reconfiguration. * Modified 84-05-18 BIM for better maintenance of io_manager_assigned bit. * Modified 1984-08-02 BIM for code return from load. * Modified 1984-07-26 BIM for paged I/O on loads. * Modified 1985-01-29, BIM: fix dump_mpx to leave chn unassigned. * Modified 1985-03-12, E. Swenson to fix unitialized timeout flag to * prevent spurious timeout errors. */ /* PARAMETERS */ dcl a_devx fixed bin; /* ioam release param */ dcl a_fnp_no fixed bin; dcl a_fnp_mem_size fixed bin; /* FNP memory size in 1024 18-bit words */ dcl a_fnp_type fixed bin; dcl a_ptr ptr; dcl a_load_info_ptr ptr; dcl a_count fixed bin; /* number of words to wire */ dcl a_code fixed bin (35); /* OUTPUT */ dcl a_ev_chan fixed bin (71); dcl a_absadr fixed bin (24); /* OUTPUT from wire and info, INPUT to load */ dcl a_version char (4); /* INPUT MCS version number */ dcl a_image_name char (168); /* INPUT core image name */ dcl norm_int_cell fixed bin; /* OUTPUT */ dcl emergency_int_cell fixed bin; /* OUTPUT */ dcl a_ints bit (2) aligned; /* OUTPUT rcvd interrupts */ dcl a_level fixed bin (3); /* INPUT level on which to interrupt fnp */ dcl a_fnp_addr fixed bin (15); /* INPUT data address in fnp */ /* AUTOMATIC */ dcl auto_absadr fixed bin (24); dcl dia_timeout bit (1) aligned; dcl fnp_no fixed bin; dcl fnp_mem_size fixed bin; dcl fnp_type fixed bin; dcl fnp_addr fixed bin (15); dcl chanid char (8) aligned; dcl opcode bit (6) aligned; dcl temp_fnp_name char (32); dcl fnp_size fixed bin; dcl segptr ptr; dcl nwords fixed bin; dcl code fixed bin (35); dcl iom_channel_number fixed bin (7); dcl devx fixed bin; dcl i fixed bin; dcl data_ptr ptr; dcl offset fixed bin; dcl fnp_tally fixed bin; dcl start_time fixed bin (71); dcl version char (4); dcl cur_la_no bit (3); dcl cur_slot_no fixed bin (6); dcl load_info_ptr ptr; dcl locked bit (1) aligned init ("0"b); dcl config_locked bit (1) aligned init ("0"b); declare message fixed bin (71); declare 1 auto_fnp_msg aligned like fnp_msg; /* BUILTINS */ dcl (addr, addrel, baseno, bit, clock, fixed, min, null, ptr, string, substr) builtin; /* ENTRIES */ dcl config_$find_2 entry (character (4) aligned, character (4) aligned, pointer); dcl fnp_multiplexer$assign entry (fixed binary, fixed binary (35)); dcl fnp_multiplexer$unassign entry (fixed binary, fixed binary (35)); dcl fnp_multiplexer$fnp_lock entry (pointer, fixed binary (35)); dcl fnp_multiplexer$fnp_unlock entry (pointer); dcl get_fnp_name_ entry (fixed bin) returns (char (32)); dcl grab_aste$grab_aste_io entry (ptr, fixed bin, fixed bin (35)) returns (ptr); dcl grab_aste$release_io entry (ptr); dcl ioam_$assign entry (fixed bin, entry, fixed bin (35)); dcl ioam_$unassign entry (fixed bin, fixed bin (35)); dcl priv_channel_manager$get_devx entry (char (*), fixed bin, fixed bin (35)); dcl dn355_util$compute_parity entry (bit (36)) returns (bit (36)); dcl absadr entry (ptr, fixed bin (35)) returns (fixed bin (24)); dcl ioi_page_table$get entry (fixed binary (19), fixed binary, fixed binary (35)); dcl ioi_page_table$fill entry (fixed binary, pointer, fixed binary (35)); dcl ioi_page_table$ptx_to_ptp entry (fixed binary) returns (pointer); dcl ioi_page_table$put entry (fixed binary, fixed binary (35)); dcl pxss$notify entry (fixed bin); dcl pxss$addevent entry (fixed bin); dcl pxss$delevent entry (fixed bin); dcl pxss$wait entry; dcl pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl get_ptrs_$given_segno entry (fixed bin) returns (ptr); dcl dn355$interrupt entry; dcl syserr entry options (variable); dcl syserr$error_code entry options (variable); dcl lock$wait entry (ptr, char (4) aligned, fixed bin (35)); dcl lock$lock_fast entry (pointer); dcl lock$unlock_fast entry (pointer); dcl lock$unlock entry (ptr, char (4) aligned); dcl ( pc_abs$wire_abs, pc_abs$wire_abs_contig ) entry (ptr, fixed bin, fixed bin, fixed bin (35)); dcl pc_abs$unwire_abs entry (ptr, fixed bin, fixed bin); /* EXTERNAL STATIC */ dcl ( error_table_$io_no_permission, error_table_$invalid_state, error_table_$bad_mpx_load_data, error_table_$no_io_interrupt, error_table_$rqover, error_table_$bad_segment, error_table_$noalloc, error_table_$action_not_performed, error_table_$io_configured, error_table_$io_not_configured, error_table_$io_assigned, error_table_$io_not_assigned, error_table_$io_not_defined ) fixed bin (35) ext static; dcl pds$processid bit (36) ext static; dcl pds$process_group_id char (32) ext static; dcl tc_data$initializer_id bit (36) aligned external static; dcl tty_buf$fnp_config_flags (1:8) bit (1) unaligned external static; dcl tty_buf$lct_ptr pointer external static; dcl sst$astsize fixed bin external; dcl sys_info$page_size fixed bin external; dcl sys_info$seg_size_256K fixed bin (19) external; /* INTERNAL STATIC */ dcl ( FNP_DOWN init (2) ) fixed bin int static options (constant); dcl fdump_seg_event char (4) aligned init ("fnpd") static options (constant); dcl cleanup condition; dcl record_quota_overflow condition; /* BASED */ dcl tally_words (fnp_tally) bit (36) aligned based; dcl 1 dump_355_control aligned based (data_ptr), /* word used to supply 355 address and tally for fdump */ 2 address_mode bit (3) unaligned, /* always 36-bit addressing ("001"b) */ 2 fnp_address bit (15) unaligned, 2 tally fixed bin (17) unaligned; dcl 1 dump_6670_control aligned based (data_ptr), /* word used to supply DN6670 address and tally for fdump */ 2 fnp_address fixed bin (18) unsigned unaligned, 2 unpaged bit (1) unaligned, 2 mbz bit (5) unaligned, 2 tally fixed bin (12) unsigned unaligned; dcl 1 load_info aligned based (load_info_ptr), /* used to assign baud rates and line types at bootload time */ 2 no_entries fixed bin, 2 entries (0 refer (load_info.no_entries)), 3 devx fixed bin, 3 baud_rate fixed bin, 3 line_type fixed bin; wire: entry (a_fnp_no, a_ptr, a_absadr, a_count, a_code); /* entry called to wire a_count words for segment at a_ptr */ /* This does not require lock protection. If we miss a deconfig, tough */ fnp_no = a_fnp_no; /* copy args */ segptr = a_ptr; nwords = a_count; call validate_fnp_ret ("wire"); call validate_assigned_ret ("wire"); if fnp_info.wired /* Someone did it already? */ then do; a_code = 0; /* be gracious */ if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util$wire: FNP ^a already wired.", fnp_info.fnp_tag); /* but note for debugging */ return; end; astep = grab_aste$grab_aste_io (segptr, nwords, code); /* make segment stay active */ if code ^= 0 then go to wire_error_return; fnp_info.astep = astep; fnp_info.n_pages_wired = divide (nwords + sys_info$page_size - 1, sys_info$page_size, 17, 0); call pc_abs$wire_abs (astep, 0, fnp_info.n_pages_wired, code); /* no contig -- we will use a page table! */ if code ^= 0 then do; call grab_aste$release_io (astep); /* couldn't wire, so let aste go */ go to wire_error_return; end; call fill_bootload_page_table; /* sets the variable absadr */ if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util$wire: seg: ^p n_pages: ^d astep ^p", segptr, fnp_info.n_pages_wired, astep); a_absadr = auto_absadr; /* relative to page table its 0 */ fnp_info.wired = "1"b; wire_error_return: if code ^= 0 & (datanet_info.trace | datanet_info.debug_stop) then do; call syserr$error_code (ANNOUNCE, code, "fnp_util$wire: failed."); call STOP_CHECK ("wire"); end; a_code = code; return; load: entry (a_fnp_no, a_absadr, a_ev_chan, a_version, a_image_name, a_fnp_mem_size, a_load_info_ptr, a_code); /* entry to initiate bootload I/O for loading an FNP */ /* This cannot lock until it has the dump seg wired */ fnp_no = a_fnp_no; fnp_mem_size = a_fnp_mem_size; auto_absadr = a_absadr; call validate_fnp_ret ("load"); call validate_assigned_ret ("load"); if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util$load: FNP ^d ADDR ^o", fnp_no, auto_absadr); if fnp_info.bootloading then do; /* we can't do it while it's already happening */ code = error_table_$invalid_state; call syserr (ANNOUNCE, "fnp_util$load: FNP load already in progress for FNP ^a.", fnp_info.fnp_tag); go to load_return; end; if ^fnp_info.wired then do; code = error_table_$invalid_state; if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util$load: FNP ^a not wired.", fnp_info.fnp_tag); go to load_return; end; if fnp_info.running then do; code = error_table_$invalid_state; if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util$load: FNP ^a is running.", fnp_info.fnp_tag); go to load_return; end; if fnp_info.t_and_d_in_progress then do; code = error_table_$invalid_state; if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util$load: FNP ^a is running T&D.", fnp_info.fnp_tag); go to load_return; end; /* process the load_info data */ load_info_ptr = a_load_info_ptr; if load_info.no_entries ^= fnp_info.no_of_channels then do; code = error_table_$bad_mpx_load_data; go to load_return; end; cur_la_no = "7"b3; /* no current line adaptor */ n_pcbs = load_info.no_entries; do i = 1 to load_info.no_entries; /* get baud rates to store in pcbs */ pcbp = addr (fnp_info.pcb_array_ptr -> pcb_array (i)); if load_info (i).devx ^= pcb.devx /* load_info does not match pcb_array */ then do; code = error_table_$bad_mpx_load_data; go to load_return; end; pcb.baud_rate = load_info (i).baud_rate; pcb.line_type = load_info (i).line_type; if ^pcb.is_hsla /* this pcb is for an lsla subchannel */ then do; /* must figure out its slot number */ if pcb.la_no ^= cur_la_no /* starting a new line adaptor */ then do; cur_la_no = pcb.la_no; cur_slot_no = 1; end; pcb.slot_no = bit (cur_slot_no, 6); if pcb.baud_rate <= 110 then cur_slot_no = cur_slot_no + 1; /* this subchan uses 1 time slot */ else if pcb.baud_rate <= 150 then cur_slot_no = cur_slot_no + 2; /* this subchan uses 2 time slots */ else cur_slot_no = cur_slot_no + 3; /* this subchan uses 3 time slots */ end; end; /* it's okay to try to load */ call lock_fnp; if ^fnp_info.io_manager_assigned /* lost race with deconfig */ then do; /* or even T&D */ call unlock_fnp; code = error_table_$io_not_assigned; /* perhaps deconfigured, but ... */ go to load_return; end; version = a_version; call syserr (ANNOUNCE, "Loading FNP ^a, ^a ^a", fnp_info.fnp_tag, a_image_name, version); fnp_info.boot_ev_chan = a_ev_chan; fnp_info.boot_process_id = pds$processid; fnp_info.version = version; fnp_info.fnp_mem_size = fnp_mem_size * 1024; fnp_info.bootloading = "1"b; datanet_mbx.mailbox_requests = 0; /* clear fields in mbx for this load */ datanet_mbx.term_inpt_mpx_wd = "0"b; datanet_mbx.last_mbx_req_count = 0; string (datanet_mbx.mbx_used_flags) = "0"b; datanet_mbx.crash_data.fault_code = 0; datanet_mbx.crash_data.ic = 0; datanet_mbx.crash_data.iom_fault_status = 0; datanet_mbx.crash_data.fault_word = 0; auto_absadr = sys_info$page_size * FIRST_BOOTLOAD_PAGEX; call mask_dia; /* Mask the IOM channel to initialize it */ call connect_to_dia_paged (auto_absadr, 0, "72"b3, dia_timeout); /* 72 (8), bootload command */ if dia_timeout then code = error_table_$no_io_interrupt; else code = 0; /* all is well so far */ call unlock_fnp; /* however, deconfigure has a problem if bootloading is on! */ load_return: if code ^= 0 & (datanet_info.trace | datanet_info.debug_stop) then do; call syserr$error_code (ANNOUNCE, code, "fnp_util$load: Error loading FNP ^a.", fnp_info.fnp_tag); call STOP_CHECK ("load"); end; a_code = code; return; info: entry (a_fnp_no, a_absadr, norm_int_cell, emergency_int_cell, a_code); /* entry called to return address of mailbox area and FNP interrupt cells */ fnp_no = a_fnp_no; call validate_fnp_ret ("info"); a_absadr = absadr (fnp_info.mbx_pt, code); if code = 0 then do; /* provided everything's ok */ norm_int_cell = 3; /* customary assignments */ emergency_int_cell = 7; end; a_code = code; return; fill_page_table: entry (a_fnp_no, a_code); fnp_no = a_fnp_no; call validate_fnp_ret ("fill_page_table"); call validate_assigned_ret ("fill_page_table"); if fnp_info.ptx ^= -1 | fnp_info.ptp ^= null () then do; call syserr (ANNOUNCE, "fnp_util$fill_page_table: page table already assigned for FNP ^a.", fnp_info.fnp_tag); call STOP_CHECK ("fill_page_table"); end; call get_page_table (code); if code ^= 0 & (datanet_info.trace | datanet_info.debug_stop) then do; call syserr$error_code (ANNOUNCE, code, "fnp_util$fill_page_table: ioi_page_table$get failed for FNP ^a.", fnp_info.fnp_tag); call STOP_CHECK ("fill_page_table"); end; a_code = code; return; free_page_table: entry (a_fnp_no, a_code); fnp_no = a_fnp_no; call validate_fnp_ret ("free_page_table"); if fnp_info.ptx = -1 then do; call syserr (ANNOUNCE, "fnp_util$free_page_table: no page table assigned for FNP ^a.", fnp_info.fnp_tag); go to ret_bad_code; end; call ioi_page_table$put (fnp_info.ptx, code); fnp_info.ptx = -1; fnp_info.ptp = null (); a_code = code; return; unwire: entry (a_fnp_no, a_code); /* entry called to abort bootload or cleanup from successful bootload */ /* no locking for same reason as wire */ fnp_no = a_fnp_no; call validate_fnp_ret ("unwire"); /* Don't demand assigned so that loads aborted by deconfig can unwire */ call internal_unwire; fnp_info.bootloading = "0"b; if code ^= 0 & (datanet_info.trace | datanet_info.debug_stop) then do; call syserr$error_code (ANNOUNCE, code, "fnp_util$unwire: Unwire failed for FNP ^a.", fnp_info.fnp_tag); call STOP_CHECK ("unwire"); end; a_code = code; return; /* RECONFIGURATION ENTRYPOINTS */ /* Configure -- add a FNP to the available collection for assignment */ configure: entry (a_fnp_no, a_code); fnp_no = a_fnp_no; call validate_fnp_ret ("configure"); call lock_fnp; if fnp_info.available then do; code = error_table_$io_configured; if datanet_info.trace | datanet_info.debug_stop then call syserr (ANNOUNCE, "fnp_util$configure: FNP ^a already configured.", fnp_info.fnp_tag); call STOP_CHECK ("configure"); go to configure_return; end; fnp_info.available = "1"b; fnp_info.io_manager_assigned = "0"b; /* clean up */ fnp_info.flags = "0"b; /* state information */ configure_return: call unlock_fnp; if code = 0 then do; call config_$find_2 ("prph", "fnp" || fnp_info.fnp_tag, prph_fnp_cardp); prph_fnp_card.state = "on"; call syserr (ANNOUNCE, "fnp_util: FNP ^a added to configuration^[ by ^a^].", fnp_info.fnp_tag, pds$processid ^= tc_data$initializer_id, pds$process_group_id); end; a_code = code; return; /**** Deconfigure -- remove from configuration. This entrypoint causes a FNP crash for the selected FNP. */ deconfigure: entry (a_fnp_no, a_code); fnp_no = a_fnp_no; call validate_fnp_ret ("deconfigure"); call lock_fnp; if ^fnp_info.available then do; code = error_table_$io_not_configured; go to deconfigure_return; end; fnp_info.available = "0"b; /* throttle init_multiplexer */ if ^fnp_info.io_manager_assigned then go to deconfigure_return; /*** here is the interesting part. What we do depends on who is active */ if fnp_info.t_and_d_in_progress then do; call unlock_fnp; /* must lock in correct order */ call release_t_and_d; /* unassigns channel */ go to deconfigure_return_unlocked; end; else do; call mask_dia; /* stop it from writing to us or sending stuff */ call fnp_multiplexer$unassign (fnp_no, (0)); /* has to succeed, we are under lock */ /*** turns off io_manager_assigned for us, nailing io_manager callers */ auto_fnp_msg.fnp_no = fnp_info.fnp_number; auto_fnp_msg.state = FNP_DOWN; auto_fnp_msg.flags = "0"b; auto_fnp_msg.deconfigured = "1"b; unspec (message) = unspec (auto_fnp_msg); call pxss$ring_0_wakeup (fnp_info.boot_process_id, fnp_info.boot_ev_chan, message, (0)); end; /*** all callers of io_manager must hold LCTE lock and check io_manager_assigned */ deconfigure_return: call unlock_fnp; deconfigure_return_unlocked: if code = 0 then do; call config_$find_2 ("prph", "fnp" || fnp_info.fnp_tag, prph_fnp_cardp); prph_fnp_card.state = "off"; call syserr (ANNOUNCE, "fnp_util: FNP ^a deleted from configuration^[ by ^a^].", fnp_info.fnp_tag, pds$processid ^= tc_data$initializer_id, pds$process_group_id); end; a_code = code; return; fdump: entry (a_fnp_no, a_fnp_type, a_fnp_mem_size, a_ptr, a_code); /* entry to read in contents of FNP core for fdump_fnp_. It is passed a pointer * to the segment in which the dump is supposed to be put. The one-page fnp_dump_seg * is wired down, and FNP core is read into it in chunks. */ /* Like load, locking must follow wiring of fnp dump seg */ fnp_no = a_fnp_no; fnp_type = a_fnp_type; fnp_mem_size = a_fnp_mem_size; segptr = a_ptr; call validate_fnp_ret ("fdump"); if fnp_info.running | fnp_info.bootloading | fnp_info.t_and_d_in_progress then do; code = error_table_$invalid_state; /* nope */ go to ret_bad_code; end; fnp_dump_ptr = addr (fnp_dump_seg$); on cleanup begin; if fnp_dump_seg.lock = pds$processid then call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event); end; call lock$wait (addr (fnp_dump_seg.lock), fdump_seg_event, code); if code ^= 0 then go to ret_bad_code; call wire_dump_seg; if code ^= 0 then go to unlock_dump_seg; fnp_dump_seg.flags = "0"b; /* aggregately */ call assign_interrupt (dump_interrupt, code); /* we will handle DIA interrupts for this */ if code ^= 0 /* checks to make sure we haven't been forcible unassigned */ then go to unwire_buffer; data_ptr = addr (fnp_dump_seg.data); if fnp_type = DN6670 then dump_6670_control.unpaged = "1"b; /* absolute 36-bit addressing for DIA */ else dump_355_control.address_mode = "001"b; /* 36-bit addressing for DIA */ fnp_size = fnp_mem_size * 512; /* size of FNP core in 36-bit words */ /* before we start, set up handler for record-quota overflow */ on record_quota_overflow begin; code = error_table_$rqover; go to restore_interrupts; end; /* loop reading chunks of FNP memory */ fnp_addr = 0; do offset = 0 to fnp_size by 1021; /* 3 words less than a page */ fnp_tally = min (1021, fnp_size - offset); call setup_dump_ctl_word; call fdump_seg_io ("fdump", "75"b3, code); /* test data xfer */ if code ^= 0 then go to restore_interrupts; /* Now copy the data into the permanent seg */ ptr (segptr, offset) -> tally_words = addr (fnp_dump_seg.data (2)) -> tally_words; /* word 0 and 1 are control words */ end; restore_interrupts: call unassign_interrupt; unwire_buffer: call unwire_dump_seg; /* and unwire buffer */ unlock_dump_seg: call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event); ret_bad_code: a_code = code; return; fdump_seg_io: proc (caller, a_diaop, code); dcl caller char (32); dcl a_diaop bit (6) aligned; dcl code fixed bin (35); start_time = clock (); if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util$fdump_seg_io: ^2.3b for ^a.", a_diaop, caller); call lock_fnp; /* must be locked to connect */ if ^fnp_info.io_manager_assigned then do; call unlock_fnp; code = error_table_$io_not_assigned; return; end; fnp_dump_seg.fdump = "1"b; /* so notify can be done */ call pxss$addevent (tty_ev); call connect_to_dia (auto_absadr, 0, a_diaop, dia_timeout); call unlock_fnp; if ^dia_timeout then do; call pxss$wait; /* wait for interrupt */ if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util (fdump_seg_io): returned from first wait."); end; else do; call pxss$delevent (tty_ev); if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util (fdump_seg_io): DIA timeout."); code = error_table_$no_io_interrupt; return; end; do while (fnp_dump_seg.fdump); /* when we get notify, make sure it's the right one */ if clock () - start_time > 5 * 1000 * 1000 /* if it's been more than 5 seconds */ then do; /* punt */ if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util (fdump_seg_io): FNP timeout."); code = error_table_$no_io_interrupt; return; end; call pxss$addevent (tty_ev); if fnp_info.t_and_d_in_progress then if fnp_info.t_and_d_lev_3_occurred | fnp_info.t_and_d_lev_7_occurred then do; code = 0; return; end; if fnp_dump_seg.fdump /* it wasn't */ then call pxss$wait; /* wait some more */ else call pxss$delevent (tty_ev); /* otherwise we needn't have added event */ end; code = 0; end fdump_seg_io; dump_interrupt: entry (a_fnp_no, a_level, a_dummy); /* this is our temporary FNP interrupt handler while doing fdump i/o */ dcl a_dummy bit (36) aligned parameter; fnp_dump_ptr = addr (fnp_dump_seg$); infop = addr (dn355_data$); if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util (dump_interrupt): Interrupt for FNP ^d level ^d. fnp_dump_seg.fdump = ""^b""b", a_fnp_no, a_level, fnp_dump_seg.fdump); if fnp_dump_seg.fdump /* if we're really interested in this one */ then do; fnp_dump_seg.fdump = "0"b; /* so we'll recognize notify */ call pxss$notify (tty_ev); end; return; fnp_tandd_setup: entry (a_fnp_no, a_ev_chan, a_code); fnp_no = a_fnp_no; call validate_fnp_ret ("fnp_tandd_setup"); /* Must set up lcte ptr first if not done already, or lock won't work. Chicken/egg problem notwithstanding, this will work, because other guy doing same thing. */ temp_fnp_name = get_fnp_name_ (fnp_no); if fnp_info.lcte_ptr = null then do; call priv_channel_manager$get_devx (temp_fnp_name, devx, code); if code ^= 0 then go to ret_bad_code; fnp_info.lcte_ptr = addr (tty_buf$lct_ptr -> lct.lcte_array (devx)); end; call lock_fnp; if fnp_info.bootloading | fnp_info.running | fnp_info.t_and_d_in_progress then do; code = error_table_$invalid_state; go to tandd_setup_loses_unlock; end; call fnp_multiplexer$assign (fnp_no, code); if code ^= 0 then do; call syserr$error_code (ANNOUNCE, code, "fnp_util: channel assignment failed for FNP ^a.", fnp_info.fnp_tag); go to tandd_setup_loses_unlock; end; call ioam_$assign ((fnp_info.io_manager_chx), fnp_tandd_release_handler, code); if code ^= 0 then do; call syserr$error_code (ANNOUNCE, code, "fnp_util: ioam_$assign failed for FNP ^a.", fnp_info.fnp_tag); go to tandd_setup_loses_unlock; end; fnp_info.boot_process_id = pds$processid; fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b; call syserr (ANNOUNCE, "fnp_util: assigned FNP ^a to ^a for T & D.", temp_fnp_name, pds$process_group_id); fnp_info.t_and_d_in_progress = "1"b; tandd_setup_loses_unlock: if code = 0 then fnp_info.boot_ev_chan = a_ev_chan; call unlock_fnp; a_code = code; return; fnp_tandd_release_handler: entry (a_devx, a_code); devx = a_devx; infop = addr (dn355_data$); fnp_dump_ptr = addr (fnp_dump_seg$); on cleanup begin; if fnp_dump_seg.lock = pds$processid then call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event); end; do fnp_no = 1 to datanet_info.no_of_355s; fnpp = addr (datanet_info.per_datanet (fnp_no)); if devx = fnp_info.io_manager_chx then if fnp_info.t_and_d_in_progress then call release_t_and_d; end; return; /**** T and D does not have to worry about force deconfiguration, since it is completely released at deconfigure time. Validate_fnp_tandd_ret will generate an error code if deconfiguration has stolen the FNP. */ fnp_tandd_detach: entry (a_fnp_no, a_code); fnp_no = a_fnp_no; call validate_fnp_tandd_ret ("fnp_tandd_detach"); call lock_fnp; call validate_assigned_ret ("fnp_tandd_detach"); call mask_dia; fnp_info.boot_process_id = "000000000000"b3; fnp_info.t_and_d_in_progress = "0"b; fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b; call ioam_$unassign ((fnp_info.io_manager_chx), (0)); call fnp_multiplexer$unassign (fnp_no, code); if code ^= 0 then call syserr$error_code (ANNOUNCE, code, "fnp_util: io channel unassignment failed for FNP ^a.", fnp_info.fnp_tag); call syserr (ANNOUNCE, "fnp_util: releasing FNP ^a from ^a", fnp_info.fnp_id.fnp_tag, pds$process_group_id); call unlock_fnp; a_code = 0; return; fnp_tandd_mask: entry (a_fnp_no, a_code); fnp_no = a_fnp_no; call validate_fnp_tandd_ret ("fnp_tandd_mask"); call lock_fnp; call validate_assigned_ret ("fnp_tandd_mask"); call mask_dia; call unlock_fnp; a_code = 0; return; fnp_tandd_send_int: entry (a_fnp_no, a_level, a_code); fnp_no = a_fnp_no; call validate_fnp_tandd_ret ("fnp_tandd_send_int"); call lock_fnp; call validate_assigned_ret ("fnp_tandd_send_int"); fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b; call connect_to_dia (0, a_level, "71"b3, dia_timeout); call unlock_fnp; if dia_timeout then a_code = error_table_$no_io_interrupt; a_code = 0; return; fnp_tandd_get_ints: entry (a_fnp_no, a_ints, a_code); fnp_no = a_fnp_no; call validate_fnp_tandd_ret ("fnp_tandd_get_ints"); call lock_fnp; call validate_assigned_ret ("fnp_tandd_get_ints"); a_ints = fnp_info.t_and_d_lev_3_occurred || fnp_info.t_and_d_lev_7_occurred; fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b; call unlock_fnp; a_code = 0; return; fnp_tandd_read: entry (a_fnp_no, a_ptr, a_count, a_fnp_addr, a_fnp_type, a_code); opcode = "75"b3; go to fnp_t_and_d_rw_merge; fnp_tandd_write: entry (a_fnp_no, a_ptr, a_count, a_fnp_addr, a_fnp_type, a_code); opcode = "76"b3; fnp_t_and_d_rw_merge: /**** To avoid LONG delays in deconfiguration, this does not lock the LCTE lock except around the connects themselves. */ fnp_no = a_fnp_no; segptr = a_ptr; nwords = a_count; fnp_type = a_fnp_type; fnp_addr = a_fnp_addr; fnp_dump_ptr = addr (fnp_dump_seg$); call validate_fnp_tandd_ret ("fnp_tandd_rw"); on cleanup begin; if fnp_dump_seg.lock = pds$processid then call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event); end; data_ptr = addr (fnp_dump_seg.data); call lock$wait (addr (fnp_dump_seg.lock), fdump_seg_event, code); if code ^= 0 then go to ret_bad_code; if fnp_type = DN6670 then dump_6670_control.unpaged = "1"b; else dump_355_control.address_mode = "1"b3; offset = 0; do while (nwords > 0); fnp_tally = min (308, nwords); nwords = nwords - fnp_tally; call setup_dump_ctl_word; if opcode = "76"b3 /* WRITE */ then addr (fnp_dump_seg.data (2)) -> tally_words = addrel (segptr, offset) -> tally_words; call wire_dump_seg; if code ^= 0 then go to unlock_dump_seg; fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b; fnp_info.t_and_d_notify_requested = "1"b; call fdump_seg_io ("fnp_tandd_rw", opcode, code); fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b; call unwire_dump_seg; if code ^= 0 then go to unlock_dump_seg; if opcode = "75"b3 /* READ */ then addrel (segptr, offset) -> tally_words = addr (fnp_dump_seg.data (2)) -> tally_words; offset = offset + fnp_tally; end; code = 0; go to unlock_dump_seg; validate_assigned_ret: procedure (caller); declare caller char (32); if ^fnp_info.io_manager_assigned then do; code = error_table_$io_not_assigned; if datanet_info.trace | datanet_info.debug_stop then call syserr$error_code (ANNOUNCE, code, "fnp_util$validate_assigned_ret (^a): IO manager assignment lacking.", caller); call STOP_CHECK ("validate_assigned_ret"); call unlock_fnp; go to ret_bad_code; end; return; end validate_assigned_ret; validate_fnp_ret: procedure (caller); declare caller char (32); /* internal procedure to ensure that FNP number is reasonable */ infop = addr (dn355_data$); if fnp_no <= 0 | fnp_no > max_no_355s then do; code = error_table_$io_not_defined; ERROR: if datanet_info.trace | datanet_info.debug_stop then call syserr$error_code (ANNOUNCE, code, "fnp_util$^a: Invalid call for FNP ^d.", caller, fnp_no); call STOP_CHECK (caller); go to ret_bad_code; end; if ^tty_buf$fnp_config_flags (fnp_no) then do; fnpp = null; code = error_table_$io_not_defined; go to ERROR; end; code = 0; fnpp = addr (datanet_info.per_datanet (fnp_no)); mbxp = fnp_info.mbx_pt; if datanet_info.trace then call syserr (ANNOUNCE, "fnp_util$^a: Tracing call for fnp ^a.", caller, fnp_info.fnp_tag); return; end validate_fnp_ret; validate_fnp_tandd_ret: proc (caller); declare caller char (32); call validate_fnp_ret (caller); if ^fnp_info.t_and_d_in_progress then code = error_table_$invalid_state; else if fnp_info.boot_process_id ^= pds$processid then code = error_table_$io_no_permission; if code ^= 0 then do; if (datanet_info.trace | datanet_info.debug_stop) then call syserr$error_code (ANNOUNCE, code, "fnp_util$^a: Invalid call.", caller); go to ret_bad_code; end; return; /* validate_fnp_ret did trace */ end validate_fnp_tandd_ret; setup_dump_ctl_word: proc; if fnp_type = DN6670 then do; dump_6670_control.fnp_address = fnp_addr + 2 * offset; dump_6670_control.tally = fnp_tally; end; else do; dump_355_control.fnp_address = bit (fixed (fnp_addr + 2 * offset, 15), 15); dump_355_control.tally = fnp_tally; end; end; wire_dump_seg: proc; astep = get_ptrs_$given_segno (fixed (baseno (fnp_dump_ptr), 17)); call pc_abs$wire_abs_contig (astep, 0, 1, code); /* wire a page */ if code = 0 then auto_absadr = absadr (addr (fnp_dump_seg.data), code); /* fdump_seg_io needs this */ end; unwire_dump_seg: proc; astep = get_ptrs_$given_segno (fixed (baseno (fnp_dump_ptr), 17)); call pc_abs$unwire_abs (astep, 0, 1); return; end unwire_dump_seg; assign_interrupt: proc (handler, code); /* internal procedure to set handler for IOM interrupt to our proc. */ dcl handler entry; dcl iom_code fixed bin (35); dcl code fixed bin (35); call lock_fnp; /* discourage reconfiguration */ if ^fnp_info.io_manager_assigned /* already deconfigured? */ then if ^fnp_info.available /* already deconfigured! */ then do; code = error_table_$io_not_configured; return; end; /**** It may already be unassigned, as in dump of down MPX */ if fnp_info.io_manager_assigned then do; call io_manager$unassign (fnp_info.io_manager_chx, code); if code ^= 0 then call syserr$error_code (CRASH, code, "fnp_util: Could not unassign FNP ^a at reassign_interrupt.", fnp_info.fnp_tag); fnp_info.io_manager_assigned = "0"b; end; /* now make new assignment */ call io_manager$assign (fnp_info.io_manager_chx, fnp_info.io_chanid, handler, (fnp_no), (null ()), iom_code); call unlock_fnp; if code = 0 /* if there wasn't anything more interesting to report */ then do; code = iom_code; /* then report this */ fnp_info.io_manager_assigned = "1"b; end; return; end assign_interrupt; unassign_interrupt: procedure; call io_manager$unassign (fnp_info.io_manager_chx, (0)); fnp_info.io_manager_assigned = "0"b; return; end unassign_interrupt; connect_to_dia: proc (address, level, cmd, timeout); /* internal procedure to do DIA i/o */ dcl old_pcw bit (36) aligned; dcl timeout bit (1) aligned; dcl address fixed bin (24); dcl level fixed bin (3); dcl cmd bit (6) aligned; dcl 1 ima aligned like io_manager_arg; dcl paged bit (1) aligned; dcl 1 a_dia_pcw aligned based (mbxp), /* better declaration than the one used when MCS is running */ 2 address fixed bin (18) unsigned unaligned, 2 error bit (1) unaligned, 2 pad1 bit (3) unaligned, 2 parity bit (1) unaligned, 2 pad2 bit (1) unaligned, 2 pad3 bit (3) unaligned, /* if we used address extension this would be important */ 2 interrupt_level fixed bin (3) unsigned unaligned, 2 command bit (6) unaligned; paged = "0"b; go to common; connect_to_dia_paged: entry (address, level, cmd, timeout); paged = "1"b; common: unspec (a_dia_pcw) = ""b; if address > sys_info$seg_size_256K then call syserr (CRASH, "fnp_util (connect_to_dia): address > 256K"); a_dia_pcw.address = address; a_dia_pcw.interrupt_level = level; a_dia_pcw.command = cmd; if datanet_info.trace | datanet_info.debug_stop then call syserr (ANNOUNCE, "fnp_util (connect): ^[ paged PTP ^p^;^s^] PCW ^w", paged, fnp_info.ptp, unspec (datanet_mbx.dia_pcw)); if datanet_info.debug_stop then do; call syserr (ANNOUNCE, "fnp_util: stop before connect."); call syserr (CRASH, " ptp: ^p astep: ^p", fnp_info.ptp, fnp_info.astep); end; /* parity on pcw REQUIRED */ string (datanet_mbx.dia_pcw) = dn355_util$compute_parity (string (datanet_mbx.dia_pcw)); ima.chx = fnp_info.io_manager_chx; if paged then ima.ptp = fnp_info.ptp; else ima.ptp = null (); old_pcw = unspec (a_dia_pcw); call io_manager$connect_direct (ima); do i = 1 to 100000 while (unspec (a_dia_pcw) = old_pcw); end; if a_dia_pcw.error | old_pcw = unspec (a_dia_pcw) then do; call syserr (ANNOUNCE, "fnp_util (connect_to_dia): DIA mailbox PCW ^[error^;timeout^] for channel ^a, FNP ^a. PCW was ^w.", a_dia_pcw.error, fnp_info.io_chanid, fnp_info.fnp_tag, old_pcw); timeout = "1"b; end; else timeout = "0"b; return; end connect_to_dia; mask_dia: procedure; call io_manager$mask (fnp_info.io_manager_chx); /* mask the channel to initialize it */ end mask_dia; internal_unwire: procedure; declare px fixed bin; /* internal procedure to undo work of wire entry */ if fnpp = null then return; if ^fnp_info.wired then return; ioptp = fnp_info.ptp; if ioptp ^= null () then do px = FIRST_BOOTLOAD_PAGEX to FIRST_BOOTLOAD_PAGEX + fnp_info.n_pages_wired; unspec (page_table.ptw (px)) = ""b; /* as of next connect, no more references */ end; astep = fnp_info.astep; call pc_abs$unwire_abs (astep, 0, fnp_info.n_pages_wired); call grab_aste$release_io (astep); fnp_info.wired = "0"b; return; end internal_unwire; release_t_and_d: procedure; declare unlock_dump_seg bit (1) aligned; call lock$wait (addr (fnp_dump_seg.lock), fdump_seg_event, code); /* wait for finish */ unlock_dump_seg = (code = 0); /* if user held lock for other reason, leave it locked ? */ call syserr (0, "fnp_util: force detaching FNP ^a from process ^w.", fnp_info.fnp_id.fnp_tag, fnp_info.boot_process_id); call lock_fnp; /* hold the LCTE lock (or the config lock) */ fnp_info.boot_process_id = "000000000000"b3; fnp_info.boot_ev_chan = 0; fnp_info.t_and_d_in_progress = "0"b; fnp_info.t_and_d_lev_3_occurred, fnp_info.t_and_d_lev_7_occurred = "0"b; call fnp_multiplexer$unassign (fnp_no, code); if code ^= 0 then call syserr$error_code (ANNOUNCE, code, "fnp_util: io channel unassignment failed for FNP ^a.", fnp_info.fnp_tag); call unlock_fnp; if unlock_dump_seg then call lock$unlock (addr (fnp_dump_seg.lock), fdump_seg_event); return; end release_t_and_d; lock_fnp: procedure; declare code fixed bin (35); if locked | config_locked then call syserr (CRASH, "fnp_util: lock_fnp called with lock locked."); locked, config_locked = "0"b; call lock$lock_fast (addr (datanet_info.configuration_lock)); config_locked = "1"b; /* LCTE cannot get initialized after this point */ if fnp_info.lcte_ptr = null () then return; /* that is the whole story */ else if ^fnp_info.lcte_ptr -> lcte.initialized /* no mpx in the house */ then return; /* and the config lock locks out T&D I/O */ /*** here, there is a multiplexer, so we have to lock against it */ call fnp_multiplexer$fnp_lock (fnpp, code); if code = 0 then do; locked = "1"b; /* lcte was initialized, and we now own it */ call lock$unlock_fast (addr (datanet_info.configuration_lock)); /* if init_multiplexer finds the LCTE initialized, it aborts */ /* so all we are protecting against is ourselves */ config_locked = "0"b; end; return; unlock_fnp: entry; if locked then call fnp_multiplexer$fnp_unlock (fnpp); locked = "0"b; if config_locked then call lock$unlock_fast (addr (datanet_info.configuration_lock)); config_locked = "0"b; return; end lock_fnp; STOP_CHECK: procedure (Tracer); declare Tracer char (*); if datanet_info.debug_stop then call syserr (CRASH, "fnp_util$^a: Debugging stop (type go to continue).", Tracer); return; end STOP_CHECK; get_page_table: procedure (code); declare pagex fixed bin; declare px fixed bin; declare 1 seg_pt (0:255) aligned like l68_core_ptw based (ptp); declare ptp pointer; declare code fixed bin (35); io_page_table_size = 256; /* always, for datanet */ call ioi_page_table$get (io_page_table_size * sys_info$page_size, fnp_info.ptx, code); /* Direct channel has no bounds check so we need all 256 */ if code ^= 0 then return; fnp_info.ptp, ioptp = ioi_page_table$ptx_to_ptp (fnp_info.ptx); unspec (page_table) = ""b; /**** leave page zero invalid */ /**** First, dn355_mailbox */ do px = 1 to 3; io_ptwp = addr (page_table.ptw (px)); io_ptw.address = px; /* absolute page number */ io_ptw.write = "1"b; io_ptw.valid = "1"b; end; /**** Now, tty_buf */ astep = get_ptrs_$given_segno (segno (addr (tty_buf$))); pagex = FIRST_TTY_BUF_PAGEX; ptp = addwordno (astep, sst$astsize); do px = 0 to bin (aste.csl, 9) - 1; /* no null pages here */ io_ptwp = addr (page_table.ptw (pagex)); io_ptw.address = seg_pt (px).frame; io_ptw.write = "1"b; io_ptw.valid = "1"b; pagex = pagex + 1; end; /* tty_buf is now described to the channel */ return; fill_bootload_page_table: entry; /* fill in io ptws for bootload segment */ /**** astep is already set to the bootload image aste */ pagex = FIRST_BOOTLOAD_PAGEX; ptp = addwordno (astep, sst$astsize); auto_absadr = pagex * sys_info$page_size; ioptp = fnp_info.ptp; do px = 0 to fnp_info.n_pages_wired - 1; io_ptwp = addr (page_table.ptw (pagex)); io_ptw.address = seg_pt (px).frame; io_ptw.write = "0"b; io_ptw.valid = "1"b; pagex = pagex + 1; end; if datanet_info.trace then do px = 0 to 255; if unspec (page_table.ptw (px)) ^= ""b then call syserr (ANNOUNCE, " ^4o ^w", px, unspec (page_table.ptw (px))); end; return; end get_page_table; /* format: off */ /* INCLUDE FILES */ %page; %include aste; %page; %include config_prph_fnp_card; %page; %include dn355_mailbox; %page; %include lct; %page; %include dn355_data; %page; %include pcb; %page; %include fnp_dump_seg; %page; %include fnp_types; %page; %include io_manager_dcls; %page; %include io_page_tables; %page; %include io_chnl_util_dcls; %page; %include "ptw.l68"; declare ptp pointer; %page; %include syserr_constants; %page; %include tty_buf; %include fnp_mpx_msg_; /* BEGIN MESSAGE DOCUMENTATION Message: Loading FNP X, CORE_IMAGE VERSION S: $info T: Answering service initialization and each subsequent FNP bootload. M: Loading of FNP X has begun with a core image named CORE_IMAGE (normally "mcs") of version number VERSION. A: $ignore Message: fnp_util$wire: FNP T already wired (trace) Message: fnp_util$wire: failed. REASON (trace) Message: fnp_util$load: FNP load already in progress for FNP T. Message: fnp_util$load: FNP T not wired. Message: fnp_util$load: FNP T is running. (trace) Message: fnp_util$load: FNP T is running T&D. Message: fnp_util$load: Error loading FNP T. REASON (trace) Message: fnp_util$unwire: Unwire failed for FNP T. REASON Message: fnp_util$configure: FNP T already configured. Message: fnp_util: FNP T added to configuration^[ by NAME^]. Message: FNP T deleted from configuration^[ by ^a^]. Message: fnp_util$fdump_seg_io: IO_OP for CALLER (trace) Message: fnp_util: channel assignment failed for FNP ^T REASON. (tandd) Message: fnp_util: ioam_$assign failed for FNP T. REASON (tandd) Message: fnp_util: assigned FNP T to NAME for T & D. Message: fnp_util: io channel unassignment failed for FNP T. (tandd) Message: fnp_util: releasing FNP T from NAME (tandd) Message: fnp_util$validate_assigned_ret (CALLER): IO manager assignment lacking. (trace) Message: fnp_util$ENTRY: Invalid call for FNP INDEX. (not in cdeck) Message: fnp_util$ENTRY: Tracing call for fnp T. Message: fnp_util$ENTRY: Invalid call. (trace) Message: fnp_util: Could not unassign FNP T at reassign_interrupt. Message: fnp_util: force detaching FNP T from process PID. Message: fnp_util: io channel unassignment failed for FNP T. (tandd) Message: fnp_util: lock_fnp called with lock locked. Message: fnp_util$ENTRY: Debugging stop (type go to continue). END MESSAGE DOCUMENTATION */ end fnp_util;  mcs_timer.pl1 11/11/89 1132.7r w 11/11/89 0825.4 159777 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style4,delnl,insnl,ifthenstmt,indnoniterend */ mcs_timer: procedure (); MAIN_RETURN: /* This is the only way out of this program. Everything */ return; /* does a non-local goto to here */ /* * MCS_TIMER -- Ring zero MCS timer manager * * This procedure implements timers for ring zero MCS. When a timer comes due, * a TIMER interrupt is delivered to the lucky channel. For all the frankly * fascinating details, see MTB-xxx. * * Written 24 March 1982, W. Olin Sibert, for the ASEA Hyperchannel project. * Modification history: * 24 Mar 82, WOS: Initial coding, for the ASEA Hyperchannel project. * 30 May 82, WOS: Added subchan_idx parameters, changed timer_id to bit (36). * October 1982, CAH: Redesigned to use an hproc. */ declare P_devx fixed bin parameter; /* Channel number */ declare P_subchan_idx fixed bin parameter; /* Index of subchannel timer belongs to */ declare P_time fixed bin (71) parameter; /* Time for timer to come due */ declare P_timer_id bit (36) aligned parameter; /* Timer ID caller uses to tell timers apart */ declare devx fixed bin; /* Local copies of parameters */ declare subchan_idx fixed bin; declare time fixed bin (71); declare timer_id bit (36) aligned; declare wire_mask fixed bin (71); /* pmut$wire_and_mask info */ declare wire_ptr pointer; declare start_time fixed bin (71); /* Time mcs_timer was entered, for metering */ declare timer_found bit (1) aligned; /* Whether locate_timer found this sort of timer anywhere */ declare timer_was_queued bit (1) aligned; /* Whether the located timer was in the interrupt queue */ declare channel_locked bit (1) aligned; /* we managed to lock channel */ declare pds$processid bit (36) aligned external static; declare channel_manager$queued_interrupt entry (fixed bin, fixed bin, bit (72) aligned); declare privileged_mode_ut$wire_and_mask entry (fixed bin (71), pointer); declare privileged_mode_ut$unwire_unmask entry (fixed bin (71), pointer); declare pxss$unique_ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); declare syserr entry options (variable); declare tty_lock$check_for_interrupt entry (fixed bin, fixed bin, bit (72) aligned) returns (bit (1) aligned); declare tty_lock$dequeue_one_interrupt entry (fixed bin, fixed bin, bit (72) aligned); declare tty_lock$dequeue_all_interrupts entry (fixed bin, fixed bin); declare tty_lock$lock_channel_int entry (fixed bin, fixed bin, bit (72) aligned, bit (1) aligned); declare tty_lock$unlock_channel_int entry (fixed bin); declare (addr, clock, null, pointer, rel, size, stacq, unspec) builtin; /* format: on */ %page; mcs_timer$set: entry (P_devx, P_subchan_idx, P_time, P_timer_id); devx = P_devx; time = P_time; call get_id_and_subchan (); call setup_channel (); call locate_timer (); if timer_found then call timer_error ("Duplicate timer ID. Cannot set"); call allocate_timer_block (); /* Get space for the new timer */ call fill_timer_block (); /* and fill it in */ call thread_timer_block (); /* Add it to the lists */ call finished (tty_buf.timer_call_time, tty_buf.timer_set_calls); /* All done */ call unlock_timer_lock (); goto MAIN_RETURN; /* Depart */ %page; mcs_timer$change: entry (P_devx, P_subchan_idx, P_time, P_timer_id); devx = P_devx; time = P_time; call get_id_and_subchan (); call setup_channel (); call locate_timer (); if ^timer_found then call timer_error ("Timer not found. Cannot change"); if timer_was_queued then do; call tty_lock$dequeue_one_interrupt (devx, TIMER, unspec (timer_info)); /* If it came from the interrupt queue, must get a new */ call allocate_timer_block (); /* timer block. Otherwise, we can just re-use the old one */ end; else call unthread_timer_block (); call fill_timer_block (); call thread_timer_block (); call finished (tty_buf.timer_call_time, tty_buf.timer_change_calls); call unlock_timer_lock (); goto MAIN_RETURN; /* Depart */ %page; mcs_timer$reset: entry (P_devx, P_subchan_idx, P_timer_id); devx = P_devx; call get_id_and_subchan (); call setup_channel (); call locate_timer (); if ^timer_found then call timer_error ("Timer not found. Cannot reset"); if timer_was_queued then call tty_lock$dequeue_one_interrupt (devx, TIMER, unspec (timer_info)); else do; /* Remove from the lists and free */ call unthread_timer_block (); call free_timer_block (); end; call finished (tty_buf.timer_call_time, tty_buf.timer_reset_calls); call unlock_timer_lock (); goto MAIN_RETURN; /* Depart */ %page; mcs_timer$reset_all: entry (P_devx); devx = P_devx; call setup_channel (); call tty_lock$dequeue_all_interrupts (devx, TIMER); /* Get the urgent ones first */ do while (lcte.timer_offset ^= ""b); /* Keep flushing from the front of the queue */ timer_ptr = pointer (ttybp, lcte.timer_offset); call unthread_timer_block (); call free_timer_block (); end; call finished (tty_buf.timer_call_time, tty_buf.timer_reset_calls); /* There. That was easy, wasn't it? */ call unlock_timer_lock (); goto MAIN_RETURN; /* Depart */ %page; mcs_timer$verify_lock: entry (); ttybp = addr (tty_buf$); /* We can't call setup_global, since this entry doesn't */ /* follow the usual conventions about locking */ if (tty_buf.timer_lock = pds$processid) then call syserr (CRASH, "mcs_timer: Crawlout with MCS timer lock locked."); return; /* not likely, but better than falling through */ %page; /* This is called by mcs_timer_daemon to do the work */ mcs_timer$poll: entry () returns (fixed bin (71)); call setup_global (); POLLING_LOOP: if tty_buf.next_timer_offset = ""b then do; /* No more left */ call finished (tty_buf.timer_polling_time, tty_buf.timer_poll_calls); call unlock_timer_lock (); return (0); end; timer_ptr = pointer (ttybp, tty_buf.next_timer_offset); /* Find the first one to deliver */ time = timer.time; /* Copy data from the timer */ timer_id = timer.data; /* since we are about to free it */ devx = timer.devx; subchan_idx = timer.subchan_idx; if (time > clock ()) then do; /* No more left */ call finished (tty_buf.timer_polling_time, tty_buf.timer_poll_calls); call unlock_timer_lock (); return (time); end; call unthread_timer_block (); call free_timer_block (); timer_info.id = timer_id; timer_info.subchan_idx = subchan_idx; call tty_lock$lock_channel_int (devx, TIMER, unspec (timer_info), channel_locked); if channel_locked then do; call unlock_timer_lock (); call channel_manager$queued_interrupt (devx, TIMER, unspec (timer_info)); call tty_lock$unlock_channel_int (devx); call lock_timer_lock (); end; goto POLLING_LOOP; %page; locate_timer: procedure (); /* This procedure finds the requested timer for a channel, given the timer ID, and sets the global variables to indicate its whereabouts. */ timer_found = tty_lock$check_for_interrupt (devx, TIMER, unspec (timer_info)); if timer_found then do; /* There's one waiting for you when you get home */ timer_ptr = null (); /* for good measure */ timer_was_queued = "1"b; /* indicate where found */ return; end; timer_was_queued = "0"b; timer_found = "1"b; do timer_ptr = pointer (ttybp, lcte.timer_offset) repeat (pointer (ttybp, timer.next_for_lcte)) while (rel (timer_ptr) ^= ""b); if (timer.data = timer_id) then if (timer.subchan_idx = subchan_idx) then return; /* Jackpot */ end; timer_found = "0"b; timer_ptr = null (); /* Again, for good measure */ return; end locate_timer; %page; allocate_timer_block: procedure (); /* Procedure to get space for a timer block, and abort if it can't */ call tty_space_man$get_space (size (timer), timer_ptr); if (timer_ptr = null ()) then call timer_error ("Cannot get space to set"); return; end allocate_timer_block; free_timer_block: procedure (); /* Procedure to return space used by a timer block */ call tty_space_man$free_space (size (timer), timer_ptr); return; end free_timer_block; fill_timer_block: procedure (); /* Procedure to fill in a timer block from the global variables */ unspec (timer) = ""b; timer.devx = devx; timer.subchan_idx = subchan_idx; timer.data = timer_id; timer.time = time; return; end fill_timer_block; %page; thread_timer_block: procedure (); /* Procedure to thread in the current timer block onto the global timer queue and the queue for the lcte */ /* Also updates the global variables in tty_buf */ declare soonest_timer_ptr pointer; declare next_timer_ptr pointer; declare prev_timer_ptr pointer; declare found_it bit (1) aligned; lctep = addr (lct.lcte_array (timer.devx)); /* Who this one belongs to */ if (tty_buf.next_timer_offset ^= ""b) then do; /* Set soonest_timer_ptr to mean we need to update */ soonest_timer_ptr = pointer (ttybp, tty_buf.next_timer_offset); if (soonest_timer_ptr -> timer.time >= timer.time) then soonest_timer_ptr = timer_ptr; /* New one is soonest in the list */ else soonest_timer_ptr = null (); /* Otherwise, leave it alone */ end; else soonest_timer_ptr = timer_ptr; /* There were none before, so this must be it */ prev_timer_ptr = pointer (ttybp, 0); /* Prepare to rethread */ next_timer_ptr = pointer (ttybp, tty_buf.next_timer_offset); found_it = "0"b; do while ((rel (next_timer_ptr) ^= ""b) & (^found_it)); /* Look for a place to thread it in */ if (next_timer_ptr -> timer.time > timer.time) then found_it = "1"b; else do; prev_timer_ptr = next_timer_ptr; next_timer_ptr = pointer (ttybp, next_timer_ptr -> timer.next_timer); end; end; if rel (prev_timer_ptr) ^= ""b then prev_timer_ptr -> timer.next_timer = rel (timer_ptr); /* Splice it in, if we can */ if rel (next_timer_ptr) ^= ""b then next_timer_ptr -> timer.prev_timer = rel (timer_ptr); timer.next_timer = rel (next_timer_ptr); timer.prev_timer = rel (prev_timer_ptr); next_timer_ptr = pointer (ttybp, lcte.timer_offset); timer.prev_for_lcte = ""b; /* Thread in at the beginning of the LCTE list */ timer.next_for_lcte = rel (next_timer_ptr); if (rel (next_timer_ptr) ^= ""b) then next_timer_ptr -> timer.prev_for_lcte = rel (timer_ptr); lcte.timer_offset = rel (timer_ptr); if (soonest_timer_ptr ^= null ()) then do; /* Must update "next time" */ tty_buf.next_timer_offset = rel (soonest_timer_ptr); call pxss$unique_ring_0_wakeup (tty_buf.timer_process, tty_buf.timer_ev_chn, 0, (0)); end; tty_buf.timer_count = tty_buf.timer_count + 1; return; end thread_timer_block; %page; unthread_timer_block: procedure (); /* Procedure to unthread the current timer block from the global timer queue and the lcte queue */ /* Also updates the global variables in tty_buf, changing the next timer info if necessary */ declare soonest_timer_ptr pointer; /* For updating tty_buf */ declare next_timer_ptr pointer; declare prev_timer_ptr pointer; prev_timer_ptr = pointer (ttybp, timer.prev_timer); /* First, unthread it from the global list */ next_timer_ptr = pointer (ttybp, timer.next_timer); if (rel (timer_ptr) = tty_buf.next_timer_offset) then soonest_timer_ptr = next_timer_ptr; /* If we're removing the first one, update */ else soonest_timer_ptr = null (); /* If not skip this step */ if (timer.next_timer ^= ""b) then next_timer_ptr -> timer.prev_timer = timer.prev_timer; if (timer.prev_timer ^= ""b) then prev_timer_ptr -> timer.next_timer = timer.next_timer; tty_buf.timer_count = tty_buf.timer_count - 1; if soonest_timer_ptr ^= null () then do; /* This means the one we unthreaded was the first */ tty_buf.next_timer_offset = rel (soonest_timer_ptr); end; /* "That's longer than anybody's ever been gone before!" */ lctep = addr (lct.lcte_array (timer.devx)); /* Who this one belongs to */ prev_timer_ptr = pointer (ttybp, timer.prev_for_lcte); /* Next, unthread it from the list for the LCTE */ next_timer_ptr = pointer (ttybp, timer.next_for_lcte); if (timer.next_for_lcte ^= ""b) then next_timer_ptr -> timer.prev_for_lcte = timer.prev_for_lcte; if (timer.prev_for_lcte ^= ""b) then prev_timer_ptr -> timer.next_for_lcte = timer.next_for_lcte; if (rel (timer_ptr) = lcte.timer_offset) then lcte.timer_offset = rel (next_timer_ptr); return; end unthread_timer_block; %page; setup_global: procedure (); /* Set up for any kind of mcs_timer operation. Sets global variables, wires and masks, and locks the timer lock */ ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; lctep = null (); start_time = clock (); call lock_timer_lock (); return; end setup_global; setup_channel: procedure (); /* This procedure performs additional setup up for an operation on a particular channel, and checks that it is locked by the correct process. */ call setup_global (); lctep = addr (lct.lcte_array (devx)); if (lcte.lock ^= pds$processid) then call syserr (CRASH, "mcs_timer: Channel not locked by this process. Devx = ^d.", devx); return; end setup_channel; get_id_and_subchan: procedure (); timer_id = P_timer_id; subchan_idx = P_subchan_idx; timer_info.id = timer_id; timer_info.subchan_idx = subchan_idx; return; end get_id_and_subchan; %page; timer_error: procedure (P_message); declare P_message char (*) parameter; call syserr (tty_buf.recoverable_error_severity, "mcs_timer: ^a timer ^w for devx(subchan) ^d(^d)", P_message, timer_id, devx, subchan_idx); call finished ((0), tty_buf.timer_error_calls); /* Don't meter calls that don't complete */ call unlock_timer_lock (); goto MAIN_RETURN; /* Depart */ end timer_error; finished: procedure (P_time_meter, P_count); declare P_time_meter fixed bin (71) parameter; declare P_count fixed bin (35) parameter; P_time_meter = P_time_meter + (clock () - start_time); if (P_count < 34359738367) then /* Avoid overflows. That number is 2**35-1 */ P_count = P_count + 1; return; end finished; %page; lock_timer_lock: procedure (); declare spin_start_time fixed bin (71); if (tty_buf.timer_lock = pds$processid) then call syserr (CRASH, "mcs_timer: Timer lock already locked to this process."); call privileged_mode_ut$wire_and_mask (wire_mask, wire_ptr); if ^(stacq (tty_buf.timer_lock, pds$processid, ""b)) then do; spin_start_time = clock (); /* Didn't lock at first attempt */ tty_buf.timer_lock_wait_count = tty_buf.timer_lock_wait_count + 1; do while (^stacq (tty_buf.timer_lock, pds$processid, ""b)); end; tty_buf.timer_lock_wait_time = tty_buf.timer_lock_wait_time + (clock () - spin_start_time); end; tty_buf.timer_lock_count = tty_buf.timer_lock_count + 1; return; end lock_timer_lock; unlock_timer_lock: procedure (); if ^(stacq (tty_buf.timer_lock, "0"b, pds$processid)) then call syserr (CRASH, "mcs_timer: Timer lock not locked by this process."); call privileged_mode_ut$unwire_unmask (wire_mask, wire_ptr); return; end unlock_timer_lock; %page; %include mcs_timer_data; %include tty_buf; %include lct; %include mcs_interrupt_info; %include tty_space_man_dcls; %page; /* BEGIN MESSAGE DOCUMENTATION Message: mcs_timer: Timer lock already locked to this process. S: $crash T: $run M: A process that had the MCS timer lock locked tried to lock it again. A: $inform Message: mcs_timer: Timer lock not locked by this process. S: $crash T: $run M: A process called to unlock the MCS timer lock, but did not have it locked. A: $inform Message: mcs_timer: Channel not locked by this process. Devx = DDDD. S: $crash T: $run M: A process called to perform an MCS timer operation, but the channel it specified (devx DDDD) was not locked by the calling process. by the calling process. A: $inform Message: mcs_timer: Timer not found. Cannot OOOOO timer NNN for devx(subchan) DDD(SSS). S: $log T: $run M: An attempt was made to perform operation OOOOO (reset or change) on an MCS timer when no timer or queued timer interrupt with the specified ID could be found for the requesting channel. The call is ignored. A: $inform Message: mcs_timer: Duplicate timer ID. Cannot set timer NNN for devx(subchan) DDD(SSS). S: $log T: $run M: An attempt was made to set an MCS timer with the specified timer ID, but the channel already had an outstanding timer or queued timer interrupt with that ID. The call is ignored. A: $inform Message: mcs_timer: Cannot get space to set timer NNN for devx(subchan) DDD(SSS). S: $log T: $run M: An attempt was made to set an MCS timer with the specified timer ID, but it was not possible to allocate the necessary space in tty_buf to hold timer data block. The call is ignored. A: $inform END MESSAGE DOCUMENTATION */ end mcs_timer;  mcs_trace.pl1 11/11/89 1132.7r w 11/11/89 0825.4 32445 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style3,linecom,ifthenstmt,ifthendo,ifthen,^indnoniterdo,indnoniterend,indcomtxt,^inditerdo,indend,idind30 */ mcs_trace: procedure (Devx); /* Routine for tracing events in ring 0 MCS. */ /* Written by C. Hornig, September 1979. */ dcl Devx fixed bin parameter; dcl Chainp pointer parameter; %include mcs_trace_data; dcl formline_ entry (fixed bin, fixed bin, pointer, fixed bin (21), fixed bin); dcl initialized bit aligned internal static init ("0"b); dcl mapc character (512) aligned internal static init (""); dcl (my_idx, next_idx) fixed bin (35) aligned; dcl (bsize, i) fixed bin; dcl bwords (256) bit (36) aligned based (blockp); dcl (addr, binary, bit, clock, length, pointer, stacq) builtin; /* * * * * * * * * * * * * * * * * * * */ call setup; call get_entry; call formline_ (2, 3, addr (trace_entry.message), length (trace_entry.message), 1); return_to_caller: return; /* * * * * * * * * * BUFFER_CHAIN * * * * * * * * * */ buffer_chain: entry (Devx, Chainp); call setup; do blockp = Chainp repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b); bsize = 16 * (1 + buffer.size_code); call fill_in (" ^d words at ^6.3b; ^d chars; flags: ^[eop,^]^[conv,^]^[break^]", bsize, rel (blockp), buffer.tally, buffer.flags.end_of_page, buffer.flags.converted, buffer.flags.break); do i = 1 by 2 to bsize; if (bwords (i) | bwords (i + 1)) ^= ""b then call fill_in (" ^2d: ^w ^w ^8a", (i - 1) * 4, bwords (i), bwords (i + 1), translate (substr (string (buffer.chars), i * 4 - 7, 8), mapc)); end; end; return; /* * * * * * * * * * INIT * * * * * * * * * */ setup: procedure; ttybp = addr (tty_buf$); if ^initialized then do; mapc = copy (".", 32) || substr (collate9 (), 33, 95) || copy (".", 385); initialized = "1"b; end; if ^tty_buf.trace.enable then goto return_to_caller; if tty_buf.trace.data_offset = ""b then goto return_to_caller; trace_array_ptr = pointer (ttybp, tty_buf.trace.data_offset); if trace_array.num_entries = 0 then goto return_to_caller; lctep = addr (tty_buf.lct_ptr -> lct.lcte_array (Devx)); if lcte.flags.trace = (tty_buf.trace.default_mode & ^lcte.flags.trace_force) then goto return_to_caller; end setup; /* * * * * * * * * * GET_ENTRY * * * * * * * * * */ get_entry: procedure; snarf_trace_entry: my_idx = binary (trace_array.idx); /* idx is where our message will go */ next_idx = my_idx + 1; if next_idx > trace_array.num_entries then next_idx = 1; /* where next entry will go */ if ^stacq (trace_array.idx, unspec (next_idx), unspec (my_idx)) then goto snarf_trace_entry; /* now grab the entry */ trace_entry_ptr = addr (trace_array.entry (my_idx)); trace_entry.time = clock (); trace_entry.devx = Devx; end get_entry; /* * * * * * * * * * FILL_IN * * * * * * * * * */ fill_in: procedure options (variable, non_quick); call get_entry; call formline_ (1, 2, addr (trace_entry.message), length (trace_entry.message), 1); end fill_in; %include tty_buf; %include lct; %include tty_buffer_block; end;  tty_interrupt.pl1 11/11/89 1132.7r w 11/11/89 0825.4 310941 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ tty_interrupt: proc (a_wtcbp, a_type, a_info); /* DESCRIPTION: interrupt handler for logical terminal channels. */ /* HISTORY: Written by Robert Coren, 08/01/78. Modified: 01/20/79 by Bernard Greenberg: Negotiated interrupt-time echo. 03/01/79 by J. Stern: for wakeup table processing. 06/29/79 by Bernard Greenberg: FNP (multiplexer)-negotiated echo. 04/01/81 by Robert Coren: bugs fixed and references to dialedt removed. 05/01/81 by J. Bongiovanni: for response time metering. 06/01/82 by Robert Coren: to add handling of MASKED interrupt type. 11/01/82 by Robert Coren: to save error code returned by channel_manager$write and to trust returned pointer even if code ^= 0. 04/01/84 by Robert Coren: to fix bug caused by setting mark flag in a buffer that might have been freed. 07/20/84 by R. Michael Tague: Changed the calling sequence of pxss$wakeup_int so that the IPS signal is specified by a bit mask instead of the signal name. 09/20/84 by Robert Coren: to fix echoing bug that arose if FNP appended characters after it stopped echoing, and to reset all the WTCB flags that have to be reset on hangup. 12/10/84 by Robert Coren: to ignore line_status interrupts if wtcb.line_status_disabled is "1"b, and to clear it on hangup. /****^ HISTORY COMMENTS: 1) change(86-06-19,Kissel), approve(86-07-30,MCR7475), audit(86-08-04,Coren), install(86-10-09,MR12.0-1181): Changed to support the new tty event message format declared in net_event_message.incl.pl1 which replaces tty_event_message.incl.pl1. 2) change(87-07-17,LJAdams), approve(87-08-07,MCR7750), audit(87-08-07,Fawcett), install(87-08-11,MR12.1-1079): wtcb.mark_set was being set to "0"b at all times. Changed this so that it will be set to "0"b only if quits are enabled. (phx20905) 3) change(88-01-15,Farley), approve(88-02-22,MCR7843), audit(88-02-22,Beattie), install(88-03-01,MR12.2-1029): Added a check to ACCEPT_INPUT for ceasing echo neg when there is no more horiz_room_left. 4) change(88-06-20,Berno), approve(88-07-13,MCR7928), audit(88-06-20,Parisek), install(88-07-19,MR12.2-1061): Added code to implement the UNCP multiplexer (DSA gateway) interface. Set the wtcb.send_turn flag & check the wtcb.receive_mode_device flag. END HISTORY COMMENTS */ /* PARAMETERS */ dcl a_wtcbp ptr; dcl a_type fixed bin; dcl a_info bit (72) aligned; /* AUTOMATIC */ dcl i fixed bin; dcl int_type fixed bin; dcl devx fixed bin; dcl charx fixed bin; dcl echbufp ptr; dcl this_char char (1) unaligned; dcl echo_tally fixed bin (9); dcl sync_ctr_tally fixed bin; dcl inchain fixed bin (18); dcl code fixed bin (35); dcl next_offset fixed bin; dcl last_offset fixed bin; dcl new_headp ptr; dcl old_tailp ptr; dcl new_first_tally fixed bin; dcl old_last_tally fixed bin; dcl max_tally fixed bin; dcl filled bit (1); dcl source_ptr ptr; dcl target_ptr ptr; dcl start_time fixed bin (71); dcl echnego_from_mux_flag bit (1); dcl echnego_scan_start fixed bin; dcl r0_did_echo bit (1); dcl uncp_flag bit (1); /* designate UNCP mpx */ dcl 1 echo_start_data, 2 ctr fixed bin (35), 2 screenleft fixed bin (35); /* BASED */ dcl new_chars char (new_first_tally) based; /* BUILTINS */ dcl (addr, bin, clock, divide, hbound, max, min, null, ptr, unspec, rank, rel, size, string, substr) builtin; /* ENTRIES */ dcl meter_response_time entry (bit (36) aligned, fixed bin); dcl pxss$ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl pxss$unique_ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl pxss$ips_wakeup_int entry (bit (36) aligned, bit (35) aligned); dcl syserr entry options (variable); /* EXTERNAL STATIC */ dcl error_table_$noalloc fixed bin (35) ext static; dcl error_table_$invalid_write fixed bin (35) ext static; dcl sys_info$quit_mask bit (35) aligned ext static; /* INTERNAL STATIC */ dcl CRASH_SYSTEM fixed bin int static options (constant) init (1); dcl line_delimiter_octal (16) bit (9) int static options (constant) init ("012"b3, (2) (1)"055"b3, "012"b3, (3) (1)"003"b3, (5) (1)"012"b3, (3) (1)"003"b3, "012"b3); dcl line_delimiter (16) char (1) based (addr (line_delimiter_octal)); dcl no_write_code fixed bin (35) internal static; dcl noalloc_code fixed bin (35) internal static; /* copy of code to be used at interrupt time */ %include wtcb; %include mcs_interrupt_info; %include tty_buf; %include tty_buffer_block; %include net_event_message; %include tty_space_man_dcls; %include channel_manager_dcls; %include line_types; %include mcs_echo_neg_sys; %include lct; %include set_wakeup_table_info; %include response_transitions; %include multiplexer_types; interrupt: entry; /* the only entry into this program */ wtcbp = a_wtcbp; int_type = a_type; interrupt_info = a_info; devx = wtcb.devx; ttybp = addr (tty_buf$); uncp_flag = is_parent_mpx (UNCP_MPX); if int_type = DIALUP then do; unspec (dialup_info) = interrupt_info; if wtcb.dialing then do; /* if we asked 355 to dial */ wtcb.dial_status_valid = "1"b; /* status code is now valid */ wtcb.dial_status_code = 0; /* success */ end; wtcb.line_type = dialup_info.line_type; wtcb.baud_rate = dialup_info.baud_rate; wtcb.max_buf_size = dialup_info.max_buf_size; wtcb.buffer_pad = dialup_info.buffer_pad; wtcb.line_delimiter = line_delimiter (wtcb.line_type); wtcb.receive_mode_device = dialup_info.receive_mode_device; if uncp_flag then wtcb.send_turn = "0"b; /* Add for the Datanet 7100. */ do i = 1 to n_sync_line_types while (sync_line_type (i) ^= wtcb.line_type); end; wtcb.sync_line = (i <= n_sync_line_types); wtcb.flags.dialed = "1"b; /* indicate dialed */ wtcb.uproc = wtcb.hproc; /* make boss process the user until we get real one */ unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_DIALUP_MSG; call pxss$ring_0_wakeup (wtcb.hproc, wtcb.hevent, net_event_message_arg, 0); /* wakeup the answering service */ end; else if int_type = HANGUP then do; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_HANGUP_MSG; call pxss$ring_0_wakeup (wtcb.hproc, wtcb.hevent, net_event_message_arg, (0)); /* notify Initializer */ call kill_line; /* wipe out our record of the channel */ end; else if int_type = CRASH /* we don't have to tell anyone */ then call kill_line; /* except ourselves */ else if int_type = SEND_OUTPUT then do; wtcb.send_output = "1"b; /* send_next_page will undo this if necessary */ if wtcb.write_first ^= 0 /* we have more output waiting */ then call send_next_page; else if wtcb.negotiating_echo then do; /* Do we need to get start_echo ctl order thru? */ echo_datap = ptr (ttybp, wtcb.echdp); if echo_data.echo_start_pending_sndopt then call start_negotiated_echo; /* This happens when multiplexer couldn't honor previous start_negotiated_echo */ /* because it had output pending. */ end; if wtcb.write_first = 0 /* no write chain left */ then if wtcb.wflag /* user is waiting to be told when output is done */ then do; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_WRITE_MSG; call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0)); wtcb.wflag = "0"b; end; end; else if int_type = INPUT_AVAILABLE /* they've got input for us, but they won't say where */ then do; wtcb.input_available = "1"b; if wtcb.rflag /* the process wants it */ then do; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_READ_MSG; call meter_response_time (wtcb.uproc, TTY_WAKEUP); call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0)); wtcb.rflag = "0"b; end; end; else if int_type = ACCEPT_INPUT /* they're handing us input */ then do; unspec (rtx_info) = interrupt_info; if rtx_info.formfeed_present /* this is end_of_page response */ then do; if ^rtx_info.output_in_ring_0 & wtcb.write_first = 0 /* if tty_write is up-to-date */ then wtcb.actline = 0; end; inchain = bin (rtx_info.chain_head); if inchain = 0 then return; sync_ctr_tally = 0; /* Set for echo sync */ r0_did_echo = "0"b; /* Set for resync hack. */ last_offset = bin (rtx_info.chain_tail); /* initialize end_of_chain pointer */ if wtcb.negotiating_echo then do; /* In echnego state */ start_time = clock (); /* count time spent doing this */ tty_buf.echo_neg_interrupts = tty_buf.echo_neg_interrupts + 1; /* METER */ echo_datap = ptr (ttybp, wtcb.echdp); /* Develop table ptr */ echbufp = null (); /* No echo buffer yet */ echnego_from_mux_flag = "0"b; if wtcb.write_last = 0 then old_tailp = null; /* Set for combining */ else do; old_tailp = ptr (ttybp, wtcb.write_last); old_last_tally = old_tailp -> buffer.tally; if old_last_tally ^< max_buffer_tally (old_tailp -> buffer.size_code) - wtcb.buffer_pad then old_tailp = null; end; do blockp = ptr (ttybp, rtx_info.chain_head) repeat (ptr (ttybp, buffer.next)) while (rel (blockp)); echnego_scan_start = 0; if echo_data.mux_will_echnego /* Mux knows how to echo negotiate */ & buffer.next = 0 /* This is end of chain */ & ^rtx_info.break_char /* Mux echoed all these characters */ /* Except maybe the last few */ & buffer.tally > 0 then do; /* it's possible that the multiplexer (in particular, the FNP) appended a few more characters after it stopped echoing. This code assumes that there will be no more than 4 such, and that the multiplexer echoed exactly the characters up to but not including the first non-echoable character. */ do echnego_scan_start = max (0, buffer.tally - 4) to buffer.tally - 1 while (echoable (buffer.chars (echnego_scan_start))); end; if echnego_scan_start > echo_data.horiz_room_left /* stopped because it ran out of line */ then echnego_scan_start = echo_data.horiz_room_left; echo_data.horiz_room_left = echo_data.horiz_room_left - echnego_scan_start; echo_data.chars_echoed = echo_data.chars_echoed + echnego_scan_start; sync_ctr_tally = sync_ctr_tally - echnego_scan_start; /* Will go negative */ tty_buf.echo_neg_mux_chars = tty_buf.echo_neg_mux_chars + echnego_scan_start; /* METER */ rtx_info.break_char = "1"b; echnego_from_mux_flag = "1"b; if echo_data.horiz_room_left ^> 0 then go to negotiated_echo_ceases; end; /* Mux echoed _n_o_n_e of them; see if we can echo them. */ do charx = echnego_scan_start to buffer.tally - 1; /* Scan buffer */ this_char = buffer.chars (charx); if ^echoable (this_char) then go to negotiated_echo_ceases; /* This character is echoable */ if echo_data.horiz_room_left ^> 0 then go to negotiated_echo_ceases; if echnego_from_mux_flag then do; echo_data.chars_echoed = echo_data.chars_echoed + 1; tty_buf.echo_neg_mux_chars = tty_buf.echo_neg_mux_chars + 1; /* METER */ sync_ctr_tally = sync_ctr_tally - 1; end; else if old_tailp ^= null then do; /* Try to combine buffers */ r0_did_echo = "1"b; old_tailp -> buffer.chars (old_last_tally) = this_char; echo_data.chars_echoed = echo_data.chars_echoed + 1; tty_buf.echo_neg_r0_chars = tty_buf.echo_neg_r0_chars + 1; old_last_tally, old_tailp -> buffer.tally = old_last_tally + 1; if old_last_tally ^< max_buffer_tally (old_tailp -> buffer.size_code) - wtcb.buffer_pad then old_tailp = null; end; else do; if echbufp = null then do; r0_did_echo = "1"b; lctp = tty_buf.lct_ptr; /* we're going to check if the guy's got too much space already */ lctep = addr (lct.lcte_array (devx)); lctep = addr (lct.lcte_array (lcte.physical_channel_devx)); if lcte.output_words >= divide (tty_buf.bleft, output_bpart, 17, 0) /* he does */ then go to negotiated_echo_ceases; /* so stop for now */ call tty_space_man$get_buffer (devx, 16, OUTPUT, echbufp); if echbufp = null then go to negotiated_echo_ceases; /* No more room */ echo_tally = 0; end; echbufp -> buffer.chars (echo_tally) = this_char; /* Insert it */ echo_tally = echo_tally + 1; /* chars is 0-indexed */ if echo_tally >= max_buffer_tally (echbufp -> buffer.size_code) - wtcb.buffer_pad then call ship_echo_buffer; end; echo_data.horiz_room_left = echo_data.horiz_room_left - 1; end; /* End of input buffer */ end; /* End of input chain */ rtx_info.break_char = "0"b; /* NO break! */ go to negotiated_echo_continues; negotiated_echo_ceases: /* Some break condition or lossage has been hit. */ echo_data.echo_start_pending_sndopt = "0"b; /* DONT start mux up. */ wtcb.negotiating_echo = "0"b; /* Turn off echoing */ negotiated_echo_continues: if echbufp ^= null then call ship_echo_buffer; tty_buf.echo_neg_time = tty_buf.echo_neg_time + clock () - start_time; end; if wtcb.echdp ^= "000000"b3 then do; /* May need to count synchronization */ echo_datap = ptr (ttybp, wtcb.echdp); if echo_data.synchronized then do; if sync_ctr_tally < 0 then echo_data.sync_ctr = 0; /* mux-Echoed chars reinit */ do blockp = ptr (ttybp, rtx_info.chain_head) repeat (ptr (ttybp, buffer.next)) while (rel (blockp)); sync_ctr_tally = sync_ctr_tally + buffer.tally; end; /* MUX-echoed characters have been predecremented out */ echo_data.sync_ctr = echo_data.sync_ctr + sync_ctr_tally; if r0_did_echo & wtcb.write_first = 0 then do; /* Keep output in order with respect to r0 */ tty_buf.echo_neg_mux_nonecho = tty_buf.echo_neg_mux_nonecho + 1; if wtcb.negotiating_echo then call start_negotiated_echo; /* Mux lost race, retry. */ end; end; end; if uncp_flag then if wtcb.receive_mode_device /* Modification for the Datanet 7100 */ then wtcb.wake_tbl = "0"b; /* If UNCP then do not optimize with qedx */ if wtcb.wake_tbl & ^wtcb.allow_wakeup then call scan_iw_char; /* look for input wakeup char */ if wtcb.mark_set then do; /* indicate that input is first after mark set */ blockp = ptr (ttybp, inchain); /* point to first buffer */ buffer.mark = "1"b; wtcb.mark_set = "0"b; /* we've taken care of it now */ end; if wtcb.fblock = 0 then do; /* no existing blocks */ wtcb.fblock = inchain; /* set offset to first block */ wtcb.fchar = 0; /* and offset to first char */ end; else do; old_tailp = ptr (ttybp, wtcb.lblock); next_offset = bin (rtx_info.chain_head); if ^old_tailp -> buffer.converted /* don't combine new input with preconverted */ then do; old_last_tally = old_tailp -> buffer.tally; max_tally = max_buffer_tally (old_tailp -> buffer.size_code); /* number of characters this buffer will hold */ filled = "0"b; do while ((next_offset ^= 0) & ^filled); /* put as much as possible of input into last old buffer */ new_headp = ptr (ttybp, next_offset); new_first_tally = new_headp -> buffer.tally; if (old_last_tally + new_first_tally <= max_tally) & ^new_headp -> buffer.mark /* if it will fit (but don't mixed marked input with unmarked) */ then do; source_ptr = addr (new_headp -> buffer.chars (0)); target_ptr = addr (old_tailp -> buffer.chars (old_last_tally)); target_ptr -> new_chars = source_ptr -> new_chars; old_last_tally = old_last_tally + new_first_tally; next_offset = new_headp -> buffer.next; /* move on to next buffer */ call tty_space_man$free_buffer (devx, INPUT, new_headp); /* through with this one */ end; else filled = "1"b; /* no more room in last old buffer */ end; old_tailp -> buffer.tally = old_last_tally; end; old_tailp -> buffer.next = next_offset; if next_offset = 0 then last_offset = 0; /* took care of entire new chain */ end; if last_offset ^= 0 then wtcb.lblock = last_offset; if wtcb.wake_tbl & ^wtcb.allow_wakeup then call check_iw_limit; /* see if too much input has accumulated */ if rtx_info.break_char & ^rtx_info.output_in_ring_0 /* newline or form feed */ then do; if ^rtx_info.output_in_fnp /* if there's no output going on */ then wtcb.actcol, wtcb.white_col = 0; /* make sure next one starts at left margin */ if wtcb.flags.count_lines & ^wtcb.breakall /* counting lines */ then wtcb.actline = wtcb.actline + 1; /* count this one */ end; if (rtx_info.break_char | wtcb.wru) /* if there was a break char or this is answerback */ & wtcb.rflag then do; /* and the user wants a wakeup then */ if wtcb.wake_tbl & ^wtcb.allow_wakeup then if wtcb.prompt_len > 0 then call send_prompt; else ; else do; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_READ_MSG; call meter_response_time (wtcb.uproc, TTY_WAKEUP); call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0); /* wakeup the user */ wtcb.rflag = "0"b; /* we've taken care of this now */ end; end; end; else if int_type = INPUT_REJECTED /* we couldn't take more input for this guy */ then do; if wtcb.fblock ^= 0 /* if he's sitting on any */ then do; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_READ_MSG; /* poke him */ if wtcb.rflag /* he hasn't been poked already */ then do; call meter_response_time (wtcb.uproc, TTY_WAKEUP); call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0)); wtcb.rflag = "0"b; end; else call pxss$unique_ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0)); end; end; else if int_type = QUIT then do; if wtcb.flags.hndlquit then do; if wtcb.negotiating_echo then do; echo_datap = ptr (ttybp, wtcb.echdp); echo_data.echo_start_pending_sndopt, echo_data.synchronized, wtcb.negotiating_echo = "0"b; end; if wtcb.fblock ^= 0 /* free read chain also */ then do; call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, wtcb.fblock)); wtcb.fblock, wtcb.lblock = 0; end; if wtcb.write_first ^= 0 then do; call tty_space_man$free_chain (devx, OUTPUT, ptr (ttybp, wtcb.write_first)); wtcb.write_first, wtcb.write_last, wtcb.write_cnt = 0; end; wtcb.white_col = 0; wtcb.actcol = 0; end; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; if wtcb.wflag | wtcb.rflag /* if process was blocked on output or input */ then do; if wtcb.wflag then net_event_message.type = MCS_WRITE_MSG; /* set message type accordingly */ else net_event_message.type = MCS_READ_MSG; call meter_response_time (wtcb.uproc, TTY_WAKEUP); call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0); /* wakeup the user */ wtcb.wflag, wtcb.rflag = "0"b; end; if wtcb.flags.qenable then do; /* if quit is enabled */ net_event_message.type = MCS_QUIT_MSG; /* we will wake up the user so he knows what gives */ call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0); call pxss$ips_wakeup_int (wtcb.uproc, sys_info$quit_mask); /* signal user process */ wtcb.flags.qflag = "1"b; /* set "quit received" flag */ wtcb.mark_set = "0"b; end; if wtcb.count_lines then if wtcb.flags.scroll then wtcb.actline = 0; /* count quit as input for scrolling purposes */ else wtcb.actline = wtcb.actline + 1; /* else count the newline */ wtcb.end_frame = "0"b; tty_buf.nquits = tty_buf.nquits + 1; /* bump quit count */ end; else if int_type = LINE_STATUS then do; if ^wtcb.line_status_disabled then if wtcb.uproc ^= "0"b then do; wtcb.line_status = interrupt_info; wtcb.line_status_present = "1"b; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_LINE_STATUS_MSG; call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0); end; return; end; else if int_type = DIAL_STATUS then do; if wtcb.dialing then do; wtcb.dial_status_valid = "1"b; /* we have dial out status */ wtcb.dial_status_code = bin (substr (interrupt_info, 1, 8), 8); unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_DIALOUT_MSG; call pxss$ring_0_wakeup (wtcb.hproc, wtcb.hevent, net_event_message_arg, 0); /* wakeup the user */ /* user will use dial_status ordercall */ end; end; else if int_type = WRU_TIMEOUT /* no response to answerback */ then do; if wtcb.flags.dialed then do; /* it had better be dialed */ wtcb.rflag = "0"b; /* read no longer pending */ unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_READ_MSG; call pxss$ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, 0); /* wakeup the user */ end; end; else if int_type = SPACE_AVAILABLE /* we were waiting for space */ then if wtcb.write_first ^= 0 /* we've got more output */ then call send_next_page; else do; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_UNSPECIFIED_MSG; call pxss$unique_ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0)); end; /* unique because we don't want to pile these up */ else if int_type = ACKNOWLEDGE_ECHNEGO_INIT then do; echo_datap = ptr (ttybp, wtcb.echdp); if echo_datap ^= ttybp then do; echo_data.awaiting_start_sync = "0"b; echo_data.synchronized = "1"b; echo_data.sync_ctr = 0; end; end; else if int_type = ACKNOWLEDGE_ECHNEGO_STOP then do; echo_datap = ptr (ttybp, wtcb.echdp); wtcb.negotiating_echo = "0"b; if echo_datap ^= ttybp then do; echo_data.awaiting_stop_sync = "0"b; echo_data.echo_start_pending_sndopt = "0"b; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_UNSPECIFIED_MSG; call pxss$unique_ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0)); end; end; else if int_type = MASKED then do; unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_MASKED_MSG; call pxss$ring_0_wakeup (wtcb.hproc, wtcb.hevent, net_event_message_arg, 0); call kill_line; wtcb.masked = "1"b; end; else bad_int: call syserr (CRASH_SYSTEM, "tty_interrupt: unrecognized interrupt type (^d) for devx ^d", int_type, devx); return; /* internal procedure to send pending output */ send_next_page: proc; dcl headp ptr; dcl next_head fixed bin; if wtcb.send_output then do; headp, blockp = ptr (ttybp, wtcb.write_first); do while (^buffer.end_of_page & buffer.next ^= 0); /* find last buffer of current page */ if buffer.mark /* this page contains the mark */ then wtcb.mark_set = "1"b; blockp = ptr (ttybp, buffer.next); end; if buffer.mark /* check last buffer too */ then wtcb.mark_set = "1"b; next_head = buffer.next; buffer.next = 0; /* break chain here */ wtcb.end_frame = buffer.end_of_page; call channel_manager$write (devx, headp, code); if code = noalloc_code then do; call tty_space_man$needs_space (devx); code = 0; /* don't treat like other error codes */ end; if headp ^= null /* didn't take it all */ then do; if code = 0 then do; blockp = headp; do while (buffer.next ^= 0); if buffer.mark /* we didn't send the marked buffer yet */ then wtcb.mark_set = "0"b; blockp = ptr (ttybp, buffer.next); end; if buffer.mark /* have to check last one */ then wtcb.mark_set = "0"b; buffer.next = next_head; /* found the end of the returned chain, reconnect it */ if next_head = 0 /* if we weren't hanging on to one */ then wtcb.write_last = bin (rel (blockp)); /* this is the end */ next_head = bin (rel (headp)); /* this is now head of the chain */ end; else do; call tty_space_man$free_chain (devx, OUTPUT, headp); /* all output to be discarded */ wtcb.mark_set = "0"b; /* can't trust anything */ wtcb.error_code = code; /* save this for callers */ unspec (net_event_message) = "0"b; net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = devx; net_event_message.type = MCS_UNSPECIFIED_MSG; /* poke the process to make sure it finds out eventually */ call pxss$unique_ring_0_wakeup (wtcb.uproc, wtcb.event, net_event_message_arg, (0)); end; end; wtcb.write_first = next_head; if wtcb.write_first = 0 then wtcb.write_last = 0; /* this must be true */ else if code ^= 0 /* in this case we'll throw away all output anyway */ then do; call tty_space_man$free_chain (devx, OUTPUT, ptr (ttybp, wtcb.write_first)); wtcb.write_first, wtcb.write_last = 0; end; wtcb.send_output = "0"b; end; return; end /* send_next_page */; /* internal procedure to set wtcb to "hung up" state */ kill_line: proc; dcl sync_flag bit (1); dcl masked_flag bit (1); if wtcb.fblock ^= 0 /* if there's a read chain, free it */ then call tty_space_man$free_chain (devx, INPUT, ptr (ttybp, wtcb.fblock)); if wtcb.write_first ^= 0 /* likewise for write chain */ then call tty_space_man$free_chain (devx, OUTPUT, ptr (ttybp, wtcb.write_first)); /* save those flags that need to be preserved */ masked_flag = wtcb.flags.masked; sync_flag = wtcb.flags.sync_line; string (wtcb.flags) = ""b; /* clear them all, then restore saved values */ string (wtcb.more_flags) = ""b; wtcb.flags.masked = masked_flag; wtcb.flags.sync_line = sync_flag; wtcb.uproc = ""b; wtcb.white_col, wtcb.fblock, wtcb.lblock = 0; wtcb.fchar, wtcb.actline, wtcb.actcol, wtcb.nramsgs = 0; wtcb.write_first, wtcb.write_last = 0; wtcb.prompt_len = 0; wtcb.error_code = 0; if wtcb.echdp ^= ""b then do; call tty_space_man$free_space (size (echo_data), ptr (ttybp, wtcb.echdp)); wtcb.echdp = ""b; end; if wtcb.waketp ^= ""b then do; call tty_space_man$free_space (size (wakeup_table), ptr (ttybp, wtcb.waketp)); wtcb.waketp = ""b; end; end /* kill_line */; echoable: procedure (test_char) returns (bit (1) aligned); /* function that indicates whether a given character can be echoed by anyone other than the application */ dcl test_char char (1); dcl char_pos fixed bin (9); char_pos = rank (test_char); if char_pos > hbound (echo_data.break, 1) /* it's not in the table at all */ then return ("0"b); /* if it is, it is echoable iff its corresponding bit is off */ else return (^echo_data.break (char_pos)); end echoable; ship_echo_buffer: proc; /* Proc called to ship out echo buffer for negotiated echo */ dcl loc_echbufp ptr; dcl loc_lastp ptr; echbufp -> buffer.tally = echo_tally; loc_echbufp = echbufp; code = 0; if wtcb.write_first ^= 0 /* already an output chain */ then do; loc_lastp = ptr (ttybp, wtcb.write_last); wtcb.write_last, /* just append this stuff to it */ loc_lastp -> buffer.next = bin (rel (loc_echbufp)); loc_echbufp = null; end; else if ^wtcb.send_output /* shouldn't send it now */ then do; wtcb.write_first, wtcb.write_last = bin (rel (loc_echbufp)); loc_echbufp = null; end; else do; wtcb.send_output = "0"b; call channel_manager$write (devx, loc_echbufp, code); end; if loc_echbufp = null & code = 0 then do; /* Won */ echo_data.chars_echoed = echo_data.chars_echoed + echo_tally; tty_buf.echo_neg_r0_chars = tty_buf.echo_neg_r0_chars + echo_tally; /* METER */ end; else do; code = 1; /* Cause echo stop */ call tty_space_man$free_buffer (devx, OUTPUT, echbufp); end; echbufp = null; if code ^= 0 then go to negotiated_echo_ceases; /* Stop the rolling ball. */ end ship_echo_buffer; /* Subroutine to scan input chain for input wakeup chars */ scan_iw_char: proc; dcl charx fixed bin; dcl i fixed bin; wakeup_tablep = ptr (ttybp, wtcb.waketp); do blockp = ptr (ttybp, rtx_info.chain_head) repeat (ptr (ttybp, buffer.next)) while (rel (blockp)); do charx = 0 to buffer.tally - 1; i = bin (unspec (buffer.chars (charx))); if i <= 127 then if wakeup_table.wake_map (i) /* found a wakeup char */ then do; wtcb.allow_wakeup = "1"b; return; end; end; end; end; /* Subroutine to check if buffered input exceeds limit for wake_tbl mode */ check_iw_limit: proc; lctp = tty_buf.lct_ptr; lctep = addr (lct.lcte_array (devx)); lctep = addr (lct.lcte_array (lcte.physical_channel_devx)); if lcte.input_words > min (128, divide (tty_buf.bleft, 4, 17, 0)) then wtcb.allow_wakeup = "1"b; end; /* Subroutine to write a prompt message */ send_prompt: proc; dcl bufp ptr; call tty_space_man$get_buffer (devx, 16, OUTPUT, bufp); if bufp = null then return; substr (string (bufp -> buffer.chars), 1, wtcb.prompt_len) = substr (wtcb.prompt, 1, wtcb.prompt_len); bufp -> buffer.tally = wtcb.prompt_len; if wtcb.write_first = 0 /* thread prompt buffer onto write chain */ then wtcb.write_first = bin (rel (bufp)); else ptr (ttybp, wtcb.write_last) -> buffer.next = bin (rel (bufp)); wtcb.write_last = bin (rel (bufp)); call send_next_page; /* ship it out */ end; set_static: entry; /* entry called once per bootload to copy error codes into internal static */ noalloc_code = error_table_$noalloc; no_write_code = error_table_$invalid_write; return; start_negotiated_echo: proc; /* echdp had better be set. */ echo_start_data.ctr = echo_data.sync_ctr; echo_start_data.screenleft = echo_data.horiz_room_left; call channel_manager$control (devx, "start_negotiated_echo", addr (echo_start_data), code); if code = 0 then echo_data.echo_start_pending_sndopt = "0"b; else if code = no_write_code then echo_data.echo_start_pending_sndopt = "1"b; tty_buf.echo_neg_sndopt_restarts = tty_buf.echo_neg_sndopt_restarts + 1; /* METER */ end; is_parent_mpx: /* Check for match of channel's parent mpx type and input mpx type */ proc (parent_mpx_type) returns (bit (1)); dcl parent_mpx_type fixed bin; dcl temp_lctep ptr; lctp = tty_buf.lct_ptr; lctep = addr (lct.lcte_array (devx)); if lcte.major_channel_devx ^= 0 then do; temp_lctep = addr (lct.lcte_array (lcte.major_channel_devx)); if temp_lctep->lcte.channel_type = parent_mpx_type then return ("1"b); end; else if lcte.channel_type = parent_mpx_type then return ("1"b); return ("0"b); end is_parent_mpx; /* BEGIN MESSAGE DOCUMENTATION Message: tty_interrupt: unrecognized interrupt type (N) for devx D S: $crash T: $run M: An unrecognized interrupt type has been reported for the nonmultiplexed channel whose device index is D. A: $inform END MESSAGE DOCUMENTATION */ end /* tty_interrupt */;  tty_lock.pl1 11/11/89 1132.7rew 11/11/89 0825.4 154782 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,^ifthendo */ tty_lock: proc; /* This procedure locks and unlocks channel locks. Locking performed at interrupt time differs from ordinary locking in two ways: 1. At interrupt time, one cannot wait for a channel that is locked to be unlocked. Therefore, failure to lock immediately at interrupt time results in the interrupt operation being queued (i.e., postponed) for later execution. Queued interrupts for a channel are processed the next time the channel is unlocked. 2. Ordinarily, it is considered an error when a process attempts to lock a channel that it has already locked. However, if the channel was previously locked for an interrupt operation, then subsequent attempts by the same process to lock and unlock for non-interrupt operations are simply ignored. This permits an interrupt handler executing on behalf of some subchannel to perform an operation on its major channel even though the major channel was previously locked for the same interrupt. */ /* Recoded by J. Stern 8/8/78 */ /* lock_lcte entry added 12/12/79 by Robert Coren */ /* Modified 6 Apr 82, W. Olin Sibert: check_for_interrupt, dequeue_interrupt entries added for mcs_timer */ /* Modified 83-12-19 BIM to add pm_code to lock_lcte, which can set it! */ /* Modified September 1984 by Robert Coren to make dequeue_*_interrupt entries avoid calling tty_space_man$free_space while holding the queue lock */ /* Modified March 1985 by EJ Sharpe to return bit from $verify */ /* Parameters */ dcl pm_lctep ptr; dcl pm_devx fixed bin; dcl pm_subchan_devx fixed bin; dcl pm_int_type fixed bin; dcl pm_int_data bit (72) aligned; dcl pm_locked bit (1) aligned; dcl pm_code fixed bin (35); /* Automatic */ dcl devx fixed bin; dcl subchan_devx fixed bin; dcl tried bit (1) aligned; dcl locked bit (1) aligned; dcl i fixed bin; dcl wire_arg fixed bin (71); dcl wire_ptr ptr; dcl qep ptr; dcl qtp ptr; dcl (prev_qep, next_qep) ptr; dcl (first_free_qep, last_free_qep) ptr; dcl dequeue_all bit (1) aligned; dcl int_type fixed bin; dcl int_data bit (72) aligned; dcl start_wait_time fixed bin (71); dcl wait_time fixed bin (35); dcl unlocked_something bit (1) aligned; /* Based */ dcl 1 queue_entry aligned based (qep), 2 next_entry bit (18) unal, 2 subchan_devx fixed bin (18) unsigned unal, 2 int_type fixed bin, 2 int_data bit (72); /* External static */ dcl pds$process_id bit (36) ext; dcl pds$process_group_id char (32) aligned ext; dcl error_table_$io_no_permission fixed bin (35) ext; /* Builtins */ dcl (addr, clock, max, null, stac, stacq, size, rel, pointer, ptr) builtin; /* Entries */ dcl pxss$addevent entry (fixed bin); dcl pxss$delevent entry (fixed bin); dcl pxss$notify entry (fixed bin); dcl pxss$wait entry; dcl syserr entry options (variable); dcl pmut$wire_and_mask entry (fixed bin (71), ptr); dcl pmut$unwire_unmask entry (fixed bin (71), ptr); dcl mcs_timer$verify_lock entry (); %page; lock_lcte: entry (pm_lctep, pm_code); /* locks a channel before a non-interrupt operation given an LCTE pointer */ ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; lctep = pm_lctep; go to lock_it; lock_channel: entry (pm_devx, pm_code); /* locks a channel before a non-interrupt operation */ pm_code = 0; call setup (); if ^lcte.entry_in_use | lcte.special_lock then go to no_permission; lock_it: tty_buf.tty_lock_calls = tty_buf.tty_lock_calls + 1; if lcte.lock = pds$process_id /* we've already locked this channel */ then if lcte.locked_for_interrupt /* ok, don't lock it again */ then return; else call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to lock channel already locked by same process.") ; locked = "0"b; tried = "0"b; do while (^locked); if stac (addr (lcte.lock), pds$process_id) then locked = "1"b; /* we locked it */ else do; /* must wait for lock to be unlocked */ if ^tried then do; tty_buf.found_channel_locked = tty_buf.found_channel_locked + 1; start_wait_time = clock (); tried = "1"b; end; call pxss$addevent (tty_ev); /* get ready to wait for this event */ lcte.notify_reqd = "1"b; /* ask to be notified when lock is unlocked */ if stac (addr (lcte.lock), pds$process_id) /* try once more to lock) it */ then do; /* got it, no need to wait */ call pxss$delevent (tty_ev); locked = "1"b; end; else call pxss$wait (); end; end; if tried then do; /* if we had to wait, meter */ wait_time = clock () - start_wait_time; tty_buf.total_wait_time = tty_buf.total_wait_time + wait_time; tty_buf.max_wait_time = max (tty_buf.max_wait_time, wait_time); end; if lcte.initialized then return; call unlock (); /* don't keep uninitialized channel locked */ no_permission: pm_code = error_table_$io_no_permission; return; %page; lock_channel_int: entry (pm_devx, pm_int_type, pm_int_data, pm_locked); /* locks a channel before an interrupt operation */ int_type = pm_int_type; int_data = pm_int_data; subchan_devx = 0; pm_locked = "0"b; call setup (); tty_buf.tty_lock_calls = tty_buf.tty_lock_calls + 1; if ^lcte.entry_in_use then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to lock unused channel for interrupt."); call lock_queue; if ^stac (addr (lcte.lock), pds$process_id) then do; /* cannot set lock, must queue the interrupt */ call enqueue; call unlock_queue; return; end; call unlock_queue; if ^lcte.initialized then do; /* ignore interrupts for uninitialized channels */ call unlock (); return; end; lcte.locked_for_interrupt = "1"b; pm_locked = "1"b; return; %page; queue_interrupt: entry (pm_devx, pm_int_type, pm_int_data, pm_subchan_devx); /* This entry adds an entry to the queue for a major channel on behalf of one of its subchannels. it is used by channel_manager$interrupt_later */ int_type = pm_int_type; int_data = pm_int_data; subchan_devx = pm_subchan_devx; call setup (); call lock_queue; call enqueue; call unlock_queue; return; %page; unlock_channel: entry (pm_devx); /* unlocks a channel after a non-interrupt operation */ call setup (); if lcte.lock = pds$process_id /* we have channel locked as expected */ then if lcte.locked_for_interrupt /* but we don't really want to unlock it now */ then return; call unlock (); return; unlock_channel_int: entry (pm_devx); /* unlocks a channel after an interrupt operation */ call setup (); lcte.locked_for_interrupt = "0"b; call unlock (); return; %page; flush_queue: entry (pm_devx); /* deletes all queue entries for a given channel */ call setup (); do while (dequeue ()); end; return; cleanup_locks: entry; /* called only by terminate_proc */ call CLEANUP_LOCKS; return; verify: entry () returns (bit (1) aligned); call CLEANUP_LOCKS; return (unlocked_something); CLEANUP_LOCKS: /* internal procedure for $cleanup_locks and $verify entrypoints */ procedure (); unlocked_something = "0"b; ttybp = addr (tty_buf$); if tty_buf.slock = pds$process_id then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock$verify: attempted crawlout with tty_buf lock set."); lctp = tty_buf.lct_ptr; if lctp = null () then return; /* MCS not started yet, never mind */ if lct.queue_lock = pds$process_id then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock$verify: attempted crawlout with queue lock set."); call mcs_timer$verify_lock (); /* will crash system if timer lock locked */ do i = 1 to lct.max_no_lctes; lctep = addr (lcte_array (i)); if lcte.entry_in_use then if lcte.lock = pds$process_id then if lcte.special_lock then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock$verify: attempted crawlout with special channel lock set."); else do; devx = i; call force_unlock; /* clear the lock so next caller won't hang */ unlocked_something = "1"b; end; end; return; end CLEANUP_LOCKS; %page; check_for_interrupt: entry (pm_devx, pm_int_type, pm_int_data) returns (bit (1) aligned); int_type = pm_int_type; int_data = pm_int_data; call setup (); call lock_queue (); do qep = pointer (ttybp, lcte.queue_head) repeat (pointer (ttybp, queue_entry.next_entry)) while (rel (qep) ^= ""b); if (queue_entry.int_type = int_type) & (queue_entry.int_data = int_data) then do; call unlock_queue (); return ("1"b); /* You're our boy */ end; end; call unlock_queue (); return ("0"b); /* None found */ %page; dequeue_one_interrupt: entry (pm_devx, pm_int_type, pm_int_data); dequeue_all = "0"b; int_data = pm_int_data; goto dequeue_common; dequeue_all_interrupts: entry (pm_devx, pm_int_type); dequeue_all = "1"b; dequeue_common: int_type = pm_int_type; call setup (); call lock_queue (); /* it's not safe to call tty_space_man with the queue lock locked, because it can generate "space_available" interrupts; so we'll keep a list of entries to free and free them all after we've unthreaded them and released the lock. */ prev_qep, first_free_qep = pointer (ttybp, 0); do qep = pointer (ttybp, lcte.queue_head) repeat (next_qep) while (rel (qep) ^= ""b); next_qep = pointer (ttybp, queue_entry.next_entry); if (queue_entry.int_type = int_type) & (dequeue_all | (queue_entry.int_data = int_data)) then do; if (lcte.queue_head = rel (qep)) then lcte.queue_head = queue_entry.next_entry; if (lcte.queue_tail = rel (qep)) then lcte.queue_tail = rel (prev_qep); if (rel (prev_qep) ^= ""b) then prev_qep -> queue_entry.next_entry = queue_entry.next_entry; /* put this one on the "to be freed" list */ queue_entry.next_entry = ""b; if rel (first_free_qep) = ""b then first_free_qep, last_free_qep = qep; else do; last_free_qep -> queue_entry.next_entry = rel (qep); last_free_qep = qep; end; end; else prev_qep = qep; end; /* Of loop through queue entries */ call unlock_queue (); /* now go through the free list (if any) and free the entries on it */ do qep = first_free_qep repeat (next_qep) while (rel (qep) ^= ""b); next_qep = pointer (ttybp, queue_entry.next_entry); call tty_space_man$free_space (size (queue_entry), qep); end; return; %page; setup: proc; ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; devx = pm_devx; lctep = addr (lct.lcte_array (devx)); return; end setup; unlock: proc; /* process all entries in the channel queue before unlocking */ /* last call to dequeue will unlock the channel lock */ do while (dequeue ()); lcte.locked_for_interrupt = "1"b; /* make queued interrupt look real */ if subchan_devx ^= 0 /* this is really for a subchannel */ then call channel_manager$interrupt (subchan_devx, int_type, int_data); else call channel_manager$queued_interrupt (devx, int_type, int_data); lcte.locked_for_interrupt = "0"b; end; if lcte.notify_reqd /* someone is waiting for this lock */ then do; /* let everyone know it's available */ lcte.notify_reqd = "0"b; call pxss$notify (tty_ev); end; end; /* unlock */ force_unlock: procedure; /* lock is to be forced because process is crawling out. Send notify if necessary, but flush queued interrupts rather than attempting to process them. */ call syserr (SYSERR_LOG_OR_PRINT, "tty_lock: forcing unlock of channel ^a from ^a", lct.lcnt_ptr -> lcnt.names (devx), pds$process_group_id); lcte.locked_for_interrupt = "0"b; do while (dequeue ()); /* this flushes the queue and unlocks the channel when it's done */ end; if lcte.notify_reqd then do; lcte.notify_reqd = "0"b; call pxss$notify (tty_ev); end; return; end force_unlock; %page; lock_queue: proc; call pmut$wire_and_mask (wire_arg, wire_ptr); do while (^stac (addr (lct.queue_lock), pds$process_id)); end; end; /* lock_queue */ unlock_queue: proc; if ^stacq (lct.queue_lock, "0"b, pds$process_id) then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to unlock queue not locked by same process."); call pmut$unwire_unmask (wire_arg, wire_ptr); end; /* unlock_queue */ %page; enqueue: proc; /* adds queue entry to head of channel queue */ if ^lcte.initialized /* don't queue anything for an uninitialized channel */ then return; call tty_space_man$get_space (size (queue_entry), qep); if qep = null then do; call syserr (SYSERR_PRINT_WITH_ALARM, "tty_lock: Cannot get space for queue entry. (devx = ^d)", devx); return; end; queue_entry.int_type = int_type; queue_entry.int_data = int_data; queue_entry.subchan_devx = subchan_devx; if lcte.queue_tail = "0"b /* queue is empty */ then lcte.queue_tail, lcte.queue_head = rel (qep);/* new entry is both first and last */ else do; qtp = ptr (ttybp, lcte.queue_tail); /* get ptr to last entry */ qtp -> queue_entry.next_entry = rel (qep); /* put new entry after it */ lcte.queue_tail = rel (qep); /* new entry is now the last */ end; queue_entry.next_entry = "0"b; /* nothing follows last entry */ tty_buf.n_queued_interrupts = tty_buf.n_queued_interrupts + 1; end; dequeue: proc returns (bit (1)); /* removes entry from head of channel queue */ call lock_queue (); if lcte.queue_head = "0"b /* queue is empty */ then do; qep = null; if ^stacq (lcte.lock, "0"b, pds$process_id) then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to unlock channel not locked by same process."); end; else do; qep = ptr (ttybp, lcte.queue_head); /* get ptr to first queue entry */ lcte.queue_head = queue_entry.next_entry; /* next entry is now first */ if lcte.queue_head = "0"b /* there was no next entry */ then lcte.queue_tail = "0"b; end; call unlock_queue (); if qep = null then return ("0"b); /* indicate empty queue */ else do; int_type = queue_entry.int_type; int_data = queue_entry.int_data; subchan_devx = queue_entry.subchan_devx; call tty_space_man$free_space (size (queue_entry), qep); return ("1"b); end; end; %page; %include lct; %include tty_buf; %include tty_space_man_dcls; %include channel_manager_dcls; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: tty_lock: attempt to lock channel already locked by same process. S: $crash T: $run M: A locking error was detected when a process tried to lock a channel that it had already locked. A: $inform Message: tty_lock: attempt to lock unused channel for interrupt. S: $crash T: $run M: A locking error was detected when an interrupt handler tried to lock an ununsed channel. A: $inform Message: tty_lock: attempt to unlock channel not locked by same process. S: $crash T: $run M: A locking error was detected when a process tried to unlock a channel that was either not locked or locked by another process. A: $inform Message: tty_lock$verify: attempted crawlout with tty_buf lock set. S: $crash T: $run M: There was an attempt to crawl out while the tty_buf lock used by tty_space_man was locked. A: $inform Message: tty_lock$verify: attempted crawlout with special channel lock set. S: $crash T: $run M: There was an attempt to crawl out while a channel lock that is also a processor lock was locked. A: $inform Message: tty_lock$verify: attempted crawlout with queue lock set. S: $crash T: $run M: There was an attempt to crawl out while the tty queue lock was locked. A: $inform Message: tty_lock: Cannot get space for queue entry. (devx = N) S: $beep T: $run M: An attempt to queue an interrupt for the channel with devx N failed due to lack of space. The interrupt was lost which may cause loss of data or improper channel operation. A: $inform Message: tty_lock: attempt to unlock queue not locked by same process. S: $crash T: $run M: A locking error was detected when a process tried to unlock the global queue lock which was either not locked or was locked by another process. END MESSAGE DOCUMENTATION */ end tty_lock;  tty_space_man.pl1 11/11/89 1132.7r w 11/11/89 0825.4 173385 /****^ ****************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright (c) 1987 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * ****************************************************** */ /* TTY_SPACE_MAN: Entries for managing the ring-0 tty buffer */ /* Written January 1978 by Larry Johnson to replace tty_free */ /* Modified 8/25/78 by J. Stern for multiplexing changes */ /* Modified March 1981 by Robert Coren to add get_perm_space entry */ /* Modified April 1981 by Robert Coren to add switch_chain entry */ /* Modified May 19, 1982 by Robert Coren to fix argument-copying bug in switch_chain entry */ /* format: style4,delnl,insnl,^ifthendo */ tty_space_man: proc; /* Parameters */ dcl arg_devx fixed bin; /* Index of lcte */ dcl arg_from_devx fixed bin; dcl arg_to_devx fixed bin; dcl arg_size fixed bin; /* Size of buffer request */ dcl arg_output_flag bit (1); /* On for output buffers */ dcl arg_from_type bit (1); /* On if switching from output */ dcl arg_to_type bit (1); /* On if switching to output */ dcl arg_blockp ptr; /* Pointer to a buffer */ dcl arg_count fixed bin; /* Length of a buffer chain */ /* Automatic */ dcl output_flag bit (1); /* Copy of arg_output_flag argument */ dcl perm bit (1); /* on for get_perm_space entry */ dcl buffer_size fixed bin; dcl count fixed bin; dcl word_count fixed bin; dcl i fixed bin; dcl prev_blockp ptr; dcl first_blockp ptr; dcl devx fixed bin; /* Copy of arg_devx */ dcl from_devx fixed bin; dcl to_devx fixed bin; dcl from_type bit (1); dcl to_type bit (1); dcl total_freed fixed bin; /* Amount of space freed during call */ dcl wire_mask fixed bin (71); /* For pmut$wire calls */ dcl wire_ptr ptr; /* This too */ dcl enter_time fixed bin (71); /* clock time at entry (for metering) */ /* External */ dcl pds$processid bit (36) external; dcl caller entry returns (ptr); dcl mcs_trace entry options (variable); dcl pmut$wire_and_mask entry (fixed bin (71), ptr); dcl pmut$unwire_unmask entry (fixed bin (71), ptr); dcl pxss$unique_ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl syserr entry options (variable); /* Internal static */ dcl RESERVED_SPACE internal static options (constant) init (256); /* Builtins */ dcl (addr, addrel, baseno, bin, bit, clock, divide, mod, null, ptr, rel, stac, stacq, unspec) builtin; /* Entry to get a single buffer */ get_buffer: entry (arg_devx, arg_size, arg_output_flag, arg_blockp); devx = arg_devx; buffer_size = arg_size; output_flag = arg_output_flag; call setup; tty_buf.alloc_calls = tty_buf.alloc_calls + 1; call buffer_getter (buffer_size); /* Allocate the buffer */ if blockp ^= null then call update_lcte (buffer_size); /* Fix wtcb if it worked */ call clean_up; arg_blockp = blockp; tty_buf.alloc_time = tty_buf.alloc_time + clock () - enter_time; return; /* Entry to get a chain of buffers */ get_chain: entry (arg_devx, arg_size, arg_count, arg_output_flag, arg_blockp); devx = arg_devx; buffer_size = arg_size; count = arg_count; output_flag = arg_output_flag; call setup; tty_buf.alloc_calls = tty_buf.alloc_calls + 1; first_blockp, prev_blockp = null; do i = 1 to count; /* Allocate number requested */ call buffer_getter (buffer_size); if blockp = null then go to get_chain_failed; /* Ran out of room */ if i = 1 then first_blockp = blockp; /* Remember pointer to first block */ else prev_blockp -> buffer.next = bin (rel (blockp)); /* And thread the rest */ prev_blockp = blockp; end; call update_lcte (count * buffer_size); /* Charge to device */ call clean_up; arg_blockp = first_blockp; /* Return pointer to first in chain */ tty_buf.alloc_time = tty_buf.alloc_time + clock () - enter_time; return; get_chain_failed: /* Not enough buffers */ blockp = first_blockp; if blockp ^= null then call chain_freer; /* Release partial chain */ call clean_up; arg_blockp = null; tty_buf.alloc_time = tty_buf.alloc_time + clock () - enter_time; return; /* Entry to free a single buffer */ free_buffer: entry (arg_devx, arg_output_flag, arg_blockp); devx = arg_devx; output_flag = arg_output_flag; blockp = arg_blockp; call setup; tty_buf.free_calls = tty_buf.free_calls + 1; call buffer_freer; /* This does the work */ call update_lcte (-total_freed); call clean_up; arg_blockp = null; tty_buf.free_time = tty_buf.free_time + clock () - enter_time; return; /* Entry to free a buffer chain */ free_chain: entry (arg_devx, arg_output_flag, arg_blockp); devx = arg_devx; output_flag = arg_output_flag; blockp = arg_blockp; call setup; tty_buf.free_calls = tty_buf.free_calls + 1; call chain_freer; /* This does the work */ call update_lcte (-total_freed); call clean_up; arg_blockp = null; tty_buf.free_time = tty_buf.free_time + clock () - enter_time; return; /* Entry to get space of arbitrary size */ get_space: entry (arg_size, arg_blockp); perm = "0"b; go to get_space_join; /* Entry to get permanent space of arbitrary size (used to allocate LCT); point is to not count it against buffer pool for metering */ get_perm_space: entry (arg_size, arg_blockp); perm = "1"b; get_space_join: buffer_size = arg_size + mod (arg_size, 2); call setup; tty_buf.alloc_calls = tty_buf.alloc_calls + 1; blockp = space_getter (buffer_size); call clean_up; arg_blockp = blockp; tty_buf.alloc_time = tty_buf.alloc_time + clock () - enter_time; if ^perm then call update_control (buffer_size); return; /* Entry to free space of arbitrary size */ free_space: entry (arg_size, arg_blockp); buffer_size = arg_size + mod (arg_size, 2); /* Make it even */ blockp = arg_blockp; call setup; tty_buf.free_calls = tty_buf.free_calls + 1; call space_freer (blockp, buffer_size); call clean_up; arg_blockp = null; tty_buf.free_time = tty_buf.free_time + clock () - enter_time; call update_control (-buffer_size); return; /* This entry is called when a process needs an interrupt when buffer space becomes available */ needs_space: entry (arg_devx); devx = arg_devx; call setup; lctep = addr (lct.lcte_array (devx)); lcte.space_needed = "1"b; /* Remember this process needs an interrupt */ tty_buf.space_needed = "1"b; /* Remember that at least one process needs an interrupt */ tty_buf.space_needed_calls = tty_buf.space_needed_calls + 1; /* Leave some evidence */ call clean_up; return; /* Entry to update metering information if a multiplexer changes a chain from input to output (or vice versa) and/or from one channel to another */ switch_chain: entry (arg_from_devx, arg_to_devx, arg_from_type, arg_to_type, arg_blockp); from_devx = arg_from_devx; to_devx = arg_to_devx; from_type = arg_from_type; to_type = arg_to_type; blockp = arg_blockp; call setup; word_count = 0; do while (blockp ^= null ()); /* ascertain the length of the chain */ word_count = word_count + 16 * (buffer.size_code + 1); if buffer.next = 0 then blockp = null (); else blockp = ptr (ttybp, buffer.next); end; devx = from_devx; /* take it away from old one */ output_flag = from_type; call update_lcte (-word_count); devx = to_devx; /* and give it to new one */ output_flag = to_type; call update_lcte (word_count); call clean_up; if tty_buf.trace.enable then if tty_buf.trace.space_man then call mcs_trace (from_devx, "switch_chain: ^d words to devx ^o by ^p", word_count, to_devx, caller ()); return; /* Procedure to allocate one buffer */ buffer_getter: proc (n); dcl n fixed bin; /* The size */ if tty_buf.bleft <= RESERVED_SPACE /* always save some for critical functions */ then blockp = null; else do; blockp = space_getter (n); /* Get the space */ if blockp = null then return; /* Error */ buffer.size_code = divide (n, 16, 17, 0) - 1; end; if tty_buf.trace.enable then if tty_buf.trace.space_man then call mcs_trace (devx, "get_buffer: ^d words at ^p by ^p", n, blockp, caller ()); return; end buffer_getter; /* Procedure to free a single buffer pointed to by blockp */ buffer_freer: proc; dcl n fixed bin; n = 16 * (buffer.size_code + 1); if tty_buf.trace.enable then if tty_buf.trace.space_man then call mcs_trace (devx, "free_buffer: ^d words at ^p by ^p", n, blockp, caller ()); call space_freer (blockp, n); total_freed = total_freed + n; return; end buffer_freer; /* Procedure to free a buffer chain */ chain_freer: proc; dcl next_rel bit (18); if tty_buf.trace.enable then if tty_buf.trace.space_man then call mcs_trace (devx, "free_chain: at ^p by ^p", blockp, caller ()); next_rel = rel (blockp); /* Start non-zero */ do while (next_rel); /* Loop to end of chain */ next_rel = bit (bin (buffer.next, 18), 18); /* Hold foward pointer */ call buffer_freer; blockp = ptr (ttybp, next_rel); end; blockp = null; return; end chain_freer; /* Procedure to find a block of any size. It is extracted from the smallest free block which can hold it */ space_getter: proc (n) returns (ptr); dcl n fixed bin; /* The size in words */ dcl best_blockp ptr init (null); /* Ptr to smallest free block large enough for request */ dcl best_block_size fixed bin init (0); /* Size of that block */ dcl prev_best_blockp ptr init (null); /* Block before best_blockp -> free_block */ dcl prev_blockp ptr init (null); /* Block before current block during scan */ dcl next_rel bit (18); /* For updating threading */ dcl p ptr; dcl free_space (n) bit (36) aligned based (free_blockp); /* The space finially allocated */ dcl nsteps fixed bin init (0); /* Number of steps in free chain */ do free_blockp = ptr (ttybp, tty_buf.free) repeat (ptr (ttybp, free_block.next)) while (rel (free_blockp)); /* Check each free block */ nsteps = nsteps + 1; if free_block.size = n then do; /* Found block just right */ next_rel = free_block.next; /* Will unthread whole block */ go to fit_found; end; if free_block.size > n then do; /* This block is large enough */ if (best_block_size = 0) | (free_block.size < best_block_size) then do; /* If either the first block, or a better one */ best_blockp = free_blockp; /* Remember this block */ best_block_size = free_block.size; prev_best_blockp = prev_blockp; /* Remember preceding block */ end; end; prev_blockp = free_blockp; end; if best_block_size = 0 then do; /* No space large enough */ tty_buf.alloc_failures = tty_buf.alloc_failures + 1; return (null); end; free_blockp = best_blockp; /* Block to use */ prev_blockp = prev_best_blockp; p = addrel (free_blockp, n); /* Get pointer to new free block */ next_rel = rel (p); p -> free_block.next = free_block.next; p -> free_block.size = free_block.size - n; fit_found: if prev_blockp = null then tty_buf.free = next_rel; /* Have unthreaded from head */ else prev_blockp -> free_block.next = next_rel; /* Unthreaded from middle */ unspec (free_space) = "0"b; /* Clear the buffer */ tty_buf.bleft = tty_buf.bleft - n; /* Total free space */ if tty_buf.minimum_free_space = 0 | tty_buf.bleft < tty_buf.minimum_free_space then tty_buf.minimum_free_space = tty_buf.bleft; /* metering */ tty_buf.total_alloc_steps = tty_buf.total_alloc_steps + nsteps; return (free_blockp); /* Return the answer */ end space_getter; /* Procedure to free space of arbitrary size */ space_freer: proc (p, n); dcl p ptr; /* Address of block to free */ dcl n fixed bin; /* Word count */ dcl (prev_blockp, next_blockp) ptr; dcl next_rel fixed bin (18); if (baseno (p) ^= baseno (ttybp)) | (rel (p) < tty_buf.borig) then call err (3); free_blockp = p; free_block.size = n; /* Initialize free block */ free_block.next = "0"b; prev_blockp = null; do free_blockp = ptr (ttybp, tty_buf.free) repeat (ptr (ttybp, free_block.next)) while (rel (free_blockp)); /* Find spot in chain before this block */ if rel (p) < rel (free_blockp) then go to found_hole; /* Block goes before here */ else if rel (p) = rel (free_blockp) then call err (4); prev_blockp = free_blockp; end; /* Block goes at end */ free_blockp = p; go to chain_back; /* Found hole in middle for this block */ found_hole: next_blockp = free_blockp; free_blockp = p; next_rel = bin (rel (free_blockp)) + free_block.size; /* Word after current block */ if next_rel > bin (rel (next_blockp)) then call err (4); /* Overlap */ else if next_rel = bin (rel (next_blockp)) then do; /* Can combine with next */ free_block.next = next_blockp -> free_block.next; free_block.size = free_block.size + next_blockp -> free_block.size; end; else free_block.next = rel (next_blockp); /* Point current at next */ /* Chain back to preceding block */ chain_back: if prev_blockp = null then tty_buf.free = rel (free_blockp); /* This is first block */ else do; next_rel = bin (rel (prev_blockp)) + prev_blockp -> free_block.size; /* Word after previous block */ if next_rel > bin (rel (free_blockp)) then call err (4); /* Overlap */ else if next_rel = bin (rel (free_blockp)) then do; /* Can combine */ prev_blockp -> free_block.next = free_block.next; prev_blockp -> free_block.size = prev_blockp -> free_block.size + free_block.size; end; else prev_blockp -> free_block.next = rel (free_blockp); /* Make previous point at this one */ end; tty_buf.bleft = tty_buf.bleft + n; if tty_buf.space_needed then /* Somebody needs space */ if tty_buf.bleft >= abs_buf_limit then call interrupt_waiting_procs; return; end space_freer; /* Initialize by doing required masking and locking */ setup: proc; ttybp = addr (tty_buf$); lctp = tty_buf.lct_ptr; call pmut$wire_and_mask (wire_mask, wire_ptr); enter_time = clock (); call lock; total_freed = 0; return; end setup; /* Procedures that manage the tty_buffer lock word */ lock: proc; dcl start_time fixed bin (71); if tty_buf.slock = pds$processid then call err (1); /* Already locked to this process */ if ^stac (addr (tty_buf.slock), pds$processid) then do; /* Didn't lock at first attempt */ start_time = clock (); /* Record time we started to loop */ tty_buf.space_lock_wait_count = tty_buf.space_lock_wait_count + 1; do while (^stac (addr (tty_buf.slock), pds$processid)); end; tty_buf.space_lock_wait_time = tty_buf.space_lock_wait_time + clock () - start_time; end; tty_buf.space_lock_count = tty_buf.space_lock_count + 1; return; unlock: entry; if ^stacq (tty_buf.slock, "0"b, pds$processid) then call err (2); return; end lock; /* Unwire and unlock and unmask as required */ clean_up: proc; call unlock; call pmut$unwire_unmask (wire_mask, wire_ptr); return; end clean_up; /* Procedure to update a channels space usage counts */ update_lcte: proc (n); dcl n fixed bin; /* The increment (+ or -) */ dcl pc_devx fixed bin; if devx < 1 | devx > lct.max_no_lctes then return; lctep = addr (lct.lcte_array (devx)); pc_devx = lcte.physical_channel_devx; lctep = addr (lct.lcte_array (pc_devx)); if output_flag then do; lcte.output_words = lcte.output_words + n; tty_buf.current_output_space = tty_buf.current_output_space + n; tty_buf.cumulative_output_space = tty_buf.cumulative_output_space + tty_buf.current_output_space; tty_buf.output_space_updates = tty_buf.output_space_updates + 1; end; else do; lcte.input_words = lcte.input_words + n; tty_buf.current_input_space = tty_buf.current_input_space + n; tty_buf.cumulative_input_space = tty_buf.cumulative_input_space + tty_buf.current_input_space; tty_buf.input_space_updates = tty_buf.input_space_updates + 1; end; return; end update_lcte; /* Procedure to update control space usage counts (for metering) */ update_control: proc (n); dcl n fixed bin; /* The increment (+ or -) */ tty_buf.current_control_space = tty_buf.current_control_space + n; tty_buf.cumulative_control_space = tty_buf.cumulative_control_space + tty_buf.current_control_space; tty_buf.control_space_updates = tty_buf.control_space_updates + 1; end update_control; /* Send an interrupt to all processes who are waiting for space to become free */ interrupt_waiting_procs: proc; dcl i fixed bin; do i = 1 to lct.max_no_lctes; lctep = addr (lct.lcte_array (i)); if lcte.initialized then /* this is a live lcte */ if lcte.space_needed then do; lcte.space_needed = "0"b; call unlock; call channel_manager$interrupt (i, SPACE_AVAILABLE, ""b); call lock; end; end; do i = 1 to lct.max_no_lctes; /* Be sure no bits were set during our unlocks */ lctep = addr (lct.lcte_array (i)); if lcte.initialized then if lcte.space_needed then return; /* Leave global flag set */ end; tty_buf.space_needed = "0"b; /* All bits are truly off */ return; end interrupt_waiting_procs; /* Crash the system on error in tty_buf */ err: proc (n); dcl n fixed bin; call_syserr: call syserr (1, "tty_space_man: ^[Lock already locked to process^;Lock not locked to process^;Adress not in buffer pool^;Tried to free space already free^]." , n); go to call_syserr; end err; %include tty_buf; %include tty_buffer_block; %include lct; %include channel_manager_dcls; %include mcs_interrupt_info; /* BEGIN MESSAGE DOCUMENTATION Message: tty_space_man: Lock already locked to process. S: $crash T: $run M: A process that had the global tty_buf lock locked attempted to lock it again. A: $inform Message: tty_space_man: Lock not locked to process. S: $crash T: $run M: A process attempted to unlock the global tty_buf lock when that process did not have it locked. A: $inform Message: tty_space_man: Address not in buffer pool. S: $crash T: $run M: An attempt was made to free space at an address not included in the free space pool of tty_buf. A: $inform Message: tty_space_man: Tried to free space already free. S: $crash T: $run M: An attempt was made to free space in tty_buf that was included in or overlapped space that was already free. A: $inform END MESSAGE DOCUMENTATION */ end tty_space_man; 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