MODULE iim$nam_passon;
?? NEWTITLE := 'NOS/VE: IIM$NAM_PASSON ' ??
*copyc osd$default_pragmats

{ Select target operating system

*IF (wev$target_operating_system='NOS')
  ? VAR ifv$nos_be: boolean := false ?;
*ELSE
  ? VAR ifv$nos_be: boolean := true ?;
*IFEND

?? PUSH (LISTEXT := OFF) ??
*copyc ifd$machine_definition
  ?IF ifv$module_for_c180 = TRUE THEN
*copy ost$status
*copyc osv$task_private_heap
  ?ELSE
*copy ost$string

    TYPE
      ost$status_condition = 0 .. 999999;

    TYPE
      ost$status = record
        condition: mlt$status,
      recend;

  ?IFEND

  PROCEDURE [XREF {TS_gate} ] mlp$add_sender ALIAS 'mladds' (application_name:
    mlt$application_name;
    sender_name: mlt$application_name;
    VAR status: ost$status);
?? PUSH (LISTEXT := ON) ??
*copyc OST$STATUS
*copyc MLD$MEMORY_LINK_DECLARATIONS
?? POP ??

  PROCEDURE [XREF {TS_gate} ] mlp$confirm_send ALIAS 'mlconf'
    (application_name: mlt$application_name;
    destination_name: mlt$application_name;
    VAR status: ost$status);

  PROCEDURE [XREF {TS_gate} ] mlp$delete_sender ALIAS 'mldels'
    (application_name: mlt$application_name;
    sender_name: mlt$application_name;
    VAR status: ost$status);

  PROCEDURE [XREF {TS_gate} ] mlp$fetch_receive_list ALIAS 'mlferl'
    (application_name: mlt$application_name;
    sender_name: mlt$application_name;
    VAR receive_list: mlt$receive_list;
    VAR receive_count: mlt$receive_count;
    VAR status: ost$status);

  PROCEDURE [XREF {TS_gate} ] mlp$receive_message ALIAS 'mlrecm'
    (application_name: mlt$application_name;
    VAR arbitrary_info: mlt$arbitrary_info;
    signal: mlt$signal;
    message_area: mlt$message_ptr;
    VAR message_length: mlt$message_length;
    message_area_length: mlt$message_length;
    receive_index: mlt$receive_index;
    VAR sender_name: mlt$application_name;
    VAR status: ost$status);

  PROCEDURE [XREF {TS_gate} ] mlp$send_message ALIAS 'mlsendm'
    (application_name: mlt$application_name;
    arbitrary_info: mlt$arbitrary_info;
    signal: mlt$signal;
    message_area: mlt$message_ptr;
    message_length: mlt$message_length;
    destination_name: mlt$application_name;
    VAR status: ost$status);

  PROCEDURE [XREF {TS_gate} ] mlp$sign_off ALIAS 'mlsinof' (application_name:
    mlt$application_name;
    VAR status: ost$status);

  PROCEDURE [XREF {TS_gate} ] mlp$sign_on ALIAS 'mlsinon' (application_name:
    mlt$application_name;
    max_messages: mlt$max_messages;
    VAR unique_application_name: mlt$application_name;
    VAR status: ost$status);

  PROCEDURE [XREF] mmove (from,
        dest: ^cell;
        length: integer);

  PROCEDURE [XREF] getword (address: integer;
        word: ^cell);
?? POP ??
*copyc iit$application_names_messages
? IF ifv$nos_be = true THEN

  PROCEDURE [XREF] pause (time : integer);
?? SET(LIST:=OFF) ??
? ELSE
*copyc net#on
? IFEND
?? SET(LIST:=ON) ??

  TYPE
    iit$connection_states = (absentee_read, wait_connection, break_active,
      broken_connection, stopped, available_for_use, connection_ending,
      connection_hold, wait_init, shutdown_complete, terminate),
    iit$connection_state = set of iit$connection_states,
    iit$connection_currency = record
      connection_state: iit$connection_state,
      application_name_jm: mlt$application_name,
      front_queued_sm_ptr,
      back_queued_sm_ptr: ^iit$sm_queue,
      front_queued_data_ptr,
      back_queued_data_ptr: ^iit$data_queue,
    ? IF ifv$nos_be = false THEN
      unacknowledged_block_count: integer,
    ? IFEND
      block_number: iit$application_block_number,
    ? IF ifv$nos_be = false THEN
      application_block_limit: iit$application_block_limit,
    ? IFEND
      application_name_last_io: mlt$application_name,
      connection_end_pending: boolean,
    ? IF ifv$nos_be = true THEN
      ind_synch,
      ind_req_1qp : integer,
      connection_ext : tint$connection_ext,
      fet_6 : tint$fet_6,
      req_1qp : tint$req_1qp,
      synch_msg : tint$synch_msg,
      term_char : tint$term_char,
    ? IFEND
    recend,
    iit$sm_queue = record
      front,
      back: ^iit$sm_queue,
      application_name: mlt$application_name,
      msg: array [ * ] of iit$170_word,
    recend,
    iit$data_queue = record
      front,
      back: ^iit$data_queue,
      application_name: mlt$application_name,
      msg: array [ * ] of iit$170_word,
    recend,
    iit$mli_status = set of mlt$status,
    iit$ra_word_0 = packed record
      fill1: 0 .. 0ffffffffff(16),
      fill2: 0 .. 01f(16),
      cfo,
      idledown,
      pause,
      sw6,
      sw5,
      sw4,
      sw3,
      sw2,
      sw1: boolean,
      fill3: 0 .. 03f(16),
    recend,
    iit$passon_failure = (signon_failed, addspl_failed, waiting_exec,
      netdbg_failed, netstc_failed, downline_failure, arbinfo_failure,
      expected_sm, conend_failure, conreq1_failure, init_failure, shutdown,
      input_sm, okee_dokee, queued_sm_send, sm_send, no_space,
      queued_data_send, data_send, reject_failure, accept_failure,
      nosve_stop_interactive, bad_downline_sm, not_exec_neton, data_ibu,
    ? IF ifv$nos_be = true THEN
      char_type_failed, init_req_failed, break_req_failed,
      termin_failed, synch_sm_failed, term_class_failed,
    ? IFEND
      sm_ibu, exec_dead, error_logical);

  VAR
  ? IF ifv$nos_be = false THEN
    mlv$mli: [XREF] integer,
  ? IFEND
    abort_poll: boolean,
    receive_index: mlt$receive_index,
    receive_list: mlt$receive_list,
    receive_count: mlt$receive_count,
    all_shutdown: boolean,
    connection_number: iit$application_connection_num,
    cs: iit$connection_state,
    msg_displayed: boolean := FALSE,
    work_done: boolean,
    status: ost$status, {*** special defn of c170 code ***}
    mli_retry_status: iit$mli_status := $iit$mli_status [mlc$busy_interlock,
      mlc$pool_buffer_not_avail, mlc$prior_msg_not_received,
      mlc$receive_list_full, mlc$receive_list_index_invalid],
    mli_ignore_status: iit$mli_status := $iit$mli_status
      [mlc$dup_permits_ignored, mlc$msgs_from_sender_queued, mlc$ok,
      mlc$queued_msgs_lost, mlc$signal_failed_ignored,
      mlc$signal_to_c170_ignored],
    mli_fatal_status: iit$mli_status := $iit$mli_status [mlc$ant_full,
      mlc$bad_c170_parameter, mlc$c170_c170_illegal, mlc$illegal_function,
      mlc$max_msgs_too_large, mlc$max_signons_this_appl,
      mlc$max_signons_this_task, mlc$message_too_long, mlc$mli_internal_error,
      mlc$nosve_not_up, mlc$permit_list_full, mlc$receiver_name_syntax_error,
      mlc$sender_name_syntax_error, mlc$system_name_no_match,
      mlc$message_truncated, mlc$receiver_not_signed_on,
      mlc$sender_not_permitted, mlc$sender_not_signed_on],
    abort: iit$passon_failure := okee_dokee,
    length_returned: mlt$message_length,
    retry_count: INTEGER,
    nosve_application: mlt$application_name,
    msg: iit$general_message,
    nam_debug,
    passon_debug,
    mli_debug: boolean,
    check_operator: integer := 0,
    ra_word_0: iit$ra_word_0,
    comm_word: packed array [1 .. 60] of boolean,
    i,
    j: integer,
    signal_record: mlt$signal_record := [0, * , * ],
    signal: mlt$signal := ^signal_record,
    signal_180: mlt$signal,
    unique: mlt$application_name,
    arbinfo: mlt$arbitrary_info,
    posm: ^iit$output_supervisory_message,
    nam_application_name: iit$nam_application_name := [22, 5, 9, 1, 6, REP 5 of
      45],
    nam_status: integer,
    next_queued_sm_acn,
    next_queued_data_acn: integer := 0,
    queued_data_count,
    queued_sm_count: integer := 0,
    connection_currency: array [0 .. iic$passon_max_cn] of
      iit$connection_currency := [REP iic$passon_max_cn + 1 of
      [$iit$connection_state [available_for_use], mlc$null_name, NIL, NIL, NIL,
    ? IF ifv$nos_be = false THEN
      NIL, 0, 0, 0, mlc$null_name, FALSE]],
    ? ELSE
      NIL, 0, mlc$null_name, FALSE,
      0, 0, $tint$connection_ext[], [0,0,0,0,0,FALSE,FALSE,FALSE,FALSE,0],
      [REP 15 OF 0], [REP 10 OF 0], [0,0,0,0,0] ]],
    ? IFEND
    pacer_kludge_enabled: [XDCL] boolean := FALSE,
    hex_digits: string (16) := '0123456789ABCDEF';

  CONST
    iic$retry_count = 3,
    retry_limit = 60,
    ?IF ifv$module_for_c180 = TRUE THEN
      iic$mli_multiplier = 8,
    ?ELSE
      iic$mli_multiplier = 1,
    ?IFEND
    sm_available = 5,
    b_display = 2,
    terminate_if_abnormal = FALSE,
    job_dayfile = 3,
    iic$exec_acn = 0,
    long_pause = 42,
    short_pause = 5,
    iic$passon_max_cn = 400,
    data_available = 4;

  PROCEDURE [XREF] initmli (i: integer);
? IF ifv$nos_be = false THEN
?? SET(LIST:=OFF) ??
?  ELSE
?? NEWTITLE := '    Definitions for NOS/BE PASSON' ??
?? EJECT ??
CONST

{ status codes reported from 1QP }

  cint$termin_zro = 0,   { empty line
  cint$termin_loc = 1,   { autologout
  cint$termin_brk = 2,   { user break
  cint$termin_nuc = 3,   { new user
  cint$termin_ico = 5,   { input available
  cint$termin_oco = 6,   { output complete
  cint$termin_dis = 7,   { user back from disconnect

{ request codes for 1QP }

  cint$termout_brk = 2,  { confirm break
  cint$termout_nuc = 3,  { detach from muj
  cint$termout_ico = 5,  { request input
  cint$termout_oco = 6,  { wait output complete
  cint$termout_trm = 10, { request terminal characteristics

{ length of 1QP communication tables

  cint$out_length = iic$passon_max_cn,
  cint$in_length = cint$out_length+15,

{ message types for simulated synchronous upline sm's }

  cint$ssm_bi_mark_r = 1,
  cint$ssm_ctrl_char_n = 2,
  cint$ssm_ctrl_tcd_r = 3,

{ fraktions of sm_term_char_definitions }

  cint$frk1 = (iic$sm_term_char_definitions DIV 4096),
  cint$frk2 = ((iic$sm_term_char_definitions-4096*cint$frk1) DIV 256),
  cint$frk3 = ((iic$sm_term_char_definitions-4096*cint$frk1
              -256*cint$frk2) DIV 16),
  cint$frk4 = iic$sm_term_char_definitions-4096*cint$frk1
              -256*cint$frk2-16*cint$frk3;

TYPE

{ type of table elements }

  tint$user_id = 0 .. 0fff(16),
  tint$user_table_address = 0 .. 3ffff(16),
  tint$input_status = 0 .. 0fff(16),
  tint$output_request = 0 .. 0f(16),

{ 1QP communication tables TERMIN and TERMOUT }

  tint$com_tables = PACKED RECORD
    fill : 0 .. 0fffffffff(16),
    out_length : 0 .. 0fff(16),
    in_length : 0 .. 0fff(16),
    in_table : ARRAY[1..cint$in_length] OF tint$in_table,
    out_table : ARRAY[1..cint$out_length] OF tint$out_table,
  RECEND,

  tint$in_table = PACKED RECORD
    user_id : tint$user_id,
    fill : 0 .. 3ffff(16),
    user_table_address : tint$user_table_address,
    status : tint$input_status,
  RECEND,

  tint$out_table = PACKED RECORD
    user_id : tint$user_id,
    fill1 : 0 .. 3ffff(16),
    add : 0 .. 3ffff(16),
    fill2 : 0 .. 0ff(16),
    request : tint$output_request,
  RECEND,

{ extensions to table connection currency }

  tint$connection_exts = (autologout,connection_rejected,detached,detach_pend,
    force_parity,init_accept,init_req,input_available,input_req,input_suppress,
    input_trans,new_user,output_suppress,output_wait,term_char_req,user_break,
    user_break_akn,user_break_out,user_break_as,user_break_rel,user_break_sy,
    wait_int,idle_ind,shut_ind,trans_break),
  tint$connection_ext = SET OF tint$connection_exts,

  tint$fet_6 = PACKED RECORD
    user_id : tint$user_id,
    in_byte : 0 .. 3f(16),
    out_byte : 0 .. 3f(16),
    fill2 : 0 .. 0fff(16),
    char_code : 0 .. 3(16),
    unit_sep,
    format_effector,
    one_line,
    par_force : BOOLEAN,
    user_table_address : tint$user_table_address,
  RECEND,

  tint$req_1qp = PACKED ARRAY[1..15] OF 0 .. 0f(16),
  tint$synch_msg = PACKED ARRAY[1..10] OF 0 .. 3f(16),

  tint$term_char = PACKED RECORD
    page_length,
    page_width,
    page_wait,
    paper_mode,
    term_class : 0 .. 0fff(16),
  RECEND,

{ predefined upline supervisory messages }

  tint$con_req_r = RECORD                  { CON/REQ/R }
    header : iit$input_supervisory_header,
    data : tint$text_con_req_r,
    logname : tint$nve_user,
    b1,b2,b3,b4 : integer,
  RECEND,

  { tint$logfam is defined as 10 6 bit elements, only the left most 7  }
  { elements are used for the family name.  10 elements are defined to }
  { insure proper word alignment when this definition is aligned.      }
  tint$logfam = PACKED ARRAY[1..10] OF 0 .. 3f(16),

  tint$text_con_req_r = PACKED RECORD
    sm_typ : iit$supervisory_message_type,
    fill1 : 0 .. 0ff(16),
    acn : iit$application_connection_num,
    abl : 0 .. 7(16),
    fill2 : 0 .. 1fffff(16),
    tname : tint$logfam,
    a1,a2 : integer,
    logfam : aligned tint$logfam,
  RECEND,

  tint$predef_sm = PACKED RECORD
    header : iit$input_supervisory_header,
    data : tint$predef_sm_text,
  RECEND,

  tint$predef_sm_text = PACKED RECORD
    sm_typ : iit$supervisory_message_type,
    rc : 0 .. 0ff(16),
    acn : iit$application_connection_num,
    fill : 0 .. 0ffffff(16),
  RECEND,

{ predefined messages }

  tint$predef_msg = PACKED RECORD        { message to user }
    header : iit$output_data_block_header,
    data : tint$meldung,
  RECEND,

  tint$debug_request = PACKED RECORD
    header : iit$output_data_block_header,
    data : tint$debug,
  RECEND,

  tint$record_request = PACKED RECORD
    header : iit$output_data_block_header,
    data : tint$record,
  RECEND,

  tint$accept_msg = PACKED RECORD
    header : iit$output_data_block_header,
    data : tint$accept,
  RECEND,

  tint$nosve_msg = PACKED RECORD
    header : iit$output_data_block_header,
    data : tint$nosve,
  RECEND,

  tint$word_8_of_12 = PACKED RECORD
    obn : 0 .. 0fffffffff(16),
    unt : 0 .. 0ffffff(16),
  RECEND,

  tint$trans_break = PACKED RECORD
    header : iit$input_data_block_header,
    data : tint$word_8_of_12,
  RECEND,

  tint$meldung = ARRAY[1..6] OF tint$word_8_of_12,
  tint$debug = ARRAY[1..27] OF tint$word_8_of_12,
  tint$record = ARRAY[1..8] OF tint$word_8_of_12,
  tint$accept = ARRAY[1..3] OF tint$word_8_of_12,
  tint$nosve = ARRAY[1..4] OF tint$word_8_of_12,

  tint$nve_user = PACKED RECORD
    id : 0..3ffffffffff(16),
    nr_prm : 0..3ffff(16),
  RECEND,

{ synchronous downline sm of type 2

  tint$synch_out_sm = PACKED RECORD
    header : iit$output_data_block_header,
    data : PACKED ARRAY[1..240] OF 0 .. 0f(16),
  RECEND,

{ synchronous upline sm of type 2

  tint$synch_in_sm = PACKED RECORD
    header : iit$input_supervisory_header,
    data : PACKED ARRAY[1..152] OF 0 .. 0f(16),
  RECEND,

{ input/output data block for intercom

  tint$data_block = ARRAY[1..iic$max_block_length_in_words]
                    OF tint$170_ascii_word,

  tint$170_ascii_word = PACKED RECORD
    byte : PACKED ARRAY[0..4] OF 0 .. 0fff(16),
  RECEND,

  tint$input_data_message = RECORD
    header : iit$input_data_block_header,
    data : tint$data_block,
  RECEND,

  tint$output_data_message = RECORD
    header : iit$output_data_block_header,
    data : tint$data_block,
  RECEND;

  VAR

    nr_msg : integer := -1,
    analyst_user_id : tint$user_id,
    analyst_acn : iit$application_connection_num := 0,
    analyst_ig,
    analyst_id : tint$nve_user,
    end_counter : integer := 50,
    nr_of_users : integer := 0,
    dump_indicator, trace_mli,
    shut_last, shut_down,
    idle_last, idle_down : boolean,
    predef_asm : ARRAY[1..5] OF tint$predef_sm :=
      [[[3,0,0,1,FALSE,0,1],[iic$sm_connection_broken,1,0,0]]      {CON/CB/R   }
      ,[[3,0,0,1,FALSE,0,1],[iic$sm_connection_ended,0,0,0]]       {CON/END/N  }
      ,[[3,0,0,1,FALSE,0,1],[iic$sm_initialized_connection,0,0,0]] {FC/INIT/R  }
      ,[[3,0,0,1,FALSE,0,1],[iic$sm_interrupt_user,3,0,0]]         {INTR/USR/R }
      ,[[3,0,0,1,FALSE,0,1],[iic$sm_shutdown,0,0,1]]               {SHUT/INSD/R}
      ],
    con_req_r : tint$con_req_r :=                                  {CON/REQ/R  }
      [[3,0,0,1,FALSE,0,10],[iic$sm_connection_request,0,0,1,0,
        [45,45,45,45,45,45,45,00,00,00],0,0,
        [45,45,45,45,45,45,45,00,00,00]],[0,0],0,0,0,0],
    predef_ssm : ARRAY[1..2] OF tint$predef_sm :=
      [[[3,0,0,2,FALSE,0,2],[iic$sm_break_indication_mark,0,0,0]]  {BI/MARK/R  }
      ,[[3,0,0,2,FALSE,0,2],[iic$sm_define_term_char_n,0,0,0]]     {CTRL/CHAR/N}
      ],
    ctrl_tcd_r : tint$synch_in_sm := [[3,0,0,2,FALSE,0,76],        {CTRL/TCD/R }
      [cint$frk1,cint$frk2,cint$frk3,cint$frk4,
       3,3,0,0,5,7,0,0,7,0,0,0,3,5,0,0,3,0,0,0,3,7,0,0,3,4,0,0,3,8,0,1,
       4,6,0,0,3,9,0,1,3,10,0,1,3,12,0,0,9,2,0,0,3,11,0,13,4,5,0,13,
       2,2,0,0,2,3,0,0,2,4,0,0,2,6,1,8,2,7,0,8,2,12,0,0,2,13,0,0,
       3,1,0,0,2,5,0,0,3,2,0,2,2,8,1,11,4,0,0,4,4,2,0,3,3,13,0,13,
       3,15,0,2,4,3,0,0,4,4,0,0,2,0,0,0,6,6,0,0,3,6,0,0,2,10,0,0,2,11,0,0]],
    predef_msg : ARRAY[1..6] OF tint$predef_msg :=
      [[[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,30],        {TOO MANY USERS...}
       [[006001240117(8),01170040(8)],[011501010116(8),01310040(8)],
        [012501230105(8),01220123(8)],[005400400124(8),01220131(8)],
        [004001140101(8),01240105(8)],[012200400040(8),00400037(8)]]]
      ,[[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,30],        {CONNECTION TO VEIAF...}
       [[006001030117(8),01160116(8)],[010501030124(8),01110117(8)],
        [011600400124(8),01170040(8)],[012601050111(8),01010106(8)],
        [004001220105(8),01120105(8)],[010301240105(8),01040037(8)]]]
      ,[[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,30],        {YOU ARE NOT VALID...}
       [[006001310117(8),01250040(8)],[010101220105(8),00400116(8)],
        [011701240040(8),01260101(8)],[011401110104(8),01010124(8)],
        [010501040040(8),01170116(8)],[004001260105(8),00400037(8)]]]
      ,[[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,30],        {NVE IDLES DOWN...}
       [[006001160126(8),01050040(8)],[011101040114(8),01050123(8)],
        [004001040117(8),01270116(8)],[005400400120(8),01140123(8)],
        [004001140117(8),01070117(8)],[012501240037(8),00400057(8)]]]
      ,[[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,30],        {NO ACCESS PERM...}
       [[006001160117(8),00400101(8)],[010301030105(8),01230123(8)],
        [004001200105(8),01220115(8)],[011101240124(8),01050104(8)],
        [004001010124(8),00400124(8)],[011101150105(8),00400037(8)]]]
      ,[[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,30],        {NVE SHUT DOWN ...}
       [[006001160126(8),01050040(8)],[012301100125(8),01240104(8)],
        [011701270116(8),00400116(8)],[011701270040(8),00410041(8)],
        [004100400040(8),00370040(8)],[003700400040(8),00400037(8)]]]
      ],
    debug_request : tint$debug_request :=
      [[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,133],        {DEBUG HELP WANTED ...}
      [[006001040105(8),01020125(8)],[010701100105(8),01140120(8)],
       [004001270101(8),01160124(8)],[010501040077(8),00370040(8)],
       [010501160124(8),01050122(8)],[004001230124(8),01220111(8)],
       [011601070040(8),01170106(8)],[004001040111(8),01070124(8)],
       [012300400061(8),00400124(8)],[011700400064(8),00400037(8)],
       [004000610040(8),01230101(8)],[012601050040(8),01150105(8)],
       [012301230101(8),01070105(8)],[012300370040(8),00620040(8)],
       [010401110123(8),01200114(8)],[010101310040(8),01150105(8)],
       [012301230101(8),01070105(8)],[004001240131(8),01200105(8)],
       [003700400063(8),00400104(8)],[011101230120(8),01140101(8)],
       [013100400115(8),01050115(8)],[011701220131(8),01140111(8)],
       [011601130037(8),00400064(8)],[004001040125(8),01150120(8)],
       [004001010124(8),00400105(8)],[012201220117(8),01220037(8)],
       [004000570037(8),00000000(8)]]],
    record_request : tint$record_request :=
      [[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,36],         {HOW MANY MESSAGES ...}
      [[006001100117(8),01270040(8)],[011501010116(8),01310040(8)],
       [011501050123(8),01230101(8)],[010701050123(8),00400104(8)],
       [011700400131(8),01170125(8)],[004001270101(8),01160124(8)],
       [004000770037(8),00400057(8)],[003700000000(8),00000000(8)]]],
    accept_msg : tint$accept_msg :=
      [[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,13],         {ACCEPTED             }
      [[004001010103(8),01030105(8)],[012001240105(8),01040037(8)],
       [004000570037(8),00000000(8)]]],
    nosve_msg : tint$nosve_msg :=
      [[2,0,1,3,0,FALSE,FALSE,FALSE,FALSE,17],         {NOSVE IS NOT UP      }
      [[004001160117(8),01230126(8)],[010500400111(8),01230040(8)],
       [011601170124(8),00400125(8)],[012000370000(8),00000000(8)]]],
    trans_break_msg : tint$trans_break :=
      [[2,0,1,3,FALSE,0,TRUE,FALSE,FALSE,5],           {user break           }
       [002000150000(8),00000000(8)]],
    class_table : ARRAY[0..31] OF integer :=
      [2,2,2,2,2,2,2,2,10,11,2,2,2,2,2,2,16,17,9,2,2,2,2,17,2,2,2,2,2,2,2,2],
    com : tint$com_tables := [0, cint$out_length, cint$in_length,
      [REP cint$in_length OF [0,0,0,0]], [REP cint$out_length OF [0,0,0,0,0]]];
?? OLDTITLE ??
?? NEWTITLE := '   COMPASS procedures for NOS/BE PASSON' ??
?? EJECT ??
PROCEDURE [XREF] ciord (fwa,ptr : ^CELL;    { call CIO to read from terminal }
                        VAR length : iit$text_length;
                        VAR error  : integer);

PROCEDURE [XREF] ciowr (fwa,ptr : ^CELL;    { call CIO to write to terminal }
                        length : integer;
                        VAR  error  : integer);

PROCEDURE [XREF] clfield (ptr : ^CELL;      { clear a field }
                          length : integer);

PROCEDURE [XREF] callmuj (ptr : ^CELL);     { call PP-program MUJ }

PROCEDURE [XREF] connct;                    { connect file ZZZZZSG to INTERCOM }

PROCEDURE [XREF] discon;                    { disconnect file ZZZZZSG from INTERCOM }

PROCEDURE [XREF] dumpen (i : integer;       { abort the program }
                         k : iit$passon_failure);

PROCEDURE [XREF] getveid (ptr : ^CELL;      { get NOSVE validation }
                          ptr : ^CELL;
                          us : tint$user_id;
                          VAR error : integer);

PROCEDURE [XREF] put1qp (                   { place 1qp-request into TERMOUT }
                         table,address : ^CELL;
                         cus : tint$user_id;
                         req : tint$output_request);

PROCEDURE [XREF] request (ordinal:integer); { request permanent file disk }

PROCEDURE [XREF] savemem (ordinal:integer;  { save variable-field for debugging
                          pt1,pt2,pt3 : ^CELL);

PROCEDURE [XREF] savemsg (ptr : ^CELL;      { save messages for debugging }
                          lng,dir : integer);

PROCEDURE [XREF] setup (ptr : ^CELL;        { get user-id of analyst }
                        VAR indicator : integer;
                        pt1,pt2,pt3 : ^CELL);
?? OLDTITLE ??
?? NEWTITLE := '    procedure analyst_action' ??
?? EJECT ??
PROCEDURE analyst_action (fwa : ^tint$input_data_message;
                          VAR ind : integer);
  VAR
    file_nr,
    lng,
    byte,
    n1,n2,n3,
    i,k : integer;

  ind := 0;
  lng := fwa^.header.text_length;
  IF lng < 9 THEN
     RETURN;
  IFEND;
  FOR i := 0 TO 4 DO
    IF fwa^.data[1].byte[i] <> 44(8) THEN
       RETURN;
    IFEND;
  FOREND;
  IF fwa^.data[2].byte[0] <> 054(8) THEN
     RETURN;
  IFEND;
  n1 := fwa^.data[2].byte[1] MOD 200(8);
  IF n1 > 140(8) THEN
     n1 := n1 - 40(8);
  IFEND;
  n2 := fwa^.data[2].byte[2] MOD 200(8);
  IF n2 > 140(8) THEN
     n2 := n2 - 40(8);
  IFEND;
  n3 := fwa^.data[2].byte[3] MOD 200(8);
  IF n3 > 140(8) THEN
     n3 := n3 - 40(8);
  IFEND;
  IF n1 = 104(8) THEN
     IF n2 = 115(8) THEN
        IF n3 = 120(8) THEN
           IF lng < 11 THEN
              RETURN;
           IFEND;
           IF fwa^.data[2].byte[4] = 054(8) THEN
              byte := fwa^.data[3].byte[0] - 60(8);
              IF (byte < 0) OR (byte > 9) THEN
                 RETURN;
              ELSE
                 ind := 1;
                 IF byte = 0 THEN
                    IF nam_debug AND (nr_msg >= 0) THEN
                       savemsg (#LOC(msg),-1,0);
                       nr_msg := -1;
                       nam_debug := false;
                    ELSE
                       RETURN;
                    IFEND;
                 ELSE
                    file_nr := byte + 33(8);
                    request (file_nr);
                    savemem (file_nr,#LOC(msg),
                             #LOC(connection_currency[0]),#LOC(com));
                 IFEND;
              IFEND;
           IFEND;
        IFEND;
     IFEND;
  IFEND;
  IF n1 = 115(8) THEN
     IF n2 = 123(8) THEN
        IF n3 = 107(8) THEN
           ind := 1;
           IF (NOT nam_debug) AND (nr_msg < 0) THEN
              nam_debug := true;
              nr_msg := 2000;
           IFEND;
        IFEND;
     IFEND;
  IFEND;
  IF ind = 1 THEN
     send_data (analyst_acn,#LOC(accept_msg));
     downline_sm (analyst_acn,cint$termout_ico);
  IFEND;
PROCEND analyst_action;
?? OLDTITLE ??
?? NEWTITLE := '    procedure connection_tour' ??
?? EJECT ??
{  The purpose of this procedure is to check and update the states of the
{    connections as described by the sets connection_state and connection_
{    _ext of table connection_currency. If required the procedure forms
{    and sends upline supervisory messages to IF. Downline supervisory mes=
{    sages are replaced by 1QP-requests, which are put into the 1QP-queue,
{    which is also updated by connection_tour.
{
PROCEDURE connection_tour;

  VAR

    connection_ext : tint$connection_ext,
    itr : ^integer,
    ptr : ^tint$term_char,
    qtr : ^tint$out_table,
    acn : iit$application_connection_num,
    request : tint$output_request,
    output_user_id,
    connect_user_id : tint$user_id,
    connect_user_table : tint$user_table_address,
    ind,
    error,
    lng,
    ind_synch,
    req_1qp,
    i,k : integer;

  acn := 0;
  /check_connection_currency/
  FOR i := 1 TO iic$passon_max_cn DO
    acn := acn + 1;
    connect_user_id := connection_currency[i].fet_6.user_id;
    /check_user_id_zero/
    BEGIN
    IF connect_user_id <> 0 THEN
       connect_user_table := connection_currency[i].fet_6.user_table_address;
{
{      check for queued 1QP-requests
{
       req_1qp := connection_currency[i].ind_req_1qp;
       output_user_id := com.out_table[i].user_id;
       IF (output_user_id = 0) AND (req_1qp <> 0) THEN
          request := connection_currency[i].req_1qp[1];
          ptr := ^connection_currency[i].term_char;
          qtr := ^com.out_table[i];
          put1qp (qtr,ptr,connect_user_id,request);
          IF request = cint$termout_nuc THEN
             connection_currency[i].connection_ext :=
                        connection_currency[i].connection_ext
                      + $tint$connection_ext[detached];
          ELSEIF request = cint$termout_brk THEN
             connection_currency[i].connection_ext :=
                        connection_currency[i].connection_ext
                      + $tint$connection_ext[user_break_rel];
          IFEND;
          /pop_up_req_1qp/
          FOR k := 1 TO req_1qp-1 DO
            connection_currency[i].req_1qp[k] :=
                       connection_currency[i].req_1qp[k+1];
          FOREND /pop_up_req_1qp/;
          connection_currency[i].req_1qp[req_1qp] := 0;
          connection_currency[i].ind_req_1qp := req_1qp - 1;
       IFEND;
       connection_ext := connection_currency[i].connection_ext;
?? NEWTITLE := '    process user break' ??
?? EJECT ??
{
{  check break aknowledge accepted by intercom
{
IF ((user_break_rel IN connection_ext)
   AND NOT (trans_break IN connection_ext)) THEN
   output_user_id := com.out_table[i].user_id;
   IF output_user_id = 0 THEN
      connection_currency[i].connection_ext :=
                 connection_currency[i].connection_ext
               - $tint$connection_ext[user_break_rel,input_available,
                 user_break_out,input_req,input_suppress,output_suppress];
      connection_ext := connection_currency[i].connection_ext;
   ELSE
      CYCLE /check_connection_currency/;
   IFEND;
IFEND;
{
{  check for user break
{
IF user_break IN connection_ext THEN
   predef_asm[4].data.acn := acn;
   modify_upline_connection_status (#LOC(predef_asm[4]),abort); {INTR/USR/R}
   IF abort <> okee_dokee THEN
      set_passon_abnormal (abort);
      IF abort <> okee_dokee THEN
         RETURN;
      IFEND;
   IFEND;
   connection_currency[i].connection_ext := connection_ext
            - $tint$connection_ext[user_break]
            + $tint$connection_ext[user_break_as,user_break_sy];
   ind_synch := connection_currency[i].ind_synch + 1;
   connection_currency[i].synch_msg[ind_synch] := cint$ssm_bi_mark_r;
   connection_currency[acn].ind_synch := ind_synch;
   CYCLE /check_connection_currency/;
IFEND;
{
{  check break aknowledge accepted by NOSVE
{
IF (user_break_akn IN connection_ext) AND
   (user_break_out IN connection_ext) THEN
   connection_currency[i].connection_ext := connection_ext
            - $tint$connection_ext[user_break_akn];
   downline_sm (acn,cint$termout_brk);
   CYCLE /check_connection_currency/;
IFEND;
?? OLDTITLE ??
?? NEWTITLE := '    process request for new user and term characteristics' ??
?? EJECT ??
{
{  check for new user
{
IF new_user IN connection_ext THEN
   nr_of_users := nr_of_users + 1;
   IF (i = iic$passon_max_cn) OR idle_down THEN
      k := 1;
      IF idle_down THEN k := 5; IFEND;
      predef_msg[k].header.connection_number := acn;
      send_data (acn,#LOC(predef_msg[k]));
      connection_currency[i].connection_ext :=
                 $tint$connection_ext[detach_pend];
   ELSE
      connection_currency[i].connection_ext := connection_ext
               - $tint$connection_ext[new_user]
               + $tint$connection_ext[term_char_req];
      connection_currency[i].term_char.term_class := 0;
      downline_sm (acn,cint$termout_trm);
      end_counter := 50;
      CYCLE /check_connection_currency/;
   IFEND;
IFEND;
{
{  request connection
{
IF term_char_req IN connection_ext THEN
   IF connection_currency[i].term_char.term_class <> 0 THEN
      getveid (#LOC(con_req_r.logname),#LOC(con_req_r.data.logfam),
               connect_user_id,error);
      IF error <> 0 THEN
         IF error = 1 THEN
            predef_msg[3].header.connection_number := acn;
            send_data (acn,#LOC(predef_msg[3]));
            connection_currency[i].connection_ext := connection_ext
                     - $tint$connection_ext[term_char_req]
                     + $tint$connection_ext[detach_pend];
         IFEND;
         CYCLE /check_connection_currency/;
      IFEND;
      connection_currency[i].connection_ext := connection_ext
               - $tint$connection_ext[term_char_req];
      con_req_r.data.acn := acn;
      modify_upline_connection_status (#LOC(con_req_r),abort);   { CON/REQ/R }
      IF abort <> okee_dokee THEN
         set_passon_abnormal (abort);
         IF abort <> okee_dokee THEN
            RETURN;
         IFEND;
      IFEND;
      IF (con_req_r.logname.id=analyst_id.id) AND (analyst_acn=0) THEN
         analyst_acn := i;
         analyst_user_id := connection_currency[i].fet_6.user_id;
         accept_msg.header.connection_number := acn;
      IFEND;
   IFEND;
   CYCLE /check_connection_currency/;
IFEND;
?? OLDTITLE ??
?? NEWTITLE := '    process connection accepted and initialized' ??
?? EJECT ??
{
{  check connection accepted
{
IF wait_int IN connection_ext THEN
   predef_asm[3].data.acn := acn;      { FC/INIT/R }
   modify_upline_connection_status (#LOC(predef_asm[3]),abort);
   IF abort <> okee_dokee THEN
      set_passon_abnormal (abort);
      IF abort <> okee_dokee THEN
         RETURN;
      IFEND;
   IFEND;
   connection_currency[i].connection_ext := connection_ext
            - $tint$connection_ext[wait_int]
            + $tint$connection_ext[init_req];
   CYCLE /check_connection_currency/;
IFEND;
{
{  check connection initialized
{
IF init_accept IN connection_ext THEN
   connection_currency[i].connection_ext := $tint$connection_ext[];
   downline_sm (acn,cint$termout_ico);
   CYCLE /check_connection_currency/;
IFEND;
?? OLDTITLE ??
?? NEWTITLE := '    process idle down and shut down' ??
?? EJECT ??
{
{  check for idle down
{
IF idle_last AND (idle_ind IN connection_ext) THEN
   IF connection_ext*$tint$connection_ext[new_user,output_suppress,
      detached,detach_pend,connection_rejected] = $tint$connection_ext[] THEN
      predef_msg[4].header.connection_number := acn;
      send_data (acn,#LOC(predef_msg[4]));
      connection_currency[i].connection_ext := connection_ext
               - $tint$connection_ext[idle_ind];
      CYCLE /check_connection_currency/;
   IFEND;
IFEND;
{
{  check for shut down
{
IF shut_last AND (shut_ind IN connection_ext) THEN
   req_1qp := connection_currency[i].ind_req_1qp;
   IF (connection_ext*$tint$connection_ext[new_user,output_suppress,idle_ind,
      detached,detach_pend,connection_rejected] = $tint$connection_ext[])
                                                        AND (req_1qp = 0) THEN
      predef_msg[4].header.connection_number := acn;
      send_data (acn,#LOC(predef_msg[6]));
      connection_currency[i].connection_ext := $tint$connection_ext[];
      predef_asm[1].data.acn := acn;
      modify_upline_connection_status (#LOC(predef_asm[1]),abort);  {CON/CB/R}
      CYCLE /check_connection_currency/;
   IFEND;
IFEND;
?? OLDTITLE ??
?? NEWTITLE := '    process detach, detach pending and autologout' ??
?? EJECT ??
{
{  check detach pending
{
IF detach_pend IN connection_ext THEN
   connection_currency[i].connection_ext := connection_ext
            - $tint$connection_ext[detach_pend];
   downline_sm (acn,cint$termout_nuc);
   connection_ext := connection_currency[acn].connection_ext;
IFEND;
{
{  check user detached
{
output_user_id := com.out_table[i].user_id;
IF (detached IN connection_ext) AND (output_user_id = 0) THEN
   IF connection_currency[i].ind_req_1qp = 0 THEN
      nr_of_users := nr_of_users - 1;
      clfield (#LOC(connection_currency[i].block_number),10);
      connection_currency[i].connection_state :=
                 $iit$connection_state[available_for_use];
   IFEND;
   CYCLE /check_connection_currency/;
IFEND;
{
{  check autologout
{
IF autologout IN connection_ext THEN
   req_1qp := connection_currency[i].ind_req_1qp;
   IF req_1qp <> 0 THEN
      FOR k := 1 TO req_1qp DO
         connection_currency[i].req_1qp[k] := 0;
      FOREND;
      connection_currency[i].ind_req_1qp := 0;
   IFEND;
   connection_currency[i].connection_ext := $tint$connection_ext[];
   predef_asm[1].data.acn := acn;
   modify_upline_connection_status (#LOC(predef_asm[1]),abort);     {CON/CB/R}
   IF abort <> okee_dokee THEN
      set_passon_abnormal (abort);
      IF abort <> okee_dokee THEN
         RETURN;
      IFEND;
   IFEND;
   CYCLE /check_connection_currency/;
IFEND;
?? OLDTITLE ??
?? NEWTITLE := '    process connection end and reject' ??
?? EJECT ??
{
{  check connection end
{
IF connection_ending IN connection_currency[i].connection_state THEN
   IF connection_currency[i].ind_req_1qp = 0 THEN
      nr_of_users := nr_of_users - 1;
      downline_sm (acn,cint$termout_nuc);
      clfield (#LOC(connection_currency[i].block_number),10);
   ELSE
      connection_currency[i].connection_ext := connection_ext
               + $tint$connection_ext[detach_pend];
   IFEND;
   predef_asm[2].data.acn := acn;
   modify_upline_connection_status (#LOC(predef_asm[2]),abort);  { CON/END/N }
   IF abort <> okee_dokee THEN
      set_passon_abnormal (abort);
      IF abort <> okee_dokee THEN
         RETURN;
      IFEND;
   IFEND;
   CYCLE /check_connection_currency/;
IFEND;
{
{  check connection rejected
{
IF connection_rejected IN connection_ext THEN
   predef_msg[2].header.connection_number := acn;
   send_data (acn,#LOC(predef_msg[2]));
   connection_currency[i].connection_ext := connection_ext
            - $tint$connection_ext[connection_rejected]
            + $tint$connection_ext[detach_pend];
   CYCLE /check_connection_currency/;
IFEND;
?? OLDTITLE ??
?? NEWTITLE := '    process absentee reads' ??
?? EJECT ??
       IF (absentee_read IN connection_currency[i].connection_state) AND
          NOT (input_suppress IN connection_ext) THEN
          ind_synch := connection_currency[acn].ind_synch;
          IF ind_synch <> 0 THEN
             synch_upline_sm (#LOC(msg),acn,lng);
             send_upline_data (#LOC(msg),lng,acn,nosve_application,abort);
          ELSE
             IF trans_break IN connection_ext THEN
                output_user_id := com.out_table[i].user_id;
                IF (output_user_id = 0) AND
                   (user_break_rel IN connection_ext) THEN
                   trans_break_msg.header.connection_number := acn;
                   mmove (#LOC(trans_break_msg),#LOC(msg),2);
                   poll_for_absentee_reads (#LOC(msg),abort);
                   connection_currency[i].connection_ext := connection_ext
                             -$tint$connection_ext[user_break_rel,trans_break,
                                                   input_available,input_req];
                ELSE
                   CYCLE /check_connection_currency/;
                IFEND;
             ELSEIF input_available IN connection_ext THEN
                read_data (acn,#LOC(msg));
                connection_currency[i].connection_ext := connection_ext
                         - $tint$connection_ext[input_available];
                IF acn = analyst_acn THEN
                   analyst_action (#LOC(msg),ind);
                   IF ind = 1 THEN
                      CYCLE /check_connection_currency/;
                   IFEND;
                IFEND;
                poll_for_absentee_reads (#LOC(msg),abort);
             ELSE
                CYCLE /check_connection_currency/;
             IFEND;
          IFEND;
          IF abort <> okee_dokee THEN
             set_passon_abnormal (abort);
             IF abort <> okee_dokee THEN
                RETURN;
             IFEND;
          IFEND;
       IFEND;
    IFEND;
    END /check_user_id_zero/;
  FOREND /check_connection_currency/;
PROCEND connection_tour;
?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := '    procedure downline_sm' ??
?? EJECT ??
{  The purpose of this procedure is to set up and put a 1QP-request into table
{    TERMOUT or to queue the request in array req_1qp of connection_currency
{    if the related slot in TERMOUT is not zero. Related pointers are updated.
{
PROCEDURE downline_sm (acn : iit$application_connection_num;
                       output_request : tint$output_request);
  VAR
    request : tint$output_request,
    con_user_id,
    tab_user_id : tint$user_id,
    ptr : ^tint$term_char,
    qtr : ^tint$out_table,
    parm_put : boolean,
    i,req : integer;

  IF output_request = cint$termout_ico THEN
     IF input_req IN connection_currency[acn].connection_ext THEN
        RETURN;
     ELSE
        connection_currency[acn].connection_ext :=
                   connection_currency[acn].connection_ext
                 + $tint$connection_ext[input_req];
     IFEND;
  IFEND;
  tab_user_id := com.out_table[acn].user_id;
  parm_put := false;
  IF tab_user_id = 0 THEN
     req := connection_currency[acn].ind_req_1qp;
     con_user_id := connection_currency[acn].fet_6.user_id;
     qtr := ^com.out_table[acn];
     ptr := ^connection_currency[acn].term_char;
     IF req <> 0 THEN
        request := connection_currency[acn].req_1qp[1];
        /pop_1qp_requests/
        FOR i := 1 TO req-1 DO
            connection_currency[acn].req_1qp[i] :=
                       connection_currency[acn].req_1qp[i+1];
        FOREND /pop_1qp_requests/;
        connection_currency[acn].req_1qp[req] := 0;
        connection_currency[acn].ind_req_1qp := req - 1;
     ELSE
        parm_put := true;
        request := output_request;
     IFEND;
     put1qp (qtr,ptr,con_user_id,request);
     IF request = cint$termout_brk THEN
        connection_currency[acn].connection_ext :=
                   connection_currency[acn].connection_ext
                 + $tint$connection_ext[user_break_rel];
     ELSEIF request = cint$termout_nuc THEN
        connection_currency[acn].connection_ext :=
                   connection_currency[acn].connection_ext
                 + $tint$connection_ext[detached];
     IFEND;
  IFEND;
  IF NOT parm_put THEN
     req := connection_currency[acn].ind_req_1qp + 1;
     IF req = 16 THEN
        RETURN;
     ELSE
        connection_currency[acn].req_1qp[req] := output_request;
     IFEND;
     connection_currency[acn].ind_req_1qp := req;
  IFEND;
  RETURN;
PROCEND downline_sm;
?? OLDTITLE ??
?? NEWTITLE := '    procedure dump_mem' ??
?? EJECT ??
{  The purpose of this procedure is to close a existing trace file and
{    to generate a mode 0 error, which abort PASSON and causes the system
{    to produce a dump of the memory.
{
PROCEDURE dump_mem (nn : integer; ab : iit$passon_failure);

  IF nam_debug AND (nr_msg>0) THEN
     savemsg (#LOC(msg),-1,0);
     nr_msg := -100;
  IFEND;
  dumpen (nn,ab);
PROCEND dump_mem;
?? OLDTITLE ??
?? NEWTITLE := '    procedure get_debug_directives' ??
?? EJECT ??
{  The purpose of this procedure is to receive debug directives from the
{    systems analyst via terminal type-ins
{
PROCEDURE get_debug_directives (fwa : ^tint$input_data_message);

  VAR
    byte,
    i,k,lng : integer,
    error : integer,
    acn : iit$application_connection_num,
    get_user_id : tint$user_id,
    user_table : tint$user_table_address;

  acn := 1;
  nr_msg := -2;
  ra_word_0.sw1 := false;
  ra_word_0.sw2 := false;
  ra_word_0.sw3 := false;
  ra_word_0.sw4 := false;
  ra_word_0.sw5 := false;
  ra_word_0.sw6 := false;

  /search_site_analyst/
  BEGIN
  FOR k := 1 TO 20 DO
    FOR i := 1 TO cint$in_length DO
      get_user_id := com.in_table[i].user_id;
      IF get_user_id <> 0 THEN
         user_table := com.in_table[i].user_table_address;
         EXIT /search_site_analyst/;
      IFEND;
    FOREND;
    pause (long_pause);
  FOREND;
  RETURN;
  END /search_site_analyst/;

  error := -1;
  WHILE error < 0 DO
    getveid (#LOC(analyst_ig),#LOC(con_req_r.data.logfam),get_user_id,error);
    pause (short_pause);
  WHILEND;
  IF (error=0) AND (analyst_ig.id=analyst_id.id) THEN
     connection_currency[acn].fet_6.user_id := get_user_id;
     connection_currency[acn].fet_6.user_table_address := user_table;
     get_debug_data (acn,#LOC(debug_request),fwa,lng);
     IF lng = 0 THEN
        RETURN;
     ELSE
        lng := lng - 1;
        IF lng > 3 THEN
           lng := 3;
        IFEND;
        FOR i := 0 TO lng DO
          byte := fwa^.data[1].byte[i];
          IF byte = 61(8) THEN
             ra_word_0.sw1 := true;
          ELSEIF byte = 62(8) THEN
             ra_word_0.sw2 := true;
          ELSEIF byte = 63(8) THEN
             ra_word_0.sw3 := true;
          ELSEIF byte = 64(8) THEN
             ra_word_0.sw4 := true;
          IFEND;
        FOREND;
     IFEND;
  ELSE
     RETURN;
  IFEND;
  IF ra_word_0.sw1 THEN
     get_debug_data (acn,#LOC(record_request),fwa,lng);
     /get_nr_msg/
     BEGIN
       IF lng = 0 THEN
          nr_msg := 1000;
          EXIT /get_nr_msg/;
       ELSE
          nr_msg := 0;
          lng := lng - 1;
          IF lng > 4 THEN
             lng := 4;
          IFEND;
       IFEND;
       FOR i := 0 TO lng DO
         byte := fwa^.data[1].byte[i] - 60(8);
         IF (byte>=0) AND (byte<10) THEN
            nr_msg := 10*nr_msg + byte;
         IFEND;
       FOREND;
       IF nr_msg = 0 THEN
          nr_msg := 1000;
       IFEND;
     END /get_nr_msg/;
     request (33(8));
  IFEND;
  connection_currency[acn].fet_6.user_id := 0;
  connection_currency[acn].fet_6.user_table_address := 0;
PROCEND get_debug_directives;
?? OLDTITLE ??
?? NEWTITLE := '    procedure get_debug_data' ??
?? EJECT ??
PROCEDURE get_debug_data (acn :  iit$application_connection_num;
                          msg : ^tint$output_data_message;
                          fwa : ^tint$input_data_message; VAR lng : integer);
  VAR
    i : integer,
    user_it,
    user_id : tint$user_id,
    status : tint$input_status;

  user_id := connection_currency[acn].fet_6.user_id;
  msg^.header.connection_number := acn;
  send_data (acn,msg);
  downline_sm (acn,cint$termout_ico);
  /wait_request_accepted/
  WHILE true DO
    user_it := com.out_table[acn].user_id;
    IF user_it = 0 THEN
       EXIT /wait_request_accepted/;
    IFEND;
    pause (short_pause);
  WHILEND /wait_request_accepted/;
  connection_currency[acn].connection_ext := $tint$connection_ext[];
  /wait_debug_directive/
  WHILE true DO
    FOR i := 1 TO cint$in_length DO
      user_it := com.in_table[i].user_id;
      IF user_it = user_id THEN
         status := com.in_table[i].status;
         IF status = cint$termin_ico THEN
            com.in_table[i].user_table_address := 0;
            com.in_table[i].status := 0;
            com.in_table[i].user_id := 0;
            EXIT /wait_debug_directive/;
         IFEND;
      IFEND;
    FOREND;
    pause (short_pause);
  WHILEND /wait_debug_directive/;
  read_data (acn,fwa);
  lng := fwa^.header.text_length;
  IF lng = 0 THEN
     connection_currency[acn].fet_6.user_id := 0;
     connection_currency[acn].fet_6.user_table_address := 0;
  IFEND;
PROCEND get_debug_data;
?? OLDTITLE ??
?? NEWTITLE := '    procedure no_nosve' ??
?? EJECT ??
PROCEDURE no_nosve;

  VAR
    nr_of_users,
    i, k : integer,
    user_id, user_it, user_ig : tint$user_id,
    user_table : tint$user_table_address,
    status : tint$input_status;

  nr_of_users := -1;
  WHILE nr_of_users <>0 DO
    nr_of_users := 0;
    /search_through_termin/
    FOR i := 1 TO cint$in_length DO
      user_id := com.in_table[i].user_id;
      IF user_id <> 0 THEN
         status := com.in_table[i].status;
         IF status <> cint$termin_nuc THEN
            com.in_table[i].user_table_address := 0;
            com.in_table[i].status := 0;
            com.in_table[i].user_id := 0;
            CYCLE /search_through_termin/;
         IFEND;
         nr_of_users := nr_of_users + 1;
         /search_user_in_con_currency/
         FOR k := 1 TO iic$passon_max_cn DO
             user_it := connection_currency[k].fet_6.user_id;
             IF user_it = user_id THEN
                user_ig := com.out_table[k].user_id;
                IF user_ig = 0 THEN
                   connection_currency[k].fet_6.user_id := 0;
                   connection_currency[k].fet_6.user_table_address := 0;
                   com.in_table[i].user_table_address := 0;
                   com.in_table[i].status := 0;
                   com.in_table[i].user_id := 0;
                   nr_of_users := nr_of_users - 1;
                IFEND;
                CYCLE /search_through_termin/;
             IFEND;
         FOREND /search_user_in_con_currency/;
         /search_empty_entry_in_currency/
         FOR k := 1 to iic$passon_max_cn DO
             user_it := connection_currency[k].fet_6.user_id;
             IF user_it = 0 THEN
                user_table := com.in_table[i].user_table_address;
                connection_currency[k].fet_6.user_id := user_id;
                connection_currency[k].fet_6.user_table_address := user_table;
                nosve_msg.header.connection_number := k;
                send_data (k,#LOC(nosve_msg));
                downline_sm (k,cint$termout_nuc);
                CYCLE /search_through_termin/;
             IFEND;
         FOREND /search_empty_entry_in_currency/;
      IFEND;
    FOREND /search_through_termin/;
    pause (short_pause);
  WHILEND;
PROCEND no_nosve;
?? OLDTITLE ??
?? NEWTITLE := '    procedure read_data' ??
?? EJECT ??
{  The purpose of this procedure is to read a single line of data from the
{    terminal and to supply a headerword, that makes the data look like a
{    NAM-datablock.
{
PROCEDURE read_data (acn :  iit$application_connection_num;
                     fwa : ^tint$input_data_message);

  VAR
    block_number : iit$application_block_number,
    ftr : ^tint$fet_6,
    lng,
    length : iit$text_length,
    i,k,
    error : integer;

  IF input_trans IN connection_currency[acn].connection_ext THEN
     connection_currency[acn].fet_6.char_code := 2;
     fwa^.header.transparent := true;
     IF force_parity IN connection_currency[acn].connection_ext THEN
        connection_currency[acn].fet_6.par_force := false;
     ELSE
        connection_currency[acn].fet_6.par_force := true;
     IFEND;
  ELSE
     connection_currency[acn].fet_6.char_code := 1;
     fwa^.header.transparent := false;
  IFEND;
  connection_currency[acn].fet_6.in_byte := 0;
  connection_currency[acn].fet_6.out_byte := 0;
  connection_currency[acn].fet_6.unit_sep := false;
  connection_currency[acn].fet_6.format_effector := false;
  ftr := ^connection_currency[acn].fet_6;
  ciord (fwa,ftr,length,error);
  IF error = 10(8) THEN
     fwa^.header.undeliverable := true;
  ELSE
     fwa^.header.undeliverable := false;
  IFEND;
  lng := 5*length;
  IF lng<>0 THEN
     /search_zero_byte/
     FOR i := 0 TO 4 DO
         k := 4 - i;
         IF fwa^.data[length].byte[k] = 0 THEN
            lng := lng - 1;
         ELSE;
            EXIT /search_zero_byte/;
         IFEND;
     FOREND /search_zero_byte/;
     IF fwa^.header.transparent THEN
       If lng > 0 THEN
         lng := lng - 1;
       IFEND;
     IFEND;
  IFEND;
  block_number := connection_currency[acn].block_number + 1;
  IF block_number > iic$max_block_number THEN
     block_number := 1;
  IFEND;
  connection_currency[acn].block_number := block_number;
  fwa^.header.block_type := iic$last_block;
  fwa^.header.connection_number := acn;
  fwa^.header.block_number := block_number;
  fwa^.header.character_type := iic$8_of_12_bit_characters;
  fwa^.header.zero1 := 0;
  fwa^.header.cancel := false;
  fwa^.header.parity_error := false;
  fwa^.header.text_length := lng;
  RETURN;
PROCEND read_data;
?? OLDTITLE ??
?? NEWTITLE := '    procedure send_data' ??
?? EJECT ??
{  The purpose of this procedure is to send data received from IF to the ter=
{    minal. The header is stripped off, its content is used to set up the FET.
{
PROCEDURE send_data (acn : iit$application_connection_num;
                     fwa : ^tint$output_data_message);

  VAR
    ftr : ^tint$fet_6,
    i,k,
    nr_char,nr_byte,
    error,
    length : integer;

  IF fwa^.header.character_type <> iic$8_of_12_bit_characters THEN
     abort := char_type_failed;
     set_passon_abnormal (abort);
     IF abort <> okee_dokee THEN
        RETURN;
     IFEND;
  IFEND;
  IF output_suppress IN connection_currency[acn].connection_ext THEN
     RETURN;
  IFEND;
  nr_char := fwa^.header.text_length;
  length := (nr_char+4) DIV 5;
  IF fwa^.header.transparent THEN
     nr_char := nr_char + 5 - 5*length;
     IF nr_char = 5 THEN
        nr_char := 0;
        length := length + 1;
        fwa^.data[length].byte[0] := 0;
     IFEND;
     fwa^.data[length].byte[4] := 0;
     IF nr_char < 4 THEN
        fwa^.data[length].byte[3] := 0;
        IF nr_char < 3 THEN
           fwa^.data[length].byte[2] := 0;
           IF nr_char < 2 THEN
              fwa^.data[length].byte[1] := 0;
           IFEND;
        IFEND;
     IFEND;
     connection_currency[acn].fet_6.char_code := 2;
     connection_currency[acn].fet_6.unit_sep := false;
     connection_currency[acn].fet_6.out_byte := 0;
     connection_currency[acn].fet_6.in_byte := 0;
     IF force_parity IN connection_currency[acn].connection_ext THEN
        connection_currency[acn].fet_6.par_force := false;
     ELSE
        connection_currency[acn].fet_6.par_force := true;
     IFEND;
  ELSE
     connection_currency[acn].fet_6.char_code := 1;
     connection_currency[acn].fet_6.par_force := false;
     connection_currency[acn].fet_6.in_byte := nr_char MOD 5;
     connection_currency[acn].fet_6.out_byte := 0;
     connection_currency[acn].fet_6.unit_sep := true;
  IFEND;
  connection_currency[acn].fet_6.format_effector :=
             fwa^.header.no_format_effectors;
  ftr := ^connection_currency[acn].fet_6;
  ciowr (fwa,ftr,length,error);
  IF error = 10(8) THEN
     downline_sm (acn,cint$termout_oco);
     connection_currency[acn].connection_ext :=
                connection_currency[acn].connection_ext
              + $tint$connection_ext[output_wait];
  IFEND;
  IF nam_debug AND (nr_msg>0) THEN
     savemsg (ftr,1,8);
     nr_msg := nr_msg - 1;
     savemsg (fwa,length+1,6);
  IFEND;
  RETURN;
PROCEND send_data;
?? OLDTITLE ??
?? NEWTITLE := '    procedure synch_downline_sm' ??
?? EJECT ??
{  The purpose of this procedure is to process one of three possible synchronous
{    downline supervisory messages.
{
PROCEDURE synch_downline_sm (acn : iit$application_connection_num;
                             msg : ^tint$synch_out_sm);

  VAR
    case_value : 0 .. 0ffff(16),
    lim,
    ind_synch,
    field_number,
    field_value,
    i : integer;

  ind_synch := connection_currency[acn].ind_synch + 1;
  case_value := ((16*msg^.data[1]+msg^.data[2])*16+msg^.data[3])*16
                + msg^.data[4];
  CASE case_value OF

  = iic$sm_resume_output_mark =    { RO/MARK/R = CB00(16) = 626000(8) }

    IF NOT (user_break_sy IN connection_currency[acn].connection_ext) THEN
       abort := break_req_failed;
       IF dump_indicator THEN
          dump_mem (1,abort);
       IFEND;
       RETURN;
    IFEND;
    connection_currency[acn].connection_ext :=
               connection_currency[acn].connection_ext
             + $tint$connection_ext[user_break_out]
             - $tint$connection_ext[user_break_sy];

  = iic$sm_define_term_char =      { CTRL/CHAR/R = C108(16) = 602040(8) }

    lim := (2*msg^.header.text_length-4) DIV 4;
    FOR i := 1 TO lim DO
      field_number := 16*msg^.data[4*i+1] + msg^.data[4*i+2];
      field_value  := 16*msg^.data[4*i+3] + msg^.data[4*i+4];
      IF field_number = iic$fn_trans_input_mode THEN
         IF field_value = 1 THEN
            connection_currency[acn].connection_ext :=
                       connection_currency[acn].connection_ext
                     + $tint$connection_ext[input_trans];
         ELSE
            connection_currency[acn].connection_ext :=
                       connection_currency[acn].connection_ext
                     - $tint$connection_ext[input_trans];
         IFEND;
      ELSEIF field_number = iic$fn_parity THEN
         IF field_value = 3 THEN
            connection_currency[acn].connection_ext :=
                       connection_currency[acn].connection_ext
                     + $tint$connection_ext[force_parity];
         ELSE
            connection_currency[acn].connection_ext :=
                       connection_currency[acn].connection_ext
                     - $tint$connection_ext[force_parity];
         IFEND;
      IFEND;
    FOREND;
    connection_currency[acn].synch_msg[ind_synch] := cint$ssm_ctrl_char_n;
    connection_currency[acn].ind_synch := ind_synch;

  = iic$sm_request_term_char =        { CTRL/RTC/R = C109(16) = 602044(8) }

    connection_currency[acn].synch_msg[ind_synch] := cint$ssm_ctrl_tcd_r;
    connection_currency[acn].ind_synch := ind_synch;

  ELSE;
  abort := synch_sm_failed;
  IF dump_indicator THEN
     dump_mem (2,abort);
  IFEND;
  CASEND;
  RETURN;
PROCEND synch_downline_sm;
?? OLDTITLE ??
?? NEWTITLE := '    procedure synch_upline_sm' ??
?? EJECT ??
{  The purpose of this procedure is to form a synchronous upline supervisory
{    message out of data stored in connection_currency. The type of the next
{    message is contained in the first place of array synch_msg.
{
PROCEDURE synch_upline_sm (msg : ^tint$predef_sm;
                           acn : iit$application_connection_num;
                       VAR lng : integer);

  VAR
    ind_synch,
    synch_type,
    a,b,
    i : integer,
    connection_ext : tint$connection_ext;

  synch_type := connection_currency[acn].synch_msg[1];

  CASE synch_type OF

  = cint$ssm_bi_mark_r =

    connection_ext := connection_currency[acn].connection_ext;
    IF connection_ext*$tint$connection_ext[user_break_as,
                      user_break_sy] <> $tint$connection_ext[] THEN
       connection_currency[acn].connection_ext := connection_ext
                 + $tint$connection_ext[input_suppress];
    IFEND;
    predef_ssm[1].header.address := acn;
    mmove (#LOC(predef_ssm[1]),msg,2);
    lng := 1;

  = cint$ssm_ctrl_char_n =

    predef_ssm[2].header.address := acn;
    mmove (#LOC(predef_ssm[2]),msg,2);
    lng := 1;

  = cint$ssm_ctrl_tcd_r =

    ctrl_tcd_r.header.address := acn;
    a := connection_currency[acn].term_char.term_class;
    b := class_table[a];
    a := b DIV 16;
    ctrl_tcd_r.data[7]  := a;
    ctrl_tcd_r.data[8]  := b - 16*a;
    a := connection_currency[acn].term_char.page_width DIV 16;
    b := connection_currency[acn].term_char.page_width - 16*a;
    ctrl_tcd_r.data[11] := a;
    ctrl_tcd_r.data[12] := b;
    a := connection_currency[acn].term_char.page_length DIV 16;
    b := connection_currency[acn].term_char.page_length - 16*a;
    ctrl_tcd_r.data[15] := a;
    ctrl_tcd_r.data[16] := b;
    a := connection_currency[acn].term_char.page_wait DIV 16;
    b := connection_currency[acn].term_char.page_wait - 16*a;
    ctrl_tcd_r.data[71] := a;
    ctrl_tcd_r.data[72] := b;
    mmove (#LOC(ctrl_tcd_r),msg,11);
    lng := 10;

  ELSE
    abort := synch_sm_failed;
    IF dump_indicator THEN
       dump_mem (3,abort);
    IFEND;
    RETURN;
  CASEND;
  ind_synch := connection_currency[acn].ind_synch;
  FOR i := 1 TO ind_synch-1 DO
    connection_currency[acn].synch_msg[i] :=
               connection_currency[acn].synch_msg[i+1];
  FOREND;
  connection_currency[acn].synch_msg[ind_synch] := 0;
  connection_currency[acn].ind_synch := ind_synch - 1;
  RETURN;
PROCEND synch_upline_sm;
?? OLDTITLE ??
?? NEWTITLE := '    procedure termin_search' ??
?? EJECT ??
{  The purpose of this pocedure is to check the 1QP-communication table
{    TERMIN for messages from 1QP and to convert them to flags of set
{    connection_ext. For new users an empty slot is searched in connection
{    _currency.
{
PROCEDURE termin_search;

  VAR

    connection_ext : tint$connection_ext,
    input_status : tint$input_status,
    input_user_id,
    connect_user_id : tint$user_id,
    input_user_table,
    connect_user_table : tint$user_table_address,
    i,
    k : integer;

  /search_table_termin/
  FOR i := 1 TO cint$in_length DO
    input_user_id := com.in_table[i].user_id;
    /check_termin_entry_zero/
    BEGIN
    IF input_user_id <> 0 THEN
       input_user_table := com.in_table[i].user_table_address;
       input_status := com.in_table[i].status;
       /check_for_new_user/
       BEGIN
       IF input_status = cint$termin_nuc THEN
          /search_empty_slot_in_currency/
          FOR k := 1 TO iic$passon_max_cn DO
            connect_user_id := connection_currency[k].fet_6.user_id;
            IF connect_user_id = 0 THEN
               connection_currency[k].fet_6.user_id := input_user_id;
               connection_currency[k].fet_6.user_table_address :=
                                      input_user_table;
               connection_currency[k].connection_ext :=
                          $tint$connection_ext[new_user];
               com.in_table[i].user_table_address := 0;
               com.in_table[i].status := 0;
               com.in_table[i].user_id := 0;
               EXIT /search_empty_slot_in_currency/;
            IFEND;
          FOREND /search_empty_slot_in_currency/;
       ELSE
?? NEWTITLE := '    check the status bits' ??
?? EJECT ??
/search_user_in_currency/
FOR k := 1 TO iic$passon_max_cn DO
  connect_user_id := connection_currency[k].fet_6.user_id;
  IF connect_user_id = input_user_id THEN
     connection_ext := connection_currency[k].connection_ext;
     CASE input_status OF

   = cint$termin_loc =      { autologout }
     connection_currency[k].connection_ext := connection_ext
              + $tint$connection_ext[autologout];

   = cint$termin_brk =      { user break }
     IF (connection_ext*$tint$connection_ext[user_break_as,
        user_break_akn] <> $tint$connection_ext[]) THEN
        abort := termin_failed;
        IF dump_indicator THEN
           dump_mem (4,abort);
        IFEND;
     ELSEIF (connection_ext*$tint$connection_ext[new_user,
             detach_pend,autologout,connection_rejected,trans_break,
             term_char_req,detached]) <> $tint$connection_ext[] THEN
        downline_sm (k,cint$termout_brk);
     ELSEIF input_trans IN connection_ext THEN
        connection_currency[k].connection_ext := connection_ext
                 - $tint$connection_ext[output_wait]
                 + $tint$connection_ext[trans_break];
        downline_sm (k,cint$termout_brk);
     ELSE
        connection_currency[k].connection_ext := connection_ext
                 - $tint$connection_ext[output_wait]
                 + $tint$connection_ext[user_break,output_suppress];
     IFEND;

   = cint$termin_ico =      { input available }
     connection_currency[k].connection_ext := connection_ext
              - $tint$connection_ext[input_req]
              + $tint$connection_ext[input_available];

   = cint$termin_oco =      { output complete }
     connection_currency[k].connection_ext := connection_ext
              - $tint$connection_ext[output_wait];

   = cint$termin_dis =      { user back from disconnect }
     downline_sm (k,cint$termout_ico);

     ELSE
       abort := termin_failed;
       IF dump_indicator THEN
          dump_mem (5,abort);
       IFEND;
       RETURN;
     CASEND;
     com.in_table[i].user_table_address := 0;
     com.in_table[i].status := 0;
     com.in_table[i].user_id := 0;
     EXIT /search_user_in_currency/;
  IFEND;
FOREND /search_user_in_currency/;
?? OLDTITLE ??
?? EJECT ??
       IFEND;
       END /check_for_new_user/;
    IFEND;
    END /check_termin_entry_zero/;
  FOREND /search_table_termin/;
?? OLDTITLE ??
PROCEND termin_search;
?? OLDTITLE ??
?  IFEND
?? SET(LIST:=ON) ??
?? NEWTITLE := '    procedure compute_block_length' ??
?? EJECT ??
{  The purpose of this routine is to compute the number of CM words required
{    to contain a given number of characters of a variable size.

  PROCEDURE compute_block_length (char_type: iit$application_character_type;
        text_length: iit$text_length;
    VAR length: iit$text_length);
    CASE char_type OF
    = iic$60_bit_characters =
      length := text_length;
    = iic$8_bit_characters =
      length := ((text_length + 7) * 2) DIV 15;
    = iic$8_of_12_bit_characters =
      length := (text_length + 4) DIV 5;
    = iic$display_code_characters =
      length := (text_length + 9) DIV 10;
    CASEND;
  PROCEND compute_block_length;
?? OLDTITLE ??
?? NEWTITLE := '    procedure log ' ??
?? EJECT ??
{  The purpose of this routine is to issue a dayfile message to the
{    NOS/A170 dayfile(s).

  PROCEDURE log (s: string ( * );
        dayfile: 0 .. 7;
        force: boolean);
?? PUSH (LISTEXT := ON) ??
*copyc zutps2d
*copyc zn7pmsg
?? POP ??

    VAR
      dcm: array [1 .. 8] of packed array [0 .. 9] of 0 .. 3f(16),
      dcwi: integer,
      dcci: 0 .. 9,
      si: ost$string_index,
      eol: boolean;

    IF (NOT passon_debug) AND (dayfile = job_dayfile) AND (NOT force) THEN
      RETURN;
    IFEND;
    si := 1;
    dcwi := 1;
    dcci := 0;
    eol := TRUE;
    utp$convert_string_to_dc_string (utc$ascii64, dcm, dcwi, dcci, s, si, eol);
    n7p$issue_dayfile_message (#LOC (dcm), dayfile);
  PROCEND log;
?? OLDTITLE ??
?? NEWTITLE := '    procedure set_passon_abnormal' ??
?? EJECT ??
{  The purpose of this routine is to issue the passon abnormal
{    log message and possibly cause passon to terminate execution.

  PROCEDURE set_passon_abnormal (VAR abort: iit$passon_failure);
    log_vrbl (' passon abnormal ', ORD (abort), job_dayfile, FALSE);
    IF status.condition = mlc$nosve_not_up THEN
      log ('$nosve down', b_display, FALSE);
      RETURN;
    IFEND;
    IF NOT terminate_if_abnormal THEN
      abort := okee_dokee;
    IFEND;
  PROCEND set_passon_abnormal;
?? OLDTITLE ??
?? NEWTITLE := '    procedure log_vrbl' ??
?? EJECT ??
{  The purpose of this routine is to issue a dayfile message to the
{    NOS/A170 dayfile(s) with a varibale value appended to it.

  PROCEDURE log_vrbl (s: string ( * );
        value: integer;
        dayfile: 0 .. 7;
        force: boolean);

    VAR
      new_s: ^string ( * ),
      n,
      l: integer;

    IF (NOT passon_debug) AND (dayfile = job_dayfile) AND (NOT force) THEN
      RETURN;
    IFEND;
    l := STRLENGTH (s);
    PUSH new_s: [l + 10];
    new_s^ (1, l) := s (1, l);
    new_s^ (l + 1, 10) := '          ';
    STRINGREP (new_s^ (l + 1, 10), n, value);
    log (new_s^, dayfile, force);
  PROCEND log_vrbl;
?? OLDTITLE ??
?? NEWTITLE := '    procedure form_sm ' ??
?? EJECT ??
{  The purpose of this procedure is to initialize the common parts of a
{    supervisory message.

  PROCEDURE form_sm (msg: ^iit$output_supervisory_message;
        pfcsfc: iit$supervisory_message_type;
        length: integer);

    VAR
      standard_header: [STATIC] iit$output_supervisory_header := [
      ?IF ifv$module_for_c180 = TRUE THEN
        0,
      ?IFEND
        {} iic$supervisory_block, 0, 0, iic$60_bit_characters, 0, 0];

    msg^.header := standard_header;
    msg^.header.text_length := length;
    msg^.message_type := pfcsfc;
  PROCEND form_sm;
?? OLDTITLE ??
?? NEWTITLE := '    procedure dump', EJECT ??

  PROCEDURE dump (abort: iit$passon_failure;
        p: ^cell;
        len: integer);

    CONST
      ?IF ifv$module_for_c180 = TRUE THEN
        nod = 16;

      ?ELSE
        nod = 15;
    ?IFEND

    VAR
      pa: ^packed array [1 .. 100] of packed array [1 .. nod] of 0 .. 15,
      lim,
      ich,
      i,
      j: integer,
      s: string (17);

    log_vrbl (' hex data for passon condition =', ORD (abort), job_dayfile,
          TRUE);
    s := '  ';
    pa := p;
    lim := len;
    IF lim > 100 THEN
      lim := 100;
    IFEND;
    FOR i := 1 TO lim DO
      FOR j := 1 TO nod DO
        ich := pa^ [i] [j];
        IF ich > 9 THEN
          ich := ich + 37(16);
        ELSE
          ich := ich + 30(16);
        IFEND;
        s (j + 1) := CHR (ich);
      FOREND;
      log (s, job_dayfile, TRUE);
    FOREND;
  PROCEND dump;
?? OLDTITLE ??
?? NEWTITLE := '    procedure begin_data_read' ??
?? EJECT ??
{  The purpose of this request is to start a read operation on a given
{    connection.

  PROCEDURE begin_data_read (acn: iit$application_connection_num;
        begin_absentee: boolean;
        notify: boolean;
        application: mlt$application_name;
    VAR abort: iit$passon_failure);

    VAR
    ? IF ifv$nos_be = true THEN
      block_number : iit$application_block_number,
      lng, ind,
      ind_synch : integer,
      connection_ext : tint$connection_ext,
      output_user_id : tint$user_id,
    ? IFEND
      cs: iit$connection_state,
      dmsg: iit$input_data_message,
      length: iit$text_length,
      smsg: iit$output_supervisory_message;

  {!log_vrbl (' begin read on acn ', acn, job_dayfile, FALSE);
    cs := connection_currency [acn].connection_state;

{ Allow reads if a break is active and read is without wait

    IF (cs * $iit$connection_state [wait_connection, break_active,
          broken_connection, stopped, connection_ending, connection_hold,
          wait_init, available_for_use, terminate]) <> $iit$connection_state [] THEN
      IF NOT ((break_active IN cs) AND (NOT begin_absentee)) THEN
        log_vrbl (' read ignored ', acn, job_dayfile, FALSE);
{
{  Notify the nos/ve task doing the read that the read was not accepted.
{
        form_sm (#LOC (smsg), iic$sm_read_rejected, iic$l_read_rejected);
        send_upline_sm (#LOC (smsg), iic$l_read_rejected, acn, application,
              abort);
        RETURN;
      IFEND;
    IFEND;
    connection_currency [acn].application_name_last_io := application;
  ? IF ifv$nos_be = false THEN
    net#get (acn, #LOC (dmsg), iic$max_block_length_in_words);
  ? ELSE
    IF input_suppress IN connection_currency[acn].connection_ext THEN
       form_sm (#LOC (smsg), iic$sm_read_rejected, iic$l_read_rejected);
       send_upline_sm (#LOC (smsg), iic$l_read_rejected, acn, application,
           abort);
       RETURN;
    IFEND;
    ind_synch := connection_currency[acn].ind_synch;
    IF ind_synch <> 0 THEN
       synch_upline_sm  (#LOC(dmsg),acn,lng);
       IF abort = okee_dokee THEN
          send_upline_data (#LOC(dmsg),lng,acn,application,abort);
       ELSE
          IF dump_indicator THEN
             dump_mem (6,abort);
          IFEND;
       IFEND;
       RETURN;
    ELSE
       /input_available_check/
       BEGIN
       /check_analyst_action/
       BEGIN
       connection_ext := connection_currency[acn].connection_ext;
       IF trans_break IN connection_ext THEN
          output_user_id := com.out_table[acn].user_id;
          IF (output_user_id = 0) AND
             (user_break_rel IN connection_ext) THEN
             trans_break_msg.header.connection_number := acn;
             mmove (#LOC(trans_break_msg),#LOC(dmsg),2);
             connection_currency[i].connection_ext := connection_ext
                       -$tint$connection_ext[user_break_rel,trans_break,
                                             input_available,input_req];
             downline_sm (acn,cint$termout_ico);
             EXIT /input_available_check/;
          IFEND;
          EXIT /check_analyst_action/;
       IFEND;
       IF input_available IN connection_ext THEN
          read_data (acn,#LOC(dmsg));
          connection_currency[acn].connection_ext := connection_ext
                   - $tint$connection_ext[input_available];
          IF acn = analyst_acn THEN
             analyst_action (#LOC(dmsg),ind);
             IF ind = 1 THEN
                EXIT /check_analyst_action/;
             IFEND;
          IFEND;
          EXIT /input_available_check/;
       IFEND;
       END /check_analyst_action/;
       block_number := connection_currency[acn].block_number + 1;
       IF block_number > iic$max_block_number THEN
          block_number := 1;
       IFEND;
       connection_currency[acn].block_number := block_number;
       dmsg.header.block_type := iic$null_block;
       dmsg.header.connection_number := acn;
       dmsg.header.block_number := block_number;
       dmsg.header.undeliverable := false;
       dmsg.header.character_type := iic$8_of_12_bit_characters;
       downline_sm (acn,cint$termout_ico);
       END /input_available_check/;
    IFEND;
  ? IFEND
    IF dmsg.header.undeliverable THEN
      abort := data_ibu;
      dump (abort, #LOC (dmsg), 5);
      RETURN;
    IFEND;
    IF (dmsg.header.block_type <> iic$null_block) OR (NOT begin_absentee) THEN
      IF dmsg.header.block_type = iic$null_block THEN
        length := 0;
      ELSE
        compute_block_length (dmsg.header.character_type, dmsg.header.
              text_length, length);
      IFEND;
      send_upline_data (#LOC (dmsg), length, acn, application, abort);
      IF abort <> okee_dokee THEN
      ? IF ifv$nos_be = true THEN
        IF dump_indicator THEN
           dump_mem (7,abort);
        IFEND;
      ? IFEND
        RETURN;
      IFEND;
    ELSE
      IF begin_absentee THEN
        connection_currency [acn].connection_state := connection_currency
              [acn].connection_state + $iit$connection_state [absentee_read];
      ? IF ifv$nos_be = false THEN
        form_sm (#LOC (smsg), iic$sm_list_on, iic$l_list_on);
        smsg.list_on.connection_number := acn;
        net#put (#LOC (smsg));
      ? IFEND
      {!log_vrbl (' begin absentee on acn ', acn, job_dayfile, FALSE);
        IF notify THEN
          form_sm (#LOC (smsg), iic$sm_absentee_begun, iic$l_absentee_begun);
          send_upline_sm (#LOC (smsg), iic$l_absentee_begun, acn,
                connection_currency [acn].application_name_last_io, abort);
        IFEND;
      IFEND;
    IFEND;
  PROCEND begin_data_read;
?? OLDTITLE ??
?? NEWTITLE := '    Map NOS family to NOSVE          ' ??
?? EJECT ??

{  The purpose of this routine is to map a NOS family to a NOS/VE
{  family.  The default NOS/VE family will be used if the first
{  character of the returned family is NULL.
{
{  Note  that the format for the family name and user name is one to
{  seven 6-bit display code letters and digits, left-justified with
{  blank fill.
{
{  For example, the following statements would specify a NOS/VE family
{  name of NOSVE and a NOS/VE user name of SON:
{
{  family [1] := 14; { 'N' in display code
{  family [2] := 15; { 'O' in display code
{  family [3] := 19; { 'S' in display code
{  family [4] := 22; { 'V' in display code
{  family [5] := 05; { 'E' in display code
{  family [6] := 45; { ' ' in display code
{  family [7] := 45; { ' ' in display code
{
{  user_name [1] := 19; { 'S' in display code
{  user_name [2] := 15; { 'O' in display code
{  user_name [3] := 14; { 'N' in display code
{  user_name [4] := 45; { ' ' in display code
{  user_name [5] := 45; { ' ' in display code
{  user_name [6] := 45; { ' ' in display code
{  user_name [7] := 45; { ' ' in display code

  PROCEDURE map_nos_family_to_nosve (VAR family: iit$login_family_name;
    VAR user_name: iit$login_user_name);

    family[1] :=  00(16);

  PROCEND map_nos_family_to_nosve;
?? OLDTITLE ??
?? NEWTITLE := '    procedure poll_for_absentee_reads' ??
?? EJECT ??
{  The purpose of this routine is to perform a nam net get list request
{    on the absentee list and send any data to the correct nos/ve task.

  PROCEDURE poll_for_absentee_reads (msg: ^iit$input_data_message;
    VAR abort: iit$passon_failure);

    VAR
      acn: iit$application_connection_num,
      application: mlt$application_name,
      length: iit$text_length,
      posm: ^iit$output_supervisory_message;

  ? IF ifv$nos_be = false THEN
    net#gtl (iic$normal_input_list_number, msg, iic$max_block_length_in_words);
  ? IFEND
    IF msg^.header.undeliverable THEN
      abort := data_ibu;
      dump (abort, #LOC (msg^), 5);
    ? IF ifv$nos_be = true THEN
      IF dump_indicator THEN
         dump_mem (8,abort);
      IFEND;
    ? IFEND
      RETURN;
    IFEND;
    IF msg^.header.block_type = iic$null_block THEN
      abort_poll := TRUE;
      RETURN;
    IFEND;
    acn := msg^.header.connection_number;
  {!log_vrbl (' absentee input from acn ', acn, job_dayfile, FALSE);
    application := connection_currency [acn].application_name_last_io;
    compute_block_length (msg^.header.character_type, msg^.header.text_length,
          length);
    abort := okee_dokee;
    send_upline_data (msg, length, acn, application, abort);
{
{ disable absentee read for this acn
{
    IF abort = okee_dokee THEN
    ? IF ifv$nos_be = false THEN
      posm := #LOC (msg^);
      form_sm (posm, iic$sm_list_off, iic$l_list_off);
      posm^.list_off.connection_number := acn;
      net#put (posm);
    ? IFEND
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state - $iit$connection_state [absentee_read];
    IFEND;
  PROCEND poll_for_absentee_reads;
?? OLDTITLE ??
?? NEWTITLE := '    procedure send_queued_upline_sm' ??
?? EJECT ??
{  The purpose of this procedure is to send queued upline supervisory messages
{    to nos/ve.

  PROCEDURE send_queued_upline_sm (acn: iit$application_connection_num;
    VAR abort: iit$passon_failure);

    VAR
      nextqp,
      qp: ^iit$sm_queue,
      sp: ^iit$input_supervisory_message,
      length: mlt$message_length;

    IF NOT (connection_hold IN connection_currency [acn].connection_state) THEN
      qp := connection_currency [acn].front_queued_sm_ptr;
      IF qp <> NIL THEN
        length := UPPERBOUND (qp^.msg);
        mlp$send_message (iic$passon_application_name,
              iic$input_supervisory_message, signal, #LOC (qp^.msg), length *
              iic$mli_multiplier, qp^.application_name, status);
        IF status.condition IN mli_retry_status THEN
          RETURN;
        IFEND;
        IF status.condition IN mli_fatal_status THEN
          IF status.condition <> mlc$receiver_not_signed_on THEN
            abort := queued_sm_send;
            dump (abort, #LOC (status), #SIZE (status));
          ? IF ifv$nos_be = true THEN
            IF dump_indicator THEN
               dump_mem (9,abort);
            IFEND;
          ? IFEND
            RETURN;
          ELSE
            log_vrbl (' upline failure to acn ', acn, job_dayfile, FALSE);
            IF acn = iic$exec_acn THEN
              abort := exec_dead;
              dump (abort, #LOC (status), #SIZE (status));
            ? IF ifv$nos_be = true THEN
              IF dump_indicator THEN
                 dump_mem (10,abort);
              IFEND;
            ? IFEND
              set_passon_abnormal (abort);
            IFEND;
          IFEND;
        IFEND;
{
{ message was sent - release space
{
        sp := #LOC (qp^.msg);
        IF sp^.message_type = iic$sm_hold_acknowlege THEN
          connection_currency [acn].connection_state := connection_currency
                [acn].connection_state + $iit$connection_state
                [connection_hold];
        IFEND;
        connection_currency [acn].front_queued_sm_ptr := qp^.front;
        IF qp^.front <> NIL THEN
          qp^.front^.back := NIL;
        ELSE
          connection_currency [acn].back_queued_sm_ptr := NIL;
        IFEND;
      {!log_vrbl (' queued sm sent from acn ', acn, job_dayfile, FALSE);
      {!log_vrbl (' sent to appl ', qp^.application_name, job_dayfile, FALSE);
        ?IF ifv$module_for_c180 = TRUE THEN
          FREE qp IN osv$task_private_heap^;
        ?ELSE
          FREE qp;
        ?IFEND
        queued_sm_count := queued_sm_count - 1;
      IFEND;
    IFEND;
  PROCEND send_queued_upline_sm;
?? OLDTITLE ??
?? NEWTITLE := '    procedure send_upline_sm' ??
?? EJECT ??
{  The purpose of this procedure is to (attempt to) send a supervisory message
{    (upline) to nos/ve.  If the message cannot be sent, it will be added to
{    a queue for later transmission.  The actual length transferred is length +
{1 to
{    account for the header word.

  PROCEDURE send_upline_sm (msg: ^iit$input_supervisory_message;
        length: integer;
        acn: iit$application_connection_num;
        application: mlt$application_name;
    VAR abort: iit$passon_failure);

    VAR
      qp: ^iit$sm_queue,
      queued_sm: ^iit$sm_queue;

  {!log_vrbl (' send sm acn', acn, job_dayfile, FALSE);
  {!log_vrbl (' send sm type ', msg^.message_type, job_dayfile, FALSE);
  {!log_vrbl (' send to appl ', application, job_dayfile, FALSE);
    qp := connection_currency [acn].back_queued_sm_ptr;
    IF NOT (connection_hold IN connection_currency [acn].connection_state) THEN
      IF qp = NIL THEN
{
{ attempt mli send
{
        mlp$send_message (iic$passon_application_name,
              iic$input_supervisory_message, signal, msg, (length + 1) *
              iic$mli_multiplier, application, status);
      ? IF ifv$nos_be = true THEN
        IF nam_debug AND (nr_msg>0) THEN
           savemsg (msg,length+1,1);
           nr_msg := nr_msg - 1;
        IFEND;
      ? IFEND
        IF status.condition IN mli_ignore_status THEN
{
{ handle connection hold
{
          IF msg^.message_type = iic$sm_hold_acknowlege THEN
            connection_currency [acn].connection_state := connection_currency
                  [acn].connection_state + $iit$connection_state
                  [connection_hold];
          IFEND;
          RETURN;
        IFEND;
        IF status.condition IN mli_fatal_status THEN
          IF status.condition <> mlc$receiver_not_signed_on THEN
            abort := sm_send;
            dump (abort, #LOC (status), #SIZE (status));
          ? IF ifv$nos_be = true THEN
            IF dump_indicator THEN
               dump_mem (11,abort);
            IFEND;
          ? IFEND
            RETURN;
          ELSE
            log_vrbl (' upline failure to acn ', acn, job_dayfile, FALSE);
            IF acn = iic$exec_acn THEN
              abort := exec_dead;
              dump (abort, #LOC (status), #SIZE (status));
            ? IF ifv$nos_be = true THEN
              IF dump_indicator THEN
                 dump_mem (12,abort);
              IFEND;
            ? IFEND
              set_passon_abnormal (abort);
            IFEND;
            RETURN;
          IFEND;
        IFEND;
      IFEND;
      IFEND; {connection_hold}
{
{ message could not be sent to nos/ve.
{ queue for later transmission.
{
      ?IF ifv$module_for_c180 = TRUE THEN
        ALLOCATE queued_sm: [1 .. length + 1] IN osv$task_private_heap^;
      ?ELSE
        ALLOCATE queued_sm: [1 .. length + 1];
      ?IFEND
      IF queued_sm = NIL THEN
        abort := no_space;
      ? IF ifv$nos_be = true THEN
        IF dump_indicator THEN
           dump_mem (13,abort);
        IFEND;
      ? IFEND
        RETURN;
      IFEND;
      mmove (#LOC (msg^), #LOC (queued_sm^.msg), length + 1);
      queued_sm^.front := NIL;
      queued_sm^.back := qp;
      IF qp <> NIL THEN
        qp^.front := queued_sm;
      ELSE
        connection_currency [acn].front_queued_sm_ptr := queued_sm;
      IFEND;
      connection_currency [acn].back_queued_sm_ptr := queued_sm;
      queued_sm^.application_name := application;
      queued_sm_count := queued_sm_count + 1;
    {!log (' sm queued ', job_dayfile, FALSE);
  PROCEND send_upline_sm;
?? OLDTITLE ??
?? NEWTITLE := '    procedure send_queued_upline_data' ??
?? EJECT ??
{  The purpose of this procedure is to send queued upline data messages
{    to nos/ve.

  PROCEDURE send_queued_upline_data (acn: iit$application_connection_num;
    VAR abort: iit$passon_failure);

    VAR
      nextqp,
      qp: ^iit$data_queue,
      length: mlt$message_length;

    IF NOT (connection_hold IN connection_currency [acn].connection_state) THEN
      qp := connection_currency [acn].front_queued_data_ptr;
      IF qp <> NIL THEN
        length := UPPERBOUND (qp^.msg);
        mlp$send_message (iic$passon_application_name, iic$input_data_message,
              signal, #LOC (qp^.msg), length * iic$mli_multiplier, qp^.
              application_name, status);
        IF status.condition IN mli_retry_status THEN
          RETURN;
        IFEND;
        IF status.condition IN mli_fatal_status THEN
          IF status.condition <> mlc$receiver_not_signed_on THEN
            abort := queued_data_send;
            dump (abort, #LOC (status), #SIZE (status));
          ? IF ifv$nos_be = true THEN
            IF dump_indicator THEN
               dump_mem (14,abort);
            IFEND;
          ? IFEND
            RETURN;
          ELSE
            log_vrbl (' upline failure to acn ', acn, job_dayfile, FALSE);
            IF acn = iic$exec_acn THEN
              abort := exec_dead;
              dump (abort, #LOC (status), #SIZE (status));
            ? IF ifv$nos_be = true THEN
              IF dump_indicator THEN
                 dump_mem (15,abort);
             IFEND;
           ? IFEND
              set_passon_abnormal (abort);
            IFEND;
          IFEND;
        IFEND;
{
{ message was sent - release space
{
        connection_currency [acn].front_queued_data_ptr := qp^.front;
        IF qp^.front <> NIL THEN
          qp^.front^.back := NIL;
        ELSE
          connection_currency [acn].back_queued_data_ptr := NIL;
        IFEND;
      {!log_vrbl (' queued data sent from acn ', acn, job_dayfile, FALSE);
      {!log_vrbl (' sent to appl ', qp^.application_name, job_dayfile, FALSE);
        ?IF ifv$module_for_c180 = TRUE THEN
          FREE qp IN osv$task_private_heap^;
        ?ELSE
          FREE qp;
        ?IFEND
        queued_data_count := queued_data_count - 1;
      IFEND;
    IFEND;
  PROCEND send_queued_upline_data;
?? OLDTITLE ??
?? NEWTITLE := '    procedure send_upline_data' ??
?? EJECT ??
{  The purpose of this procedure is to (attempt to) send a data message
{    (upline) to nos/ve.  If the message cannot be sent, it will be added to
{    a queue for later transmission.  The actual length transferred is length +
{1
{    to account for the header word.

  PROCEDURE send_upline_data (msg: ^iit$input_data_message;
        length: integer;
        acn: iit$application_connection_num;
        application: mlt$application_name;
    VAR abort: iit$passon_failure);

    VAR
    ? IF ifv$nos_be = true THEN
      k : integer,
    ? IFEND
      qp: ^iit$data_queue,
      queued_data: ^iit$data_queue;

  {!log_vrbl (' send data from acn ', acn, job_dayfile, FALSE);
  {!log_vrbl (' send to appl ', application, job_dayfile, FALSE);
    qp := connection_currency [acn].back_queued_data_ptr;
    IF NOT (connection_hold IN connection_currency [acn].connection_state) THEN
    ? IF ifv$nos_be = true THEN
      IF nam_debug AND (nr_msg>0) THEN
         IF msg^.header.block_type  = iic$supervisory_block THEN
            k := 3;
         ELSE
            k := 5;
            savemsg (#LOC(connection_currency[acn].fet_6),1,7);
         IFEND;
         savemsg (msg,length+1,k);
         nr_msg := nr_msg - 1;
      IFEND;
    ? IFEND
      IF qp = NIL THEN
{
{ attempt mli send
{
        mlp$send_message (iic$passon_application_name, iic$input_data_message,
              signal, msg, (length + 1) * iic$mli_multiplier, application,
              status);
        IF status.condition IN mli_ignore_status THEN
          RETURN;
        IFEND;
        IF status.condition IN mli_fatal_status THEN
          IF status.condition <> mlc$receiver_not_signed_on THEN
            abort := data_send;
            dump (abort, #LOC (status), #SIZE (status));
            dump (abort, msg, 10);
            dump (abort, #LOC (acn), 1);
          ? IF ifv$nos_be = true THEN
            IF dump_indicator THEN
               dump_mem (16,abort);
            IFEND;
          ? IFEND
            RETURN;
          ELSE
            log_vrbl (' upline failure to acn ', acn, job_dayfile, FALSE);
            IF acn = iic$exec_acn THEN
              abort := exec_dead;
              dump (abort, #LOC (status), #SIZE (status));
            ? IF ifv$nos_be = true THEN
              IF dump_indicator THEN
                 dump_mem (17,abort);
              IFEND;
            ? IFEND
              set_passon_abnormal (abort);
            IFEND;
            RETURN;
          IFEND;
        IFEND;
      IFEND;
{
{ message could not be sent to nos/ve.
{ queue for later transmission.
{
      ?IF ifv$module_for_c180 = TRUE THEN
        ALLOCATE queued_data: [1 .. length + 1] IN osv$task_private_heap^;
      ?ELSE
        ALLOCATE queued_data: [1 .. length + 1];
      ?IFEND
      IF queued_data = NIL THEN
        abort := no_space;
      ? IF ifv$nos_be = true THEN
        IF dump_indicator THEN
           dump_mem (18,abort);
        IFEND;
      ? IFEND
        RETURN;
      IFEND;
      mmove (#LOC (msg^), #LOC (queued_data^.msg), length + 1);
      queued_data^.front := NIL;
      queued_data^.back := qp;
      IF qp <> NIL THEN
        qp^.front := queued_data;
      ELSE
        connection_currency [acn].front_queued_data_ptr := queued_data;
      IFEND;
      connection_currency [acn].back_queued_data_ptr := queued_data;
      queued_data^.application_name := application;
      queued_data_count := queued_data_count + 1;
    {!log (' data queued ', job_dayfile, FALSE);
    IFEND;
  PROCEND send_upline_data;
?? OLDTITLE ??
?? NEWTITLE := '    procedure send_downline_data' ??
?? EJECT ??
{  The purpose of this procedure is to transmit the specified data message
{    to nam.

? IF ifv$nos_be = true THEN
  PROCEDURE send_downline_data (msg : ^tint$output_data_message;
                                fwa : ^tint$synch_out_sm);

    VAR
      lng: integer,
      cs: iit$connection_state,
      acn: iit$application_connection_num;
? ELSE
  PROCEDURE send_downline_data (msg: ^iit$output_data_message);

    VAR
      cs: iit$connection_state,
      acn: iit$application_connection_num;
? IFEND
    VAR
      begin_absentee: boolean,
      smsg: iit$output_supervisory_message;

    begin_absentee := false;
    IF msg^.header.block_type = iic$begin_absentee THEN
       msg^.header.block_type := iic$last_block;
       begin_absentee := true;
    IFEND;
    acn := msg^.header.connection_number;
    cs := connection_currency [acn].connection_state;
    IF (cs * $iit$connection_state [wait_connection, break_active,
          broken_connection, stopped, connection_ending, connection_hold,
          wait_init, available_for_use, terminate]) <> $iit$connection_state [] THEN
      RETURN;
    IFEND;
  ? IF ifv$nos_be = false THEN
    connection_currency [acn].unacknowledged_block_count := connection_currency
          [acn].unacknowledged_block_count + 1;
    net#put (msg);
  ? ELSE
    IF msg^.header.block_type <> iic$supervisory_block THEN
      send_data (acn,msg);
    ELSE
      IF nam_debug AND (nr_msg>0) THEN
         lng := (2*fwa^.header.text_length+14) DIV 15 + 1;
         nr_msg := nr_msg - 1;
         savemsg (fwa,lng,4);
      IFEND;
      synch_downline_sm (acn,fwa);
    IFEND;
  ? IFEND
    IF msg^.header.block_type = iic$last_block THEN
      form_sm(#loc(smsg), iic$sm_read_request, iic$l_read_request);
      smsg.read_request.connection_number := acn;
      smsg.read_request.begin_absentee := begin_absentee;
      smsg.read_request.notify_if_absentee_started := true;
      modify_downline_connection (#loc(smsg), nosve_application,abort);
    IFEND;
  PROCEND send_downline_data;
? IF ifv$nos_be = true THEN
?? SET(LIST:=OFF) ??
?  ELSE
?? OLDTITLE ??
?? NEWTITLE := 'fetch_upline_sm' ??
?? EJECT ??
{  The purpose of this procedure is to get an upline supervisory message
{    from nam and send it to the appropriate nos/ve task.

  PROCEDURE fetch_upline_sm (msg: ^iit$input_supervisory_message;

    VAR abort: iit$passon_failure);
    net#get (iic$supervisory_connection_num, msg,
          iic$max_block_length_in_words);
    IF msg^.header.undeliverable THEN
      abort := sm_ibu;
      dump (abort, #LOC (msg^), 5);
      RETURN;
    IFEND;
{
{ check if no sm available
{
    IF msg^.header.block_type = iic$null_block THEN
      RETURN;
    IFEND;
    IF msg^.header.block_type <> iic$supervisory_block THEN
      abort := expected_sm;
      dump (abort, #LOC (msg^), 5);
      RETURN;
    IFEND;
    modify_upline_connection_status (msg, abort);
  PROCEND fetch_upline_sm;
?  IFEND
?? SET(LIST:=ON) ??
?? OLDTITLE ??
?? NEWTITLE := '    procedure modify_upline_connection_status' ??
?? EJECT ??
{  The purpose of this procedure is to modify the passon environment,
{    as needed, from the upline supervisory message.  The message is then sent
{    (upline) to nos/ve;

  PROCEDURE modify_upline_connection_status (msg:
    ^iit$input_supervisory_message;
    VAR abort: iit$passon_failure);

    TYPE
      kludge = record
        w1: integer,
        w2: integer,
        w3: iit$output_data_block_header,
      recend;

    VAR
    ? IF ifv$nos_be = true THEN
      lng : integer,
    ? IFEND
      family: iit$login_family_name,
      user_name: iit$login_user_name,
      xsmp,
      smp: ^iit$sm_queue,
      xdmp,
      dmp: ^iit$data_queue,
      ptr: ^kludge,
      ismsg: ^iit$input_supervisory_message,
      osmsg: ^iit$output_supervisory_message,
      conend_zero2: [STATIC] iit$170_display_word := [[REP 5 of 0], [REP 5 of
        0]],
      acn: iit$application_connection_num;

  {!log_vrbl (' upline sm ', msg^.message_type, job_dayfile, FALSE);
    CASE msg^.message_type OF
    = iic$sm_connection_broken =
      acn := msg^.connection_broken.connection_number;
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state + $iit$connection_state [broken_connection];
    ? IF ifv$nos_be = false THEN
      connection_currency [acn].unacknowledged_block_count := 0;
    ? IFEND
      send_upline_sm (msg, iic$l_connection_broken, acn, connection_currency
            [acn].application_name_jm, abort);
    = iic$sm_connection_ended =
      acn := msg^.connection_ended.connection_number;
      send_upline_sm (msg, iic$l_connection_ended, acn, connection_currency
            [acn].application_name_jm, abort);
      dmp := connection_currency [acn].front_queued_data_ptr;
      WHILE dmp <> NIL DO
        xdmp := dmp;
        dmp := xdmp^.front;
        ?IF ifv$module_for_c180 = TRUE THEN
          FREE xdmp IN osv$task_private_heap^;
        ?ELSE
          FREE xdmp;
        ?IFEND
        queued_data_count := queued_data_count - 1;
      WHILEND;
      connection_currency [acn].connection_state := $iit$connection_state
            [available_for_use];
{
{ add the supervisory messages for this connection to the exec's sm queue.
{ this will enable passon to free the acn before the 180 tasks have
{ completed interactive termination.
{
      smp := connection_currency [acn].front_queued_sm_ptr;
      IF smp <> NIL THEN
        xsmp := connection_currency [iic$exec_acn].back_queued_sm_ptr;
        IF xsmp <> NIL THEN
          xsmp^.front := smp;
          smp^.back := xsmp;
        ELSE
          connection_currency [iic$exec_acn].front_queued_sm_ptr := smp;
        IFEND;
        connection_currency [iic$exec_acn].back_queued_sm_ptr :=
              connection_currency [acn].back_queued_sm_ptr;
      IFEND;
      connection_currency [acn].front_queued_sm_ptr := NIL;
      connection_currency [acn].back_queued_sm_ptr := NIL;
      connection_currency [acn].connection_end_pending := FALSE;
    = iic$sm_connection_request =
      acn := msg^.conreq_connection_number;
      IF connection_currency [acn].connection_state <> $iit$connection_state
            [available_for_use] THEN
        abort := conreq1_failure;
        dump (abort, #LOC (connection_currency [acn]), #SIZE
              (connection_currency [acn]));
      ? IF ifv$nos_be = true THEN
        IF dump_indicator THEN
           dump_mem (19,abort);
        IFEND;
      ? IFEND
        RETURN;
      IFEND;
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state - $iit$connection_state [available_for_use] +
            $iit$connection_state [wait_connection];
    ? IF ifv$nos_be = false THEN
      connection_currency [acn].application_block_limit := msg^.
            conreq_block_limit;
      connection_currency [acn].unacknowledged_block_count := 0;
      family := msg^.conreq_family_name;
      user_name := msg^.conreq_user_name;
      map_nos_family_to_nosve(family,user_name);
      msg^.conreq_family_name := family;
      msg^.conreq_user_name := user_name;

    ? IFEND
      send_upline_sm (msg, iic$l_connection_request, iic$exec_acn,
            iic$exec_application_name, abort);
      IF abort = exec_dead THEN
      ? IF ifv$nos_be = false THEN
        PUSH osmsg;
        form_sm (osmsg, iic$sm_connection_rejected, iic$l_connection_rejected);
        osmsg^.connection_rejected.connection_number := acn;
        osmsg^.connection_rejected.reason := iic$unspecified_reject;
        net#put (osmsg);
      ? IFEND
      {!log_vrbl (' exec dead conreq reject', acn, job_dayfile, FALSE);
        connection_currency [acn].connection_state := $iit$connection_state
              [available_for_use];
      ? IF ifv$nos_be = true THEN
        connection_currency [acn].connection_ext :=
                                  $tint$connection_ext[detach_pend];
      ? IFEND
      IFEND;
    ? IF ifv$nos_be = true THEN
    ?? SET(LIST:=OFF) ??
    ? ELSE
    = iic$sm_output_stopped =
      acn := msg^.output_stopped.connection_number;
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state + $iit$connection_state [stopped];
      connection_currency [acn].unacknowledged_block_count := 0;
      send_upline_sm (msg, iic$l_output_stopped, acn, connection_currency
            [acn].application_name_jm, abort);
    = iic$sm_logical_error =
      log (' an errlgl follows ', job_dayfile, FALSE);
      dump (okee_dokee, #LOC (msg^), 10);
      IF msg^.errlgl_reason = iic$block_limit_exceeded THEN
{
{  send to job monitor
{
        ptr := #LOC (msg^);
        acn := ptr^.w3.connection_number;
        send_upline_sm (msg, iic$l_logical_error, acn, connection_currency
              [acn].application_name_jm, abort);
      ELSE
{
{ send to exec
{
        send_upline_sm (msg, iic$l_logical_error, iic$exec_acn,
              iic$exec_application_name, abort);
      IFEND;
      abort := error_logical;
    = iic$sm_break =
      acn := msg^.break.connection_number;
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state + $iit$connection_state [break_active];
      connection_currency [acn].unacknowledged_block_count := 0;
      send_upline_sm (msg, iic$l_break, acn, connection_currency [acn].
            application_name_jm, abort);
      IF absentee_read IN connection_currency [acn].connection_state THEN
{
{ remove absentee read from passon environment
{
        connection_currency [acn].connection_state := connection_currency
              [acn].connection_state - $iit$connection_state [absentee_read];
        PUSH osmsg;
        form_sm (osmsg, iic$sm_list_off, iic$l_list_off);
        osmsg^.list_off.connection_number := acn;
        net#put (osmsg);
      IFEND;
    ? IFEND
    ?? SET(LIST:=ON) ??
    = iic$sm_initialized_connection =
      acn := msg^.initialized_connection.connection_number;
      IF connection_currency [acn].connection_state <> $iit$connection_state
            [wait_init] THEN
        IF connection_currency [acn].connection_state <> $iit$connection_state
              [wait_init, broken_connection] THEN
          abort := init_failure;
          dump (abort, #LOC (connection_currency [acn]), #SIZE
                (connection_currency [acn]));
        ? IF ifv$nos_be = true THEN
          IF dump_indicator THEN
             dump_mem (20,abort);
          IFEND;
        ? IFEND
          RETURN;
        IFEND;
      IFEND;
      PUSH osmsg;
{ issue network connection initialized for NOS/VE
      form_sm(osmsg,iic$sm_connection_initialized,iic$l_connection_initialized);
      osmsg^.connection_initialized.connection_number:=acn;
      modify_downline_connection (osmsg, 0, abort);
{ issue network list off for the connection
      form_sm(osmsg,iic$sm_list_off,iic$l_list_off);
      osmsg^.list_off.connection_number := acn;
      modify_downline_connection (osmsg, 0, abort);
{ issue network list switch for this connection
      form_sm (osmsg, iic$sm_list_switch, iic$l_list_switch);
      osmsg^.list_switch.connection_number := acn;
      osmsg^.list_switch.new_list_number := iic$normal_input_list_number;
      modify_downline_connection (osmsg, 0, abort);
{ issue another list off request for this connection
      form_sm(osmsg, iic$sm_list_off, iic$l_list_off);
      osmsg^.list_off.connection_number := acn;
      modify_downline_connection (osmsg, 0, abort);
{ let nos/ve know that the connection is initialized
      send_upline_sm (msg, iic$l_initialized_connection, acn,
            connection_currency [acn].application_name_jm, abort);
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state - $iit$connection_state [wait_init];
    ? IF ifv$nos_be = true THEN
    ?? SET(LIST:=OFF) ??
    ? ELSE
    = iic$sm_start_output =
      acn := msg^.start_output.connection_number;
{
{ dont clear stopped state until nos/ve sends reset connection
{
      send_upline_sm (msg, iic$l_start_output, acn, connection_currency [acn].
            application_name_jm, abort);
    = iic$sm_shutdown =
      IF msg^.shutdown.immediate THEN
        abort := shutdown;
        RETURN;
      ELSE
        send_upline_sm (msg, iic$l_shutdown, iic$exec_acn,
              iic$exec_application_name, abort);
      IFEND;
    = iic$sm_block_delivered =
      acn := msg^.block_delivered.connection_number;
      IF connection_currency [acn].unacknowledged_block_count > 0 THEN
      connection_currency [acn].unacknowledged_block_count :=
            connection_currency [acn].unacknowledged_block_count - 1;
      IFEND;

{ If ubc is zero and this connection is to be ended - do it.

      IF (connection_currency [acn].unacknowledged_block_count = 0) AND
            (connection_currency [acn].connection_end_pending) THEN
        PUSH osmsg;
        form_sm (osmsg, iic$sm_end_connection, iic$l_end_connection);
        osmsg^.conend_connection_number := acn;
        osmsg^.conend_fill1 := 0;
        osmsg^.conend_zero2 := conend_zero2;
        net#put (osmsg);
      {!log_vrbl ('delayed end connection', acn, job_dayfile, FALSE);
      IFEND;
    = iic$sm_inactive_connection =
      acn := msg^.inactive_connection.connection_number;
      send_upline_sm (msg, iic$l_inactive_connection, acn, connection_currency
            [acn].application_name_jm, abort);
    = iic$sm_block_not_delivered =
      acn := msg^.block_not_delivered.connection_number;
      IF connection_currency [acn].unacknowledged_block_count > 0 THEN
      connection_currency [acn].unacknowledged_block_count :=
            connection_currency [acn].unacknowledged_block_count - 1;
      IFEND;

{ If ubc is zero and this connection is to be ended - do it.

      IF (connection_currency [acn].unacknowledged_block_count = 0) AND
            (connection_currency [acn].connection_end_pending) THEN
        PUSH osmsg;
        form_sm (osmsg, iic$sm_end_connection, iic$l_end_connection);
        osmsg^.conend_connection_number := acn;
        osmsg^.conend_fill1 := 0;
        osmsg^.conend_zero2 := conend_zero2;
        net#put (osmsg);
      {!log_vrbl ('delayed end connection', acn, job_dayfile, FALSE);
      IFEND;
    = iic$sm_term_char_changed =
      acn := msg^.term_char_redefined.connection_number;
      send_upline_sm (msg, iic$l_term_char_redefined, acn, connection_currency
            [acn].application_name_jm, abort);
    ? IFEND
    ?? SET(LIST:=ON) ??
    = iic$sm_interrupt_user =
      acn := msg^.interrupt_user.connection_number;
      send_upline_sm (msg, iic$l_interrupt_user, acn, connection_currency
            [acn].application_name_jm, abort);
      IF (absentee_read IN connection_currency [acn].connection_state) AND
            (msg^.interrupt_user.alpha < CHR (5)) THEN
{
{ remove absentee read from passon environment - but do not send read reject
{
        connection_currency [acn].connection_state := connection_currency
              [acn].connection_state - $iit$connection_state [absentee_read];
      ? IF ifv$nos_be = false THEN
        PUSH osmsg;
        form_sm (osmsg, iic$sm_list_off, iic$l_list_off);
        osmsg^.list_off.connection_number := acn;
        net#put (osmsg);
      ? IFEND
      IFEND;
    = iic$sm_reset_connection =

{ Enable outputting (disabled by an FC/BRK/R).

      acn := msg^.reset_connection.connection_number;
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state - $iit$connection_state [break_active];
    ELSE
      abort := input_sm;
      dump (abort, #LOC (msg^), 20);
    ? IF ifv$nos_be = true THEN
      IF dump_indicator THEN
         dump_mem (21,abort);
      IFEND;
    ? IFEND
      RETURN;
    CASEND;
  PROCEND modify_upline_connection_status;
?? OLDTITLE ??
?? NEWTITLE := '    procedure modify_downline_connection' ??
?? EJECT ??
{  The purpose of this procedure is to process downline supervisory messages
{    sent from nos/ve to nam.  Certain modifications are made to the
{    passon environment before the message is sent to nam.  Some messages
{    are never sent to nam, as they are meant only for use by passon.

  PROCEDURE modify_downline_connection (msg: ^iit$output_supervisory_message;
        from_application: mlt$application_name;
    VAR abort: iit$passon_failure);

    VAR
    ? IF ifv$nos_be = true THEN
      lng : integer,
      ex : tint$connection_ext,
      user_id : tint$user_id,
      qtr : ^tint$out_table,
    ? IFEND
      osm: iit$output_supervisory_message,
      acn: iit$application_connection_num,
      rle: mlt$receive_index,
      notify,
      begin_absentee: boolean,
      newjm,
      oldjm: mlt$application_name,
      qp: ^iit$sm_queue;

  ? IF ifv$nos_be = true THEN
    IF nam_debug AND (nr_msg>0) THEN
       lng := msg^.header.text_length + 1;
       nr_msg := nr_msg - 1;
       savemsg (msg,lng,2);
    IFEND;
  ? IFEND
  {!log_vrbl (' downline sm ', msg^.message_type, job_dayfile, FALSE);
  {!log_vrbl (' from appl ', from_application, job_dayfile, FALSE);
  {!log_vrbl (' acn ', msg^.connection_accepted.connection_number, job_dayfile,
  {!      FALSE);
    CASE msg^.message_type OF
    = iic$sm_end_connection =
      acn := msg^.conend_connection_number;
    ? IF ifv$nos_be = false THEN
      IF absentee_read IN connection_currency [acn].connection_state THEN
        form_sm (#LOC (osm), iic$sm_list_off, iic$l_list_off);
        osm.list_off.connection_number := acn;
        net#put (#LOC (osm));
      IFEND;
    ? IFEND
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state + $iit$connection_state [connection_ending] -
            $iit$connection_state [absentee_read];
    ? IF ifv$nos_be = false THEN
      IF connection_currency [acn].unacknowledged_block_count = 0 THEN
        net#put (msg);
      ELSE
    ? IFEND

{ Delay the end connection until all blocks have been ack'd.

        connection_currency [acn].connection_end_pending := TRUE;
    ? IF ifv$nos_be = false THEN
     {! log_vrbl ('end connection delayed', acn, job_dayfile, FALSE);
      IFEND;
    ? IFEND

{ Formerly, there was a receive message here to discard any output
{ destined to this acn.  This did not work.  Now we rely
{ on a connection_state of connection_ending to throw data away in
{ procedure send_downline_data. DAH.

    = iic$sm_connection_rejected =
      acn := msg^.connection_rejected.connection_number;
      IF connection_currency [acn].connection_state <> $iit$connection_state
            [wait_connection] THEN
        IF connection_currency [acn].connection_state <> $iit$connection_state
              [wait_connection, broken_connection] THEN
          abort := reject_failure;
          dump (abort, #LOC (connection_currency [acn]), #SIZE
                (connection_currency [acn]));
          RETURN;
        IFEND;
      IFEND;
    ? IF ifv$nos_be = false THEN
      net#put (msg);
    ? ELSE
      connection_currency[acn].connection_ext :=
                 connection_currency[acn].connection_ext
               + $tint$connection_ext[connection_rejected];
    ? IFEND;
      connection_currency [acn].connection_state := $iit$connection_state
            [available_for_use];
    = iic$sm_connection_accepted =
      acn := msg^.connection_accepted.connection_number;
      IF connection_currency [acn].connection_state <> $iit$connection_state
            [wait_connection] THEN
        IF connection_currency [acn].connection_state <> $iit$connection_state
              [wait_connection, broken_connection] THEN
          abort := accept_failure;
          dump (abort, #LOC (connection_currency [acn]), #SIZE
                (connection_currency [acn]));
          RETURN;
        IFEND;
      IFEND;
      connection_currency [acn].application_name_jm := from_application;
    ? IF ifv$nos_be = false THEN
      connection_currency [acn].unacknowledged_block_count := 0;
    ? IFEND
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state - $iit$connection_state [wait_connection] +
            $iit$connection_state [wait_init];
    ? IF ifv$nos_be = false THEN
      net#put (msg);
    ? ELSE
      IF msg^.connection_accepted.character_type <>
                                   iic$8_of_12_bit_characters THEN
         abort := char_type_failed;
         IF dump_indicator THEN
            dump_mem (22,abort);
         IFEND;
         RETURN;
      IFEND;
      connection_currency[acn].connection_ext :=
                 connection_currency[acn].connection_ext
               + $tint$connection_ext[wait_int];
    ? IFEND
    = iic$sm_connection_initialized =
      acn := msg^.connection_initialized.connection_number;
      IF connection_currency [acn].connection_state <> $iit$connection_state
            [wait_init] THEN
        IF connection_currency [acn].connection_state <> $iit$connection_state
              [wait_connection, broken_connection] THEN
          abort := init_failure;
          dump (abort, #LOC (connection_currency [acn]), #SIZE
                (connection_currency [acn]));
          RETURN;
        IFEND;
      IFEND;
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state - $iit$connection_state [wait_init];
    ? IF ifv$nos_be = false THEN
      net#put (msg);
    ? ELSE
      IF init_req IN connection_currency[acn].connection_ext THEN
         connection_currency[acn].connection_ext :=
                    connection_currency[acn].connection_ext
                  - $tint$connection_ext[init_req]
                  + $tint$connection_ext[init_accept];
      ELSE
         abort := init_req_failed;
         IF dump_indicator THEN
            dump_mem (23,abort);
         IFEND;
      IFEND;
    ? IFEND
    ? IF ifv$nos_be = false THEN
    = iic$sm_reset_connection =
      acn := msg^.reset_connection.connection_number;
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state - $iit$connection_state [break_active, stopped];
      net#put (msg);
    ? IFEND
    = iic$sm_hold =
      acn := msg^.hold.connection_number;
{
{ send hold acknowledge - hold takes affect when acknowledge is sent to
{   the nos/ve task.
{
      form_sm (msg, iic$sm_hold_acknowlege, iic$l_hold_acknowlege);
      send_upline_sm (#LOC (msg^), iic$l_hold_acknowlege, acn,
            connection_currency [acn].application_name_jm, abort);
    = iic$sm_terminate =
      {Job is terminating - ignore all io traffic
      acn := msg^.terminate.connection_number;
      log_vrbl ('Job termination requested', acn, job_dayfile, FALSE);
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state + $iit$connection_state [terminate];
    ? IF ifv$nos_be = false THEN
      IF absentee_read IN connection_currency [acn].connection_state THEN
        connection_currency [acn].connection_state := connection_currency
              [acn].connection_state - $iit$connection_state [absentee_read];
        form_sm (msg, iic$sm_list_off, iic$l_list_off);
        msg^.list_off.connection_number := acn;
        net#put (msg);
      IFEND;
      connection_currency [acn].unacknowledged_block_count := 0;
    ? IFEND
    = iic$sm_unhold =
      acn := msg^.unhold.connection_number;
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state - $iit$connection_state [connection_hold];
    = iic$sm_read_request =
      acn := msg^.read_request.connection_number;
      begin_absentee := msg^.read_request.begin_absentee;
      notify := msg^.read_request.notify_if_absentee_started;
    ? IF ifv$nos_be = true THEN
      ex := connection_currency[acn].connection_ext;
      IF ex*$tint$connection_ext[input_available,input_suppress,input_req]
         = $tint$connection_ext[] THEN
         downline_sm (acn,cint$termout_ico);
      IFEND;
    ? IFEND
      begin_data_read (acn, begin_absentee, notify, from_application, abort);
    = iic$sm_change_job_monitor =
      acn := msg^.changejm_connection_number;
      newjm := msg^.changejm_new_jm;
      oldjm := connection_currency [acn].application_name_jm;
      connection_currency [acn].application_name_jm := newjm;
      qp := connection_currency [acn].front_queued_sm_ptr;
      WHILE qp <> NIL DO
        IF qp^.application_name = oldjm THEN
          qp^.application_name := newjm;
        IFEND;
        qp := qp^.front;
      WHILEND;
{
{ force unhold here
{
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state - $iit$connection_state [connection_hold];
      form_sm (msg, iic$sm_job_monitor_changed, iic$l_job_monitor_changed);
      send_upline_sm (#LOC (msg^), iic$l_job_monitor_changed, acn, newjm,
            abort);
    = iic$sm_stop_interactive =
      abort := nosve_stop_interactive;
      RETURN;
    ? IF ifv$nos_be = false THEN
    = iic$sm_redefine_term_char, iic$sm_start_input, iic$sm_stop_input,
          iic$sm_change_character_type, iic$sm_list_on,
            iic$sm_list_switch, iic$sm_message_to_operator,
            iic$sm_interrupt_response =
      net#put (msg);
    = iic$sm_break =

{ Inhibit outputting until an FC/RST/R is received. }

      acn := msg^.break.connection_number;
      connection_currency [acn].connection_state := connection_currency [acn].
            connection_state + $iit$connection_state [break_active];
      connection_currency [acn].unacknowledged_block_count := 0;
      net#put (msg);
    = iic$sm_list_off =
      acn := msg^.list_off.connection_number;
      connection_currency[acn].connection_state :=
                 connection_currency[acn].connection_state
               - $iit$connection_state[absentee_read];
      net#put (msg);
    ? ELSE
    = iic$sm_list_off =
      acn := msg^.list_off.connection_number;
      connection_currency[acn].connection_state :=
                 connection_currency[acn].connection_state
               - $iit$connection_state[absentee_read];
    = iic$sm_list_on,iic$sm_list_switch =
    = iic$sm_interrupt_response =
      acn := msg^.interrupt_response.connection_number;
      IF user_break_as IN connection_currency[acn].connection_ext THEN
         connection_currency[acn].connection_ext :=
                    connection_currency[acn].connection_ext
                  + $tint$connection_ext[user_break_akn]
                  - $tint$connection_ext[user_break_as];
      ELSE
         abort := break_req_failed;
         IF dump_indicator THEN
            dump_mem (24,abort);
         IFEND;
      IFEND;
    = iic$sm_break =
{     iic$sm_break is treated as a NO-OP in nosbe.
    ? IFEND
    = iic$sm_start_interactive =
      log (' start interactive on the fly ', job_dayfile, FALSE);
      form_sm (msg, iic$sm_interactive_started, iic$l_interactive_started);
      send_upline_sm (#LOC (msg^), iic$l_interactive_started, iic$exec_acn,
            iic$exec_application_name, abort);
    ELSE
      abort := bad_downline_sm;
      dump (abort, #LOC (msg^), 20);
    ? IF ifv$nos_be = true THEN
      IF dump_indicator THEN
         dump_mem (25,abort);
      IFEND;
    ? IFEND
      RETURN;
    CASEND;
  PROCEND modify_downline_connection;
?? OLDTITLE ??
?? NEWTITLE := ' nam passon main program' ??
?? EJECT ??
{
{  PASSON MAIN PROGRAM
  ?IF ifv$module_for_c180 = FALSE THEN

    PROGRAM nam_passon;
  ?ELSE

    PROCEDURE [XDCL, #GATE] nam_passon;
    ?IFEND
  ? IF ifv$nos_be = false THEN
    getword (0, #LOC (ra_word_0));
  ? ELSE
    idle_last := false;
    idle_down := false;
    shut_last := false;
    shut_down := false;
    connct;
    callmuj (#LOC(com));
    setup (#LOC(analyst_id),nr_msg,#LOC(msg),
           #LOC(connection_currency[0]),#LOC(com));
    IF nr_msg <> 0 THEN
       get_debug_directives (#LOC(msg));
       dump_indicator := ra_word_0.sw4;
    IFEND;
    i := 0;
  ? IFEND
    mli_debug := ra_word_0.sw3;
    nam_debug := ra_word_0.sw1;
    passon_debug := ra_word_0.sw2;
    pacer_kludge_enabled := ra_word_0.sw4;
  ? IF ifv$nos_be THEN
    trace_mli := mli_debug AND nam_debug;
  ? IFEND
    IF mli_debug THEN
      initmli (1);
    ELSE
      initmli (0);
    IFEND;

  /continue_passon_after_shutdown/
    WHILE TRUE DO
    /passon/
      BEGIN
        msg_displayed := FALSE;

      /signon/
        WHILE TRUE DO
          mlp$sign_on (iic$passon_application_name, mlc$max_queued_messages,
                unique, status);
          IF (status.condition IN mli_retry_status) OR (status.condition =
                mlc$nosve_not_up) THEN
            IF NOT msg_displayed THEN
              log (' waiting for nos/ve    ', b_display, FALSE);
              msg_displayed := TRUE;
            IFEND;
          ? IF ifv$nos_be = true THEN
            IF status.condition = mlc$nosve_not_up THEN
               i := i + 1;
               IF i = 20 THEN
                  no_nosve;
                  EXIT /passon/;
               IFEND;
            IFEND;
          ? IFEND
            pause (long_pause);
            CYCLE /signon/;
          IFEND;
          IF status.condition IN mli_fatal_status THEN
            abort := signon_failed;
            dump (abort, #LOC (status), #SIZE (status));
          ? IF ifv$nos_be = true THEN
            no_nosve;
          ? IFENd
            EXIT /passon/;
          IFEND;
          EXIT /signon/;
        WHILEND /signon/;

      /addspl/
        WHILE TRUE DO
          mlp$add_sender (iic$passon_application_name, mlc$null_name, status);
          IF status.condition IN mli_retry_status THEN
            pause (short_pause);
            CYCLE /addspl/;
          IFEND;
          IF status.condition IN mli_fatal_status THEN
            abort := addspl_failed;
            dump (abort, #LOC (status), #SIZE (status));
          ? IF ifv$nos_be = true THEN
            no_nosve;
          ? IFEND
            EXIT /passon/;
          IFEND;
          EXIT /addspl/;
        WHILEND /addspl/;
        log (' c180/mli connected', job_dayfile, FALSE);

  { send start interactive to exec (in case this is a passon restart)

        REPEAT
          abort := okee_dokee;
          form_sm (#LOC (msg), iic$sm_start_interactive,
                iic$l_start_interactive);
          mlp$send_message (iic$passon_application_name,
                iic$input_supervisory_message, signal, #LOC (msg),
                (iic$l_start_interactive + 1) * iic$mli_multiplier,
                iic$exec_application_name, status);
          IF status.condition <> mlc$ok THEN
            log (' waiting for exec', b_display, FALSE);
            pause (long_pause);
          IFEND;
        UNTIL status.condition = mlc$ok;
        msg_displayed := FALSE;

      /wait_exec/
        WHILE TRUE DO
          mlp$receive_message (iic$passon_application_name, arbinfo, signal, #LOC
                (msg), length_returned, #SIZE (msg), 0, nosve_application,
                status);
          IF status.condition IN mli_retry_status THEN
            IF NOT msg_displayed THEN
              log (' waiting for exec', b_display, FALSE);
              msg_displayed := TRUE;
            IFEND;
            pause (long_pause);
            CYCLE /wait_exec/;
          IFEND;
          IF status.condition IN mli_fatal_status THEN
            abort := waiting_exec;
            dump (abort, #LOC (status), #SIZE (status));
          ? IF ifv$nos_be = true THEN
            no_nosve;
          ? IFEND
            EXIT /passon/;
          IFEND;
          IF (arbinfo <> iic$output_supervisory_message) OR (nosve_application <>
                iic$exec_application_name) THEN
            log (' wait exec - garbage ignored ', job_dayfile, FALSE);
            CYCLE /wait_exec/;
          IFEND;
          posm := #LOC (msg);
          IF posm^.message_type <> iic$sm_start_interactive THEN
            log (' wait exec - garbage ignored ', job_dayfile, FALSE);
            CYCLE /wait_exec/;
          IFEND;
          EXIT /wait_exec/;
        WHILEND /wait_exec/;
        log (' exec connected ', job_dayfile, FALSE);
        msg_displayed := FALSE;

    ?  IF ifv$nos_be = true THEN
    ?? SET(LIST:=OFF) ??
    ?  ELSE
      /wait_neton/
        WHILE TRUE DO
          net#on (nam_application_name, #LOC (comm_word), #LOC (nam_status),
                iic$min_connection_number, iic$passon_max_cn);
          IF nam_status <> 0 THEN
            log_vrbl (' nam status ', nam_status, job_dayfile, FALSE);
            IF NOT msg_displayed THEN
              log (' waiting for network', b_display, FALSE);
              msg_displayed := TRUE;
            IFEND;
            pause (long_pause);
            CYCLE /wait_neton/;
          ELSE
            EXIT /wait_neton/;
          IFEND;
        WHILEND /wait_neton/;
        IF nam_debug THEN
          net#dbg (0, 0, #LOC (i));
          IF i <> 0 THEN
            abort := netdbg_failed;
            EXIT /passon/;
          IFEND;
          net#stc (0, #LOC (i));
          IF i <> 0 THEN
            abort := netstc_failed;
            EXIT /passon/;
          IFEND;
        IFEND;
      ? IFEND
      ?? SET(LIST:=ON) ??
        form_sm (#LOC (msg), iic$sm_interactive_started,
              iic$l_interactive_started);
        send_upline_sm (#LOC (msg), iic$l_interactive_started, iic$exec_acn,
              iic$exec_application_name, abort);
        IF abort <> okee_dokee THEN
        ? IF ifv$nos_be = true THEN
          no_nosve;
        ? IFEND
          EXIT /passon/;
        IFEND;
  {
  { Begin PASSON processing
  {
        log (' passon passing ', b_display, FALSE);

      /main_loop/
        WHILE TRUE DO
          work_done := FALSE;
        ? IF ifv$nos_be = true THEN
          termin_search;
          IF abort <> okee_dokee THEN
             set_passon_abnormal (abort);
             IF abort <> okee_dokee THEN
                EXIT /passon/;
             IFEND;
          IFEND;
          connection_tour;
          IF abort <> okee_dokee THEN
             set_passon_abnormal (abort);
             IF abort <> okee_dokee THEN
                EXIT /passon/;
             IFEND;
          IFEND;
        ?? SET(LIST:=OFF) ??
        ? ELSE
          ?IF ifv$module_for_c180 = TRUE THEN
            IF comm_word [sm_available] THEN
          ?ELSE
            REPEAT
            ?IFEND
            { must ALWAYS make this call - to update
            { comm_word [input_avail] - used below.
            fetch_upline_sm (#LOC (msg), abort);
            IF abort <> okee_dokee THEN
              IF abort = shutdown THEN
                EXIT /passon/;
              IFEND;
              set_passon_abnormal (abort);
              IF abort <> okee_dokee THEN
                EXIT /passon/;
              IFEND;
            IFEND;
            ?IF ifv$module_for_c180 = TRUE THEN
            IFEND;
            ?ELSE
            UNTIL NOT comm_word [sm_available];
          ?IFEND
            { The following test assumes that the fetch_upline_sm call above
            { has updated comm_word.
            IF comm_word [data_available] THEN
              abort_poll := FALSE;
              REPEAT
                poll_for_absentee_reads (#LOC (msg), abort);
                IF abort <> okee_dokee THEN
                  set_passon_abnormal (abort);
                  IF abort <> okee_dokee THEN
                    EXIT /passon/;
                  IFEND;
                IFEND;
              UNTIL (NOT comm_word [data_available]) OR abort_poll;
            IFEND;
          ?  IFEND
          ?? SET(LIST:=ON) ??
          IF queued_sm_count > 0 THEN
  {
  { find next queued sm
  {

          /search_sm/
            FOR i := 0 TO iic$passon_max_cn DO
              IF connection_currency [next_queued_sm_acn].front_queued_sm_ptr <>
                    NIL THEN
                send_queued_upline_sm (next_queued_sm_acn, abort);
                work_done := TRUE;
                IF abort <> okee_dokee THEN
                  set_passon_abnormal (abort);
                  IF abort <> okee_dokee THEN
                    EXIT /passon/;
                  IFEND;
                IFEND;
                next_queued_sm_acn := (next_queued_sm_acn + 1) MOD
                      (iic$passon_max_cn + 1);
                EXIT /search_sm/;
              ELSE
                next_queued_sm_acn := (next_queued_sm_acn + 1) MOD
                      (iic$passon_max_cn + 1);
              IFEND;
            FOREND /search_sm/;
          IFEND;
          IF queued_data_count > 0 THEN
  {
  { find next queued data message
  {

          /search_data/
            FOR i := 0 TO iic$passon_max_cn DO
              IF connection_currency [next_queued_data_acn].front_queued_data_ptr
                    <> NIL THEN
                send_queued_upline_data (next_queued_data_acn, abort);
                work_done := TRUE;
                IF abort <> okee_dokee THEN
                  set_passon_abnormal (abort);
                  IF abort <> okee_dokee THEN
                    EXIT /passon/;
                  IFEND;
                IFEND;
                next_queued_data_acn := (next_queued_data_acn + 1) MOD
                      (iic$passon_max_cn + 1);
                EXIT /search_data/;
              ELSE
                next_queued_data_acn := (next_queued_data_acn + 1) MOD
                      (iic$passon_max_cn + 1);
              IFEND;
            FOREND /search_data/;
          IFEND;
          retry_count := 0;

        /downline/
          BEGIN

          /wait_fetch/
            WHILE TRUE DO
              mlp$fetch_receive_list (iic$passon_application_name, mlc$null_name,
                    receive_list, receive_count, status);
            ? IF ifv$nos_be = true THEN
              IF trace_mli AND (nr_msg>0) THEN
                 i := 4*receive_count;
                 savemsg (#LOC(receive_list),i,9);
                 nr_msg := nr_msg - 1;
              IFEND;
            ? IFEND
              IF status.condition IN mli_retry_status THEN
                retry_count := retry_count + 1;
                IF retry_count > iic$retry_count THEN
                  EXIT /downline/;
                IFEND;
                pause (short_pause);
                CYCLE /wait_fetch/;
              IFEND;
              IF status.condition IN mli_fatal_status THEN
                abort := downline_failure;
                dump (abort, #LOC (status), #SIZE (status));
                set_passon_abnormal (abort);
                IF abort <> okee_dokee THEN
                  EXIT /passon/;
                IFEND;
              IFEND;
              EXIT /wait_fetch/;
            WHILEND /wait_fetch/;
          ? IF ifv$nos_be = false THEN
            IF receive_count < 4 THEN
               MLV$MLI := 24;
            ELSEIF receive_count < 8 THEN
               MLV$MLI := 12;
            ELSE
               MLV$MLI := 8;
            IFEND;
          ? IFEND

          /process_downline/
            FOR i := 1 TO receive_count DO
  {
  { allow downline data only if abl is not exceeded
  {
              signal_180 := signal;
              IF receive_list [i].arbitrary_info >= iic$dont_signal THEN
                 receive_list [i].arbitrary_info := receive_list [i].arbitrary_info -
                    iic$dont_signal;
                 signal_180 := NIL;
              IFEND;
              IF receive_list [i].arbitrary_info >= iic$output_data_message THEN
                j := receive_list [i].arbitrary_info - iic$output_data_message;
              ? IF ifv$nos_be = false THEN
                IF (connection_currency [j].unacknowledged_block_count >=
                      connection_currency [j].application_block_limit) THEN
              ? ELSE
                IF (user_break_out IN connection_currency[j].connection_ext) OR
                   (output_wait IN connection_currency[j].connection_ext) THEN
                   IF trace_mli AND (nr_msg>0) THEN
                      savemsg(#LOC(connection_currency[j].connection_ext),1,11);
                      nr_msg := nr_msg - 1;
                   IFEND;
              ? IFEND
                  CYCLE /process_downline/;
                IFEND;

                IF connection_currency [j].connection_state>= $iit$connection_state [wait_init] THEN
                  CYCLE /process_downline/;
                IFEND;

                IF (connection_currency [j].connection_state * $iit$connection_state [break_active]) <>
                      $iit$connection_state [] THEN
                    CYCLE /process_downline/;
                IFEND;

              IFEND;
              receive_index := receive_list [i].receive_index;
              retry_count := 0;

            /wait_downline/
              WHILE TRUE DO
                mlp$receive_message (iic$passon_application_name, arbinfo,
                      signal_180, #LOC (msg), length_returned, #SIZE (msg),
                      receive_index, nosve_application, status);
              ? IF ifv$nos_be = true THEN
                IF trace_mli AND (nr_msg>0) THEN
                   savemsg (#LOC(msg),1,10);
                   nr_msg := nr_msg - 1;
                IFEND;
              ? IFEND
                IF status.condition IN mli_retry_status THEN
                  IF status.condition = mlc$receive_list_index_invalid THEN
                    EXIT /process_downline/;
                  IFEND;
                  retry_count := retry_count + 1;
                  IF retry_count > iic$retry_count THEN
                    EXIT /process_downline/;
                  IFEND;
                  pause (short_pause);
                  CYCLE /wait_downline/;
                IFEND;
                IF status.condition IN mli_fatal_status THEN
                  abort := downline_failure;
                  dump (abort, #LOC (status), #SIZE (status));
                  set_passon_abnormal (abort);
                  IF abort <> okee_dokee THEN
                    EXIT /passon/;
                  IFEND;
                IFEND;
                EXIT /wait_downline/;
              WHILEND /wait_downline/;
              work_done := TRUE;
              IF arbinfo >= iic$dont_signal THEN
                 arbinfo := arbinfo - iic$dont_signal;
              IFEND;
              IF arbinfo >= iic$output_data_message THEN
                arbinfo := iic$output_data_message;
              IFEND;
              CASE arbinfo OF
              = iic$output_data_message =
              ? IF ifv$nos_be = true THEN
                send_downline_data (#LOC(msg),#LOC(msg));
              ? ELSE
                send_downline_data (#LOC (msg));
              ? IFEND
                IF abort <> okee_dokee THEN
                  set_passon_abnormal (abort);
                  IF abort <> okee_dokee THEN
                    EXIT /passon/;
                  IFEND;
                IFEND;
              = iic$output_supervisory_message =
                modify_downline_connection (#LOC (msg), nosve_application,
                      abort);
                IF abort <> okee_dokee THEN
                  IF abort = nosve_stop_interactive THEN
                    EXIT /passon/;
                  IFEND;
                  set_passon_abnormal (abort);
                  IF abort <> okee_dokee THEN
                    EXIT /passon/;
                  IFEND;
                IFEND;
              ELSE
                abort := arbinfo_failure;
                dump (abort, #LOC (arbinfo), #SIZE (arbinfo));
                set_passon_abnormal (abort);
                IF abort <> okee_dokee THEN
                  EXIT /passon/;
                IFEND;
              CASEND;
            FOREND /process_downline/;
          END /downline/;
          IF NOT work_done THEN
            pause (short_pause);
          IFEND;
          work_done := FALSE;
          check_operator := check_operator + 1;
          IF check_operator = 50 THEN
            check_operator := 0;
            getword (0, #LOC (ra_word_0));
          ? IF ifv$nos_be = true THEN
            idle_down := ra_word_0.sw5;
            shut_down := ra_word_0.sw6;
            IF shut_down AND NOT shut_last THEN
               shut_last := true;
               FOR j := 1 TO iic$passon_max_cn DO
                 IF connection_currency[j].fet_6.user_id <> 0 THEN
                    connection_currency[j].connection_ext :=
                               connection_currency[j].connection_ext
                             + $tint$connection_ext[shut_ind];
                 IFEND;
               FOREND;
               IF NOT idle_last THEN
                  idle_down := true;
               IFEND;
            IFEND;
            IF idle_down AND NOT idle_last THEN
               idle_last := true;
               FOR j := 1 TO iic$passon_max_cn DO
                 IF connection_currency[j].fet_6.user_id <> 0 THEN
                    connection_currency[j].connection_ext :=
                               connection_currency[j].connection_ext
                             + $tint$connection_ext[idle_ind];
                 IFEND;
               FOREND;
            IFEND;
          ?? SET(LIST:=OFF) ??
          ? ELSE
            IF ra_word_0.sw1 THEN
              IF NOT nam_debug THEN
  { turn on
                nam_debug := TRUE;
                net#dbg (0, 0, #LOC (i));
                net#stc (0, #LOC (i));
              IFEND;
            ELSE
              IF nam_debug THEN
  { turn off
                nam_debug := FALSE;
                net#dbg (1, 1, #LOC (i));
                net#stc (1, #LOC (i));
              IFEND;
            IFEND;
          ? IFEND
          ?? SET(LIST:=ON) ??
            passon_debug := ra_word_0.sw2;
            IF ra_word_0.sw3 THEN
              IF NOT mli_debug THEN
  { turn on
                mli_debug := TRUE;
                initmli (1);
              IFEND;
            ELSE
              IF mli_debug THEN
  { turn off
                mli_debug := FALSE;
                initmli (0);
              IFEND;
            IFEND;
            pacer_kludge_enabled := ra_word_0.sw4;
          IFEND;
        ? IF ifv$nos_be = true THEN
          IF nam_debug AND (nr_msg=0) THEN
             savemsg (#LOC(MSG),-1,0);
             nr_msg := -1;
          IFEND;
          IF nr_of_users = 0 THEN
             end_counter := end_counter - 1;
             IF end_counter = 0 THEN
                EXIT /passon/;
             IFEND;
             pause (short_pause);
          IFEND;
        ? IFEND
        WHILEND /main_loop/;
      END /passon/;
      passon_debug := TRUE;
      IF abort <> okee_dokee THEN
        log_vrbl (' passon status', ORD (abort), job_dayfile, FALSE);
        log_vrbl (' last mli status ', status.condition, job_dayfile, FALSE);
      IFEND;
  {
  { bring PASSON down
  {
    ? IF ifv$nos_be = false THEN
      net#off;
    ? ELSE
      discon;
      mmove (#LOC(predef_asm[5]),#LOC(msg),2);
      IF nam_debug AND (nr_msg>=0) THEN
         savemsg (#LOC(MSG),-1,0);
      IFEND;
    ? IFEND
      mlp$sign_off (iic$passon_application_name, status);
      IF abort = shutdown THEN
        abort := okee_dokee;
        FOR connection_number := 1 TO iic$passon_max_cn DO

{ Make all PASSON connections available for use.

          connection_currency [connection_number].connection_state :=
                $iit$connection_state [available_for_use];
        FOREND;
      ELSE
        EXIT /continue_passon_after_shutdown/;
      IFEND;
    WHILEND /continue_passon_after_shutdown/;
    IF (abort <> okee_dokee) AND (abort <> nosve_stop_interactive) THEN
      log ('$passon failure', b_display, FALSE);
      ?IF ifv$module_for_c180 = FALSE THEN
        WHILE TRUE DO
          pause (short_pause);
        WHILEND;
      ?IFEND
    IFEND;
  PROCEND nam_passon;
MODEND iim$nam_passon
