display_mc_anstbl.pl1 08/04/87 1456.8rew 08/04/87 1428.4 100143 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* 82-10-26 Written E. N. Kittlitz */ /* Modified for oper info... -E. A. Ranzenbach */ /* Modified for iox_ BIM 1984-10-30 */ /****^ HISTORY COMMENTS: 1) change(86-03-31,MSharpe), approve(87-06-12,MCR7690), audit(87-05-07,Parisek): Modified to recognize new mc_acte structure; to accept -pending & -p to print pending entries; to print pending entries, as well as active ones, by default. 2) change(87-02-05,GDixon), approve(87-06-12,MCR7690), audit(87-05-07,Parisek): Modified for change to mc_anstbl.incl.pl1. END HISTORY COMMENTS */ /* format: style2 */ display_mc_anstbl: procedure options (variable); dcl argc fixed bin; dcl argl fixed bin (21); dcl argn fixed bin; dcl argp ptr; dcl code fixed bin (35); dcl dn char (168); dcl en char (32); dcl found_a_channel bit (1) aligned; dcl header_sw bit (1) aligned; dcl header_only_sw bit (1) aligned; dcl mode fixed bin init (1); dcl name_count fixed bin; dcl name_error_printed_sw bit (1) aligned; dcl names (100) char (32); dcl octal_sw bit (1) aligned; dcl path char (168); dcl prev_argl fixed bin (21); dcl prev_argp ptr; dcl ME char (32) init ("display_mc_anstbl") static options (constant); dcl arg char (argl) based (argp) unaligned; dcl prev_arg char (prev_argl) based (prev_argp) unaligned; dcl (addr, null, char, codeptr, environmentptr, hbound, rtrim, unspec) builtin; dcl cleanup condition; dcl com_err_ entry options (variable); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl date_time_$format entry (character (*), fixed binary (71), character (*), character (*)) returns (character (250) var); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); dcl ioa_ entry () options (variable); dcl ioa_$nnl entry () options (variable); dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); dcl error_table_$noarg fixed bin (35) ext static; %page; mc_ansp = null; header_sw = "1"b; octal_sw = "0"b; header_only_sw = "0"b; path = ""; mode = 1; name_error_printed_sw = "0"b; name_count = 0; on cleanup call clean_up; call cu_$arg_count (argc, code); if code ^= 0 then do; call com_err_ (code, ME); go to exit; end; do argn = 1 to argc; call cu_$arg_ptr (argn, argp, argl, code); if char (arg, 1) = "-" then do; if arg = "-all" then mode = 0; else if arg = "-a" then mode = 0; else if arg = "-pending" then mode = 3; else if arg = "-p" then mode = 3; else if arg = "-octal" then octal_sw = "1"b; else if arg = "-oc" then octal_sw = "1"b; else if arg = "-no_octal" | arg = "-noc" then octal_sw = "0"b; else if arg = "-no_header" then header_sw = "0"b; else if arg = "-nhe" then header_sw = "0"b; else if arg = "-header" | arg = "-he" then header_sw = "1"b; else if arg = "-header_only" then header_only_sw = "1"b; else if arg = "-pathname" | arg = "-pn" then do; if path ^= "" then do; call com_err_ (0, ME, "^a specified more than once.", arg); return; end; prev_argp = argp; prev_argl = argl; argn = argn + 1; if argn > argc then do; missing_arg: call com_err_ (error_table_$noarg, ME, "Following: ^a.", prev_arg); return; end; call cu_$arg_ptr (argn, argp, argl, code); if char (arg, 1) = "-" then go to missing_arg; path = arg; end; else if arg = "-active" then mode = 1; else if arg = "-entire" then mode = 2; end; /* -control_arg */ else do; /* no leading -, call it a tty name */ if name_count >= hbound (names, 1) then do; if ^name_error_printed_sw then do; name_error_printed_sw = "1"b; call com_err_ (0, ME, "More than ^d channel names specified. Starting with ""^a"", channel names ignored.", hbound (names, 1), arg); end; end; /* too many names */ else do; /* add name */ name_count = name_count + 1; names (name_count) = arg; end; /* add name */ end; /* non -control_arg */ end; /* argument processing loop */ if path = "" then path = ">system_control_1>mc_anstbl"; call expand_pathname_ (path, dn, en, code); if code ^= 0 then do; call com_err_ (code, ME, "^a", path); go to exit; end; call initiate_file_ (dn, en, R_ACCESS, mc_ansp, (0), code); if mc_ansp = null then do; call com_err_ (code, ME, "^a", pathname_ (dn, en)); go to exit; end; call do_dump; if ^header_only_sw & ^found_a_channel then call com_err_ (0, ME, "No MC terminals ^[matched selection criteri^[on^;a^]^;found^].", (name_count > 0), (name_count = 1)); exit: call clean_up; return; clean_up: proc; if mc_ansp ^= null then call terminate_file_ (mc_ansp, 0, TERM_FILE_TERM, (0)); end clean_up; %page; do_dump: proc; dcl i fixed bin; dcl j fixed bin; dcl limit fixed bin; dcl mcode fixed bin (35); found_a_channel = "0"b; call ioa_ ("^/DUMP OF ^a", pathname_ (dn, en)); if header_sw | header_only_sw then do; call ioa_ ("max_size: ^21t^d", mc_anstbl.max_size); call ioa_ ("current_size: ^21t^d", mc_anstbl.current_size); call ioa_ ("mc_procid:^21t^w", mc_anstbl.mc_procid); call ioa_ ("sysdir:^21t^a", mc_anstbl.sysdir); call ioa_ ("mrtp:^21t^p", mc_anstbl.mrtp); call ioa_ ("vconsp:^21t^p", mc_anstbl.vconsp); call ioa_ ("cons_cont_proc:^21t^p, ^p", codeptr (mc_anstbl.cons_cont_proc), environmentptr (mc_anstbl.cons_cont_proc)); call ioa_ ("con_rec"); call ioa_ (" mc_ate_ptr:^21t^p", mc_anstbl.mc_ate_ptr); call ioa_ (" ec_id:^21t^24.3b", unspec (mc_anstbl.ec_id)); call ioa_ (" seq_num:^21t^d", mc_anstbl.seq_num); call ioa_ (" offset:^21t^oo", mc_anstbl.offset); call ioa_ (" flags"); call ioa_ (" enabled:^21t^[on^;off^]", mc_anstbl.con_rec.flags.enabled); call ioa_ (" active:^21t^[on^;off^]", mc_anstbl.con_rec.flags.active); call ioa_ ("n_sources:^21t^d", mc_anstbl.n_sources); call ioa_ ("max_sources:^21t^d", mc_anstbl.max_sources); call ioa_ ("current_time:^21t^a", date_time_$format ("date_time", mc_anstbl.current_time, "", "")); end; /* header_sw */ if header_only_sw then go to done_dump; if mode = 2 then limit = mc_anstbl.max_size; else limit = mc_anstbl.current_size; do i = 1 to limit; mc_atep = addr (mc_anstbl.entry (i)); if ^mc_ate.pending & mode = 3 then goto next_ate; else if ^(mc_ate.pending | mc_ate.active) & mode = 1 then go to next_ate; if name_count > 0 then do; /* must match a specified name */ mcode = -1; /* no match yet */ do j = 1 to name_count while (mcode ^= 0); /* scan the entire list */ call match_star_name_ ((mc_ate.real_tty_name), names (j), mcode); if mcode ^= 0 /* may have specified the vchn name */ then call match_star_name_ ((mc_ate.virtual_tty_name), names (j), mcode); end; if mcode ^= 0 then go to next_ate; end; found_a_channel = "1"b; call ioa_ ("^/ENTRY AT ^p", mc_atep); call ioa_ ("virtual_tty_name:^21t^a", rtrim (mc_ate.virtual_tty_name, "")); call ioa_ ("real_tty_name:^21t^a", rtrim (mc_ate.real_tty_name, "")); call ioa_ ("flags:"); call ioa_ (" active:^21t^[on^;off^]", mc_ate.active); call ioa_ (" virtual:^21t^[on^;off^]", mc_ate.virtual); call ioa_ (" pending:^21t^[on^;off^]", mc_ate.pending); call ioa_ (" the_system_console:^21t^[on^;off^]", mc_ate.flags.the_system_console); call ioa_ (" a_system_console:^21t^[on^;off^]", mc_ate.flags.a_system_console); call ioa_ (" signed_on:^21t^[on^;off^]", mc_ate.flags.signed_on); call ioa_ (" reply_restricted:^21t^[on^;off^]", mc_ate.flags.reply_restricted); call ioa_ (" broadcast:^21t^[on^;off^]", mc_ate.flags.broadcast); call ioa_ (" broadcast_all:^21t^[on^;off^]", mc_ate.flags.broadcast_all); call ioa_ (" vchn_requires_accept:^21t^[on^;off^]", mc_ate.flags.vchn_requires_accept); call ioa_ ("oper_info:"); call ioa_ ("^2xpersonid:^21t""^a""", rtrim (mc_ate.oper_info.personid, "")); call ioa_ ("^2xlast_input_time:^21t^a", date_time_$format ("date_time", mc_ate.oper_info.last_input_time, "", "")); call ioa_ ("cdte_ptr:^21t^p", mc_ate.cdtep); call ioa_ ("restrict_reply:^21t^a", rtrim (mc_ate.restrict_reply, "")); call ioa_ ("n_casts:^21t^d", mc_ate.n_casts); call ioa_$nnl ("cast:^21t"); do j = 1 to hbound (mc_ate.cast, 1) - 1; call ioa_$nnl ("^a, ", rtrim (mc_ate.cast (j), "")); end; call ioa_ ("^a", rtrim (mc_ate.cast (j), "")); call ioa_ ("sci_ptr:^21t^p", mc_ate.sci_ptr); call ioa_ ("iocb:^21t^p", mc_ate.iocb); call ioa_ ("tra_vec:^21t^d", mc_ate.tra_vec); call ioa_ ("queue_ptr:^21t^p", mc_ate.queue_ptr); call ioa_ ("queue_event:^21t^24.3b", unspec (mc_ate.queue_event)); call ioa_ ("event:^21t^24.3b", unspec (mc_ate.event)); call ioa_ ("ls_procid:^21t^w", mc_ate.ls_procid); call ioa_ ("ls_term_ev_chn:^21t^24.3b", unspec (mc_ate.ls_term_ev_chn)); call ioa_ ("ls_resp_ev_chn:^21t^24.3b", unspec (mc_ate.ls_resp_ev_chn)); call ioa_ ("ls_handle:^21t^2w", unspec (mc_ate.ls_handle)); call ioa_ ("authority"); call ioa_ (" privilege:^21t^w", mc_ate.privilege); call ioa_ ("control"); call ioa_ (" inhibit:^21t^[on^;off^]", mc_ate.control.inhibit); call ioa_ (" output_wait:^21t^[on^;off^]", mc_ate.control.output_wait); call ioa_ (" output_pending:^21t^[on^;off^]", mc_ate.control.output_pending); next_ate: end; /* do over mc_anstbl ate's */ done_dump: call ioa_ ("^/END DUMP OF ^a", pathname_ (dn, en)); end do_dump; %page; %include access_mode_values; %page; %include mc_anstbl; %page; %include terminate_file; end display_mc_anstbl;  dump_devq.pl1 02/07/85 0954.7r w 02/06/85 1403.7 29754 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ dump_devq: proc; dcl char32 char (32) aligned, dn char (168) aligned init (">system_control_dir"), en char (32) aligned, c1 char (1) aligned, alrm char (1) aligned, (i, j, k, l, m, n) fixed bin, ap ptr, al fixed bin, bchr char (al) unaligned based (ap), ec fixed bin (35), qp ptr; dcl 1 xxx based aligned, 2 w1 fixed bin (35), 2 w2 fixed bin (35); dcl (addr, null, substr, index, unspec, length, bit, fixed, divide, mod, abs) builtin; dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)), ioa_ entry options (variable), ioa_$nnl entry options (variable), com_err_ entry options (variable); dcl hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), ptr, fixed bin (35)), hcs_$terminate_noname entry (ptr, fixed bin (35)), hcs_$wakeup entry (bit (*) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); %include device_queue; /* ------------------------- */ call cu_$arg_ptr (1, ap, al, ec); if ec ^= 0 then do; er1: call com_err_ (ec, "dump_devq", ""); return; end; if bchr = "-pn" then do; call cu_$arg_ptr (2, ap, al, ec); if ec ^= 0 then go to er1; call expand_path_ (ap, al, addr (dn), addr (en), ec); if ec ^= 0 then do; er: call com_err_ (ec, "dump_devq", "^a", bchr); return; end; end; else en = bchr; if index (en, ".queue") = 0 then do; i = index (en, " "); substr (en, i) = ".queue"; end; call hcs_$initiate (dn, en, "", 0, 1, qp, ec); if qp = null then do; call com_err_ (ec, "dump_devq", "^a>^a", dn, en); return; end; call ioa_ ("^/DEVICE QUEUE - ^a", device_queue.device_name); call ioa_ ("mc_atep:^9x^p", device_queue.mc_atep); call ioa_ ("channel:^9x^w^w", addr (device_queue.channel) -> w1, addr (device_queue.channel) -> w2); call ioa_ ("no_of_messages:^2x^d", device_queue.no_of_messages); call ioa_ ("top_of_queue:^4x^d", device_queue.top_of_queue); call ioa_ ("end_of_queue:^4x^d", device_queue.end_of_queue); call ioa_ ("free_top:^8x^d", device_queue.free_top); call ioa_ ("next_free:^7x^d", device_queue.next_free); call ioa_ ("^/NUM NEXT OFF LTH SC MESSAGE^/"); do i = 1 to device_queue.next_free; if device_queue.line (i).not_done then c1 = "+"; else c1 = " "; if device_queue.line (i).alarm then alrm = "*"; else alrm = " "; call ioa_$nnl ("^3d^1a^5d^6d^6d^3d^1a^a", i, c1, device_queue.line (i).next_line, device_queue.line (i).offset, device_queue.line (i).line_length, device_queue.line (i).source, alrm, device_queue.line (i).string); end; call ioa_ (""); call hcs_$terminate_noname (qp, ec); end;  dump_mrt.pl1 02/07/85 0954.7r w 02/06/85 1403.7 46089 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ dump_mrt: proc; /* DUMP_MRT - dump message routing table THVV */ dcl (path, dn) char (168) aligned, en char (32) aligned, srch (10) char (32) aligned, line char (120) aligned, datstr char (16) aligned, vstr char (64) aligned, vconst char (33) aligned, (i, j, k, l, m, n) fixed bin, (time, fb71) fixed bin (71), ap ptr, al fixed bin, bchr char (al) unaligned based (ap), ec fixed bin (35), (p, q) ptr; dcl (addr, null, substr, index, unspec, length, bit, fixed, divide, mod, abs) builtin; dcl clock_ entry () returns (fixed bin (71)), cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)), ioa_ entry options (variable), date_time_ entry (fixed bin (71), char (*) aligned), com_err_ entry options (variable); dcl hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), ptr, fixed bin (35)), hcs_$terminate_noname entry (ptr, fixed bin (35)); %include mess_route_table; dcl mrtp ptr; dcl streamp ptr; /* ------------------------------------------------------- */ m = 0; l = 0; k = 2; path = ">system_control_1>MRT"; call cu_$arg_ptr (1, ap, al, ec); if ec ^= 0 then go to mrt1; path = bchr; arglp: call cu_$arg_ptr (k, ap, al, ec); /* See if optional args */ if ec ^= 0 then go to mrt1; m = m + 1; /* count selectors */ if m > 10 then go to mrt1; if bchr = "*" then l = m; srch (m) = bchr; k = k + 1; go to arglp; mrt1: i = index (path, " "); call expand_path_ (addr (path), i, addr (dn), addr (en), ec); if ec ^= 0 then do; er: call com_err_ (ec, "dump_mrt", "^a", path); return; end; call hcs_$initiate (dn, en, "", 0, 1, mrtp, ec); if mrtp = null then go to er; if m = 0 then do; /* Header only if no selected args. */ call date_time_ ((clock_ ()), datstr); call ioa_ ("^/Message Routing Table - ^a^/", datstr); call ioa_ ("lock:^15x^w", MRT.lock); call ioa_ ("no_of_sources:^6x^d", MRT.no_of_sources); call ioa_ ("flags:^14x^w", MRT.flags); end; if l ^= 0 then do; /* want to list star entry */ srch (m) = ""; go to pss; end; if m = 0 then do; pss: call ioa_ ("^/SOURCE: ^a^/", MRT.star_entry.source); call ioa_ ("no_of_streams:^6x^d", MRT.star_entry.no_of_streams); call pstream (addr (MRT.star_entry.stream)); end; do i = 1 to MRT.no_of_sources; if ^MRT.source (i).flags.valid then go to skip; if m = 0 then go to pss1; do n = 1 to m; if MRT.source (i).source = srch (n) then do; srch (n) = ""; go to pss1; end; end; go to skip; pss1: call ioa_ ("^/SOURCE: ^a^/", MRT.source (i).source); call ioa_ ("hismess:^12x^p", MRT.source (i).hismess); call ioa_ ("no_of_streams:^6x^d", MRT.source (i).no_of_streams); vstr = "valid"; if MRT.source (i).flags.init then vstr = vstr || ", init"; call ioa_ ("flags:^14x^a", vstr); do j = 1 to MRT.source (i).no_of_streams; if MRT.source (i).stream (j).flags.valid then call pstream (addr (MRT.source (i).stream (j))); end; skip: end; if m = 0 then call ioa_ ("^/End^/"); else do i = 1 to m; if srch (i) ^= "" then call ioa_ ("source ""^a"" not in MRT", srch (i)); end; call hcs_$terminate_noname (mrtp, ec); return; pstream: proc (sp); dcl sp ptr; dcl k fixed bin, vstr char (64) varying, sourcet char (32) aligned; streamp = sp; call ioa_ ("^/^5xSTREAM: ^a^/", stream.stream); if substr (stream.source, 1, 1) < " " then sourcet = "*"; else sourcet = stream.source; call ioa_ ("^5xsource:^8x^a", sourcet); vstr = "valid"; if stream.flags.read then vstr = vstr || ", read"; if stream.flags.write then vstr = vstr || ", write"; if stream.flags.active then vstr = vstr || ", active"; call ioa_ ("^5xflags:^9x^a", vstr); call ioa_ ("^5xourmess:^7x^p", stream.ourmess); call ioa_ ("^5xhismess:^7x^p", stream.hismess); call ioa_ ("^5xsource_index:^2x^d", stream.source_index); call ioa_ ("^5xstream_index:^2x^d", stream.stream_index); call ioa_ ("^5xno_of_vcons:^3x^d^/", stream.no_of_vcons); do k = 1 to stream.no_of_vcons; if substr (stream.flags.alarm, k, 1) then vconst = "*" || stream.vcons (k); else vconst = stream.vcons (k); /* Star means alarm flag will be in message */ call ioa_ ("^10xvcons ^d: ^3d ^a", k, stream.vcons_index (k), vconst); end; end pstream; end dump_mrt;  dump_syscon_mseg.pl1 09/03/87 1221.9rew 09/03/87 1221.4 71982 /****^ *********************************************************** * * * 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(87-09-02,Parisek), approve(87-09-03,MECR0005), audit(87-09-02,GDixon), install(87-09-03,MR12.1-1098): Expand the quit_bits display to include all possible 504 bits. (phx20974) END HISTORY COMMENTS */ dump_syscon_mseg: dump_msg: proc; /* automatic */ dcl argl fixed bin, /* Length of current argument */ argno fixed bin, /* Number of current argument */ code fixed bin, /* For errors */ i fixed bin, /* A temporary index */ j fixed bin, /* Another */ k fixed bin, /* Another */ n_blocks fixed bin, highest_quit_bits fixed bin(24), /* quit_bits to display */ (temp_stream, temp_source) char (32); declare argp pointer, /* Pointer to current argument */ messp pointer, /* Pointer to current block */ msegp pointer; /* Pointer to the message segment */ declare barg char (argl) based (argp), /* For getting arguments */ date_string char (25), dirname char (168), entname char (32), flagn_arr (4) char (16) varying int static init ("continue, ", "introduction, ", "farewell, ", "sentinel, "), list char (64) varying; /* For printing bit names &c */ declare addr builtin, length builtin, null builtin, rel builtin, string builtin, substr builtin, unspec builtin; declare com_err_ entry options (variable), cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin), date_time_$hundredths entry (fixed bin (71), char (*)), expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin), find_bit_$last_on entry (bit (*) aligned) returns (fixed bin (24)), hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin), ioa_ entry options (variable); /* include files */ %include syscon_mseg; /* program */ /* This program dumps a "message" segment of the message routing facility */ /* First get the pathname of the seg from the command line */ argno = 1; call cu_$arg_ptr (argno, argp, argl, code); if code ^= 0 then do; call com_err_ (code, "dump_msg", "Pathname of message segment"); return; end; call expand_path_ (argp, argl, addr (dirname), addr (entname), code); if code ^= 0 then do; call com_err_ (code, "dump_msg", "^a", barg); return; end; call hcs_$initiate (dirname, entname, "", 0, 1, msegp, code); if msegp = null then do; call com_err_ (code, "dump_msg", "^a>^a", dirname, entname); return; end; call ioa_ ("lock:^2-^12.3b^/locked_by_pid:^-^12.3b", msegp -> syscon_mseg.mlock, msegp -> syscon_mseg.locked_by_pid); call ioa_ ("process_id:^-^12.3b", msegp -> syscon_mseg.current_process_id); call ioa_ ("regular channel:^-^72.3b", unspec (msegp -> syscon_mseg.ipc_el.channel)); call ioa_ ("protocol channel:^-^72.3b", unspec (msegp -> syscon_mseg.proto_el.channel)); /* Prepare list of flags that are on & print it */ list = ""; highest_quit_bits = find_bit_$last_on (msegp->syscon_mseg.quit_bits); if msegp -> syscon_mseg.flags.test_mode then list = "test_mode, "; if msegp -> syscon_mseg.flags.receiver_woken then list = list || "receiver_woken, "; if list ^= "" then call ioa_ ("flags:^2-^a", substr (list, 1, length (list) - 2)); call ioa_ ("first_free_buffer:^-^d", msegp -> syscon_mseg.first_free_buffer); call ioa_ ("last_assigned_buffer:^-^d", msegp -> syscon_mseg.last_assigned_buffer); call ioa_ ("no_of_streams:^-^d", msegp -> syscon_mseg.no_of_streams); call ioa_ ("quit bits:^-^.3b", substr (msegp -> syscon_mseg.quit_bits, 1, highest_quit_bits)); call ioa_ ("mescount:^2-^d", msegp -> syscon_mseg.mescount); call ioa_ ("output_wait:^-^[ON^;OFF^]", msegp -> syscon_mseg.output_wait); n_blocks = msegp -> syscon_mseg.last_assigned_buffer; begin; /* allocate space to hold trace flags */ dcl already_printed bit (n_blocks) unaligned; already_printed = "0"b; call print_chain ("protocol", msegp -> syscon_mseg.first_proto); call print_chain ("regular", msegp -> syscon_mseg.first_message); call print_chain ("free", msegp -> syscon_mseg.first_free_buffer); if (^already_printed) ^= ""b then do; call ioa_ ("Not in any chain:"); do k = 1 to n_blocks; if substr (already_printed, k, 1) = "0"b then call print_block (k); end; end; return; print_chain: proc (chain_name, chain_head); declare chain_name char (*), chain_head fixed bin, chainlen fixed bin, this_message fixed bin; chainlen = 0; this_message = chain_head; do while (this_message ^= 0); /* find out how long chain is */ if ^substr (already_printed, this_message, 1) then do; substr (already_printed, this_message, 1) = "1"b; chainlen = chainlen + 1; this_message = msegp -> syscon_mseg.message (this_message).next_message; end; else this_message = 0; /* quit because we've looped back */ end; call ioa_ ("There are ^d blocks in the ^a chain", chainlen, chain_name); if chainlen = 0 then return; /* No chain to print */ call ioa_ ("OFFSET # NEXT SOURCE STREAM INDICES TIME FLAGS"); pb: this_message = chain_head; do i = 1 to chainlen; messp = addr (msegp -> syscon_mseg.message (this_message)); if messp -> debug_info.flag = -1 then do; /* debugging info block */ call ioa_ ("^6.3b ^3d DEBUG INFO:", rel (messp), this_message); call date_time_$hundredths (messp -> debug_info.time, date_string); call ioa_ ("^-time:^-^a", date_string); call ioa_ ("^-last_pid:^-^12.3b", messp -> debug_info.last_pid); call ioa_ ("^-first_msg:^-^d", messp -> debug_info.first_msg); call ioa_ ("^-last_msg:^-^d", messp -> debug_info.last_msg); call ioa_ ("^-first_pro:^-^d", messp -> debug_info.first_pro); call ioa_ ("^-last_pro:^-^d", messp -> debug_info.last_pro); call ioa_ ("^-free_chain:^-^d", messp -> debug_info.free_chain); go to next_block; end; list = ""; do j = 1 to 4; if substr (string (message_block.flags), j, 1) then list = list || flagn_arr (j); end; if list ^= "" then list = substr (list, 1, length (list) -2); call date_time_$hundredths (message_block.time_sent, date_string); if unspec (message_block.from_source) = ""b then temp_source = "(unset)"; else temp_source = message_block.from_source; if unspec (message_block.from_stream) = ""b then temp_stream = "(unset)"; else temp_stream = message_block.from_stream; call ioa_ ("^6.3b ^3d ^3d ^10a ^10a ^3d ^3d ^a ^a", rel (messp), this_message, message_block.next_message, temp_source, temp_stream, message_block.source_index, message_block.stream_index, date_string, list); call ioa_ ("^3d ^a", message_block.length, substr (message_block.message_body, 1, message_block.length)); this_message = message_block.next_message; next_block: end; return; print_block: entry (chain_head); chainlen = 1; goto pb; end print_chain; end; end dump_syscon_mseg;  dump_vct.pl1 02/07/85 0954.7r w 02/06/85 1403.7 35316 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ dump_vct: proc; /* DUMP_VCT - dump virtual console table THVV */ dcl (path, dn) char (168) aligned, en char (32) aligned, srch (10) char (32) aligned, line char (120) aligned, datstr char (16) aligned, vstr char (64) aligned, (i, j, k, l, m, n) fixed bin, (time, fb71) fixed bin (71), ap ptr, al fixed bin, bchr char (al) unaligned based (ap), ec fixed bin (35), (p, q) ptr; dcl (addr, null, substr, index, unspec, length, bit, fixed, divide, mod, abs) builtin; dcl clock_ entry () returns (fixed bin (71)), cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)), ioa_ entry options (variable), date_time_ entry (fixed bin (71), char (*) aligned), com_err_ entry options (variable); dcl hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), ptr, fixed bin (35)), hcs_$terminate_noname entry (ptr, fixed bin (35)); %include vcons_tab; dcl vconsp ptr; dcl vcep ptr; dcl typer (3) char (4) aligned int static init ("tty", "log", "sink"); /* ------------------------------------------------------- */ m = 0; l = 0; k = 2; path = ">system_control_1>vcons_tab"; call cu_$arg_ptr (1, ap, al, ec); if ec ^= 0 then go to vct1; path = bchr; arglp: call cu_$arg_ptr (k, ap, al, ec); if ec ^= 0 then go to vct1; m = m + 1; if m > 10 then go to vct1; if bchr = "*" then l = m; srch (m) = bchr; k = k + 1; go to arglp; vct1: i = index (path, " "); call expand_path_ (addr (path), i, addr (dn), addr (en), ec); if ec ^= 0 then do; er: call com_err_ (ec, "dump_vct", "^a", path); return; end; call hcs_$initiate (dn, en, "", 0, 1, vconsp, ec); if vconsp = null then go to er; if m = 0 then do; call date_time_ ((clock_ ()), datstr); call ioa_ ("^/Virtual Console Table - ^a^/", datstr); call ioa_ ("lock:^15x^w", vcons_tab.lock); call ioa_ ("no_of_vcons:^8x^d", vcons_tab.no_of_vcons); call ioa_ ("flags:^14x^w", vcons_tab.flags); end; if l ^= 0 then do; srch (l) = ""; go to pvv; end; if m = 0 then do; pvv: call ioa_ ("^/VIRTUAL CONSOLE: ^a^/", vcons_tab.star_entry.vcons); call pvcons (addr (vcons_tab.star_entry)); end; do i = 1 to vcons_tab.no_of_vcons; if ^vcons_tab.vcons (i).flags.inuse then go to skip; if m = 0 then go to pvv1; do n = 1 to m; if vcons_tab.vcons (i).vcons = srch (n) then do; srch (n) = ""; go to pvv1; end; end; go to skip; pvv1: call ioa_ ("^/VIRTUAL CONSOLE: ^a^/", vcons_tab.vcons (i).vcons); call pvcons (addr (vcons_tab.vcons (i))); skip: end; if m = 0 then call ioa_ ("^/End^/"); else do i = 1 to m; if srch (i) ^= "" then call ioa_ ("vcons ""^a"" not in vcons_tab", srch (i)); end; call hcs_$terminate_noname (vconsp, ec); return; pvcons: proc (sp); dcl sp ptr; dcl k fixed bin, vstr char (64) varying, vconst char (32) aligned; vcep = sp; vstr = "inuse"; call ioa_ ("^5xflags:^9x^a", vstr); call ioa_ ("^5xno_of_dest:^4x^d^/", vcons.no_of_dest); do k = 1 to vcons.no_of_dest; call ioa_ ("^10xdest ^d:^3x^4a ^a ^p", k, typer (vcons.dest (k).type), vcons.dest (k).dest, vcons.dest (k).queue_seg_ptr); end; end pvcons; end dump_vct;  mc_check_access_.pl1 08/05/87 0801.2r 08/04/87 1540.6 24714 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* mc_check_access_ -- access control for Message Coordinator */ /* format: style2 */ mc_check_access_: procedure; /**** Modification History: Created 1985-01-07, BIM. */ declare P_SSI_ptr pointer; declare P_source_name char (*); declare P_code fixed bin (35); declare P_user_name char (*); declare mc_check_acs_$reply entry (character (*), fixed binary (3), character (*), fixed binary (35)); declare mc_check_acs_$quit entry (character (*), fixed binary (3), character (*), fixed binary (35)); declare mc_check_acs_$log_daemon_in entry (character (*), fixed binary (3), character (*), fixed binary (35)); declare mc_check_acs_$log_daemon_out entry (character (*), fixed binary (3), character (*), fixed binary (35)); declare mc_check_acs_$new_proc_daemon entry (character (*), fixed binary (3), character (*), fixed binary (35)); declare mc_check_acs_$log_in_as_daemon entry (character (*), fixed binary (3), character (*), fixed binary (35)); declare DEFAULT_RING fixed bin (3) init (4) int static options (constant); reply: entry (P_SSI_ptr, P_source_name, P_code); sc_subsystem_info_ptr = P_SSI_ptr; call mc_check_acs_$reply (sc_subsystem_info.access_control_name, DEFAULT_RING, P_source_name, P_code); return; quit: entry (P_SSI_ptr, P_source_name, P_code); sc_subsystem_info_ptr = P_SSI_ptr; call mc_check_acs_$quit (sc_subsystem_info.access_control_name, DEFAULT_RING, P_source_name, P_code); return; log_daemon_in: entry (P_SSI_ptr, P_source_name, P_code); sc_subsystem_info_ptr = P_SSI_ptr; call mc_check_acs_$log_daemon_in (sc_subsystem_info.access_control_name, DEFAULT_RING, P_source_name, P_code); return; log_daemon_out: entry (P_SSI_ptr, P_source_name, P_code); sc_subsystem_info_ptr = P_SSI_ptr; call mc_check_acs_$log_daemon_out (sc_subsystem_info.access_control_name, DEFAULT_RING, P_source_name, P_code); return; new_proc_daemon: entry (P_SSI_ptr, P_source_name, P_code); sc_subsystem_info_ptr = P_SSI_ptr; call mc_check_acs_$new_proc_daemon (sc_subsystem_info.access_control_name, DEFAULT_RING, P_source_name, P_code); return; log_in_as_daemon: entry (P_user_name, P_source_name, P_code); call mc_check_acs_$log_in_as_daemon (P_user_name, DEFAULT_RING, P_source_name, P_code) ; return; %include sc_subsystem_info_; end mc_check_access_;  mc_check_acs_.pl1 08/04/87 1456.8rew 08/04/87 1221.8 53757 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1987 * * * *********************************************************** */ /* mc_check_acs_ -- access control for Message Coordinator */ /* format: style2 */ mc_check_acs_: procedure; /**** Modification History: Created 1984-12-26, BIM. Modified 1985-01-29 by E. Swenson to add auditing */ /****^ HISTORY COMMENTS: 1) change(87-02-23,GDixon), approve(87-06-12,MCR7690), audit(87-05-07,Parisek), install(87-08-04,MR12.1-1055): Correct coding standard violations. Add copyright notice. END HISTORY COMMENTS */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* NOTES ON AUDITING: */ /* */ /* This procedure is responsible for access checks and auditing in the */ /* usual manner. If the redundancy level gets out of hand (in terms of */ /* duplicate messages) then a solution will have to be found. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ declare P_source_name char (*); declare P_user_name char (*); declare P_code fixed bin (35); declare P_ring fixed bin (3); declare global_access_op bit (36) aligned; declare modes bit (36) aligned; declare rtrim builtin; declare convert_access_operation_ entry (bit (36) aligned) returns (char (50)); declare hcs_$get_user_access_modes entry (char (*), char (*), char (*), fixed bin, bit (36) aligned, bit (36) aligned, fixed bin (35)); declare sys_log_ entry options (variable); declare ( GRANT initial ("1"b), DENY initial ("0"b) ) bit (1) aligned internal static options (constant); declare ( access_operations_$daemon_daemon_login, access_operations_$daemon_reply, access_operations_$daemon_login, access_operations_$daemon_logout, access_operations_$daemon_quit ) ext static bit (36) aligned; declare ( error_table_$mc_no_c_permission, error_table_$mc_no_d_permission, error_table_$mc_no_q_permission, error_table_$mc_no_r_permission ) fixed bin (35) ext static; reply: entry (P_user_name, P_ring, P_source_name, P_code); call setup (access_operations_$daemon_reply); /* returns non-locally if checking is disabled */ call hcs_$get_user_access_modes (sc_stat_$mc_acs_dir, rtrim (P_source_name) || ".mcacs", P_user_name, (P_ring), (""b), modes, P_code); if P_code = 0 then if (modes & MCACS_R_ACCESS) = ""b then P_code = error_table_$mc_no_r_permission; if P_code = 0 then call AUDIT (GRANT); else call AUDIT (DENY); return; quit: entry (P_user_name, P_ring, P_source_name, P_code); call setup (access_operations_$daemon_quit); /* returns non-locally if checking is disabled */ call hcs_$get_user_access_modes (sc_stat_$mc_acs_dir, rtrim (P_source_name) || ".mcacs", P_user_name, (P_ring), (""b), modes, P_code); if P_code = 0 then if (modes & MCACS_Q_ACCESS) = ""b then P_code = error_table_$mc_no_q_permission; if P_code = 0 then call AUDIT (GRANT); else call AUDIT (DENY); return; log_daemon_in: entry (P_user_name, P_ring, P_source_name, P_code); call setup (access_operations_$daemon_login); /* returns non-locally if checking is disabled */ go to CONTROL_COMMON; log_daemon_out: entry (P_user_name, P_ring, P_source_name, P_code); call setup (access_operations_$daemon_logout); /* returns non-locally if checking is disabled */ go to CONTROL_COMMON; new_proc_daemon: entry (P_user_name, P_ring, P_source_name, P_code); call setup (access_operations_$daemon_quit); /* returns non-locally if checking is disabled */ CONTROL_COMMON: call hcs_$get_user_access_modes (sc_stat_$mc_acs_dir, rtrim (P_source_name) || ".mcacs", P_user_name, (P_ring), (""b), modes, P_code); if P_code = 0 then if (modes & MCACS_C_ACCESS) = ""b then P_code = error_table_$mc_no_c_permission; if P_code = 0 then call AUDIT (GRANT); else call AUDIT (DENY); return; log_in_as_daemon: entry (P_user_name, P_ring, P_source_name, P_code); call setup (access_operations_$daemon_daemon_login); /* returns non-locally if checking is disabled */ call hcs_$get_user_access_modes (sc_stat_$mc_acs_dir, rtrim (P_source_name) || ".mcacs", P_user_name, (P_ring), (""b), modes, P_code); if P_code = 0 then if (modes & MCACS_D_ACCESS) = ""b then P_code = error_table_$mc_no_d_permission; if P_code = 0 then call AUDIT (GRANT); else call AUDIT (DENY); return; setup: procedure (access_op); declare access_op bit (36) aligned; P_code = 0; global_access_op = access_op; if ^installation_parms.validate_daemon_commands then go to EXIT_NONLOCAL; return; end setup; EXIT_NONLOCAL: return; AUDIT: procedure (P_grant_sw); /**** This procedure is responsible for auditing all message coordinator access. P_grant_sw indicates if the access check resulted in a GRANT of DENY. */ dcl P_grant_sw bit (1) aligned parameter; call sys_log_ (SL_LOG_SILENT, "Audit: ^[GRANTED^;DENIED^] ^a for ^a Level=^d to ^a", P_grant_sw, convert_access_operation_ (global_access_op), P_user_name, P_ring, P_source_name); return; end AUDIT; %include as_data_; %include installation_parms; declare ip pointer defined (as_data_$rs_ptrs (0)); %include mcacs_access_modes; %include sc_stat_; %include sys_log_constants; end mc_check_acs_;  mc_commands_.pl1 11/14/88 1010.2rew 11/14/88 1005.9 655587 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ mc_commands_: proc; /* This procedure is part of the message coordinator. It contains entries that support all of the message coordinator commands. * The message coordinator was originally created by Dennis Capps with advice from TH VanVleck in October of 1972. "mc_commands_" originally created by Bill Silver in May, 74. modified by D. M. Wells, July 1976, to understand about FTP channels modified by Robert Coren, August 1976, to use CDT Modified June 1981 by T. Casey for MR9.0 for new wakeup priorities. Modified January 1982 by E. N. Kittlitz to check for intty before searching cdt. * 84-11-16, W. Olin Sibert: Changed to call mc_con_rec_$check correctly 1984-11-??, BIM: changes for iox_. 1985-03-22, E. Swenson: to eliminate extra NL at end of messages and to log operator logout upon dropping a mc terminal. 1985-04-05, E. Swenson: Fixed to handle dropping/substty on accepted channels whose multiplexer has not yet been loaded. 1985-04-17, E. Swenson: To not attempt to sign out a terminal not signed on. */ /****^ HISTORY COMMENTS: 1) change(85-12-19,MSharpe), approve(87-05-01,MCR7690), audit(87-05-10,Parisek), install(87-08-04,MR12.1-1055): The following modules were changed so that DSA channels could be used as MC terminals: new_tty, KILL_TTY, ATTACH_ATE, SEARCH_MC_ANSTBL. A new module, mc_login, was added for the same purpose. It supports "login Person_id -operator -vchannel"; after the answering service has validated this user to be eligible for logging in as an operator, this routine is called to fill in the actual_channel_name of the pre-accepted virtual channel specified, and to attach the iocb for it. CDD-3/28/86: to clear out login server id in KILL_TTY 2) change(87-02-05,GDixon), approve(87-05-01,MCR7690), audit(87-05-10,Parisek), install(87-08-04,MR12.1-1055): Modified for change to mc_anstbl.incl.pl1. Entrypoint which reference mc_anstbl must now explicitly set mc_ansp from sc_stat_$mc_ansp. CDD-4/10/86: to set virtual and realy tty_name correctly. 3) change(87-02-13,GDixon), approve(87-05-01,MCR7690), audit(87-05-10,Parisek), install(87-08-04,MR12.1-1055): Correct problem in mc_commands_$substty where target terminal is otw_ (the system console). A previous substty operation (substty otw_ XXX) destroyed the ssu_ subsystem associated with the console; an attempt to substitute I/O back to the system console (substty XXX otw_) then assumes the ssu_ subsystem still exists. Avoid the destroy operation for the system console. (phx20406) 4) change(87-04-06,Parisek), approve(87-05-01,MCR7690), audit(87-07-17,Beattie), install(87-08-04,MR12.1-1055): Commented in the error_table_$(bad_vchannel vchn_active vchn_not_found) error assignments. 5) change(87-04-23,GDixon), approve(87-05-01,MCR7690), audit(87-05-10,Parisek), install(87-08-04,MR12.1-1055): Fill in login_server_operator_response.process_group_id so message coordinator channels will have proper group id in connection list. 6) change(87-05-04,Parisek), approve(87-05-01,MCR7690), audit(87-07-17,Beattie), install(87-08-04,MR12.1-1055): A. Set mc_atep for the valid otw_ mc_anstbl entry instead of leaving it null for returning to caller. B. Initialize the mc_ate.oper_info.personid. 7) change(87-05-18,GDixon), approve(87-05-01,MCR7690), audit(87-05-10,Parisek), install(87-08-04,MR12.1-1055): Use revised calling sequence for uc_send_ls_response_. 8) change(87-05-27,Parisek), approve(87-05-01,MCR7690), audit(87-07-17,Beattie), install(87-08-04,MR12.1-1055): A. If by chance the returned cdte pointer from DROP_CDT_TERMINAL is null, I added a call sys_log_ call to document the error. B. Removed FIND_CDTE internal procedure for locating the cdtep, and instead use the value of mc_ate.cdtep which is the cdtep previously set when the channel was originally attached. C. Pass the mc_atep (mc_anstbl entry pointer) as the parameter to DROP_CDT_TERMINAL instead of the tty name so the cdt entry pointer can be determined faster. 9) change(87-06-12,Parisek), approve(87-05-01,MCR7690), audit(87-07-17,Beattie), install(87-08-04,MR12.1-1055): Added the P_utep parameter for mc_login so we can set the ute.proc_id to that of the target process which is needed in case the process is bumped. 10) change(87-06-18,Parisek), approve(87-05-01,MCR7690), audit(87-07-17,Beattie), install(87-08-04,MR12.1-1055): Do not reference mc_ate.cdte for otw_ since otw_ has no cdt entry. This corrects a null pointer fault problem when doing a substty of otw_ for another channel. 11) change(87-06-26,Parisek), approve(87-06-26,MCR7690), audit(87-07-17,Beattie), install(87-08-04,MR12.1-1055): A. Add the access_class_range parameter to mc_login passed by it's caller. B. Check allowable access_class_range for dialed user. C. Add internal procs ABORT_DIALIN and DIALIN_OK for sending audit data. D. Call ABORT_DIALIN or DIALIN_OK where necessary in mc_login entry. 12) change(87-08-07,Parisek), approve(87-08-07,MCR7690), audit(87-08-07,GDixon), install(87-08-07,MR12.1-1073): Change the audit action value for successful dialins to a positive (accepted) value from a negative (rejected) value. 13) change(88-11-04,Parisek), approve(87-06-26,MCR7690), audit(88-11-10,Beattie), install(88-11-14,MR12.2-1211): Check for a valid cdte pointer (mc_ate.cdtep) for a terminal dialed to the MC (DROP_CDT_TERMINAL internal proc) before attempting to reset the cdte information for that terminal. Reestablished the FIND_CDTE internal proc for locating the cdtep for the dialed terminal in the case where mc_atep or mc_ate.cdtep is null. END HISTORY COMMENTS */ declare P_access_class (2) bit (72) aligned; declare P_cdtp ptr parameter; declare P_cdte_flag bit (1) aligned parameter; declare P_drop_terminal bit (1) aligned parameter; declare P_ls_handle bit (72) parameter; declare P_ls_procid bit (36) parameter; declare P_ls_term_ev_chn fixed bin (71) parameter; declare P_ls_resp_ev_chn fixed bin (71) parameter; declare P_mpx_name char (*) parameter; declare P_mc_ansp ptr parameter; declare P_mc_atep ptr parameter; declare P_mcmp ptr parameter; declare P_message_ptr ptr parameter; declare P_temp_SDBp ptr parameter; declare P_vchannel char (*) parameter; declare P_utep ptr parameter; declare inttyp ptr parameter; /* (OUTPUT) ptr to mc_ate */ declare code fixed bin (35) parameter; /* error code */ declare Message_ptr pointer parameter; /* used in reply and intercom */ declare Message_length fixed bin (21) parameter; /* ditto */ declare insc char (*) parameter; /* A source to route */ declare instream char (*) parameter; /* A stream for us to route */ declare intty char (*) parameter; /* A console for us to use */ declare invc char (*) parameter; /* Virt Cons */ declare param1 char (*) parameter; /* A new target. */ declare type char (*) parameter; /* type of destination */ /* Declarations of POINTERS */ declare bufferp2 ptr, /* Addr of buffer2 */ iutep ptr, /* ptr to Initializer ute entry */ mcmp ptr int static init (null), /* to message seg for message coordinator */ messp ptr int static init (null), mrtp ptr int static init (null), /* to Message Routing Table */ p ptr, /* A temporary pointer used by substty */ qp ptr, /* to queue of lines to be typed on a device */ streamp ptr, /* to a stream entry in MRT */ temp_SDBp ptr int static init (null), /* to temp_SDB */ vcep ptr, /* to an entry in virtual console table */ vconsp ptr int static init (null), /* to Virtual CONSole table */ wakeup_data_ptr ptr; /* Fixed binary quantities */ declare autocode fixed bin (35) init (0), /* error code in automatic storage */ ls_status_code fixed bin (35) init (0), /* ditto */ dest fixed bin, /* Index when looping thru phys devices in vcons_tab */ fbtype fixed bin, /* type of destination,1=>tty 2=>log 3=>sink */ i fixed bin, /* a temporary index */ j fixed bin, /* another temporary index */ jj fixed bin, k fixed bin, /* loop counter for protocol and router */ lng fixed bin, /* Length of formatted string for output */ ls_event_channel fixed bin (71), /* login server event channel; used for drop */ mrt_source fixed bin, /* Index of source entry in MRT */ mrt_stream fixed bin, /* Index of stream entry in source entry in MRT */ nt fixed bin, /* No of characters actually typed */ state fixed bin, /* 0 -- end of data, 1-- more to message */ this_line fixed bin, /* Current link in q of lines to be typed */ vc fixed bin, /* Index when looping thru vcons in MRT */ vce fixed bin, /* Index of Virtual Console table Entry */ wakeup_data_len fixed bin (18); /* length of mc_ate; passed to LS for dial wakeup */ /* Character strings */ declare Destination char (*) varying; declare Message char (*); dcl old_operator_name char (32); /* operator currently signed on */ declare mpx_starname char (32); /* star name that matches subchannels of mpx */ declare message char (Message_length) based (Message_ptr); declare 1 ls_operator_resp aligned like login_server_operator_response; declare 1 ls_term_resp aligned like login_server_termination_response; declare 1 CAI structure aligned like channel_audit_info automatic; declare buffer2 char (132); declare char32 char (32); /* automatic intty */ declare insca char (32); /* automatic insc */ declare instreama char (32); /* automatic instream */ declare iocb_name char (32); declare recipient char (32); /* the source to which a reply is directed */ declare tempdest char (32); /* A temporary */ declare vchannel char (32); /* automatic P_vchannel */ /* BIT strings */ declare access_class_range (2) bit (72) aligned, /* dialed aim class */ authority bit (36), /* Parameter Privileges for this console */ created_seg (8) bit (1) init ((8) (1)"0"b), /* In case we want to write messages */ dont_log bit (1) init ("0"b), /* "1"b=>Sentinel-- Needn't be logged */ cdte_flag bit (1) aligned, /* ""b=> channel not defined in cdt */ ls_handle bit (72) aligned, /* login server handle for channel; used for drop */ ls_process_id bit (36) aligned, /* login server process id; used for drop */ must_send_operator_response bit (1), /* "1"b=> respond to login server's operator request */ new_vchn_flag bit (1), op_ok bit (1), /* ""b => channel must be accepted by oprator */ sendalarm bit (1), /* TRUE if alarm message; at distribute */ virtual_flag bit (1) aligned, /* "1"b if intty in new_tty is a vchn name */ zerobits bit (72) init (""b); /* used for sending operator response */ /* BUILTIN FUNCTIONS */ declare addr builtin, clock builtin, index builtin, length builtin, null builtin, search builtin, size builtin, string builtin, substr builtin, unspec builtin, codeptr builtin, rtrim builtin; /* CONSTANTS */ declare (TRUE init ("1"b), FALSE init (""b)) bit (1) aligned int static options (constant); /* EXTERNAL ENTRIES */ declare aim_check_$greater entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); declare as_access_audit_$channel entry (ptr, ptr, ptr, fixed bin, ptr, char (*)); declare astty_$tty_event entry (ptr, fixed bin (35)); declare ioa_$ioa_switch entry () options (variable); declare cdt_mgr_$find_cdt_channel entry (pointer, character (32), fixed binary, bit (1) aligned, fixed binary (35)); declare convert_status_code_ entry (fixed binary (35), character (8) aligned, character (100) aligned); declare get_group_id_ entry () returns (char (32)); declare get_process_access_class_ entry () returns (bit (72) aligned); declare get_process_id_ entry () returns (bit (36)); declare get_ring_ entry () returns (fixed bin (3)); declare hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)); declare hcs_$chname_seg entry (ptr, char (*), char (*), fixed bin (35)); declare hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); declare hphcs_$ips_wakeup entry (bit (*) aligned, char (*)); declare ioa_ entry options (variable); declare ioa_$rs entry options (variable); declare ioa_$rsnnl entry options (variable); declare ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); declare ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35)); declare ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); declare lg_ctl_$logout_operator entry (ptr, char (*), char (*)); declare lg_ctl_$logout_channel entry (ptr, char (*)); declare log_write_$open entry (character (*), character (*), bit (1) aligned, pointer, fixed binary (35)); declare log_write_$close entry (pointer, fixed binary (35)); declare match_star_name_ entry (char (*), char (*), fixed bin (35)); declare mc_con_rec_$check entry (); declare mc_util_$get_seg entry (char (*), ptr, fixed bin (35)); declare mc_util_$mrt_source entry (char (*), fixed bin, fixed bin (35)); declare mc_util_$mrt_stream entry (fixed bin, char (*), ptr, fixed bin, fixed bin (35)); declare mc_util_$queue entry (ptr, bit (1), ptr, fixed bin, fixed bin, fixed bin (35)); declare mc_wakeups_$typer_out entry; declare mrd_util_$write entry (ptr, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)); declare sc_create_sci_ entry (pointer, fixed binary (35)); declare sc_create_sci_$destroy entry (pointer); declare ssu_$get_info_ptr entry (ptr) returns (ptr); declare sys_log_$command_error entry options (variable); declare sys_log_ entry options (variable); declare uc_send_ls_response_ entry (ptr, fixed bin (18), bit (36) aligned, bit (72) aligned, fixed bin (71), ptr, char (32) aligned, fixed bin (35), fixed bin (35)); declare unique_chars_ entry (bit (*)) returns (char (15)); /* EXTERNAL constants */ declare as_error_table_$dialnotup fixed bin (35) ext static; declare (error_table_$action_not_performed, error_table_$ai_out_range, error_table_$bad_vchannel, error_table_$invalid_device, error_table_$io_no_permission, error_table_$ioname_not_active, error_table_$ioname_not_found, error_table_$ionmat, error_table_$noentry, error_table_$notalloc, error_table_$typename_not_found, error_table_$vchn_active, error_table_$vchn_not_found) fixed bin (35) ext static; declare cleanup condition; %page; init: entry (P_mc_ansp, P_cdtp, P_temp_SDBp, P_mcmp, P_message_ptr); /* This entry is called by mc_util_$init. It sets up all of the internal static variables needed by the other entries. */ mc_ansp, sc_stat_$mc_ansp = P_mc_ansp; temp_SDBp = P_temp_SDBp; mcmp = P_mcmp; messp = P_message_ptr; mrtp = mc_anstbl.mrtp; vconsp = mc_anstbl.vconsp; return; %page; /* This is the reply command. */ reply_command: entry (Destination, Message_ptr, Message_length, inttyp, code); code = 0; recipient = Destination; mc_atep = inttyp; if mc_atep ^= null () then if mc_ate.flags.reply_restricted then if mc_ate.restrict_reply ^= "" then /* If there is a restriction on reply */ if recipient ^= mc_ate.restrict_reply then do; /* .. check it. */ code = error_table_$io_no_permission; /* Naughty. */ return; end; call mc_util_$mrt_source (recipient, mrt_source, code); if code ^= 0 then return; /* Couldn't find him. */ if ^MRT.source (mrt_source).flags.init then /* He's not attached. */ do; noreply: code = error_table_$ioname_not_active; return; end; temp_SDBp -> stream.hismess = MRT.source (mrt_source).hismess; /* Where to put the reply. */ autocode = 0; /* Write it. */ call mrd_util_$write (temp_SDBp, Message_ptr, 0, (Message_length), nt, state, autocode); code = autocode; return; %page; /* This entry checks to see if the source named has enabled quits, by checking a bit in mc.message. If quits are enabled, it uses a highly-privileged interface to send an IPS quit. */ quit_command: entry (insc, inttyp, code); code = 0; insca = insc; if inttyp ^= null () /* Not send_admin_command_ or some other previleged entity */ then if inttyp -> mc_ate.flags.reply_restricted then /* Is this terminal limited in who it can quit? */ if inttyp -> mc_ate.restrict_reply ^= insca then do; code = error_table_$io_no_permission; /* Naughty. */ return; end; call mc_util_$mrt_source (insca, mrt_source, code); if code ^= 0 then return; /* Couldn't find him. */ if ^MRT.source (mrt_source).flags.init then /* He's not attached. */ do; code = error_table_$ioname_not_active; return; end; if substr (mcmp -> syscon_mseg.quit_bits, mrt_source, 1) then do; /* Quits enabled? */ call ioa_ ("Sending quit to ^a (^w)", MRT.source (mrt_source).source, MRT.source (mrt_source).hismess -> syscon_mseg.current_process_id); call hphcs_$ips_wakeup (MRT.source (mrt_source).hismess -> syscon_mseg.current_process_id, "quit"); end; else code = error_table_$io_no_permission; return; %page; intercom: entry (Destination, Message_ptr, Message_length, inttyp, code); /**** This entry is called when an operator downstairs wants to talk to an operator upstairs. */ code = 0; bufferp2 = addr (buffer2); char32 = Destination; mc_atep = SEARCH_MC_ANSTBL (char32, code); /* Look up destination. */ if code ^= 0 then return; /* Quit if not in table. */ if mc_ate.iocb = null () then do; code = error_table_$ioname_not_active; return; end; call ioa_$rsnnl ("FROM ^a: ^a", buffer2, lng, inttyp -> mc_ate.real_tty_name, message); qp = mc_ate.queue_ptr; /* Locate device queue for destination. */ sendalarm = "0"b; /* Don't make a fuss. */ call mc_util_$queue (qp, sendalarm, bufferp2, lng, 0, code); /* Queue stuff for writing. */ return; %page; /* This entry is called by system_control_ whenever an input line is typed. It logs the input line, so that we can find out what was said to the system, and it may broadcast the input line to other terminals if the mc_ate for the sending terminal specifies. */ note_input: entry (Message, inttyp, code); code = 0; if inttyp = null () then return; mc_ansp = sc_stat_$mc_ansp; bufferp2 = addr (buffer2); call ioa_$rs (" (input on ^a) ^a", buffer2, lng, inttyp -> mc_ate.real_tty_name, Message); sendalarm = "0"b; /* Not that important. */ if inttyp -> mc_ate.broadcast & ^inttyp -> mc_ate.broadcast_all then do; /* Broadcast to specified list? */ do k = 1 to inttyp -> mc_ate.n_casts; /* Scan broadcast list. */ char32 = inttyp -> mc_ate.cast (k); /* Get one destination. */ mc_atep = SEARCH_MC_ANSTBL (char32, code); /* Hunt receiver. */ if code = 0 then if mc_atep ^= inttyp then do; /* NEVER broadcast back to inputter. */ qp = mc_ate.queue_ptr; /* Locate queue segment. */ call mc_util_$queue (qp, sendalarm, bufferp2, lng, 0, code); end; end; end; else if inttyp -> mc_ate.broadcast & inttyp -> mc_ate.broadcast_all then do; /* Broadcast to everybody? */ do k = 1 to mc_anstbl.current_size; /* Check all consoles. */ mc_atep = addr (mc_anstbl.entry (k)); if mc_ate.flags.active then if mc_atep ^= inttyp then do; /* .. nor does it mean myself (silly) */ qp = mc_ate.queue_ptr; call mc_util_$queue (qp, sendalarm, bufferp2, lng, 0, code); end; end; end; return; %page; /* This entry is called by admin to set the broadcast list for a terminal. The default is no broadcast. */ set_broadcast: entry (intty, instring, code); dcl instring char (*); code = 0; char32 = intty; /* Search for this console. */ mc_atep = SEARCH_MC_ANSTBL (char32, code); /* .. */ if code ^= 0 then return; if instring = "none" then do; /* Reset switch. */ mc_ate.broadcast, mc_ate.broadcast_all = "0"b; mc_ate.n_casts = 0; mc_ate.cast (*) = ""; end; else if instring = "all" then mc_ate.broadcast, mc_ate.broadcast_all = "1"b; else do; /* Must be list. */ mc_ate.n_casts = 0; /* Clear list. */ mc_ate.broadcast = "1"b; do i = 1 repeat i + j while (i < length (instring)); j = search (substr (instring, i), ","); /* find next comma. */ if j = 0 then j = length (instring) - i + 2; mc_ate.n_casts = mc_ate.n_casts + 1; mc_ate.cast (mc_ate.n_casts) = substr (instring, i, j - 1); end; end; return; %page; /* This entry is called by admin to set the "reply restriction" for a terminal. */ set_restrict: entry (intty, instring, code); code = 0; char32 = intty; mc_atep = SEARCH_MC_ANSTBL (char32, code); if code ^= 0 then return; mc_ate.restrict_reply = instring; mc_ate.flags.reply_restricted = (instring ^= ""); return; %page; new_vchannel: entry (intty, authority, inttyp, code); /* This entry is the same as accept (below) except that the virtual channels created this way, must be "accepted" by the operator before being used. */ code = 0; char32 = intty; new_vchn_flag = "1"b; virtual_flag = "1"b; cdte_flag = "0"b; goto COMMON_NEW; %page; new_tty: entry (intty, authority, P_cdte_flag, inttyp, code); /* This entry accepts a console by symbolic name and adds it to the message coordinator's answer table. It also creates a typeout queue segment for this new tty. First check for this console already hooked up. If not, do it. Return error_table_$ionmat if it's already here. mc_commands_$mc_login is used for creating entries in the mc_anstbl when the "login {person_id} -operator", without -vchannel, is used; it sets the mc_ate.pending flag. Only these custom-made entries may be used for dsa channels when virtual channels are not used. */ code = 0; char32 = intty; virtual_flag = (index (char32, ".") = 0) & (char32 ^= "otw_"); cdte_flag = P_cdte_flag; /* has a cdte ? */ new_vchn_flag = ""b; COMMON_NEW: /* new_vchannel joins us here */ must_send_operator_response = ""b; /* i.e., we don't need to send a response */ mc_atep = SEARCH_MC_ANSTBL (char32, code); inttyp = mc_atep; /* output param */ if code = 0 then if ^mc_ate.flags.pending then do; string (mc_ate.authority) = authority; /* Reset authority flags. */ if mc_ate.sci_ptr ^= null () then do; /* not supposed to happen, but faults are un-nice. */ sc_subsystem_info_ptr = ssu_$get_info_ptr (mc_ate.sci_ptr); sc_subsystem_info.restriction_flags = authority; end; code = error_table_$ionmat; return; end; else if mc_ate.flags.virtual /* vchannel pending accept */ then do; mc_ate.flags.pending = ""b; if mc_ate.ls_procid ^= ""b /* network line */ then call FILL_RESPONSE_STRUCTURE (); /* prepare to reply to login_server operator request */ call CONNECT_PHYSICAL_CHANNEL (); return; end; else ; else if (code ^= error_table_$ioname_not_found & code ^= error_table_$ioname_not_active) then return; if mc_atep = null /* need to allocate a new_entry */ then do; if ^cdte_flag & ^virtual_flag then do; /* non-cdt channels are created upon "dialing in" */ code = error_table_$ioname_not_found; /* same code as a channel not in MC_SERVICE */ return; end; j, mc_anstbl.current_size = mc_anstbl.current_size + 1; mc_atep = addr (mc_anstbl.entry (j)); end; else if ^cdte_flag & ^virtual_flag /* requires pending entry */ & code = error_table_$ioname_not_found then return; code = 0; mc_ate.flags = ""b; mc_ate.pad_ptrs = ""b; mc_ate.flags.vchn_requires_accept = new_vchn_flag; mc_ate.queue_ptr = null; mc_ate.sci_ptr = null; mc_ate.iocb = null; mc_ate.cdtep = null; mc_ate.queue_event = 0; mc_ate.pad_ev_chn = ""b; mc_ate.virtual_tty_name = intty; mc_ate.oper_info.personid = ""; string (mc_ate.authority) = authority; /* What this typewriter is allowed to do. */ mc_ate.flags.active = "1"b; /* Now initiate or create queue seg. */ if length (rtrim (mc_ate.virtual_tty_name)) + length (".queue") <= 32 then call mc_util_$get_seg (rtrim (mc_ate.virtual_tty_name) || ".queue", qp, code); else do; call mc_util_$get_seg (unique_chars_ (""b), qp, code); if code = 0 then call hcs_$chname_seg (qp, "", intty, (0)); end; if code ^= 0 then goto NEWERR; mc_ate.queue_ptr = qp; /* Seg for queue of things to be typed. */ mc_ate.n_casts = 0; mc_ate.restrict_reply = ""; /* .. and to whom. (default is everybody) */ string (mc_ate.control) = "0"b; /* Allowed to type but nothing waiting */ call ipc_$create_ev_chn (mc_ate.queue_event, code); /* Channel to wake when want to type. */ if code ^= 0 then goto NEWERR; /* Set up console queue seg */ call hcs_$truncate_seg (qp, 0, code); if code ^= 0 then goto NEWERR; device_queue.channel = mc_ate.queue_event; device_queue.device_name = intty; device_queue.mc_atep = mc_atep; /* What to do when typer channel kicked. */ call ipc_$decl_ev_call_chn (device_queue.channel, mc_wakeups_$typer_out, qp, MC_PRIO, code); if code ^= 0 then goto NEWERR; call mc_con_rec_$check (); /* Check to see if we can use this terminal for console recovery. */ if virtual_flag then do; mc_ate.flags.virtual = "1"b; return; end; if mc_ate.ls_procid ^= ""b /* network line */ then call FILL_RESPONSE_STRUCTURE (); /* prepare to reply to login_server operator request */ call CONNECT_PHYSICAL_CHANNEL (); /* attach iocb, event channel for dial/hangup, etc. mc_login does this for virtual channels when someone logs into one */ if mc_ate.real_tty_name = "otw_" & mc_ate.flags.the_system_console then /* Define the mc_ate pointer for otw_ */ inttyp = addr (mc_anstbl.entry (1)); if code = 0 then return; NEWERR: if must_send_operator_response then do; ls_operator_resp.status_code = code; call uc_send_ls_response_ (addr (ls_operator_resp), size (ls_operator_resp), ls_process_id, ls_handle, ls_event_channel, addr (zerobits), (intty), 0, code); end; else ; call KILL_TTY (mc_atep); return; %page; mc_login: entry (intty, Operator_name, P_utep, P_vchannel, P_access_class, P_ls_procid, P_ls_term_ev_chn, P_ls_resp_ev_chn, P_ls_handle, code); /* This routine is called by dial_mgr_ to let us know that someone wishes to "login" as a message coordinator. If the P_vchannel is "", we create a pending mc_ate for the channel, and "sign on" the operator. Only a "pending" entry may be used for a DSA channel; "accept" will not create or assign a free mc_ate to DSA channels. This is required for DSA channels since there is no CDTE to hold this information. If the P_vchannel is provided, and a "virtual" mc_ate already exists, we fill in the mc_ate.tty portion, attach the iocb and "sign on" the operator. */ code = 0; char32 = intty; utep = P_utep; vchannel = P_vchannel; access_class_range = P_access_class; mc_ansp = sc_stat_$mc_ansp; dutp = as_data_$dutp; iutep = addr (dutbl.entry (1)); /* Initializer's ute entry ptr */ op_ok = ""b; if vchannel = "" then do; mc_atep = SEARCH_MC_ANSTBL (char32, code); if code = 0 /* already active */ | code = error_table_$ioname_not_active /* already pending */ then do; code = error_table_$ionmat; call ABORT_DIALIN (code, ""); return; end; else if code ^= error_table_$ioname_not_found then do; call ABORT_DIALIN (code, ""); return; /* "real" error */ end; if mc_atep = null /* create a new entry */ then do; if mc_anstbl.current_size = mc_anstbl.max_size then do; /* no more room */ code = error_table_$notalloc; call ABORT_DIALIN (code, ""); return; end; mc_anstbl.current_size = mc_anstbl.current_size + 1; mc_atep = addr (mc_anstbl.entry (mc_anstbl.current_size)); end; unspec (mc_ate) = ""b; end; else do; /* attach to a virtual channel */ if (index (vchannel, ".") ^= 0) | (vchannel = "otw_") then do; code = error_table_$bad_vchannel; call ABORT_DIALIN (code, ""); return; end; mc_atep = SEARCH_MC_ANSTBL (char32, code); if (code = 0 | code = error_table_$ioname_not_active) then do; code = error_table_$ionmat; call ioa_$rsnnl ("Channel ^a already in use.", buffer2, (0), char32); call sys_log_$command_error (-1, code, "mc_commands_$mc_login", buffer2); call ABORT_DIALIN (code, ""); return; end; else if code ^= error_table_$ioname_not_found then do; call ABORT_DIALIN (code, ""); return; /* real error */ end; mc_atep = SEARCH_MC_ANSTBL (vchannel, code); if code = 0 then if mc_ate.iocb ^= null () then do; code = error_table_$vchn_active; /* vchannel already active */ call ABORT_DIALIN (code, ""); return; end; else ; else do; if code = error_table_$ioname_not_found /* vchannel does not exist */ then code = error_table_$vchn_not_found; call ABORT_DIALIN (code, ""); return; end; if sc_stat_$vchn_requires_accept then do; do i = 1 to mc_anstbl.current_size while (^op_ok); if (Operator_name = mc_anstbl.entry (i).oper_info.personid) /* operator already cleared */ then op_ok = "1"b; end; end; if ^mc_ate.flags.vchn_requires_accept then op_ok = "1"b; end; if aim_check_$greater (get_process_access_class_ (), access_class_range (1)) then do; call ABORT_DIALIN (error_table_$ai_out_range, "Channel not system_low"); return; end; mc_ate.virtual_tty_name = vchannel; mc_ate.real_tty_name = intty; mc_ate.sci_ptr = null (); mc_ate.cdtep = null (); mc_ate.ls_procid = P_ls_procid; /* Accept wakeups from this process in mc_tty_ */ mc_ate.ls_term_ev_chn = P_ls_term_ev_chn; mc_ate.ls_resp_ev_chn = P_ls_resp_ev_chn; mc_ate.ls_handle = P_ls_handle; call ipc_$create_ev_chn (mc_ate.event, code); if code ^= 0 then do; call ABORT_DIALIN (code, ""); return; end; call ipc_$decl_ev_call_chn (mc_ate.event, mc_anstbl.cons_cont_proc, mc_atep, MC_PRIO, code); if code ^= 0 then do; call ABORT_DIALIN (code, ""); return; end; if utep ^= null then ute.proc_id = get_process_id_ (); /* Target process set in case a bump is done */ if op_ok then do; mc_ate.flags.pending = ""b; call FILL_RESPONSE_STRUCTURE (); call CONNECT_PHYSICAL_CHANNEL (); if code ^= 0 then do; call ABORT_DIALIN (code, ""); return; /* let AS deal with the login_server */ end; end; else mc_ate.flags.pending = "1"b; /* wait for "accept" */ /* Tell the operator */ call sys_log_ (SL_LOG_BEEP, "^a: Channel ^a^[ vchannel (^a)^;^s^] dialed to Initializer (^a^[ ACCEPTED^])", "mc_commands_$mc_login", mc_ate.real_tty_name, mc_ate.flags.virtual, mc_ate.virtual_tty_name, Operator_name, op_ok); /* Sign on the operator */ if ^sc_stat_$no_operator_login then mc_ate.oper_info.personid = Operator_name; code = 0; call DIALIN_OK (); return; %page; remove_tty: entry (intty, P_drop_terminal, code); /* This entry is called to remove a tty from the message coordinator. It removes all references to this channel from all vcons table entries. If intty is the name of the real channel connected to a virtual channel, the real channel is dropped, but the output to the virtual channel continues to get queued up, i.e., the virtual channel may be reused without needing to be "accepted" again. Otherwise, the channel is removed from the list of destinations of all virtual consoles and the iocb, queue segment, event channels and the corresponding mc_ate are destroyed. If this entry is called from mc_tty_ when a terminal is disconnected, P_drop_terminal is ""b and no attempt is made to disconnect the line. */ code = 0; char32 = intty; if index (char32, ".") ^= 0 | intty = "otw_" then virtual_flag = ""b; else virtual_flag = "1"b; mc_atep = SEARCH_MC_ANSTBL (char32, code); if code = error_table_$ioname_not_active then do; if P_drop_terminal then do; code = 0; if mc_ate.ls_procid = ""b & ^mc_ate.virtual then call DROP_CDT_TERMINAL (mc_atep, char32); else call SEND_OPERATOR_RESPONSE (mc_ate.real_tty_name, error_table_$action_not_performed); end; mc_ate.flags.pending = ""b; mc_ate.real_tty_name = ""; mc_ate.oper_info.personid = ""; mc_ate.ls_procid = ""b; return; end; if code ^= 0 then do; code = 0; call DROP_CDT_TERMINAL (mc_atep, char32); if code ^= 0 then call sys_log_ (SL_LOG_BEEP, "Unable to locate a CDT entry for ^a while attempting to drop it.", char32); return; end; /* Find every reference to this typewriter that is made in the vcons tab */ do vce = 1 to vcons_tab.no_of_vcons; vcep = addr (vcons_tab.vcons (vce)); if vcons.flags.inuse /* No need to look at empty entries */ then do dest = 1 to vcons.no_of_dest; if vcons.dest (dest).dest = char32 then /* found a reference */ do; /* Get rid of it */ do i = dest to vcons.no_of_dest - 1; vcons.dest (i).type = vcons.dest (i + 1).type; vcons.dest (i).dest = vcons.dest (i + 1).dest; vcons.dest (i).queue_seg_ptr = vcons.dest (i + 1).queue_seg_ptr; end; vcons.no_of_dest = vcons.no_of_dest - 1; goto rtnext; /* Assume its not here twice */ end; end; rtnext: end; /* Remember the star entry */ vcep = addr (vcons_tab.star_entry); do dest = 1 to vcons.no_of_dest; if vcons.dest (dest).dest = char32 then do; do i = dest to vcons.no_of_dest - 1; vcons.dest (i).type = vcons.dest (i + 1).type; vcons.dest (i).dest = vcons.dest (i + 1).dest; vcons.dest (i).queue_seg_ptr = vcons.dest (i + 1).queue_seg_ptr; end; vcons.no_of_dest = vcons.no_of_dest - 1; goto rtnext1; end; end; rtnext1: if mc_ate.pending /* pending on a vchannel */ then do; if P_drop_terminal then do; code = 0; if mc_ate.ls_procid = ""b & ^mc_ate.virtual then call DROP_CDT_TERMINAL (mc_atep, char32); else call SEND_OPERATOR_RESPONSE (mc_ate.real_tty_name, error_table_$action_not_performed); end; if mc_ate.real_tty_name = char32 /* just drop the real tty of a vchannel */ then do; mc_ate.flags.pending = ""b; mc_ate.real_tty_name = ""; mc_ate.oper_info.personid = ""; mc_ate.ls_procid = ""b; return; end; else ; /* drop down to call kill_tty */ end; else if ^(mc_ate.flags.virtual & mc_ate.virtual_tty_name = char32 & mc_ate.real_tty_name = "") /* all but vchns not connected to a real channel */ then do; call DELETE_IOCB (mc_atep); if P_drop_terminal then do; if mc_ate.ls_procid = ""b then do; call DROP_CDT_TERMINAL (mc_atep, char32); if code = error_table_$noentry then call sys_log_ (SL_TYPE_BEEP, "Unable to locate a CDT entry for ^a while attempting to drop it.", mc_ate.real_tty_name); end; else do; call SEND_TERMINATE_RESPONSE (); mc_ate.ls_procid = ""b; end; end; if mc_ate.virtual_tty_name ^= char32 then do; /* do not remove the mc_ate */ mc_ate.signed_on = ""b; mc_ate.oper_info.personid = ""; return; end; end; /* "Delete" the mc_ate, queue segment, the whole thing */ code = 0; qp = mc_ate.queue_ptr; call KILL_TTY (mc_atep); /* Remove the mc_ate */ return; %page; /* This entry is essentially an abbreviation for the following sequence of calls: remove_tty(intty) new_tty (param1) define (,param1) where successively takes on the names of all virtual consoles that were previously directed to intty. It is complicated by having to preserve the output destined for intty, which it puts in param1's queue by copying it wholesale. */ substty: entry (intty, param1, P_cdte_flag, inttyp, P_drop_terminal, code); code = 0; char32 = intty; mc_atep = SEARCH_MC_ANSTBL (char32, code); if code ^= 0 then return; /* Not there, meaningless. */ inttyp = SEARCH_MC_ANSTBL ((param1), code); /* We need to weed out the pending entries */ if code = error_table_$ioname_not_active | code = 0 then if inttyp -> mc_ate.pending then do; code = error_table_$action_not_performed; return; end; cdte_flag = P_cdte_flag; call new_tty (param1, string (mc_ate.authority), cdte_flag, inttyp, autocode); if autocode ^= 0 then if autocode = error_table_$ionmat then autocode = 0; else do; /* Real error. */ code = autocode; return; end; p = inttyp -> mc_ate.queue_ptr; /* Pointer to queue seg of new typewriter. */ qp = mc_atep -> mc_ate.queue_ptr; /* Pointer to queue seg of old typewriter. */ /* Change all the references in the virtual console table. */ do vce = 1 to vcons_tab.no_of_vcons; vcep = addr (vcons_tab.vcons (vce)); if vcons.flags.inuse then /* No need to look at empty entries */ do dest = 1 to vcons.no_of_dest; if vcons.dest (dest).dest = intty then /* Found a reference */ do; /* Change it */ vcons.dest (dest).dest = param1; vcons.dest (dest).queue_seg_ptr = p; end; end; end; /* * */ vcep = addr (vcons_tab.star_entry); do dest = 1 to vcons.no_of_dest; if vcons.dest (dest).dest = intty then do; vcons.dest (dest).dest = param1; vcons.dest (dest).queue_seg_ptr = p; end; end; /* Now transfer all the pending output for intty to queue for param1 */ if qp -> device_queue.no_of_messages = 0 then goto delete; /* Nothing to save */ i = p -> device_queue.end_of_queue; /* Link saved stuff to end of savior queue */ if i ^= 0 then p -> device_queue.line (i).next_line = p -> device_queue.next_free + 1; j = p -> device_queue.next_free + 1; /* Dont fiddle with free list. Just allocate blocks */ this_line = qp -> device_queue.top_of_queue; do jj = 1 to 10000 while (this_line ^= 0); p -> device_queue.line (j).not_done = qp -> device_queue.line (this_line).not_done; p -> device_queue.line (j).alarm = qp -> device_queue.line (this_line).alarm; p -> device_queue.line (j).offset = qp -> device_queue.line (this_line).offset; p -> device_queue.line (j).source = qp -> device_queue.line (this_line).source; p -> device_queue.line (j).line_length = qp -> device_queue.line (this_line).line_length; p -> device_queue.line (j).string = qp -> device_queue.line (this_line).string; this_line = qp -> device_queue.line (this_line).next_line; if this_line = 0 then /* This is the end of the chain */ p -> device_queue.line (j).next_line = 0; else do; p -> device_queue.line (j).next_line = j + 1; j = j + 1; end; end; p -> device_queue.no_of_messages = p -> device_queue.no_of_messages + qp -> device_queue.no_of_messages; if p -> device_queue.top_of_queue = 0 then /* Savior was previously empty */ do; p -> device_queue.top_of_queue = p -> device_queue.next_free + 1; call hcs_$wakeup (mc_anstbl.mc_procid, p -> device_queue.channel, 0, code); /* wake typer_out */ end; p -> device_queue.end_of_queue = j; p -> device_queue.next_free = j; delete: call DELETE_IOCB (mc_atep); if mc_ate.ls_procid = ""b & ^mc_ate.virtual then call DROP_CDT_TERMINAL (mc_atep, char32); else call SEND_TERMINATE_RESPONSE (); if ^(mc_ate.flags.virtual & mc_ate.real_tty_name = char32) then call KILL_TTY (mc_atep); /* Delete the typewriter. */ return; %page; /* This is the guts of the define command. The human interface is in admin_ which then calls this entry for every definition. If the specified tty is not found in the mc_anstbl, the vcons given the default destination and an error code is returned. If the specified vcons is already known, the new destination is added, otherwise a new vcons entry is created. The real channel associated with a vchannel may be specified interchangeably with the vchannel to which it is connected. Pending entries not associated with vchannels are treated like non-existent ttys. Pending entries associated with vchannels are rejected; the operator can define the vcons using the star_entry or the vchannel name. */ define: entry (invc, type, intty, code); code = 0; /* initialization is bliss */ if type = "tty" then do; fbtype = 1; char32 = intty; mc_atep = SEARCH_MC_ANSTBL (char32, code); /* Look for this typewriter in mc_answer table */ if code ^= 0 then if code ^= error_table_$ioname_not_found & code ^= error_table_$ioname_not_active then return; /* A real error */ else do; /* Not there. Use default typewriter. */ qp = vcons_tab.star_entry.dest (1).queue_seg_ptr; tempdest = vcons_tab.star_entry.dest (1).dest; mc_atep = device_queue.mc_atep; end; else do; /* Found it. Get relevant info */ if mc_ate.flags.pending & mc_ate.real_tty_name = char32 then do; /* the real channel pending accept on vchannel */ code = error_table_$action_not_performed; return; end; qp = mc_ate.queue_ptr; tempdest = char32; end; vcep = SEARCH_VCONS_TAB (invc, vce, autocode); /* Look for this vcons in table */ if autocode = 0 then goto change_vce; /* Found it. */ if autocode = error_table_$ioname_not_found then goto new_vce; /* Not there */ if code = 0 then code = autocode; /* A real error. */ return; end; else if type = "log" then do; fbtype = 2; tempdest = intty; call log_write_$open (sc_stat_$log_dir, tempdest, "1"b /* create ok */, qp, code); if code ^= 0 then return; vcep = SEARCH_VCONS_TAB (invc, vce, code); /* Look for this vcons in table. */ if code = 0 then goto change_vce; /* Found it. */ if code ^= error_table_$ioname_not_found then return; /* A real error */ code = 0; /* not there */ goto new_vce; end; else if type = "sink" then do; fbtype = 3; tempdest = intty; qp = null; vcep = SEARCH_VCONS_TAB (invc, vce, code); if code = 0 then goto change_vce; if code ^= error_table_$ioname_not_found then return; /* Not there */ code = 0; goto new_vce; end; else do; /* Bad type */ code = error_table_$typename_not_found; return; end; change_vce: /* Find out if this destination is already defined */ do i = 1 to vcons.no_of_dest while (vcons.dest (i).dest ^= tempdest); end; if i > vcons.no_of_dest then /* didn't find it */ if i > 8 then /* Not room for it anyway */ do; if code = 0 then code = error_table_$notalloc; return; end; else vcons.no_of_dest = i; /* Allocate new entry */ vcons.dest (i).type = fbtype; vcons.dest (i).dest = tempdest; vcons.dest (i).queue_seg_ptr = qp; return; new_vce: if vcep = null then /* There wasn't a vacant entry. */ do; vce, vcons_tab.no_of_vcons = vcons_tab.no_of_vcons + 1; /* Allocate a new entry. */ vcep = addr (vcons_tab.vcons (vce)); end; vcons.vcons = invc; vcons.no_of_dest = 1; vcons.flags.inuse = "1"b; vcons.dest (1).type = fbtype; vcons.dest (1).dest = tempdest; vcons.dest (1).queue_seg_ptr = qp; return; %page; redefine: entry (invc, intty, type, param1, code); code = 0; call undefine (invc, intty, code); if code ^= 0 then return; call define (invc, type, param1, code); return; %page; undefine: entry (invc, intty, code); code = 0; vcep = SEARCH_VCONS_TAB (invc, vce, code); if intty = "*" then goto udsMRT; /* This vcons goes entirely away. */ if code ^= 0 then return; /* That vcons isn't there! */ /* Find the destination and delete it. */ do dest = 1 to vcons.no_of_dest; if vcons.dest (dest).dest = intty then do; do i = dest to vcons.no_of_dest - 1; if vcons.dest (i).type = 2 then call log_write_$close (vcons.dest (i).queue_seg_ptr, (0)); vcons.dest (i).dest = vcons.dest (i + 1).dest; vcons.dest (i).type = vcons.dest (i + 1).type; vcons.dest (i).queue_seg_ptr = vcons.dest (i + 1).queue_seg_ptr; end; vcons.no_of_dest = vcons.no_of_dest - 1; go to udsMRT; /* If any daemon is stuck, go wake him */ end; end; code = error_table_$ioname_not_found; /* Fell out of loop, bad tty name. */ return; udsMRT: /* Eliminate all references in the MRT */ do mrt_source = 1 to MRT.no_of_sources; if MRT.source (mrt_source).flags.valid then /* No need to look at empty entries */ do mrt_stream = 1 to MRT.source (mrt_source).no_of_streams; streamp = addr (MRT.source (mrt_source).stream (mrt_stream)); if stream.flags.valid then /* No need to look at empty entries */ do vc = 1 to stream.no_of_vcons; if stream.vcons (vc) = invc then do; /* Found a reference */ if intty = "*" then do; /* Deleting whole vcon? */ do i = vc to stream.no_of_vcons - 1; stream.vcons (i) = stream.vcons (i + 1); stream.vcons_index (i) = stream.vcons_index (i + 1); end; stream.no_of_vcons = stream.no_of_vcons - 1; end; call SHAKE_SOURCE (MRT.source (mrt_source).hismess); /* If any daemon waits this console, wake */ goto udnext; /* Assume it's not here twice */ end; end; udnext: end; end; if intty ^= "*" then return; /* Unless destroying a vcon entirely, done */ streamp = addr (MRT.star_entry.stream); do vc = 1 to stream.no_of_vcons; if stream.vcons (vc) = invc then do; do i = vc to stream.no_of_vcons - 1; stream.vcons (i) = stream.vcons (i + 1); stream.vcons_index (i) = stream.vcons_index (i + 1); end; stream.no_of_vcons = stream.no_of_vcons - 1; goto wipeout; end; end; wipeout: if code ^= 0 then return; /* this vcons isn't there. */ vcons.flags.inuse = "0"b; /* Invalidate the entry */ vcons_tab.no_of_vcons = vcons_tab.no_of_vcons - 1; return; %page; route: entry (insc, instream, invc, type, code); code = 0; insca = insc; instreama = instream; /* Find out if this virtual console is known */ vcep = SEARCH_VCONS_TAB (invc, vce, code); if code ^= 0 then if code ^= error_table_$ioname_not_found then return; else do; /* Use default virtual console */ vce = 1; vcep = addr (vcons_tab.vcons (1)); end; /* Now find place in MRT */ /* source */ call mc_util_$mrt_source (insca, mrt_source, autocode); if autocode ^= 0 then if autocode = error_table_$ioname_not_found then goto new_source; /* not already routed */ else return; /* real error */ /* stream */ call mc_util_$mrt_stream (mrt_source, instreama, streamp, mrt_stream, autocode); if autocode ^= 0 then if autocode = error_table_$ioname_not_found then goto new_stream; else return; /* See if this vcons already recieves messages from this source-stream */ do vc = 1 to stream.no_of_vcons; if stream.vcons (vc) = invc then goto refresh; end; /* Not here. */ if stream.no_of_vcons < 8 then /* Room enough for another entry. */ vc, stream.no_of_vcons = stream.no_of_vcons + 1; else do; code = error_table_$notalloc; return; end; refresh: if type = "alarm" then substr (stream.flags.alarm, vc, 1) = "1"b; /* Are these messages important? */ else substr (stream.flags.alarm, vc, 1) = "0"b; stream.vcons (vc) = vcons_tab.vcons (vce).vcons; stream.vcons_index (vc) = vce; return; new_stream: /* Create a new stream entry for this source */ if mrt_stream = 0 then /* need to allocate a new one */ if MRT.source (mrt_source).no_of_streams < 8 then /* there's room enough */ mrt_stream, MRT.source (mrt_source).no_of_streams = MRT.source (mrt_source).no_of_streams + 1; else do; /* Not room enough */ code = error_table_$notalloc; return; end; /* Successfully allocated or there was a vacant entry */ set_stream: streamp = addr (MRT.source (mrt_source).stream (mrt_stream)); stream.flags.valid = "1"b; stream.flags.active = "0"b; stream.source = insc; stream.stream = instream; stream.ourmess = mcmp; stream.hismess = MRT.source (mrt_source).hismess; stream.source_index = mrt_source; stream.stream_index = mrt_stream; vc, stream.no_of_vcons = 1; goto refresh; new_source: /* Create new source entry in MRT */ if mrt_source = 0 then /* Need to allocate a new one */ mrt_source, MRT.no_of_sources = MRT.no_of_sources + 1; /* else have a vacant one */ MRT.source (mrt_source).source = insc; MRT.source (mrt_source).hismess = null; mrt_stream, MRT.source (mrt_source).no_of_streams = 1; string (MRT.source (mrt_source).flags) = "01"b; /* Not initialized but valid */ goto set_stream; %page; reroute: entry (insc, instream, invc, param1, type, code); code = 0; call deroute (insc, instream, invc, code); if code ^= 0 then return; call route (insc, instream, param1, type, code); return; %page; deroute: entry (insc, instream, invc, code); code = 0; insca = insc; instreama = instream; call mc_util_$mrt_source (insca, mrt_source, code); if code ^= 0 then return; call mc_util_$mrt_stream (mrt_source, instreama, streamp, mrt_stream, code); if code ^= 0 then return; call SHAKE_SOURCE (MRT.source (mrt_source).hismess); do vc = 1 to stream.no_of_vcons; if stream.vcons (vc) = invc then do; do i = vc to stream.no_of_vcons - 1; stream.vcons (i) = stream.vcons (i + 1); stream.vcons_index (i) = stream.vcons_index (i + 1); end; stream.no_of_vcons = stream.no_of_vcons - 1; goto drend; end; end; code = error_table_$ioname_not_found; drend: return; %page; declare MC_atep pointer; declare Operator_name char (*); declare Ex_operator_name char (*); declare Code fixed bin (35); sign_in: entry (MC_atep, Operator_name, Ex_operator_name); mc_atep = MC_atep; Ex_operator_name = ""; if mc_ate.signed_on then Ex_operator_name = mc_ate.oper_info.personid; mc_ate.signed_on = "1"b; mc_ate.oper_info.personid = Operator_name; mc_ate.oper_info.last_input_time = clock (); return; sign_out: entry (MC_atep, Ex_operator_name, Code); call SIGN_OUT (MC_atep, Ex_operator_name, Code); return; %page; listen_to_ttys: entry (P_mpx_name); /* entry called when FNP comes up, listens to all accepted terminals on that FNP */ declare error_string char (100) aligned; mc_ansp = sc_stat_$mc_ansp; if mc_ansp = null () then return; mpx_starname = rtrim (P_mpx_name) || ".*.**"; do i = 1 to mc_anstbl.current_size; mc_atep = addr (mc_anstbl.entry (i)); if mc_ate.flags.active then do; call match_star_name_ (mc_ate.real_tty_name, mpx_starname, autocode); if autocode = 0 then do; if mc_ate.iocb ^= null () then do; if mc_anstbl.trace then call ioa_$ioa_switch (sc_stat_$master_iocb, "MC ^a listen_to_ttys: DETACHING.", mc_ate.real_tty_name); call iox_$close (mc_ate.iocb, (0)); call iox_$detach_iocb (mc_ate.iocb, (0)); call iox_$destroy_iocb (mc_ate.iocb, (0)); end; if mc_anstbl.trace then call ioa_$ioa_switch (sc_stat_$master_iocb, "MC ^a listen_to_ttys: ATTACHING.", mc_ate.real_tty_name); call ATTACH_ATE (autocode); if mc_anstbl.trace then do; if autocode = 0 then call ioa_$ioa_switch (sc_stat_$master_iocb, "MC ^a listen_to_ttys: ATTACHED", mc_ate.real_tty_name); else do; call convert_status_code_ (autocode, (8)" ", error_string); call ioa_$ioa_switch (sc_stat_$master_iocb, "MC ^a listen_to_ttys: ATTACH FAILED ^a", mc_ate.real_tty_name, error_string); end; end; end; end; end; return; %page; create_iocb: entry (P_mc_atep, code); /**** Note, if this attach fails, we will have a null sci_ptr. This will occur for tty channels if the multiplexer is not up. This routine is also called by mc_tty_ when the login server sends a DIALED_UP wakeup to our event channel. ****/ mc_ansp = sc_stat_$mc_ansp; mc_atep = P_mc_atep; iocb_name = "mc" || unique_chars_ (""b) || "." || rtrim (mc_ate.real_tty_name); call iox_$attach_name (iocb_name, mc_ate.iocb, "tty_ " || rtrim (mc_ate.real_tty_name) || " -hangup_on_detach -suppress_dial_manager", codeptr (mc_commands_), code); if code ^= 0 then return; call iox_$control (mc_ate.iocb, "set_event_channel", addr (mc_ate.event), code); /* cannot be fast */ if code ^= 0 then go to ERROR; call sc_create_sci_ (mc_ate.sci_ptr, code); if code ^= 0 then go to ERROR; mc_ate.oper_info.last_input_time = clock (); sc_subsystem_info_ptr = ssu_$get_info_ptr (mc_ate.sci_ptr); sc_subsystem_info.real_iocb = mc_ate.iocb; sc_subsystem_info.mc_atep = mc_atep; sc_subsystem_info.source_name = mc_ate.real_tty_name; sc_subsystem_info.restriction_flags = string (mc_ate.authority); sc_subsystem_info.print_ready = "1"b; /* fake a prompt */ call iox_$open (mc_ate.iocb, Stream_input_output, "0"b, code); if code ^= 0 then do; if mc_ate.flags.virtual then goto ERROR; /* Should not happen */ call iox_$control (mc_ate.iocb, "listen", null (), (0)); code = 0; end; call hcs_$wakeup (mc_anstbl.mc_procid, mc_ate.event, (0), (0)); /* cause mc_tty_ to notice the arrival. */ return; ERROR: call iox_$close (mc_ate.iocb, (0)); call iox_$detach_iocb (mc_ate.iocb, (0)); call iox_$destroy_iocb (mc_ate.iocb, (0)); if mc_ate.event ^= 0 then call ipc_$delete_ev_chn (mc_ate.event, (0)); mc_ate.iocb = null (); return; /* Internal Procedures Follow */ %page; SEND_OPERATOR_RESPONSE: procedure (P_tty_name, P_code); dcl P_tty_name char (32) unaligned; dcl P_code fixed bin (35) parameter; dcl code fixed bin (35); call FILL_RESPONSE_STRUCTURE (); ls_operator_resp.status_code = P_code; call uc_send_ls_response_ (addr (ls_operator_resp), size (ls_operator_resp), ls_process_id, ls_handle, ls_event_channel, addr (zerobits), (P_tty_name), 0, code); /* log out user and drop line */ return; end SEND_OPERATOR_RESPONSE; %page; SEND_TERMINATE_RESPONSE: procedure; unspec (ls_term_resp) = ""b; ls_term_resp.header.message_type = LS_TERMINATION_RESPONSE; ls_term_resp.header.version = LOGIN_SERVER_TERMINATION_RESPONSE_VERSION_1; ls_term_resp.process_id = mc_anstbl.mc_procid; wakeup_data_ptr = mc_atep; wakeup_data_len = size (mc_ate); ls_handle = mc_ate.ls_handle; ls_process_id = mc_ate.ls_procid; ls_event_channel = mc_ate.ls_term_ev_chn; call uc_send_ls_response_ (addr (ls_term_resp), size (ls_term_resp), ls_process_id, ls_handle, ls_event_channel, addr (zerobits), (mc_ate.real_tty_name), 0, code); /* log out user and drop line */ return; end SEND_TERMINATE_RESPONSE; %page; DROP_CDT_TERMINAL: procedure (P_mc_atep, P_tty); declare P_mc_atep pointer parameter; declare P_tty char (32) unaligned parameter; declare wakeup_msg char (8); declare bin_msg fixed bin (71) based; declare mc_tty char (32) unaligned; mc_atep = P_mc_atep; mc_tty = P_tty; /* channel name, only used in case mc_atep or mc_ate.cdtep = null */ cdtep = null (); if mc_atep = null then cdtep = FIND_CDTE (mc_tty); else if ^mc_ate.the_system_console then do; if mc_ate.cdtep = null () then cdtep = FIND_CDTE (mc_tty); else cdtep = mc_ate.cdtep; end; else do; code = 0; /* this is the booload console */ return; end; if cdtep ^= null () then do; if ^(cdte.in_use > NOW_FREE) then go to SET_NO_ENTRY; /* not ours now */ if cdte.service_type = MC_SERVICE then do /* usually an MC terminal */ cdte.in_use = NOW_HUNG_UP; cdte.current_service_type = INACTIVE; /* not now */ return; /* nothing more to do */ end; if cdte.current_service_type = MC_SERVICE then do; cdte.current_service_type = INACTIVE; call astty_$tty_event (cdtep, (0)); /* get channel back from MC now */ cdte.current_service_type = cdte.service_type; /* no longer */ cdte.dialed_to_procid = "0"b; cdte.dial_ev_chn = 0; cdte.process = null (); cdte.tra_vec = WAIT_DIALUP; cdte.in_use = NOW_DIALED; /**** Make dialup_ aware of the channel's new state. */ wakeup_msg = "device"; call hcs_$wakeup (as_data_$as_procid, cdte.event, addr (wakeup_msg) -> bin_msg, code); /**** If channel is authenticated, log it out */ if cdte.flags.access_control.slave_dial then call lg_ctl_$logout_channel (cdtep, "drop"); end; else if code ^= error_table_$ioname_not_found then code = error_table_$action_not_performed; end; else SET_NO_ENTRY: code = error_table_$noentry; /* +++ should be changed */ return; end DROP_CDT_TERMINAL; %page; DELETE_IOCB: procedure (xp); dcl xp ptr parameter; /* pointer to mc_ate entry */ if ^(xp -> mc_ate.the_system_console) & (xp -> mc_ate.iocb ^= null) & (mc_ate.cdtep ^= null) then do; call iox_$control (xp -> mc_ate.iocb, "hangup", null (), (0)); call iox_$close (xp -> mc_ate.iocb, (0)); call iox_$detach_iocb (xp -> mc_ate.iocb, (0)); call iox_$destroy_iocb (xp -> mc_ate.iocb, (0)); call ipc_$delete_ev_chn (xp -> mc_ate.event, code); end; xp -> mc_ate.iocb = null (); xp -> mc_ate.real_tty_name = ""; xp -> mc_ate.flags.pending = ""b; /**** Check to see if we have deleted the terminal used for console recovery. This routine keys on mc_ate.active to find out if it has any good consoles left. As far as console recovery goes, this terminal is no longer active; but if only the real channel of a vchannel is being dropped, the vchannel is still active. Thus the twiddling of mc_ate.active below: */ mc_ate.active = ""b; call mc_con_rec_$check (); mc_ate.active = "1"b; /**** Sign out any operator on this terminal. And destroy the SSU invocation. */ call SIGN_OUT (xp, old_operator_name, code); /**** First check for a null sci_ptr. This can happen if the multiplexer for this channel never came up. */ if xp -> mc_ate.sci_ptr ^= null () then do; if code = 0 /* only if there was an operator signed on */ then call lg_ctl_$logout_operator ( ssu_$get_info_ptr (xp -> mc_ate.sci_ptr), old_operator_name, "drop"); if ^xp -> mc_ate.the_system_console then call sc_create_sci_$destroy (xp -> mc_ate.sci_ptr); end; code = 0; return; end DELETE_IOCB; %page; KILL_TTY: procedure (xp); dcl xp ptr parameter; /* pointer to mc_ate entry */ dcl (j, jj, k) fixed bin; dcl qp ptr; if xp -> mc_ate.queue_event ^= 0 then call ipc_$delete_ev_chn (xp -> mc_ate.queue_event, (0)); if xp -> mc_ate.queue_ptr ^= null () then do; qp = xp -> mc_ate.queue_ptr; j = qp -> device_queue.top_of_queue; do jj = 1 to 10000 while (j ^= 0); k = qp -> device_queue.line (j).source; if k > 0 then call SHAKE_SOURCE (MRT.source (k).hismess); end; call hcs_$truncate_seg (qp, 0, (0)); end; xp -> mc_ate.flags.active, xp -> mc_ate.flags.vchn_requires_accept, xp -> mc_ate.flags.virtual = "0"b; /* free the mc_ate entry */ xp -> mc_ate.virtual_tty_name = ""; string (xp -> mc_ate.control) = ""b; xp -> mc_ate.flags.signed_on = ""b; xp -> mc_ate.oper_info.personid = ""; xp -> mc_ate.ls_procid = ""b; return; end KILL_TTY; %page; SEARCH_MC_ANSTBL: proc (typw, code) returns (ptr); dcl code fixed bin (35); dcl typw char (32); dcl xp ptr; dcl (i, j) fixed bin; mc_ansp = sc_stat_$mc_ansp; /* Most entrypoints call this internal proc */ /* just after entry; let this proc set */ /* mc_ansp. */ j = 0; do i = 1 to mc_anstbl.current_size; /* Search through mc_anstbl */ xp = addr (mc_anstbl.entry (i)); if xp -> mc_ate.flags.active then /* Entry in use? */ if xp -> mc_ate.virtual_tty_name = typw | xp -> mc_ate.real_tty_name = typw /* That's us! Say it, go home */ then do; code = 0; return (xp); end; else ; else if xp -> mc_ate.flags.pending /* pending & ^vchn */ then if xp -> mc_ate.real_tty_name = typw /* That's us ! */ then do; code = error_table_$ioname_not_active; return (xp); end; else ; else if j = 0 then j = i; /* An empty entry; remember first one. */ else ; end; if j = 0 then xp = null; else xp = addr (mc_anstbl.entry (j)); code = error_table_$ioname_not_found; return (xp); end SEARCH_MC_ANSTBL; %page; SEARCH_VCONS_TAB: proc (vcon, vce, code) returns (ptr); dcl code fixed bin (35); dcl vcon char (*); dcl vce fixed bin; dcl xp ptr; dcl j fixed bin; if vcon = "*" then do; vce = 0; xp = addr (vcons_tab.star_entry); code = 0; return (xp); end; j = 0; do vce = 1 to vcons_tab.no_of_vcons; xp = addr (vcons_tab.vcons (vce)); if ^(xp -> vcons.flags.inuse) then /* Empty entry? */ if j = 0 then j = vce; /* .. yes. remember first one. */ else ; else if xp -> vcons.vcons = vcon then do; code = 0; return (xp); end; end; if j = 0 then xp = null; /* Currently always happens */ else xp = addr (vcons_tab.vcons (j)); vce = j; code = error_table_$ioname_not_found; return (xp); end SEARCH_VCONS_TAB; SHAKE_SOURCE: proc (xp); dcl xp ptr; if xp = null then return; if xp -> syscon_mseg.mescount ^= 0 then do; xp -> syscon_mseg.mescount = 0; if xp -> syscon_mseg.output_wait then do; xp -> syscon_mseg.output_wait = "0"b; call hcs_$wakeup (xp -> syscon_mseg.current_process_id, xp -> syscon_mseg.ipc_el.channel, 0, code); end; end; end SHAKE_SOURCE; %page; FILL_RESPONSE_STRUCTURE: procedure (); must_send_operator_response = "1"b; unspec (ls_operator_resp) = ""b; ls_operator_resp.header.message_type = LS_OPERATOR_RESPONSE; ls_operator_resp.header.version = LOGIN_SERVER_OPERATOR_RESPONSE_VERSION_1; ls_operator_resp.status_code = 0; ls_operator_resp.process_group_id = get_group_id_ (); ls_operator_resp.process_id = mc_anstbl.mc_procid; ls_operator_resp.event_channel = mc_ate.event; ls_operator_resp.ring = get_ring_ (); wakeup_data_ptr = mc_atep; wakeup_data_len = size (mc_ate); ls_handle = mc_ate.ls_handle; ls_process_id = mc_ate.ls_procid; ls_event_channel = mc_ate.ls_resp_ev_chn; return; end FILL_RESPONSE_STRUCTURE; %page; CONNECT_PHYSICAL_CHANNEL: procedure (); on cleanup begin; call CPC_ERROR (); end; mc_ate.flags.signed_on = ^(mc_ate.oper_info.personid = ""); if mc_ate.ls_procid = ""b then do; mc_ate.real_tty_name = char32; call ipc_$create_ev_chn (mc_ate.event, code);/* system console or not */ if code ^= 0 then go to CPC_ERROR_RETURN; call ipc_$decl_ev_call_chn (mc_ate.event, mc_anstbl.cons_cont_proc, mc_atep, MC_PRIO, code); if code ^= 0 then go to CPC_ERROR_RETURN; end; if mc_ate.real_tty_name = "otw_" then do; mc_ate.flags.the_system_console = "1"b; mc_ate.iocb = sc_stat_$master_iocb; mc_ate.sci_ptr = sc_stat_$master_sci_ptr; end; else if must_send_operator_response /* network line */ then do; /* wait for connect wakeup */ mc_ate.tra_vec = MC_WAIT_DIALUP; call uc_send_ls_response_ (addr (ls_operator_resp), size (ls_operator_resp), ls_process_id, ls_handle, ls_event_channel, addr (zerobits), (mc_ate.real_tty_name), 0, code); must_send_operator_response = ""b; return; end; else do; call ATTACH_ATE (code); if code = error_table_$invalid_device /* FNP down */ then code = 0; end; if code = 0 then return; CPC_ERROR_RETURN: call CPC_ERROR (); return; CPC_ERROR: procedure (); if mc_ate.iocb ^= null () & char32 ^= "otw_" then do; call iox_$close (mc_ate.iocb, (0)); call iox_$detach_iocb (mc_ate.iocb, (0)); call iox_$destroy_iocb (mc_ate.iocb, (0)); end; mc_ate.flags.pending = ""b; if ^mc_ate.flags.virtual /* don't inactivate vchannels */ then mc_ate.flags.active = "0"b; mc_ate.real_tty_name = ""; call ipc_$delete_ev_chn (mc_ate.event, (0)); return; end CPC_ERROR; end CONNECT_PHYSICAL_CHANNEL; %page; ATTACH_ATE: procedure (code); declare code fixed bin (35); declare cdtx fixed bin; declare fnp bit (1) aligned; if mc_ate.ls_procid = ""b then do; call cdt_mgr_$find_cdt_channel (as_data_$cdtp, mc_ate.real_tty_name, cdtx, fnp, code); if code ^= 0 then return; if fnp then do; code = error_table_$ioname_not_found; return; end; cdtep = addr (as_data_$cdtp -> cdt.cdt_entry (cdtx)); mc_ate.cdtep = cdtep; if cdte.in_use = 0 | cdte.current_service_type ^= MC_SERVICE then do; code = error_table_$ioname_not_found; return; end; end; mc_ate.tra_vec = MC_WAIT_DIALUP; mc_ate.sci_ptr = null (); /* easier to check for null () */ if mc_ate.ls_procid = ""b then call create_iocb (mc_atep, code); else ; /* mc_tty_ will create the iocb for network channels when the login server sends it a DIALED_UP wakeup */ return; end ATTACH_ATE; %page; SIGN_OUT: procedure (MC_atep, Ex_operator_name, Code); /**** This procedure actually does the work of signing out an MC terminal. */ dcl MC_atep ptr parameter; dcl Ex_operator_name char (*) parameter; dcl Code fixed bin (35) parameter; mc_atep = MC_atep; Code = 0; if ^mc_ate.signed_on then Code = error_table_$action_not_performed; else do; Ex_operator_name = mc_ate.oper_info.personid; mc_ate.oper_info.personid = ""; mc_ate.signed_on = "0"b; end; return; end SIGN_OUT; %page; ABORT_DIALIN: procedure (P_ec, P_reason); dcl P_ec fixed bin (35) parameter; dcl P_reason char (*) parameter; dcl action fixed bin (17); dcl code_reason char (150) varying; dcl code_reason_al char (100) aligned; if P_ec = 0 then code_reason = P_reason; else do; call convert_status_code_ (P_ec, (""), code_reason_al); code_reason = rtrim (code_reason_al); if P_reason ^= "" then do; code_reason = code_reason || ", "; code_reason = code_reason || rtrim (P_reason); end; end; if utep ^= null () then do; action = -AS_AUDIT_CHANNEL_DIALIN; CAI.channel_name = ute.tty_name; CAI.valid = FALSE; if vchannel = "" then CAI.valid.service_info = FALSE; else CAI.valid.service_info = TRUE; if CAI.valid.service_info then do; if mc_atep ^= null then CAI.service_info = mc_ate.virtual_tty_name; else CAI.service_info = "Unknown"; end; else CAI.service_info = "system"; CAI.valid.access_class = FALSE; CAI.access_class = FALSE; CAI.valid.access_class_range = FALSE; CAI.access_class_range = access_class_range; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = iutep -> ute.initial_ring; call as_access_audit_$channel (null, utep, iutep, action, addr (CAI), (code_reason)); end; if P_ec ^= 0 then code = P_ec; /* export this error code */ else code = as_error_table_$dialnotup; /* default error message */ return; end ABORT_DIALIN; %page; DIALIN_OK: procedure (); dcl action fixed bin (17); action = AS_AUDIT_CHANNEL_DIALIN; CAI.channel_name = ute.tty_name; CAI.valid = FALSE; if vchannel = "" then CAI.valid.service_info = FALSE; else CAI.valid.service_info = TRUE; if CAI.valid.service_info then do; if mc_atep ^= null then CAI.service_info = mc_ate.virtual_tty_name; else CAI.service_info = "Unknown"; end; else CAI.service_info = "system"; CAI.valid.access_class = TRUE; CAI.access_class = FALSE; CAI.valid.access_class_range = FALSE; CAI.access_class_range = access_class_range; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = iutep -> ute.initial_ring; call as_access_audit_$channel (null, utep, iutep, action, addr (CAI), ""); end DIALIN_OK; %page; FIND_CDTE: procedure (P_tty_name) returns (ptr); dcl P_tty_name char (*) parameter; dcl cdtx fixed bin (17) automatic; dcl cdte_ptr pointer; dcl tty_name char (32); dcl fnp bit (1) aligned; tty_name = P_tty_name; call cdt_mgr_$find_cdt_channel (as_data_$cdtp, tty_name, cdtx, fnp, code); if code = 0 & ^fnp then do; cdte_ptr = addr (as_data_$cdtp -> cdt.cdt_entry (cdtx)); return (cdte_ptr); end; else return (null ()); end FIND_CDTE; %page; /* format: off */ %page; %include access_audit_bin_header; %page; %include answer_table; %page; %include as_audit_structures; %page; %include as_data_; %page; %include as_wakeup_priorities; %page; %include author_dcl; %page; %include cdt; %page; %include daemon_user_table; %page; %include device_queue; %page; %include dialup_values; %page; %include iox_entries; %page; %include iox_modes; %page; %include login_server_messages; %page; %include mc_anstbl; %page; %include mess_route_table; %page; %include sc_stat_; %page; %include sc_subsystem_info_; %page; %include sys_log_constants; %page; %include syscon_mseg; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; %include vcons_tab; %page; /* BEGIN MESSAGE DOCUMENTATION Message: mc_commands_$mc_login: error: Channel XXXX already in use. S: sc (error_output) T: $response M: The channel specified for MNA attachment is already in use by the message coordinator. A: $tryagain Message: mc_commands_$mc_login: Channel XXXX dialed to Initializer (NAME). S: as (severity 1) T: In response to a message coordinator dial request. M: Informative message indicating that a successful dialin occured on the specified channel by the named operator. A subsequent accept is required by an authenticated operator to complete the attachment. A: $ignore Message: mc_commands_$mc_login: Channel XXXX dialed to Initializer (NAME ACCEPTED). S: as (severity 1) T: In response to a message coordinator dial request. M: Informative message indicating that a successful dialin occured on the specified channel by the named operator. A: $ignore Message: mc_commands_$mc_login: Channel XXXX vchannel (YYYY) dialed to Initializer (NAME). S: as (severity 1) T: In response to a message coordinator dial request. M: Informative message indicating that a successful dialin occured on the specified channel by the named operator. A subsequent accept is required by an authenticated operator to complete the attachment. A: $ignore Message: mc_commands_$mc_login: Channel XXXX vchannel (YYYY) dialed to Initializer (NAME ACCEPTED). S: as (severity 1) T: In response to a message coordinator dial request. M: Informative message indicating that a successful dialin occured on the specified channel by the named operator. A: $ignore Message: Unable to locate a CDT entry for XXXX while attempting to drop it. S: as (severity 1) T: In response to a drop operator command. M: Notification that the CDT entry cannot be found to free it as a result of dropping the tty channel from the message coordinator. The mc_anstbl entry is freed at this point however. A: $ignore END MESSAGE DOCUMENTATION */ end mc_commands_;  mc_con_rec_.pl1 08/04/87 1456.8rew 08/04/87 1428.9 112059 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ mc_con_rec_: procedure; /* * Modification history: * 75-11-05, Larry Johnson: Modified for new syserr message format * 76-08-13, Robert Coren: Modified to check CDT entry pointer * 81-06-27, T. Casey: Changed for MR9.0 new wakeup priorities * 83-10-08, E. A. Ranzenbach: Changed for new console recovery strategy * 84-10-19, W. Olin Sibert: Temp kludge to avoid calling phcs_$syserr_logger_copy * 84-11-11, W. Olin Sibert: Moved syserr recovery responsibility into * syserr_log_man_, and added $queue_message entrypoint for that. * 84-11-16, W. Olin Sibert: Modified to handle zero wakeup from * ocdcm_ as signal to deactivate console recovery. * 1984-10-30 BIM for iox_. */ /****^ HISTORY COMMENTS: 1) change(87-02-05,GDixon), approve(87-06-12,MCR7690), audit(87-05-07,Parisek): Modified for a change to mc_anstbl.incl.pl1. 2) change(87-02-12,GDixon), approve(87-06-12,MCR7690), audit(87-05-07,Parisek): Correct reference through unset pointer (often null pointer) when mc_con_rec_$output calls QUEUE_MESSAGE. (phx20767) END HISTORY COMMENTS */ /* This procedure is part of the message coordinator. * It performs those functions necessary for operator console * recovery. It contains the following entries: * * init: initializes internal static variables * check: checks to see whether or not the recovery mechanism * should be enabled or disabled * output: outputs console traffic. * * Note that the console recovery mechanism has two states: * enabled: there is a tty type device available for use by the * console recovery mechanism - ocdcm_ has an event * channel that it can use for console recovery * disabled: there are mo MC devices available for recovery. * * The "active" bit controls whether console recovery is to be * used; it depends on the values of the wakeups received by * mc_con_rec_$output: a zero value deactivates console recovery, * and a non-zero value activates it. The active/inactive state * controls whether syserr messages are recovered; non-zero * wakeups will only arrive when the console is inoperable, so * that the first such wakeup, in effect, turns the mechanism on. */ /* PARAMETER DATA */ declare arg_mc_ansp pointer parameter; /* (I) Ptr to message coordinator answer table. */ declare arg_io_uid fixed bin (71) parameter; /* (I) ID of message */ declare arg_log_message_ptr pointer parameter; /* (I) Pointer to log message to be queued */ declare arg_alarm_flag bit (1) aligned parameter; /* (I) Whether to beep */ /* AUTOMATIC DATA */ dcl error_code fixed bin (35), /* Standard system error code. */ i fixed bin, /* Work index. */ inzr_text_length fixed bin, /* length returned by ocdcm_... */ inzr_text char (256), /* text returned by ocdcm_... */ qp ptr, /* Pointer to device queue. */ io_uid fixed bin (71); /* identifier of message to retrieve */ /* EXTERNAL ENTRIES */ dcl (addr, length, substr, byte, max) builtin; dcl date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) varying), hphcs_$ocdcm_err_event_chan entry (fixed bin (71)), hphcs_$ocdcm_get_mc_output entry (fixed bin (71), fixed bin (17), char (256)), ioa_$rsnnl entry options (variable), ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)), ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35)), ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)), mc_util_$queue entry (ptr, bit (1), ptr, fixed bin, fixed bin, fixed bin (35)), mc_wakeups_$con_rec entry options (variable), syserr_log_man_$console_recovery entry (bit (1) aligned, fixed bin (35)); /* */ mc_con_rec_$init: entry (arg_mc_ansp); /* This entry is called by mc_util_$init. It will copy its two * arguments into internal static storage. It also turns OFF * the console recovery enabled flag. */ arg_mc_ansp -> mc_anstbl.con_rec.flags.enabled = "0"b; return; check: entry; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This entry is called whenever a tty type device is added or */ /* deleted from the message coordinator answer table. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ mc_ansp = sc_stat_$mc_ansp; if mc_anstbl.con_rec.flags.enabled /* Do we already have a device/ */ then do; /* Yes, make sure we still have it. */ mc_atep = mc_anstbl.con_rec.mc_ate_ptr; if mc_ate.active /* Is device entry still active? */ then if mc_ate.tra_vec > MC_WAIT_ANSWERBACK then return; /* Yes, we are still enabled. */ end; /* We do not have a tty type device to use for recovery. We will look * through the list of devices asigned to the message coordinator to see * if there is one that we can use. */ do i = 1 to mc_anstbl.current_size; mc_atep = addr (mc_anstbl.entry (i)); /* Get pointer to device entry. */ if ^mc_ate.the_system_console & mc_ate.active /* mess. coord. now owns it ... */ & mc_ate.tra_vec > MC_WAIT_ANSWERBACK then do; /* then we can use it for recovery. */ call ENABLE; /* Enable console recovery. */ return; end; end; /* We could not find a device to use for recovery. If recovery had been * enabled, we must turn it OFF. */ if mc_anstbl.con_rec.flags.enabled then call DISABLE; return; /* */ mc_con_rec_$output: entry (arg_io_uid); /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This entry is called by mc_wakeups$con_rec when that procedure receives a wakeup. This wakeup */ /* indicates that the operator's console software is unable to perform an output and has asked us */ /* to handle the output in its behalf. The io_uid will contain one of the following: */ /* */ /* A positive value which is the syserr sequence number of a syserr message for display. */ /* In this case we will extract the syserr message from the log and print it. */ /* */ /* A negative value which is a UID of the message in oc_data. For these we will call */ /* ocdcm_$get_mc_output to extract the message for printing. */ /* */ /* A zero, indicating that the console works again and that console recovery is */ /* to be deactivated. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ mc_ansp = sc_stat_$mc_ansp; io_uid = arg_io_uid; mc_atep = mc_anstbl.con_rec.mc_ate_ptr; /* -> device entry to write to... */ qp = mc_ate.queue_ptr; /* -> device's queue segment... */ if (io_uid = 0) then do; /* Console working again */ if ^mc_anstbl.con_rec.flags.active then /* It wasn't active, so ignore the wakeup */ return; call syserr_log_man_$console_recovery ("0"b, 0); /* Otherwise, deactivate it */ mc_anstbl.con_rec.flags.active = "0"b; return; end; if ^mc_anstbl.con_rec.flags.active then do; /* This is a non-zero (activating) wakeup, */ call syserr_log_man_$console_recovery ("1"b, max (0, io_uid)); /* so we activate the mechanism, giving the */ /* number of the first message to be recovered, */ mc_anstbl.con_rec.flags.active = "1"b; /* and turn on the flag (but only the first */ end; /* time, until we get the deactivate wakeup */ if (io_uid > 0) then /* This is a syserr message, so we let */ return; /* our counterpart in syserr_log_man_ get it. */ if ^as_data_$debug_flag then call hphcs_$ocdcm_get_mc_output (io_uid, inzr_text_length, inzr_text); call QUEUE_MESSAGE ("INZR", (-io_uid), 0, "0"b, addr (inzr_text), (inzr_text_length)); return; /* */ mc_con_rec_$queue_log_message: entry (arg_log_message_ptr, arg_alarm_flag); /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This entrypoint is called by syserr_log_man_ to queue a syserr message */ /* into the console recovery mechanism. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ mc_ansp = sc_stat_$mc_ansp; log_message_ptr = arg_log_message_ptr; mc_atep = mc_anstbl.con_rec.mc_ate_ptr; /* -> device entry to write to... */ qp = mc_ate.queue_ptr; /* -> device's queue segment... */ call QUEUE_MESSAGE ("HARD", (log_message.time), (log_message.sequence), arg_alarm_flag, addr (log_message.text), length (log_message.text)); return; /* */ ENABLE: procedure; /* This internal procedure is called to enable the console recovery * mechanism. We must give ocdcm_ an event channel that it can use * to signal that it wants console recovery. We will also initialize * the data that must be kept in the mc_anstbl. */ mc_anstbl.con_rec.mc_ate_ptr = mc_atep; /* Save pointer to recovery device entry. */ if mc_anstbl.con_rec.enabled /* Are we already enabled? */ then return; /* Yes. */ call ipc_$create_ev_chn (mc_anstbl.con_rec.ec_id, error_code); if error_code ^= 0 then return; call ipc_$decl_ev_call_chn (mc_anstbl.con_rec.ec_id, mc_wakeups_$con_rec, mc_ansp, MC_PRIO, error_code); if error_code ^= 0 then return; if ^as_data_$debug_flag then call hphcs_$ocdcm_err_event_chan (mc_anstbl.con_rec.ec_id); mc_anstbl.con_rec.flags.active = "0"b; /* Initialize con_rec flags. */ mc_anstbl.con_rec.flags.enabled = "1"b; end ENABLE; /* */ DISABLE: procedure; /* This internal procedure is called when we must disable the console * recovery mechanism. We must tell ocdcm_ that it can no longer use * the event channel that it was previously given. */ mc_anstbl.con_rec.flags.enabled = "0"b; /* Now all wakeups will be ignored. */ if ^as_data_$debug_flag then call hphcs_$ocdcm_err_event_chan (0); /* Take event channel away. */ call ipc_$delete_ev_chn (mc_anstbl.con_rec.ec_id, (0)); end DISABLE; /* */ QUEUE_MESSAGE: procedure (P_msg_type, P_msg_time, P_msg_sequence, P_alarm_flag, P_msg_ptr, P_msg_lth); declare P_msg_type char (4) parameter; declare P_msg_time fixed bin (71) parameter; declare P_msg_sequence fixed bin (35) parameter; declare P_alarm_flag bit (1) aligned parameter; declare P_msg_ptr pointer parameter; declare P_msg_lth fixed bin (18) parameter; declare P_msg char (P_msg_lth) based (P_msg_ptr); declare output_buffer char (256); declare out_buf_len fixed bin (18); /* * This internal procedure is called to queue a message for output * over the assigned console recovery tty type terminal. It creates * a printable representation of the message, including the time, * sequence number (if any), and text, adding a newline if one is * not present at the end of the message already. */ call ioa_$rsnnl ("^x^a^2x^4a ^[#^d^;^s^] ^a^[^/^]", output_buffer, out_buf_len, date_time_$format ("^Hd^99.9MH", P_msg_time, "", ""), P_msg_type, (P_msg_sequence ^= 0), P_msg_sequence, P_msg, (substr (P_msg, length (P_msg), 1) ^= byte (10))); call mc_util_$queue (qp, (P_alarm_flag), addr (output_buffer), (out_buf_len), 0, error_code); return; end QUEUE_MESSAGE; /* format: off */ %page; %include as_data_; %page; %include as_wakeup_priorities; %page; %include mc_anstbl; %page; %include log_message; %page; %include sc_stat_; end mc_con_rec_;  mc_list.pl1 02/07/85 0954.7r w 02/06/85 1403.7 43038 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ mc_list: proc; /* MC_LIST - produce a set of define and route commands from current tables. Written by THVV Modified 750213 by PG to be able to print test_udd tables */ dcl (path, dn) char (168) aligned, en char (32) aligned, srch (10) char (32) aligned, (i, j, k, l, m, n) fixed bin, write fixed bin init (0), ap ptr, al fixed bin, bchr char (al) unaligned based (ap), ec fixed bin (35); dcl (addr, index, null, search, substr) builtin; dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)), ioa_ entry options (variable), com_err_ entry options (variable); dcl hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), ptr, fixed bin (35)), hcs_$terminate_noname entry (ptr, fixed bin (35)); %include vcons_tab; %include mess_route_table; dcl mrtp ptr; dcl streamp ptr; dcl vconsp ptr; dcl vcep ptr; dcl typer (3) char (4) aligned int static init ("tty", "log", "sink"); /* ------------------------------------------------------- */ m = 0; l = 0; k = 1; path = ">system_control_1"; arglp: call cu_$arg_ptr (k, ap, al, ec); if ec ^= 0 then go to vct1; if search (bchr, "<>") ^= 0 /* is it a pathname? */ then path = bchr; else do; m = m + 1; /* it's a keyword to search for */ if m > 10 then go to vct1; if bchr = "*" then l = m; srch (m) = bchr; end; k = k + 1; go to arglp; vct1: i = index (path, " "); if i = 0 then i = length (path); call expand_path_ (addr (path), i, addr (dn), null, ec); if ec ^= 0 then do; call com_err_ (ec, "mc_list", "^a", path); return; end; en = "vcons_tab"; call hcs_$initiate (dn, en, "", 0, 1, vconsp, ec); if vconsp = null then do; er: call com_err_ (ec, "mc_list", "^a>^a", dn, en); return; end; call pvcons ("*", addr (vcons_tab.star_entry)); do i = 1 to vcons_tab.no_of_vcons; if ^vcons_tab.vcons (i).flags.inuse then go to skip; call pvcons (vcons_tab.vcons (i).vcons, addr (vcons_tab.vcons (i))); skip: end; call hcs_$terminate_noname (vconsp, ec); /* --------------- */ en = "MRT"; call hcs_$initiate (dn, en, "", 0, 1, mrtp, ec); if mrtp = null then go to er; call pstream ("*", addr (MRT.star_entry.stream)); do i = 1 to MRT.no_of_sources; if ^MRT.source (i).flags.valid then go to sskip; do j = 1 to MRT.source (i).no_of_streams; if MRT.source (i).stream (j).flags.valid then call pstream (MRT.source (i).source, addr (MRT.source (i).stream (j))); end; sskip: end; call hcs_$terminate_noname (mrtp, ec); if write = 0 then call ioa_ ("none"); return; /* ------------------------------------------------------- */ pstream: proc (id, sp); dcl id char (*) aligned, sp ptr; dcl k fixed bin, vstr char (64) varying, vconst char (32) aligned, sourcet char (32) aligned; streamp = sp; if substr (stream.source, 1, 1) < " " then sourcet = "*"; else sourcet = stream.source; do k = 1 to stream.no_of_vcons; if substr (stream.flags.alarm, k, 1) then vconst = "*" || stream.vcons (k); else vconst = stream.vcons (k); /* Star means alarm flag will be in message */ do n = 1 to m; if id = srch (n) then go to pvv1; end; do n = 1 to m; if stream.stream = srch (n) then go to pvv1; end; do n = 1 to m; if stream.vcons (k) = srch (n) then go to pvv1; end; if m ^= 0 then go to pvv2; pvv1: call ioa_ ("route ^a ^a ^a", id, stream.stream, vconst); write = write + 1; pvv2: end; end pstream; pvcons: proc (id, sp); dcl id char (*) aligned, sp ptr; dcl k fixed bin, temptype char (8) aligned; vcep = sp; do k = 1 to vcons.no_of_dest; temptype = typer (vcons.dest (k).type); do n = 1 to m; if id = srch (n) then go to pvv3; end; do n = 1 to m; if vcons.dest (k).dest = srch (n) then go to pvv3; end; do n = 1 to m; if temptype = srch (n) then go to pvv3; end; if m ^= 0 then go to pvv4; pvv3: call ioa_ ("define ^a ^a ^a", id, temptype, vcons.dest (k).dest); write = write + 1; pvv4: end; end pvcons; end mc_list;  mc_quiesce_.pl1 08/04/87 1456.8rew 08/04/87 1429.3 36558 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style4 */ mc_quiesce_: proc; /* Just a little something to wait until all message coordinator terminals are done. */ /* 82-10-28 Written E. N. Kittlitz. */ /* Modified 1984-10-29 BIM for iox_ */ /****^ HISTORY COMMENTS: 1) change(86-07-01,Swenson), approve(87-06-12,MCR7690), audit(87-05-07,Parisek): Added support for test system control; no hanging up of process' login channel. 2) change(87-02-05,GDixon), approve(87-06-12,MCR7690), audit(87-05-07,Parisek): Modified for change to mc_anstbl.incl.pl1. END HISTORY COMMENTS */ dcl atex fixed bin; dcl code fixed bin (35); dcl have_queued_output bit (1) aligned; dcl qp ptr; dcl quiesce_tries fixed bin; dcl 1 write_status_info aligned, 2 evchn fixed bin (71), 2 output_pending bit (1); dcl ME char (12) static init ("mc_quiesce_") options (constant); dcl (addr, null) builtin; dcl error_table_$out_of_sequence fixed bin (35) ext static; dcl get_process_id_ entry () returns (bit (36)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl mc_wakeups_$set_shutdown_limits entry; dcl phcs_$ring_0_message entry (char (*) aligned); dcl sub_err_ entry () options (variable); dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); mc_ansp = sc_stat_$mc_ansp; if ^sc_stat_$mc_is_on | get_process_id_ () ^= mc_anstbl.mc_procid then call sub_err_ (error_table_$out_of_sequence, ME, ACTION_CANT_RESTART); call mc_wakeups_$set_shutdown_limits; have_queued_output = "1"b; do quiesce_tries = 1 to 10 while (have_queued_output); have_queued_output = "0"b; do atex = 1 to mc_anstbl.current_size; mc_atep = addr (mc_anstbl.entry (atex)); qp = mc_ate.queue_ptr; if mc_ate.active & /* shall we even LOOK at this entry? */ mc_ate.tra_vec > MC_WAIT_ANSWERBACK & qp ^= null then do; /* really has a queue segment */ if device_queue.no_of_messages > 0 then do; have_queued_output = "1"b; /* have something that can reasonably be done */ call hcs_$wakeup (mc_anstbl.mc_procid, device_queue.channel, 0, (0)); call timer_manager_$sleep (1, "10"b); /* 1 micro-second */ end; end; /* active mc_ate */ end; /* for each entry in the answer table */ end; /* try it a bunch of times */ if have_queued_output then /* still stuff left over */ call phcs_$ring_0_message ("mc_quiesce_: Unable to quiesce message coordinator. Some queued messages will be lost."); /* now wait for ttys to stop chattering */ have_queued_output = "1"b; do quiesce_tries = 1 to 60 while (have_queued_output); /* try for up to one minute */ have_queued_output = "0"b; do atex = 1 to mc_anstbl.current_size; mc_atep = addr (mc_anstbl.entry (atex)); call iox_$control (mc_ate.iocb, "write_status", addr (write_status_info), code); if code ^= 0 | ^write_status_info.output_pending then do; call iox_$control (mc_ate.iocb, "hangup", null (), (0)); mc_ate.tra_vec = -1; end; else have_queued_output = "1"b; /* STILL more */ end; /* tty to check */ call timer_manager_$sleep (1, "11"b); /* sleep 1 second */ end; /* try for 1 minute */ if have_queued_output then call phcs_$ring_0_message ("mc_quiesce_: some terminals still have output in progress. They will be hungup."); return; %page; %include device_queue; %page; %include mc_anstbl; %page; %include sc_stat_; %page; %include sub_err_flags; %include iox_entries; end mc_quiesce_;  mc_tty_.pl1 07/20/88 1251.1r w 07/19/88 1536.0 334935 /****^ *********************************************************** * * * 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: style2 */ mc_tty_: proc (Event_call_info_ptr); /* MC_TTY_ - This program is invoked by ipc_ event call when the hardcore sends a device wakeup for a typewriter channel. Alarm timers may also go off for a channel. The hardcore wakeup may mean that a channel which was writing and encountered lack of output buffer space may now proceed again; or it may indicate a read completion; or a hangup. When a read completion arrives, this program attempts to copy the data read from the hardcore. If the operator inputs just an empty line, we inhibit output on the channel for 3 minutes and wait to read his command. Once we have read a command line, we parse it, and execute it. Dennis Capps & Tom Van Vleck */ /* revised for MCS by Grady 4/28/75 modified by Robert Coren in August 1976 to use CDT entry modified by Robert Coren in June 1977 to use ttt_info_ for terminal-type stuff Modified June 1981 by T. Casey for MR9.0 to add metering. Modified October 1982 by E. N. Kittlitz to not squawk during shutdown. Modified 1984-10-29 BIM for iox_. Modified 1984-12-11, BIM: put OPER: back in. Modified 1985-01-21, BIM: mc_con_rec_$check when a terminal is dialed up. Modified 1985-04-01, E. Swenson: to cause sign_out on hangup. Modified 1985-05-14, E. Swenson to remove mc terminals from service upon hangup if terminal was dialed to the Initializer. */ /****^ HISTORY COMMENTS: 1) change(86-03-25,MSharpe), approve(87-07-09,MCR7690), audit(87-07-30,Parisek), install(87-08-04,MR12.1-1055): Modified to work with (DSA) network channels; to drop channel if it can't connect it; to always trace (temporary). 2) 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. 3) change(86-06-26,Cox), approve(87-07-09,MCR7690), audit(87-07-30,Parisek), install(87-08-04,MR12.1-1055): Modified to not read answerback for network channels. Removed trace calls to sys_log_. 4) change(86-12-08,Brunelle), approve(87-07-09,MCR7690), audit(87-07-30,Parisek), install(87-08-04,MR12.1-1055): Modified to work with (DSA) network channels; to drop channel if it can't connect it !!;to always trace (temporary). (Changes actually made by MSharpe on 86-03-25) 5) change(87-02-05,GDixon), approve(87-07-09,MCR7690), audit(87-07-30,Parisek), install(87-08-04,MR12.1-1055): Modified for change to mc_anstbl.incl.pl1. 6) change(87-05-11,Parisek), approve(87-07-09,MCR7690), audit(87-07-31,Beattie), install(87-08-04,MR12.1-1055): Check cdte.current_terminal_type before filling the set_term_type_info structure for the set_term_type order call. 7) change(87-06-08,Parisek), approve(87-07-09,MCR7690), audit(87-07-31,Beattie), install(87-08-04,MR12.1-1055): Removed instances of sys_log_ calling when mc_ate.cdtep = null. END HISTORY COMMENTS */ /* Parameters */ declare Event_call_info_ptr pointer parameter; /* Automatic */ declare code fixed bin (35); declare errmsg char (200); declare input_buffer char (1000); declare line_status_space bit (72) aligned; declare length_read_in fixed bin (21); declare ls_wakeup bit (1); dcl message char (8); dcl old_operator_name char (32); declare p1 pointer; declare perm_mc_service bit (1); declare read_answerback bit (1); declare 1 STTI aligned like set_term_type_info; declare 1 TI aligned like terminal_info; declare tty_state fixed bin; declare type_to_set char (32); declare wakeup_event fixed bin; /* Based */ dcl fixed_bin_71 fixed bin (71) based; /* overlay for message */ dcl signal_type char (8) based; /* char overlay for ipc_ message */ /* Entries */ dcl astty_$tty_event entry (ptr, fixed bin (35)); dcl lg_ctl_$logout_channel entry (ptr, char (*)); dcl mc_commands_$remove_tty entry (char (*), bit (1) aligned, fixed bin (35)); dcl mc_con_rec_$check entry; dcl ( hphcs_$syserr, hphcs_$syserr_error_code ) entry options (variable); dcl hcs_$wakeup entry (bit (*) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); declare ioa_$rs entry options (variable); declare ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); declare lg_ctl_$logout_operator entry (ptr, char (*), char (*)); declare mc_commands_$sign_out entry (ptr, char (*), fixed bin (35)); declare mc_commands_$create_iocb entry (ptr, fixed bin (35)); declare timed_io_$get_chars entry (pointer, fixed binary (71), pointer, fixed binary (21), fixed binary (21), fixed binary (35)); declare timed_io_$get_line entry (pointer, fixed binary (71), pointer, fixed binary (21), fixed binary (21), fixed binary (35)); declare timed_io_$put_chars entry (pointer, fixed binary (71), pointer, fixed binary (21), fixed binary (21), fixed binary (35)); declare ttt_info_$default_term_type entry (fixed binary, fixed binary, character (*), fixed binary (35)); dcl ttt_info_$decode_answerback entry (char (*), fixed bin, char (*), char (*), fixed bin (35)); dcl multiplexer_mgr_$state_mpx entry (char (*), fixed bin, fixed bin (35)); declare sc_process_command_line_ entry (pointer, pointer, fixed binary (21)); declare ssu_$abort_line entry () options (variable); declare ssu_$get_info_ptr entry (pointer) returns (pointer); dcl ( as_$meter_enter, as_$meter_exit ) entry (fixed bin); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); dcl timer_manager_$alarm_wakeup entry (fixed binary (71), bit (2), fixed binary (71)); dcl timer_manager_$reset_alarm_wakeup entry (fixed binary (71)); /* External */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$line_status_pending fixed bin (35) ext static; dcl error_table_$timeout fixed bin (35) ext static; dcl error_table_$io_no_permission fixed bin (35) ext static; dcl error_table_$undefined_order_request fixed bin (35) ext static; /* Builtins */ dcl (null, addr, baseno, index, length, reverse, rtrim, substr, unspec, verify) builtin; /* Constant */ dcl ME char (32) initial ("mc_tty_") internal static options (constant); declare WHITESPACE char (7) init ("  ") /* SP TAB BS VT NL CR FF */ int static options (constant); dcl ( UNSPECIFIED_EVENT initial (0), DIALUP_EVENT initial (1), HANGUP_EVENT initial (2), QUIT_EVENT initial (3), INPUT_AVAILABLE_EVENT initial (4), OUTPUT_SPACE_AVAILABLE_EVENT initial (5), LINE_STATUS_EVENT initial (6), MASKED_EVENT initial (7) ) fixed bin internal static options (constant); dcl EVENT_TO_PNAME (-1:7) char (22) internal static options (constant) init ("invalid", /* -1 */ "unspecified", /* 0 */ "dialup", /* 1 */ "hangup", /* 2 */ "quit", /* 3 */ "input available", /* 4 */ "output space available", /* 5 */ "line status", /* 6 */ "masked"); /* 7 */ %page; /* Program */ call as_$meter_enter (MSGCORD_METER); /* meter cpu time and paging used by this procedure */ mc_ansp = sc_stat_$mc_ansp; if Event_call_info_ptr = null then call errx ("called with null ptr"); event_call_info_ptr = Event_call_info_ptr; mc_atep = event_call_info.data_ptr; /* Pointer to mcanstbl entry */ cdtep = mc_ate.cdtep; /* Pointer to CDT entry */ p1 = addr (event_call_info.message); /* What kind of signal */ if sc_stat_$mc_ansp = null then call errx ("sc_stat_$mc_ansp is null"); if baseno (mc_atep) ^= baseno (sc_stat_$mc_ansp) then call errx ("called with bad pointer"); wakeup_event = -1; /* not set yet */ errmsg = ""; /* init */ if event_call_info.sender = mc_anstbl.mc_procid then do; if p1 -> signal_type = "alarm___" then do; /* Timeout? */ if mc_ate.iocb = null () then do; call hphcs_$syserr (ANNOUNCE, "^a: Channel ^a ^[(vchannel ^a)^;^s^] received TIMEOUT while awaiting DIALUP wakeup.", ME, mc_ate.real_tty_name, mc_ate.flags.virtual, mc_ate.virtual_tty_name); goto ttydone; end; mc_ate.control.inhibit = "0"b;/* Operator didn't type his command in time. */ mc_ate.tra_vec = MC_WAIT_READY; /* Set state back to "not waiting" */ call iox_$control (mc_ate.iocb, "start", null (), (0)); /* In case of lost wakeup, honk on ring 0 */ go to READ_COMMAND; end; end; else if event_call_info.origin.ring > mc_anstbl.dsa_ring_number then /* Else didn't signal ourself */ if event_call_info.sender = mc_ate.ls_procid then do; /* wakeup from login server, not hardcore */ ls_wakeup = "1"b; dial_event_message_ptr = addr (event_call_info.message); if dial_event_message.control = JUST_DIALED then wakeup_event = DIALUP_EVENT; /* deal with incompatible message formats */ else wakeup_event = HANGUP_EVENT; end; else do; call ioa_$rs ("Event sent from incorrect ring. ^/event channel = ^d, event message = ^d, event sender = ^b, device signal = ^b^/, ring = ^d, event data ptr = ^p", errmsg, (0), event_call_info.channel_id, event_call_info.message, event_call_info.sender, event_call_info.dev_signal, event_call_info.ring, event_call_info.data_ptr); call errx (errmsg); /* .. ignore unless from ring 0 or 1 */ end; net_event_message_arg = event_call_info.message; /* Overlayed on net_event_message. */ /**** Here, wakeup_event is non-zero IFF we received a wakeup from the login server telling us that a MC channel dialed up or hung up. Otherwise, the event message contains a type-code which, combined with the network type, determines what kind of wakeup we must process. */ if wakeup_event = -1 then /* not set already */ wakeup_event = decode_event_type (net_event_message.network_type, net_event_message.type); if mc_anstbl.trace then call sys_log_ (SL_LOG_SILENT, "^a: ^a state wait ^[-1(MASKED)^;ZERO^;wait_dialup^;wait_answerback^;wait_ready^;wait_command^] message ^a.", ME, mc_ate.real_tty_name, mc_ate.tra_vec + 2, /* -1 -> 1 */ EVENT_TO_PNAME (wakeup_event)); if wakeup_event = -1 /* i.e. a bad event type, already logged */ then goto ttydone; if mc_ate.tra_vec = -1 then go to ttydone; /* masked, whatever */ tty_state = 0; if mc_ate.iocb = null () then if wakeup_event = DIALUP_EVENT & mc_ate.tra_vec = MC_WAIT_DIALUP then do; code = 0; call mc_commands_$create_iocb (mc_atep, code); if code ^= 0 then do; call hphcs_$syserr_error_code (ANNOUNCE, code, "^a: Connecting to ^a^[ (vchannel ^a)^;^s^].", ME, mc_ate.real_tty_name, mc_ate.flags.virtual, mc_ate.virtual_tty_name); call mc_commands_$remove_tty ((mc_ate.real_tty_name), "1"b, code); goto ttydone; end; end; else do; call hphcs_$syserr (ANNOUNCE, "^a: Channel ^a^[ (vchannel ^a)^;^s^] received ^a wakeup while awaiting DIALUP.", ME, mc_ate.real_tty_name, mc_ate.flags.virtual, mc_ate.virtual_tty_name, EVENT_TO_PNAME (wakeup_event)); goto ttydone; end; call iox_$control (mc_ate.iocb, "state", addr (tty_state), code); if tty_state ^= TTY_STATE_DIALED_UP then if wakeup_event ^= HANGUP_EVENT & wakeup_event ^= MASKED_EVENT then wakeup_event = HANGUP_EVENT; /* treat it as a hangup */ if wakeup_event = QUIT_EVENT then if sc_stat_$admin_sci_ptr = mc_ate.sci_ptr & mc_ate.sci_ptr ^= null () then do; mc_ate.control.inhibit = "0"b; /* Allow output to come out. */ call hcs_$wakeup (mc_anstbl.mc_procid, mc_ate.queue_event, 0, code); call as_$meter_exit (MSGCORD_METER); /* turn off metering before returning */ call ssu_$abort_line (mc_ate.sci_ptr, 0, "BREAK key aborted command execution."); end; if wakeup_event = HANGUP_EVENT | wakeup_event = MASKED_EVENT /* line hung up */ then do; if wakeup_event = MASKED_EVENT then call hphcs_$syserr (BEEP, "^a: channel ^a masked by FNP.", ME, mc_ate.real_tty_name); else if mc_ate.tra_vec < MC_WAIT_READY /* only tattle once */ then do; /* so quietly go back to listening */ mc_ate.tra_vec = MC_WAIT_DIALUP; if cdtep ^= null then call listen_if_mpx_up (); go to ttydone; end; go to tty_hung; /* report it */ end; else if wakeup_event = OUTPUT_SPACE_AVAILABLE_EVENT /* output done, rather than input arrived */ then go to check_ow; /* see if we have more */ else if wakeup_event = LINE_STATUS_EVENT then call FLUSH_LINE_STATUS; if mc_ate.tra_vec = MC_WAIT_DIALUP then do; /* whatever it said, we see if we are alive */ call iox_$control (mc_ate.iocb, "state", addr (tty_state), code); if code ^= 0 | tty_state < TTY_STATE_DIALED_UP then do; if cdtep ^= null () then call listen_if_mpx_up; go to ttydone; end; mc_ate.control.inhibit = "1"b; /* .. yes. Inhibit output. */ call SET_TERM_TYPE (""); /* set the default terminal type */ if cdtep = null () /* DSA channel */ then read_answerback = "0"b; /* DSA doesn't support answerback */ else read_answerback = ^cdte.flags.dont_read_answerback; if read_answerback then do; call iox_$control (mc_ate.iocb, "resetread", null (), (0)); call ipc_$drain_chn (mc_ate.event, (0)); /* don't get fooled */ call iox_$control (mc_ate.iocb, "wru", null (), code); if code = error_table_$undefined_order_request then goto SKIP_ANSWERBACK; if code ^= 0 then do; call hphcs_$syserr_error_code (ANNOUNCE, code, "^a: wru failed for ^a.", ME, mc_ate.real_tty_name); go to tty_err; end; mc_ate.tra_vec = MC_WAIT_ANSWERBACK; goto ttydone; /* come back later */ end; else do; SKIP_ANSWERBACK: mc_ate.tra_vec = MC_WAIT_READY; call GREET; call mc_con_rec_$check; end; end; /* end DIALUP message processing */ else if mc_ate.tra_vec = MC_WAIT_ANSWERBACK then do; mc_ate.tra_vec = MC_WAIT_READY; call get_chars (0); /* no timeout tolerance */ if length_read_in > 0 then do; if mc_anstbl.trace then call sys_log_ (SL_LOG_SILENT, "^a: ^a WRU response ^a", ME, mc_ate.real_tty_name, substr (input_buffer, 1, length_read_in)); type_to_set = ""; if mc_ate.iocb = null () then do; unspec (TI) = ""b; TI.version = terminal_info_version; call iox_$control (mc_ate.iocb, "terminal_info", addr (TI), code); if code ^= 0 then do; call ttt_info_$decode_answerback ( substr (input_buffer, 1, length_read_in), (cdte.line_type), type_to_set, (""), code); /* ignore code, we will leave the initial terminal type if we have to */ end; end; end; else type_to_set = ""; /* default */ call SET_TERM_TYPE (type_to_set); call iox_$control (mc_ate.iocb, "resetread", null (), (0)); call GREET; call mc_con_rec_$check; end; /**** Arriving here, the terminal is dialed up, we were not trying to get rid of output. So we look for input. */ READ_COMMAND: do while ("1"b); call get_line (0); if length_read_in = 0 then go to check_ow; /* If nothing read, done. */ if verify (substr (input_buffer, 1, length_read_in), WHITESPACE) = 0 /* Its all whitespace */ then do; if mc_ate.control.inhibit /* toggle off */ then do; call timer_manager_$reset_alarm_wakeup (mc_ate.event); mc_ate.control.inhibit = "0"b; end; else do; mc_ate.control.inhibit = "1"b; /* Don't interrupt operator for a while. */ call timer_manager_$alarm_wakeup (30, "11"b, mc_ate.event); /* 30 seconds of peace and quiet */ call write ("OPER: "); end; end; else do; /* just execute the command, bud. */ mc_ate.control.inhibit = "1"b; /* Don't interrupt operator for a while. */ call sc_process_command_line_ (mc_ate.sci_ptr, addr (input_buffer), length_read_in); mc_ate.control.inhibit = "0"b; /* Allow output. */ end; end; /* Try to read more */ /* -------------------------------------------------------- */ /* Come here when tty appears to be hung up */ tty_hung: if sc_stat_$shutdown_typed then do; /* if shutting down */ call sys_log_ (SL_LOG_SILENT, "^a: Line ^a hung up.", ME, mc_ate.real_tty_name); mc_ate.tra_vec = -1; go to stim; /* kick outputter */ end; else if mc_ate.tra_vec >= MC_WAIT_READY then call hphcs_$syserr (BEEP, "^a: channel ^a hung up.", ME, mc_ate.real_tty_name); /**** If the channel is normally designated as MC service (as opposed to being "dial system"'ed), then we listen for another dialup on this channel wherepon we will continue message coordinator service. If, however, the channel is a network connection or an MCS channel in temporary MC service, then we remove it from MC service and give it back to the answering service. */ if cdtep = null () then perm_mc_service = ""b; else perm_mc_service = (cdte.service_type = MC_SERVICE); if ^perm_mc_service then do; /* remove from MC service */ call mc_commands_$remove_tty ((mc_ate.real_tty_name), ""b, code); if code ^= 0 then call hphcs_$syserr_error_code (ANNOUNCE, code, "^a: Could not remove ^a from MC use.", ME, mc_ate.real_tty_name); if cdtep ^= null then do; call astty_$tty_event (cdtep, code); if code ^= 0 then call hphcs_$syserr_error_code (ANNOUNCE, code, "^a: Could not get channel ^a back from MC.", ME, cdte.name); cdte.current_service_type = cdte.service_type; cdte.dialed_to_procid = ""b; cdte.dial_ev_chn = 0; cdte.process = null (); cdte.tra_vec = WAIT_GREETING_MSG; cdte.in_use = NOW_HUNG_UP; if cdte.flags.access_control.slave_dial then call lg_ctl_$logout_channel (cdtep, "mc hangup"); message = "device"; call hcs_$wakeup (mc_anstbl.mc_procid, cdte.event, addr (message) -> fixed_bin_71, code); if code ^= 0 then call hphcs_$syserr_error_code (ANNOUNCE, code, "^a: Could not notify answering service of new login channel ^a.", ME, cdte.name); end; goto ttydone; end; else do; mc_ate.tra_vec = MC_WAIT_DIALUP; if cdtep ^= null () then call listen_if_mpx_up (); go to error_exit; end; /* Come here when we get an error code from the ttydim. */ /* We check for hangup */ /* Message is printed elsewhere */ tty_err: if code = error_table_$line_status_pending /* we lost the wakeup? */ then do; call FLUSH_LINE_STATUS; go to ttydone; end; if code ^= error_table_$io_no_permission then call iox_$control (mc_ate.iocb, "hangup", null (), (0)); mc_ate.tra_vec = MC_WAIT_DIALUP; if cdtep ^= null then call listen_if_mpx_up (); error_exit: mc_ate.control.inhibit = "0"b; /* Allow output to come out. */ call hcs_$wakeup (mc_anstbl.mc_procid, mc_ate.queue_event, 0, code); /**** If a message coordinator terminal hangs up, force a sign_out. We may get here as a result of a drop command. If so, we have already signed out the terminal and desctroyed the ssu invocation. */ if mc_ate.signed_on & mc_ate.sci_ptr ^= null () then do; call mc_commands_$sign_out (mc_atep, old_operator_name, (0)); call lg_ctl_$logout_operator (ssu_$get_info_ptr (mc_ate.sci_ptr), old_operator_name, "hangup"); end; if sc_stat_$admin_sci_ptr = mc_ate.sci_ptr & mc_ate.sci_ptr ^= null () then do; call as_$meter_exit (MSGCORD_METER); /* turn off metering before returning */ sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$admin_sci_ptr); call sc_subsystem_info.hangup_entry (sc_stat_$admin_sci_ptr); end; /* Come here when we have hung out a read and found no input. The ttydim will send us a wakeup when there is some If there is stacked output for this channel, or if the device is in output wait, send a wakeup to the output driver for the device (mc_wakeups_$typer_out). */ check_ow: if (mc_ate.output_wait | mc_ate.output_pending) then stim: call hcs_$wakeup (mc_anstbl.mc_procid, mc_ate.queue_event, 0, code); /* ALL RETURNS MUST COME HERE TO TURN OFF METERING BEFORE RETURNING !!! */ ttydone: call as_$meter_exit (MSGCORD_METER); /* turn off metering before returning */ return; /* Exit */ /* -------------------------------------------------------- */ get_chars: procedure (time); declare time fixed bin (71); call timed_io_$get_chars (mc_ate.iocb, time, addr (input_buffer), length (input_buffer), length_read_in, code); go to READ_COMMON; get_line: entry (time); call timed_io_$get_line (mc_ate.iocb, time, addr (input_buffer), length (input_buffer), length_read_in, code); READ_COMMON: if code = error_table_$timeout then code = 0; if code = error_table_$io_no_permission then go to tty_hung; if code ^= 0 then go to tty_err; end get_chars; write: proc (message); declare message char (*); /**** This should only be used for short messages. It assumes that a moment sleeping will get rid of the output. */ call timed_io_$put_chars (mc_ate.iocb, 10 * 1000 * 1000, addr (message), length (message), (0), code); /* can't block, but patience is possible */ if code = error_table_$timeout then code = 0; if code = error_table_$io_no_permission then go to tty_hung; if code ^= 0 then go to tty_err; end write; errx: proc (msg); dcl msg char (*); call hphcs_$syserr (ANNOUNCE, "^a: ^a", ME, msg); go to ttydone; end errx; listen_if_mpx_up: procedure; dcl mpx_name char (32); dcl state fixed bin; dcl i fixed bin; dcl codex fixed bin (35); i = index (reverse (cdte.name), "."); if i = 0 then return; mpx_name = substr (cdte.name, 1, length (cdte.name) - i); call multiplexer_mgr_$state_mpx (mpx_name, state, codex); if codex = 0 then if state = FNP_UP then call iox_$control (mc_ate.iocb, "listen", null (), (0)); return; end listen_if_mpx_up; /* entry used by multiplexer mgr when mpx crashes. We are given a cdte pointer instead of a mc_ate pointer */ simulated_wakeup: entry (Event_call_info_ptr); dcl 1 local_event_call_info aligned like event_call_info automatic; dcl i fixed bin; event_call_info_ptr = Event_call_info_ptr; local_event_call_info = event_call_info; cdtep = event_call_info.data_ptr; mc_ansp = sc_stat_$mc_ansp; do i = 1 to mc_anstbl.current_size; mc_atep = addr (mc_anstbl.entry (i)); if mc_ate.active then if mc_ate.real_tty_name = cdte.name then do; local_event_call_info.channel_id = mc_ate.event; local_event_call_info.data_ptr = mc_atep; call mc_tty_ (addr (local_event_call_info)); return; end; end; return; GREET: procedure; declare message char (100); call ioa_$rs ("Channel ^a attached by Message Coordinator.", message, (0), mc_ate.real_tty_name); call write (rtrim (message)); mc_ate.control.inhibit = "0"b; /* Reset output-inhibit */ mc_ate.tra_vec = MC_WAIT_READY; return; end GREET; SET_TERM_TYPE: procedure (a_type_to_set); declare a_type_to_set char (*); declare type_to_set char (32); if cdtep = null () then return; /* DSA doesn't allow changing terminal type */ type_to_set = a_type_to_set; if type_to_set = "" then do; if cdte.current_terminal_type ^= "" then type_to_set = cdte.current_terminal_type; else if cdte.initial_terminal_type ^= "" then type_to_set = cdte.initial_terminal_type; else do; GET_TERM_TYPE: unspec (TI) = ""b; TI.term_type = ""; TI.version = terminal_info_version; call iox_$control (mc_ate.iocb, "terminal_info", addr (TI), code); if (code = error_table_$io_no_permission) then go to tty_hung; /* forgive and forget about it */ if code ^= 0 then go to TTP_ERROR; call ttt_info_$default_term_type (TI.line_type, TI.baud_rate, type_to_set, code); if code ^= 0 then TTP_ERROR: do; call hphcs_$syserr_error_code (ANNOUNCE, code, "^a: No default ttp for ^a line ^d baud ^d.", ME, mc_ate.real_tty_name, TI.line_type, TI.baud_rate); go to tty_err; end; end; end; STTI.version = 1; STTI.name = type_to_set; STTI.flags = "1"b; STTI.mbz = "0"b; if mc_anstbl.trace then call sys_log_ (SL_LOG_SILENT, "^a: ^a stty -ttp ^a", ME, mc_ate.real_tty_name, type_to_set); call iox_$control (mc_ate.iocb, "set_term_type", addr (STTI), code); if code = error_table_$io_no_permission then go to tty_hung; if code ^= 0 then do; call hphcs_$syserr_error_code (ANNOUNCE, code, "^a: Failed to set terminal type for ^a.", ME, mc_ate.real_tty_name); go to tty_err; end; end SET_TERM_TYPE; FLUSH_LINE_STATUS: procedure; declare code fixed bin (35); code = error_table_$line_status_pending; do while (code ^= 0); call iox_$control (mc_ate.iocb, "line_status", addr (line_status_space), code); if code ^= 0 & code ^= error_table_$line_status_pending then go to tty_err; end; call iox_$control (mc_ate.iocb, "start", null (), (0)); end FLUSH_LINE_STATUS; %page; decode_event_type: procedure (P_network_type, P_event_type) returns (fixed bin); /**** This internal procedure returns an generic event type based on the network type and the event type. */ dcl P_network_type fixed bin (4) unsigned unaligned parameter; dcl P_event_type fixed bin (8) unsigned unaligned parameter; dcl event_type fixed bin; %include net_event_message; if P_network_type = MCS_NETWORK_TYPE then do; if P_event_type = MCS_UNSPECIFIED_MSG then event_type = UNSPECIFIED_EVENT; else if P_event_type = MCS_DIALUP_MSG then event_type = DIALUP_EVENT; else if P_event_type = MCS_HANGUP_MSG then event_type = HANGUP_EVENT; else if P_event_type = MCS_QUIT_MSG then event_type = QUIT_EVENT; else if P_event_type = MCS_READ_MSG then event_type = INPUT_AVAILABLE_EVENT; else if P_event_type = MCS_WRITE_MSG then event_type = OUTPUT_SPACE_AVAILABLE_EVENT; else if P_event_type = MCS_LINE_STATUS_MSG then event_type = LINE_STATUS_EVENT; else if P_event_type = MCS_MASKED_MSG then event_type = MASKED_EVENT; else do; if P_event_type > MAX_MCS_EVENT_MSG_TYPE then call sys_log_$error_log (SL_LOG_SILENT, error_table_$bad_arg, ME, "Invalid MCS wakeup event type ^d.", P_event_type); else call sys_log_$error_log (SL_LOG_SILENT, error_table_$bad_arg, ME, "Unexpected MCS wakeup event type ^a.", MCS_MSG_TYPE_TO_PNAME (P_event_type)); event_type = -1; end; end; else if P_network_type = DSA_NETWORK_TYPE then do; if P_event_type = DSA_UNSPECIFIED_MSG then event_type = UNSPECIFIED_EVENT; else if P_event_type = DSA_ESTABLISHMENT_MSG then event_type = DIALUP_EVENT; else if P_event_type = DSA_TERM_ABNORMAL_MSG then event_type = HANGUP_EVENT; else if P_event_type = DSA_ATTENTION_MSG then event_type = QUIT_EVENT; else if P_event_type = DSA_DATA_INPUT_MSG then event_type = INPUT_AVAILABLE_EVENT; else if P_event_type = DSA_DATA_OUTPUT_MSG then event_type = OUTPUT_SPACE_AVAILABLE_EVENT; else do; if P_event_type > MAX_DSA_EVENT_MSG_TYPE then call sys_log_$error_log (SL_LOG_SILENT, error_table_$bad_arg, ME, "Invalid DSA event type ^d.", P_event_type); else call sys_log_$error_log (SL_LOG_SILENT, error_table_$bad_arg, ME, "Unexpected DSA event type ""^a"".", DSA_MSG_TYPE_TO_PNAME (P_event_type)); event_type = -1; end; end; else do; call sys_log_$error_log (SL_LOG_SILENT, error_table_$bad_arg, ME, "Unexpected network type ^d in event message.", P_network_type); event_type = -1; end; return (event_type); end decode_event_type; /* format: off */ %page; %include as_data_; %page; %include as_meter_numbers; %page; %include author_dcl; %page; %include cdt; %page; %include dial_event_message; %page; %include dialup_values; %page; %include event_call_info; %page; %include iox_entries; %page; %include mc_anstbl; %page; %include net_event_message; %page; %include sc_stat_; %page; %include sc_subsystem_info_; %page; %include set_term_type_info; %page; %include sys_log_constants; %page; %include syserr_constants; %page; %include terminal_info; %page; %include tty_states; %page; /* BEGIN MESSAGE DOCUMENTATION Message: mc_tty_: Channel CHANNEL (vchannel VCHANNEL) received TIMEOUT while awaiting DIALUP wakeup. S: $info T: $run M: Wakeup was not acted on soon enough by AS. A: $inform Message: mc_tty_: Channel CHANNEL received TIMEOUT while awaiting DIALUP wakeup. S: $info T: $run M: Wakeup was not acted on soon enough by AS. A: $inform Message: mc_tty_: Event sent from incorrect ring. event channel = N, event message = M, event sender = S, device signal = D ring = R, event data ptr = P S: $info T: $run M: An event was sent from a ring higher than the specified MNA ring 2. A: $inform Message: mc_tty_: ERROR_TABLE_MESSAGE Connecting to CHANNEL (vchannel VCHANNEL). S: $info T: $run M: Error creating an IOCB while attempting to connect channel CHANNEL as message coordinator terminal. Channel cannot be accepted as MC terminal. Cannot attach and open I/O switches. A: $inform Message: mc_tty_: ERROR_TABLE_MESSAGE Connecting to CHANNEL. S: $info T: $run M: Error creating an IOCB while attempting to connect channel CHANNEL as message coordinator terminal. Channel cannot be accepted as MC terminal. Cannot attach and open I/O switches. A: $inform Message: mc_tty_: Channel CHANNEL (vchannel VCHANNEL) received WAKEUP_TYPE wakeup while awaiting DIALUP. S: $info T: $run M: Received an unexpected WAKEUP_TYPE wakeup while waiting for a DIALUP wakeup. Dialup will not succeed. A: $inform Message: mc_tty_: Channel CHANNEL received WAKEUP_TYPE wakeup while awaiting DIALUP. S: $info T: $run M: Did not receive a DIALUP wakeup WAKEUP_TYPE when should have. Recieved an unexpected WAKEUP_TYPE. A: $inform Message: mc_tty_: Line CHAN hung up. S: as (severity 0) T: $run M: Channel CHAN has been hungup during a system shutdown. A: $ignore Message: mc_tty_: Invalid argument. Invalid MCS wakeup event type TYPE. S: $as0 T: $run M: An MCS wakeup event type TYPE was received which is out of the range of known event types. The wakeup was ignored. A: $ignore Message: mc_tty_: Invalid argument. Unexpected MCS wakeup event type TYPE. S: $as0 T: $run M: A known MCS wakeup event type TYPE was received but was not expected for a message coordinator terminal. The wakeup was ignored. Message: mc_tty_: Invalid argument. Invalid DSA wakeup event type TYPE. S: $as0 T: $run M: A DSA wakeup event type TYPE was received which is out of the range of known event types. The wakeup was ignored. A: $ignore Message: mc_tty_: Invalid argument. Unexpected DSA wakeup event type TYPE. S: $as0 T: $run M: A known DSA wakeup event type TYPE was received but was not expected for a message coordinator terminal. The wakeup was ignored. A: $ignore Message: mc_tty_: Invalid argument. Unexpected network type TYPE in event message. S: $as0 T: $run M: An unknown network ident in wakeup event message was received. The wakeup was ignored. A: $ignore Message: OPER: S: Initializer terminal. T: $run M: This message is typed if the operator enters a blank line on a message coordinator terminal. It indicates that input is expected on the terminal, and that output will be inhibited for 30 seconds. A: Type a system control command. Message: Channel CHANNEL_NAME attached by Message Coordinator. S: Initializer terminal. T: $run M: The terminal has been attached by the message coordinator in response to an accept or substty command. A: Proceed to use the terminal. Message: mc_tty_: called with bad pointer S: BOS typewriter. T: $run M: This message indicates a bug in system_control_ or in the Message Coordinator. An illegal signal has been received by the attached terminal handler in system_control_; the data pointer that should point to an entry in the mc_anstbl does not point to the correct segment. The signal is ignored. A: $contact Message: mc_tty_: called with null ptr S: BOS typewriter. T: $run M: This message indicates a bug in system_control_ or in the Message Coordinator. An illegal signal has been received by the attached terminal handler in system_control_. The signal is ignored. A: $contact Message: mc_tty_: channel CHAN masked by FNP. S: $beep T: $run M: The channel, CHAN, has just been masked by the FNP. This is usually due to some hardware problem with the channel. A: Fix the problem before re-using the channel. Message: mc_tty_: ERROR_TABLE_MESSAGE wru failed for CHAN. S: $info T: $run M: The CDT entry for channel CHAN requires an answerback, but an error was returned while trying to read it. The returned error is described by ERROR_TABLE_MESSAGE. A: Verify that the channel is configured correctly in the CDT. Message: mc_tty_: ERROR_TABLE_MESSAGE Could not remove CHAN from MC use. S: $info T: $run M: An error, described by ERROR_TABLE_MESSAGE, was returned from mc_commands_$remove_tty while tring to remove channel CHAN from MC service after a hangup. A: $inform Message: mc_tty_: ERROR_TABLE_MESSAGE Could not get channel CHAN back from MC. S: $info T: $run M: An error, described by ERROR_TABLE_MESSAGE, was returned from astty_$tty_event while trying to give channel CHAN back to the AS after a hangup. A: $inform Message: mc_tty_: ERROR_TABLE_MESSAGE Could not notify answering service of new login channel CHAN. S: $info T: $run M: An error, described by ERROR_TABLE_MESSAGE, was returned from hcs_$wakeup while trying to notify the AS about the new login channel CHAN, after a hangup. A: $inform Message: mc_tty_: sc_stat_$mc_ansp is null S: $info T: $run M: This message indicates a bug in system_control_ or in the Message Coordinator. A signal has been received by the attached terminal handler in system_control_ but the signal cannot be handled because the mc_anstbl cannot be located. The signal is ignored. A: $contact Message: mc_tty_: ERROR_TABLE_MESSAGE Failed to set terminal type for CHAN. S: $info T: $run M: An error described ty ERROR_TABLE_MESSAGE was returned while trying to set the terminal type on channel CHAN. A: Depending on the error, it may be ignored, or the channel may be hungup. If the channel is hungup, an attempt should be made to fix the error before connecting the terminal again. Message: mc_tty_: channel CHAN hung up. S: $beep T: $run M: This message indicates that an attempt has been made to read input from a terminal device channel attached to the Message Coordinator and that the channel is not active. This condition may be due to a transient line condition, a terminal failure, or a communications line failure. The system attempts to proceed. A: If the terminal is a hardwired device and can be reconnected, do so. If this is a dialup channel that has failed, use the substty or drop commands to remove the channel. Message: mc_tty_: No default ttp for CHANNEL line LINE baud BAUD. S: $beep T: $run M: Could not get default terminal type for terminal on CHANNEL which has a line type of LINE. Hangup will follow. A: $inform END MESSAGE DOCUMENTATION */ end mc_tty_;  mc_util_.pl1 09/03/87 1218.5r w 09/03/87 1209.7 149238 /****^ *********************************************************** * * * 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,indattr */ mc_util_: procedure; /* This procedure contains utility routines used by the message coordinator. It contains the following entries: init: mrt_source: mrt_stream: get_seg: queue */ /* message_coordr_ was originally created by Dennis Capps with advice from TH VanVleck in October of 1972. mc_util_ created by Bill Silver on May 31, 1974. modified August 1976 by Robert Coren to get pointer to CDT and to behave sensibly if init entry is called twice. Modified June 1971 by T. Casey for MR9.0 for new wakeup priorities. Modified 1984-12, BIM: iox_ message coordinator. */ /****^ HISTORY COMMENTS: 1) change(86-01-07,MSharpe), approve(87-05-01,MCR7690), audit(87-05-10,Parisek), install(87-08-04,MR12.1-1055): Added the new "virtual_flag" and "cdt_channel_flag" arguments to the declaration and calls to mc_commands_$new_tty. 2) change(87-02-05,GDixon), approve(87-05-01,MCR7690), audit(87-05-10,Parisek), install(87-08-04,MR12.1-1055): Modified for a change to mc_anstbl.incl.pl1. Added the new "cdt_channel_flag" argument to the declaration and calls to mc_commands_$new_tty. 3) change(87-03-27,Parisek), approve(87-05-01,MCR7690), audit(87-08-03,GDixon), install(87-08-04,MR12.1-1055): Initialize the mc_anstbl.dsa_ring_number entry in the mc_anstbl structure. END HISTORY COMMENTS */ %page; /* Parameters */ declare arg_alarm bit (1), /* ON => alarm message. */ arg_code fixed bin, /* Error code. */ arg_entry_name char (*), /* Name of segment to initiate. */ arg_qp ptr, /* Pointer to output queue segment. */ arg_seg_ptr ptr, /* Pointer to segment that was initiated. */ arg_source_name char (*), /* Name of source entry. */ arg_sourcex fixed bin, /* Index to source entry. */ arg_stream_name char (*), /* Name of stream entry. */ arg_streamp ptr, /* Pointer to stream entry. */ arg_streamx fixed bin, /* Index to stream entry. */ arg_string_len fixed bin, /* Length of input string. */ arg_source fixed bin, /* Source index */ arg_string_ptr ptr, /* Pointer to input string. */ ansptr ptr, /* Returned pointer to mc_anstbl. */ cons_cont_proc entry, /* Entry to call to twitch typewriter. */ intty char (*), /* Console name. */ inttyp ptr, /* Returned pointer to mc_ate. */ sdir char (*); /* Pathname of system directory for tables. */ /* Declarations of POINTERS */ declare cdtp ptr, /* to Channel Definition Table */ mc_ansp_stat ptr int static init (null), /* to mc_anstbl */ mcmp ptr int static init (null), /* to message seg for message coordinator */ messp ptr int static init (null), /* to a partic message */ mrtp ptr int static init (null), /* to Message Routing Table */ qp ptr, /* to queue of lines to be typed on a device */ seg_ptr ptr, /* to make a segment. */ streamp ptr, /* to a stream entry in MRT. */ string_ptr ptr, /* to input string. */ temp_SDBp ptr int static init (null), /* to temp_SDB */ vcep ptr, /* to an entry in virtual console table */ vconsp ptr int static init (null); /* to Virtual CONSole table */ /* Fixed binary quantities */ declare ackn fixed bin (71) init (0), /* event message for calls to hcs_$wakeup */ code fixed bin, /* Error code */ i fixed bin, /* a temporary index */ j fixed bin, /* another temporary index */ sourcex fixed bin, streamx fixed bin, string_len fixed bin, vacantx fixed bin; /* Character strings */ declare entry_name char (32), source_name char (32), stream_name char (32), sysdir char (168) int static init (">system_control_1"); /* BIT strings */ declare dont_log bit (1) init ("0"b), /* "1"b=>Sentinel-- Needn't be logged */ initialized bit (1) int static init ("0"b), /* to prevent multiple initializations */ wake_typer bit (1); /* ON => send wakeup. */ /* BUILTIN FUNCTIONS */ declare addr builtin, null builtin, string builtin; /* EXTERNAL ENTRIES */ declare get_process_id_ entry returns (bit (36)), hcs_$add_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin), hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin), hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin), hcs_$terminate_noname entry (ptr, fixed bin), hcs_$truncate_seg entry (ptr, fixed bin, fixed bin), hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin), ipc_$create_ev_chn entry (fixed bin (71), fixed bin), ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin), mc_commands_$define entry (char (*), char (*), char (*), fixed bin), mc_commands_$init entry (ptr, ptr, ptr, ptr, ptr), mc_commands_$new_tty entry (char (*), bit (36), bit (1) aligned, ptr, fixed bin), mc_con_rec_$init entry (ptr), mc_util_$get_seg entry (char (*), ptr, fixed bin), mc_wakeups_$init entry (ptr, ptr, ptr, ptr), mc_wakeups_$protocol entry (ptr), mc_wakeups_$router entry (ptr); /* EXTERNAL constants */ declare error_table_$ioname_not_found ext fixed bin, error_table_$noentry ext fixed bin; /* STRUCTURES */ declare 1 temp_SDB int static aligned like stream, /* For calls to mrd_util_$read */ 1 temp_mess int static aligned like message_block; /* ditto */ dcl based_string char (string_len) based (string_ptr); declare 1 segment_acl (1) aligned, 2 access_name char (32), 2 modes bit (36), 2 mbz bit (36) init ("0"b), 2 status_code fixed bin (35); %page; init: entry (sdir, intty, cons_cont_proc, ansptr, inttyp, arg_code); /* This entry is called to initialize the message coordinator. It sets up all the tables used by the message coordinator. It calls the initialization entries of the other procedures that make up the message coordinator. */ sysdir = sdir; code = 0; if initialized /* already been called */ then do; /* we still have to fill in output arguments */ call hcs_$initiate (sysdir, "mc_anstbl", "", 0, 1, ansptr, code); if ansptr ^= null then do; call hcs_$terminate_noname (ansptr, code); /* once is enough */ call mc_commands_$new_tty (intty, (36)"1"b, "1"b, inttyp, code); arg_code = 0; end; else arg_code = code; return; end; messp = addr (temp_mess); temp_SDBp = addr (temp_SDB); temp_SDB.ourmess = null; temp_SDB.hismess = null; temp_SDB.source = "(op)"; temp_SDB.stream = "reply"; temp_SDB.source_index = 0; temp_SDB.stream_index = 0; temp_SDB.prev_trans.first_block = 0; temp_SDB.prev_trans.end_block = 0; temp_SDB.prev_trans.current_block = 0; temp_SDB.prev_trans.offset = 0; temp_SDB.no_of_vcons = 0; string (temp_SDB.flags) = "0"b; /* Initiate mc.message */ call mc_util_$get_seg ("mc.message", mcmp, code); if code ^= 0 then goto INIT_RETURN; temp_SDB.ourmess = mcmp; /* Initialize mc.message */ call hcs_$truncate_seg (mcmp, 0, code); /* Zero it */ mcmp -> syscon_mseg.current_process_id = get_process_id_ (); mcmp -> syscon_mseg.ipc_el.n = 1; call ipc_$create_ev_chn (mcmp -> syscon_mseg.ipc_el.channel, code); if code ^= 0 then goto INIT_RETURN; mcmp -> syscon_mseg.proto_el.n = 1; call ipc_$create_ev_chn (mcmp -> syscon_mseg.proto_el.channel, code); if code ^= 0 then goto INIT_RETURN; /* Make these event call channels so sources can get some action going */ call ipc_$decl_ev_call_chn (mcmp -> syscon_mseg.ipc_el.channel, mc_wakeups_$router, null, MC_PRIO, code); call ipc_$decl_ev_call_chn (mcmp -> syscon_mseg.proto_el.channel, mc_wakeups_$protocol, null, MC_PRIO, code); /* Initiate other segs */ call mc_util_$get_seg ("mc_anstbl", mc_ansp, code); if code ^= 0 then goto INIT_RETURN; mc_ansp_stat, ansptr = mc_ansp; call mc_util_$get_seg ("cdt", cdtp, code); if code ^= 0 then go to INIT_RETURN; call mc_util_$get_seg ("vcons_tab", vconsp, code); if code ^= 0 then goto INIT_RETURN; call mc_util_$get_seg ("MRT", mrtp, code); if code ^= 0 then goto INIT_RETURN; /* Set up mc_anstbl */ /* First fill in the header */ call hcs_$truncate_seg (mc_ansp, 0, code); mc_anstbl.max_size = 256; /* No of entries permitted. */ mc_anstbl.mc_procid = mcmp -> syscon_mseg.current_process_id; mc_anstbl.sysdir = sysdir; /* Where to find put data segs. */ mc_anstbl.mrtp = mrtp; /* Pointer to MRT */ mc_anstbl.vconsp = vconsp; /* Pointer to Virtual Console Table */ mc_anstbl.cons_cont_proc = cons_cont_proc; /* Proc to wake when tty wants something. */ mc_anstbl.max_sources = 32; mc_anstbl.dsa_ring_number = 2; /* DSA ring */ /* Now we must initialize some of the other procedures which make up the message coordinator. We will pass them some pointers they are interrested in. */ call mc_commands_$init (mc_ansp, cdtp, temp_SDBp, mcmp, messp); call mc_con_rec_$init (mc_ansp); call mc_wakeups_$init (mc_ansp, temp_SDBp, mcmp, messp); /* Set up first entry in mc_anstbl. */ call mc_commands_$new_tty (intty, (36)"1"b, "1"b, inttyp, code); if code ^= 0 then if code = error_table_$ioname_not_found then code = 0; else goto INIT_RETURN; call hcs_$truncate_seg (vconsp, 0, code); /* Initialize virtual console table. */ /* Fill in * entry */ vcep = addr (vcons_tab.star_entry); vcons.vcons = "*"; vcons.no_of_dest = 1; vcons.dest (1).type = 1; vcons.dest (1).dest = intty; vcons.dest (1).queue_seg_ptr = addr (mc_anstbl.entry (1)) -> mc_ate.queue_ptr; /* Define the default virtual console. */ call mc_commands_$define ("default_vcons", "tty", intty, code); if code ^= 0 then if code = error_table_$ioname_not_found then code = 0; /* Initialize the MRT */ call hcs_$truncate_seg (mrtp, 0, code); MRT.star_entry.source = "*"; MRT.star_entry.hismess = null; MRT.star_entry.no_of_streams = 1; streamp = addr (MRT.star_entry.stream); stream.stream = "*"; stream.ourmess = mcmp; stream.no_of_vcons = 1; stream.vcons (1) = "default_vcons"; stream.vcons_index (1) = 1; initialized = "1"b; INIT_RETURN: arg_code = code; return; %page; mrt_source: entry (arg_source_name, arg_sourcex, arg_code); /* This entry is called to look for a source entry in the Message Routing Table. It returns the index associated with this source entry. */ source_name = arg_source_name; /* Copy input argument. */ vacantx = 0; /* We remember first vacant entry. */ do sourcex = 1 to MRT.no_of_sources; if MRT.source (sourcex).source = source_name then do; /* We found the right source entry. */ arg_sourcex = sourcex; /* Set return arguments. */ arg_code = 0; return; end; if vacantx = 0 /* Is this a vacant entry? */ then if ^MRT.source (sourcex).flags.valid then vacantx = sourcex; end; arg_sourcex = vacantx; /* Didn't find right source entry. */ arg_code = error_table_$ioname_not_found; return; %page; mrt_stream: entry (arg_sourcex, arg_stream_name, arg_streamp, arg_streamx, arg_code); /* This entry is called to find a stream entry within a source entry. It will return a pointer to the stream entry as well as the array index associated with this stream entry. */ sourcex = arg_sourcex; /* Copy argument data. */ stream_name = arg_stream_name; vacantx = 0; /* We're going to remember the first vacancy. */ do streamx = 1 to MRT.source (sourcex).no_of_streams; streamp = addr (MRT.source (sourcex).stream (streamx)); if streamp -> stream.stream = stream_name then do; /* Found the right stream entry. */ arg_streamp = streamp; arg_streamx = streamx; arg_code = 0; return; end; if vacantx = 0 /* Save index of first vacant entry. */ then if ^(streamp -> stream.flags.valid) then vacantx = streamx; end; streamx = vacantx; /* Didn't find the right stream entry. */ if streamx = 0 /* Did we find a vacant entry? */ then arg_streamp = null (); /* No. */ else arg_streamp = addr (MRT.source (sourcex).stream (streamx)); arg_streamx = streamx; arg_code = error_table_$ioname_not_found; return; %page; get_seg: entry (arg_entry_name, arg_seg_ptr, arg_code); /* This entry is called to obtain a pointer to a segment whose entry name is passed as an argument. If we cannot initiate the segment, we will make a new segment with that name. */ entry_name = arg_entry_name; /* Initialize arguments. */ code = 0; call hcs_$initiate (sysdir, entry_name, "", 0, 1, seg_ptr, code); if seg_ptr ^= null then code = 0; /* Not null, forget code. */ else if code = error_table_$noentry /* Null => segment not there. */ then do; call hcs_$make_seg (sysdir, entry_name, "", 01011b, seg_ptr, code); if seg_ptr ^= null then do; /* We have created it. */ segment_acl (1).access_name = "*.SysDaemon.*"; segment_acl (1).modes = "101"b; call hcs_$add_acl_entries (sysdir, entry_name, addr (segment_acl), 1, code); end; end; arg_seg_ptr = seg_ptr; /* Return arguments. */ arg_code = code; return; %page; queue: entry (arg_qp, arg_alarm, arg_string_ptr, arg_string_len, arg_source, arg_code); /* This entry is called to put a message in a device output queue. */ qp = arg_qp; /* Copy arguments. */ code = 0; string_ptr = arg_string_ptr; string_len = arg_string_len; code = 0; mc_ansp = mc_ansp_stat; if device_queue.top_of_queue = 0 then /* Empty queue */ do; wake_typer = "1"b; /* REmember to wake typer_out */ if device_queue.free_top = 0 then /* Empty free storage list */ j, /* Allocate new block */ device_queue.top_of_queue, device_queue.end_of_queue, device_queue.next_free = device_queue.next_free + 1; else do; /* Take block from free list */ j, device_queue.top_of_queue, device_queue.end_of_queue = device_queue.free_top; device_queue.free_top = device_queue.line (j).next_line; end; end; else do; /* Stuff already in queue */ wake_typer = "0"b; /* Wakeup will come from self or tty_aught */ if device_queue.free_top = 0 then /* Empty free storage list */ j, /* Allocate new block */ device_queue.next_free = device_queue.next_free + 1; else do; /* Take block from free list */ j = device_queue.free_top; device_queue.free_top = device_queue.line (j).next_line; end; i = device_queue.end_of_queue; /* Put it on end of queue */ device_queue.line (i).next_line, device_queue.end_of_queue = j; end; device_queue.line (j).not_done = "0"b; /* Fill it in */ device_queue.line (j).alarm = arg_alarm; device_queue.line (j).next_line = 0; device_queue.line (j).offset = 0; device_queue.line (j).line_length = string_len; device_queue.line (j).source = arg_source; device_queue.line (j).string = based_string; device_queue.no_of_messages = device_queue.no_of_messages + 1; if wake_typer then call hcs_$wakeup (mc_anstbl.mc_procid, device_queue.channel, 0, code); arg_code = code; return; %page; %include as_wakeup_priorities; %page; %include syscon_mseg; %page; %include mess_route_table; %page; %include vcons_tab; %page; %include device_queue; %page; %include mc_anstbl; end mc_util_;  mc_wakeups_.pl1 07/20/88 1251.1r w 07/19/88 1536.0 290097 /****^ *********************************************************** * * * 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 */ mc_wakeups_: procedure; /* This procedure is part of the message coordinator. It receives all wakeups handled by the message coordinator. The message coordinator was originally created by Dennis Capps with help from TH VanVleck in October of 1972. "mc_wakeups_" originally created by Bill Silver in May, 74. Modified 751215 by PG to make any_other handler just return, and fix error handling Modified June 1976 by Larry Johnson to use new ocdim_ alarm order call Modified August 1976 by Robert Coren to use CDT entry for tty channels Modified 770725 by PG to fix bug in folding of multi-line messages Modified 25 Sept 1979 by T. Casey to allow setting of message limits. Modified June 1981 by T. Casey for MR9.0 to add metering. Modified 830620 by E. A. Ranzenbach for new console recovery scheme... * 84-11-16, W. Olin Sibert: Modified to handle zero wakeup from * ocdcm_ as signal to deactivate console recovery. * 1985-01-02, BIM: new logging and other improvements. */ /****^ HISTORY COMMENTS: 1) change(86-02-21,MSharpe), approve(87-06-12,MCR7690), audit(87-05-07,Parisek), install(87-08-06,MR12.1-1054): Modified to use new version of mc_anstbl.incl.pl1; Fixed bug in "router" that lost stream.source when using the star_entry. 2) change(87-02-05,GDixon), approve(87-06-12,MCR7690), audit(87-05-07,Parisek), install(87-08-06,MR12.1-1054): Modified for a change to mc_anstbl.incl.pl1. All entrypoints that refer to mc_anstbl must now set the automatic variable mc_ansp from mc_ansp_stat. 3) change(87-09-17,Parisek), audit(87-09-21,GDixon), approve(87-09-21,MECR0008), install(87-09-21,MR12.1-1114): Return with error if status code equals error_table_$unable_to_do_io from calling mrd_util_. This status code represents a condition error signalled from mrd_util_. (phx20928) END HISTORY COMMENTS */ /* Declaration of Parameters */ declare arg_mc_ansp ptr, arg_mcmp ptr, arg_messp ptr, arg_event_call_info_ptr ptr, arg_temp_SDBp ptr; /* Declarations of POINTERS */ declare buffer_ptr pointer, log_buffer_ptr pointer, tty_buffer_ptr pointer, hismp ptr, /* to message seg of a source */ linep ptr, /* to something in a device queue to be printed */ mc_ansp_stat ptr int static init (null ()), /* to mc_anstbl */ mcmp ptr int static init (null), /* to message seg for message coordinator */ messp ptr int static init (null), /* to a particular message */ mrtp ptr int static init (null), /* to Message Routing Table */ qp ptr, /* to queue of lines to be typed on a device */ streamp ptr, /* to a stream entry in MRT */ temp_SDBp ptr int static init (null), /* to temp_SDB */ vcep ptr, /* to an entry in virtual console table */ vconsp ptr int static init (null); /* to Virtual CONSole table */ /* Fixed binary quantities */ declare ackn fixed bin (71) init (0), /* event message for calls to hcs_$wakeup */ code fixed bin (35), /* error code */ dest fixed bin, /* Index when looping thru phys devices in vcons_tab */ i fixed bin, /* a temporary index */ k fixed bin, /* loop counter for protocol and router */ last_line fixed bin, /* 1 link back in q of lines to be typed */ limit fixed bin, /* No of lines typer_out will try to type */ lng fixed bin, /* Length of formatted string for output */ mrt_source fixed bin, /* Index of source entry in MRT */ mrt_stream fixed bin, /* Index of stream entry in source entry in MRT */ n fixed bin (21), /* No of characters to be typed */ nt fixed bin (21), /* No of characters actually typed */ offset fixed bin, /* No of characters already typed */ this_line fixed bin, /* Current link in q of lines to be typed */ ucs_recursion fixed bin initial (0), /* Recursion counter for any_other handler */ vc fixed bin, /* Index when looping thru vcons in MRT */ vce fixed bin, /* Index of Virtual Console table Entry */ wait_time fixed bin (71) int static init (5), /* Settable time to wait til try to print some more */ max_limit fixed bin int static init (20), /* settable number of messages to print before waiting */ when_sent fixed bin (71); /* Postmark from each message. */ declare log_buffer_length fixed bin (21); declare state fixed bin; /* Character strings */ declare (buffer_space, log_buffer_space) char (500) unaligned; declare tty_buffer_space char (132) unaligned; declare timestamp char (50) varying; declare buffer char (nt) based (buffer_ptr), chain char (8), /* whence the message is to be taken */ log_buffer char (log_buffer_length) based (log_buffer_ptr), stream_source char (32), /* saves the stream.source in case star entry is used */ pigeon_hole char (32), /* Name of a message segment to be initiated */ sysdir char (168) int static init (">system_control_1"), /* ditto */ /* where to find the message segs */ time char (24); /* for putting in messages */ dcl NL char (1) aligned int static options (constant) init (" "); dcl stars char (16) aligned int static options (constant) init (" *********** "); /* There are three BEL chars in this string */ /* BIT strings */ declare created_seg (8) bit (1) init ((8) (1)"0"b), /* In case we want to write messages */ dont_log bit (1), /* "1"b=>Sentinel-- Needn't be logged */ sendalarm bit (1); /* TRUE if alarm message, at distribute */ /* builtins */ dcl (addr, index, max, min, null, string, substr, length, addcharno, byte, rtrim) builtin; dcl any_other condition; /* EXTERNAL ENTRIES */ declare as_any_other_handler_ entry (character (*), entry, label, label), com_err_ entry options (variable), com_err_$suppress_name entry () options (variable), date_time_$format entry (character (*), fixed binary (71), character (*), character (*)) returns (character (250) var), hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)), hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)), ioa_$rsnnl entry () options (variable), ioa_ entry options (variable), mc_con_rec_$output entry (fixed bin (71)), mc_util_$mrt_source entry (char (*) aligned, fixed bin, fixed bin (35)), mc_util_$mrt_stream entry (fixed bin, char (*) aligned, ptr, fixed bin, fixed bin (35)), mc_util_$queue entry (ptr, bit (1), ptr, fixed bin, fixed bin, fixed bin (35)), mrd_util_$discard_remainder entry (ptr, fixed bin, fixed bin (35)), mrd_util_$read entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (21), char (*), ptr, fixed bin, fixed bin (35)), timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); declare log_write_$message entry (pointer, fixed binary, character (*), pointer, fixed binary (35)); declare hphcs_$syserr entry options (variable); declare hphcs_$syserr_error_code entry options (variable); declare sys_log_ entry options (variable); declare sys_log_$error_log entry options (variable); declare timed_io_$put_chars entry (pointer, fixed binary (71), pointer, fixed binary (21), fixed binary (21), fixed binary (35)); declare (as_$meter_enter, as_$meter_exit) entry (fixed bin); /* EXTERNAL constants */ declare ( error_table_$ioname_not_found, error_table_$no_message ext, error_table_$notalloc, error_table_$timeout, error_table_$unable_to_do_io) fixed bin (35) ext static; /* STRUCTURES */ declare 1 based_ackn based, 2 source_index fixed bin (35), 2 stream_index fixed bin (35); %page; /* Program */ init: entry (arg_mc_ansp, arg_temp_SDBp, arg_mcmp, arg_messp); /* This entry is called by mc_util_$init. It sets up the internal static variables that were once part of the unified message_coordr_ procedure. */ mc_ansp, mc_ansp_stat = arg_mc_ansp; temp_SDBp = arg_temp_SDBp; mcmp = arg_mcmp; messp = arg_messp; sysdir = mc_anstbl.sysdir; mrtp = mc_anstbl.mrtp; vconsp = mc_anstbl.vconsp; return; /* This entry is called when a wakeup arrives on the message coordinator's protocol channel. This happens whenever a source attaches an i/o stream through mrd_ or detaches such a stream (if no previous protocol message is still pending) or when this program sends itself a wakeup after processing 20 messages. */ protocol: entry (arg_event_call_info_ptr); event_call_info_ptr = arg_event_call_info_ptr; on any_other call as_any_other_handler_ ("mc_wakeups_$prototol", mc_wakeups_handler_, ABORT_EXIT, ABORT_EXIT); call as_$meter_enter (MSGCORD_METER); /* meter cpu time and paging used by this procedure */ chain = "proto"; do k = 1 to 20; /* Do at most 20 messages. */ /* Read part (or all) of the first available message in the chain and get its index. */ call mrd_util_$read (temp_SDBp, addr (buffer_space), 0, length (buffer_space), nt, chain, messp, state, code); if code = error_table_$no_message | code = error_table_$unable_to_do_io then goto METER_EXIT; /* There weren't 20 messages. */ when_sent = message_block.time_sent; if message_block.flags.introduction then goto introduction; if message_block.flags.farewell then goto farewell; /* If we get here, complain and */ call hphcs_$syserr (ANNOUNCE, "mc_wakeups_: Bad protocol: index = ^d", message_block.next_message); goto attached; introduction: /* This is where we fill in the MRT so that the router can do its work . */ /* Get indices in MRT */ /* First the source */ call mc_util_$mrt_source (message_block.from_source, mrt_source, code); if code ^= 0 then if code ^= error_table_$ioname_not_found then /* A real error */ do; gripe: call hphcs_$syserr_error_code (ANNOUNCE, code, "mc_wakeups_", "Protocol error: ^a ^a", message_block.from_source, message_block.from_stream); goto attached; end; else do; /* This is a source for which no routing has been provided. Make one. */ if mrt_source = 0 then mrt_source, /* Need to allocate new entry */ MRT.no_of_sources = MRT.no_of_sources + 1; MRT.source (mrt_source).source = message_block.from_source; MRT.source (mrt_source).hismess = null; MRT.source (mrt_source).no_of_streams = 0; MRT.source (mrt_source).flags.init = "0"b; /* "message" segment not initiated */ MRT.source (mrt_source).flags.valid = "1"b; /* info otherwise correct */ goto make_stream; end; /* Next the stream. */ call mc_util_$mrt_stream (mrt_source, message_block.from_stream, streamp, mrt_stream, code); if code ^= 0 then if code ^= error_table_$ioname_not_found then goto gripe; /* A real error */ else do; /* No routing provided for this stream. Make new entry. */ if mrt_stream = 0 then /* Need to allocate new entry */ if MRT.source (mrt_source).no_of_streams < 8 then /* Room for another? */ make_stream: mrt_stream, MRT.source (mrt_source).no_of_streams = MRT.source (mrt_source).no_of_streams + 1; else do; /* No room. */ code = error_table_$notalloc; goto gripe; end; streamp = addr (MRT.source (mrt_source).stream (mrt_stream)); string (stream.flags) = "0"b; stream.flags.valid = "1"b; /* Entry contains correct info */ stream.source = message_block.from_source; stream.stream = message_block.from_stream; stream.ourmess = mcmp; stream.source_index = mrt_source; stream.stream_index = mrt_stream; stream.no_of_vcons = MRT.star_entry.stream.no_of_vcons; do vc = 1 to stream.no_of_vcons; stream.vcons (vc) = MRT.star_entry.stream.vcons (vc); stream.vcons_index (vc) = MRT.star_entry.stream.vcons_index (vc); end; end; /* now fill in pointer to message segment for this source */ if MRT.source (mrt_source).flags.init then hismp = MRT.source (mrt_source).hismess; else do; /* first time through, initiate it. */ i = index (stream.source, " ") - 1; pigeon_hole = substr (stream.source, 1, i) || ".message"; call hcs_$initiate (sysdir, pigeon_hole, "", 0, 1, hismp, code); if hismp = null then go to gripe; /* EEK. message segment missing. */ MRT.source (mrt_source).hismess = hismp; MRT.source (mrt_source).flags.init = "1"b; /* "message" segment now initiated */ end; stream.hismess = MRT.source (mrt_source).hismess; stream.flags.active = "1"b; /* stream attached and sending */ /* Acknowledge the protocol, sending the indeces in the MRT */ addr (ackn) -> based_ackn.source_index = mrt_source; addr (ackn) -> based_ackn.stream_index = mrt_stream; call hcs_$wakeup (hismp -> syscon_mseg.current_process_id, hismp -> syscon_mseg.proto_el.channel, ackn, code); if code ^= 0 then call com_err_ (code, "mc_wakeups_", "Protocol cannot wake ^a", stream.source); goto attached; /* Reset active and send acknowledgement. */ farewell: mrt_source = message_block.source_index; mrt_stream = message_block.stream_index; streamp = addr (MRT.source (mrt_source).stream (mrt_stream)); stream.flags.active = "0"b; hismp = stream.hismess; if hismp -> syscon_mseg.no_of_streams = 0 then MRT.source (mrt_source).flags.init = "0"b; /* More tidy */ ackn = 0; call hcs_$wakeup (hismp -> syscon_mseg.current_process_id, hismp -> syscon_mseg.proto_el.channel, ackn, code); attached: call mrd_util_$discard_remainder (temp_SDBp, state, code); /* Leave campsite as clean as found it */ end; /* When we have done 20, give rest of process a chance But remember to do more later. */ call hcs_$wakeup (mcmp -> syscon_mseg.current_process_id, mcmp -> syscon_mseg.proto_el.channel, 0, code); goto METER_EXIT; /* ROUTER - called when a wakeup arrives on the "normal" event channel. Daemons send a wakeup after they have sent output, and router sends itself a wakeup after processing 20 messages. Under most circumstances (stream.source <= 4 chars), the maximum line length will be 118 characters...just enough to fit on a TermiNet */ router: entry (arg_event_call_info_ptr); mc_ansp = mc_ansp_stat; event_call_info_ptr = arg_event_call_info_ptr; on any_other call as_any_other_handler_ ("mc_wakeups_$router", mc_wakeups_handler_, ABORT_EXIT, ABORT_EXIT); call as_$meter_enter (MSGCORD_METER); /* meter cpu time and paging used by this procedure */ chain = "normal"; buffer_ptr = addr (buffer_space); log_buffer_ptr = addr (log_buffer_space); tty_buffer_ptr = addr (tty_buffer_space); do k = 1 to 20; /* Do 20 messages at a time. */ /* Read part (or all) of first available message in the chain */ call mrd_util_$read (temp_SDBp, buffer_ptr, 0, length (buffer_space), nt, chain, messp, state, code); if mc_anstbl.trace then call trace_mrd_util_read; if code = error_table_$no_message | code = error_table_$unable_to_do_io then goto METER_EXIT; /* There weren't 20 things in queue. */ /* Find the MRT entry */ mrt_source = message_block.source_index; mrt_stream = message_block.stream_index; if mrt_source = 0 | mrt_stream = 0 then do; /* AARGH! */ call hphcs_$syserr (ANNOUNCE, "mc_wakeups_: bad message from ^a.", message_block.from_source); call hphcs_$syserr (ANNOUNCE, "mc_wakeups_: message is ""^a"".", substr (message_block.message_body, 1, message_block.length)); call mrd_util_$discard_remainder (temp_SDBp, state, code); go to METER_EXIT; /* for now */ end; when_sent = message_block.time_sent; /* Get this too while at it. */ streamp = addr (MRT.source (mrt_source).stream (mrt_stream)); hismp = stream.hismess; stream_source = stream.source; /* save this, as you won't find it in the star entry */ if stream.no_of_vcons = 0 then streamp = addr (MRT.star_entry.stream); /* Whoops! */ /* Set up line to be typed */ another: dont_log = "0"b; if message_block.flags.sentinel then do; /* No special format */ dont_log = "1"b; if nt = 0 then go to get_rest; /* Unlikely */ tty_buffer_ptr = addr (buffer_space); /* reset ptr */ lng = nt; end; else do; time = date_time_$format ("^Hd^MH", when_sent, "", ""); if substr (buffer, nt, 1) = NL then nt = nt - 1; /* Remove extraneous nl */ timestamp = ""; /* varying string, initialize */ call ioa_$rsnnl (" ^a ^4a ", timestamp, (0), time, stream_source); /* just prepare stamp */ call ioa_$rsnnl ("^va ^a", log_buffer_space, log_buffer_length, max (4, length (rtrim (stream_source))), stream.source, buffer); end; do vc = 1 to stream.no_of_vcons; /* Send message to each virtual console */ vce = stream.vcons_index (vc); sendalarm = substr (stream.flags.alarm, vc, 1); /* Set alarm switch. */ vcep = addr (vcons_tab.vcons (vce)); if vcons.no_of_dest = 0 then vcep = addr (vcons_tab.star_entry); /* Whoops! */ do dest = 1 to vcons.no_of_dest; /* Send it to each physical device */ if vcons.dest (dest).type = 1 then do; /* This is a typewriter */ qp = vcons.dest (dest).queue_seg_ptr; if dont_log /* just a sentinel */ then do; call mc_util_$queue (qp, sendalarm, tty_buffer_ptr, lng, mrt_source, code); hismp -> syscon_mseg.mescount = hismp -> syscon_mseg.mescount + 1; end; else call queue_tty_message; /* send one or more messages as needed to fit in 132 per message char limit */ end; else if vcons.dest (dest).type = 2 then do; /* This is a log */ if sendalarm then i = 2; else i = 1; if ^dont_log then /* Interesting later? */ call log_write_$message (vcons.dest (dest).queue_seg_ptr, i, log_buffer, (null ()), (0)); end; else if vcons.dest (dest).type = 3 then ; /* Sink */ end; end; call check_off_message; get_rest: if state ^= 0 then do; /* Message cont more than 1 line or more chars than asked. */ call mrd_util_$read (temp_SDBp, addr (buffer_space), 0, length (buffer_space), nt, chain, messp, state, code); if mc_anstbl.trace then call trace_mrd_util_read; if code = error_table_$unable_to_do_io then goto METER_EXIT; if nt ^= 0 then goto another; end; end; call hcs_$wakeup (mcmp -> syscon_mseg.current_process_id, mcmp -> syscon_mseg.ipc_el.channel, 0, code); goto METER_EXIT; /* Fell out of loop. Big backlog. Allow rest of process a chance, but insure we come back. */ check_off_message: proc; hismp -> syscon_mseg.mescount = hismp -> syscon_mseg.mescount - 1; if hismp -> syscon_mseg.mescount <= 0 then do; hismp -> syscon_mseg.mescount = 0; if hismp -> syscon_mseg.output_wait then do; hismp -> syscon_mseg.output_wait = "0"b; call hcs_$wakeup (hismp -> syscon_mseg.current_process_id, hismp -> syscon_mseg.ipc_el.channel, 0, code); end; end; end check_off_message; /* This entry is called when a wakeup arrives on the event channel associated with a device queue. This can happen in three ways. When a line is placed in a previously empty queue a wakeup is sent to initiate processing by the typer_out. If the typer_out cannot complete typing all messages in a queue, it sets a timer to wake itself later to try again. If the typer_out cannot type all the characters of a given message it sets the output_wait switch in the mc answer table entry for this typewriter and expects system_control_$tty_aught to send a wakeup when hardcore is ready for more work. No lock is necessary on the device queues because mc$router and mc$typer_out are executed in the same process. */ typer_out: entry (arg_event_call_info_ptr); mc_ansp = mc_ansp_stat; event_call_info_ptr = arg_event_call_info_ptr; on any_other call as_any_other_handler_ ("mc_wakeups_$typer_out", mc_wakeups_handler_, ABORT_EXIT, ABORT_EXIT); call as_$meter_enter (MSGCORD_METER); /* meter cpu time and paging used by this procedure */ qp = event_call_info.data_ptr; /* What queue are we processing? */ if device_queue.no_of_messages = 0 then goto METER_EXIT; /* Nothing to do. */ mc_atep = device_queue.mc_atep; cdtep = mc_ate.cdtep; if mc_ate.control.inhibit then /* Waiting for operator? */ do; /* Tell mc_tty_ to talk to us */ mc_ate.control.output_pending = "1"b; goto METER_EXIT; end; n, last_line = 0; this_line = device_queue.top_of_queue; /* First message to type. */ limit = min (max_limit, device_queue.no_of_messages); /* Total number to type. */ do i = 1 to limit; mrt_source = device_queue.line (this_line).source; if mrt_source = 0 then hismp = null; else hismp = MRT.source (mrt_source).hismess; linep = addr (device_queue.line (this_line).string); offset = device_queue.line (this_line).offset; n = device_queue.line (this_line).line_length - offset; if mc_anstbl.trace then begin; declare line char (n) based (addcharno (linep, offset)); call sys_log_ (SL_LOG_SILENT, "MC (mc_wakeups_ - typer_out): tty: ^a^[; physical channel: ^a^;^s^]; this_line: ^d; line_length: ^d; offset: ^d; n: ^d; line: ^a", mc_ate.virtual_tty_name, mc_ate.virtual, mc_ate.real_tty_name, this_line, device_queue.line (this_line).line_length, device_queue.line (this_line).offset, n, line); end; nt = 0; if device_queue.line (this_line).alarm /* alarm needed */ then if mc_ate.the_system_console then call iox_$control (mc_ate.iocb, "alarm", null, code); else call timed_io_$put_chars (mc_ate.iocb, 5 * 1000 * 1000, addr (stars), length (stars), (0), code); /* allow this to wait */ device_queue.line (this_line).alarm = "0"b; if mc_ate.the_system_console then do; call iox_$put_chars (mc_ate.iocb, addcharno (linep, offset), n, code); if code = 0 then nt = n; end; else do; call timed_io_$put_chars (mc_ate.iocb, 0, addcharno (linep, offset), n, nt, code); if code = error_table_$timeout then code = 0; end; if mc_anstbl.trace then call sys_log_$error_log (SL_LOG_SILENT, code, "MC (mc_wakeups_ - typer_out)", "called put_chars nt: ^d", nt); if code ^= 0 then do; nt = 0; go to finish; end; if nt ^= n then go to finish; /* Hardcore buffers full. Can't do any more now */ last_line = this_line; /* Useful below when unchaining */ this_line = device_queue.line (this_line).next_line; /* Next message to type. */ if hismp ^= null then call check_off_message; end; device_queue.line (last_line).next_line = device_queue.free_top; /* Unchain */ device_queue.free_top = device_queue.top_of_queue; device_queue.top_of_queue = this_line; device_queue.no_of_messages = device_queue.no_of_messages - limit; if this_line = 0 then device_queue.end_of_queue = 0; else call timer_manager_$alarm_wakeup (wait_time, "11"b, /* More to do. Come back later. */ device_queue.channel); mc_ate.control.output_wait = "0"b; /* Did all wanted to do. */ goto exit; finish: if mc_anstbl.trace then call sys_log_ (SL_LOG_SILENT, "MC (mc_wakeups - finish): tty: ^a^[; physical channel: ^a^;^s^]; length: ^d; length transmitted ^d; offset: ^d", mc_ate.virtual_tty_name, mc_ate.virtual, mc_ate.real_tty_name, n, nt, offset); mc_ate.control.output_wait = "1"b; /* Tell tty_aught to wake us when hardcore ready. */ device_queue.line (this_line).offset = nt + offset; /* Remember how much got typed. */ device_queue.line (this_line).not_done = "1"b; device_queue.no_of_messages = device_queue.no_of_messages - i + 1; if last_line = 0 then goto exit; /* Stuck on first one? */ device_queue.line (last_line).next_line = device_queue.free_top; /* No. Unchain. */ device_queue.free_top = device_queue.top_of_queue; device_queue.top_of_queue = this_line; exit: if mc_ate.the_system_console then call iox_$control (mc_ate.iocb, "start", null, code); /* In case we stole a wakeup */ goto METER_EXIT; con_rec: entry (arg_event_call_info_ptr); /* This entry is called when a wakeup arrives on the console recovery event channel. The event message will contain either a positive value which is used to recover a syserr message or a negative value which will be used to retrieve the message from oc_data. This message will be sent to used to retrieve the message from oc_data. This message will be sent to mc_con_rec_ for the actual work. If the event message is zero, it means that the console has come back into operation, and console recovery is deactivated; this is all handled by mc_con_rec_. */ mc_ansp = mc_ansp_stat; event_call_info_ptr = arg_event_call_info_ptr; on any_other call as_any_other_handler_ ("mc_wakeups_$con_rec", mc_wakeups_handler_, ABORT_EXIT, ABORT_EXIT); call as_$meter_enter (MSGCORD_METER); /* meter cpu time and paging used by this procedure */ if ^mc_anstbl.con_rec.flags.enabled /* Ignore wakeup if console recovery not enabled. */ then goto METER_EXIT; call mc_con_rec_$output (event_call_info.message);/* process the message... */ goto METER_EXIT; /* ALL RETURNS MUST COME HERE TO TURN OFF METERING BEFORE RETURNING !!! */ ABORT_EXIT: METER_EXIT: call as_$meter_exit (MSGCORD_METER); /* turn off metering before returning */ return; queue_tty_message: procedure; declare SPACE_IN_A_QUEUE_ENTRY fixed bin init (131) int static options (constant); /* device_queue.string = 132, NL = 1 */ declare to_go fixed bin (21); declare to_go_1 fixed bin; declare n_sent fixed bin (21); declare max_to_send fixed bin; declare done bit (1) aligned; max_to_send = SPACE_IN_A_QUEUE_ENTRY - length (timestamp); to_go = nt; n_sent = 0; to_go_1 = 0; /**** This loop must be executed at least once to insure that blank lines are processed. Since we haven't got do until, we simulate with the "done" flag. to_go is decremented at the end of the loop so it is co-located with recalculating done. */ done = "0"b; do while (^done); to_go_1 = min (to_go, max_to_send); /* Zero is fine */ substr (tty_buffer_space, 1, length (timestamp)) = timestamp; substr (tty_buffer_space, length (timestamp) + 1, to_go_1) = substr (buffer_space, n_sent + 1, to_go_1); /* Zero length is fine */ substr (tty_buffer_space, length (timestamp) + 1 + to_go_1, 1) = byte (10); call mc_util_$queue (qp, sendalarm, addr (tty_buffer_space), to_go_1 + length (timestamp) + 1, mrt_source, code); /* l(timestamp)+ NL */ if code ^= 0 then call hphcs_$syserr_error_code (LOG, code, "mc_wakeups_", "Failed to queue message for ^a.", device_queue.mc_atep -> mc_ate.virtual_tty_name); sendalarm = "0"b; /* Once is enough per message */ hismp -> syscon_mseg.mescount = hismp -> syscon_mseg.mescount + 1; if mc_anstbl.trace then call sys_log_ (SL_LOG_SILENT, "MC (mc_wakeups_ - queue_tty_message): n_sent: ^d; to_go: ^d; to_go_1: ^d; this_line: ^a", n_sent, to_go, to_go_1, substr (tty_buffer_space, 1, to_go_1 + length (timestamp))); n_sent = n_sent + to_go_1; to_go = to_go - to_go_1; /* This many left */ done = (to_go <= 0); /* none left? Note that if to_go started as zero (a blank line), then to_go_1 will be zero, 0-0 = 0, so this terminates */ end; return; end queue_tty_message; mc_wakeups_handler_: procedure; /* This procedure is a handler for the "any_other" condition. */ /**** Nothing to do here? Not even send some protocol wakeups? */ end mc_wakeups_handler_; set_mc_message_limits: entry; dcl (argval, nargs) fixed bin; dcl l_wait_time fixed bin (71); dcl l_max_limit fixed bin; dcl ct_dly bit (1) aligned; dcl mcl_me char (24) init ("set_mc_message_limits") static options (constant); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl argp ptr, argl fixed bin (21), arg char (argl) based (argp); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl error_table_$badopt fixed bin (35) ext static; dcl error_table_$noarg fixed bin (35) ext static; l_wait_time = wait_time; l_max_limit = max_limit; call cu_$arg_count (nargs, code); if code ^= 0 then call com_err_ (code, "set_mc_message_limits"); if nargs < 1 then do; call com_err_$suppress_name (0, mcl_me, "USAGE: set_mc_message_limits {-count N} {-delay N} {-print}"); return; end; do i = 1 to nargs; call cu_$arg_ptr (i, argp, argl, code); if arg = "-count" | arg = "-ct" | arg = "-delay" | arg = "-dly" then do; i = i + 1; if i > nargs then do; call com_err_ (error_table_$noarg, mcl_me, "Following ^a.", arg); return; end; ct_dly = substr (arg, 2, 1) = "c"; call cu_$arg_ptr (i, argp, argl, code); argval = cv_dec_check_ ((arg), code); if (code ^= 0 | argval <= 0) then do; call com_err_ (0, mcl_me, "^a is not a positive decimal number", arg); return; end; if ct_dly then l_max_limit = argval; else l_wait_time = argval; end; else if arg = "-print" | arg = "-pr" then call ioa_ ("^a: Message coordinator message limit is ^d messages per ^d seconds.", mcl_me, l_max_limit, l_wait_time); else do; call com_err_ (error_table_$badopt, mcl_me, "^a", arg); return; end; end; max_limit = l_max_limit; wait_time = l_wait_time; return; set_shutdown_limits: entry; max_limit = 131071; wait_time = 1; return; trace_mrd_util_read: procedure; call sys_log_$error_log (SL_LOG_SILENT, code, "mc_wakeups_ (router)", "buffer: ^a; nt: ^d; chain: ^a; state: ^d", substr (buffer_space, 1, nt), nt, chain, state); call sys_log_ (SL_LOG_SILENT, "mc_wakeups_ (router): time ^a; from_source ^a; from_stream ^a; source_index ^d; stream_index ^d; next_message ^d; ^[continue^] ^[introduction^] ^[farewell^] ^[sentinel^]", date_time_$format ("time", message_block.time_sent, "", ""), message_block.from_source, message_block.from_stream, message_block.source_index, message_block.stream_index, message_block.next_message, message_block.continue, message_block.introduction, message_block.farewell, message_block.sentinel); call sys_log_ (SL_LOG_SILENT, "mc_wakeups_ (router): length: ^d; message ^a", message_block.length, substr (message_block.message_body, 1, message_block.length)); return; end trace_mrd_util_read; /* include files */ /* format: off */ %page; %include iox_entries; %page; %include as_meter_numbers; %page; %include syscon_mseg; %page; %include mess_route_table; %page; %include vcons_tab; %page; %include device_queue; %page; %include mc_anstbl; %page; %include cdt; %page; %include author_dcl; %page; %include event_call_info; %page; %include syserr_constants; %page; %include sys_log_constants; end mc_wakeups_;  mrd_.alm 11/05/86 1352.3r w 11/04/86 1039.3 15768 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " *********************************************************** " ****************************************************** " * * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " * * " ****************************************************** " Outer Module Transfer Vector for the mrd_ outer module. segdef mrd_module " %include stack_header; " " **********INTERNAL CODE TO GET LP (should be replaced by macro)********** mrd_module: eppbp * get ptr to this seg spribp sp|18,* store it lda sp|18,* get seg number lda sb|stack_header.lot_ptr,*au get LOT entry easplp 0,au get seg number in lp eawplp 0,al get offset in lp tra *+1,6 go to proper transfer instruction tra |[mrd_attach] tra |[mrd_detach] tra |[mrd_read] tra |[mrd_write] tra |[mrd_abort] tra |[mrd_order] tra |[mrd_resetread] tra |[mrd_resetwrite] tra |[no_entry] tra |[mrd_getsize] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[mrd_changemode] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] tra |[no_entry] end  mrd_util_.pl1 09/21/87 1958.4rew 09/21/87 1954.4 287874 /****^ *********************************************************** * * * 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(87-09-15,Parisek), approve(87-09-21,MECR0008), audit(87-09-21,GDixon), install(87-09-21,MR12.1-1114): On any_other conditions report condition name, reset the message segment header, unlock the message segment if locked and return to caller with an error code instead of terminating the process. (phx20928) END HISTORY COMMENTS */ /* format: style4 */ mrd_util_: procedure; /* MRD_UTIL_ - This procedure contains all code which must deal with a message coordinator "message" segment in a consistent fashion. This is the only program which locks and unlocks these segments. */ /* Coded by Dennis Capps, July 1972 Modified by J. C. Whitmore, Aug 1975 to return event chan on each read_status call. Rewritten 751223 by PG Modified 6/8/83 by E. N. Kittlitz to fix uninitialized variable used by cleanup. Modified 1985-03-11 by E. Swenson to fix locking code and add cleanup handler. */ /* builtins */ dcl (addr, clock, divide, index, min, null, string, substr) builtin; /* parameters */ dcl (tp ptr, /* ptr to Stream Data Block */ workp ptr, /* ptr to I/O workspace for transfer */ first_char fixed bin, /* Offset from base of users workspace */ nchar fixed bin, /* Number of characters to be transferred */ nchart fixed bin, /* Number of characters actually transferred */ state fixed bin, /* 0 -- end of data,1 -- more to message. */ code fixed bin (35), /* error code */ reqsw fixed bin, /* what to abort */ request char (*) /* What kind of protocol request */ ) parameter; /* Automatic */ dcl dont_flood bit (1) aligned init ("0"b); /* TRUE = may go into output wait */ dcl lock_ptr ptr init (null); /* ptr to message seg we have locked */ dcl lock_set bit (1) aligned init (""b); /* ON if we have lock set */ dcl mask bit (36) aligned init (""b), /* IPS Mask */ my_name char (32) varying, ourmp ptr, /* Pointer to message seg for this function */ recursion fixed bin initial (0), hismp ptr, /* Pointer to message seg for destination func. */ messp ptr, messp1 ptr, thatp ptr, /* Used in transferring characters. */ thisp ptr, /* Used in transferring characters. */ chainp ptr, /* Points to head & tail info for current chain */ mp ptr, wake_up_chan fixed bin (71), /* How to tell him message deposited */ event_mess fixed bin (71), /* Give inkling of whats happening */ i fixed bin, /* A temporary index */ autocode fixed bin (35), /* Error code */ this_message fixed bin, /* Message block currently under inspection */ begin_this fixed bin, /* First block of this message */ end_this fixed bin, /* last block of this message */ prev_message fixed bin, /* Message block previously under inspection */ time fixed bin (71), /* Current time (postmark) */ n fixed bin, /* Temporaries of a dedicated nature */ no_of_blocks fixed bin, len fixed bin; dcl ipc_mask_code fixed bin (35); dcl ipc_unmask_code fixed bin (35); dcl 1 ci aligned like condition_info; /* Condition info */ dcl 1 message_type, 2 continue bit (1), /* Message continued in next block */ 2 introduction bit (1), /* This is an introductory message */ 2 farewell bit (1), /* " " farewell " */ 2 sentinel bit (1), /* Don't print time at front of this one */ 2 unused bit (32); dcl 1 terminate_info structure aligned, 2 version fixed bin, 2 code fixed bin (35); /* based */ dcl 1 chain based (chainp), 2 chain_head fixed bin, /* first_message or first_proto */ 2 chain_tail fixed bin; /* last_message or last_proto */ dcl based_mess char (len) based (thatp), /* For transferring characters */ char_array (buff_len) char (1) based (thisp), /* For updating thisp */ char_event_mess char (8) based, /* Goes with event_mess */ this_batch char (len) based (thisp); /* For transferring characters */ dcl 1 SDB based (tp) aligned, /* one entry in list of stream control blocks */ 2 dim_name char (32), /* the name of this DIM */ 2 device_name_list ptr, /* threaded list of device id's */ 2 next_device ptr, /* pointer to next entry in threaded list */ 2 device_name_size fixed bin, /* number of chars in device name */ 2 device_name char (32), /* device id */ 2 pad1 fixed bin, 2 ipc_ep ptr, /* to normal event list for read block */ 2 proto_ep ptr, /* to protocol event list for att & det */ 2 nextp ptr, /* pointer to next stream block in chain */ 2 ourmess ptr, /* Pointer to mseg for this function */ 2 hismess ptr, /* Pointer to mseg for message coord'r */ 2 source char (32), /* symbolic name of I/O source */ 2 stream char (32), /* symbolic name of I/O stream */ 2 source_index fixed bin, /* in MRT */ 2 stream_index fixed bin, 2 flags, 3 valid bit (1) unal, /* "1"b = entry-in-use, "0"b = not_in_use */ 3 read bit (1) unal, /* "1"b = stream attached for reading. */ 3 write bit (1) unal, /* "1"b = stream attached for writing. */ 3 active bit (1) unal, /* For compatibility with message_coordr_ */ 3 more bit (1) unal, /* "1"b = More text in this message than we've given */ 3 unused bit (31) unal, 2 prev_trans, 3 first_block fixed bin, 3 end_block fixed bin, 3 current_block fixed bin, 3 offset fixed bin; /* Entries */ dcl continue_to_signal_ entry (fixed bin (35)), find_condition_info_ entry (ptr, ptr, fixed bin(35)), get_process_id_ entry () returns (bit (36) aligned), hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned), hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned), hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)), ipc_$drain_chn entry (fixed bin (71), fixed bin (35)), ipc_$mask_ev_calls entry (fixed bin (35)), ipc_$unmask_ev_calls entry (fixed bin (35)), phcs_$ring_0_message ext entry (char (*)), set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)), set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); dcl terminate_process_ entry (char (*), ptr); /* internal static */ dcl (my_process_id bit (36) aligned initial ((18)"10"b), thirty_seconds fixed bin init (30) options (constant), /* How long before set_lock_ gives up */ NL char (1) initial (" "), LIMIT fixed bin init (10), /* Max # lines queued but not printed */ OWAIT fixed bin init (123) /* Err code to mrdim_ => output wait */ ) internal static; /* external static */ dcl error_table_$argerr fixed bin (35) external; dcl error_table_$lock_wait_time_exceeded fixed bin (35) external; dcl error_table_$invalid_lock_reset fixed bin (35) external; dcl error_table_$locked_by_this_process fixed bin (35) external; dcl error_table_$no_message fixed bin (35) external; dcl error_table_$unable_to_do_io fixed bin (35) external; /* Conditions */ dcl any_other condition; dcl cleanup condition; %page; /* Program */ protocol: entry (tp, workp, first_char, nchar, nchart, request, code); /* This entry helps a function to do certain things to make the interaction with the message coordinator go smoothly */ my_name = "mrd_util_$protocol"; string (message_type) = ""b; hismp = SDB.hismess; addr (event_mess) -> char_event_mess = request; if request = "attach" then do; my_process_id = get_process_id_ (); /* this is the first call to this program... */ wake_up_chan = hismp -> syscon_mseg.proto_el.channel; message_type.introduction = "1"b; chainp = addr (hismp -> syscon_mseg.first_proto); end; else if request = "sentinel" then do; wake_up_chan = hismp -> syscon_mseg.ipc_el.channel; message_type.sentinel = "1"b; chainp = addr (hismp -> syscon_mseg.first_message); end; else if request = "detach" then do; wake_up_chan = hismp -> syscon_mseg.proto_el.channel; message_type.farewell = "1"b; chainp = addr (hismp -> syscon_mseg.first_proto); end; else do; code = error_table_$argerr; return; end; go to common_write; /* This is the ordinary entry for writing. */ write_dont_flood: entry (tp, workp, first_char, nchar, nchart, state, code); dont_flood = "1"b; write: entry (tp, workp, first_char, nchar, nchart, state, code); mask = ""b; on any_other call ANY_OTHER_HANDLER (); my_name = "mrd_util_$write"; string (message_type) = ""b; hismp = SDB.hismess; wake_up_chan = hismp -> syscon_mseg.ipc_el.channel; addr (event_mess) -> char_event_mess = "normal"; chainp = addr (hismp -> syscon_mseg.first_message); ourmp = SDB.ourmess; if dont_flood & (hismp -> syscon_mseg.current_process_id ^= ourmp -> syscon_mseg.current_process_id) & (ourmp -> syscon_mseg.mescount >= LIMIT | ourmp -> syscon_mseg.output_wait) then do; ourmp -> syscon_mseg.output_wait = "1"b; code = OWAIT; return; end; ourmp -> syscon_mseg.mescount = ourmp -> syscon_mseg.mescount + 1; common_write: ourmp = SDB.ourmess; nchart = 0; /* A couple of initializations. */ code = 0; lock_set = "0"b; /* for cleanup handler */ lock_ptr = null (); /* for cleanup handler */ ipc_mask_code, ipc_unmask_code = -1; on condition (cleanup) call CLEAN_UP (); call LOCK (hismp, code); /* lock the message segment (shared amoung many processes) */ if code ^= 0 then return; /* Now that the seg is locked, calculate how many blocks we need for this message. Grab them. Unlock the seg and we can fill them at our leisure. */ no_of_blocks = divide (nchar + buff_len - 1, buff_len, 17, 0); message_type.continue = "1"b; do n = 1 to no_of_blocks; if hismp -> syscon_mseg.first_free_buffer = 0 then do; hismp -> syscon_mseg.last_assigned_buffer = hismp -> syscon_mseg.last_assigned_buffer + 1; this_message = hismp -> syscon_mseg.last_assigned_buffer; end; else do; this_message = hismp -> syscon_mseg.first_free_buffer; hismp -> syscon_mseg.first_free_buffer = hismp -> syscon_mseg.message (this_message).next_message; end; if n = 1 then begin_this = this_message; else hismp -> syscon_mseg.message (prev_message).next_message = this_message; prev_message = this_message; hismp -> syscon_mseg.message (this_message).next_message = 0; string (hismp -> syscon_mseg.message (this_message).flags) = string (message_type); end; hismp -> syscon_mseg.message (this_message).flags.continue = "0"b; end_this = this_message; call UNLOCK (hismp); /* Now fill in the message blocks */ len = min (nchar, buff_len); thisp = workp; thisp = addr (char_array (first_char + 1)); /* +1 because its really an offset */ time = clock (); this_message = begin_this; do n = 1 to no_of_blocks; hismp -> syscon_mseg.message (this_message).time_sent = time; hismp -> syscon_mseg.message (this_message).from_source = SDB.source; hismp -> syscon_mseg.message (this_message).from_stream = SDB.stream; hismp -> syscon_mseg.message (this_message).source_index = SDB.source_index; hismp -> syscon_mseg.message (this_message).stream_index = SDB.stream_index; hismp -> syscon_mseg.message (this_message).message_body = this_batch; hismp -> syscon_mseg.message (this_message).length = len; thisp = addr (char_array (len + 1)); /* Update pointer & indeces */ nchart = nchart + len; len = min (nchar - nchart, buff_len); this_message = hismp -> syscon_mseg.message (this_message).next_message; end; /* Lock the segment again, stick in the message, &unlock */ call LOCK (hismp, code); if code ^= 0 then do; /* Woops. Cannot lock seg to chain in. */ nchart = 0; /* Pretend we didn't write at all */ return; /* Some storage in message seg will be lost. */ end; call VALIDATE_CHAIN (hismp, chainp, "write-2"); if chain.chain_head = 0 /* Hook this into the proper message queue */ then chain.chain_head = begin_this; else hismp -> syscon_mseg.message (chain.chain_tail).next_message = begin_this; chain.chain_tail = end_this; call UNLOCK (hismp); /* Now wakeup other guy so he knows to look for what we just gave him. */ call hcs_$wakeup (hismp -> syscon_mseg.current_process_id, wake_up_chan, event_mess, autocode); return; %page; discard_remainder: entry (tp, state, code); mask = ""b; on any_other call ANY_OTHER_HANDLER (); my_name = "mrd_util_$discard_remainder"; ourmp = SDB.ourmess; begin_this = SDB.prev_trans.first_block; end_this = SDB.prev_trans.end_block; code = 0; go to free_current_chain; %page; read: entry (tp, workp, first_char, nchar, nchart, request, mp, state, code); mask = ""b; on any_other call ANY_OTHER_HANDLER (); my_name = "mrd_util_$read"; messp1 = mp; nchart = 0; code = 0; end_this = SDB.prev_trans.end_block; begin_this = SDB.prev_trans.first_block; ourmp = SDB.ourmess; if request = "proto" then chainp = addr (ourmp -> syscon_mseg.first_proto); else chainp = addr (ourmp -> syscon_mseg.first_message); if SDB.flags.more then goto get_message; /* Unhook the blocks for this message (locking the seg first) */ lock_set = "0"b; /* for cleanup handler */ lock_ptr = null (); /* for cleanup handler */ ipc_mask_code, ipc_unmask_code = -1; on condition (cleanup) call CLEAN_UP (); call LOCK (ourmp, code); if code ^= 0 then return; call VALIDATE_CHAIN (ourmp, chainp, "read-1"); SDB.prev_trans.offset = 0; if chain.chain_head = 0 then do; /* Nothing in queue */ code = error_table_$no_message; go to read_return; end; SDB.prev_trans.first_block, SDB.prev_trans.current_block, begin_this, this_message = chain.chain_head; no_of_blocks = 1; do while (ourmp -> syscon_mseg.message (this_message).continue); this_message = ourmp -> syscon_mseg.message (this_message).next_message; no_of_blocks = no_of_blocks + 1; end; SDB.prev_trans.end_block, end_this = this_message; chain.chain_head = ourmp -> syscon_mseg.message (this_message).next_message; if end_this = chain.chain_tail then chain.chain_tail = 0; call UNLOCK (ourmp); messp = addr (ourmp -> syscon_mseg.message (begin_this)); messp1 -> message_block.time_sent = message_block.time_sent; messp1 -> message_block.from_source = message_block.from_source; messp1 -> message_block.from_stream = message_block.from_stream; messp1 -> message_block.source_index = message_block.source_index; messp1 -> message_block.stream_index = message_block.stream_index; string (messp1 -> message_block.flags) = string (message_block.flags); get_message: /**** Extract the message */ thisp = workp; thisp = addr (char_array (first_char + 1)); this_message = SDB.prev_trans.current_block; len = min (nchar, ourmp -> syscon_mseg.message (this_message).length - SDB.prev_trans.offset); thatp = addr (ourmp -> syscon_mseg.message (this_message).message_body); thatp = addr (thatp -> char_array (SDB.prev_trans.offset + 1)); do while (ourmp -> syscon_mseg.message (this_message).continue); i = index (based_mess, NL); if i ^= 0 then len = i; this_batch = based_mess; nchart = nchart + len; if SDB.prev_trans.offset + len = ourmp -> syscon_mseg.message (this_message).length then do; SDB.prev_trans.offset = 0; this_message, SDB.prev_trans.current_block = ourmp -> syscon_mseg.message (this_message).next_message; end; else do; SDB.prev_trans.offset = SDB.prev_trans.offset + len; goto theres_more; end; if nchart = nchar then goto theres_more; thatp = addr (ourmp -> syscon_mseg.message (this_message).message_body); thisp = addr (char_array (len + 1)); len = min (nchar - nchart, ourmp -> syscon_mseg.message (this_message).length); end; i = index (based_mess, NL); if i ^= 0 then len = i; this_batch = based_mess; nchart = nchart + len; SDB.prev_trans.offset = SDB.prev_trans.offset + len; if SDB.prev_trans.offset ^= ourmp -> syscon_mseg.message (this_message).length then do; theres_more: state = 1; SDB.flags.more = "1"b; return; end; /* Put used blocks back on the free storage list */ free_current_chain: SDB.flags.more = "0"b; state = 0; if begin_this = 0 then return; if end_this = 0 then do; call COMPLAIN (ourmp, "inconsistent threads"); call SAVE_STATE (ourmp); return; end; call LOCK (ourmp, code); if code ^= 0 then return; ourmp -> syscon_mseg.message (end_this).next_message = ourmp -> syscon_mseg.first_free_buffer; ourmp -> syscon_mseg.first_free_buffer = begin_this; read_return: SDB.prev_trans.first_block = 0; SDB.prev_trans.end_block = 0; call UNLOCK (ourmp); return; %page; read_status: entry (tp, statusp, code); /**** entry to look at read ahead */ dcl 1 status_struct aligned based (statusp), 2 ev_chan fixed bin (71), 2 input_available bit (1); dcl statusp ptr; ourmp = SDB.ourmess; /* get ptr to our msg seg */ chainp = addr (ourmp -> syscon_mseg.first_message); /* get ptr to chain of messages */ status_struct.ev_chan = ourmp -> syscon_mseg.ipc_el.channel; if chain.chain_head = 0 then /* no chain, no input now */ status_struct.input_available = "0"b; /* say no input */ else status_struct.input_available = "1"b; return; %page; abort: entry (tp, reqsw, state, code); mask = ""b; on any_other call ANY_OTHER_HANDLER (); my_name = "mrd_util_$abort"; ourmp = SDB.ourmess; hismp = SDB.hismess; lock_set = "0"b; /* for cleanup handler */ lock_ptr = null (); /* for cleanup handler */ ipc_mask_code, ipc_unmask_code = -1; on condition (cleanup) call CLEAN_UP (); if reqsw = 1 | reqsw = 3 then do; /* reset_read ==> wipe out messages in our seg */ call LOCK (ourmp, code); if code ^= 0 then return; ourmp -> syscon_mseg.first_message, ourmp -> syscon_mseg.last_message, ourmp -> syscon_mseg.first_proto, ourmp -> syscon_mseg.last_proto = 0; call ipc_$drain_chn (ourmp -> syscon_mseg.ipc_el.channel, autocode); call ipc_$drain_chn (ourmp -> syscon_mseg.proto_el.channel, autocode); call UNLOCK (ourmp); end; if reqsw = 2 | reqsw = 3 then do; /* reset_write ==> wipe out messages from us in mc's seg */ call LOCK (hismp, code); if code ^= 0 then return; do i = 1 to 2; /* look in both chains */ prev_message = 0; if i = 1 then chainp = addr (hismp -> syscon_mseg.first_message); else chainp = addr (hismp -> syscon_mseg.first_proto); call VALIDATE_CHAIN (hismp, chainp, "abort-1"); this_message = chain.chain_head; do while (this_message ^= 0); /* look for messages from us */ if hismp -> syscon_mseg.message (this_message).from_source = SDB.source then if hismp -> syscon_mseg.message (this_message).from_stream = SDB.stream then do; /* found one */ begin_this = this_message; /* Loop looking for end of message */ do while (hismp -> syscon_mseg.message (this_message).continue); this_message = hismp -> syscon_mseg.message (this_message).next_message; end; end_this = this_message; if prev_message = 0 then chain_head, this_message = hismp -> syscon_mseg.message (end_this).next_message; else hismp -> syscon_mseg.message (prev_message).next_message, this_message = hismp -> syscon_mseg.message (end_this).next_message; if end_this = chain_tail then chain_tail = prev_message; hismp -> syscon_mseg.message (end_this).next_message = hismp -> syscon_mseg.first_free_buffer; hismp -> syscon_mseg.first_free_buffer = begin_this; end; else do; skipover: do while (hismp -> syscon_mseg.message (this_message).continue); this_message = hismp -> syscon_mseg.message (this_message).next_message; end; this_message = hismp -> syscon_mseg.message (this_message).next_message; end; else go to skipover; /* sources don't match */ end; call VALIDATE_CHAIN (hismp, chainp, "abort-2"); end; ourmp -> syscon_mseg.mescount = 0; ourmp -> syscon_mseg.output_wait = "0"b; call UNLOCK (hismp); end; return; %page; LOCK: procedure (bv_lock_ptr, bv_lock_code); /* parameters */ dcl (bv_lock_ptr ptr, bv_lock_code fixed bin (35)) parameter; /* automatic */ dcl lock_code fixed bin (35); lock_set = "0"b; /* we're not really locked yet */ lock_ptr = bv_lock_ptr; /* remember which lock we're locking */ call ipc_$mask_ev_calls (ipc_mask_code); /* mask ipc calls */ call hcs_$set_ips_mask (""b, mask); /* mask ips interrupts */ locking_loop: call set_lock_$lock (lock_ptr -> syscon_mseg.mlock, thirty_seconds, lock_code); if lock_code ^= 0 then if lock_code = error_table_$lock_wait_time_exceeded then do; call SAVE_STATE (lock_ptr); lock_ptr -> syscon_mseg.mlock = "0"b; /* This is naughty but may save a crash. */ call COMPLAIN (lock_ptr, "had to blast lock"); goto locking_loop; end; else if lock_code = error_table_$invalid_lock_reset then do; call COMPLAIN (lock_ptr, "reset bad lock"); call SAVE_STATE (lock_ptr); end; else if lock_code = error_table_$locked_by_this_process then do; call COMPLAIN (lock_ptr, "killing process due to mylock error"); call SAVE_STATE (lock_ptr); terminate_info.version = 0; terminate_info.code = lock_code; do while ("1"b); call terminate_process_ ("fatal_error", addr (terminate_info)); end; end; else do; bv_lock_code = lock_code; call hcs_$reset_ips_mask (mask, mask); call ipc_$unmask_ev_calls (ipc_unmask_code); return; end; lock_ptr -> syscon_mseg.locked_by_pid = my_process_id; lock_set = "1"b; bv_lock_code = 0; return; end LOCK; %page; UNLOCK: procedure (bv_unlock_ptr); /* parameters */ dcl bv_unlock_ptr ptr parameter; /* automatic */ dcl unlock_ptr ptr; /* program */ unlock_ptr = bv_unlock_ptr; /* remember what we're unlocking */ lock_set = "0"b; /* Turn off now to avoid bad window */ lock_ptr = null (); call set_lock_$unlock (unlock_ptr -> syscon_mseg.mlock, autocode); call hcs_$reset_ips_mask (mask, mask); call ipc_$unmask_ev_calls (ipc_unmask_code); return; end UNLOCK; SAVE_STATE: procedure (bv_seg_ptr); /* parameters */ dcl bv_seg_ptr ptr parameter; /* automatic */ dcl (p, segp) ptr; /* program */ segp = bv_seg_ptr; segp -> syscon_mseg.last_assigned_buffer = segp -> syscon_mseg.last_assigned_buffer + 1; p = addr (segp -> syscon_mseg.message (segp -> syscon_mseg.last_assigned_buffer)); p -> debug_info.flag = -1; p -> debug_info.time = clock (); p -> debug_info.last_pid = segp -> syscon_mseg.locked_by_pid; p -> debug_info.first_msg = segp -> syscon_mseg.first_message; p -> debug_info.last_msg = segp -> syscon_mseg.last_message; p -> debug_info.first_pro = segp -> syscon_mseg.first_proto; p -> debug_info.last_pro = segp -> syscon_mseg.last_proto; p -> debug_info.free_chain = segp -> syscon_mseg.first_free_buffer; end SAVE_STATE; VALIDATE_CHAIN: procedure (bv_seg_ptr, bv_chain_ptr, bv_where); /* parameters */ dcl (bv_chain_ptr ptr, bv_seg_ptr ptr, bv_where char (*)) parameter; /* automatic */ dcl (last_msgx, msgs_scanned, msgx) fixed bin; dcl (chain_ptr, msgp, segp) ptr; dcl why char (64) varying; /* based */ dcl 1 chain based (chain_ptr) aligned, 2 head fixed bin, 2 tail fixed bin; /* program */ segp = bv_seg_ptr; chain_ptr = bv_chain_ptr; if chain.head = 0 & chain.tail = 0 then return; if chain.head = 0 & chain.tail ^= 0 then do; why = "(head = 0 but tail ^= 0)"; go to die; end; if chain.head ^= 0 & chain.tail = 0 then do; why = "(head ^= 0 but tail = 0)"; go to die; end; last_msgx = -1; msgs_scanned = 0; do msgx = chain.head repeat (msgp -> message_block.next_message) while (msgx ^= 0); if msgs_scanned > 4662 then do; why = "(loop in chain)"; go to die; end; msgs_scanned = msgs_scanned + 1; if msgx <= 0 | msgx > min (segp -> syscon_mseg.last_assigned_buffer, 4662) then do; why = "(msg index out of range)"; go to die; end; if last_msgx = msgx then do; why = "(chain loops onto self)"; go to die; end; msgp = addr (segp -> syscon_mseg.message (msgx)); last_msgx = msgx; end; if chain.tail ^= last_msgx then do; why = "(chain.tail doesn't point to last msg)"; go to die; end; return; die: call SAVE_STATE (segp); call RESET_HEADER (segp); call COMPLAIN (segp, bv_where || " " || why); end VALIDATE_CHAIN; COMPLAIN: procedure (bv_complaint_ptr, bv_complaint); /* parameters */ dcl (bv_complaint char (*), bv_complaint_ptr ptr) parameter; /* automatic */ dcl complaint_ptr ptr, dname char (168), dname_len fixed bin, ename char (32); /* program */ complaint_ptr = bv_complaint_ptr; call hcs_$fs_get_path_name (complaint_ptr, dname, dname_len, ename, (0)); call phcs_$ring_0_message (my_name || ": " || bv_complaint || " in " || ename); end COMPLAIN; RESET_HEADER: procedure (bv_reset_ptr); /* parameters */ dcl bv_reset_ptr ptr parameter; /* automatic */ dcl reset_ptr ptr; /* program */ reset_ptr = bv_reset_ptr; reset_ptr -> syscon_mseg.first_message = 0; /* zap msg chain */ reset_ptr -> syscon_mseg.last_message = 0; reset_ptr -> syscon_mseg.first_proto = 0; /* zap protocol chain */ reset_ptr -> syscon_mseg.last_proto = 0; reset_ptr -> syscon_mseg.first_free_buffer = 0; /* zap free chain */ reset_ptr -> syscon_mseg.last_assigned_buffer = 0; end RESET_HEADER; %page; RETURN: /**** any_other handler comes here. */ return; %page; ANY_OTHER_HANDLER: procedure (); /**** This procedure is the any_other handler for mrd_util_. We report the find of condition, reset the message segment header elements, unlock the message segment if locked and return to mrd_ with an error status code. */ call find_condition_info_ (null, addr(ci), code); if code = 0 then do; call COMPLAIN (lock_ptr, "Condition encountered: "||ci.condition_name); if ci.condition_name = "out_of_bounds" then do; if lock_ptr ^= null & lock_ptr ^= hismp then call RESET_HEADER (lock_ptr); /* lock_ptr probably mc.message pointer anyway */ else call RESET_HEADER (hismp); /* mc.message */ end; end; if lock_ptr ^= null then call UNLOCK (lock_ptr); code = error_table_$unable_to_do_io; goto RETURN; end ANY_OTHER_HANDLER; %page; CLEAN_UP: procedure (); if lock_set then do; call set_lock_$unlock (lock_ptr -> syscon_mseg.mlock, (0)); lock_set = "0"b; lock_ptr = null (); end; if substr (mask, 36, 1) = "1"b then /* we were masked */ call hcs_$reset_ips_mask (mask, mask); if ipc_mask_code ^= -1 & ipc_unmask_code = -1 then call ipc_$unmask_ev_calls (ipc_unmask_code); return; end CLEAN_UP; /* format: off */ %page; %include condition_info; %page; %include syscon_mseg; /* format: on */ /* BEGIN MESSAGE DOCUMENTATION Message: mrd_util_$ENTRY: CALL_CODE (MESSAGE) in ENAME S: $beep T: $run M: A problem has been discovered in the threading of the message coordinator segment ENAME. CALL_CODE identifies the particular call that failed, and MESSAGE identifies the reason for the failure. Entry identifies the entrypoint in mrd_util_ that was called. All pending messages in ENAME are discarded. Debugging information is written into ENAME, and may be displayed using the dump_syscon_mseg tool. The message coordinator recovers from these errors and continues, possibly with the loss of some input or output. If ENAME is mc.message, some daemon output may be lost. If ENAME is anything else, some input to that daemon may be lost, and the operator should communicate with the daemon immediately, in case this has happened. $err A: $inform Save all console and message coordinator terminal output. Message: mrd_util_$ENTRY: had to blast lock in ENAME S: $beep T: $run M: The lock in the message coordinator segment ENAME did not unlock within thirty seconds. The lock is reset forcibly, and locked to the calling process. ENTRY identifies the entrypoint in mrd_util_ that was called. Debugging information is written into ENAME, and may be displayed using the dump_syscon_mseg tool. Further errors may result if the process that originally locked the segment left it in an inconsistent state, or if it later starts up again. A: $inform Save all console and message coordinator terminal output. Message: mrd_util_$ENTRY: reset bad lock in ENAME S: $beep T: $run M: The message coordinator segment ENAME was locked to a nonexistent process. The lock is reset and locked to the calling process. ENTRY identifies the entrypoint in mrd_util_ that was called. Debugging information is written into ENAME, and may be displayed using the dump_syscon_mseg tool. Further errors may be reported if ENAME was in an inconsistent state. A: $inform Save all console and message coordinator terminal output. Message: mrd_util_$ENTRY: killing process due to mylock error in ENAME S: $term T: $run M: While trying to lock the message coordinator segment ENAME, the lock was found to already be locked to the calling process. ENTRY identifies the entrypoint in mrd_util_ that was called. Debugging information is written into ENAME, and may be displayed using the dump_syscon_mseg tool. $err A: $inform Save all console and message coordinator terminal output. Message: mrd_util_$ENTRY: inconsistent threads in ENAME S: $beep T: $run M: While trying to add unused blocks to the free chain in the message coordinator segment ENAME, an error was discovered. ENTRY identifies the entrypoint in mrd_util_ that was called. Debugging information is written into ENAME, and may be displayed using the dump_syscon_mseg tool. $err A: $inform Save all console and message coordinator terminal output. Message: Error: CONDITION in mrd_util_$ENTRY S: $beep T: $run M: CONDITION was signalled during a call to the entrypoint ENTRY in mrd_util_. A message coordinator dump is taken. If the calling process had a message coordinator segment locked, that segment is checked for consistency, and the lock is unlocked. mrd_util_ then returns to its caller without retrying the operation that failed. $err A: $inform Save all console and message coordinator terminal output. END MESSAGE DOCUMENTATION */ end mrd_util_;  mrdim_.pl1 09/21/87 1958.4rew 09/21/87 1954.7 267309 /****^ *********************************************************** * * * 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(87-06-10,Parisek), approve(87-06-12,MCR7690), audit(87-06-12,Martinson), install(87-09-10,MR12.1-1104): Corrected a stringsize problem. 2) change(87-09-08,Parisek), approve(87-09-08,MECR0005), audit(87-09-09,GDixon), install(87-09-10,MR12.1-1104): Expand "quit_mask" field to 504 bits from 72 bits for supporting QUITs to a larger array of daemons. 3) change(87-09-17,Parisek), approve(87-09-21,MECR0008), audit(87-09-21,GDixon), install(87-09-21,MR12.1-1114): Return with error if status code equals error_table_$unable_to_do_io from calling mrd_util_. This status code represents a condition error signalled from mrd_util_. (phx20928) END HISTORY COMMENTS */ mrdim_: proc; return; /* this is an undefined entry */ /* MRDIM_ - message routing DIM. This module replaces "ttydim_" for daemon processes which do not have stream terminals. It sends messages to and gets messages from a message coordinator which is part of the system control process group. The initializer may operate several consoles and route messages to them as it pleases. Coded by THVV from Feiertag's "ttydim_" Modified by Dennis Capps Attach entry modified for the access isolation mechanism on 10/16/74 - J. Whitmore Modified by J. C. Whitmore, 10/78, to zero words on first attach instead of calling hcs_$truncate_seg (BUG writearound) Modified by B. Margulies 11/81 for -login_channel. */ dcl (addr, index, length, null, size, string, substr, rtrim) builtin; dcl (tp, sp, vp, p) ptr, /* temporary storage */ (state, n, nt, k, rw) fixed bin init (0), code fixed bin (35), em (4) fixed bin (71); dcl sysdir char (168) int static init (">system_control_1"), /* The directory in which to find the tables */ RINGS (3) fixed bin (6) int static options (constant) init (4, 4, 4), OWAIT fixed bin static options (constant) init (123), /* err code from mrdi_util_ */ pigeon_hole char (32) init (""), USERID char (32), message char (132); dcl ourmp ptr, /* Pointer to mseg for this function */ mcmp ptr int static, /* pointer to mseg for message coord'r */ messp ptr int static init (null); /* Periferal info on read. */ dcl need_priv bit (1) int static init ("0"b), /* switch for using privileges */ mask bit (36) aligned init ("0"b), /* ips mask temporary */ created_seg bit (1) init ("0"b), init bit (1) int static init ("0"b), leave_locked bit (1) init ("0"b), quit_mask bit (504)int static init ("0"b), source_init bit (1) init ("0"b), testing bit (1) int static init ("0"b), wrote_sentinel bit (1) init ("0"b); dcl lock_wait_time fixed bin init (300), i fixed bin, lcode fixed bin (35) init (0), level fixed bin, reset_priv fixed bin (35); dcl 1 based_mrt_index based (p), 2 dummy fixed bin (71), 2 mrt_source fixed bin (35), 2 mrt_stream fixed bin (35); declare 1 dump int static aligned like message_block; dcl 1 first_SDB int static aligned, /* The first stream data block in the stream data list for this process. */ 2 dim_name char (32), /* the name of this DIM */ 2 device_name_list ptr, /* threaded list of device id's */ 2 next_device ptr, /* pointer to next entry in threaded list */ 2 device_name_size fixed bin, /* number of chars in device name */ 2 device_name char (32), /* device id */ 2 pad1 fixed bin, 2 ipc_ep ptr, /* to event list for block in read */ 2 proto_ep ptr, /* to event list for block in att & det */ 2 nextp ptr init (null), /* pointer to next stream block in chain */ 2 ourmess ptr, /* Pointer to mseg for this function */ 2 hismess ptr, /* Pointer to mseg for message coord'r */ 2 source char (32), /* symbolic name of I/O source */ 2 stream char (32), /* symbolic name of I/O stream */ 2 source_index fixed bin, /* in MRT */ 2 stream_index fixed bin, 2 flags, 3 valid bit (1) unal init ("0"b), /* "1"b = entry-in-use, "0"b = not_in_use */ 3 read bit (1) unal, /* "1"b = stream attached for reading. */ 3 write bit (1) unal, /* "1"b = stream attached for writing. */ 3 active bit (1) unal, /* For compatibility with message_coordr_ */ 3 more bit (1) unal, /* "1"b = More text in this message than we've given */ 3 unused bit (31)unal, 2 prev_trans, 3 first_block fixed bin, 3 end_block fixed bin, 3 current_block fixed bin, 3 offset fixed bin; dcl 1 SDB based (tp) aligned, /* one entry in list of stream control blocks */ 2 dim_name char (32), /* the name of this DIM */ 2 device_name_list ptr, /* threaded list of device id's */ 2 next_device ptr, /* pointer to next entry in threaded list */ 2 device_name_size fixed bin, /* number of chars in device name */ 2 device_name char (32), /* device id */ 2 pad1 fixed bin, 2 ipc_ep ptr, /* to event list for block in read */ 2 proto_ep ptr, /* to event list for block in att & det */ 2 nextp ptr, /* pointer to next stream block in chain */ 2 ourmess ptr, /* Pointer to mseg for this function */ 2 hismess ptr, /* Pointer to mseg for message coord'r */ 2 source char (32), /* symbolic name of I/O source */ 2 stream char (32), /* symbolic name of I/O stream */ 2 source_index fixed bin, /* in MRT */ 2 stream_index fixed bin, 2 flags, 3 valid bit (1) unal, /* "1"b = entry-in-use, "0"b = not_in_use */ 3 read bit (1) unal, /* "1"b = stream attached for reading. */ 3 write bit (1) unal, /* "1"b = stream attached for writing. */ 3 active bit (1) unal, /* For compatibility with message_coordr_ */ 3 more bit (1) unal, /* "1"b = More text in this message than we've given */ 3 unused bit (31)unal, 2 prev_trans, 3 first_block fixed bin, 3 end_block fixed bin, 3 current_block fixed bin, 3 offset fixed bin; % include line_types; % include syscon_mseg; % include tty_types; dcl 1 st based (sp) aligned, /* breakdown of I/O system status word */ 2 code fixed bin (35), /* error status code (0 = OK) */ 2 comp bit (4) unaligned, /* completion status, LI, LC, PI, PC */ 2 eof bit (1) unaligned, /* end-of-file */ 2 pad1 bit (4) unaligned, 2 eod bit (1) unaligned, /* end of physical data */ 2 pad2 bit (4) unaligned, 2 abs bit (1) unaligned, 2 det bit (1) unaligned, /* detach flag */ 2 quit bit (1) unaligned, /* quit flag */ 2 abort bit (1) unaligned, /* abort flag */ 2 callx bit (18) unaligned; /* rel pointer to last transaction */ dcl acc_mode fixed bin (35); /* mode to satisfy the compiler */ dcl 1 syscon_template aligned based, /* overlay for xxx.message to truncate above system_low AIM */ 2 lock_word fixed bin (35), 2 words (2047) fixed bin (35); /* two pages worth of stuff to zero out */ dcl 1 access based (addr (acc_mode)), 2 access_pad bit (32) unaligned, 2 R bit (1) unaligned, /* the READ bit for the access mode */ 2 E bit (1) unaligned, /* the EXECUTE bit... */ 2 W bit (1) unaligned, /* the WRITE bit.... */ 2 A bit (1) unaligned; /* the APPEND bit (obsolete for segs)... */ dcl com_err_ ext entry options (variable), continue_to_signal_ entry (fixed bin (35)), cu_$cl ext entry, cu_$level_get entry () returns (fixed bin), get_process_id_ ext entry returns (bit (36) aligned), ioa_$rs ext entry options (variable), get_group_id_$tag_star ext entry () returns (char (32)), ipc_$create_ev_chn ext entry (fixed bin (71), fixed bin (35)), ipc_$block ext entry (ptr, ptr, fixed bin (35)), ipc_$mask_ev_calls ext entry (fixed bin (35)), ipc_$unmask_ev_calls ext entry (fixed bin (35)), hcs_$append_branchx ext entry (char (*), char (*), fixed bin (5), (3) fixed bin (6), char (*), fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)), hcs_$assign_linkage ext entry (fixed bin, ptr, fixed bin (35)), hcs_$fs_get_mode entry (ptr, fixed bin (35), fixed bin (35)), hcs_$initiate ext entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)), hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned), mrd_util_$abort ext entry (ptr, fixed bin, fixed bin, fixed bin (35)), mrd_util_$discard_remainder ext entry (ptr, fixed bin, fixed bin (35)), mrd_util_$protocol ext entry (ptr, ptr, fixed bin, fixed bin, fixed bin, char (*), fixed bin (35)), mrd_util_$read ext entry (ptr, ptr, fixed bin, fixed bin, fixed bin, char (*), ptr, fixed bin, fixed bin (35)), mrd_util_$write ext entry (ptr, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)), mrd_util_$write_dont_flood ext entry (ptr, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)), mrd_util_$read_status ext entry (ptr, ptr, fixed bin (35)), phcs_$ring_0_message ext entry (char (*)), set_lock_$lock ext entry (bit (36) aligned, fixed bin, fixed bin (35)), set_lock_$unlock ext entry (bit (36) aligned, fixed bin (35)), system_privilege_$dir_priv_off entry (fixed bin (35)), system_privilege_$dir_priv_on entry (fixed bin (35)), system_privilege_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl user_info_$terminal_data entry options (variable); dcl error_table_$invalid_lock_reset ext fixed bin, error_table_$ionmat ext fixed bin, /* stream already attached */ error_table_$lock_wait_time_exceeded ext fixed bin, error_table_$locked_by_this_process ext fixed bin, error_table_$noentry ext fixed bin, error_table_$moderr ext fixed bin (35), error_table_$unable_to_do_io ext fixed bin (35), error_table_$undefined_order_request ext fixed bin; dcl (any_other, linkage_error) condition; /* */ /* ===================================================== */ mrd_attach: entry (attname, attype, attchan, mode, attstat, attptr); /* entry to attach stream */ dcl attname char (*), /* stream name (e.g. user_i/o) */ attype char (*), /* device type name ("mrd") */ attchan char (*), /* stream channel name */ mode char (*), /* attachment mode */ attstat bit (72) aligned, /* I/O system status code (returned) */ attptr ptr; /* device attachment pointer (returned) */ dcl mode_bits bit (36) init ("0"b); /* For call to parse_mode */ declare attach_channel_name character (32); attach_channel_name = attchan; if attach_channel_name = "-login_channel" then call user_info_$terminal_data ("", "", attach_channel_name); attstat = "0"b; /* clear status code */ sp = addr (attstat); /* pick up pointer to status code argument */ if attptr ^= null then do; /* this is a multiple attachment, no good */ st.code = error_table_$ionmat; /* return error code */ return; /* return */ end; if ^init then do; /* be sure we are initialized */ USERID = get_group_id_$tag_star (); /* get process name */ level = cu_$level_get (); /* get validation level of process */ /* see if process has access to coord message seg */ pigeon_hole = "mc.message"; /* name of message seg */ call hcs_$initiate (sysdir, pigeon_hole, "", 0, 1, mcmp, code); /* get the pointer */ if mcmp = null then go to check_priv; /* we should have had access, try for priv initiate. */ /* mc.message is assumed to be at the */ /* lowest access class in the system. */ call hcs_$fs_get_mode (mcmp, acc_mode, code); /* check real effective access */ if code ^= 0 then go to atterr; /* bad news */ if ^(access.R & access.W) then do; /* are we restricted by access isolation? */ /* yes, see if priv initiate is possible */ check_priv: on linkage_error begin; /* in case we don't have access to gate */ code = error_table_$moderr; /* tell caller he has no access */ go to atterr; /* and return; */ end; call system_privilege_$initiate (sysdir, pigeon_hole, "", 0, 1, mcmp, code); if mcmp = null then go to atterr; /* this should never happen */ revert linkage_error; /* this must be off for the next part */ need_priv = "1"b; /* if we needed priv here, we will need it later */ end; init = "1"b; /* Let's not go through this again */ messp = addr (dump); /* last item to initialize */ end; /* Search stream data list to see if this attachment is already made. */ tp = addr (first_SDB); /* get pointer to first entry in stream list */ vp = null; /* use vp to record first vacant entry (if any) */ do while (tp ^= null); /* search entire stream list */ p = tp; /* keep track of last entry in p */ if ^SDB.flags.valid then do; /* is this entry an unused (^valid) entry? */ if vp = null then vp = tp; /* record first vacant entry found in list */ end; else if SDB.source = attach_channel_name then /* not vacant, is attach_channel_name-attname already attached? */ do; if ^source_init then do; source_init = "1"b; ourmp = SDB.ourmess; /* So we don't have to initiate > once */ end; if SDB.stream = attname then do; attptr = tp; /* if so, return attachment ptr to this entry */ go to attrtn; /* and return to caller */ end; end; tp = SDB.nextp; /* get pointer to next entry (if any) in list */ end; if vp = null then do; /* if no vacant entry found in stream list, */ i = size (SDB); call hcs_$assign_linkage (i, vp, code); /* then we must allocate space for a new entry */ string (vp -> SDB.flags) = "0"b; /* initialize new stream list entry */ vp -> SDB.nextp = null; /* indicate new entry is last entry in list */ p -> SDB.nextp = vp; /* thread new entry into stream list */ end; tp, attptr = vp; /* set caller's attachment pointer */ /* Fill in SDB */ SDB.dim_name = "mrd_"; SDB.device_name_list = addr (SDB.next_device); /* Pointer to list of device names. */ SDB.next_device = null; /* This is last entry in list of device names. */ i = index (attach_channel_name, " "); if i = 0 then SDB.device_name_size = length (attach_channel_name); else SDB.device_name_size = i - 1; SDB.device_name = attach_channel_name; SDB.source = attach_channel_name; SDB.stream = attname; SDB.hismess = mcmp; if ^source_init then do; /* Initiate the message segment for this source */ pigeon_hole = substr (attach_channel_name, 1, SDB.device_name_size) || ".message"; if need_priv then call system_privilege_$initiate (sysdir, pigeon_hole, "", 0, 1, ourmp, code); else call hcs_$initiate (sysdir, pigeon_hole, "", 0, 1, ourmp, code); if ourmp = null then do; if code = error_table_$noentry then /* see if we can create the message seg */ do; USERID = get_group_id_$tag_star (); if need_priv then do; /* we can and need to use system priv */ reset_priv = 1; /* if this is 0, we set the priv */ mask = "0"b; /* old ips mask to be reset if not null */ on any_other begin; /* be sure we cleanup if an error occurs */ if reset_priv = 0 then call system_privilege_$dir_priv_off (reset_priv); reset_priv = 0; if mask then call hcs_$set_ips_mask (mask, ("0"b)); mask = "0"b; call continue_to_signal_ ((0)); end; call hcs_$set_ips_mask ((36)"0"b, mask); /* don't want to be interrupted */ call system_privilege_$dir_priv_on (reset_priv); /* get dir priv */ call hcs_$append_branchx (sysdir, pigeon_hole, 1011b, RINGS, USERID, 0, 0, 0, code); if reset_priv = 0 then call system_privilege_$dir_priv_off (reset_priv); reset_priv = 1; /* don't reset it twice */ call hcs_$set_ips_mask (mask, ("0"b)); /* reset the old mask */ mask = "0"b; /* clear it out */ revert any_other; end; else call hcs_$append_branchx (sysdir, pigeon_hole, 1011b, RINGS, USERID, 0, 0, 0, code); if code ^= 0 then go to atterr; if need_priv then call system_privilege_$initiate (sysdir, pigeon_hole, "", 0, 1, ourmp, code); else call hcs_$initiate (sysdir, pigeon_hole, "", 0, 1, ourmp, code); if ourmp = null then goto atterr; created_seg = "1"b; /* So we can mention it later */ end; else goto atterr; end; /* Initialize our message segment */ call ipc_$mask_ev_calls (code); lock_loop: call set_lock_$lock (ourmp -> syscon_mseg.mlock, lock_wait_time, code); if code ^= 0 then if code = error_table_$lock_wait_time_exceeded then do; if testing then do; call com_err_ (code, "mrdim_"); call cu_$cl; end; else call phcs_$ring_0_message ("Unable to lock daemon message segment"); goto lock_loop; end; else if code = error_table_$locked_by_this_process then leave_locked = "1"b; else if code ^= error_table_$invalid_lock_reset then goto atterr; ourmp -> syscon_template.words (*) = 0; /* Zero all but the lock word */ /* to get around hcs_$truncate bug for sys priv initiate */ ourmp -> syscon_mseg.current_process_id = get_process_id_ (); /* Fill in event lists */ ourmp -> syscon_mseg.ipc_el.n = 1; ourmp -> syscon_mseg.proto_el.n = 1; call ipc_$create_ev_chn (ourmp -> syscon_mseg.ipc_el.channel, code); if code ^= 0 then goto latterr; call ipc_$create_ev_chn (ourmp -> syscon_mseg.proto_el.channel, code); if code ^= 0 then go to latterr; ourmp -> syscon_mseg.flags.test_mode = testing; if ^leave_locked then call set_lock_$unlock (ourmp -> syscon_mseg.mlock, lcode); call ipc_$unmask_ev_calls (code); end; SDB.ipc_ep = addr (ourmp -> syscon_mseg.ipc_el); SDB.proto_ep = addr (ourmp -> syscon_mseg.proto_el); SDB.ourmess = ourmp; /* Now let's introduce ourself to the message coordinator. */ /* Construct a message. */ call ioa_$rs ("^a function attaching ^a stream.", message, i, attach_channel_name, attname); p = addr (em); /* Preparation for reciept of acknowledgement */ /* Send introduction. (This entry to mrd_util_ is really mrd_util_$write except that it wakes up a different channel & puts messages in a different chain.) */ call mrd_util_$protocol (tp, addr (message), 0, i, nt, "attach", code); if code ^= 0 then goto atterr; /* Wait for acknowledgement. */ call ipc_$block (SDB.proto_ep, p, code); SDB.source_index = based_mrt_index.mrt_source; /* All future correspondence must */ SDB.stream_index = based_mrt_index.mrt_stream; /* refer to these invoice numbers */ substr (quit_mask, SDB.source_index, 1) = "1"b; ourmp -> syscon_mseg.no_of_streams = ourmp -> syscon_mseg.no_of_streams + 1; if created_seg then do; call ioa_$rs ("Created ^a>^a.message", message, i, sysdir, attach_channel_name); call mrd_util_$write (tp, addr (message), 0, i, nt, state, code); if code = error_table_$unable_to_do_io then goto atterr; /* Condition error */ end; SDB.flags.valid = "1"b; /* This SDB is being used. */ SDB.flags.more = "0"b; attrtn: st.eof = "1"b; /* indicate stream at "end of file" */ return; /* and return to caller */ latterr: if ^leave_locked then call set_lock_$unlock (ourmp -> syscon_mseg.mlock, lcode); call ipc_$unmask_ev_calls (lcode); atterr: st.code = code; /* here on error, return status code to caller */ st.det = "1"b; /* indicate stream not attached */ return; /* */ /* ===================================================== */ mrd_write: entry (SDBptr, wp, offset, ne, net, rwstat); /* entry to write on stream */ dcl SDBptr ptr, /* attachment pointer to entry in stream list */ wp ptr, /* pointer to base of user's workspace */ offset fixed bin, /* character offset from wp */ ne fixed bin, /* number of elements (characters) to write (or read) */ net fixed bin, /* number of elements actually written (or read) */ rwstat bit (72) aligned; /* I/O system status code */ tp = SDBptr; /* get pointer to entry for this stream */ rwstat = "0"b; /* initialize status code to zero */ sp = addr (rwstat); /* get pointer to status code argument */ if ne = 0 then go to wrtn; /* skip to return if nothing to write */ nt = 0; /* initialize elements-written to zero */ n = ne; /* pick up number of elements to write */ k = offset; /* pick up element offset from wp */ wloop: call mrd_util_$write_dont_flood (tp, wp, k, n, nt, state, code); if code = OWAIT then do; call ipc_$block (SDB.ipc_ep, addr (em), code); go to wloop; end; else if code = error_table_$unable_to_do_io then goto wrerr; /* Condition error */ if n ^= nt then /* if elements-written < elements-requested, */ do; k = k + nt; /* adjust element offset by elements transferred */ n = n - nt; /* adjust element count to elements remaining */ nt = 0; /* reset elements transferred to zero and */ if n ^= 0 then go to wloop; /* if elements remaining > 0, try again to write */ end; wrtn: st.eof = "1"b; /* indicate stream at "end-of-file" */ st.comp = "1110"b; /* return I/O completion indicators */ net = ne; /* indicate that all elements were transferred */ return; wrerr: st.code = code; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ mrd_read: entry (SDBptr, wp, offset, ne, net, rwstat); /* entry to read from stream */ tp = SDBptr; /* get pointer to entry for this stream */ rwstat = "0"b; /* initialize status code to zero */ sp = addr (rwstat); /* get pointer to status code argument */ if ne = 0 then go to rdrtn; /* skip to return if zero elements requested */ net = 0; /* initialize elements transferred to zero */ p = addr (em); /* get pointer to event message for call to block */ rdloop: call mrd_util_$read (tp, wp, offset, ne, net, "normal", messp, state, code); if code = error_table_$unable_to_do_io then goto rdrtn; /* Condition error */ if net = 0 then do; /* if no elements read from console */ if ^wrote_sentinel then /* Send one reminder to operator */ do; call ioa_$rs ("--> ^a", message, i, SDB.source); call mrd_util_$protocol (tp, addr (message), 0, i, nt, "sentinel", code); if code = error_table_$unable_to_do_io then goto rdrtn; /* Condition error */ wrote_sentinel = "1"b; end; call ipc_$block (SDB.ipc_ep, p, code); /* call block to await signal from message coord'r */ go to rdloop; /* and try again to read from console */ end; rdrtn: st.eof = "0"b; /* not at end-of-file when in read-ahead mode */ st.comp = "1111"b; /* return I/O completion indicators */ if state = 0 then st.eod = "1"b; return; /* and return control to caller */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ mrd_resetread: entry (SDBptr, stat2); /* entry to reset read-ahead data */ dcl stat2 bit (72) aligned; /* I/O system status code (returned) */ rw = 1; /* set code to reset read-ahead only */ go to reset; /* join with code for resetwrite */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ mrd_resetwrite: entry (SDBptr, stat2); /* entry to reset write-behind buffers */ rw = 2; /* set code to reset write-behind only */ reset: stat2 = "0"b; /* initialize status code to zero */ sp = addr (stat2); /* get pointer to status code argument */ go to rwabort; /* join with code for abort */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ mrd_abort: entry (SDBptr, stat2, stat3); /* entry to reset read, write and quit condition */ dcl stat3 bit (72) aligned; /* I/O system status code (returned) */ rw = 3; /* set code to reset everything */ stat3 = "0"b; /* initialize status code to zero */ sp = addr (stat3); /* get pointer to status code argument */ rwabort: tp = SDBptr; /* get pointer to entry for this stream */ call mrd_util_$abort (tp, rw, state, st.code); return; /* and return */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ mrd_order: entry (SDBptr, request, argptr, stat4); /* entry to handle stream orders */ dcl request char (*), /* symbol stream request order code */ argptr ptr, /* pointer to additional arguments (if any) */ stat4 bit (72) aligned; /* I/O system status code (returned) */ dcl 1 info_struc aligned based (argptr), 2 id char (4), 2 flags aligned, 3 bps_rate fixed binary (17) unaligned, 3 line_type fixed binary (17) unaligned, 3 pad bit (36) unaligned, 2 tw_type fixed bin; string (stat4) = "0"b; tp = SDBptr; if request = "hangup" then return; if request = "listen" then return; if request = "line_length" then return; if request = "quit_enable" then do; mcmp -> syscon_mseg.quit_bits = mcmp -> syscon_mseg.quit_bits | quit_mask; return; end; if request = "quit_disable" then do; mcmp -> syscon_mseg.quit_bits = mcmp -> syscon_mseg.quit_bits & ^quit_mask; return; end; if request = "start" then return; if request = "printer_off" then return; if request = "printer_on" then return; if request = "info" then do; info_struc.id = rtrim(SDB.source); info_struc.bps_rate = 0; info_struc.line_type = LINE_MC; info_struc.pad = ""b; info_struc.tw_type = TYPE_UNKNOWN; return; end; if request = "discard_remainder" then do; call mrd_util_$discard_remainder (tp, state, code); return; end; if request = "read_status" then do; /* request to look at read ahead */ call mrd_util_$read_status (tp, argptr, code); return; end; /* Any others are in error */ addr (stat4) -> st.code = error_table_$undefined_order_request; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ mrd_getsize: entry (SDBptr, elsize, stat3); /* entry to return current element size */ dcl elsize fixed bin; /* current element size (returned) */ elsize = 9; /* element size for consoles is always 9 */ return; /* so return the constant 9 to the caller */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ mrd_changemode: entry (SDBptr, mode, omode, stat4); /* entry to modify the stream mode */ dcl omode char (*); /* returned mode prior to this call */ dcl 1 modes aligned, /* structure for order call */ 2 len fixed bin, /* length of mode string */ 2 mode_string char (128); /* mode string */ tp = SDBptr; /* get pointer to SDB for this stream */ stat4 = ""b; /* initialize status to OK */ sp = addr (stat4); /* pick up pointer to status argument */ modes.mode_string = mode; /* copy mode string */ omode = ""; return; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ mrd_detach: entry (SDBptr, ch2, disposal, stat4); /* entry to detach a currently attached stream */ dcl (ch2, disposal) char (*); /* these arguments ignored in this implementation */ tp = SDBptr; /* get pointer to entry for this stream */ stat4 = "0"b; /* initialize status code to zero */ sp = addr (stat4); /* get pointer to status code argument */ ourmp = SDB.ourmess; st.det = "1"b; /* set code to detach this ioname */ if ^SDB.valid then return; SDB.valid = "0"b; /* indicate stream list entry no longer in use */ ourmp -> syscon_mseg.no_of_streams = ourmp -> syscon_mseg.no_of_streams - 1; if ourmp -> syscon_mseg.no_of_streams = 0 then substr (quit_mask, SDB.source_index, 1) = "0"b; /* Say goodbye to message coordinator */ p = addr (em); /* Preparation for reciept of acknowledgement. */ /* Construct a message */ call ioa_$rs ("^a function detaching ^a stream. ", message, i, SDB.source, SDB.stream); /* Send it */ call mrd_util_$protocol (tp, addr (message), 0, i, nt, "detach", code); /* Wait for acknowledgement */ call ipc_$block (SDB.proto_ep, p, code); return; /* and return */ /* =================================================== */ test_mrd: entry (system_dir); dcl system_dir char (*); sysdir = system_dir; init = "0"b; need_priv = "0"b; /* this will be determined later */ testing = "1"b; return; end mrdim_;  restart_mc_ttys_.pl1 08/04/87 1456.8rew 08/04/87 1221.8 19269 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ restart_mc_ttys_: proc; /* restart_mc_ttys_ is called to send a wakeup to all terminal device control channels. This insures that any asynchronously-invoked programs which do output will not steal a read wakeup. */ /* Modified August 1976 by Robert Coren to check CDTE pointer */ /* Modified 1985-01-02, BIM: new IOX MC. */ /****^ HISTORY COMMENTS: 1) change(87-02-17,GDixon), approve(87-06-12,MCR7690), audit(87-05-07,Parisek), install(87-08-04,MR12.1-1055): Modified for change to mc_anstbl.incl.pl1. END HISTORY COMMENTS */ dcl i fixed bin; dcl code fixed bin (35); dcl fb71 fixed bin (71) based (addr (larm)); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl larm char (8) aligned int static init ("alarm___"); /* for restart_mc_ttys_ */ dcl (null, addr) builtin; mc_ansp = sc_stat_$mc_ansp; /* Find table */ call iox_$control (sc_stat_$mc_iocb, "start", null, code); do i = 1 to mc_anstbl.current_size; /* Simulate timeout on attached consoles, get them going */ mc_atep = addr (mc_anstbl.entry (i)); if mc_ate.active & ^mc_ate.the_system_console then call hcs_$wakeup (mc_anstbl.mc_procid, mc_ate.event, fb71, code); end; return; %include sc_stat_; %include mc_anstbl; end restart_mc_ttys_;  suffix_mcacs_.pl1 04/09/85 1550.5r w 04/08/85 1133.0 124227 /* ************************************************************** * * * Copyright, (C) Massachusetts Institute of Technology, 1983 * * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * ************************************************************** */ /* format: style2,idind30,indcomtxt */ /* Typed-segment primitives for Message Coordinator ACS segments */ /**** 1984-12-21, BIM: created from suffix_ms_ */ suffix_mcacs_: procedure (); /* Common Parameters */ dcl P_desired_version character (*) parameter; dcl P_dirname character (*) parameter; /* directory containing the message segment */ dcl P_ename character (*) parameter; /* name of the message segment */ dcl P_code fixed binary (35) parameter; /* suffix_info and list_switches Parameters */ dcl P_switch_list_ptr ptr parameter; dcl P_suffix_info_ptr ptr parameter; /* chname_file Parameters */ dcl P_old_name character (*) parameter; /* name to be deleted */ dcl P_new_name character (*) parameter; /* name to be added */ /* copy parameters */ dcl P_copy_options_ptr ptr parameter; /* Parameters used by most ACL entries */ dcl P_acl_ptr pointer parameter; /* -> an ACL array structure */ /* list_acl Parameters */ dcl P_user_area_ptr pointer parameter; /* -> area where to allocate listed_acl if non-null */ /* replace_acl Parameters */ dcl P_no_sysdaemon bit (1) parameter; /* ON => do not add explicit *.SysDaemon.* term */ /* switch Parameters */ dcl P_switch_name char (*) parameter; dcl P_value bit (1) aligned parameter; /* (get set)_max_length and bit_count parameters */ dcl P_max_length fixed bin (19) parameter; /* get_user_access_modes parameters */ dcl (P_modes, P_exmodes) bit (36) aligned; dcl P_ring fixed bin; dcl P_user_name char (*); /* ring brackets */ dcl P_rings (2) fixed bin (3); /* Remaining declarations */ dcl acl_error bit (1) aligned; dcl ex_acl_ptr pointer; dcl user_area_ptr pointer; dcl user_area area based (user_area_ptr); dcl system_free_area area based (get_system_free_area_ ()); dcl idx fixed binary; dcl error_table_$argerr fixed binary (35) external; dcl error_table_$unsupported_operation fixed binary (35) external; dcl error_table_$unimplemented_version fixed bin (35) ext static; declare error_table_$not_seg_type fixed bin (35) ext static; declare cu_$generate_call entry (entry, ptr); declare cu_$arg_list_ptr entry returns (pointer); dcl (get_system_free_area_, get_user_free_area_) entry () returns (pointer); dcl hcs_$get_user_access_modes entry (char (*), char (*), char (*), fixed bin, bit (36) aligned, bit (36) aligned, fixed bin (35)); dcl sub_err_ entry () options (variable); declare V_entry entry variable options (variable); dcl cleanup condition; dcl null builtin; declare VALID_ACL_XMODES bit (36) aligned init /** abcdefghijklmnopqrstuvwxyz */ /* */ ("001100000000000011000000000000000000"b) int static options (constant); /**** format: off */ %page; %include suffix_info; %page; %include acl_structures; %page; %include access_mode_values; %include sub_err_flags; %include copy_flags; %include file_system_operations; /* format: on */ /* Deletes a message segment */ delentry_file: entry (P_dirname, P_ename, P_code); call FORWARD (FS_DELENTRY_FILE, cu_$arg_list_ptr ()); return; chname_file: entry (P_dirname, P_ename, P_old_name, P_new_name, P_code); call FORWARD (FS_CHNAME_FILE, cu_$arg_list_ptr ()); return; copy: entry (P_copy_options_ptr, P_code); call FORWARD (FS_COPY, cu_$arg_list_ptr ()); return; validate: entry (P_dirname, P_ename, P_code); P_code = error_table_$not_seg_type; if index (P_ename, ".") > 0 then if before (reverse (rtrim (P_ename)), ".") = reverse ("mcacs") then P_code = 0; return; suffix_info: entry (P_suffix_info_ptr); suffix_info_ptr = P_suffix_info_ptr; if suffix_info.version ^= SUFFIX_INFO_VERSION_1 then call sub_err_ (error_table_$unimplemented_version, "bad suffix info version", ACTION_CANT_RESTART, null (), (0), "Invalid version ^a in call to suffix_ms_$suffix_info.", suffix_info.version); suffix_info.type = "mcacs"; suffix_info.type_name = "Message Coordinator source ACS"; suffix_info.plural_name = "Message Coordinator source ACS's"; string (suffix_info.flags) = ""b; suffix_info.extended_acl = "0"b; suffix_info.has_switches = "0"b; suffix_info.modes = "cdqr"; suffix_info.max_mode_len = 4; suffix_info.num_ring_brackets = 2; /* gate bracket dull */ string (suffix_info.copy_flags) = ""b; suffix_info.copy_flags.names, suffix_info.copy_flags.acl, suffix_info.copy_flags.max_length, suffix_info.copy_flags.safety_switch = "1"b; suffix_info.info_pathname = "extended_access.gi.info"; return; %page; add_acl_entries: entry (P_dirname, P_ename, P_acl_ptr, P_code); acl_ptr = P_acl_ptr; if acl_ptr = null () then do; P_code = error_table_$argerr; return; end; if general_acl.version ^= GENERAL_ACL_VERSION_1 then do; P_code = error_table_$unimplemented_version; return; end; acl_error = "0"b; general_acl.entries (*).status_code = 0; do idx = 1 to general_acl.count; if (general_acl.entries (idx).mode & VALID_ACL_XMODES) ^= ""b then do; general_acl.entries (idx).status_code = error_table_$argerr; acl_error = "1"b; end; end; if acl_error then do; P_code = error_table_$argerr; return; end; acl_count = general_acl.count; allocate general_extended_acl in (system_free_area) set (ex_acl_ptr); ex_acl_ptr -> general_extended_acl.version = GENERAL_EXTENDED_ACL_VERSION_1; do idx = 1 to acl_count; ex_acl_ptr -> general_extended_acl.entries (idx).access_name = general_acl.entries (idx).access_name; ex_acl_ptr -> general_extended_acl.entries (idx).mode = ""b; ex_acl_ptr -> general_extended_acl.entries (idx).extended_mode = general_acl.entries (idx).mode; ex_acl_ptr -> general_extended_acl.entries (idx).status_code = 0; end; call MAKE_ENTRY (FS_ADD_EXTENDED_ACL_ENTRIES); call V_entry (P_dirname, P_ename, ex_acl_ptr, P_code); general_acl.entries (*).status_code = ex_acl_ptr -> general_extended_acl.entries (*).status_code; free general_extended_acl; return; list_acl: entry (P_dirname, P_ename, P_desired_version, P_user_area_ptr, P_acl_ptr, P_code); acl_ptr = P_acl_ptr; ex_acl_ptr = null (); if acl_ptr ^= null () then do; /* wants to list specific entries */ if general_acl.version ^= GENERAL_ACL_VERSION_1 then do; P_code = error_table_$unimplemented_version; return; end; acl_count = general_acl.count; if acl_count = 0 then return; allocate general_extended_acl in (system_free_area) set (ex_acl_ptr); ex_acl_ptr -> general_extended_acl.version = GENERAL_EXTENDED_ACL_VERSION_1; do idx = 1 to acl_count; ex_acl_ptr -> general_extended_acl.entries (idx).access_name = general_acl.entries (idx).access_name; ex_acl_ptr -> general_extended_acl.entries (idx).status_code = 0; end; call MAKE_ENTRY (FS_LIST_EXTENDED_ACL); call V_entry (P_dirname, P_ename, "", null (), ex_acl_ptr, P_code); do idx = 1 to acl_count; general_acl.entries (idx).mode = ex_acl_ptr -> general_extended_acl.entries (idx).extended_mode; general_acl.entries (idx).status_code = ex_acl_ptr -> general_extended_acl.entries (idx).status_code; end; free ex_acl_ptr -> general_extended_acl; end; else do; /* wants to list an acl entirely */ if P_desired_version ^= GENERAL_ACL_VERSION_1 then do; P_code = error_table_$unimplemented_version; return; end; user_area_ptr = P_user_area_ptr; if user_area_ptr = null () then user_area_ptr = get_user_free_area_ (); call MAKE_ENTRY (FS_LIST_EXTENDED_ACL); call V_entry (P_dirname, P_ename, GENERAL_EXTENDED_ACL_VERSION_1, get_system_free_area_ (), ex_acl_ptr, P_code); if P_code ^= 0 then return; if ex_acl_ptr = null () then do; P_acl_ptr = null (); return; end; acl_count = max (1, ex_acl_ptr -> general_extended_acl.count); allocate general_acl in (user_area); P_acl_ptr = acl_ptr; general_acl.count = ex_acl_ptr -> general_extended_acl.count; if general_acl.count = 0 then go to LIST_FREE_RETURN; general_acl.version = GENERAL_ACL_VERSION_1; do idx = 1 to acl_count; general_acl.entries (idx).access_name = ex_acl_ptr -> general_extended_acl.entries (idx).access_name; general_acl.entries (idx).mode = ex_acl_ptr -> general_extended_acl.entries (idx).extended_mode; general_acl.entries (*).status_code = 0; end; LIST_FREE_RETURN: free ex_acl_ptr -> general_extended_acl; end; return; %page; delete_acl_entries: entry (P_dirname, P_ename, P_acl_ptr, P_code); acl_ptr = P_acl_ptr; if acl_ptr = null () then do; P_code = error_table_$argerr; return; end; call FORWARD (FS_DELETE_ACL_ENTRIES, cu_$arg_list_ptr ()); %page; /**** NOTE -- the default SysDaemon access for an mcacs is null. Therefore, the no_sysdaemon switch is a noop. */ replace_acl: entry (P_dirname, P_ename, P_acl_ptr, P_no_sysdaemon, P_code); ex_acl_ptr = null (); acl_ptr = P_acl_ptr; if acl_ptr = null () then do; P_code = error_table_$argerr; return; end; on cleanup begin; if ex_acl_ptr ^= null () then do; free ex_acl_ptr -> general_extended_acl; ex_acl_ptr = null (); end; end; acl_count = general_acl.count; call MAKE_ENTRY (FS_REPLACE_EXTENDED_ACL); if acl_count = 0 /* cannot have no_sysdaemon */ then do; acl_count = 1; allocate general_extended_acl in (system_free_area) set (ex_acl_ptr); ex_acl_ptr -> general_extended_acl.version = GENERAL_EXTENDED_ACL_VERSION_1; ex_acl_ptr -> general_extended_acl.count = 0; call V_entry (P_dirname, P_ename, ex_acl_ptr, "1"b, P_code); free ex_acl_ptr -> general_extended_acl; return; end; allocate general_extended_acl in (system_free_area) set (ex_acl_ptr); ex_acl_ptr -> general_extended_acl.version = GENERAL_EXTENDED_ACL_VERSION_1; do idx = 1 to acl_count; /* no need to splice in funny acl */ ex_acl_ptr -> general_extended_acl.entries (idx).access_name = general_acl.entries (idx).access_name; ex_acl_ptr -> general_extended_acl.entries (idx).extended_mode = general_acl.entries (idx).mode; ex_acl_ptr -> general_extended_acl.entries (idx).mode = ""b; ex_acl_ptr -> general_extended_acl.entries (idx).status_code = 0; end; call V_entry (P_dirname, P_ename, ex_acl_ptr, "1"b, P_code); general_acl.entries (*).status_code = ex_acl_ptr -> general_extended_acl.entries (*).status_code; free ex_acl_ptr -> general_extended_acl; return; get_switch: entry (P_dirname, P_ename, P_switch_name, P_value, P_code); call FORWARD (FS_GET_SWITCH, cu_$arg_list_ptr ()); set_switch: entry (P_dirname, P_ename, P_switch_name, P_value, P_code); call FORWARD (FS_SET_SWITCH, cu_$arg_list_ptr ()); %page; get_max_length: entry (P_dirname, P_ename, P_max_length, P_code); call FORWARD (FS_GET_MAX_LENGTH, cu_$arg_list_ptr ()); set_max_length: entry (P_dirname, P_ename, P_max_length, P_code); call FORWARD (FS_SET_MAX_LENGTH, cu_$arg_list_ptr ()); list_switches: entry (P_desired_version, P_user_area_ptr, P_switch_list_ptr, P_code); call FORWARD (FS_LIST_SWITCHES, cu_$arg_list_ptr ()); get_ring_brackets: entry (P_dirname, P_ename, P_rings, P_code); declare three_rings (3) fixed bin (3); call MAKE_ENTRY (FS_GET_RING_BRACKETS); call V_entry (P_dirname, P_ename, three_rings, P_code); P_rings (1) = three_rings (1); P_rings (2) = three_rings (2); return; set_ring_brackets: entry (P_dirname, P_ename, P_rings, P_code); three_rings (1) = P_rings (1); three_rings (2), three_rings (3) = P_rings (2); call MAKE_ENTRY (FS_SET_RING_BRACKETS); call V_entry (P_dirname, P_ename, three_rings, P_code); return; get_user_access_modes: entry (P_dirname, P_ename, P_user_name, P_ring, P_modes, P_exmodes, P_code); P_exmodes = ""b; /* msegs, like dirs, have only modes, no exmodes */ call hcs_$get_user_access_modes (P_dirname, P_ename, P_user_name, P_ring, ((36)"0"b), P_modes, P_code); return; MAKE_ENTRY: procedure (OP); declare OP char (64); call MAKE_ENTRY_ (OP); return; FORWARD: entry (OP, Arg_list_ptr); declare Arg_list_ptr pointer; call MAKE_ENTRY_ (OP); call cu_$generate_call (V_entry, Arg_list_ptr); go to FORWARD_RETURNS; end MAKE_ENTRY; FORWARD_RETURNS: return; MAKE_ENTRY_: procedure (OP); declare OP char (64); declare code fixed bin (35); declare fs_util_$make_entry_for_type entry (character (*), character (*), entry, fixed binary (35)); call fs_util_$make_entry_for_type ("-segment", (OP), V_entry, code); if code ^= 0 then call sub_err_ (code, "suffix_mcacs_", ACTION_CANT_RESTART, null (), (0), "Failed to find entrypoint for ""^a"" for segments.", OP); end MAKE_ENTRY_; end suffix_mcacs_;  turn_on_mc_.pl1 08/04/87 1456.8rew 08/04/87 1221.9 52263 /****^ *********************************************************** * * * 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: style2 */ /* This procedure is called to cause the message coordinator to start up. It reattaches the I/O streams used by the message coordinator so that the various sources inside the initializer process can be routed independently. */ /* Modified August 1981 by E. N. Kittlitz to get heed bad iox_ return codes */ /* Modified August 1982 by E. N. Kittlitz to not call sys_log_$mc_on. */ /* Modified 1984-10-08 BIM to remove tape_switch, use up-to-date iox. */ /* Modified 1984-12-02, BIM: remove mc_i/o altogether, use sc_ipc_mask_ */ /****^ HISTORY COMMENTS: 1) change(86-06-05,GJohnson), approve(86-06-05,MCR7387), audit(86-06-10,Martinson), install(86-07-11,MR12.0-1092): Correct error message documentation. 2) change(87-06-12,Parisek), approve(87-06-12,MCR7690), audit(87-06-12,Martinson), install(87-08-04,MR12.1-1055): 1) Removed unreferenced declarations. 2) Added HBULL pnotice. END HISTORY COMMENTS */ turn_on_mc_: proc; /* Builtins */ dcl codeptr builtin; dcl code fixed bin (35); dcl n_masks fixed bin; dcl mc_tty_ entry (); dcl com_err_ entry options (variable); dcl mc_util_$init entry (char (*), char (6) aligned, entry, ptr, ptr, fixed bin (35)); %include iox_entries; dcl sc_ipc_mask_$unmask entry (fixed binary); dcl sc_ipc_mask_$remask entry (fixed binary); dcl ssu_$get_info_ptr entry (ptr) returns (ptr); %include iox_modes; %include sc_stat_; %include sc_subsystem_info_; if sc_stat_$mc_is_on then return; /* once. */ /* First turn on the real message coordinator. */ call mc_util_$init (sc_stat_$sysdir, sc_stat_$master_channel, mc_tty_, sc_stat_$mc_ansp, sc_stat_$initzer_ttyp, code); if code ^= 0 then call complain ("error from mc_init"); call sc_ipc_mask_$unmask (n_masks); /*** event calls are now unmasked, and n_masks is the number of times to remask them (perhaps 0). */ call iox_$detach_iocb (sc_stat_$sv1_iocb, code); if code ^= 0 then call complain ("detach severity1"); call iox_$detach_iocb (sc_stat_$sv2_iocb, code); if code ^= 0 then call complain ("detach severity2"); call iox_$detach_iocb (sc_stat_$sv3_iocb, code); if code ^= 0 then call complain ("detach severity3"); call iox_$attach_ptr (sc_stat_$sv1_iocb, "mr_ as", codeptr (turn_on_mc_), code); if code ^= 0 then call complain ("attach severity1"); call iox_$attach_ptr (sc_stat_$sv2_iocb, "mr_ as", codeptr (turn_on_mc_), code); if code ^= 0 then call complain ("attach severity2"); call iox_$attach_ptr (sc_stat_$sv3_iocb, "mr_ as", codeptr (turn_on_mc_), code); if code ^= 0 then call complain ("attach severity3"); call iox_$open (sc_stat_$sv1_iocb, Stream_output, "1"b, code); if code ^= 0 then call complain ("open severity1"); call iox_$open (sc_stat_$sv2_iocb, Stream_output, "1"b, code); if code ^= 0 then call complain ("open severity2"); call iox_$open (sc_stat_$sv3_iocb, Stream_output, "1"b, code); if code ^= 0 then call complain ("open severity3"); call sc_ipc_mask_$remask (n_masks); sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$master_sci_ptr); sc_subsystem_info.mc_atep = sc_stat_$initzer_ttyp;/* tell the world */ sc_subsystem_info.real_iocb = sc_stat_$master_iocb; /* how to talk to this */ sc_stat_$mc_is_on = "1"b; /* Set flag. */ exit: return; complain: proc (why); dcl why char (*); call com_err_ (code, "turn_on_mc_", why); go to exit; end; /* BEGIN MESSAGE DOCUMENTATION Message: turn_on_mc_: MESSAGE. detach STREAM S: sc (error_output). T: $init M: The system attempted to start the Message Coordinator but the stream STREAM could not be detached from its initial dim. The system continues to operate but the Message Coordinator is not used. Probably, the daemon processes will also encounter trouble. A: $contact Message: turn_on_mc_: MESSAGE. attach STREAM S: sc (error_output). T: $init M: The system attempted to start the Message Coordinator but the stream STREAM cannot be attached to the message routing dim. The system continues to operate but the Message Coordinator is not used. Probably, the daemon processes will also encounter trouble. A: $contact Message: turn_on_mc_: MESSAGE. open STREAM S: sc (error_output). T: $init M: The system attempted to start the Message Coordinator but the stream STREAM cannot be opened by the message routing dim. The system continues to operate but the Message Coordinator is not used. Probably, the daemon processes will also encounter trouble. A: $contact Message: turn_on_mc_: MESSAGE. error from mc_init S: sc (error_output). T: $init M: The system attempted to start the Message Coordinator but it cannot be initialized. The system continues to operate but the Message Coordinator is not used. The daemon processes will probably also encounter trouble. A: $contact END MESSAGE DOCUMENTATION */ end turn_on_mc_; 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