MODULE mlp$mli_subsystem;
*copyc OSD$DEFAULT_PRAGMATS


{ The purpose of this module is to control all A170 jobs using the NOS/VE
{ memory link.  Only the MLISS can issue signon and signoff requests.
{ All A170 jobs that are signed on to the memory link have a long term
{ connection with the MLISS so that their termination will be
{ detected and the MLI will be cleaned up properly.  If the MLISS
{ terminates, then all A170 jobs using the MLI will be terminated and
{ the MLI environment will be cleaned up.
{
{ MLISS sense switch usage:
{
{ ONSW2 - enables the MLISS dayfile diagnostics.
{
{ ONSW3 - enables the MLISS snap file stuff.
{


?? PUSH (LISTEXT := ON) ??
*copyc ifd$machine_definition

  ?IF ifv$module_for_c180 = TRUE THEN
*copy OST$STATUS
  ?ELSE
*copy OST$STRING

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

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

  ?IFEND
*copyc dsp$check_if_ve_running
*copyc MLP$SIGN_ON
*copyc MLP$SIGN_OFF
*copyc MLT$C170_RQST_BLK
*copyc MLT$ANT_ENTRY
*copyc MLD$MEMORY_LINK_DECLARATIONS
*copyc MLT$PARTNER_JOB_UNIQUE_ID
*copyc ICP$PARTNER_JOB_EXEC_REAL

PROCEDURE [XREF] rhp$partner_job_exec;
*copyc ZUTPS2D
*copyc ZN7PMSG
?? POP ??

?? OLDTITLE, NEWTITLE := 'TYPE DECLARATIONS', EJECT ??

  TYPE

{ UCP/SCP communication definitions.

    t#ucp_param_word = packed record
      rss: 0 .. 0ffffff(16),
      rin: 0 .. 0fff(16),
      wc: 0 .. 3f(16),
      rcdc: 0 .. 0f(16),
      b13: boolean,
      b12: boolean,
      ec: 0 .. 3f(16),
      rsv: 0 .. 3(16),
      es3: boolean,
      es2: boolean,
      es1: boolean,
      c: boolean,
    recend,

{ Note: This record definition differs slightly from the actual SCP
{definition.

    t#job_id_word = packed record
      jsn: 0 .. 0ffffff(16),
      jsn2: 0 .. 0fff(16), { jsn is left justified }
      zero1: 0 .. 0fff(16),
      fst: 0 .. 0fff(16),
    recend,

    t#ssf_param_block = packed record
      rc: 0 .. 3f(16),
      fp: 0 .. 0fff(16),
      ucpa: 0 .. 3ffff(16),
      scpa: 0 .. 3ffff(16),
      fc: 0 .. 3f(16),
      jid: t#job_id_word,
      u: boolean,
      s: boolean,
      rsv1: 0 .. 3ff(16),
      eucpa: 0 .. 0ffffff(16),
      escpa: 0 .. 0ffffff(16),
    recend,

    t#ssf_stat_response = packed record
      rc: 0 .. 3f(16),
      zero: 0 .. 3f(16),
      priv_program: boolean,
      priv_user: boolean,
      long_term_connect: boolean,
      request_count: 0 .. 7,
      ucpa: 0 .. 3ffff(16),
      scpa: 0 .. 3ffff(16),
      fc: 0 .. 3f(16),
    recend,

    t#ucp_param_block = record
      ctrl: t#ucp_param_word,
      data: array [1 .. c#data_block_length] of integer,
    recend,

    t#sscr_word = packed record
      i: boolean,
      p: boolean,
      zero: 0 .. 0f(16),
      xp: 0 .. 3ffff(16),
      v: boolean,
      lp: 0 .. 1ffff(16),
      ap: 0 .. 3ffff(16),
    recend,

    t#scp_ap0_word = packed record
      resv1: 0 .. 0fff(16),
      resv2: 0 .. 0ffffff(16),
      status: 0 .. 3f(16),
      addr: 0 .. 3ffff(16),
    recend,

    t#scp_param_block = record
      ap0: t#scp_ap0_word,
      ap1: t#job_id_word,
      data: array [1 .. c#data_block_length] of integer,
    recend,

    t#ssiw_word = packed record
      name: 0 .. 3ffffffffff(16),
      qp: 0 .. 3ffff(16),
    recend,

{ Note:  This record defines the response block for an sf.cpid request.

    cpid_response = packed record
      family_name: string (5),
      user_name: string (5),
      filler1: string (4),
      filler2: 0 .. 7ff(16),
      validated: boolean,
    recend,

{ Subsystem type declarations.

    t#jsn_entry = record
      jsn: integer,
      count: integer,
      job_id_word: t#job_id_word,
    recend,

{ Kludge for RH batch origin jobs.
    t#partner_job_entry = record
      job_unique_id: mlt$partner_job_unique_id,
      sign_on_state: mlt$job_sign_on_state,
      remote_host_job: boolean,
    recend;

?? OLDTITLE, NEWTITLE := 'CONSTANT DECLARATIONS', EJECT ??

  CONST

{ SSF function codes.

    c#sf_regr = 2,
    c#sf_endt = 6,
    c#sf_read = 8,
    c#sf_stat = 10,
    c#sf_writ = 12,
    c#sf_exit = 14,
    c#sf_swpo = 20,
    c#sf_swpi = 22,
    c#sf_sltc = 24,
    c#sf_cltc = 26,
    c#sf_list = 28,
    c#sf_xred = 32,
    c#sf_xlst = 34,
    c#sf_xwrt = 36,
    c#sf_cpid = 38,

{ System to SCP status codes.

    c#normal_msg = 0,
    c#ucp_ended = 1,
    c#ucp_aborted = 2,
    c#forcibly_broken = 3,
    c#scp_aborted = 4,

{ Regrets function error codes.

    c#normal_error = 1,
    c#hostile_user_error = 2,

{ Low core constants.

    c#ssiw = 40,
    c#sscr = 41,

{ Miscellaneous constants.

    c#data_block_length = 100,
    c#user_dayfile = 3,
    c#b_dayfile = 2,
    c#swapout_max = 60,

{ Parameter positions in the MLI parameter block.

    c#aname = aname + 2,
    c#sname = sname + 2,
    c#status = pstatus + 2,
    c#funct = funct + 2,
    c#rindex = rindex + 2,
    c#fwa = fwa + 2,
    c#buflen = buflen + 2,
    c#signal = signal + 2,
    c#arbinfo = arbinfo + 2,
    c#msglen = msglen + 2,
    c#mlpsv = mlpsv + 2,
    c#mlpv1 = mlpv1 + 2,
    c#mlpv2 = mlpv2 + 2,
    c#mlpv3 = mlpv3 + 2,
    c#maxmsg = c#rindex,
    c#count = c#rindex,
    c#jsn = c#fwa,

{ MLI request function codes.

    c#signon = signon,
    c#signoff = signoff,
    c#addspl = addspl,
    c#delspl = delspl,
    c#send = send,
    c#receive = receive,
    c#fetchrl = fetchrl,
    c#confirm = confirm,
    c#kill = kill,
    c#kill_all = kill_all,
    c#swapout_ucp = swapout_ucp,

{ SSF error codes.

    e#ucp_address_error = 35,
    e#job_swapped_out = 36;

?? OLDTITLE, NEWTITLE := 'PROCEDURE call_snap', EJECT ??

  PROCEDURE call_snap (p: ^cell;
        l: integer);

    IF snap_debug THEN
      snap (p, l);
    ELSE
      RETURN;
    IFEND;

  PROCEND call_snap;

?? OLDTITLE, NEWTITLE := 'PROCEDURE expunge', EJECT ??

  PROCEDURE expunge;

{ Terminate the SCP.

    IF nosbe THEN
      RETURN; { compass subroutine *endprgr* does sf.exit processing }
    IFEND;

    ssf_req.jid.jsn := 0;
    ssf_req.jid.jsn2 := 0;
    ssf_req.jid.fst := 0;
    ssf_req.fc := c#sf_exit;
    ssf_req.rc := 0;
    ssf_req.fp := 0;
    sfcall (^ssf_req);

{ This code should never execute - the c#sf_exit will abort the job step.


  PROCEND expunge;

?? OLDTITLE, NEWTITLE := 'PROCEDURE hang', EJECT ??

  PROCEDURE hang;

    snap_debug := TRUE;
    mliss_debug := TRUE;
    log (save_dayfile, c#user_dayfile);
    call_snap (^ssf_req, #SIZE (ssf_req));
    call_snap (^request, 15);
    call_snap (^jsn_list, #SIZE (jsn_list));
    call_snap (^mlv$jsn, 1);
    call_snap (^status, 1);
    log ('$subsystem failure', c#b_dayfile);
    WHILE TRUE DO
      pause (1);
    WHILEND;

  PROCEND hang;

?? OLDTITLE, NEWTITLE := 'PROCEDURE log', EJECT ??

  PROCEDURE log (s: string ( * );
        dayfile: 0 .. 7);

    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 mliss_debug) AND (dayfile = c#user_dayfile) THEN
      save_dayfile := s;
      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);
    IF dayfile = c#b_dayfile THEN
      n7p$issue_dayfile_message (#LOC (dcm), c#user_dayfile);
    IFEND;

  PROCEND log;

?? OLDTITLE, NEWTITLE := 'PROCEDURE log_vrbl', EJECT ??

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

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

    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);

  PROCEND log_vrbl;

?? OLDTITLE, NEWTITLE := 'PROCEDURE search_for_jsn', EJECT ??

  PROCEDURE search_for_jsn (jsn: integer;
    VAR index: integer);

    VAR
      i: integer;

    index := 0;
    FOR i := 1 TO mlc$max_ant_entries DO
      IF jsn_list [i].jsn = jsn THEN
        index := i;
        RETURN;
      ELSEIF jsn_list [i].jsn = 0 THEN
        IF index = 0 THEN
          index := - i;
        IFEND;
      IFEND;
    FOREND;

  PROCEND search_for_jsn;

?? OLDTITLE, NEWTITLE := 'PROCEDURE write_to_ucp', EJECT ??

  PROCEDURE write_to_ucp (ucpa: integer;
        pscpa: ^cell;
        length: integer);

    VAR
      scpa: integer;

    pointer_to_integer (pscpa, scpa);

  /writ_loop/
    WHILE TRUE DO
    ssf_req.jid := request.ap1;
    ssf_req.fc := c#sf_writ;
    ssf_req.rc := 0;
    ssf_req.ucpa := ucpa;
    ssf_req.scpa := scpa;
    ssf_req.fp := length;
    sfcall (^ssf_req);
    IF ssf_req.rc <> 0 THEN
      log_vrbl ('write ucp err', ssf_req.rc, c#user_dayfile);
      IF ssf_req.rc = e#ucp_address_error THEN

{ Abort the UCP.
          EXIT /writ_loop/;

      ELSEIF ssf_req.rc = e#job_swapped_out THEN

{ Issue swapin and retry the writ.

          ssf_req.fc := c#sf_swpi;
          ssf_req.rc := 0;
          sfcall (^ssf_req);
          pause (1);
          CYCLE /writ_loop/;

        ELSE
          hang;
        IFEND;
      ELSE
        EXIT /writ_loop/;
      IFEND;
    WHILEND /writ_loop/;

  PROCEND write_to_ucp;

?? OLDTITLE, NEWTITLE := 'PROCEDURE integer_to_pointer', EJECT ??

  PROCEDURE integer_to_pointer (i: integer;
    VAR p: ^cell);

    VAR
      pi: ^integer;

    pi := #LOC (p);
    pi^ := i;

  PROCEND integer_to_pointer;

?? OLDTITLE, NEWTITLE := 'PROCEDURE pointer_to_integer', EJECT ??

  PROCEDURE pointer_to_integer (p: ^cell;
    VAR i: integer);

    VAR
      pi: ^integer;

    pi := #LOC (p);
    i := pi^;

  PROCEND pointer_to_integer;

?? OLDTITLE, NEWTITLE := 'PROCEDURE mlp$find_signed_on_job', EJECT ??

  PROCEDURE [XDCL] mlp$find_signed_on_job ALIAS 'mlpfsoj'
    (partner_job_unique_id: mlt$partner_job_unique_id;
    VAR find_status: mlt$find_status);

    VAR
      i: integer;

    find_status := mlc$job_not_signed_on;
    FOR i := 1 TO mlc$max_ant_entries DO
      IF jsn_list [i].jsn = partner_job_unique_id THEN
        find_status := mlc$job_signed_on;
        RETURN;
      IFEND;
    FOREND;

  PROCEND mlp$find_signed_on_job;

?? OLDTITLE, NEWTITLE := 'PROCEDURE mlp$terminate_signed_on_job', EJECT ??

  PROCEDURE [XDCL] mlp$terminate_signed_on_job ALIAS 'mlptsoj'
    (partner_job_unique_id: mlt$partner_job_unique_id;
    VAR terminate_status: mlt$terminate_status);

    VAR
      i: integer,
      status: ost$status;

    terminate_status := mlc$no_term_not_signed_on;
    FOR i := 1 TO mlc$max_ant_entries DO
      IF jsn_list [i].jsn = partner_job_unique_id THEN
        mlpkill (jsn_list [i].jsn, status);
        log_vrbl ('mlpkill status ', status.condition, c#user_dayfile);
        log ('jsn killed ', c#user_dayfile);
        change_job_sign_on_state (jsn_list [i].jsn, mlc$signed_off);

      /terminate_job/
        WHILE TRUE DO
          ssf_req.jid := jsn_list [i].job_id_word;
          ssf_req.fc := c#sf_regr;
          ssf_req.rc := 0;
          ssf_req.scpa := 0;
          ssf_req.ucpa := c#normal_error;
          sfcall (^ssf_req);
          IF ssf_req.rc <> 0 THEN
            log_vrbl ('regr err', ssf_req.rc, c#user_dayfile);
            IF ssf_req.rc = e#job_swapped_out THEN
{ Issue swapin and retry.

              ssf_req.fc := c#sf_swpi;
              ssf_req.rc := 0;
              sfcall (^ssf_req);

              pause (1);
              CYCLE /terminate_job/;
            ELSE
              hang;
            IFEND;
          ELSE
            EXIT /terminate_job/;
          IFEND;
        WHILEND /terminate_job/;

        jsn_list [i].jsn := 0;
        jsn_list [i].count := 0;
        jsn_list [i].job_id_word := initial_job_id_word_entry;
        signon_count := signon_count - 1;
        terminate_status := mlc$job_terminated;
        RETURN;
      IFEND;
    FOREND;

  PROCEND mlp$terminate_signed_on_job;


?? OLDTITLE, NEWTITLE := 'PROCEDURE mlp$force_job_sign_off', EJECT ??

  PROCEDURE [XDCL] mlp$force_job_sign_off ALIAS 'mlpfjso'
    (partner_job_unique_id: mlt$partner_job_unique_id;
    VAR forced_sign_off_status: mlt$forced_sign_off_status);

    VAR
      i: integer,
      status: ost$status;

    forced_sign_off_status := mlc$forced_sign_off_failed;
    FOR i := 1 TO mlc$max_ant_entries DO
      IF jsn_list [i].jsn = partner_job_unique_id THEN
        mlpkill (jsn_list [i].jsn, status);
        log_vrbl ('mlpkill status ', status.condition, c#user_dayfile);
        log ('jsn killed ', c#user_dayfile);
        change_job_sign_on_state (jsn_list [i].jsn, mlc$signed_off);
        forced_sign_off_status := mlc$forced_sign_off_ok;
        RETURN;
      IFEND;
    FOREND;

  PROCEND mlp$force_job_sign_off;

?? OLDTITLE, NEWTITLE := 'PROCEDURE mlp$locate_free_job_entry', EJECT ??

  PROCEDURE [XDCL] mlp$locate_free_job_entry ALIAS 'mlplfje' (VAR
      entry_located: boolean);

    VAR
      i: integer;

    entry_located := FALSE;
    FOR i := 1 TO mlc$max_partner_jobs DO
      IF pj_list [i].job_unique_id = 0 THEN
        entry_located := TRUE;
        RETURN;
      IFEND;
    FOREND;

  PROCEND mlp$locate_free_job_entry;

?? OLDTITLE, NEWTITLE := 'PROCEDURE mlp$create_job_entry', EJECT ??

  PROCEDURE [XDCL] mlp$create_job_entry ALIAS 'mlpcje' (job_unique_id:
    mlt$partner_job_unique_id;
    VAR create_status: mlt$create_status;
    remote_host_job: boolean);

    VAR
      i: integer;

    create_status := mlc$job_entry_create_failed;
    FOR i := 1 TO mlc$max_partner_jobs DO
      IF pj_list [i].job_unique_id = 0 THEN
        pj_list [i].job_unique_id := job_unique_id;
        pj_list [i].sign_on_state := mlc$not_signed_on;
        pj_list [i].remote_host_job := remote_host_job;
        create_status := mlc$job_entry_created_ok;
        RETURN;
      IFEND;
    FOREND;

  PROCEND mlp$create_job_entry;

?? OLDTITLE, NEWTITLE := 'PROCEDURE mlp$delete_job_entry', EJECT ??

  PROCEDURE [XDCL] mlp$delete_job_entry ALIAS 'mlpdje' (job_unique_id:
    mlt$partner_job_unique_id;
    VAR delete_status: mlt$delete_status);

    VAR
      i: integer;

    delete_status := mlc$job_entry_delete_failed;
    FOR i := 1 TO mlc$max_partner_jobs DO
      IF pj_list [i].job_unique_id = job_unique_id THEN
        pj_list [i].job_unique_id := 0;
        pj_list [i].sign_on_state := mlc$not_signed_on;
        pj_list [i].remote_host_job := false;
        delete_status := mlc$job_entry_deleted_ok;
        RETURN;
      IFEND;
    FOREND;

  PROCEND mlp$delete_job_entry;


?? OLDTITLE, NEWTITLE := 'PROCEDURE locate_job_entry', EJECT ??

  PROCEDURE locate_job_entry (job_unique_id: mlt$partner_job_unique_id;
    VAR job_located: boolean);

    VAR
      i: integer;

    job_located := FALSE;
    FOR i := 1 TO mlc$max_partner_jobs DO
      IF pj_list [i].job_unique_id = job_unique_id THEN
        job_located := TRUE;
        RETURN;
      IFEND;
    FOREND;

  PROCEND locate_job_entry;

?? OLDTITLE, NEWTITLE := 'PROCEDURE change_job_sign_on_state', EJECT ??

  PROCEDURE change_job_sign_on_state (job_unique_id: mlt$partner_job_unique_id;
        job_sign_on_state: mlt$job_sign_on_state);

    VAR
      ml_status: mlt$delete_status,
      i: integer;

    FOR i := 1 TO mlc$max_partner_jobs DO
      IF pj_list [i].job_unique_id = job_unique_id THEN
        IF (job_sign_on_state = mlc$signed_off) AND
          (pj_list [i].remote_host_job) THEN
          mlp$delete_job_entry (job_unique_id, ml_status);
        IFEND;
        pj_list [i].sign_on_state := job_sign_on_state;
        RETURN;
      IFEND;
    FOREND;

  PROCEND change_job_sign_on_state;

?? OLDTITLE, NEWTITLE := 'PROCEDURE fetch_job_sign_on_state', EJECT ??

  PROCEDURE fetch_job_sign_on_state (job_unique_id: mlt$partner_job_unique_id;
    VAR job_sign_on_state: mlt$job_sign_on_state);

    VAR
      i: integer;

    FOR i := 1 TO mlc$max_partner_jobs DO
      IF pj_list [i].job_unique_id = job_unique_id THEN
        job_sign_on_state := pj_list [i].sign_on_state;
        RETURN;
      IFEND;
    FOREND;

  PROCEND fetch_job_sign_on_state;

?? OLDTITLE, NEWTITLE := 'STATIC VARIABLES', EJECT ??

  VAR
    ssiw: t#ssiw_word := [14046000000(16), * ],
    request: t#scp_param_block := [ * , * , [REP c#data_block_length of 3]],
    index: integer,
    ssf_req: t#ssf_param_block,
    resp: cpid_response,
    jsn_list: array [1 .. mlc$max_ant_entries] of t#jsn_entry,
    pj_list: array [1 .. mlc$max_partner_jobs] of t#partner_job_entry,
    mlv$jsn: [XDCL] integer,
    initial_job_id_word_entry: t#job_id_word := [0, 0, 0, 0],
    status: ost$status,
    sscr: t#sscr_word := [FALSE, FALSE, 0, 0, FALSE, 12, * ],
    p_sscr: ^t#sscr_word,
    stat_response_ptr: ^t#ssf_stat_response,
    privileged_caller: boolean,
    nosbe: boolean := FALSE,
    swapoutjob: t#job_id_word := [0, 0, 0, 0],
    saved_ucpa: integer,
    swap_loop_count: integer := 0,
    irhf_not_swapped: boolean := TRUE,
    job_entry_found: boolean,
    job_sign_on_state: mlt$job_sign_on_state,
    qp: integer,
    unique: mlt$application_name,
    signon_count: integer := 0,
    mliss_debug: boolean,
    snap_debug: boolean,
    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,
    i: integer,
    special_endt_ucpa: boolean := FALSE,
    save_dayfile: string (60),
    mlv$terminate: [XDCL] boolean := FALSE,
    mlv$fatal_error: [XDCL] boolean := FALSE,
    pjexec_count: integer := 0;

?? OLDTITLE, NEWTITLE := 'EXTERNAL REFERENCES', EJECT ??

  PROCEDURE [XREF] make_me_a_system_cp ALIAS 'makscp';

  PROCEDURE [XREF] getword (address: integer;
        word: ^cell);

  PROCEDURE [XREF] initmli (i: integer);

  PROCEDURE [XREF] snap (p: ^cell;
        l: integer);

  PROCEDURE [XREF] pause (count: integer);

  PROCEDURE [XREF] ml$wait (milisecond: integer);

  PROCEDURE [XREF] sfcall (p: ^cell);

  PROCEDURE [XREF] mlpkill (jsn: integer;
    VAR status: ost$status);

  PROCEDURE [XREF] testnbe (VAR nosbe: boolean);
*copy DSP$NVE_RESOURCE_INTERFACE


?? OLDTITLE, NEWTITLE := 'PROGRAM main', EJECT ??

  PROGRAM main;

{ Initialize the subsystem and SCP environment.

    make_me_a_system_cp;
    dsp$check_if_ve_running;
    initmli (0);
    getword (0, #LOC (ra_word_0));
    mliss_debug := ra_word_0.sw2;
    snap_debug := ra_word_0.sw3;
    integer_to_pointer (c#sscr, p_sscr);
    pointer_to_integer (#LOC (request), i);
    sscr.ap := i;
    p_sscr^ := sscr;
    log (' nos/ve mli subsystem ', c#user_dayfile);
    call_snap (p_sscr, 1);
    testnbe (nosbe);

{ Begin the main loop.

  /main_loop/

    WHILE TRUE DO

{ Check for a request from a UCP.

      IF p_sscr^.i THEN
        getword (0, #LOC (ra_word_0));
        mliss_debug := ra_word_0.sw2;
        snap_debug := ra_word_0.sw3;
        call_snap (p_sscr, 1);
        call_snap (^request, 15);
        mlv$jsn := request.ap1.jsn;
        log_vrbl ('request received', request.ap0.status, c#user_dayfile);

      /process_ucp/
        BEGIN

{ Determine whether or not the UCP is privileged.

          IF request.ap0.status = c#normal_msg THEN
            ssf_req.jid := request.ap1;
            ssf_req.fc := c#sf_stat;
            ssf_req.rc := 0;
            sfcall (^ssf_req);
            IF ssf_req.rc <> 0 THEN
              log_vrbl ('stat err', ssf_req.rc, c#user_dayfile);
              IF ssf_req.rc = e#job_swapped_out THEN
{ Issue swapin and retry .

               ssf_req.fc := c#sf_swpi;
               ssf_req.rc := 0;
               sfcall (^ssf_req);

                pause (1);
                CYCLE /main_loop/;
              ELSE
                hang;
              IFEND;
            IFEND;

            stat_response_ptr := #LOC (ssf_req);
            IF (stat_response_ptr^.priv_program OR stat_response_ptr^.
                  priv_user) THEN
              privileged_caller := TRUE;
            ELSE
              privileged_caller := FALSE;

{ Determine if validated to sign on.

              ssf_req.fc := c#sf_cpid;
              ssf_req.rc := 0;
              ssf_req.fp := 0;
              ssf_req.jid := request.ap1;
              pointer_to_integer (^resp, i);
              ssf_req.scpa := i;
              sfcall (^ssf_req);
              IF ssf_req.rc = e#job_swapped_out THEN
                pause (1);
                CYCLE /main_loop/;
              IFEND;
              IF ssf_req.rc <> 0 THEN
                log_vrbl ('stat err', ssf_req.rc, c#user_dayfile);
                hang;
              IFEND;
              IF NOT resp.validated THEN
                log ('signon attempt by nonvalidated user', c#user_dayfile);
                ssf_req.jid := request.ap1;
                ssf_req.fc := c#sf_regr;
                ssf_req.rc := 0;
                ssf_req.scpa := 0;
                ssf_req.ucpa := c#hostile_user_error;
                sfcall (^ssf_req);
                IF ssf_req.rc <> 0 THEN
                  log_vrbl ('regr err', ssf_req.rc, c#user_dayfile);
                  IF ssf_req.rc = e#job_swapped_out THEN
                    pause (1);
                    CYCLE /main_loop/;
                  ELSE
                    hang;
                  IFEND;
                IFEND;
                EXIT /process_ucp/;
              IFEND;
            IFEND;
          IFEND;

          CASE request.ap0.status OF

          = c#normal_msg =

            CASE request.data [c#funct] OF

            = c#signon =

              IF NOT privileged_caller THEN

                locate_job_entry (mlv$jsn, job_entry_found);

                IF NOT job_entry_found THEN
                  log ('signon attempt by user job not started by ss',
                        c#user_dayfile);
                  ssf_req.jid := request.ap1;
                  ssf_req.fc := c#sf_regr;
                  ssf_req.rc := 0;
                  ssf_req.scpa := 0;
                  ssf_req.ucpa := c#hostile_user_error;
                  sfcall (^ssf_req);
                  IF ssf_req.rc <> 0 THEN
                    log_vrbl ('regr err', ssf_req.rc, c#user_dayfile);
                    IF ssf_req.rc = e#job_swapped_out THEN

{ Ignore UCP swapped out condition.

                      pause (1);
                      CYCLE /main_loop/;

                    ELSE
                      hang;
                    IFEND;
                  IFEND;
                  special_endt_ucpa := TRUE;
                  EXIT /process_ucp/;
                ELSE
                  fetch_job_sign_on_state (mlv$jsn, job_sign_on_state);

                  IF job_sign_on_state = mlc$signed_on THEN
                    log ('signon attempt by user job currently signed on',
                          c#user_dayfile);
                    ssf_req.jid := request.ap1;
                    ssf_req.fc := c#sf_regr;
                    ssf_req.rc := 0;
                    ssf_req.scpa := 0;
                    ssf_req.ucpa := c#normal_error;
                    sfcall (^ssf_req);
                    IF ssf_req.rc <> 0 THEN
                      log_vrbl ('regr err', ssf_req.rc, c#user_dayfile);
                      IF ssf_req.rc = e#job_swapped_out THEN

{ Ignore UCP swapped out condition.

                        pause (1);
                        CYCLE /main_loop/;

                      ELSE
                        hang;
                      IFEND;
                    IFEND;
                    EXIT /process_ucp/;
                  IFEND;
                IFEND;
              IFEND;

              mlp$sign_on (request.data [c#aname], request.data [c#maxmsg],
                    unique, status);
              log_vrbl ('signon status ', status.condition, c#user_dayfile);
              IF (status.condition = mlc$nosve_not_up) AND (signon_count > 0)
                    THEN
                expunge;
                dsp$nve_down_condition;
              IFEND;

{ Return status and unique application name to the UCP.

              write_to_ucp (request.ap0.addr + c#mlpv1 - 1, ^unique, 1);
              write_to_ucp (request.ap0.addr + c#mlpsv - 1, ^status, 1);
              IF status.condition = mlc$ok THEN

{ Add new entry to jsn list or increment an existing entry.

                search_for_jsn (mlv$jsn, index);
                IF index < 0 THEN

{ Set long term connection.

                /sltc_loop/
                  WHILE TRUE DO

                  ssf_req.jid := request.ap1;
                  ssf_req.fc := c#sf_sltc;
                  ssf_req.rc := 0;
                  ssf_req.fp := 0;
                  sfcall (^ssf_req);
                  IF ssf_req.rc <> 0 THEN
                    log_vrbl ('sltc err', ssf_req.rc, c#user_dayfile);
                    IF ssf_req.rc = e#job_swapped_out THEN

{ Issue swapin and retry the sltc.

                        ssf_req.fc := c#sf_swpi;
                        ssf_req.rc := 0;
                        sfcall (^ssf_req);
                        pause (1);
                        CYCLE /sltc_loop/;
                      ELSE
                        hang;
                      IFEND;
                    ELSE
                      EXIT /sltc_loop/;
                    IFEND;
                  WHILEND /sltc_loop/;

{ Add new entry to jsn list.

                  index := - index;
                  jsn_list [index].jsn := mlv$jsn;
                  jsn_list [index].count := 1;
                  jsn_list [index].job_id_word := request.ap1;
                  signon_count := signon_count + 1;
                ELSEIF index = 0 THEN

{ Full jsn list - should never happen.

                  log ('jsn list full ', c#user_dayfile);
                  hang;
                ELSE { index > 0 }

{ Increment count for an existing jsn.

                  jsn_list [index].count := jsn_list [index].count + 1;
                IFEND;
              IFEND;

              IF NOT privileged_caller THEN
                change_job_sign_on_state (mlv$jsn, mlc$signed_on);
              IFEND;

            = c#signoff =

              mlp$sign_off (request.data [c#aname], status);
              log_vrbl ('signoff status ', status.condition, c#user_dayfile);
              IF (status.condition = mlc$nosve_not_up) AND (signon_count > 0)
                    THEN
                expunge;
                dsp$nve_down_condition;
              IFEND;

{ Return status to the UCP.

              write_to_ucp (request.ap0.addr + c#mlpsv - 1, ^status, 1);
              IF (status.condition = mlc$ok) OR (status.condition =
                    mlc$queued_msgs_lost) THEN

{ Decrement jsn count.

                search_for_jsn (mlv$jsn, index);
                IF index <= 0 THEN
                  log ('jsn not found (signoff) ', c#user_dayfile);
                  hang;
                ELSE
                  IF jsn_list [index].count = 1 THEN

{ End the long term connection with the UCP.

                  /cltc_loop/
                    WHILE TRUE DO

                      ssf_req.jid := request.ap1;
                      ssf_req.fc := c#sf_cltc;
                      ssf_req.fp := 0;
                      ssf_req.rc := 0;
                      sfcall (^ssf_req);
                      IF ssf_req.rc <> 0 THEN
                        log_vrbl ('cltc err', ssf_req.rc, c#user_dayfile);
                        IF ssf_req.rc = e#job_swapped_out THEN

{ Issue swapin and retry the cltc.

                          ssf_req.fc := c#sf_swpi;
                          ssf_req.rc := 0;
                          sfcall (^ssf_req);
                          pause (1);
                          CYCLE /cltc_loop/;
                        ELSE
                          hang;
                        IFEND;
                      ELSE
                        EXIT /cltc_loop/;
                      IFEND;
                    WHILEND /cltc_loop/;


                    jsn_list [index].jsn := 0;
                    signon_count := signon_count - 1;
                  IFEND;
                  jsn_list [index].count := jsn_list [index].count - 1;
                IFEND;
              IFEND;

                change_job_sign_on_state (mlv$jsn, mlc$signed_off);

            = c#swapout_ucp =

            search_for_jsn (mlv$jsn, index);
              IF NOT nosbe OR (swapoutjob <> initial_job_id_word_entry) OR
                 (index < 1) OR (jsn_list[index].count < 2) THEN
                status.condition := mlc$illegal_function;
                log_vrbl ('illegal ucp req', request.data [c#funct],
                      c#user_dayfile);
                write_to_ucp (request.ap0.addr + c#mlpsv - 1, ^status, 1);
              ELSE
                swapoutjob := request.ap1;
                ssf_req.jid := request.ap1;
                ssf_req.fc := c#sf_swpo;
                ssf_req.rc := 0;
                ssf_req.fp := 0;
                sfcall (^ssf_req);
                irhf_not_swapped := FALSE;
                swap_loop_count := 0;
                saved_ucpa := request.ap0.addr;
              IFEND;

            ELSE

{ Signon and signoff are the only MLI functions supported by the subsystem.
{ An illegal MLI function status is returned for all others.

              status.condition := mlc$illegal_function;
              log_vrbl ('illegal ucp req', request.data [c#funct],
                    c#user_dayfile);
              write_to_ucp (request.ap0.addr + c#mlpsv - 1, ^status, 1);

            CASEND;

          = c#ucp_ended, c#ucp_aborted, c#forcibly_broken =
            special_endt_ucpa := TRUE;

{ Sign the UCP off of the MLI.

            search_for_jsn (mlv$jsn, index);
            IF index <= 0 THEN

{ Ignore this condition

              log ('jsn not found (ucp end/abt/fb)', c#user_dayfile);
            ELSE
                mlpkill (mlv$jsn, status);
                log_vrbl ('mlpkill status ', status.condition, c#user_dayfile);
                log ('jsn killed ', c#user_dayfile);
                jsn_list [index].jsn := 0;
                jsn_list [index].count := 0;
                jsn_list [index].job_id_word := initial_job_id_word_entry;
                signon_count := signon_count - 1;
                IF nosbe OR NOT privileged_caller THEN
                  change_job_sign_on_state (mlv$jsn, mlc$signed_off);
                IFEND;
            IFEND;
          ELSE

{ Illegal SCP request.

            log_vrbl ('bad scp req ', request.ap0.status, c#user_dayfile);
            hang;

          CASEND;

        END /process_ucp/;

       IF irhf_not_swapped AND (request.ap0.status <> c#forcibly_broken) THEN
{ Respond to the UCP request

      /endt_loop/
        WHILE TRUE DO

          ssf_req.jid := request.ap1;
          ssf_req.fc := c#sf_endt;
          ssf_req.scpa := 0;
          ssf_req.rc := 0;
          ssf_req.fp := 0;
          IF special_endt_ucpa THEN
            log ('endt for hostile user', c#user_dayfile);
            ssf_req.ucpa := 3fffe(16); { -1}
          ELSE
            ssf_req.ucpa := request.ap0.addr;
          IFEND;
          sfcall (^ssf_req);
          IF ssf_req.rc <> 0 THEN
            log_vrbl ('endt err', ssf_req.rc, c#user_dayfile);
            IF ssf_req.rc = e#job_swapped_out THEN

{ Issue swapin and retry the endt.

              ssf_req.fc := c#sf_swpi;
              ssf_req.rc := 0;
              sfcall (^ssf_req);
              pause (1);
              CYCLE /endt_loop/;
            ELSE
{ Ignore all other errors.
              EXIT /endt_loop/;
            IFEND;
          ELSE
            EXIT /endt_loop/;
          IFEND;
        WHILEND /endt_loop/;
      IFEND;

        special_endt_ucpa := FALSE;
        p_sscr^.i := FALSE;
        irhf_not_swapped := TRUE;

      ELSE
        mlv$jsn := 0;
        icp$partner_job_exec_real;
        rhp$partner_job_exec;

        IF nosbe AND (swapoutjob <> initial_job_id_word_entry) THEN
          swap_loop_count := swap_loop_count + 1;
        IFEND;
        IF nosbe AND (swap_loop_count = c#swapout_max) THEN
          ssf_req.jid := swapoutjob;
          ssf_req.fc := c#sf_swpi;
          ssf_req.fp := 0;
          swap_loop_count := 0;
          swapoutjob := initial_job_id_word_entry;
          ssf_req.rc := 0;
          sfcall (^ssf_req);
          pause (1);

          /endt_loop2/
          WHILE TRUE DO
            ssf_req.fc := c#sf_endt;
            ssf_req.scpa := 0;
            ssf_req.ucpa := saved_ucpa;
            ssf_req.rc := 0;
            ssf_req.fp := 0;
            sfcall (^ssf_req);
            IF (ssf_req.rc <> 0) THEN
              log_vrbl ('ENDT ERR 2', ssf_req.rc, c#user_dayfile);
              IF (ssf_req.rc = e#job_swapped_out) THEN
                ssf_req.fc := c#sf_swpi;
                ssf_req.rc := 0;
                sfcall (^ssf_req);
                pause (1);
                CYCLE /endt_loop2/;
              ELSE
                EXIT /endt_loop2/;
              IFEND;
            ELSE
              EXIT /endt_loop2/;
            IFEND;
          WHILEND /endt_loop2/;

        IFEND;

        ml$wait (250);

      IFEND;

      dsp$nve_resource_interface;
      IF mlv$terminate OR mlv$fatal_error THEN
        expunge;
        dsp$nve_down_condition;
      IFEND;

    WHILEND /main_loop/;

  PROCEND main;

MODEND mlp$mli_subsystem;
