Multics > Library > Source
Aug 1983

dialup_.pl1

History | People | Library | Sites | About

This Multics source file was rescued from the messed-up source archive at MIT.

This program is the main loop of the answering service, the Multics facility that logs users in and out. dialup_ "owns" all terminal device channels when the system is booted; when a user logs in on a channel, dialup_ creates a process for the user and gives the terminal to the user process. If the process dies, dialup_ reclaims the channel and creates a new process for the user; if the user hangs up, dialup_ preserves the user process and waits for the user to reconnect. Many other events and sequences of events are handled. This program parses the login command and reads users' passwords, among other activities.

dialup_ is the work of many hands over many years, and shows the tool marks. This is a big ugly program that we always wanted to rewrite, but never had the time. The event-driven main loop is a more familiar pattern now, used in many graphical user interface applications, but it was unusual and hard to debug when we began in 1969. (There was a testing facility that let you run an answering service in your own process, called test_dialup.)

Back to Multics Source index.

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


/* format: style4 */
dialup_: proc (msg_ptr);

/* PLEASE DO NOT ADD ANY RETURN STATEMENTS TO (THE EXTERNAL PROCEDURE PORTION OF) THIS PROGRAM.

   There should be only one return statement, at the label "return_immediately", which is
   located at the end of the process creation code, in the login section.

   A goto that label should be used instead of a return statement, so that all
   "logical returns" will be noted in the cross reference section of the listing,
   as references to that label.

   Note, however, that an immediate return is usually the wrong thing to do, as there
   is some cleaning up that almost always needs to be done before a return. The labels
   "exit" and "exit1" should be used in most cases; exit if both answer table unlocking
   and termination of metering is needed, and exit1 if just the latter is needed.

   If in doubt about the proper way to return, read the code for more details.

   *                    T. Casey, 5/19/81

*/

/* Automatic answering service using the ring-0 ttydim

   Originally coded by J. F. Ossanna Jan 1969
   Recoded by Michael J. Spier and Robert C. Daley February 1969
   Revised by Michael D. Schroeder, July
   Re-revised, converted to PL/1 and adapted to current System/User Control
   by Michael J. Spier, 25.12.1969, 'twixt X-mas and New-Year
   Modified for inactive bump & fixes THVV 9/70
   Modified for new ttydim, removing many waits, 12/70 THVV
   Modified for efficiency, ucs handler, login args THVV
   Modified for garbage for consoles without poff, THVV
   Modified for help function THVV 11/71
   Modified for dynamic changing of password, J.Phillipps 8/72
   Modified 740913 by PG for generated passwords
   Modified 750226 by PG for Multics Communication System (MCS)
   Modified 750328 by PG to use printer_on and printer_off order calls.
   Modified 750417 by PG for new_proc -authorization
   Modified 750502 by PG to fix bug which left logged-out users in whotab
   Modified 750715 by PG & THVV for MCS Phase II
   Modified 751110 by PG for bug fixes & ttydim/network dim changes
   Modified April 1976 by T. Casey to detect fatal process error loops and process initialization failures,
   .                 and to ask for new password twice when -cpw is given,
   .        and by P. Green to fix misc. bugs.
   Modified 760601 by PG to fix pw mask handling and add resetreads.
   Modified 760720 by D. Wells to fix problem with dialing (to match ftp_dialup_)
   and, incidentally, to shorten blank padded messages
   Modified 760819 by Roy Planalp to use error msg passed up from lg_ctl_ and to fix detach bug.
   Modified Aug-Sept 1976 by T. Casey, M. Grady, and D. Wells, for as9.0 (v2CDT & FNP loading)
   Modified Feb., 1977, by D. M. Wells, to get more info about terminal into CDT
   Modified June 1977 by Robert Coren to use ttt_info_ for terminal information
   Modified September 1977 by T. Casey to fix hung process bugs.
   Modified October 1977 by T. Casey to send term signal to process being bumped, and wait for it to destroy itself.
   Modified January 1978 by T. Casey and R. Coren to fix bugs in previous two modifications.
   Modified May 1978 by T. Casey to use parameters in installation_parms in the fatal process error loop detector,
   .        and to try to destroy processes whose stopstop wakeups were apparently lost.
   Modified August 1978 by T. Casey to call astty_$get_chars to read answerback.
   Modified Fall 1978 by Larry Johnson for ring-0 demultiplexing.
   Modified November 1978 by T. Casey for MR7.0 new installation_parms.
   Modified April 1979 by T. Casey for MR7.0a to log lost initial wakeups, and fix bug in handling responses to trm_ signals.
   Modified July 1979 by T. Casey for MR8.0 to implement process preservation across hangups.
   Modified August 1979 by Larry Johnson for new pre-access commands echo, modes, and terminal_type.
   Modified November 1979 by T. Casey for MR8.0 to fix bugs in process preservation.
   Modified February 27, 1980 by T. Casey to fix a bug that was leaving the answer table locked.
   Modified March 1980 by Tom Casey to add metering.
   Modified December 1980 by E. N. Kittlitz for bugfixes, activity_unbump.
   Modified March 1981 by Robert Coren to add WAIT_FIN_TANDD_ATTACH and WAIT_DISCARD_WAKEUPS wait types.
   Modified April 1981 by Robert Coren to issue copy_meters order when assigning channel.
   Modified April 1981 by E. N. Kittlitz for various bugfixes.
   Modified May 1981 by T. Casey to fix bugs for MR9.0.
   Modified July 1981 by T. Casey for MR9.0 to wait for logout message to print before hanging up.
   Modified November 1981, E. N. Kittlitz.  user_table_entry conversion.
   Modified December 1981, E. N. Kittlitz.  don't hangup on lg_ctl_ error, destroy connect request or special session.
   Modified January 1982, E. N. Kittlitz.   bugfixes, login_parse_ changes, -immediate, etc.
   Modified January 1982, E. N. Kittlitz.  eliminate edited and red mode fiddling.
   Modified April 1982, E. N. Kittlitz. 'quit', etc. bugfixes
   Modified May 1982, E. N. Kittlitz. New AS initialization.
   Modified July 1982, E. N. Kittlitz. Support MCS channel (un)masking.
   Modified February 1983, E. N. Kittlitz. Password prompt does printer-off before typing NL.
   Modified May 1983, E. N. Kittlitz. set_required_access_class support.
   Modified August 1983, E. N. Kittlitz (courtesy S. Harris) to not use whotab (ute.whotabx) if it's 0.
*/

/* parameters */

dcl  msg_ptr ptr;                   /* argument to event-call procedure */

/* builtins */

dcl  (addr, addrel, baseno, bit, clock, divide, fixed, float, hbound, index, lbound, length,
     max, mod, null, reverse, rtrim, string, substr, translate, unspec, verify) builtin;

/* entries */

dcl  (as_meter_$enter, as_meter_$exit) entry (fixed bin);
dcl  as_meter_$exit_values entry (fixed bin, fixed bin, fixed bin (71), fixed bin (71));
dcl  match_star_name_ entry (char (*) aligned, char (*) aligned, fixed bin (35));
dcl  aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned);
dcl  parse_answerback_ entry (char (*), fixed bin, fixed bin, char (*) aligned);
dcl  cpu_time_and_paging_ entry (fixed bin, fixed bin (71), fixed bin);
dcl  as_dump_ entry (char (*) aligned);         /* take a dump on error */
dcl  condition_ entry (char (*), entry);
dcl  hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, fixed bin (5), fixed bin (35));
dcl  hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35));
dcl  asu_$check_channel_acs entry (ptr, char (*)) returns (bit (1) aligned);
dcl  asu_$check_for_stopped_process entry (ptr, char (*)) returns (bit (1) aligned);
dcl  asu_$find_process entry (bit (36) aligned, fixed bin, ptr);
dcl  asu_$attach_ate entry (ptr, fixed bin (35));
dcl  asu_$release_ate entry (ptr, fixed bin (35));
dcl  asu_$send_term_signal entry (ptr, fixed bin) returns (bit (1) aligned);
dcl  asu_$asu_listen entry (ptr, fixed bin (35));       /* program makes event chan & orders listen */
dcl  asu_$write_chn_message entry (ptr, fixed bin (35), char (8) aligned, fixed bin (35));
dcl  convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned);
dcl  asu_$asu_remove entry (ptr);           /* completely removes tty chn from system */
dcl  asu_$remove_cdte entry (ptr);          /* removes channel of garbaged cdte, if possible */
dcl  asu_$release_suspended_process entry (ptr);
dcl  asu_$suspend_process entry (ptr);
dcl  convert_ipc_code_ entry (fixed bin (35));
dcl  cpg_ entry (ptr, fixed bin (35));          /* utility to create process */
dcl  cpg_$set_pit_tty_info entry (ptr, fixed bin (35)); /* to tell existing process about its new tty channel */
dcl  dpg_ entry (ptr);              /* utility to destroy process */
dcl  dpg_$finish entry (ptr);               /* second half of process destruction */
dcl  date_time_ entry (fixed bin (71), char (*) aligned);   /* formats date and time */
dcl  get_process_id_ entry () returns (bit (36) aligned);
dcl  astty_$tty_abort entry (ptr, fixed bin, fixed bin (35)); /* astty_ is used for all terminal i/o */
dcl  astty_$tty_new_proc entry (ptr, bit (36) aligned, fixed bin (35)); /* force "uproc" to processid */
dcl  astty_$tty_event entry (ptr, fixed bin (35));  /* cause device signals to come to caller */
dcl  astty_$tty_order entry (ptr, char (*), ptr, fixed bin (35));
dcl  astty_$tty_changemode entry (ptr, char (*), fixed bin (35));
dcl  astty_$tty_getmode entry (ptr, char (*), fixed bin (35));
dcl  astty_$tty_read entry (ptr, ptr, fixed bin, fixed bin (35));
dcl  astty_$tty_get_chars entry (ptr, ptr, fixed bin, fixed bin (35));
dcl  astty_$tty_state entry (ptr, fixed bin (35));
dcl  astty_$tty_force entry (ptr, ptr, fixed bin, fixed bin (35));
dcl  timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71));
dcl  timer_manager_$reset_alarm_wakeup entry (fixed bin (71));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  hcs_$wakeup entry (bit (*) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
dcl  (ioa_, ioa_$rs, ioa_$rsnnl) entry options (variable);
dcl  (sys_log_, sys_log_$error_log) entry options (variable); /* error reporting program */
dcl  ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35));
dcl  ipc_$drain_chn entry (fixed bin (71), fixed bin (35));
dcl  ipc_$unmask_ev_calls entry (fixed bin (35));
dcl  lg_ctl_$login entry (ptr, char (8), char (*) varying, fixed bin (35));
dcl  lg_ctl_$logout entry (ptr);
dcl  lg_ctl_$validate entry (ptr, char (8), char (*) varying, fixed bin (35));
dcl  login_parse_ entry (ptr, fixed bin, char (*), fixed bin, fixed bin, fixed bin (35));
dcl  login_parse_$password entry (ptr, fixed bin, char (*), fixed bin, fixed bin, fixed bin (35));
dcl  lv_request_$cleanup_process entry (bit (36) aligned);
dcl  parse_login_line_ entry (ptr, fixed bin, ptr, char (*), char (*) aligned, fixed bin (35));
dcl  parse_login_line_$dial_line entry (ptr, fixed bin, ptr, char (*) aligned, fixed bin (35));
dcl  parse_login_line_$slave_line entry (ptr, fixed bin, ptr, char (*) aligned, fixed bin (35));
dcl  dial_ctl_ entry (ptr, char (*), char (*), fixed bin (35));
dcl  dial_ctl_$dial_term entry (ptr);
dcl  dial_ctl_$dial_broom entry (ptr, char (8) aligned);
dcl  dial_ctl_$finish_dial_out entry (ptr);
dcl  dial_ctl_$finish_priv_attach entry (ptr);
dcl  dial_ctl_$continue_tandd_attach entry (ptr);
dcl  dial_ctl_$finish_tandd_attach entry (ptr);
dcl  rcp_sys_$unassign_process entry (bit (36) aligned, fixed bin (35));
dcl  act_ctl_$open_account entry (ptr);
dcl  device_acct_$on entry (fixed bin, char (*) aligned, ptr);
dcl  device_acct_$off entry (fixed bin, char (*) aligned, ptr);
dcl  act_ctl_$close_account entry (ptr);
dcl  act_ctl_$cp entry (ptr);
dcl  act_ctl_$dp entry (ptr);               /* charge user */
dcl  act_ctl_$activity_unbump entry (ptr, fixed bin (35));
dcl  send_mail_$access_class entry (char (*), char (*), ptr, bit (72) aligned, fixed bin (35));
dcl  scramble_ entry (char (8)) returns (char (8));
dcl  generate_word_ entry (char (*), char (*), fixed bin, fixed bin);
dcl  ttt_info_$default_term_type entry (fixed bin, fixed bin, char (*), fixed bin (35));
dcl  ttt_info_$decode_answerback entry (char (*), fixed bin, char (*), char (*) aligned, fixed bin (35));
dcl  ttt_info_$dialup_flags entry (char (*), bit (1), bit (1), fixed bin (35));
dcl  ttt_info_$initial_string entry (char (*), char (*) varying, fixed bin (35));
dcl  ttt_info_$modes entry (char (*), char (*), fixed bin (35));
dcl  ttt_info_$preaccess_type entry (char (*), char (*), fixed bin (35));

/* external static */

dcl  error_table_$bad_arg fixed bin (35) ext static;
dcl  error_table_$badstar fixed bin (35) external static;
dcl  error_table_$messages_deferred fixed bin (35) external static;
dcl  error_table_$messages_off fixed bin (35) external static;
dcl  error_table_$action_not_performed fixed bin (35) external static;
dcl  error_table_$noarg fixed bin (35) ext static;
dcl  error_table_$unbalanced_quotes fixed bin (35) ext static;
dcl  error_table_$undefined_order_request fixed bin (35) ext static;
dcl  as_error_table_$no_create_aclass fixed bin (35) ext static;
dcl  as_error_table_$preaccess_request_error fixed bin (35) ext static;
dcl  as_error_table_$dial_request_error fixed bin (35) ext static;
dcl  as_error_table_$ds_user_ignored fixed bin (35) ext static;
dcl  as_error_table_$ds_user_required fixed bin (35) ext static;
dcl  as_error_table_$illegal_new_proc fixed bin (35) external static;
dcl  as_error_table_$term_by_operator fixed bin (35) external static;
dcl  as_error_table_$generated_pw_msg fixed bin (35) external;
dcl  as_error_table_$bad_answerback fixed bin (35) external;
dcl  as_error_table_$illegal_signal fixed bin (35) ext;
dcl  as_error_table_$dialup_error fixed bin (35) ext;
dcl  as_error_table_$automatic_logout fixed bin (35) ext;
dcl  as_error_table_$greeting_msg fixed bin (35) ext;
dcl  as_error_table_$bad_login_word_msg fixed bin (35) ext;
dcl  as_error_table_$hangup_msg fixed bin (35) ext;
dcl  as_error_table_$init_err fixed bin (35) ext;
dcl  as_error_table_$logout_msg fixed bin (35) ext;
dcl  as_error_table_$logout1_msg fixed bin (35) ext;
dcl  as_error_table_$no_connect_aclass fixed bin (35) ext;
dcl  as_error_table_$no_init_proc fixed bin (35) ext;
dcl  as_error_table_$no_io_attach fixed bin (35) ext;
dcl  as_error_table_$no_line_permission fixed bin (35) ext static;
dcl  as_error_table_$proc_term_msg fixed bin (35) ext;
dcl  as_error_table_$init_term_msg fixed bin (35) ext;
dcl  as_error_table_$proc_term_loop_msg fixed bin (35) ext;
dcl  as_error_table_$ask_for_help fixed bin (35) ext;
dcl  as_error_table_$pw_msg fixed bin (35) ext;
dcl  as_error_table_$npw_msg fixed bin (35) ext;
dcl  as_error_table_$npw_again_msg fixed bin (35) ext;
dcl  as_error_table_$shutdown fixed bin (35) ext;
dcl  as_error_table_$special_session fixed bin (35) ext;
dcl  as_error_table_$coming_up fixed bin (35) ext;
dcl  as_error_table_$try_again fixed bin (35) ext;
dcl  as_error_table_$detach fixed bin (35) ext;
dcl  as_error_table_$process_create_fail fixed bin (35) ext;
dcl  as_error_table_$new_pw_err fixed bin (35) ext;
dcl  as_error_table_$generated_pw_err fixed bin (35) ext;
dcl  as_error_table_$login_args fixed bin (35) ext;
dcl  as_error_table_$no_signal fixed bin (35) ext;
dcl  as_error_table_$bump_cancelled fixed bin (35) ext;
dcl  as_error_table_$sys_full fixed bin (35) ext;
dcl  as_error_table_$tty_no_room fixed bin (35) ext;
dcl  as_error_table_$only_after_login_msg fixed bin (35) ext;
dcl  as_error_table_$now_logged_in fixed bin (35) ext;
dcl  as_error_table_$give_connect_request fixed bin (35) ext;
dcl  as_error_table_$give_connect_request_no_disc fixed bin (35) ext;
dcl  as_error_table_$unknown_request_msg fixed bin (35) ext;
dcl  as_error_table_$rq_invalid_now_msg fixed bin (35) ext;
dcl  as_error_table_$unknown_arg_msg fixed bin (35) ext;
dcl  as_error_table_$user_typed_quit fixed bin (35) ext;
dcl  as_error_table_$logout_disconnected_msg fixed bin (35) ext;
dcl  as_error_table_$give_instructions fixed bin (35) ext;
dcl  as_error_table_$not_implemented_msg fixed bin (35) ext;
dcl  as_error_table_$no_such_process_msg fixed bin (35) ext;
dcl  as_error_table_$list_disconnected_msg fixed bin (35) ext;
dcl  as_error_table_$must_give_proc_no fixed bin (35) ext;
dcl  as_error_table_$no_disconnected_procs fixed bin (35) ext;
dcl  as_error_table_$activity_unbump fixed bin (35) ext;
dcl  as_error_table_$bad_password_format fixed bin (35) ext;
dcl  as_error_table_$pw_format_warning fixed bin (35) ext;
dcl  as_error_table_$new_password_indistinct fixed bin (35) ext;
dcl  as_error_table_$help_password fixed bin (35) ext;
dcl  as_error_table_$help_gpw_verify fixed bin (35) ext;
dcl  as_error_table_$help_new_pw fixed bin (35) ext;
dcl  as_error_table_$help_npw_verify fixed bin (35) ext;
dcl  as_error_table_$fpe_caused_logout fixed bin (35) ext;

/* DECLARATION OF INTERNAL STATIC VARIABLES */

dcl  static_label label int static;         /* where to go on error */
dcl  loudsw bit (1) aligned init ("0"b) int static; /* 1 if super-loud */
dcl  ME char (7) int static init ("dialup_") options (constant);
dcl  NL char (1) aligned int static init ("
") options (constant);
dcl  RESERVED_PW_MSG char (39) int static options (constant) init ("The supplied new password is reserved.
");
dcl  wcr char (1) aligned int static;           /* carriage return */
dcl  dum_msg fixed binary (71) int static;      /* dummy ipc message */
dcl  unlock_string char (8) int static options (constant) init ("unlock"); /* msg sent by unlock procedure */
dcl  STOPstop char (8) aligned int static init ("STOPstop") options (constant);
dcl  STOPstop_msg fixed bin (71) based (addr (STOPstop));
dcl  termstop char (8) aligned int static init ("termstop") options (constant);
dcl  termstop_msg fixed bin (71) based (addr (termstop));
dcl  start_proc_chn fixed bin (71) init (-1) int static options (constant); /* dummy event channel for starting process */
dcl  start_proc_msg fixed bin (71) init (-1) int static options (constant); /* dummy message. these are ignored by process */
dcl  greeting_fmt char (100) aligned varying int static;    /* Message format frm as_error_table_ */
dcl  bad_login_word_fmt char (100) aligned varying int static; /* .. */
dcl  (proc_term_fmt, init_term_fmt, proc_term_loop_fmt) char (100) aligned varying int static;
dcl  (logout_fmt, logout_fmt1) char (100) aligned varying int static; /* .. */
dcl  pw_msg char (16) aligned int static;       /* "password" */
dcl  pw_msg_lth fixed bin int static;           /* length of message */
dcl  npw_msg char (20) aligned int static;      /* "new password" */
dcl  npw_msg_lth fixed bin int static;          /* length of message */
dcl  npw_again_msg char (28) aligned int static;        /* "New Password Again:" */
dcl  npw_again_msg_lth fixed bin int static;        /* length, set by dialup_init */
dcl  hangup_msg char (8) aligned int static;        /* we type it when hanging channel */
dcl  hangup_msg_lth fixed bin int static init (8);  /* length of message */
dcl  RANDOM char (32) aligned int static init ("etaiosqwertyuioplkjhgfdsazxcvbnm");
dcl  garbg char (97) aligned int static;        /* password-hiding lines */
dcl  garbg_lth fixed bin int static;            /* length of message */
dcl  lilo_mode fixed bin int static init (1);
dcl  static_fault_sw bit (1) aligned int static init (""b);

/* AUTOMATIC */

dcl  time fixed bin (71);
dcl  (i, j, k, tabsx, userx, lgwd) fixed bin;       /* temps */
dcl  login_word char (16);
dcl  (code, ignore_code) fixed bin (35);        /* std status code */
dcl  password_pronunciation char (16);          /* 8 letters plus 8 hyphens */
dcl  tcode fixed bin (35);              /* errcode */
dcl  (old_pf, new_pf) fixed bin;
dcl  (old_cpu, new_cpu) fixed bin (71);
dcl  (old_pp, new_pp) fixed bin;
dcl  utep ptr;                  /* ptr to answer table entry */
dcl  (p, q, p1) ptr;                /* misc pointers */
dcl  say_hello bit (1);             /* TRUE at login unless logout -hold -brief */
dcl  just_dialed_up bit (1);                /* Distinguaish between dialup and logout-hold */
dcl  user_password char (8);                /* password typed by user. scrambled. */
dcl  temp_password char (8);                /* for checking change */
dcl  ubits bit (72) aligned;                /* trick value for garbage generator */
dcl  jj fixed bin;                  /* temp for password parse */
dcl  (dial_qual, dial_arg1) char (32);          /* for dial command */
dcl  funct char (8) aligned;                /* used at "hand (8)" - event message */
dcl  nc fixed bin;                  /* char count for read */
dcl  (t1, t2) float bin;                /* temps for units message */
dcl  shxx char (8) aligned;             /* error id */
dcl  error_mess char (100) aligned;         /* ... for convert_status_code */
dcl  format char (100) aligned;         /* ... for message formats */
dcl  reason char (168) varying;         /* returned from lg_ctl_ */
dcl  date_time char (24) aligned;           /* character date and time */
dcl  buff char (500) aligned;               /* i-o buffer for writes */
dcl  helphelp bit (1) aligned;          /* 1 if user has many fatal process errors and might need help */
dcl  new_modes char (100);              /* New mode string for terminal. */
dcl  old_type char (32);                /* terminal type before calling parse_login_line_ */
dcl  type_to_set char (32);
dcl  tab_string char (512) varying;
dcl  modes_string char (512);               /* to allow room for "force,init," */
dcl  simulated_wakeup_sw bit (1);           /* indicates simulated wakeup entry called */
dcl  temp_atep ptr;                 /* temporary answer table entry ptr */

dcl  (wakeup_for_channel,               /* wakeup over a cdte event channel */
     wakeup_for_process,                /* wakeup over an ate event channel */
     wakeup_from_as,                /* wakeup came from answering service */
     wakeup_from_ring_zero,             /* wakeup came from ring zero */
     wakeup_from_user               /* wakeup came from user process */
     ) bit (1) aligned init (""b);          /* switches to keep track of where wakeup came from */

dcl  tra_vec fixed bin;             /* copy of either cdte.tra_vec or ate.destroy_flag */

dcl  (have_ate, have_cdte) bit (1) aligned init (""b);  /* "1"b if respective ptrs ^= null */

dcl  (tname, tsignal_type) char (64) varying;       /* for printing in trace and error messages */
dcl  tanswb char (4);
dcl  (tstate, ttv, tinuse) fixed bin;           /* copied from either cdte or ate */

dcl  1 term_info like terminal_info;
dcl  1 set_type_info like set_term_type_info;
dcl  accode fixed bin (35);

dcl  (pdtp, pdtep) ptr init (null);
dcl  connect_immediate bit (1) aligned init (""b);
dcl  logout_hold bit (1) aligned init (""b);
dcl  logout_brief bit (1) aligned init (""b);

dcl  1 write_status_info aligned,
       2 evchn fixed bin (71),
       2 output_pending bit (1);


/* DECLARATION OF BASED STRUCTURES */

dcl  1 ev_msg based (msg_ptr) aligned,          /* interprocess event message */
       2 ev_channel fixed bin (71),         /* channel id */
       2 ev_message fixed bin (71),         /* what user wants to tell me */
       2 fromproc bit (36),             /* user's process id */
       2 origin,
         3 dev_signal bit (18) unal,            /* twx if hardcore */
         3 sender_ring bit (18) unal,           /* execution ring at call to singal */
       2 data_ptr ptr;              /* ptr to channel definition table entry (see asu_) */

dcl  signal_type char (8) aligned based (p1);       /* overlay when user signal is 8 chars */

dcl  1 bc based (addr (funct)) aligned,         /* overlay for terminate_proc signal */
       2 signal_type1 char (4),         /* "term" usually */
       2 code fixed bin;                /* system error code */

dcl  1 new_proc_auth based (p1) aligned,        /* structure from new_proc -auth */
       2 np_signal char (2) unaligned,          /* "np" */
       2 authorization bit (54) unaligned;      /* the new authorization */

dcl  1 based_tcode based (addr (tcode)) aligned,        /* This is used to make sure that */
       2 tcode_left_half bit (18) unal,         /* .. nobody is pulling a fast one */
       2 xxx bit (18) unal;             /* .. because convert_status_code tends to blow up */

%page;
/* dialup_ is the procedure associated with the TTY event
   call channels and is called by the Wait Coordinator whenever an interrupt is
   signalled by one of the devices to which the answering-service is currently listening.
   dialup_ never calls the wait_coordinator  (directly nor indirectly), rather,
   it sets conditional-go to variable cdte.tra_vec to the label desired and returns to
   the wait coordinator. Upon re-invocation it transfers to that point.  */

    simulated_wakeup_sw = "0"b;         /* called thru normal entry */
    go to dialup_begin;

simulated_wakeup: entry (msg_ptr);          /* entry used by multiplexer_mgr_ */

    simulated_wakeup_sw = "1"b;

dialup_begin:
    if msg_ptr = null then go to evil3;     /* Network programs could do this by mistake */
    if ansp = null then go to evil2;        /* called before initialization */

/* Initialize */

    p1 = addr (ev_msg.ev_message);      /* get ptr to 72-bit data item */
    static_label = exit;            /* setup non-local go */
    tcode = 0;              /* Clear temp code. */
    just_dialed_up = "0"b;          /* .. */
    call condition_ ("any_other", ucs);     /* Set up handler for any faults. */
                        /* if any trouble */
    anstbl.current_time = clock ();     /* Read clock. */

/*  call cpu_time_and_paging_ (old_pf, old_cpu, old_pp); /* */

    call as_meter_$enter (DIALUP_METER);

/* See where the wakeup came from, and over which kind of channel (ate or cdte) */

    if baseno (ev_msg.data_ptr) = baseno (scdtp) then do; /* cdte */
         cdtep = ev_msg.data_ptr;           /* copy pointer to cdte */
         wakeup_for_channel = "1"b;     /* remember which kind */
         utep = cdte.process;           /* will be null if not valid */
         tra_vec = cdte.tra_vec;            /* copy the tra_vec we want to use */
         if cdte.in_use < NOW_DIALED     /* it should be, that is */
        & utep ^= null then         /* trap bugs */
        if tra_vec ^= WAIT_TANDD_HANGUP &   /* is it OK to have non-null atep? */
             tra_vec ^= WAIT_FIN_TANDD_ATTACH &
             tra_vec ^= WAIT_FIN_PRIV_ATTACH &
             tra_vec ^= WAIT_DISCARD_WAKEUPS then do; /* out of luck */
             call sys_log_ (0, "dialup_: non-null atep (^p) for cdte (^p,^a), tv=^d,inuse=^d",
            utep, cdtep, cdte.name, cdte.tra_vec, cdte.in_use);
             utep = null;
             cdte.process = null;
        end;
    end;                    /* end wakeup over channel */

    else if baseno (ev_msg.data_ptr) = baseno (ansp) then do; /* ate */
         utep = ev_msg.data_ptr;            /* copy ptr to ate */
         wakeup_for_process = "1"b;     /* remember which kind */
         cdtep = ute.channel;           /* unpack ptr to cdte */
         if cdtep ^= null then
        if cdte.process ^= utep then do;    /* trap bugs */
             call sys_log_ (0, "dialup_: re-used cdte (^p,^a) by ate ^p, destroy_flag=^d",
            cdtep, cdte.name, utep, ute.destroy_flag);
             cdtep = null;
             if ^ute.disconnected then do;
            call sys_log_ (0, "dialup_: turning on disconnected flag for ate ^p", utep);
            ute.disconnected = "1"b;
            if ute.whotabx > 0 then
                 whotab.e (ute.whotabx).disconnected = "1"b;
             end;
        end;                /* end cdte.process not equal atep */

         if ute.disconnected & cdtep ^= null then do;
        call sys_log_ (0, "dialup_: turning off disconnected flag for ate ^p, cdte ^p,^a",
             utep, cdtep, cdte.name);
        ute.disconnected = ""b;
        if ute.whotabx > 0 then
             whotab.e (ute.whotabx).disconnected = ""b;
         end;

         tra_vec = ute.destroy_flag;        /* copy the tra vec that we want to use */
    end;                    /* end wakeup over ate channel */

    else goto evil1;                /* data pointer points to neither cdt nor answer table */

    if cdtep ^= null then have_cdte = "1"b;     /* checking switches is cheaper than testing ptrs for null */
    if utep ^= null then have_ate = "1"b;

    if loudsw then call trace;          /* now we have enough info to print trace message if wanted */

/* If wakeups on a channel are arriving at an excessive rate, hang up.
   This is to prevent Initializer process overload or tty buffer space exhaustion.
   An excessive rate is defined to be more than COUNT wakeups within INTERVAL,
   where COUNT and INTERVAL are installation parameters with long, untypeable names.
   Whenever we get through an interval with fewer than COUNT wakeups,
   we reset the counter and start a new interval. Thus, in the most extreme
   case, we could get 2 * COUNT -1 wakeups within INTERVAL + DELTA before we decide to hang up. */

    if wakeup_for_channel then
         if cdte.recent_wakeup_time + installation_parms.chn_wakeup_error_loop_seconds * 1000000
        < anstbl.current_time then do;
        cdte.recent_wakeup_count = 1;
        cdte.recent_wakeup_time = anstbl.current_time;
         end;
         else do;
        cdte.recent_wakeup_count = cdte.recent_wakeup_count + 1;
        if cdte.recent_wakeup_count > installation_parms.chn_wakeup_error_loop_count then do;
             cdte.recent_wakeup_time = 0;   /* reset the wakeup loop counters */
             cdte.recent_wakeup_count = 0;  /* we'll start counting again at the next dialup */
             call astty_$tty_abort (cdtep, 3, code); /* flush all input and output */
             go to listen_again;        /* go hang up; we got too many wakeups too quickly */
        end;
         end;

/* We know what kind of wakeup it is. Now see where it's from. */

    if ev_msg.origin.sender_ring = ""b then     /* from ring zero? */
         wakeup_from_ring_zero = "1"b;

    else if ev_msg.fromproc = as_procid then    /* or from answering service */
         wakeup_from_as = "1"b;

    else do;                    /* either legal wakeup from user, or illegal wakeup
                           from someone playing games or experimenting */
         if have_ate then           /* if we have an ate */
        if ute.active = NOW_HAS_PROCESS /* with a live process */
             & ute.proc_id = ev_msg.fromproc then /* and the wakeup is from that process */
             wakeup_from_user = "1"b;       /* then it is legal */

         if ^wakeup_from_user then goto evil;   /* illegal, so log it and exit */
    end;

/* Now, decide how to handle the wakeup. That's a function of all the above, plus the contents of the event message. */

    if wakeup_from_ring_zero then goto fan_out; /* trust all wakeups from ring zero */

/* Here, we special case some of the wakeups that the answering service sends to itself.
   This section of code is OLD, and poorly-understood. It might benefit from redesign and rewriting.
   But we risk introducing bugs by making unnecessary changes to poorly-understood code,
   so we are leaving it essentially unchanged, and adding comments to describe what we thing it does. */



    if wakeup_from_as then do;          /* I can signal myself. */

/* A "device" wakeup comes from ARPANET software, running in the Initializer process.
   This is like a device signal from the ring zero tty dim. So we treat it like a wakeup from ring zero. */

         if signal_type = "device  " then go to fan_out; /* software-simulated device signal */

/* Here, we catch alarm___ wakeups for tty channels (but not for processes).
   In some cases, we don't just goto the handler specified by tra_vec. This is tricky, because any time
   a handler is changed to use an alarm timer, this code must be made aware of it. */

         if signal_type = "alarm___" & wakeup_for_channel then do; /* See if timeout. */

/* If the channel is not dialed up (or rather, it was not dialed up at the end of the last wakeup), then ignore the alarm. */

        if cdte.in_use < NOW_DIALED then go to fals; /* if user is not home, ignore */

/* If there is a logged in user on this channel, assume it is a bump. NOTE: this might be a mistake:
   we set an alarm on the process, not the channel, for bumps. But this statement is probably harmless,
   so we leave it as it has been for years. */

        if cdte.in_use > NOW_DIALED then go to hand (8); /* if user is logged in, probably bump */

/* Here, we have to special case the alarm timer set when waiting for output to finish before hanging up a line. */

        if tra_vec = WAIT_BEFORE_HANGUP then
             goto hand (WAIT_BEFORE_HANGUP);

/* Since in_use is equal to NOW_DIALED, assume the user is in the process of logging in, and the 3 minute timer
   went off. Before hanging up on him, do a read to see if he just typed something. If he did, give him a break, and
   go process it instead of hanging up. (Note that we no longer have a timer running.) */

        call astty_$tty_read (cdtep, addr (buff), nc, code); /* Dialed up, no process. */
        if code = 0 then            /* If ev call backlog, mayhave finished line */
             if nc > 0 then do;      /* .. any chars there? */
            j = cdte.tra_vec;       /* verify the computed goto */
            if j < lbound (hand, 1) then go to eek;
            if j > hbound (hand, 1) then go to eek;
            go to timeout (j);      /* pick up where we left off */
                        /* set up new timer? */
             end;
        go to listen_again;         /* User didn't login in 3 minutes */
         end;

/* It was not an alarm for a channel. It might be an alarm for a process, or some other kind of wakeup
   for either a process or a channel. If tra_vec is less than WAIT_LOGOUT_SIG, we are in the middle of a login,
   waiting for either a login command or a password. In that situation, we ignore a termstop (for unknown historical reasons),
   and we assume any other wakeup is an operator bump command, so we change the tra_vec to go to the process destructon code. */

         if tra_vec < WAIT_LOGOUT_SIG then       /* If not a regular user. */
        if signal_type = "termstop" then goto fals0; /* Ignore if extra */
        else tra_vec = WAIT_LOGOUT_SIG; /* Make opr command into command even if login pending */

/* Now go wherever tra_vec says to go. Most likely, we will be bumping a user. */

         go to fan_out;             /* Go bump user. */
    end;                    /* end wakeup from answering service */

/* ***** END of OLD CODE */

/* It appears that it is ok to fall thru to fan_out, now */

/* * COMMENT OUT APPARENTLY UNNECESSARY CODE: */
/* *    if cdte.tra_vec > WAIT_LOGOUT_SIG then go to hand (9); /* Nothing else if waiting logout */
/* *    if cdte.tra_vec = WAIT_LOGOUT_SIG then      /* also, allow process to log itself out */
/* *         if ev_msg.fromproc = ate.proc_id then do;  /* Assume ipc_ is secure. Our records and his must agree. */
/* *        user_signal = "1"b;         /* note that is from user */
/* *        go to hand (8);         /* Go directly to logout point. */
/* *         end;/* */
/* *    go to evil;             /* oh, no you don't */

fan_out:                        /* go where tra_vec says to go */

/* Check validity of wakeup/tra_vec combination, before going anywhere */

    if signal_type = "detach" & tra_vec = WAIT_LOGOUT_SIG then ; /* detach is always ok */

    else if tra_vec = WAIT_LOGOUT_SIG       /* if tra_vec says to expect a process termination signal */
        | tra_vec = WAIT_LOGOUT
        | tra_vec = WAIT_LOGOUT_HOLD
        | tra_vec = WAIT_NEW_PROC then do;  /* then there must be a process */
         if ^have_ate then do;          /* if there's no ate, there can't be a process */
        call sys_log_ (2, "dialup_: Program error: null atep with per-process tra_vec value");
        goto fals;          /* fals prints all the relevant variables */
         end;
    end;                    /* end tra_vec says to expect process termination signal */

    else                    /* but if tra_vec is anything else, wakeup must be for cdte */
         if wakeup_for_process then do;     /* if wakeup isn't for a channel, complain and exit */
         if tra_vec = WAIT_DETACH
        | tra_vec = WAIT_REMOVE
        | tra_vec = WAIT_DELETE_CHANNEL then do;/* these can be for a process or a channel */
        if ^have_cdte then do;      /* but we must have a channel */
             call sys_log_ (2, "dialup_: Program error: null cdtep with per-channel tra_vec value");
             goto fals;         /* fals prints all the relevant variables */
        end;
         end;
         else do;               /* rest of tra_vec values are restricted to per-channel wakeups */
        call sys_log_ (2, "dialup_: Program error: per-process wakeup with per-channel-only tra_vec value");
        goto fals;
         end;
    end;

    if wakeup_for_process then          /* trap bug */
         if ute.active = NOW_FREE then      /* spurious wakeup for free ate */
        goto fals0;         /* go log and ignore it */

    if tra_vec < lbound (hand, 1)            /* Subscript range check. */
         | tra_vec > hbound (hand, 1) then do;   /* if this fails, cdt or anstbl is garbaged. */
eek:         if simulated_wakeup_sw then
        if tra_vec = 0 then goto exit1; /* multiplexer_mgr_ called too soon */
         call sys_log_ (2, "dialup_: ^[CDT^;answer table^] damaged at ^[^p^s^;^s^p^], tra_vec=^d",
        wakeup_for_channel, wakeup_for_channel, cdtep, utep, tra_vec);

/* *    call asu_$remove_cdte (cdtep);      /* remove channel, if cdte is not so garbaged that we can't */
         goto exit1;                /* clean up metering and exit */
    end;

    go to hand (tra_vec);           /* this is fast in v2pl1 */

/* Come here when a terminal channel dials up. */

hand (1): cdte.n_dialups = cdte.n_dialups + 1;      /* count number of times TTY has been dialed up */
    cdte.dialup_time = anstbl.current_time;     /* Note time of dialup. */

    call astty_$tty_state (cdtep, code);        /* make sure tty now dialed up. */
    if code ^= 0 then go to chn_error;      /* go get rid of channel if any error */

    if cdte.state < TTY_DIALED then go to listen_again; /* Transient wakeup. Phone is hung now, give up. */

    cdte.in_use = NOW_DIALED;           /* record that channel is dialed up */

    call update_term_info;

    if cdte.line_type ^= LINE_TELNET then       /* if network channel, we just got host id */
         cdte.tty_id_code = "none";     /* but for other channels, we read answerback below */

    if cdte.initial_terminal_type ^= ""     /* if type specified in CMF */
    then type_to_set = cdte.initial_terminal_type;
    else do;                    /* else figure it out from line-type/baud-rate */
         call ttt_info_$default_term_type (term_info.line_type, term_info.baud_rate, type_to_set, code);
         if code ^= 0 then go to ttt_error;

         if type_to_set = ""
         then do;
        call sys_log_$error_log (2, 0, ME, "Unable to determine initial terminal type for channel ^a",
             cdte.name);
        go to ttt_error;
         end;
    end;

    call change_type (type_to_set, "0"b, "0"b, code); /* whatever it's supposed to be, set it */
    if code ^= 0 then go to chn_error;

    call astty_$tty_abort (cdtep, 1, code);     /* flush any trash */
    if code ^= 0 then go to chn_error;

    if cdte.line_type ^= LINE_TELNET        /* Network channels can't return answerback. */
         & ^cdte.flags.dont_read_answerback     /* or they might have said not to try */
    then do;
         call astty_$tty_order (cdtep, "wru", null, code); /* Initiate answerback read and send us a wakeup */
                        /* whether answerback exists or not */
         if code ^= 0 then go to chn_error;     /* Now that MCS is in, expect no error */

         cdte.tra_vec = WAIT_ANSWERBACK;        /* and wait for it */
         go to exit1;               /* Wait for tty dim Wakeup */

hand (2):                       /* WAIT_ANSWERBACK - Got answerback wakeup */
         call astty_$tty_get_chars (cdtep, addr (buff), nc, code); /* read it & see if it's there */
                        /* use get_chars 'cause some answerbacks don't end in a newline */
         if code ^= 0 then go to chn_error;
         if nc > 0 then do;          /* if there is an answerback, process it */
timeout (2):                    /* come here if we timeout & find answerback there */
        call ttt_info_$decode_answerback (substr (buff, 1, nc), (cdte.cur_line_type), type_to_set,
             cdte.tty_id_code, code);
        if code ^= 0 then do;
             type_to_set = "";
             cdte.tty_id_code = ""; ;
        end;

        if cdte.tty_id_code = ""
        then cdte.tty_id_code = "none";
        if type_to_set ^= "" &
             type_to_set ^= cdte.current_terminal_type /* answerback says different terminal type */
        then do;
             call change_type (type_to_set, "0"b, "0"b, code);
             if code ^= 0 then go to chn_user_error;
        end;

        call astty_$tty_order (cdtep, "store_id", addr (cdte.tty_id_code), ignore_code);
        call astty_$tty_abort (cdtep, 1, code); /* flush junk from multi-line answerbacks */
        if code ^= 0 then go to chn_error;
         end;
    end;

    call set_tabs_and_modes (code);     /* Get terminal normalized. */
    if code ^= 0 then go to chn_user_error;

/* Here is the login sequence. First, tell him it's Multics, etc. */

    say_hello = "1"b;               /* Always be polite to strangers. */
    just_dialed_up = "1"b;          /* .. */

/* Come here after a logout -hold or after a dialed terminal's master process terminates */

login:
    cdte.count = 1;             /* we count login tries and hang up if there are too many */
    call turn_printer_on (code);            /* Make sure user can see this */
    if code ^= 0 then go to chn_error;

    call astty_$tty_force (cdtep, addr (NL), length (NL), code);
    if code ^= 0 then go to chn_error;      /* send NL */

    if cdte.flags.ck_answerback then do;        /* If we should check answerback */
         call match_star_name_ (cdte.tty_id_code, cdte.answerback, code);
         if code ^= 0
         then if code ^= error_table_$badstar   /* ignore problems with starname */
        then do;
             call sys_log_ (2, "dialup_: wrong answerback on ^a (^a); expected ""^a"", got ""^a"".",
            cdte.name, cdte.comment, cdte.answerback, cdte.tty_id_code);
                        /* now tell user */
             call asu_$write_chn_message (cdtep, as_error_table_$bad_answerback, shxx, code);
             if code ^= 0 then go to chn_error; /* handle random errors */
             go to listen_again;        /* hangup the terminal */
        end;
    end;

    if say_hello then call hello (0);       /* Greeting message. */
    if code ^= 0 then go to chn_error;      /* too bad */

    if anstbl.session = "shutdown"      /* if user dials up during shutdown */
         & ^cdte.flags.hardwired then       /* and not hardwired chn. (that "dials up" right after hangup) */
         goto listen_again;         /* hang up */
    if cdte.flags.hardwired
    then time = 1e20b;              /* don't bug hardwired channels */
    else time = installation_parms.login_time;  /* ask for wakeup if user asleep */
    call timer_manager_$alarm_wakeup (time, "11"b, cdte.event);

    if just_dialed_up then          /* Is this time for initial command? */
         if cdte.flags.execute_initial_command then do; /* .. is there one? */
        buff = cdte.initial_command;        /* Yes. Do it. */
        nc = length (cdte.initial_command);
        go to timeout (3);          /* Skip the first read call. */
         end;
%page;

/* Come here after saying "Login incorrect. Please try again or type help for instructions." */

read_login_line:
    cdte.tra_vec = WAIT_LOGIN_LINE;     /* Set up transfer vector. */

hand (3): call astty_$tty_read (cdtep, addr (buff), nc, code); /* read the login line */
    if code ^= 0 then go to chn_error;
    if nc <= 0 then go to exit1;         /* is line in yet? */

/* At this point we have a login line. Parse it. */

timeout (3):                    /* come here if line read during timeout */
    call login_parse_ (addr (buff), nc, login_word, k, jj, tcode); /* Get login-word from line. */
    if tcode = error_table_$noarg then go to read_login_line; /* nothing but white space */
    if tcode ^= 0 then go to try_again_code;

    do lgwd = 1 to n_login_words while (login_word ^= login_words (lgwd));
    end;

    if anstbl.session ^= "normal  " then        /* Check for Special Session */
         if lgwd <= 6 then           /* (normal login) */
        go to reject_login_word;        /* ... not allowed during Special Session */
         else if lgwd <= n_login_words then ;    /* (preaccess command) */
         else if login_word = anstbl.login_word /* (special session login) */
             & (anstbl.session ^= "shutdown"    /* and not shutdown */
             | anstbl.login_word ^= "shutdown") then /* or shutting down but emergency logins are allowed */
        lgwd = 1;               /* convert to "login" */
         else go to reject_login_word;      /* Don't let user try to guess magic word */
    else if lgwd > n_login_words then        /* Normal Session. Unknown word */
         go to bad_login_word;          /* Tell user. Give 'em another chance */

/* Note that anonymous users cannot login during special session. */

    if lgwd <= 6 then do;            /* Command is of login type. Parse args. */
         call grab_ute;             /* get a user_table_entry */
         call ipc_$decl_ev_call_chn (ute.event, dialup_, utep, INT_LOGIN_PRIO, code);
         if code ^= 0 then do;
        call convert_ipc_code_ (code);
        call sys_log_$error_log (2, code, ME,
             "Unable to declare handler for ev chn ^24.3b for ate ^p for ^a", ute.event, utep, cdte.name);
        call asu_$write_chn_message (cdtep, as_error_table_$dialup_error, shxx, code);
        if code ^= 0 then goto chn_error;
        goto listen_again;
         end;
         ute.login_code = login_word;
         if nc <= jj then do;            /* Is line currently empty? */
read_login_args:    cdte.tra_vec = WAIT_LOGIN_ARGS; /* Set up wait point */
        ute.count = lgwd;           /* Remember what we're up to. */
        call asu_$write_chn_message (cdtep, as_error_table_$login_args, shxx, code);
        if code ^= 0 then go to chn_error;

hand (4):       call astty_$tty_read (cdtep, addr (buff), nc, code); /* Read rest of login command */
        if code ^= 0 then go to chn_error;
        if nc <= 0 then go to exit1;     /* Wait for him to type */
timeout (4):    jj = 1;             /* Now parse the rest of the line. */
        lgwd = ute.count;           /* .. and then execute the command. */
         end;
         old_type = cdte.current_terminal_type; /* save this in case parse_login_line_ changes it */
         ute.tty_id_code = cdte.tty_id_code;    /* as_who will want this */

         call parse_login_line_ (addr (substr (buff, jj, 1)), nc - jj + 1, utep, new_modes, error_mess, code);
         if code = error_table_$noarg then go to read_login_args; /* If user gave no args, ask for them. */
         if code ^= 0 then do;          /* If any error, fuss. */
        cdte.current_terminal_type = old_type;  /* because we won't do any changing this time */
bad_login_dial_slave_request:
        call ioa_$rs (convert_message (code), buff, i, error_mess); /* Object to bad argument. */
        call astty_$tty_force (cdtep, addr (buff), i, code);
        if code ^= 0 then go to chn_error;
        go to try_again;
         end;

         if ute.ur_at.brief then            /* if user SPECIFIED -lg or -bf */
        logout_brief = ute.at.brief;
         connect_immediate = cdte.immediate_arg;

         if cdte.current_terminal_type ^= old_type  /* user changed his terminal type */
         then do;
        call change_type (cdte.current_terminal_type, "1"b, "0"b, code);
        if code ^= 0 then go to chn_user_error;
         end;
         else if ute.uflags.send_initial_string /* he said -ttp but specified same type */
         then do;
        call set_tabs_and_modes_gently (code);
        if code ^= 0 then go to chn_user_error;
         end;

         if new_modes ^= "" then do;        /* Did user specify "-modes" ? */
        call astty_$tty_changemode (cdtep, (new_modes), code);
        if code = -1 then go to chn_error;  /* Check if user hung up. */
        if code ^= 0 then do;       /* If can't make modes, dump login attempt. */
             j = lgwd + mod (lgwd, 2);  /* get long name of login command */
             call ioa_$rs ("^a: ^a ^a", buff, i, login_words (j), convert_message (code), new_modes);
             call astty_$tty_force (cdtep, addr (buff), i, code);
             if code ^= 0 then go to chn_error;
             go to try_again;
        end;
         end;
    end;

    go to login_handler (lgwd);         /* Dispatch on login command. */
%page;

bad_login_word:
    call ioa_$rs (bad_login_word_fmt, buff, i, login_word); /* Not legal login word. Complain. */
    call astty_$tty_force (cdtep, addr (buff), i, code); /* .. */
    if code ^= 0 then go to chn_error;
    call astty_$tty_abort (cdtep, 1, code);     /* flush type-ahead */
    if code ^= 0 then go to chn_error;
    go to try_again;

user_typed_quit:
    call asu_$write_chn_message (cdtep, as_error_table_$user_typed_quit, shxx, code);
    if code ^= 0 then go to chn_error;
    go to try_again;

try_again_code:
    call print_ascii_msg (code, "");

try_again:                  /* transfer point for repeat login attempts */
    call free_ute;              /* If a ute was allocated, free it */
    cdte.count = cdte.count + 1;            /* Count errors. */
    if cdte.count > installation_parms.login_tries then go to listen_again;
                        /* Has user tried us too many times? */
    call asu_$write_chn_message (cdtep, as_error_table_$try_again, shxx, code);
    if code ^= 0 then go to chn_error;
    if cdte.dialup_flags.ppm then do;
         call astty_$tty_force (cdtep, addrel (addr (as_data_$special_2741_message), 1),
        length (as_data_$special_2741_message), code);
         if code ^= 0 then go to chn_error;
    end;
    go to read_login_line;          /* Read another line. */

reject_login_word:
    if anstbl.session = "shutdown" then     /* Is the system coming down? */
         tcode = as_error_table_$shutdown;      /* Yes, tell user */
    else if anstbl.session = "init    " then    /* Not up yet. */
         tcode = as_error_table_$coming_up;     /* Tell him we will be up shortly. */
    else tcode = as_error_table_$special_session;   /* Go way kid you bother me */
    call asu_$write_chn_message (cdtep, tcode, shxx, code); /* .. */
    if code ^= 0 then go to chn_error;
    if tcode = as_error_table_$special_session then go to try_again; /* Be a little loose */
    else go to listen_again;            /* Hang up on the fella. */
%page;

login_handler (5):                  /* "ep" */
login_handler (6):                  /* "enterp" */
    if cdte.disconnected_proc_command ^= 0 then do; /* -connect specified */
no_anon_connect_loop:
         call asu_$write_chn_message (cdtep, as_error_table_$no_disconnected_procs, shxx, code);
         if code ^= 0 then go to chn_error;
         go to try_again;
    end;

    ute.anonymous = 1;              /* Set anonymous-login flag. */
    ute.pw_flags.cpw = "0"b;            /* Can't change password. */
    ute.pw_flags.generate_pw = "0"b;        /* ... */

login_handler (1):                  /* "l" */
login_handler (2):                  /* "login" */
read_password:                  /* for "slave" and "dial" */
    if ute.pw_flags.mask_ctl = DERIVE_MASK      /* user didn't say -pf or -npf */
    then if cdte.dialup_flags.cpo           /* this terminal type's printer depends on id */
         then if substr (cdte.tty_id_code, 1, 1) < "A"
        then ute.pw_flags.mask_ctl = DONT_MASK;
        else ute.pw_flags.mask_ctl = DO_MASK;

    if ute.pw_flags.mask_ctl = DONT_MASK        /* either as result above or it already was */
    then do;
         call astty_$tty_order (cdtep, "accept_printer_off", null, code);
         if code ^= 0 then go to chn_error;
    end;

    else if ute.pw_flags.mask_ctl = DO_MASK     /* this terminal really doesn't have printer_off */
    then do;
         call astty_$tty_order (cdtep, "refuse_printer_off", null, code);
         if code ^= 0 then go to chn_error;
    end;

    user_password = "";             /* Preset password to blanks */
    call astty_$tty_force (cdtep, addr (pw_msg), pw_msg_lth, code); /* Ask for password. */
    if code ^= 0 then go to chn_error;

    call type_black;                /* Hide password */

    if ute.pw_flags.cpw then do;            /* If changing password, need special stuff. */
         cdte.tra_vec = WAIT_OLD_PASSWORD;      /* Set transfer vector so we come back here. */
hand (5):        call astty_$tty_read (cdtep, addr (buff), nc, code); /* read password */
         if code ^= 0 then go to chn_error;
         if nc <= 0 then go to exit1;        /* Was anything typed? */
timeout (5):                    /* come here if line read during timeout */
         call login_parse_$password (addr (buff), nc, user_password, k, jj, tcode); /* Get password from line. */
         if tcode = error_table_$noarg then go to hand (5); /* Ignore all blank line. */
         call turn_printer_on (code);
         if code ^= 0 then go to chn_error;
         if tcode ^= 0 | k > length (user_password) then do; /* just a slap on the wrist */
        call asu_$write_chn_message (cdtep, as_error_table_$pw_format_warning, shxx, code);
        if code ^= 0 then go to chn_error;
         end;
         if user_password = "HELP" | user_password = "help" | user_password = "?" then do;
        call asu_$write_chn_message (cdtep, as_error_table_$help_password, shxx, code);
        if code ^= 0 then go to chn_error;
        go to login_handler (2);
         end;
         if user_password = "quit" | user_password = "QUIT" then go to user_typed_quit;
         ute.old_password = scramble_ (user_password);/* Stow in anstbl, all mashed up. */
         user_password = "";            /* Keep secure */
         buff = "";             /* .. */

         if ute.pw_flags.generate_pw        /* does user want us to give pw? */
         then do;               /* get one that is 6 chars long */
        do k = 1 to 5;          /* allow up to 5 tries to generate a different pw */

             call generate_word_ (user_password, password_pronunciation, 6, 6);
             ute.generated_pw = scramble_ (user_password); /* save it for later */
             if ute.generated_pw ^= ute.old_password then go to have_different_pw;
        end;
new_pw_same_as_old:
        call asu_$write_chn_message (cdtep, as_error_table_$new_password_indistinct, shxx, code);
        if code ^= 0 then go to chn_error;
        go to try_again;
have_different_pw:
        call ioa_$rs (convert_message (as_error_table_$generated_pw_msg),
             buff, i, user_password, password_pronunciation);

        user_password = "";         /* To the best of my recollection, Senator ... */
        password_pronunciation = "";        /* at that point in time ... */
        call astty_$tty_force (cdtep, addr (buff), i, code); /* show user the generated password */
        buff = "";          /* I don't remember a thing. */
        if code ^= 0 then go to chn_error;  /* (clear buff before checking code!) */
         end;                   /* end -gpw do group */

/* For either -gpw or -cpw, we say: "New Password:" at this point. */

prompt_npw:    call astty_$tty_force (cdtep, addr (npw_msg), npw_msg_lth, code);
         if code ^= 0 then goto chn_error;

         if ^ute.pw_flags.generate_pw then do;  /* User said -cpw; wait for him to type it,
                           and then ask him to repeat it */
        call type_black;            /* turn off printer or type mask, to hide new password */
        cdte.tra_vec = WAIT_NEW_PASSWORD;   /* remember where to resume after user types it */

hand (7):       call astty_$tty_read (cdtep, addr (buff), nc, code);
        if code ^= 0 then goto chn_error;
        if nc <= 0 then goto exit1;      /* if user has not typed it yet, go 'way 'til he does */

timeout (7):
        call login_parse_$password (addr (buff), nc, temp_password, k, jj, tcode);
        if tcode = error_table_$noarg then goto hand (7); /* if blank line, read again */
        call turn_printer_on (code);
        if code ^= 0 then goto chn_error;
        if tcode ^= 0 | k > length (temp_password) then do;
bad_password_format:     call asu_$write_chn_message (cdtep, as_error_table_$bad_password_format, shxx, code);
             if code ^= 0 then go to chn_error;
             go to try_again;
        end;
        if temp_password = "help" | temp_password = "HELP" | temp_password = "?" then do;
             call asu_$write_chn_message (cdtep, as_error_table_$help_new_pw, shxx, code);
             if code ^= 0 then go to chn_error;
             go to prompt_npw;
        end;
        if temp_password = "quit" | temp_password = "QUIT" then go to user_typed_quit; /* giving up? */

        temp_password = scramble_ (temp_password); /* working with scrambled versions is more secure */
        buff = "";          /* be sure unscrambled password is blanked out */
        if temp_password = ute.old_password then
             goto new_pw_same_as_old;       /* if you say -cpw, you should change it! */
prompt_npw_vfy: call astty_$tty_force (cdtep, addr (npw_again_msg), npw_again_msg_lth, code);
                        /* ask for repeat of new password */
        if code ^= 0 then goto chn_error;

        ute.generated_pw = temp_password;   /* save new pw in anstbl entry while waiting for repeat */
         end;                   /* end of -cpw do group */

         call type_black;           /* turn off printer or type mask, to hide new password */

    end;                    /* end of -gpw or -cpw do group */

    cdte.tra_vec = WAIT_PASSWORD;           /* Set transfer vector to come back here. */

/* At this point, we are waiting for one of three things:
   1) user to repeat new password, if -cpw;
   2) user to type generated password for the first time, if -gpw;
   3) user to type current password, if neither -cpw or -gpw.
*/

hand (6): call astty_$tty_read (cdtep, addr (buff), nc, code); /* read the password */
    if code ^= 0 then go to chn_error;
    if nc <= 0 then go to exit1;         /* wait for him */
timeout (6):                    /* come here if line read during timeout */
    call login_parse_$password (addr (buff), nc, user_password, k, jj, tcode); /* extract password */
    if tcode = error_table_$noarg then go to hand (6);/* Ignore all blank line. */
    call turn_printer_on (code);
    if code ^= 0 then go to chn_error;
    if tcode ^= 0 | k > length (user_password) then  /* something naughty */
         if ^ute.pw_flags.cpw then do;      /* this is real password */
                        /* so just make it a warning */
        call asu_$write_chn_message (cdtep, as_error_table_$pw_format_warning, shxx, code);
        if code ^= 0 then go to chn_error;
         end;                   /* if -cpw, it has to match, anyhow! */
    if user_password = "quit" | user_password = "QUIT" then go to user_typed_quit; /* he wants to give up */
    if user_password = "help" | user_password = "HELP" | user_password = "?" then do;
         if ute.pw_flags.cpw then
        if ute.pw_flags.generate_pw then tcode = as_error_table_$help_gpw_verify;
        else tcode = as_error_table_$help_npw_verify;
         else tcode = as_error_table_$help_password;
         call asu_$write_chn_message (cdtep, tcode, shxx, code);
         if code ^= 0 then go to chn_error;
         if ute.pw_flags.cpw then
        if ute.pw_flags.generate_pw then go to prompt_npw;
        else go to prompt_npw_vfy;
         else go to login_handler (2);
    end;

    user_password = scramble_ (user_password);  /* No peeking. */
    buff = "";              /* blank out unscrambled version */

    if ute.pw_flags.cpw then do;            /* if this is repeat of new password, compare to first one */
         if user_password ^= ute.generated_pw then do;/* note that they are both scrambled */
        if ute.pw_flags.generate_pw then    /* get the right error message */
             ignore_code = as_error_table_$generated_pw_err;
        else ignore_code = as_error_table_$new_pw_err;
        call asu_$write_chn_message (cdtep, ignore_code, shxx, code);
        if code ^= 0 then goto chn_error;
        goto try_again;         /* Please try again or type help for instructions */
         end;
    end;

    go to trylog;

login_handler (3):                  /* "e" - no password needed. */
login_handler (4):                  /* "enter" */
    if cdte.disconnected_proc_command ^= 0 then /* -connected specified */
         go to no_anon_connect_loop;
    ute.anonymous = 1;              /* No password needed */

trylog: static_label = abort;           /* in case error */
    call lock;              /* interlock answer table to prevent updates */

/* The answer table lock prevents up_sysctl_ from installing a system table.
   We don't want the SAT or a PDT installed out from under us while we are logging
   someone in, so we lock it before calling lg_ctl_ (which looks in the tables
   to see if the user can log in), and we leave it locked (if we are going to
   create a process) until act_ctl_ has recorded the login in the PDT entry. */

    cdte.n_disconnected_procs = 0;      /* make sure there's no leftover garbage in these */
    cdte.disconnected_ate_index = 0;
    if string (ute.pw_flags.special_pw) then
         call lg_ctl_$validate (utep, user_password, reason, code); /* check pw, etc. */
    else call lg_ctl_$login (utep, user_password, reason, code); /* get permission to log in */
    ute.old_password, ute.generated_pw = "";    /* for added security */

/* Check for success or failure of the login */

    if ute.login_result ^= 0 then do;       /* did he fail? */
         call unlock;               /* Allow logins */
         if reason ^= ""            /* if lg_ctl_ had something to say */
         then do;
        substr (buff, 1, length (reason)) = reason;
        call astty_$tty_force (cdtep, addr (buff), length (reason), code);
        if code ^= 0 then go to chn_error;
         end;
         if ute.uflags.logged_in then       /* if we told him he was logged in */
        call print_logged_out;      /* tell him that he isn't, anymore */
         if ute.login_result = 1 then go to listen_again; /* don't allow another attempt */
         else go to try_again;          /* get another chance to login */
    end;

/* See if this is dial or slave with a -user control argument */

    if string (ute.pw_flags.special_pw) then
         if ute.pw_flags.dial_pw then go to dial_command_join;
         else if ute.pw_flags.slave_pw then go to slave_command_join;

/* See if lg_ctl_ found a disconnected process */

    if cdte.n_disconnected_procs > 0     /* if user has disconnected processes */
         & cdte.disconnected_proc_command ^= 2 then do; /* and didn't ask for another one */
         call unlock;               /* we aren't going to create a proc, so unlock anstbl */
         if cdte.disconnected_proc_number > cdte.n_disconnected_procs then
        goto no_such_process;       /* user asked for process N but doesn't have that many */

         if cdte.disconnected_proc_command = 0 then /* disconnected procs, but no relevant login control args */
        if ute.at.brief then go to read_connect_request_brief; /* right into the request loop */
        else goto give_instructions;        /* supply more information */

         if cdte.disconnected_proc_command = 1 then /* -list */
        goto list_request;

         if cdte.disconnected_proc_number = 0   /* if user didn't specify a process number */
        & cdte.disconnected_proc_command > 2 then do; /* but gave an arg that goes with a process */
        if cdte.n_disconnected_procs > 1 then    /* if he has more than one, we don't know which one he wants */
             goto must_give_proc_no;
        cdte.disconnected_proc_number = 1;  /* default to process number 1 if that's the only one there is */
         end;

         logout_hold = ^cdte.no_hold_arg;       /* set up automatic variable */

/* command not 0, 1, or 2, so must be 3, 4, or 5 (connect, new_proc, or destroy) */

execute_connect_request:

         do j = 1 to cdte.disconnected_proc_number; /* search list for user-specified proc */
        call get_next_disc_ate_jkp;     /* get next disconnected ate;
                           global variables j, k, and p are implied arguments */
         end;

/* Now check that the terminal has enough oomf to handle the disconnected process.
   We require AIM sufficiency for connect or new_proc requests, but let
   the other requests proceed regardless. */

         if cdte.disconnected_proc_command = 3 |    /* -connect? */
        cdte.disconnected_proc_command = 4 then do; /* -new_proc? */
        call astty_$tty_order (cdtep, "set_required_access_class", addr (p -> ute.process_authorization), code);
        if (code ^= 0 & code ^= error_table_$undefined_order_request) |
             ^aim_check_$greater_or_equal (cdte.access_class,
             p -> ute.process_authorization) then do;
             call sys_log_$error_log (0, tcode, ME, "connect request of ^a.^a denied by channel AIM restriction.", ute.person, ute.project);
             call convert_status_code_ (as_error_table_$no_connect_aclass, shxx, format);
             call ioa_$rs (rtrim (format), buff, i, (cdte.n_disconnected_procs > 1), cdte.disconnected_proc_number);
             call print_buff;
             go to read_connect_request;
        end;
         end;

         temp_atep = utep;          /* remember temporary atep */
         utep = p;              /* get ptr to disconnected process ate */
         call timer_manager_$reset_alarm_wakeup (cdte.event);
         ute.lock_value = ute.lock_value + temp_atep -> ute.lock_value;
         ute.outer_module = temp_atep -> ute.outer_module; /* lg_ctl_ will have determined
                           the correct outer module for this connection */
         ute.at.brief = temp_atep -> ute.at.brief;

         call asu_$release_ate (cdtep, code);   /* give back the ate that we were using */
         cdte.process = utep;           /* connect cdte to existing ate */
         ute.channel = cdtep;           /* in both directions */
         ute.tty_name = cdte.name;      /* copy new channel name into existing ate */
         ute.tty_id_code = cdte.tty_id_code;    /* also copy answerback */

         if cdte.charge_type > 0 then        /* if we normally charge for this channel */
        call device_acct_$on ((cdte.charge_type), cdte.name, utep); /* then start doing so */
         cdte.n_logins = cdte.n_logins + 1;     /* count number of successful logins on channel */
         call sys_log_ (lilo_mode, "CONNECT ^8a ^4a ^6a ^a.^a",
        cdte.current_terminal_type, ute.tty_id_code, ute.tty_name, ute.person, ute.project);

/* Tell the user what we're about to do.
   This message could not be put into as_error_table_ because the conditionals contain semicolons,
   and the error_table_compiler doesn't allow semicolons imbedded in messages. */

         if ^ute.at.brief then do;      /* unless user thinks he knows it all */
        call ioa_$rs
             ("Your disconnected process ^[#^d ^;^s^]will be ^[destroyed^s^;connected to this terminal^[ after new_proc^]^].",
             buff, i,
                        /* Your disconnected process */
             (cdte.n_disconnected_procs > 1), cdte.disconnected_proc_number, /* #N */
                        /* will be */
             (cdte.disconnected_proc_command = 5), /* destroyed */
                        /* connected to this terminal */
             (cdte.disconnected_proc_command = 4)); /* after new_proc */
        call print_buff;
         end;
         i = 0;             /* don't print twice */

         if cdte.disconnected_proc_command = 3 then goto connect_tty; /* -connect */

         else do;               /* -new_proc or -destroy */
        cdte.in_use = NOW_HAS_PROCESS;  /* get ready to jump into the middle of */
        cdte.tra_vec = WAIT_LOGOUT_SIG; /* the process destruction code */
        static_label = abort;
        tcode = 0;
        error_mess = "";
        helphelp = ""b;
        ute.pdtep -> user.n_disconnected =   /* decrement count of user's disconnected processes */
             max (0, ute.pdtep -> user.n_disconnected - 1);
        ute.disconnected = ""b;
        if ute.whotabx > 0 then do;
             whotab.e (ute.whotabx).disconnected = ""b;
             whotab.e (ute.whotabx).idcode = cdte.tty_id_code;
        end;
        call unlock;

        if cdte.disconnected_proc_command = 4 then /* -new_proc */
             j = 2;         /* table position of new_proc wakeup */
        else                /* -destroy */
             if cdte.n_disconnected_procs = 1 & /* if only one disconnected proc, regular logout */
            ^logout_hold then       /* user said -no_hold */
             j = 4;         /* table position of logout wakeup */
        else                /* if more than one, logout -hold */
             j = 3;         /* table position of logout -hold wakeup */

        if ^connect_immediate then      /* user didn't say -immediate */
             if asu_$send_term_signal (utep, j) then /* see if we want to send trm_ to the process */
            goto exit1;     /* if we did, we'll get a wakeup when it destroys itself */

        goto logout_handler (j);        /* if -immediate or no trm_ sent, go shoot it down immediately */
         end;

    end;                    /* end disconnected procs > 0 & command ^= create */

    if cdte.n_disconnected_procs = 0        /* if user has no disconnected processes */
         & cdte.disconnected_proc_command ^= 0  /* but gave an argument pertaining to disconnected processes */
         & cdte.disconnected_proc_command ^= 2  /* and it wasn't -create */
    then do;                    /* then go complain */
         call unlock;               /* but make sure not to leave anstbl locked */
         go to read_connect_request;        /* don't tell him twice he has no processes */
    end;

/* If we get here, the user wanted a process created, either -create or no args and no disconnected processes */

/* First, make sure this isn't a write-down dialup (via sty_, or whatever) */

    call astty_$tty_order (cdtep, "set_required_access_class", addr (ute.process_authorization), tcode);
    if tcode ^= 0 & tcode ^= error_table_$undefined_order_request then do;
         call sys_log_$error_log (0, tcode, ME, "process creation for ^a.^a denied by channel AIM restriction.", ute.person, ute.project);
         if cdte.disconnected_proc_command = 2 &    /* should stay in connect loop */
        cdte.n_disconnected_procs > 0 then go to connect_error;
         call lg_ctl_$logout (utep);        /* remove user from whotab and return his load units */
         call unlock;
         tcode = as_error_table_$no_create_aclass;
         call asu_$write_chn_message (cdtep, tcode, shxx, ignore_code);
         if ^ute.pw_flags.noprint then do;
        call date_time_ (anstbl.current_time, date_time);
        call ioa_$rs (logout_fmt, buff, i, ute.person, ute.project, date_time, 0, 0, 0, 0);
        call print_buff;
        i = 0;
         end;
         say_hello = ^ute.pw_flags.noprint;
         call astty_$tty_state (cdtep, code);
         if code ^= 0 | cdte.state < TTY_DIALED then
        go to cleanup_hangup;
         call update_term_info ();
         cdte.in_use = NOW_DIALED;
         go to try_again;           /* more? */
    end;

/* Check for persistent bug */

    if ^ute.uflags.proc_create_ok then do;      /* if lg_ctl_ did not fill in the process creation variables */
         call sys_log_ (1, "dialup_: program error: attempt to create process for ^a.^a ^a,
with ate ^p not filled in; n_disc=^d,disc_com=^d,disc_ate_ix=^d",
        ute.person, ute.project, cdte.name, utep, cdte.n_disconnected_procs,
        cdte.disconnected_proc_command, cdte.disconnected_ate_index);
         tcode = as_error_table_$dialup_error;
         call asu_$write_chn_message (cdtep, tcode, shxx, code);
         if code ^= 0 then goto chn_error;
         logout_hold = "1"b;            /* don't hang up */
         call unlock;               /* make sure not to leave anstbl locked */
         goto log_disconnected_user_out;        /* if we printed logged in, print logged out */
    end;

/* User is authorized to log in. */

    call timer_manager_$reset_alarm_wakeup (cdte.event);
                        /* Turn off egg timer on logins */
    ute.n_processes = 0;            /* set to 'initial process creation' */

    call act_ctl_$open_account (utep);      /* open and activate user's account */
    cdte.n_logins = cdte.n_logins + 1;      /* count number of successful logins on channel */

/* Come here to create new process on login, new_proc, or fatal error termination */

create: if cdte.charge_type > 0
    then call device_acct_$on ((cdte.charge_type), cdte.name, utep); /* Charge for fancy devices */
    call lock;              /* interlock answer table to prevent updates */
    if ute.whotabx > 0 then
         whotab.e (ute.whotabx).suspended = "0"b;   /* KLUDGE - this should be better */
    ute.ignore_cpulimit = "1"b;         /* KLUDGE - this should be better */
    ute.suspended, ute.sus_sent = ""b;      /* KLUDGE - this should be better */
    ute.n_processes = ute.n_processes + 1;      /* count number of processes in session */
    if ute.preempted >= 3 then
         ute.preempted = 0;         /* in case we came here after operator term command */

    call cpg_ (utep, code);         /* Call utility to create process (calls actproc) */
    if code ^= 0 then do;           /* should never happen */
         call sys_log_$error_log (2, code, ME, "creating proc for ^a.^a",
        ute.person, ute.project);
                        /* Clean up after the aborted login (thank you, Steve Landry) */
         ute.logout_type = "cpg";           /* act_ctl_$close_account needs a reason for the logout */
         call act_ctl_$close_account (utep);    /* close account and print logout message for operator */
         call lg_ctl_$logout (utep);        /* remove user from whotab and return his load units */
         tcode = as_error_table_$process_create_fail; /* Tell user we failed. */
         i = 0;             /* No further message. */
         cdte.tra_vec, ute.destroy_flag = WAIT_LOGOUT_HOLD; /* and after destroying process, let user try again */
         call unlock;               /* Unlock ate */
         go to kill;                /* Get tty back. */
    end;

    call act_ctl_$cp (utep);            /* Record the creation of the user process. */
    ute.active = NOW_HAS_PROCESS;           /* User now has a process. */

connect_tty:
    cdte.in_use = NOW_HAS_PROCESS;      /* Indicate that there is a process. */

    call astty_$tty_new_proc (cdtep, ute.proc_id, code); /* give tty to new process before it runs */
    if code ^= 0 then go to abort;      /* kill proc if hungup */

    call astty_$tty_order (cdtep, "copy_meters", null (), code);

    if ute.disconnected then do;            /* if we're reconnecting a process */
         call cpg_$set_pit_tty_info (utep, code);   /* tell process about it's new terminal */
         if code ^= 0 then do;
        call sys_log_$error_log (0, code, ME, "while setting new tty info for ^a", cdte.name);
                        /* for now, keep going and see what happens */
         end;
         call asu_$release_suspended_process (utep);    /* tell process that it may run again */
         ute.pdtep -> user.n_disconnected =      /* decrement count of user's disconnected processes */
        max (0, ute.pdtep -> user.n_disconnected - 1);
         ute.disconnected = ""b;
         if ute.whotabx > 0 then do;
        whotab.e (ute.whotabx).disconnected = ""b; /* publish it */
        whotab.e (ute.whotabx).idcode = cdte.tty_id_code;
         end;
    end;

    else do;                    /* we're creating a new process */
         call hcs_$wakeup (ute.proc_id, start_proc_chn, start_proc_msg, code);
                        /* Kick the process loose from initial block state */
         if code ^= 0 then          /* log any error for debugging */
        call sys_log_$error_log (0, code, ME, "Sending initial wakeup to ^w (^a.^a)",
             ute.proc_id, ute.person, ute.project);
    end;
    cdte.tra_vec = WAIT_LOGOUT_SIG;     /* Set transfer vector. */
    ute.destroy_flag = WAIT_LOGOUT_SIG;     /* .. */
exit:   static_label = exit1;           /* in case fault in unlock */
    call unlock;                /* release answer table, permit updates */
exit1:  static_label = return_immediately;
    call as_meter_$exit_values (DIALUP_METER, new_pf, new_cpu, old_cpu); /* using old_cpu to hold real_time */

/*  scdtp -> cdt.realtime_in_dialup = scdtp -> cdt.realtime_in_dialup + (clock () - anstbl.current_time); /* */
    scdtp -> cdt.realtime_in_dialup = scdtp -> cdt.realtime_in_dialup + old_cpu;

/*  call cpu_time_and_paging_ (new_pf, new_cpu, new_pp); /* */
/*  scdtp -> cdt.pf_in_dialup = scdtp -> cdt.pf_in_dialup + (new_pf-old_pf); /* */
    scdtp -> cdt.pf_in_dialup = scdtp -> cdt.pf_in_dialup + new_pf;

/*  scdtp -> cdt.cpu_in_dialup = scdtp -> cdt.cpu_in_dialup + (new_cpu-old_cpu); /* */
    scdtp -> cdt.cpu_in_dialup = scdtp -> cdt.cpu_in_dialup + new_cpu;

/*  scdtp -> cdt.pp_in_dialup = scdtp -> cdt.pp_in_dialup + (new_pp-old_pp); /* */

    scdtp -> cdt.entries_to_dialup = scdtp -> cdt.entries_to_dialup + 1;

return_immediately:
    return;                 /* This is the main exit. */
%page;

login_handler (7):                  /* "d" */
login_handler (8):                  /* "dial" */
    call grab_ute;              /* set up */
    call parse_login_line_$dial_line (addr (substr (buff, jj, 1)), nc - jj + 1, utep, error_mess, code);
    if code = error_table_$noarg then go to read_login_args; /* If user gave no args, ask for them. */
    if code ^= 0 then go to bad_login_dial_slave_request;
    if ute.person ^= "" then do;
         if ute.person = "anonymous" then ute.anonymous = 1; /* special hack */
         if cdte.flags.check_acs then go to read_password;
         else call asu_$write_chn_message (cdtep, as_error_table_$ds_user_ignored, shxx, ignore_code);
    end;
    else if cdte.flags.check_acs then do;
         call asu_$write_chn_message (cdtep, as_error_table_$ds_user_required, shxx, ignore_code);
         go to try_again;
    end;

dial_command_join:                  /* back here after password validated */
    dial_qual = ute.dial_qualifier;     /* copy ute values */
    dial_arg1 = ute.sender;
    call free_ute;              /* release the ute */
    call dial_ctl_ (cdtep, dial_qual, dial_arg1, code);
    if code ^= 0
    then do;
         call asu_$write_chn_message (cdtep, code, shxx, ignore_code); /* try to write the error message */
         if cdte.state < TTY_DIALED then go to listen_again; /* if user hung up during dial */
         else go to try_again;          /* all other errors */
    end;
    call timer_manager_$reset_alarm_wakeup (cdte.event); /* Success. */
    cdte.tra_vec = WAIT_DIAL_RELEASE;       /* Set transfer vector to reclaim channel. */
    go to exit1;                /* Note that cdte.in_use is still NOW_DIALED */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

login_handler (10):                 /* "HELP" */
login_handler (9):                  /* "help" */
    call print_help ("login_help");
    go to try_again;                /* Tell him he can try again. */

login_handler (11):                 /* "MAP" - The Padlipsky command. */
    call ttt_info_$preaccess_type ("MAP", type_to_set, code); /* find out what type corresponds */
    if code ^= 0 then go to chn_user_error;
    if type_to_set ^= "" then do;
         call change_type (type_to_set, "1"b, "1"b, code);
         if code ^= 0 then go to chn_user_error;
    end;
    go to read_login_line;          /* Try again. */

login_handler (12):                 /* "hello" command */
    call hello (0);             /* Repeat greeting */
    if code ^= 0 then go to chn_error;
    go to read_login_line;          /* Let him try login now. */

login_handler (14):                 /* "063" (change to EBCDIC) */
    call interpret_preaccess ("029", "963", code);  /* make the change if appropriate */
    if code ^= 0 then go to chn_user_error;
    go to read_login_line;

login_handler (16):                 /* "9" (change to Correspondence) */
    call interpret_preaccess ("963", "029", code);  /* as for "063" */
    if code ^= 0 then go to chn_user_error;
    go to read_login_line;

login_handler (13):                 /* "963" command */
login_handler (15):                 /* "029" command */
    go to read_login_line;          /* .. that's all */

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

login_handler (17):                 /* "slave" command */
    call grab_ute;              /* set up */
    call parse_login_line_$slave_line (addr (substr (buff, jj, 1)), nc - jj + 1, utep, error_mess, code);
    if code ^= 0 then go to bad_login_dial_slave_request;
    if ute.person ^= "" then do;
         if ute.person = "anonymous" then ute.anonymous = 1;
         if cdte.flags.check_acs then go to read_password;
         else call asu_$write_chn_message (cdtep, as_error_table_$ds_user_ignored, shxx, ignore_code);
    end;
    else if cdte.flags.check_acs then do;
         call asu_$write_chn_message (cdtep, as_error_table_$ds_user_required, shxx, ignore_code);
         go to try_again;
    end;

slave_command_join:                 /* back here after password verified */
    call free_ute;
    cdte.current_service_type = SLAVE_SERVICE;  /* Set channel up to wait for Godot. */
    cdte.tra_vec = WAIT_DIAL_RELEASE;       /* Do something reasonable if it hangs up */
    cdte.process = null;            /* .. */
    call timer_manager_$reset_alarm_wakeup (cdte.event);
    go to exit1;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
/* Preaccess commands for setting terminal types and modes */

login_handler (18):                 /* "modes" command */
    call login_parse_ (addr (substr (buff, jj, 1)), nc - jj + 1, new_modes, k, j, code);
    if code = error_table_$noarg then do;
         call astty_$tty_getmode (cdtep, modes_string, code);
         if code ^= 0 then modes_string = "?";
         call ioa_$rs ("Current modes: ^a", buff, i, modes_string);
         call print_buff;
         go to read_login_line;
    end;
    else if code ^= 0 then go to try_again_code;

    go to login_modes_join;

login_handler (29):                 /* "noecho" command */
    new_modes = "^echoplex";
    goto login_modes_join;

login_handler (19):                 /* "echo" command */
    new_modes = "echoplex";

login_modes_join:
    call astty_$tty_changemode (cdtep, (new_modes), code);
    if code ^= 0 then go to chn_user_error;
    go to read_login_line;


login_handler (20):                 /* "terminal_type" command */
login_handler (21):                 /* "ttp" command */
    call login_parse_ (addr (substr (buff, jj, 1)), nc - jj + 1, new_modes, k, j, code);
    if code = error_table_$noarg then do;
         call ioa_$rs ("Current terminal type is ""^a"".", buff, i, cdte.current_terminal_type);
         call print_buff;
         go to read_login_line;
    end;
    else if code ^= 0 then go to try_again_code;

    set_type_info.version = stti_version_1;
    set_type_info.name = translate (new_modes, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz");
    string (set_type_info.flags) = "0"b;
    call astty_$tty_order (cdtep, "set_term_type", addr (set_type_info), code);
    if code ^= 0 then do;
         call convert_status_code_ (code, shxx, error_mess);
         call ioa_$rs ("^a ^a", buff, i, error_mess, set_type_info.name);
         call print_buff;
         go to read_login_line;
    end;
    cdte.current_terminal_type = set_type_info.name;
    call set_tabs_and_modes_gently (code);
    call ttt_info_$dialup_flags (set_type_info.name, cdte.dialup_flags.ppm, cdte.dialup_flags.cpo, code);
    go to read_login_line;

/* ******************** */

/* The following are only valid when the user is logged in, and we are now awaiting a login command */

login_handler (24):                 /* list */
login_handler (25):                 /* create */
login_handler (26):                 /* connect */
login_handler (27):                 /* new_proc */
login_handler (28):                 /* destroy */

    call print_ascii_msg (as_error_table_$only_after_login_msg, (login_word));
    goto try_again;

/* We come to one of the following labels to print an error message related to disconnected processes,
   and then prompt for, and read, a connect request */

no_such_process:
    call ioa_$rs (convert_message (as_error_table_$no_such_process_msg), buff, i, cdte.disconnected_proc_number);
    call print_buff;
    goto read_connect_request;

no_disconnected_procs:
    tcode = as_error_table_$no_disconnected_procs;
    goto connect_error;

must_give_proc_no:
    tcode = as_error_table_$must_give_proc_no;
    goto connect_error;

give_instructions:
    if ute.at.brief then go to read_connect_request;    /* user doesn't want instructions */
    tcode = as_error_table_$give_instructions;

connect_error:
    call asu_$write_chn_message (cdtep, tcode, shxx, code);
    if code ^= 0 then goto chn_error;
    go to read_connect_request;         /* unconditionally write request prompt */

/* read_connect_request_brief is for use if no error occured. Then we pay attention to the user's brief bit.
   But if he made an error, the read_connect_request label is used, resulting
   in the user always getting a prompting message */

read_connect_request_brief:             /* honour brief bit */
    if ute.at.brief then do;            /* user doesn't want a prompt */
         cdte.tra_vec = WAIT_CONNECT_REQUEST;
         go to wait_connect_request;        /* so just wait for him */
    end;

read_connect_request:
    cdte.tra_vec = WAIT_CONNECT_REQUEST;        /* ask for and wait for connect request */
    if cdte.n_disconnected_procs > 0 then code = as_error_table_$give_connect_request;
    else code = as_error_table_$give_connect_request_no_disc;
    call asu_$write_chn_message (cdtep, (code), shxx, code);
    if code ^= 0 then goto chn_error;

/* WAIT_CONNECT_REQUEST */
hand (21):
wait_connect_request:
    call astty_$tty_read (cdtep, addr (buff), nc, code);
    if code ^= 0 then goto chn_error;
    if nc <= 0 then goto exit1;          /* if user hasn't typed anything yet,
                           we'll get a wakeup when he does */

/* We hope we have a connect request */

timeout (21):
    call login_parse_ (addr (buff), nc, login_word, k, jj, code); /* get first word on line */
    if code = error_table_$noarg then goto read_connect_request; /* happens if user hits just blanks and carriage return */
    if code ^= 0 then go to try_again_code;

    do lgwd = 1 to n_login_words while (login_word ^= login_words (lgwd)); end; /* look up the word in the table */

    if lgwd > n_login_words then do;     /* user typed an unknown word */
         call print_ascii_msg (as_error_table_$unknown_request_msg, (login_word));
         goto read_connect_request;
    end;

    if lgwd = 9 then do;            /* help */
         call print_help ("connect_help");
         goto read_connect_request;
    end;

/* Some time, allow the terminal mode setting requests in here */

    if lgwd < 22 | lgwd > 28 then do;     /* word recognized but invalid now */
         call print_ascii_msg (as_error_table_$rq_invalid_now_msg, (login_word));
         call asu_$write_chn_message (cdtep, as_error_table_$now_logged_in, shxx, code); /* say "You're logged in now;
                           tell us what to do about your disconnected processes" */
         if code ^= 0 then goto chn_error;
         if cdte.n_disconnected_procs > 0 then
        goto give_instructions;
         else goto read_connect_request;
    end;

/* It is a legal connect request */

    goto connect_handler (lgwd - 21);       /* map 22 thru 28 into 1 thru 7 */

connect_handler (1):                /* logout */
login_handler (22):                 /* logout when not really logged in */

    logout_hold, logout_brief = ""b;        /* assume not -hold */
    k = 1;                  /* get the do while started */
    code = 0;
    do while (code = 0);            /* as long as there's anything more on the line */
         call login_parse_ (addr (substr (buff, jj, 1)), nc - jj + 1, login_word, k, j, code); /* see if there's another word */
         if code ^= error_table_$noarg then
        if code ^= 0 then go to try_again_code;
         if code = 0 then do;           /* there is; see what it is */
        if login_word = "-hd" | login_word = "-hold" then logout_hold = "1"b;
        else if login_word = "-no_hold" | login_word = "-nhd" then logout_hold = "0"b;
        else if login_word = "-bf" | login_word = "-brief" then logout_brief = "1"b;
        else if login_word = "-long" | login_word = "-lg" then logout_brief = "0"b;
        else do;
             call print_ascii_msg (as_error_table_$unknown_arg_msg, (login_word));
             if cdte.tra_vec = WAIT_CONNECT_REQUEST then /* can user be in connect loop? */
            goto read_connect_request;  /* yes */
             else goto try_again;       /* silly boy */
        end;
        jj = jj + j;            /* move cursor past this argument */
         end;
    end;

log_disconnected_user_out:

    if logout_brief then say_hello = ""b;
    else say_hello = "1"b;

    if have_ate & ^logout_brief then        /* if there's a user and he didn't say -brief */
         if ute.uflags.logged_in then       /* and he got a login message, give him a logout message */
        call print_logged_out;

    if logout_hold then do;         /* if -hold, clean up and then go print a greeting message */
         call free_ute;
         goto login;
    end;
                        /* if not -hold, fall thru to hangup */

connect_handler (2):                /* hangup command while logged in */
login_handler (23):                 /* hangup command while not logged in */
    goto listen_again;              /* that was easy */

connect_handler (3):                /* list */
list_request:
    if cdte.n_disconnected_procs = 0 then goto no_disconnected_procs;
    do j = 1 to cdte.n_disconnected_procs;
         call get_next_disc_ate_jkp;        /* get next disconnected ate;
                           global variables j, k, and p are implied arguments */
         call date_time_ (p -> ute.login_time, date_time);
         call ioa_$rs (convert_message (as_error_table_$list_disconnected_msg), buff, i,
        j, date_time, p -> ute.tty_name, p -> ute.tty_id_code);
         call print_buff;
    end;
    goto read_connect_request_brief;        /* be quiet if the user wants it */

connect_handler (4):                /* create */
    cdte.disconnected_proc_command = 2;     /* -create */
    cdte.disconnected_proc_number = 0;
    goto trylog;                /* go pretend user said login -create */

connect_handler (5):                /* connect */
    cdte.disconnected_proc_command = 3;     /* -connect */
    goto connect_common;

connect_handler (6):                /* new_proc */
    cdte.disconnected_proc_command = 4;     /* -new_proc */
    goto connect_common;

connect_handler (7):                /* destroy */
    cdte.disconnected_proc_command = 5;     /* -destroy */

connect_common:
    if cdte.n_disconnected_procs = 0 then       /* if none, say so before going any further */
         goto no_disconnected_procs;

    cdte.disconnected_proc_number = 0;      /* illegal value; changes if user gives number */
    logout_hold = "1"b;             /* default to -hold */
    do while ("1"b);                /* handle all control args */
         call login_parse_ (addr (substr (buff, jj, 1)), nc - jj + 1, login_word, k, j, code); /* see if there's another word */
         if code = error_table_$noarg then do;  /* no more args - check what we have */
        if cdte.disconnected_proc_number = 0 then /* if user did not give process number */
             if cdte.n_disconnected_procs = 1 then /* if user only has one */
            cdte.disconnected_proc_number = 1; /* default to 1 if no number given */
             else go to must_give_proc_no;  /* error if more than one and user didn't say which */
        go to execute_connect_request;  /* go connect terminal to process; then do what user requested */
         end;                   /* end no more arguments */
         else if code ^= 0 then go to try_again_code;

         jj = jj + j;               /* advance index */
         k = cv_dec_check_ (login_word, code);  /* think of it as a number */
         if code = 0 then do;           /* it was a number */
        if cdte.disconnected_proc_number ^= 0 then do; /* but user already specified a process */
connect_arg_error:       code = as_error_table_$unknown_arg_msg;
             call print_ascii_msg (code, (login_word));
             go to read_connect_request;    /* have the user try again */
        end;

        if k <= 0 | k > cdte.n_disconnected_procs then
             go to no_such_process;     /* user gave nonsense value */
        else cdte.disconnected_proc_number = k; /* remember it */
         end;                   /* it was a number */
         else if login_word = "-immediate" | login_word = "-im" then do;
        if cdte.disconnected_proc_command = 4 | /* new_proc */
             cdte.disconnected_proc_command = 5 then /* destroy */
             connect_immediate = "1"b;  /* user want's process destroyed immediately */
        else go to connect_arg_error;
         end;
         else if login_word = "-hold" | login_word = "-hd" then do;
        if cdte.disconnected_proc_command = 5 | /* destroy */
             cdte.disconnected_proc_command = 1 /* logout */
        then logout_hold = "1"b;        /* don't hang up */
        else go to connect_arg_error;
         end;
         else if login_word = "-no_hold" | login_word = "-nhd" then do;
        if cdte.disconnected_proc_command = 5 | /* destroy */
             cdte.disconnected_proc_command = 1 /* logout */
        then logout_hold = "0"b;        /* hang up */
        else go to connect_arg_error;
         end;
         else go to connect_arg_error;      /* invalid control arg */
    end;                    /* connect control arg loop */
%page;

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   *                         *
   * Here if a logged-in user has something happen to him    *
   * which involves destroying his process.      *
   *                         *
   *    logout                   *
   *    logout hold              *
   *    fatal error in process           *
   *    out of funds                 *
   *    can't start process              *
   *    preempted                    *
   *    system coming down               *
   *    standby bump                 *
   *    inactive too long                *
   *    bumped/unbumped/terminated/detached by operator    *
   *    hung up phone                *
   *                         *
   * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

/* WAIT_LOGOUT_SIG */
hand (8): funct = signal_type;          /* extract event message, tells what to do */
    static_label = abort;           /* in case error */
    tcode = 0;              /* Assume no special termination code. */
    error_mess = "";                /* clear string used to hold converted status code */
    helphelp = ""b;             /* assume user is not in fatal process error trouble */
    if wakeup_from_user then do;
         do j = 1 to n_signals while (funct ^= signals (j)); /* check in as_data_ */
         end;
         if j <= n_signals then ;            /* is it known? */
         else if signal_type1 = "term" | signal_type1 = "init" then do; /* these messages have error code in word 2 */
        tcode = bc.code;            /* extract code (xxxx) from "term"xxxx or "init"xxxx */
        if tcode ^= 0           /* Validate it. We don't want to be hacked. */
        then if tcode_left_half ^= baseno (null)/* Oops. Not an error_table_ code. */
             then do;           /* wonder what is is  ... */
            call ioa_$rsnnl ("Code = ^w", error_mess, i, tcode); /* lets see */
            tcode = 0;      /* don't try to convert_status_code_ it */
             end;
        j = 1;              /* Terminate his process. */
         end;
         else if new_proc_auth.np_signal = "np" then    /* new_proc -auth AUTH */
        j = 13;             /* new_proc to new authorization */
         else if ute.sus_sent & ^ute.suspended then do; /* if waiting for response from sus_, this must be it */
        ute.sus_channel = ev_msg.ev_message;    /* save event channel that process is blocked on */
        if ute.ignore_cpulimit then do; /* if process got released before it responded */
             ute.sus_sent = ""b;        /* clear the suspended flag */
             if ute.whotabx > 0 then
            whotab.e (ute.whotabx).suspended = ""b; /* publish it */
             call hcs_$wakeup (ute.proc_id, ute.sus_channel, (0), (0)); /* tell process it may run */
        end;                /* leave the ignore_cpulimit switch on */
        else do;                /* not released already (normal case) */
             ute.suspended = "1"b;      /* remember that process responded correctly */
             if ute.whotabx > 0 then
            whotab.e (ute.whotabx).suspended = "1"b; /* publish it */
             call timer_manager_$reset_alarm_wakeup (ute.event); /* turn off the alarm timer */
        end;
        goto exit1;         /* and get out */
         end;                   /* end sus sent */
         else do;               /* That's all a user can signal. */
        j = 1;              /* Creative user tried to write own logout, and goofed. */
        funct = "badsignl";         /* Or he may have tried to hack us. */
        tcode = as_error_table_$illegal_signal; /* Might as well tell user. */
         end;
    end;
    else do;                    /* Must be a system-generated event. */
         do j = 1 to n_system_signals while (funct ^= system_signals (j)); end;
         if j <= n_system_signals then j = j + 19;   /* See if it is a system signal. */
         else do;               /* Probably a hangup ... check it out */
        if ^have_cdte then goto fals0;  /* can't be hangup if no cdte */
        call astty_$tty_state (cdtep, code);
        if code ^= 0 then go to chn_error;  /* tolerate no errors */

        if cdte.state = TTY_DIALED      /* not a hangup cause terminal is still there */
        then go to fals0;           /* ignore it (but log it first) */

        j = 20;             /* set jump index to hangup */
         end;
    end;

    if have_ate then do;            /* watch out for detach of tty with no process (no ate) */
         if ute.preempted ^= 3 then     /* unless we have already done so */
        ute.logout_type = signal_type1; /* remember the reason for the logout */
         ute.pw_flags.noprint = "0"b;       /* usually print logout message. */
    end;

    i = 0;                  /* message length = 0 until we build a message */

    go to logout_handler (j);           /* Fast dispatch. */

logout_handler (27):                /* ("terminat") Operator terminated process. */
    if asu_$send_term_signal (utep, j)      /* send term signal if appropriate */
    then goto exit1;                /* if we did, wait for process to destroy itself */
    tcode = as_error_table_$term_by_operator;   /* Tell user why process died. */
                        /* Fall through into normal case. */

logout_handler (1):                 /* ("term"xxxx or "init"xxxx) Process termination. */
    if have_cdte then
         call astty_$tty_abort (cdtep, 1, ignore_code); /* abort any read ahead (let writing finish!) */
    if tcode ^= 0 then do;          /* If code is not zero then */
         call convert_status_code_ (tcode, shxx, error_mess);
         call sys_log_ (0, "dialup_: process terminated ^a.^a ^a ^a",
        ute.person, ute.project, ute.tty_name, shxx);
         tcode = 0;             /* Don't print it again... */
    end;

    if ute.disconnected then do;            /* if a disconnected process gets a fatal error */
         ute.destroy_flag = WAIT_LOGOUT;        /* log the user out (no point in anything else) */

/* TO BE CODED: send the user a message with the reason in it (error_mess contains the reason) */

    end;

    else if signal_type1 = "init" then do;      /* fatal error during process initialization */
         ute.destroy_flag = WAIT_LOGOUT_HOLD;   /* a new process would just get another fatal error */
         call ioa_$rs (init_term_fmt, buff, i, error_mess); /* Put reason for fatal error into message:
                           Fatal error during process initialization. <error_mess> */
         call sys_log_ (1, "dialup_: fatal error during process creation for ^a.^a ^a",
        ute.person, ute.project, cdte.name);
         helphelp = "1"b;           /* offer some help - its the least we can do */
    end;

    else do;                    /* fatal error not during initialization -
                           but check for fatal error loop anyway, since
                           user might be getting errors during start_up.ec */
         if ute.recent_fatal_error_time + installation_parms.fatal_error_loop_seconds * 1000000 < anstbl.current_time then
        do;             /* if previous fatal error was long ago */
        if ute.uflags.fpe_causes_logout then do;
             call convert_status_code_ (as_error_table_$fpe_caused_logout, shxx, error_mess);
             call ioa_$rs ("^a", buff, i, error_mess);
             ute.destroy_flag = WAIT_LOGOUT_HOLD;
        end;
        else do;
             ute.recent_fatal_error_time = anstbl.current_time; /* reset the fatal error loop timer */
             ute.recent_fatal_error_count = 1;  /* and set the counter back to 1 */
create_another_new_proc:
             ute.destroy_flag = WAIT_NEW_PROC;  /* let user have another new process after destroying this one. */
             call ioa_$rs (proc_term_fmt, buff, i, error_mess); /* put reason for fatal error into message:
                           Fatal error. Process has terminated. <error_mess>
                           New process created. */
        end;
         end;                   /* not too many FPEs */

         else do;               /* we seem to have a loop */
        ute.recent_fatal_error_count = ute.recent_fatal_error_count + 1; /* count times around it */
        if ute.recent_fatal_error_count < installation_parms.fatal_error_loop_count then /* if not too many */
             goto create_another_new_proc;  /* keep going a while longer */
        ute.destroy_flag = WAIT_LOGOUT_HOLD;    /* too many. get out of the loop, but don't hang up */
        call ioa_$rs (proc_term_loop_fmt, buff, i, error_mess); /* put reason for fatal error into message:
                           Fatal error. Process has terminated. <error_mess>
                           You appear to be in a fatal process error loop. */

        call sys_log_ (1, "dialup_: terminating fatal process error loop for ^a.^a ^a",
             ute.person, ute.project, ute.tty_name);
        helphelp = "1"b;            /* offer some help */
         end;
    end;

    go to kill;

logout_handler (2):                 /* New_proc */
    ute.destroy_flag = WAIT_NEW_PROC;       /* Create new process after destroying process. */
    ute.pw_flags.noprint = "1"b;            /* no message from us. */
    go to kill;

logout_handler (3):                 /* logout -hold */
    ute.destroy_flag = WAIT_LOGOUT_HOLD;        /* User wants to login again. */
    go to kill;

logout_handler (5):                 /* logout -bf */
    ute.destroy_flag = WAIT_LOGOUT;
    ute.pw_flags.noprint = "1"b;            /* Inhibit printing of messages. */
    go to kill;

logout_handler (6):                 /* logout -hold -bf */
    ute.pw_flags.noprint = "1"b;            /* Inhibit printing of logout message. */
    ute.destroy_flag = WAIT_LOGOUT_HOLD;        /* Set transfer vector to mallow login */
    go to kill;

logout_handler (7):                 /* init_err */
    ute.destroy_flag = WAIT_LOGOUT_HOLD;
    tcode = as_error_table_$init_err;       /* Process cannot be initialized. */
    helphelp = "1"b;                /* offer some help */
    go to kill;

logout_handler (8):                 /* no_ioatt */
    ute.destroy_flag = WAIT_LOGOUT_HOLD;
    tcode = as_error_table_$no_io_attach;       /* Cannot attach process I/O streams */
    helphelp = "1"b;                /* offer some help */
    go to kill;

logout_handler (9):                 /* no_initproc */
    ute.destroy_flag = WAIT_LOGOUT_HOLD;
    tcode = as_error_table_$no_init_proc;       /* Cannot locate initial procedure. */
    helphelp = "1"b;                /* offer some help */
    go to kill;

logout_handler (13):                /* new_proc -auth AUTH */
    ute.destroy_flag = WAIT_NEW_PROC;       /* always get new process */

    if ^have_cdte then do;          /* can't new_proc -auth in a disconnected process */
         tcode = as_error_table_$illegal_new_proc;
         goto kill;
    end;

    if ^aim_check_$greater_or_equal (ute.max_process_authorization, (new_proc_auth.authorization)) then do;
illegal_new_proc: tcode = as_error_table_$illegal_new_proc; /* Can't go above max auth */
         go to kill;                /* leave at old auth */
    end;

    if ^aim_check_$greater_or_equal (cdte.access_class, (new_proc_auth.authorization)) then
         go to illegal_new_proc;

    call astty_$tty_order (cdtep, "set_required_access_class", addr (new_proc_auth.authorization), code);
    if code ^= 0 & code ^= error_table_$undefined_order_request then do;
         call sys_log_$error_log (0, tcode, ME, "new_proc of ^a.^a denied by channel AIM restriction.", ute.person, ute.project);
         go to illegal_new_proc;
    end;

    ute.process_authorization = new_proc_auth.authorization; /* CHANGE AUTHORIZATION */
    userx = ute.whotabx;            /* find user's whotab entry */
    if userx ^= 0               /* if he has one */
    then whotab.e (userx).process_authorization = ute.process_authorization;

    go to kill;

logout_handler (14):                /* termsgnl */

/* ate.preempted says what to do here:
   -1 user unbumped after term signal sent
   0  user unbumped; ignore alarm___
   1  value internally used in load_ctl_
   2  user bumped; when alarm___ comes in, send term signal
   3  term signal sent; destroy process if termsgnl, alarm___, or cpulimit signals come in
   4  user bumped; process sick, so destroy without sending term signal
   5  trm_ signal sent, termsgnl received; (if still 3, we never got the termsgnl).
*/

    call timer_manager_$reset_alarm_wakeup (ute.event); /* turn off realtime limit */
    if ute.preempted = -1 then do;      /* unbumped just a little late */
         tcode = as_error_table_$bump_cancelled;    /* apologize */
         goto logout_handler (1);           /* give the guy a new process */
    end;
    else if ute.preempted = 3 then do;      /* sent term signal, expecting termsgnl */
         ute.preempted = 5;         /* remember that we're no longer waiting for termsgnl */
         goto logout_handler (ute.logout_index);    /* go finish what we started to do */
    end;
    else do;                    /* unexpected termsgnl */
         call sys_log_ (0, "dialup_: Unexpected termsgnl for ^a.^a ^a",
        ute.person, ute.project, ute.tty_name); /* tell sysprogs */
         tcode = as_error_table_$illegal_signal;    /* complain to user */
         goto logout_handler (1);           /* but give the guy a new process */
    end;


/* User may not signal any of the functions below */

logout_handler (20):                /* hangup */

    if have_ate then                /* if we have an ate */
         if ute.active = NOW_HAS_PROCESS        /* with a process */
        & ute.preempted <= 0 then        /* that's not already being destroyed */
        if ute.save_if_disconnected then do;    /* that the user wants saved across hangups */
             call asu_$suspend_process (utep);  /* try to save it */
             ute.disconnected = "1"b;       /* remember that it's disconnected */
             if ute.whotabx > 0 then
            whotab.e (ute.whotabx).disconnected = "1"b; /* publish it */
             ute.pdtep -> user.n_disconnected = /* increment count of user's disconnected processes */
            max (0, ute.pdtep -> user.n_disconnected + 1);
             ute.channel = null;        /* and don't try to use the old cdte again for this process */
             if cdte.state = TTY_DIALED then    /* if operator disconnect command */
            cdte.tra_vec = WAIT_HANGUP;
             cdte.process = null;       /* also, don't let future channel operations affect the process */
             if cdte.charge_type > 0 then    /* if we were charging for the channel */
            call device_acct_$off ((cdte.charge_type), cdte.name, utep); /* stop charging - it's hung up */
             call sys_log_ (lilo_mode, "DISCONNECT ^8a ^4a ^6a ^a.^a",
            cdte.current_terminal_type, ute.tty_id_code, ute.tty_name, ute.person, ute.project);
             code = 0;          /* nothing wrong with the channel */
             goto cleanup_hangup;       /* go clean up and listen on hung-up channel */
        end;

    if asu_$send_term_signal (utep, j) then     /* send a term signal if appropriate */
         goto exit1;                /* if we did, wait for process to destroy itself */
    ute.destroy_flag = WAIT_LOGOUT;
    goto kill;

logout_handler (21):                /* Shutdown */
    if asu_$send_term_signal (utep, j) then     /* send term signal if appropriate */
         goto exit1;                /* if we did, wait for process to destroy itself */
    ute.destroy_flag = WAIT_LOGOUT;
    tcode = as_error_table_$shutdown;       /* Multics is shutting down. */
    go to kill;

logout_handler (22):                /* bump */
    if asu_$send_term_signal (utep, j) then     /* send term signal if appropriate */
         goto exit1;                /* if we did, wait for process to destroy itself */
    ute.destroy_flag = WAIT_LOGOUT;
    tcode = as_error_table_$automatic_logout;   /* Automatic logout. */
    go to kill;

logout_handler (23):                /* alarm___ */

/* alarm___ can occur as a result of several conditions.
   Also, we can come here from the termsgnl handler if we sent term in response to alarm___.
   Sort it all out here.

   ***** CHECK FOR LEFT OVER ALARM AFTER PROCESS HAS BEEN DESTROYED
*/

    if funct = "alarm___" then do;      /* if really alarm rather than termsgnl */

/* TEMPORARY - NEEDS BETTER ERROR MESSAGES */

         if ute.sus_sent & ^ute.suspended then do;  /* process ignored sus_ */
ignored_sus:                    /* come here from cpulimit */
        call sys_log_ (1, "dialup_: process ignored sus_ signal ^a.^a ^a",
             ute.person, ute.project, ute.tty_name);

        if asu_$send_term_signal (utep, 20) then goto exit1;
        ute.destroy_flag = WAIT_LOGOUT;
        goto kill;
         end;

/* END TEMPORARY */
         if ute.preempted <= 0 then      /* if user has been unbumped */
        goto exit1;         /* go away quietly */
         else if (ute.preempted = 2 & ute.activity_can_unbump) then do; /* see if user woke up */
        call act_ctl_$activity_unbump (utep, code);
        if code = 0 then do;        /* acceptably active */
             call sys_log_ (1, "dialup_: cancelling inactivity bump of ^a.^a", ute.person, ute.project);
             call convert_status_code_ (as_error_table_$activity_unbump, shxx, error_mess);
             call send_mail ((error_mess));
             go to logout_handler (25); /* unbump */
        end;
         end;
         if asu_$send_term_signal (utep, j) then    /* send term signal if appropriate */
        goto exit1;         /* if we did, wait for process to destroy itself */
         else if ute.preempted = 3 then do;     /* sent term and process failed to respond */
ignored_term:                   /* come here if cpu timer runs out after term sent */
        ute.preempted = 5;          /* indicate that we're no longer waiting for termsgnl */
        call sys_log_ (1, "dialup_: process ignored trm_ signal ^a.^a ^a", ute.person, ute.project, ute.tty_name);
        if ute.logout_index = 23 then       /* if original objective was bump after X minutes */
             goto bump_or_shut;     /* go do it */
        else goto logout_handler (ute.logout_index); /* go finish what we started to do */
         end;
    end;

bump_or_shut:

    ute.destroy_flag = WAIT_LOGOUT;
    if anstbl.session = "shutdown" then tcode = as_error_table_$shutdown;
    else tcode = as_error_table_$automatic_logout;  /* Three minutes' grace expired. */
    go to kill;

logout_handler (24):                /* detach */
    if cdte.in_use < NOW_LOGGED_IN then      /* operator detach. someone on line? */
         tcode = as_error_table_$detach;        /* No. Automatic detach. */
    else do;                    /* Yes. Must destroy user. Automatic logout. */
         if asu_$send_term_signal (utep, j) then    /* send term signal if appropriate */
        goto exit1;         /* if we did, wait for process to destroy itself */
         tcode = as_error_table_$automatic_logout;
    end;
    if have_ate then
         ute.destroy_flag = WAIT_DETACH;        /* After proc is destroyed, leave phone hung. */
    else cdte.tra_vec = WAIT_DETACH;        /* if no process, use cdte to remember what to do */
    go to kill;

logout_handler (25):                /* ("unbump") is operator cancelling a bump? */
    ute.activity_can_unbump = "0"b;     /* tidy up */
    if ute.preempted = 3 then           /* if term signal sent before unbump */
         ute.preempted = -1;            /* remember that it happened */
    else ute.preempted = 0;         /* else just cancel the bump */
    go to exit1;

logout_handler (26):                /* "stopstop"  Check for out-of-sequence signals. */
    call sys_log_ (0, "dialup_: premature stopstop for ^a.^a ^a",
         ute.person, ute.project, ute.tty_name);
    call hcs_$wakeup (anstbl.as_procid, ute.event, termstop_msg, code);
    call hcs_$wakeup (anstbl.as_procid, ute.event, STOPstop_msg, code);
    go to exit1;

logout_handler (28):                /* "termstop" */
    tcode = as_error_table_$no_signal;      /* Process terminated without signalling answering service. */
    ute.destroy_flag = WAIT_LOGOUT_HOLD;
    goto kill;

logout_handler (29):                /* cpulimit: Process used too much cpu time after sus_ or trm_ */
    if ute.ignore_cpulimit then do;     /* there's no way to turn of cpulimit timer */
         ute.ignore_cpulimit = ""b;     /* except for this switch, which we now turn off */
         goto exit1;                /* and go away quietly */
    end;

    call timer_manager_$reset_alarm_wakeup (ute.event); /* turn off realtime timer */

    if ute.preempted = 3 then           /* if we had sent trm_ */
         goto ignored_term;         /* go complain and kill process */
    else if ute.sus_sent then           /* or, if we had sent sus_ */
         goto ignored_sus;          /* likewise, complain and kill process */
    else goto fals;             /* otherwise, log and ignore this unexpected signal */


logout_handler (4):                 /* Standard logout. */
logout_handler (10):                /* Unused. Treat as logout. */
logout_handler (11):                /* Unused. Treat as logout. */
logout_handler (12):                /* Unused. Treat as logout. */
logout_handler (15):                /* Unused. Treat as logout. */
logout_handler (16):                /* Unused. Treat as logout. */
logout_handler (17):                /* Unused. Treat as logout. */
logout_handler (18):                /* Unused. Treat as logout. */
logout_handler (19):                /* Unused. Treat as logout. */
    ute.destroy_flag = WAIT_LOGOUT;

kill:

    if have_ate then do;            /* if there is an answer table entry for this channel */
         if ute.preempted = 3 then do;      /* if we were waiting for termsgnl and never got it */
        call sys_log_ (0, "dialup_: process did not respond properly to trm_ signal. ^a.^a ^a",
             ute.person, ute.project, ute.tty_name);
        if ute.logout_index ^= 27 then  /* if original objective was other than terminate */
             if ute.destroy_flag = WAIT_NEW_PROC then /* if response was f.p.e or newproc */
                        /* don't allow tricky user to get out of being bumped */
            if ute.logout_index = 24 then /* put back the original objective */
                 ute.destroy_flag = WAIT_DETACH;
            else ute.destroy_flag = WAIT_LOGOUT;
         end;

         if ute.active = NOW_HAS_PROCESS then do;   /* if user has a process then destroy it */
        call dial_ctl_$dial_broom (utep, funct);/* clean out attached consoles */
        call rcp_sys_$unassign_process (ute.proc_id, ignore_code);
        if ute.lvs_attached then
             call lv_request_$cleanup_process (ute.proc_id);
        call dpg_ (utep);
         end;

         if have_cdte then          /* if we have a cdte also */
        cdte.tra_vec = ute.destroy_flag;    /* tell cdte what we're about to do to the ate */
    end;                    /* end have ate */

    if have_cdte then do;           /* if we have a cdte */

         call grab_tty;             /* Take over the typewriter */

         if tcode ^= 0 then call asu_$write_chn_message (cdtep, tcode, shxx, ignore_code);
         if i > 0 then call astty_$tty_force (cdtep, addr (buff), i, ignore_code);
                        /* Write nice message if process terminated. */

         if helphelp then           /* if user is having fatal process error problems */
        call asu_$write_chn_message (cdtep, as_error_table_$ask_for_help, shxx, ignore_code); /* offer help */

         if cdte.charge_type > 0 then
        if have_ate then            /* don't try to turn off charging if no user owns device */
             call device_acct_$off ((cdte.charge_type), cdte.name, utep);

         i = 0;             /* Don't print twice. */

         if cdte.in_use < NOW_LOGGED_IN then goto process_destroyed; /* if no process to destroy, don't try */
         if cdte.in_use = NOW_LOGGED_IN then go to process_stopped; /* Do we need to wait for a process to die? */
         if cdte.in_use > NOW_LOGGED_IN then goto exit1; /* wait for process to be stopped by ring zero */

    end;                    /* end have cdte */

/* If we get here, we don't have a cdte */

    if ute.active = NOW_LOGGED_IN then goto process_stopped;
    if ute.active > NOW_LOGGED_IN then goto exit1;   /* wait for ring zero to stop process */

/* If we get here, there's a bug */

    call sys_log_ (2, "dialup_: cdtep = null and ate.active = ^d for ^p", ute.active, utep);
    goto exit1;             /* what else should we do? */

/* Return here when the process has had a chance to run and destroy itself.
   Call accounting to log him out completely, get his channel back, type nice messages. */

/* WAIT_(LOGOUT LOGOUT_HOLD DETACH NEW_PROC REMOVE DELETE_CHANNEL) */
hand (9): hand (10): hand (11): hand (12): hand (13): hand (20):
    if wakeup_from_user then go to fals0;       /* User cannot send this. */
    if signal_type ^= "STOPstop" then
         if signal_type ^= "stopstop" then do;  /* we're waiting for a stopstop, and this isn't one */

        if signal_type = "device  " then goto fals0; /* worse-than-useless signal from network */

        if asu_$check_for_stopped_process (utep, ME) then /* if process is stopped */
             goto process_stopped;      /* the stopstop wakeup must have been lost */
        else goto fals0;            /* process not stopped; log and ignore this wakeup */
         end;

process_stopped:

    call dpg_$finish (utep);
    call act_ctl_$dp (utep);
    ute.active = NOW_LOGGED_IN;         /* No process any more. */
    if have_cdte then
         cdte.in_use = NOW_LOGGED_IN;
    i = 0;
    if ute.destroy_flag ^= WAIT_NEW_PROC then do;   /* Unless a new_proc, log him out. */
         call act_ctl_$close_account (utep);    /* Close account and print logged out msg to opr */
         call lg_ctl_$logout (utep);

         if ^have_cdte then goto process_destroyed; /* if no cdte, skip the following channel stuff */

         if cdte.tra_vec = WAIT_DELETE_CHANNEL then do; /* channel was deleted by CDT installation */
        cdte.in_use = CHANNEL_DELETED;  /* but we had to keep it long enough to destroy the process */
        cdte.tra_vec = WAIT_HANGUP;     /* ignore all wakeups */
        cdte.current_service_type = INACTIVE;   /* INACTIVE */
        goto exit1;         /* now we can mark it deleted and get out */
         end;

         if cdte.tra_vec = WAIT_REMOVE then do; /* we hung up the channel before destroying the process */
        cdte.in_use = NOW_HUNG_UP;      /* line will be ignored until ATTACHed or CDT installed */
        go to exit1;            /* we quit before trying to print message, listen, etc. */
         end;
         if ^ute.pw_flags.noprint then do;      /* If logout message will be needed. */
        i = float (ute.cpu_usage, 63) / 1e6 + .5e0; /* convert usec to sec, rounded */
        j = divide (i, 60, 17, 0);      /* j= number of usage minutes */
        i = i - j * 60;         /* i= mod (usage, minutes)  */
        t1 = float (ute.mem_usage, 63) / 1e3;   /* Get memory usage. */
        call date_time_ (anstbl.current_time, date_time);
        if j > 0 then            /* Use different message if there were minutes. */
             call ioa_$rs (logout_fmt, buff, i, ute.person, ute.project, date_time, j, i, t1, ute.session_cost);
        else call ioa_$rs (logout_fmt1, buff, i, ute.person, ute.project, date_time, i, t1, ute.session_cost);
         end;
    end;

process_destroyed:
    if ^have_cdte then do;          /* if no cdte, we just destroyed a disconnected process */
         call unlock;               /* so clean up the way listen_again (below) does */
         ute.active = NOW_FREE;         /* imitate a little bit of asu_$release_ate */
         anstbl.nlin = anstbl.nlin - 1;     /* a very little bit */
         goto exit1;                /* and then get out quickly */
    end;


    call astty_$tty_state (cdtep, code);        /* Verify that user has not hung up. */
    if code ^= 0 then go to cleanup_hangup;     /* random error */
    if cdte.state < TTY_DIALED then go to cleanup_hangup; /* Is tty hung up already? */

    if i > 0 then                /* Do we have logout message? */
         if ^ute.pw_flags.noprint then do;      /* User want messages? */
        call astty_$tty_force (cdtep, addr (buff), i, code); /* write logout message */
        if code ^= 0 then go to cleanup_hangup;
         end;

    call update_term_info ();           /* go get the latest about the term */

    if cdte.tra_vec = WAIT_LOGOUT_HOLD then do; /* Was logout hold, type "users" message. */
         call timer_manager_$reset_alarm_wakeup (cdte.event);
         if ute.pw_flags.noprint then say_hello = "0"b; else say_hello = "1"b;
         just_dialed_up = "0"b;
         call free_ute;             /* we'll get a new one if we must */
         cdte.in_use = NOW_DIALED;
         go to login;
    end;
    else if cdte.tra_vec = WAIT_NEW_PROC then go to create; /* Make new process as result of term or new_proc */

    cdte.in_use = NOW_DIALED;           /* No user any more. */

/* Hang up the terminal, and set up to listen for next dialup (unless detach) */

listen_again:
timeout (1):
timeout (8):
timeout (9):
timeout (10):
timeout (11):
timeout (12):
timeout (13):
timeout (14):
timeout (15):
    call unlock;                /* release answer table, permit updates */
    call free_ute;
    call timer_manager_$reset_alarm_wakeup (cdte.event);
    call ipc_$drain_chn (cdte.event, code);     /* .. he's got no future */

/**** * NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE * ****/
/**** *                   * ****/
/**** * The following tests should be replaced by    * ****/
/**** * code that classifies a wakeup as a hangup    * ****/
/**** * wakeup, rather than taking an error          * ****/
/**** * elsewhere.                * ****/

    if cdte.state = TTY_DIALED then do;     /* If he's still there, tell him hang is on purpose */
         call turn_printer_on (ignore_code);
         call astty_$tty_force (cdtep, addr (hangup_msg), hangup_msg_lth, ignore_code);

/* Don't order the hangup until all the output is finished printing. */

         cdte.detach_after_hangup = (cdte.tra_vec = WAIT_DETACH); /* remember if detaching */
         cdte.tra_vec = WAIT_BEFORE_HANGUP;
hand (25):                  /* WAIT_BEFORE_HANGUP */
         call timer_manager_$reset_alarm_wakeup (cdte.event); /* we don't know if we got a timer or an output complete */
         call ipc_$drain_chn (cdte.event, code);    /* so we'll clear out both, to avoid an extraneous wakeup */
         write_status_info.output_pending = ""b;
         call astty_$tty_order (cdtep, "write_status", addr (write_status_info), code);

         if code ^= 0 then          /* FOR DEBUGGING */
        if loudsw then do;          /* only if dial_loud is on */
             if ^loud_select_sw     /* if tracing all channels */
            | substr (cdte.name, 1, length (loud_select_channel)) = loud_select_channel /* or tracing this one */
             then call sys_log_$error_log (1, code, ME, "From write_status order on ^a", cdte.name);
        end;                /* END DEBUGGING CODE */
                        /* Note that the write_status order might fail legitimately,
                           if the dim doesn't support it; that's not a real error. */
         if code = 0 then           /* if write status order worked */
        if write_status_info.output_pending then do; /* and there's stuff yet to be printed */
             call timer_manager_$alarm_wakeup (10, "11"b, cdte.event); /* set 10 second timer, since we don't
                           always get a wakeup when output is complete */
             goto exit1;            /* don't hang up until it's all done */
        end;                /* we'll get a wakeup when it's done */
         if cdte.detach_after_hangup then       /* if we were detaching the channel */
        cdte.tra_vec = WAIT_DETACH;     /* put back the proper tra_vec value */

         call astty_$tty_order (cdtep, "hangup", null, ignore_code); /* also clears modes & flags in ttydim */
         cdte.in_use = NOW_HUNG_UP;     /* keep our records straight */
    end;

    if cdte.in_use > NOW_LISTENING then do;      /* TRAP BUG where state and in_use get inconsistent */
         call sys_log_ (0, "dialup_: cdte ^p (^a) state ^d in use ^d - notify system programmer",
        cdtep, cdte.name, cdte.state, cdte.in_use);
         cdte.in_use = NOW_HUNG_UP;     /* to avoid losing the channel */
    end;

    cdte.dialed_up_time = cdte.dialed_up_time + /* Compute running total, in seconds */
         float (anstbl.current_time - cdte.dialup_time, 63) / 1e6 + .5e0;

    if cdte.tra_vec ^= WAIT_DETACH then do;     /* If operator wants this tty detached, omit the listen  */
         call astty_$tty_state (cdtep, code);   /* We want the channel back again */
         if cdte.state = TTY_DIALED then        /* Still dialed, wait for hangup to happen */
        cdte.tra_vec = WAIT_HANGUP;     /* hand(17) does listen after hangup wakeup, ignores others */
         else do;               /* channel is already hung up */
        call ipc_$drain_chn (cdte.event, code); /* so discard the hangup wakeup, which would
                           just confuse us if it came along later */
        if ^sc_stat_$shutdown_typed then    /* if not shutting down */
             if cdte.state ^= TTY_MASKED then
            call asu_$asu_listen (cdtep, code); /* Turn on channel again. Reset CDTE */
         end;
    end;
    go to exit1;
%page;
/* Come here if cannot write fatal process error message, or if user
   hangs up during a new_proc */

cleanup_hangup:
    if cdte.tra_vec = WAIT_NEW_PROC then do;    /* were we going to give a new process? */
         call act_ctl_$close_account (utep);    /* close account & log logout */
         call lg_ctl_$logout (utep);        /* remove user from whotab */
    end;

/* If the error was caused by an FNP crash, the cdte could be in any state,
   and asu_listen will quit before fixing it up - so we fix it up a little, here */

    call astty_$tty_order (cdtep, "hangup", null, ignore_code); /* be sure of hangup, and set cdte.state */
    cdte.in_use = NOW_HUNG_UP;          /* or it will be, real soon */

    if code = 0 then go to listen_again;        /* just a hangup, do normal reset */
    go to chn_error;                /* some other error, bomb out */

%page;
/* Come here if any call to astty_ returns a non-zero code */
/* If -1 (hangup) is always returned when the FNP has gone down, then there is no problem -
   otherwise, FNP crashes will result in channels being removed, which we don't want */

chn_error:
    if channel_error () then go to exit1;
    else go to listen_again;

/* come here when something goes wrong with the tty channel which can
   probably be blamed on something the user did.  For example, typing in
   an outrageous answerback, or causes some invalid combination of modes and
   line types. */

chn_user_error:
    call convert_status_code_ (code, shxx, error_mess); /* tell user 'what' went wrong */
    call ioa_$rs ("Error during initialization or while processing last pre-access command:^/ ^a", buff, i, error_mess);
    call print_buff;
    go to try_again;                /* count offences and proceed */

ttt_error:
    call remove_channel ("ttt");
    go to exit1;

/* Come here in case of fault during login or logout. */

abort:  static_label = exit;            /* so as not to loop */
    if utep = null then go to listen_again;     /* not much to do */
    funct = "ucs     ";
    ute.destroy_flag = WAIT_LOGOUT_HOLD;        /* pretend logout hold */
    if have_cdte then
         cdte.tra_vec = WAIT_LOGOUT_HOLD;       /* make cdte tra_vec equal the one in ate */
    ute.logout_type = "ucs ";
    ute.pw_flags.noprint = "0"b;
    tcode = as_error_table_$dialup_error;
    i = 0;                  /* Buff is empty */
    go to kill;
%page;
evil3:  call sys_log_ (2, "dialup_: called with null message ptr");
    goto return_immediately;            /* metering was not turned on */

evil2:  call sys_log_ (2, "dialup_: called while ansp = null");
    goto return_immediately;            /* metering was not turned on */

evil1:  call sys_log_ (2, "dialup_: called with bad ptr ^p by ^w", ev_msg.data_ptr, ev_msg.fromproc);
    goto exit1;             /* metering was on; go turn it off before returning */

evil:   call asu_$find_process (ev_msg.fromproc, i, q); /* find out who sent signal */
    if q ^= null then do;
         call get_trace_info;
         call sys_log_ (2, "dialup_: ignored ^a from ^a.^a for ^a st=^d,inuse=^d,tv=^d",
        tsignal_type, q -> ute.person, q -> ute.project, tname, tstate, tinuse, ttv);
         goto exit1;                /* metering was turned on so go turn it off */
    end;                    /* can't find process; fall thru and print a different message */
fals:   i = 2;                  /* print with alarm */
falsi:  call get_trace_info;
    call sys_log_ (i, "dialup_: ignored ^a for ^a st=^d,inuse=^d,tv=^d",
         tsignal_type, tname, tstate, tinuse, ttv);
    goto exit1;             /* metering was turned on, so go turn it off */
fals0:  i = 0;                  /* just log */
    goto falsi;
%page;

/* Come here when a channel (terminal) that has been requested by a user
   process finally dials up. TTYDIM won't let us connect it to user unless
   it is actually dialed up. */

hand (14):                  /* WAIT_FIN_PRIV_ATTACH */
    call astty_$tty_state (cdtep, code);        /* get current state of channel */
    if cdte.state = TTY_DIALED then
         call dial_ctl_$finish_priv_attach (cdtep); /* do the work */
    else if cdte.state <= TTY_HUNG then do;      /* up and then down too fast for us */
         call ipc_$drain_chn (cdte.event, code);    /* get rid of any dross */
         if ^sc_stat_$shutdown_typed then
        if cdte.state ^= TTY_MASKED then
             call asu_$asu_listen (cdtep, code);/* turn on channel again. Reset CDTE */
    end;
    go to exit1;

/* Next section of code takes care of dialed consoles' events */

hand (15):                  /* WAIT_DIAL_RELEASE */
    call astty_$tty_state (cdtep, code);        /* get current state of channel */
    if cdte.state > TTY_HUNG then go to exit1;   /* wait for correct event */
    call dial_ctl_$dial_term (cdtep);       /* Reset CDTE & tell master */
    go to exit1;                /* All done. */

/* This code handles completion of auto_call dialing */

hand (16):                  /* WAIT_DIAL_OUT */
    call dial_ctl_$finish_dial_out (cdtep);     /* That's all folks! */
    go to exit1;

/* This code handles waiting for the hangup event to occur. When */
/* it does, we will listen to the channel */

hand (17):                  /* WAIT_HANGUP */
    call astty_$tty_state (cdtep, code);        /* get current state of channel */
    if cdte.state > TTY_HUNG then go to exit1;   /* wait for correct event */

    if ^sc_stat_$shutdown_typed         /* if we're not shutting down */
         & cdte.in_use ^= CHANNEL_DELETED       /* or being deconfigured */
         & (cdte.current_service_type = ANS_SERVICE | /* and this is still live */
         cdte.current_service_type = SLAVE_SERVICE)
    then if cdte.state ^= TTY_MASKED
         then call asu_$asu_listen (cdtep, code);   /* ready for use, reconnect to channel */
/**** * This will swallow all wakeups for channel from now on. */
    go to exit1;

/* This code handles wakeups for slave service channels before anyone has asked
   for them. It just ignores the wakeups */

hand (18):                  /* WAIT_SLAVE_REQUEST */
    go to hand (17);                /* go discard all wakeups except hangups */

/* This code allows a procedure other than dialup_ to invite a user to log in
   on an already dialed up channel. It is used by dial_ctl_$dial_broom, when the
   master process of a dialed channel terminates. That procedure sets
   cdte.tra_vec to WAIT_GREETING_MSG and sends a wakeup with "device  " as a message */

hand (19):                  /* WAIT_GREETING_MSG */
    call grab_tty;              /* make sure we can read and write on the channel */
    say_hello = "1"b;
    just_dialed_up = ""b;
    cdte.in_use = NOW_DIALED;
    goto login;

/* Come here when a channel that has been requested for T & D attachment hangs up. It must be hung up and not listening
   in order for the attachment to continue. */

hand (22):                  /* WAIT_TANDD_HANGUP */
    call astty_$tty_state (cdtep, code);        /* get current state of channel */
    if cdte.state > TTY_HUNG then go to exit1;   /* wait for correct event */
    call dial_ctl_$continue_tandd_attach (cdtep);   /* do the work */
    go to exit1;

/* Come here when a channel that has been requested for T & D attachment signals dialup.
   This is a simulated dialup that allows the attaching process to communicate with the
   channel in a normal fashion. */

hand (23):                  /* WAIT_FIN_TANDD_ATTACH */
    call astty_$tty_state (cdtep, code);
    if cdte.state ^= TTY_DIALED then go to exit1;   /* wait for correct event */
    call dial_ctl_$finish_tandd_attach (cdtep); /* if so, process it */
    go to exit1;

/* Come here when changes in a channel's state are uninteresting -- it is not available for use until the master
   process lets go of it. */

hand (24):                  /* WAIT_DISCARD_WAKEUPS */
    go to exit1;                /* really just discard it */
%page;
change_type: proc (new_type, do_tabs, do_init, code);

dcl  new_type char (*);
dcl  do_tabs bit (1);
dcl  do_init bit (1);
dcl  code fixed bin (35);

    set_type_info.version = stti_version_1;
    set_type_info.name = new_type;
    string (set_type_info.flags) = "0"b;
    call astty_$tty_order (cdtep, "set_term_type", addr (set_type_info), code);
    if code ^= 0 then return;

    call ttt_info_$dialup_flags (new_type, cdte.dialup_flags.ppm, cdte.dialup_flags.cpo, code);
    if code ^= 0 then return;

    cdte.current_terminal_type = new_type;
    if ^do_tabs then return;
    if do_init then call set_tabs_and_modes (code); /* Reset options for new type. */
    else call set_tabs_and_modes_gently (code);

     end change_type;
%page;
channel_error: proc returns (bit (1) aligned);      /* "1"b if a real error happened */
    if code = -1 then if cdte.state < TTY_DIALED then do; /* code = -1 means "it hung up" */
        cdte.in_use = NOW_HUNG_UP;      /* keep cdte consistent */
        return ("0"b);
         end;
    call remove_channel ("tty_dim");
    return ("1"b);
     end;
%page;
convert_message: proc (p_status_code) returns (char (100) varying);

declare  p_status_code fixed binary (35) parameter;

declare  short character (8) aligned automatic,
         long character (100) aligned automatic;

    call convert_status_code_ (p_status_code, short, long);

    return (rtrim (long, " "));

     end convert_message;
%page;
free_ute: proc;

    call asu_$release_ate (cdtep, code);        /* Free the ATE */
    utep = null;
    have_ate = ""b;
     end;
%page;
get_next_disc_ate_jkp: proc;

/* This procedure gets the next disconnected ate in a disconnected list, and checks the list for consistency.
   Global variables j, k, and p are implied arguments. j is the position in the list (input),
   and k and p are the ate index, and pointer, respectively, of the next ate in the list (output). */

    if j = 1 then
         k = cdte.disconnected_ate_index;
    else k = p -> ute.next_disconnected_ate_index;
    if k <= 0 | k > anstbl.current_size then do;
         call sys_log_ (1, "dialup_: program error: disconnected ate index no. ^d for ^a.^a is ^d",
        j, ute.person, ute.project, k);
         goto abort;
    end;
    p = addr (anstbl.entry (k));            /* get ptr to next ate in list */

    if ^p -> ute.disconnected            /* if ate is not disconnected */
         | ^(p -> ute.person = ute.person        /* or doesn't belong to this user */
         & p -> ute.project = ute.project)
         | ^(p -> ute.active = NOW_HAS_PROCESS)  /* or doesn't have a live process */
    then do;                    /* inform user, and logout -hold */
         call ioa_$rs ("Your disconnected process^x^[#^d^x^;^s^]has changed state unexpectedly;
it may have been bumped or connected to another terminal.",
        buff, i, (cdte.n_disconnected_procs > 1), j);
         call print_buff;
         logout_hold = "1"b;
         goto log_disconnected_user_out;
    end;
    return;

     end get_next_disc_ate_jkp;
%page;
get_trace_info: proc;               /* format information for printing,
                           either in trace or error message */

dcl  i fixed bin;
dcl  o_sw bit (1);                  /* says whether to print msg in octal or character */
dcl  char8 char (8);


/* First, format the contents of the wakeup message, in ASCII, octal, or both */

    char8 = "........";
    o_sw = "0"b;                /* assume character */
    do i = 1 to length (signal_type);       /* check each character */
         if unspec (substr (signal_type, i, 1)) < "040"b3 |
        unspec (substr (signal_type, i, 1)) > "176"b3 then
        o_sw = "1"b;            /* if nonprinting char, remember to print in octal */
         else substr (char8, i, 1) = substr (signal_type, i, 1); /* copy printing char into ASCII string */
    end;
    call ioa_$rsnnl ("^[""^a""^x^;^s^]^[(^w ^w)^;^2s^]", tsignal_type, (0), (char8 ^= "........"), char8, o_sw,
         substr (unspec (signal_type), 1, 36), substr (unspec (signal_type), 37, 36));

/* Then get state information from either the cdte or ate (whichever we have) or maybe both */

    if wakeup_for_channel & cdtep ^= null then do;  /* if wakeup came in over a cdte channel */
         tname = rtrim (cdte.name);
         if utep ^= null then
        tname = tname || " (" || rtrim (ute.person) || "." || rtrim (ute.project) || ")";
         tanswb = cdte.tty_id_code;
         tstate = cdte.state;
         ttv = cdte.tra_vec;
         tinuse = cdte.in_use;
    end;

    else if wakeup_for_process & utep ^= null then do;/* or, if it came in over an ate channel */
         tname = rtrim (ute.person) || "." || rtrim (ute.project); /* construct an informative name */
         if cdtep ^= null then do;      /* if we have a cdte, get more debugging info */
        tname = tname || " (" || rtrim (cdte.name) || ")";
        tstate = cdte.state;
         end;
         else do;
        tname = tname || " (" || rtrim (ute.tty_name) || ")";
        tstate = 0;         /* no channel state info in ate */
         end;
         tanswb = ute.tty_id_code;      /* a copy of cdte.tty_id_code */
         ttv = ute.destroy_flag;            /* a copy of cdte.tra_vec */
         tinuse = ute.active;           /* a copy of cdte.in_use */
    end;

    else do;                    /* should never happen, but be cautious */
         tname = "???";
         tanswb = "";
         tstate, tinuse, ttv = 0;
    end;
    return;

     end get_trace_info;
%page;
grab_tty: proc;

/* Internal procedure to assign a channel back to the answering service so
   we can talk to it.  It must always work, so we ignore any codes which
   might indicate errors or hangups */

    call astty_$tty_order (cdtep, "quit_disable", null, ignore_code);
    call astty_$tty_event (cdtep, ignore_code); /* Set read terminations to come to me */
    call turn_printer_on (ignore_code);

     end grab_tty;
%page;
grab_ute: proc;
    call asu_$attach_ate (cdtep, code);     /* allocate user table entry */
    if code ^= 0 then do;
         call sys_log_$error_log (1, code, ME, "^a", cdte.name);
         if code = as_error_table_$tty_no_room then do; /* if answer table is full */
        call sys_log_ (1, "dialup_: The answer table is full (^d entries)", anstbl.max_size);
        code = as_error_table_$sys_full;    /* don't burden user with details, just say "System full." */
         end;
         call asu_$write_chn_message (cdtep, code, shxx, ignore_code);
         if ignore_code ^= 0 then goto chn_error;   /* don't really ignore the code */
         goto listen_again;         /* go hang up and listen - no use saying please try again */
    end;
    utep = cdte.process;            /* copy ptr to ate that we just got */
    have_ate = "1"b;                /* and tell everyone else that it's ok to reference the ate */
     end;
%page;
hello: proc (leading_NLs);              /* returns code from write_force */

dcl  leading_NLs fixed bin;
dcl  special_msg_fmt char (5) static options (constant) init ("^v/^a");
dcl  special_message char (anstbl.message_lng) based (addr (anstbl.special_message));

    if anstbl.message_lng > 0 | leading_NLs > 0 then do; /* Any special flash for all users? */
         call ioa_$rsnnl (special_msg_fmt, buff, i, leading_NLs, special_message); /* already have NL */
         call astty_$tty_force (cdtep, addr (buff), i, code);
         if code ^= 0 then return;      /* Lay it on them */
    end;
    t1 = anstbl.n_units / 10.0e0;           /* format load message */
    t2 = anstbl.max_units / 10.0e0;     /* ... */
    call date_time_ (anstbl.current_time, date_time);
    call ioa_$rs (greeting_fmt, buff, i, whotab.sysid, installation_parms.installation_id, cdte.name,
         t1, t2, anstbl.n_users, date_time);
    call astty_$tty_force (cdtep, addr (buff), i, code);

     end hello;
%page;
interpret_preaccess: proc (old_com, new_com, code);

/* this procedure determines whether a preaccess command requires a change of terminal type */

dcl  old_com char (3);
dcl  new_com char (3);
dcl  code fixed bin (35);

    call ttt_info_$preaccess_type (old_com, old_type, code);
    if code ^= 0 then return;
    if cdte.current_terminal_type = old_type
    then do;
         call ttt_info_$preaccess_type (new_com, type_to_set, code);
         if code ^= 0 then return;
         if type_to_set ^= ""
         then call change_type (type_to_set, "1"b, "1"b, code);
    end;

    return;

     end interpret_preaccess;
%page;
lock: procedure;

    ute.lock_value = ute.lock_value + 1;
    anstbl.lock_count = anstbl.lock_count + 1;

    return;

     end lock;
%page;
print_ascii_msg: proc (a_code, a_string);

dcl  a_code fixed bin (35);
dcl  a_string char (*);

    call ioa_$rs (convert_message (a_code), buff, i, a_string);
    call print_buff;
    return;

     end print_ascii_msg;
%page;
print_buff: proc;                   /* replaces dozens of copies of these two lines */

    call astty_$tty_force (cdtep, addr (buff), i, code);
    if code ^= 0 then goto chn_error;
    return;

     end print_buff;
%page;
print_help: proc (ename);

dcl  ename char (*);

dcl  segp ptr init (null);
dcl  segl fixed bin;
dcl  seg char (segl) based (segp);

    call hcs_$initiate_count (anstbl.sysdir, (ename), "", segl, (0), segp, code);
    if segp = null then do;
         call sys_log_$error_log (2, code, ME, "^a>^a", anstbl.sysdir, ename);
         call ioa_$rs ("^a ^a>^a", buff, i, convert_message (code), anstbl.sysdir, ename);
         call astty_$tty_force (cdtep, addr (buff), i, code);
         if code ^= 0 then goto chn_error;
    end;
    else do;
         segl = divide (segl, 9, 17, 0);        /* get length in characters */

         do i = 1 repeat i + j while (i < segl); /* Write one line at a time of help file */
        j = index (substr (seg, i), NL);    /* Scan for end of line. */
        if j = 0 then j = segl - i + 1; /* if last newline missing, print what's there */
        call astty_$tty_force (cdtep, addr (substr (seg, i, 1)), j, code);
        if code ^= 0 then go to chn_error;
         end;
         call astty_$tty_force (cdtep, addr (NL), length (NL), code); /* put out a blank line */
         if code ^= 0 then goto chn_error;
         call hcs_$terminate_noname (segp, code);
    end;

    return;

     end print_help;
%page;
print_logged_out: proc;

    call date_time_ (anstbl.current_time, date_time);
    call ioa_$rs (convert_message (as_error_table_$logout_disconnected_msg), buff, i,
         ute.person, ute.project, date_time);
    call print_buff;
    return;

     end print_logged_out;
%page;
remove_channel: proc (err_type);

dcl  err_type char (*);

    call sys_log_$error_log (2, code, ME, "^a error, removing channel ^a ^a",
         err_type, cdte.name, cdte.comment);
    call unlock;                /* release answer table, permit updates */
    call free_ute;              /* Free the UTE */
    call timer_manager_$reset_alarm_wakeup (cdte.event);
    call asu_$asu_remove (cdtep);
     end;
%page;
send_mail:
     proc (message);

dcl  message char (*);

dcl  user_id char (32);

    if utep = null
    then return;                /* can't do anything */
    user_id = rtrim (ute.person) || ".";        /* build Person.Project */
    user_id = rtrim (user_id) || ute.project;
    unspec (send_mail_info) = "0"b;
    send_mail_info.version = send_mail_info_version_2;
    send_mail_info.wakeup = "1"b;
    send_mail_info.always_add = "1"b;
    send_mail_info.sent_from = "answering service";

    call send_mail_$access_class (user_id, message, addr (send_mail_info), ute.process_authorization, code);
    if code ^= 0 & code ^= error_table_$messages_deferred & code ^= error_table_$messages_off
    then call sys_log_$error_log (0, code, "dialup", "Unable to notify user ^a of dialup event", user_id);
    return;

     end send_mail;
%page;
set_tabs_and_modes: procedure (bv_tabs_code);

declare  bv_tabs_code fixed bin (35) parameter;

dcl  init_sw bit (1) init ("1"b);

join:   if cdte.line_type ^= LINE_TELNET        /* this isn't the way to set network tabs         */
    then do;
         call ttt_info_$initial_string (cdte.current_terminal_type, tab_string, bv_tabs_code);
         if bv_tabs_code ^= 0 then return;
         if length (tab_string) ^= 0 then do;
        call astty_$tty_changemode (cdtep, "rawo", bv_tabs_code); /* write string out exactly */
        if bv_tabs_code ^= 0 then return;

        p = addrel (addr (tab_string), 1);  /* varying string */
        call astty_$tty_force (cdtep, p, length (tab_string), bv_tabs_code);
        if bv_tabs_code ^= 0 then return;
         end;
    end;

    call ttt_info_$modes (cdte.current_terminal_type, modes_string, bv_tabs_code);
    if bv_tabs_code ^= 0 then return;

    if init_sw then call astty_$tty_changemode (cdtep, "force,init," || modes_string, bv_tabs_code);
    else call astty_$tty_changemode (cdtep, "force," || modes_string, bv_tabs_code);
    return;

set_tabs_and_modes_gently: entry (bv_tabs_code);

    init_sw = "0"b;
    go to join;

     end set_tabs_and_modes;
%page;
trace: proc;

    if loud_select_sw then do;          /* trace only specified channel(s) */
         if have_cdte then do;
        if loud_select_channel ^=       /* if specified string is not equal to */
             substr (cdte.name, 1, length (loud_select_channel)) /* the beginning of this channel's name */
        then return;            /* then don't trace it */
         end;
         else if have_ate then do;
        if loud_select_channel ^=
             substr (ute.tty_name, 1, length (loud_select_channel))
        then return;
         end;
    end;
    call get_trace_info;
    call sys_log_ (1, "dialup_: trace event ^a ^a ^w ^p st=^d,inuse=^d,tv=^d",
         tname,             /* channel name */
         tsignal_type,              /* what was signalled */
         ev_msg.fromproc,           /* signalling processid */
         ev_msg.data_ptr,           /* ptr to cdte or ate */
         tstate, tinuse, ttv);          /* line state, entry state, wait point */

     end trace;
%page;
turn_printer_on: proc (bv_turn_code);

declare  bv_turn_code fixed bin (35) parameter;

    call astty_$tty_order (cdtep, "printer_on", null, bv_turn_code);
    if bv_turn_code ^= 0
    then if bv_turn_code = error_table_$action_not_performed
         then bv_turn_code = 0;

    return;

     end turn_printer_on;
%page;
type_black: proc;

    call astty_$tty_order (cdtep, "printer_off", null, code);
    if code ^= 0                /* allow only 0 or action_not_performed */
    then if code ^= error_table_$action_not_performed
         then go to chn_error;

    if (ute.pw_flags.mask_ctl = DO_MASK)
         | (ute.pw_flags.mask_ctl = DERIVE_MASK & (code ^= 0))
    then do;
         substr (ubits, 1, 36) = bit (fixed (anstbl.current_time, 36, 0), 36);
         substr (ubits, 37, 36) = bit (fixed (fixed (anstbl.current_time, 35) * 99991, 36, 0), 36);
         do i = 2 to 13;
        substr (garbg, 39 + i, 1) = substr (RANDOM, fixed (substr (ubits, 1 + 5 * i, 5), 17) + 1, 1);
         end;
         call astty_$tty_force (cdtep, addr (garbg), garbg_lth, code);
    end;
    else call astty_$tty_force (cdtep, addr (NL), size (NL), code); /* now that printer is off, signal user */
    if code ^= 0 then go to chn_error;
    return;

     end type_black;
%page;
ucs: proc (mcptr, condname, coptr, infoptr, continue);

dcl  (mcptr, coptr, infoptr) ptr, condname char (*), continue bit (1);
dcl  errm char (120) aligned, erri fixed bin;
dcl  non_local bit (1);
dcl  as_check_condition_ entry (char (*), bit (1), bit (1));

    call as_check_condition_ (condname, continue, non_local);
    if continue | non_local then return;

    tname, tanswb = "";
    tstate, tinuse, ttv = -999;

    if ^static_fault_sw then do;            /* avoid infinite loop of get_trace_info faults */
         static_fault_sw = "1"b;
         call get_trace_info;           /* get info out of either ate or cdte */
         static_fault_sw = ""b;
    end;
    call ioa_$rsnnl ("dialup_: Error ^a ^a ""^a"" ^a st=^d,inuse=^d,tv=^d", errm, erri,
         condname, tname, tanswb, tsignal_type, tstate, tinuse, ttv);
    call as_dump_ (errm);
    go to static_label;

     end ucs;
%page;
unlock: proc;

    if utep ^= null             /* Might unlock when not needed. */
    then anstbl.lock_count = anstbl.lock_count - ute.lock_value;
    if anstbl.lock_count < 0 then anstbl.lock_count = 0;
    if anstbl.lock_count = 0 then do;
         code = 0;
         if ^simulated_wakeup_sw then do while (code = 0);
        call ipc_$unmask_ev_calls (code);
        if code = 0 then call ioa_ ("dialup_: error - event calls were masked");
         end;
    end;
    if utep ^= null then ute.lock_value = 0;
    if ((anstbl.lock_count = 0) & (anstbl.update_pending = "1"b)) then do;
         anstbl.update_pending = "0"b;      /* reset update-pending flag  */
         call hcs_$wakeup (as_procid, anstbl.update_channel, dum_msg, code);
                        /* trigger dormant update procedure */
    end;

    return;

     end unlock;
%page;
update_term_info: proc;


    term_info.version = terminal_info_version;
    call astty_$tty_order (cdtep, "terminal_info", addr (term_info), code);
    if code ^= 0 then go to chn_error;      /* Get the info that's available. */

    cdte.current_terminal_type = term_info.term_type; /* Store info in CDTE for this channel */
    cdte.tty_id_code = term_info.id;        /* .. */
    cdte.cur_line_type = term_info.line_type;   /* .. */
    if cdte.flags.autobaud then         /* if it changes, save what he said */
         cdte.baud_rate = term_info.baud_rate;  /* .. */

    return;

     end update_term_info;
%page;
/* ADDITIONAL ENTRY POINTS */

/* initialize: we're happy to do this as many times as asked, because we
   don't touch any tables. */

init: entry;

    wcr = as_data_$CR;              /* set up characters hard to type */
    greeting_fmt = convert_message (as_error_table_$greeting_msg);
    bad_login_word_fmt = convert_message (as_error_table_$bad_login_word_msg);
    proc_term_fmt = convert_message (as_error_table_$proc_term_msg);
    init_term_fmt = convert_message (as_error_table_$init_term_msg);
    proc_term_loop_fmt = convert_message (as_error_table_$proc_term_loop_msg);
    logout_fmt = convert_message (as_error_table_$logout_msg);
    logout_fmt1 = convert_message (as_error_table_$logout1_msg);

    call convert_status_code_ (as_error_table_$pw_msg, shxx, format);
    call ioa_$rsnnl (rtrim (format), pw_msg, pw_msg_lth);

    call convert_status_code_ (as_error_table_$npw_msg, shxx, format);
    call ioa_$rsnnl (rtrim (format), npw_msg, npw_msg_lth);

    call convert_status_code_ (as_error_table_$npw_again_msg, shxx, format);
    call ioa_$rsnnl (rtrim (format), npw_again_msg, npw_again_msg_lth);

    call ioa_$rsnnl ("^/YourPassword^aXWXWXWXWXWXW^a986543986543^agqypjmmjpyqg^a", garbg, garbg_lth,
         wcr, wcr, wcr, wcr);

    call convert_status_code_ (as_error_table_$hangup_msg, shxx, format);
    call ioa_$rsnnl (rtrim (format), hangup_msg, hangup_msg_lth);

    unspec (dum_msg) = unspec (unlock_string);  /* wakeup message sent by unlock */

    return;
%page;
dial_loud: entry;

dcl  cu_$arg_count entry returns (fixed bin);
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  argp ptr, argl fixed bin, arg char (argl) based (argp);
dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35));
dcl  loud_select_sw bit (1) aligned int static init (""b);
dcl  loud_select_channel char (32) varying int static init ("");

    loudsw = "1"b;

    if cu_$arg_count () = 0 then            /* if no argument, trace all channels */
         loud_select_sw = ""b;
    else do;                    /* trace the specified channel(s) */
         loud_select_sw = "1"b;
         call cu_$arg_ptr (1, argp, argl, code);
         loud_select_channel = arg;     /* can be something like "a.h1" */
    end;

    return;

dial_soft: entry;

    loudsw = "0"b;

    return;
%page;
re_introduce: entry;                /* say hello to dialed up channels again */

    begin;
dcl  i fixed bin;                   /* no interference from anyone! */
         do i = 1 to scdtp -> cdt.current_size;
        cdtep = addr (scdtp -> cdt.cdt_entry (i));
        if cdte.service_type = ANS_SERVICE &
             cdte.tra_vec = WAIT_LOGIN_LINE then do;
             call astty_$tty_state (cdtep, code); /* let's double-check */
             if code ^= 0 then say_hello = ^channel_error (); /* ignore return value */
             else if cdte.in_use = NOW_DIALED &
                 cdte.state = TTY_DIALED then do; /* should do a read_status or check the ipc channel */
            call astty_$tty_abort (cdtep, 2, code); /* conserve tty_buf, flush anything backed */
            if code ^= 0 then go to reintro_fails;
            call hello (2);     /* keep talking */
            if code ^= 0 then
reintro_fails:           say_hello = ^channel_error (); /* ignore return value */
             end;               /* have a client */
        end;
         end;                   /* all CDTEs */
         return;
    end;

/* format: off */
%page; %include answer_table;
%page; %include as_data_;
%page; %include as_data_definitions_;
%page; %include as_meter_numbers;
%page; %include as_wakeup_priorities;
%page; %include author_dcl;
%page; %include cdt;
%page; %include dialup_values;
%page; %include installation_parms;
%page; %include line_types;
%page; %include pdt;
%page; %include sc_stat_;
%page; %include send_mail_info;
%page; %include set_term_type_info;
%page; %include terminal_info;
%page; %include user_attributes;
%page; %include user_table_entry;
%page; %include whotab;

/* format: on */
%page;

/* BEGIN MESSAGE DOCUMENTATION

   Message:
   dialup_: error - event calls were masked

   S:   sc (user_output).

   T:   $run

   M:   This message indicates a serious error in the Initializer
   programs.  The system attempts to recover and keep running.

   A:   $notify


   Message:
   dialup_: channel definition table garbaged at SSS|XXX

   S:   as (severity2).

   T:   $run

   M:   A bad value has been found in the CDT.  This may
   be the result of a store error, a programming error, or a bad patch.
   The system attempts to remove the channel from use and continue.

   A:   $inform


   Message:
   dialup_: called while ansp = null

   S:   as (severity2).

   T:   $run

   M:   A programming error in the Answering Service or an incorrect
   library installation has caused the Answering Service to be called
   before being initialized.  The system will ignore the error and attempt
   to continue.

   A:   Shut down the system and perform a bootload operation.


   Message:
   dialup_: called with bad ptr XXX|YYY by WWWWWWWWWWWW

   S:   as (severity2).

   T:   $run

   M:   A programming error in the interprocess communication
   system, the network software, or the Answering Service itself has
   occurred.  An invalid message pointer has been passed to the Answering
   Service.  The system ignores the message and attempts to continue.
   This message may be the result of an incorrect library installation.

   A:   Shut down the system and perform a bootload operation.


   Message:
   dialup_: called with null message ptr

   S:   as (severity2).

   T:   $run

   M:   A programming error in the interprocess communication
   system, the network software, or the Answering Service itself
   has occurred.  An invalid message pointer has been passed to
   the Answering Service.  The system ignores the message and
   attempts to continue.  This message may be the result of an incorrect
   library installation.

   A:   Shut down the system and perform a bootload operation.
   Inform the system programming staff.


   Message:
   dialup_: Entry not found. login_help

   S:   as (severity1).

   T:   $init

   M:   The segment login_help is missing. The dialup_ procedure types the
   contents of this segment to a user if he cannot determine
   how to log in.  The system runs normally but nothing is
   printed out if a user types help instead of login.

   A:   $inform_sa


   Message:
   dialup_: Error CONDITION TTYxxx NAME.PROJ IDCODE N

   S:   as (severity2).

   T:   $run

   M:   A supervisor error has prevented the user NAME.PROJ from
   being logged in or out successfully.  The user's wait point is N.  If
   N is 8, the user was trying to log out.  If N is less than 8, the
   user was trying to log in.  The user got the message "hangup" and
   his phone hung up.  All system tables were salvaged as far as possible,
   an Answering Service dump was performed, and the Answering Service attempted to
   continue.

   A:   $note
   If this message comes up on every login and logout,
   it is probably wise to shut the system down and perform a
   bootload operation.


   Message:
   dialup_: ERROR_MESSAGE. creating proc for NAME.PROJ

   S:   as (severity2).

   T:   $run

   M:   The system was unable to create a process for the user
   with name NAME and project PROJ.

   A:   If possible, get in touch with the user. (He got a
   message to contact you.) Ask him to try again and to tell
   you of any peculiarities of his login.  Note all particulars
   and contact the programming staff.


   Message:
   dialup_: ERROR_MESSAGE. ttydim error, removing chn TTYxxx DESCRIPTION

   S:   as (severity2).

   T:   $run

   M:   A supervisor error has caused channel TTYxxx to be
   unusable.  It has been removed from the list of known channels.
   DESCRIPTION is the channel's description in the CDT.

   A:   $inform
   An attach TTYxxx
   command can be tried; if the channel is to be left detached, busy
   out the modem.


   Message:
   dialup_: ERROR_MESSAGE. ttt error, removing chn TTYxxx DESCRIPTION

   S:   as (severity2).

   T:   $run

   M:   An error accessing the TTT has caused channel TTYxxx to be
   unusable.  It has been removed from the list of known channels.
   DESCRIPTION is the channel's description in the CDT.

   A:   $inform
   An attach TTYxxx
   command can be tried; if the channel is to be left detached, busy
   out the modem.


   Message:
   dialup_: ignored FFFFFFFF for TTYxxx N M

   S:   as (severity2).

   T:   $run

   M:   A spurious signal has arrived for some terminal.
   The state of the channel is N and the wait point is M.

   A:   Inform the programming staff if the message recurs.


   Message:
   dialup_: ignored FFFFFFFF from NAME.PROJ for TTYxxx N M

   S:   as (severity2).

   T:   $run

   M:   A spurious signal from user NAME.PROJ has arrived for
   channel TTYxxx.  The state of the channel is N and the wait point is M.

   A:   This may be some user trying to disrupt the system.  Do a
   who and save it for the programming staff.


   Message:
   dialup_: trace event TTYxxx FFFFFFFF WWWWWWWWWWWW RRRRRRDDDDDD SS XXXX st N wp M

   S:   as (severity1).

   T:   $run

   M:   This is trace output.  When dialup_$dial_loud is called,
   these messages are printed out for every signal concerning a device
   channel. FFFFFFFF is the function being performed. WWWWWWWWWWWW is
   the sending process ID. RRRRRR is the ring origin of the signal.
   DDDDDD is the device signal information.  The pointer SS XXXX locates the
   answer table entry for TTYxxx.  The channel state is N and the wait
   point is M.

   A:   $ignore  To turn these messages
   off, type dialup_$dial_soft while in admin mode.


   Message:
   dialup_: wrong answerback on TTYxxx (DESC); expected "ID1", got "ID2"

   S:   as (severity2).

   T:   $run

   M:   The terminal dialed to the Initializer process on channel TTYxxx
   is restricted to a specific answerback and did not return the expected value.
   ID1 is the answerback expected; ID2 is the answerback actually received.
   The terminal is hung up. The description of the channel in the CDT is DESC.

   A:   $ignore

   Message:
   dialup_: process terminated NAME.PROJ ttyXXX REASON

   S:   as (severity0)

   T:   $run

   M:   This output is usually logged and not printed.
   The process for user NAME.PROJ on channel ttyXXX terminated
   for a reason whose short representation is REASON.

   A:   $ignore


   Message:
   dialup_: fatal error during process creation for NAME.PROJ ttyXXX

   S:   as (severity1)

   T:   $run

   M:   The user NAME.PROJ
   could not create his process
   due to a fault during initialization.
   This may be due to a user error:
   incorrect segments in the user's home directory or
   bad login arguments can cause this problem.

   A:   $ignore


   Message:
   dialup_: terminating fatal process error loop for NAME.PROJ ttyXXX

   S:   as (severity1)

   T:   $run

   M:   The system has detected a case where the processes for NAME.PROJ terminate repeatedly.
   The system has therefore logged the user out.
   This message may be due to a user error.

   A:   $ignore


   Message:
   dialup_: premature stopstop for NAME.PROJ ttyXXX

   S:   as (severity1)

   T:   $run

   M:   $err
   This output is usually logged only.

   A:   $ignore


   Message:
   dialup_: cdte SSS|XXX (ttyXXX) state M in use N - notify system programmer

   S:   as (severity1)

   T:   $run

   M:   $err

   A:   $contact


   Message:
   dialup_: cancelling inactivity bump of PERSON.PROJECT

   S:   as (severity 1)

   T:   $run

   M:   a user previous bumped due to inactivity has become active.
   The automatic logout was therefor cancelled.

   A:     $ignore


   Message:
   dialup_: MESSAGE. connect request of PERSON.PROJ denied by channel AIM restriction.

   S:   as (severity 0)

   T:   $run

   M:   A user connect or new_proc request was refused because the AIM
   restrictions of the channel did not allow communication with the
   terminal channel.

   A:     $ignore


   Message:
   dialup_: MESSAGE. process creation for PERSON.PROJECT denied by channel AIM restriction.

   S:   as (severity 0)

   T:   $run

   M:   A user attempted to create a process at an AIM authorization
   which is not allowed by the terminal channel in use. The creation request
   was denied.

   A:     $ignore


   Message:
   dialup_: MESSAGE. new_proc of PERSON.PROJECT denied by channel AIM restriction.

   S:   as (severity 0)

   T:   $run

   M:   a user attempted to issue a new_proc an specify an AIM authorization
   which is not allowed by the terminal channel in use.

   A:     $ignore


   END MESSAGE DOCUMENTATION */

     end dialup_;

"This material is presented to ensure dissemination of scholarly and technical work. Copyright and all rights therein are retained by authors or by other copyright holders. All persons copying this information are expected to adhere to the terms and constraints invoked by each author's copyright. In most cases, these works may not be reposted without the explicit permission of the copyright holder."