*copyc OSD$DEFAULT_PRAGMATS
?? NEWTITLE := 'NOS/VE: MEMORY LINK INTERFACE' ??
{
{ PURPOSE:
{     The NOS/VE MLI (Memory Link Interface) is a general message
{  transfer mechanism which allows priviledged C180 code to communicate
{  with one or more C170 jobs or system applications.  By nature of
{  its symmetry, MLI also allows a C180 task to communicate with a C180
{  task which is part of a different C180 job.  Transfer of messages
{  between a sender and a receiver is controlled by only allowing app-
{  lications that have been granted permission by the receiver to send
{  messages to the receiver.
{
MODULE mlm$memory_link_interface;
?? SET (LIST := ON) ??
*copyc ost$signature_lock
*copyc OSS$MAINFRAME_PAGED_LITERAL
*copyc OSS$JOB_PAGED_LITERAL
?? SET (LIST := ON) ??
?? NEWTITLE := 'EXTERNAL CONSTANT AND TYPE DECLARATIONS ' ??
?? EJECT ??
*copyc MLD$MEMORY_LINK_DECLARATIONS
?? OLDTITLE ??
?? NEWTITLE := 'INTERNAL CONSTANT AND TYPE DECLARATIONS ' ??
?? EJECT ??
*copyc MLT$ANT_ENTRY
*copyc MLK$KEYPOINTS
?? OLDTITLE ??
?? NEWTITLE := 'EXTERNAL PROCEDURE REFERENCE DECLARATIONS ' ??
?? EJECT ??
*copyc PMP$CYCLE
*copyc PMP$READY_TASK
*copyc PMP$GET_EXECUTING_TASK_GTID
*copyc I#MOVE
*copyc osp$set_mainframe_sig_lock
*copyc osp$clear_mainframe_sig_lock
*copyc osp$clear_mainframe_sig_lock
*copyc osp$set_locked_variable
*copyc osp$fetch_locked_variable
*copyc osp$system_error
*copyc PMP$SEND_SIGNAL
*copyc jmv$jcb
*copyc oss$job_fixed
*copyc osv$170_os_type
*copyc osv$job_fixed_heap
*copyc osp$set_status_abnormal
*copyc ose$job_recovery_exceptions
?? OLDTITLE ??
?? NEWTITLE := 'INTERNAL MODULE VARIABLE DECLARATIONS ' ??
?? EJECT ??


  VAR
    mlv$ilk: [READ, OSS$MAINFRAME_PAGED_LITERAL] ost$compare_swap_lock := mlc$ilk, { value for set
      {interlock }
    mlv$not_ilk: [READ, OSS$MAINFRAME_PAGED_LITERAL] ost$compare_swap_lock := mlc$not_ilk, { value for
      {clear interlock }
    mlv$shared_segment: [XREF] mlt$shared_segment,
    mlv$lock: [XDCL, #GATE] ost$signature_lock := [0],
    mlv$enabled: [XREF] boolean,
    callers_ant_index: mlt$ant_index := mlc$not_found,
    mlv$add_chain,
    mlv$remove_chain,
    mlv$send_message,
    mlv$send_bytes: [XDCL] integer := 0,
    system_name: mlt$system_name;




?? OLDTITLE ??
?? EJECT ??
?? NEWTITLE := 'search_ant ' ??
?? EJECT ??
{
{  PROCEDURE search_ant
{
{    PURPOSE:
{      To search the application name table for one of the following
{      conditions:
{      1) match with just application name.
{      2) match with application name and system name.
{      3) match with empty entry.
{
{    PARAMETERS:
{      application_name: (input) name of the application to search for.
{      system_name: (input) system_name to match with if application_name
{                   is found.  If null then no system_name check is performed.
{      ant_entry: (output) index of the ANT entry if found, otherwise zero.
{      status: (output) status of the search.
{
{    NOTE:
{      . The ANT currently consists of an array of ant_entries which is
{      searched sequentially.  An index into the array is returned.

  PROCEDURE [INLINE] search_ant (application_name: mlt$application_name;
    system_name: mlt$system_name;
    VAR ant_entry: mlt$ant_index;
    VAR status: mlt$search_status);

    VAR
      stat: mlt$status, { local status }
      res_value: integer,
      empty, { index into the ANT }
      i, j: mlt$ant_index; { index into the ANT }

  /pre_search/
    BEGIN
      IF callers_ant_index <> mlc$not_found THEN
{
{ check to see if pointing to correct entry already
{
        IF mlv$shared_segment.ant [callers_ant_index].application_name DIV
          mlc$shift = application_name THEN
{
{ found match - check (maybe) system name }
{
          IF system_name.c170_c180_flag <> mlc$none THEN
{
{ check for system name match }
{
            check_sn (mlv$shared_segment.ant [callers_ant_index].system_name,
                  stat);
            IF stat <> mlc$ok THEN
{
{ system name conflict }
{
              EXIT /pre_search/;
            IFEND;
          IFEND;
{
{ entry was found and either system names matched or no system name
{ check was performed
{
          ant_entry := callers_ant_index;
          status := found;
          RETURN;
        IFEND;
      IFEND;
    END /pre_search/;
    empty := mlc$not_found;

{  create table index using hashing function

     i  := (((application_name DIV 10000(16)) MOD 1000000(16)) MOD 127) + 1;

{  remember if primary entry is empty

     osp$fetch_locked_variable(mlv$shared_segment.ant[i].reservation, res_value);
     IF res_value = mlc$not_ilk THEN
          empty := i;
        IFEND;

  /search_loop/
    WHILE i<>mlc$end_of_chain DO
      IF mlv$shared_segment.ant [i].application_name DIV mlc$shift =
        application_name THEN
{
{ found match - check (maybe) system name }
{
        IF system_name.c170_c180_flag <> mlc$none THEN
{
{ check for system name match }
{
          check_sn (mlv$shared_segment.ant [i].system_name, stat);
          IF stat <> mlc$ok THEN
{
{ system name conflict }
{
            ant_entry := mlc$not_found;
            status := no_match;
            RETURN;
          IFEND;
        IFEND;
{
{ entry was found and either system names matched or no system name
{ check was performed
{
        ant_entry := i;
        status := found;
        RETURN;
      ELSE
{
{  proceed to next entry on chain, keeping track of previous one
{
        j := i;
        i := mlv$shared_segment.ant[i].forward_p;
      IFEND;
    WHILEND /search_loop/;
{
{ no match found }
{
    IF (empty = mlc$not_found) AND (mlv$shared_segment.next_free_ant_entry
      <>mlc$end_of_chain) THEN
      empty := j;
    IFEND;
    ant_entry := empty;
    status := not_found;
    RETURN;
  PROCEND search_ant;

?? OLDTITLE ??

?? NEWTITLE := 'search_permit_list ' ??
?? EJECT ??
{
{  PROCEDURE search_permit_list
{
{    PURPOSE:
{      To search the permit list of a given application and find either
{      a match on sender names or an empty entry.
{
{    PARAMETERS:
{      application_name: (input) the name of the sender to search for.
{                        If null then search for empty entry.
{      ant_entry: (input) index into the ANT of the application whose
{                 permit list is to be searched.
{      permit_entry: (output) index of the entry if found, otherwise zero.
{
{    NOTE:
{      . A permit list currently consists of an array that is searched
{      sequentially.  An index into the array is retunred.

  PROCEDURE search_permit_list (application_name: mlt$application_name;
    ant_entry: mlt$ant_index;
    VAR permit_entry: mlt$permit_index);

    VAR
      permit_list: ^mlt$permit_list, { pointer to the applications permit list}
      i: mlt$permit_index;

{
{ note that the same code is used to search for both empty and non-empty
{ cases because all empty entries have the name field set to mlc$unique_name
{ which is the value of the application name parameter when called to find
{ an empty entry.
{
    permit_list := mlv$shared_segment.ant [ant_entry].permit_list;

  /search_loop/
    FOR i := 1 TO mlc$max_permits DO
      IF permit_list^ [i].sender = application_name THEN
{
{ found match
{
        permit_entry := i;
        RETURN;
      IFEND;
    FOREND /search_loop/;
{
{ no match was found }
{
    permit_entry := mlc$not_found;
    RETURN;
  PROCEND search_permit_list;

?? OLDTITLE ??

?? NEWTITLE := 'search_receive_list ' ??
?? EJECT ??
{
{  PROCEDURE search_receive_list
{
{    PURPOSE:
{      To search the receive list of a given application and find either
{      a match on sender names or an empty entry.
{
{    PARAMETERS:
{      application_name: (input) the name of the sender to search for.
{                        If null then search for an empty entry.
{      ant_entry: (input) index of the ant entry upon which the search
{               is being performed.
{      receive_entry: (output) index of the entry if found, otherwise zero.
{
{    NOTE:
{      . A receive list currently consists of an array that is searched
{      sequentially.  An index into the array is returned.
{
{      . The maximum number of receive entries looked at is determined by the
{      max_messages value for this application.

  PROCEDURE search_receive_list (application_name: mlt$application_name;
    ant_entry: mlt$ant_index;
    VAR receive_entry: mlt$receive_index);

    VAR
      i: mlt$receive_index, { index into the receive list }
      crlp: ^mlt$int_receive_list_entry,
      receive_list: ^mlt$int_receive_list, { pointer to the current receive
      {list }
      max_msgs: mlt$max_messages; { max messages for the current application }

    IF application_name = mlc$empty_entry THEN
      max_msgs := mlv$shared_segment.ant [ant_entry].max_messages;
    ELSE
      max_msgs := mlv$shared_segment.ant [ant_entry].highest_rl_entry;
    IFEND;

    receive_list := mlv$shared_segment.ant [ant_entry].receive_list;
{
{ note that the same code is used to search for both empty and non-empty
{ cases because all empty entries have the name field set to mlc$unique_name
{ which is the value of the application name parameter when called to find
{ an empty entry.
{

  /search_loop/
    FOR i := 1 TO max_msgs DO
      IF receive_list^ [i].sender_name = application_name THEN
        receive_entry := i;
        RETURN;
      IFEND;
      IF (receive_list^ [i].sender_name <> mlc$empty_entry) THEN
        crlp := ^receive_list^ [i];
        {Search ssn chain for name match
        WHILE crlp <> NIL DO
          IF crlp^.sender_name = application_name THEN
            receive_entry := i;
            RETURN;
          IFEND;
          crlp := crlp^.chained_entry;
        WHILEND;
      IFEND;
    FOREND /search_loop/;
{
{ no match was found }
{
    receive_entry := mlc$not_found;
    RETURN;
  PROCEND search_receive_list;

?? OLDTITLE ??

?? NEWTITLE := 'mli_error' ??
?? EJECT ??
{
{  PROCEDURE mli_error
{
{    PURPOSE:
{      To process internal MLI errors.  These errors should never occur,
{      but if they do it would indicate a bug somewhere in MLI or the
{      system.  mli_error will take appropriate action depending on
{      the exact error encountered.
{
{    PARAMETERS:
{      code: (input) type of internal error detected.
{
{    NOTES:
{      **** note **** this routine is for NOSVE ( c180 )

  PROCEDURE mli_error (code: mlt$internal_error);

    VAR
      nnn: integer,
      status: ost$status,
      ts: string (20);


    ts := '  mli abort ';
    #INLINE ('keypoint', osk$debug, osk$m * ORD (code),
          mlk$memory_link_error_code);
    STRINGREP (ts (13, 8), nnn, ORD (code));
    osp$system_error (ts, NIL);

  PROCEND mli_error;

?? NEWTITLE := 'obtain_system_name ' ??
?? EJECT ??
{
{  PROCEDURE obtain_system_name
{
{    PURPOSE:
{      To return the system name and c170_c180_flag of the task (which is
{      currently calling MLI) to the caller.
{
{    PARAMETERS:
{      system_name: (output) the system name (and c170_c180_flag) of *this*
{                   task.
{
{    NOTES:
{      . If the global task_id of this task equals the dual state tasks
{      global task_id then the system name is obtained from the c170
{      operating system memory segment, otherwise the system name is the
{      current tasks global task_id.
{
{      . The task_id of the dual state task has previously been stored
{      into the MLI shared segment.

    PROCEDURE [INLINE] obtain_system_name (VAR system_name: mlt$system_name);

      PROCEDURE [XREF] mlp$get_c170_jobname (VAR jn: integer);

      VAR
        task: ost$global_task_id;

      pmp$get_executing_task_gtid (task);
      IF task = mlv$shared_segment.dust_id THEN
{
{ get C170 name
{
        system_name.c170_c180_flag := c170;
        mlp$get_c170_jobname (system_name.name_170);
      ELSE
{
{ get C180 name
{
        system_name.c170_c180_flag := mlc$c180;
        system_name.name_180 := task;
      IFEND;

    PROCEND obtain_system_name;

?? OLDTITLE ??

?? NEWTITLE := 'mli_init ' ??
?? EJECT ??
{
{  PROCEDURE mli_init
{
{    PURPOSE
{      To initialize the local copy of mlv$shared_segment - the pointer to
{      the shared data segment, and to initialize the local copy of this
{      tasks system name.  This action should only be performed for the
{      first call to any mli entry point.  All mli main routines (signon,
{      signoff, add, delete, confirm, fetchrl, send, receive) call this
{      routine as soon as they are called.
{
{     PARAMETERS:
{       status: (output) status of the operation.
{
{    NOTES:
{      This routine is currently modified to aid in HSS/HCS testing.

  PROCEDURE [INLINE] mli_init (VAR status: mlt$status);

{
{   MLI_INIT
{

    VAR
      stat: mlt$status,
      ost: ost$status;

{
{ This routine is currently modified to force serial execution of MLI.
{

    IF NOT mlv$enabled THEN
      status := mlc$mli_internal_error;
      RETURN;
    IFEND;

    osp$set_mainframe_sig_lock (mlv$lock);
    obtain_system_name (system_name);
    callers_ant_index := mlc$not_found; {** for serialization only **}
    status := mlc$ok;
    RETURN;
  PROCEND mli_init;
?? OLDTITLE ??


?? NEWTITLE := 'validate_name ' ??
?? EJECT ??
{
{  PROCEDURE validate_name
{
{    PURPOSE:
{      To validate an application name (type mlt$application_name).
{
{    PARAMETERS:
{      name: (input) the application name to be validated.
{      status: (output) status of the operation.
{
{    NOTES:
{      . The following conditions must be satisfied:
{        1) application name <> mlc$empty_entry, <> mlc$unique_name
{        2) upper 9 bits of application name must be zero.

  PROCEDURE [INLINE] validate_name (name: mlt$application_name;
    VAR status: mlt$status);

    VAR
      i: integer,
    chk: record
        case typ: 1 .. 2 of
        = 1 =
        an: mlt$application_name,
        = 2 =
        vfy: packed record
          u9: 0 .. 1ff(16),
          l1: 0 .. 7ffffff(16),
          l2: 0 .. 0fffffff(16),
        recend,
      casend,
    recend;

    status := mlc$receiver_name_syntax_error;
    IF (name = mlc$empty_entry) OR (name = mlc$unique_name) THEN
      RETURN;
    IFEND;
    chk.an := name;
    IF chk.vfy.u9 <> 0 THEN
      RETURN;
    IFEND;
    status := mlc$ok;
  PROCEND validate_name;
?? OLDTITLE ??

?? NEWTITLE := 'lock ' ??
?? EJECT ??
{
{  PROCEDURE lock
{
{    PURPOSE:
{      To interlock a given word in memory.
{
{    PARAMETERS:
{      ptr: (input-output) the word to lock in memory.
{      status: (output) status of the operation.
{
{    NOTES:
{      . Compare/Swap is currently used to interlock a word.
{
{      . May want to implement some limited waiting for busy interlock
{      capability for C180 tasks.
{
{      . This routine could also stack a list of all locks that it sets (i.e.,
{      save the PVA's).  The routine unlock would unstack these when it was
{      called.  This list could then be used by a condition handler to
{      selectivly clear interlocks set by the aborted task.

  PROCEDURE [INLINE] lock (VAR ptr: ost$compare_swap_lock;
    VAR status: mlt$status);

    VAR
      actual_val: ost$compare_swap_lock,
      succeeded: boolean;

    osp$set_locked_variable (ptr, mlv$not_ilk, mlv$ilk, actual_val, succeeded);
    IF succeeded THEN
      status := mlc$ok;
    ELSE
      status := mlc$busy_interlock;
    IFEND;
  PROCEND lock;

?? OLDTITLE ??

?? NEWTITLE := 'unlock ' ??
?? EJECT ??
{
{  PROCEDURE unlock
{
{    PURPOSE:
{      To unlock a word in memory that had previously been set by lock.
{
{    PARAMETERS:
{      ptr: (input-output) the word in memory to be unlocked.
{      status: (output) the status of the operation.
{
{    NOTES:
{      . Compare/Swap is currently used to interlock a word.
{
{      . This routine should never fail as the caller should be the only
{      one manipulating the lock.  If it does fail then there is a bug
{      in MLI.

  PROCEDURE [INLINE] unlock (VAR ptr: ost$compare_swap_lock;
    VAR status: mlt$status);

    VAR
      actual_val: ost$compare_swap_lock,
      succeeded: boolean;

    osp$set_locked_variable (ptr, mlv$ilk, mlv$not_ilk, actual_val, succeeded);
    IF succeeded THEN
      status := mlc$ok;
    ELSE
      status := mlc$mli_internal_error;
      mli_error (unlock_err);
    IFEND;
  PROCEND unlock;

?? OLDTITLE ??

?? NEWTITLE := 'confirm_sender_allowed_to_send ' ??
?? EJECT ??
{
{  PROCEDURE confirm_sender_allowed_to_send
{
{    PURPOSE:
{      To check if the sender has been permitted to send to the specified
{      receiver.
{
{    PARAMETERS:
{      application_name: (input) application name of the sender.
{      ant_entry: (input) ANT index of the receiver application.
{      status: (output) status of the operation.

  PROCEDURE confirm_sender_allowed_to_send (application_name:
    mlt$application_name;
    ant_entry: mlt$ant_index;
    VAR status: mlt$status);

    VAR
      permit_entry: mlt$permit_index; { index into the permit list }

{ this routine was no-op'd to make job recovery simpler

status:=mlc$ok;
return;
{
{ search for global permission
{
    search_permit_list (mlc$unique_name, ant_entry, permit_entry);
    IF permit_entry = mlc$not_found THEN
{
{ search for specific permission
{
      search_permit_list (application_name, ant_entry, permit_entry);
      IF permit_entry = mlc$not_found THEN
        status := mlc$sender_not_permitted;
      ELSE
        status := mlc$ok;
      IFEND;
    ELSE
{
{ global permission found
{
      status := mlc$ok;
      RETURN;
    IFEND;
  PROCEND confirm_sender_allowed_to_send;
?? OLDTITLE ??

?? NEWTITLE := 'confrim_receiver_ready ' ??
?? EJECT ??
{
{  PROCEDURE confrim_receiver_ready
{
{    PURPOSE:
{      To check if:
{         1) a message from sender to receiver is currently in the receiver
{            queue, and,
{         2) an empty receive list entry exists for the receiver.
{
{    PARAMETERS:
{      application_name: (input) application name of the sender.
{      ant_entry: (input) ANT index of the receiver application.
{      status: (output) status of the operation.

  PROCEDURE confirm_receiver_ready (application_name: mlt$application_name;
    ant_entry: mlt$ant_index;
    force_send: boolean;
    VAR status: mlt$status);

    VAR
      cnt: integer, { count of queued msgs }
      crlp: ^mlt$int_receive_list_entry,
      rlp: ^mlt$int_receive_list, { pointer to the applications receive list }
      receive_entry: mlt$receive_index; { index into the receive list }
{
{ search for message(s) not yet received
{
    cnt := 0;
    rlp := mlv$shared_segment.ant [ant_entry].receive_list;
    IF NOT force_send THEN
  /floop/
    FOR receive_entry := 1 TO mlv$shared_segment.ant [ant_entry].highest_rl_entry
          DO
      IF (rlp^ [receive_entry].sender_name <> mlc$empty_entry) AND
          (rlp^ [receive_entry].ssn = jmv$jcb.system_name) THEN
        crlp := ^rlp^ [receive_entry];
        {Search ssn chain for name match
        WHILE crlp <> NIL DO
          IF crlp^.sender_name = application_name THEN
            cnt := cnt + 1;
          IFEND;
          crlp := crlp^.chained_entry;
        WHILEND;
        EXIT /floop/;
      IFEND;
    FOREND /floop/;
    IFEND; {force_send}
    IF cnt = 0 THEN
{
{ search for empty entry
{
      search_receive_list (mlc$empty_entry, ant_entry, receive_entry);
      IF receive_entry = mlc$not_found THEN
        status := mlc$receive_list_full;
      ELSE
        status := mlc$ok;
      IFEND;
    ELSEIF (cnt >= mlc$max_in_transit) OR
        (cnt >= mlv$shared_segment.ant [ant_entry].max_messages) THEN
      status := mlc$prior_msg_not_received;
    ELSE
      status := mlc$ok;
    IFEND;
  PROCEND confirm_receiver_ready;
?? OLDTITLE ??


?? NEWTITLE := 'check_sn ' ??
?? EJECT ??
{
{  PROCEDURE check_sn
{
{    PURPOSE:
{      To determine if the system name passed is the same as the system name
{      of the current task.
{
{    PARAMETERS:
{      sn: (input) the system name to compare with the current task system
{                  name.
{      status: (output) status of the operation.
{
{    NOTES:
{      This routine is needed because a variant record cannot be used in
{      a relational expression.

  PROCEDURE [INLINE] check_sn (sn: mlt$system_name;
    VAR status: mlt$status);

    status := mlc$system_name_no_match;
    IF sn.c170_c180_flag <> system_name.c170_c180_flag THEN
      RETURN;
    IFEND;
    CASE sn.c170_c180_flag OF
    = c170 =
      IF sn.name_170 <> system_name.name_170 THEN
        RETURN;
      IFEND;
    = mlc$c180 =
      IF sn.name_180.index <> system_name.name_180.index THEN
        RETURN;
      IFEND;
      IF sn.name_180.seqno <> system_name.name_180.seqno THEN
        RETURN;
      IFEND;
    = mlc$none =
      RETURN;
    CASEND;
    status := mlc$ok;
  PROCEND check_sn;
?? OLDTITLE ??

?? NEWTITLE := 'release_ant_entry_resources' ??
?? EJECT ??
{
{  PROCEDURE release_ant_entry_resources
{
{    PURPOSE:
{      1) To return all message buffer space pointed to by active receive list
{         entries to the buffer pool, and,
{      2) To return all permit and receive list space to the table pool.
{
{    PARAMETERS:
{      ant_entry: (input) ANT index to the application being signed off.
{      status: (output) the status of the operation.

  PROCEDURE release_ant_entry_resources (ant_entry: mlt$ant_index;
    VAR status: mlt$status);

    VAR
      ncrl, crl: ^mlt$int_receive_list_entry,
      cae: ^mlt$ant_entry, { pointer to the current ant entry }
      i: mlt$receive_index, { index into the receive list }
      stat: mlt$status; { local status }

    cae := ^mlv$shared_segment.ant [ant_entry];
{
{ must obtain all interlocks before attempting any free operations
{
    lock (mlv$shared_segment.tlock, status);
    IF status <> mlc$ok THEN
      RETURN;
    IFEND;
{
    lock (mlv$shared_segment.plock, status);
    IF status <> mlc$ok THEN
      unlock (mlv$shared_segment.tlock, stat);
      RETURN;
    IFEND;
    status := mlc$ok;
{
{return permit list space }
{
    FREE cae^.permit_list IN mlv$shared_segment.pspace;
{
{ return all queued messages }
{
    FOR i := 1 TO cae^.max_messages DO
      IF cae^.receive_list^ [i].message_location <> NIL THEN
        FREE cae^.receive_list^ [i].message_location IN mlv$shared_segment.
          pspace;
        status := mlc$queued_msgs_lost;
      IFEND;
      IF cae^.receive_list^ [i].chained_entry <> NIL THEN
        crl := cae^.receive_list^ [i].chained_entry;
        WHILE crl <> NIL DO
          IF crl^.message_location <> NIL THEN
            FREE crl^.message_location IN mlv$shared_segment.
              pspace;
            status := mlc$queued_msgs_lost;
          IFEND;
          ncrl := crl^.chained_entry;
          FREE crl IN mlv$shared_segment.pspace;
          crl := ncrl;
        WHILEND;
      IFEND;
    FOREND;
{
{ free receive list space }
{
    FREE cae^.receive_list IN mlv$shared_segment.pspace;
{
{ release interlocks }
{
    unlock (mlv$shared_segment.plock, stat);
    unlock (mlv$shared_segment.tlock, stat);
IF cae^.job_recovery_index <> 0 THEN
    mlv$job_recovery_info^[cae^.job_recovery_index].status :=
      mlc$invalid;
    mlv$job_signon_count := mlv$job_signon_count - 1;
IFEND;
  PROCEND release_ant_entry_resources;

?? OLDTITLE ??

?? NEWTITLE := 'mlp$kill' ??
?? EJECT ??
{   The purpose of this request is to force a sign_off for all applications
{ signed_on by a specified task.  This request should only be issued
{ by mlp$task_termination_cleanup or mlp$front_end.
{
{        MLP$KILL (SYSTEM_NAME, STATUS)
{
{ SYSTEM_NAME: (input) This parameter specifies the task for which all
{        signed_on applications are to be signed_off.
{
{ STATUS: (output) This parameter specifies the request status.
{

  PROCEDURE [XDCL] mlp$kill (sn: mlt$system_name;
    VAR status: ost$status);

    VAR
      entry: mlt$ant_index, {current ant entry being signed off}
      stat: mlt$status,
      sn_table_seed: integer,
      sn_hash: mlt$sn_table_index,
      ost: ost$status,
      cae: ^mlt$ant_entry, {pointer to current ant entry}
      msm: mlt$system_name;

    status.normal := FALSE;
    status.condition := mlc$ok;
    IF NOT mlv$enabled THEN
      status.condition := mlc$mli_internal_error;
      RETURN;
    IFEND;

    osp$set_mainframe_sig_lock (mlv$lock);
{
{  derive seed for creating hash into sn table from system name
{
    CASE sn.c170_c180_flag OF
      = mlc$c180 =
        sn_table_seed := sn.name_180.index;
      = c170 =
        sn_table_seed := ((sn.name_170) DIV 100(16))
          MOD 1000000(16);
    CASEND;
{
{  create index to bottom of chain for this system name
{  using hashing function.
{
    sn_hash := (sn_table_seed MOD (mlc$max_sn_entry - 1)) + 1;
{
{  check all ant entries in chain for system name match
{
    entry := mlv$shared_segment.sn_chain_table [sn_hash];
  /signoff/
    WHILE entry <> mlc$end_of_chain DO
      cae := ^mlv$shared_segment.ant [entry];
{
{  signoff if system name match
{
      msm := cae^.system_name;
      IF (msm.c170_c180_flag = mlc$none) OR (msm.c170_c180_flag <> sn.
        c170_c180_flag) THEN
        entry := cae^.sn_bkwd_p;
        CYCLE /signoff/;
      IFEND;
      IF (msm.c170_c180_flag = mlc$c180) AND (msm.name_180 <> sn.name_180) THEN
        entry := cae^.sn_bkwd_p;
        CYCLE /signoff/;
      IFEND;
      IF (msm.c170_c180_flag = c170) AND (msm.name_170 <> sn.name_170) THEN
        entry := cae^.sn_bkwd_p;
        CYCLE /signoff/;
      IFEND;
      REPEAT
        release_ant_entry_resources (entry, stat);
      UNTIL stat <> mlc$busy_interlock;
{
{ if application was signed_off then complete the signoff by clearing
{ the rest of the entry.
{
      cae^.application_name := mlc$empty_entry;
      cae^.system_name.c170_c180_flag := mlc$none;
      cae^.max_messages := 0;
      cae^.unique := - 1;
      status.condition := stat;
{
{  remove entry from system name chain
{
      IF entry = mlv$shared_segment.sn_chain_table [sn_hash] THEN
        mlv$shared_segment.sn_chain_table [sn_hash]
          := cae^.sn_bkwd_p;
      ELSE
        mlv$shared_segment.ant [cae^.sn_fwd_p].sn_bkwd_p
          := cae^.sn_bkwd_p;
      IFEND;
      IF cae^.sn_bkwd_p <> 0 THEN
        mlv$shared_segment.ant [cae^.sn_bkwd_p].sn_fwd_p
          := cae^.sn_fwd_p;
      IFEND;
{
{  if entry is chained, return to free pool.
{
      IF cae^.backward_p <> mlc$end_of_chain THEN
        IF cae^.forward_p <> mlc$end_of_chain THEN
          mlv$shared_segment.ant[cae^.forward_p].backward_p
            := cae^.backward_p;
        IFEND;
        mlv$shared_segment.ant[cae^.backward_p].forward_p
          := cae^.forward_p;
        cae^.forward_p := mlv$shared_segment.next_free_ant_entry;
        mlv$shared_segment.next_free_ant_entry := entry;
      IFEND;
      entry := cae^.sn_bkwd_p;
      cae^.sn_fwd_p := mlc$end_of_chain;
      cae^.sn_bkwd_p := mlc$end_of_chain;
      unlock (cae^.reservation, stat);
    WHILEND /signoff/;
    osp$clear_mainframe_sig_lock (mlv$lock);
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
  PROCEND mlp$kill;
?? OLDTITLE ??
?? NEWTITLE := 'mlp$task_termination_cleanup' ??
?? EJECT ??
*copyc MLH$TASK_TERMINATION_CLEANUP

  PROCEDURE [XDCL, #GATE] mlp$task_termination_cleanup;

    VAR
      task: ost$global_task_id,
      status: ost$status,
      sn: mlt$system_name;

    IF NOT mlv$enabled THEN
      RETURN;
    IFEND;
    pmp$get_executing_task_gtid (task);
    IF task = mlv$shared_segment.dust_id THEN

{ helper task being terminated - should not happen.

{  i#program_error;

    ELSE
      sn.c170_c180_flag := mlc$c180;
      sn.name_180 := task;
      mlp$kill (sn, status);
    IFEND;
  PROCEND mlp$task_termination_cleanup;
?? OLDTITLE ??
?? NEWTITLE := 'mlp$sign_on ' ??
?? EJECT ??
*copyc MLH$SIGN_ON

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$sign_on_os (application_name:
    mlt$application_name;
    max_messages: mlt$max_messages;
    VAR unique_application_name: mlt$application_name;
    VAR status: ost$status);

?? NEWTITLE := 'build_ant_entry ' ??
?? EJECT ??
{
{  PROCEDURE build_ant_entry
{
{    PURPOSE:
{      To obtain table space for the permit and receive lists and
{      initialize the fields of a new ANT entry.
{
{    PARAMETERS:
{      application_name: (input) the name of the application being created.
{      ant_entry: (input) index of the entry being created.
{      max_msgs: (input) maximum number of queued messages for this
{                application.
{      status: (output) status of the operation.
{
{    NOTES:
{      . The signon count is initialized to one.
{
{      . The system name is obtained from the global variable containing it.

    PROCEDURE build_ant_entry (application_name: mlt$application_name;
      ant_entry: mlt$ant_index;
      max_msgs: mlt$max_messages;
      VAR status: mlt$status);

      VAR
        ip: mlt$permit_index, { permit list index }
        ir: mlt$receive_index, { receive list index }
        cae: ^mlt$ant_entry; { pointer to the current ANT entry }

      cae := ^mlv$shared_segment.ant [ant_entry];
{
{ obtain table interlock }
{
      lock (mlv$shared_segment.tlock, status);
      IF status <> mlc$ok THEN
        RETURN;
      IFEND;
{
{ obtain permit list space }
{
      ALLOCATE cae^.permit_list IN mlv$shared_segment.pspace;
      IF cae^.permit_list = NIL THEN
        unlock (mlv$shared_segment.tlock, status);
        status := mlc$pool_buffer_not_avail;
        RETURN;
      IFEND;
{
{ obtain receive list space }
{
      ALLOCATE cae^.receive_list IN mlv$shared_segment.pspace;
{
{ if not available then free permit space and return
{
      IF cae^.receive_list = NIL THEN
        FREE cae^.permit_list IN mlv$shared_segment.pspace;
        unlock (mlv$shared_segment.tlock, status);
        status := mlc$pool_buffer_not_avail;
        RETURN;
      IFEND;
{
{ space was obtained for both tables }
{
      unlock (mlv$shared_segment.tlock, status);
{
{ initialize new entry fields
{
      cae^.application_name := application_name * mlc$shift + mlc$ilk;
      cae^.system_name := system_name;
cae^.job_recovery_index:=0;
      IF max_msgs = 0 THEN

{ allow multiple messages from same sender

        cae^.max_messages := mlc$max_in_transit;
        cae^.multiple := TRUE;
      ELSE
      cae^.max_messages := max_msgs;
        cae^.multiple := FALSE;
      IFEND;
      cae^.unique := - 1;
      cae^.handler := NIL;
      cae^.highest_rl_entry := 0;
      cae^.active_rl_count := 0;
{
{ initialize new lists
{
      FOR ip := 1 TO mlc$max_permits DO
        cae^.permit_list^ [ip].sender := mlc$empty_entry;
      FOREND;
      FOR ir := 1 TO mlc$max_queued_messages DO
        cae^.receive_list^ [ir].sender_name := mlc$empty_entry;
        cae^.receive_list^ [ir].chained_entry := NIL;
        cae^.receive_list^ [ir].message_location := NIL;
      FOREND;
      status := mlc$ok;
    PROCEND build_ant_entry;

?? OLDTITLE ??


?? EJECT ??
{
{  MLP$SIGN_ON
{

    VAR
      success: boolean, { status from reserve_ant_entry }
      i: mlt$ant_index, { ANT search index }
      j: integer, { loop vrbl }
      sn_hash: mlt$sn_table_index,
      sn_table_seed: integer,
      unique_set: mlt$unique, { in use / free unique name }
      ant_entry: mlt$ant_index, { index into the ANT }
      sstat: mlt$search_status, { search_ant status }
      sn: mlt$system_name, { dummy system name }
      cae: ^mlt$ant_entry, { pointer to the current ANT entry }
      stat: mlt$status, { local status }
      res_value: integer,
      last_chained_entry: mlt$ant_index,
      ost: ost$status,
      cnt: mlt$ant_index; { count of the number of signons from this task }

    #INLINE ('keypoint', osk$entry, 0, mlk$sign_on);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0, mlk$sign_on);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN
{
{ process application name
{
      IF application_name <> mlc$unique_name THEN
        validate_name (application_name, stat);
        IF stat <> mlc$ok THEN
          status.condition := mlc$receiver_name_syntax_error;
          EXIT /locked/;
        IFEND;
      IFEND;
      IF max_messages > mlc$max_queued_messages THEN
        status.condition := mlc$max_msgs_too_large;
        EXIT /locked/;
      IFEND;
{
{ search the ant and count all signons from this system name
{ also count all free / in use unique names
{
      cnt := 0;
      unique_set := $mlt$unique [];
      CASE system_name.c170_c180_flag OF
        = mlc$c180 =
          sn_table_seed := system_name.name_180.index;
        = c170 =
          sn_table_seed := ((system_name.name_170) DIV 100(16))
            MOD 1000000(16);
      CASEND;
{
{  create hash index into sn table to find end of chain
{
      sn_hash := (sn_table_seed MOD (mlc$max_sn_entry - 1)) + 1;
      i := mlv$shared_segment.sn_chain_table [sn_hash];
      WHILE i <> mlc$end_of_chain DO
        check_sn (mlv$shared_segment.ant [i].system_name, stat);
        IF stat = mlc$ok THEN
          cnt := cnt + 1;
          j := mlv$shared_segment.ant [i].unique;
          IF j <> - 1 THEN
            unique_set := unique_set + $mlt$unique [j];
          IFEND;
        IFEND;
        i := mlv$shared_segment.ant[i].sn_bkwd_p;
      WHILEND;
      IF cnt = mlc$max_signons_per_system_name THEN
        status.condition := mlc$max_signons_this_task;
        EXIT /locked/;
      IFEND;
      IF application_name = mlc$unique_name THEN
{
{ signon with mlc$unique_name - generate unique application name
{
{
{ search task unique set
{

      /search/
        BEGIN
          FOR j := 1 TO mlc$max_signons_per_system_name DO
            IF NOT (j IN unique_set) THEN
              EXIT /search/;
            IFEND;
          FOREND;
{
{ this case must never happen
{
          status.condition := mlc$mli_internal_error;
          mli_error (unique_error);
          EXIT /locked/;
        END /search/;
      CASE system_name.c170_c180_flag OF
        = mlc$none =
          status.condition := mlc$mli_internal_error;
        mli_error (bad_system_name);
          EXIT /locked/;
        = mlc$c180 =
          unique_application_name := (system_name.name_180.index * 256 +
            system_name.name_180.seqno) * 256 + (j - 1);
        = c170 =
          unique_application_name := system_name.name_170 * 256 + (j - 1);
        CASEND;
      ELSE
        unique_application_name := application_name;
      IFEND;
      sn.c170_c180_flag := mlc$none;
      search_ant (unique_application_name, sn, ant_entry, sstat);
      IF ant_entry <> 0 THEN
        cae := ^mlv$shared_segment.ant [ant_entry];
      ELSE
        cae := NIL;
      IFEND;
IF system_name.c170_c180_flag = mlc$c180 THEN
  IF mlv$job_signon_count = mlc$max_signons_per_job THEN
    status.condition := mlc$max_job_signons;
    EXIT /locked/;
  IFEND;
IFEND;
      CASE sstat OF
      = found =
{
{ check system name match }
{
      check_sn (cae^.system_name, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$system_name_no_match;
          EXIT /locked/;
        IFEND;
{
{ multiple sign_ons are not allowed
{
        status.condition := mlc$max_signons_this_appl;
        EXIT /locked/;
      = not_found =
      IF cae = NIL THEN
        status.condition := mlc$ant_full;
          EXIT /locked/;
      IFEND;
{
{  interpret ant_entry. may point to empty entry in primary table but
{  points to last entry in chain if primary entry was in use.
{
      last_chained_entry := mlc$end_of_chain;
      osp$fetch_locked_variable(mlv$shared_segment.ant[ant_entry].reservation, res_value);
      IF res_value = mlc$ilk THEN
        last_chained_entry := ant_entry;
        ant_entry := mlv$shared_segment.next_free_ant_entry;
        cae := ^mlv$shared_segment.ant[ant_entry];
      IFEND;
{
{ attempt to reserve the free ant entry }
{
      lock (cae^.reservation, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$busy_interlock;
          EXIT /locked/;
      IFEND;
{
{ create the new entry }
{
        build_ant_entry (unique_application_name, ant_entry, max_messages,
          stat);
      IF stat <> mlc$ok THEN
{
{ destroy entry }
{
        cae^.application_name := mlc$empty_entry;
        cae^.system_name.c170_c180_flag := mlc$none;
        status.condition := stat;
        unlock (cae^.reservation, stat);
          EXIT /locked/;
        IFEND;
        IF application_name = mlc$unique_name THEN
          cae^.unique := j;
      IFEND;
{
{  link new chained entry into ant table
{
      IF last_chained_entry <> mlc$end_of_chain THEN
        mlv$shared_segment.ant [last_chained_entry].forward_p
          := ant_entry;
        cae^.backward_p := last_chained_entry;
        mlv$shared_segment.next_free_ant_entry :=
          cae^.forward_p;
        cae^.forward_p := mlc$end_of_chain;
      IFEND;
{
{  link new entry into sn chain to limit sn search time
{
      IF mlv$shared_segment.sn_chain_table [sn_hash] <> 0 THEN
        mlv$shared_segment.ant [mlv$shared_segment.
          sn_chain_table [sn_hash] ].sn_fwd_p := ant_entry;
        cae^.sn_bkwd_p := mlv$shared_segment.sn_chain_table [sn_hash];
      IFEND;
      mlv$shared_segment.sn_chain_table [sn_hash] := ant_entry;
{
{ set value of callers_ant_index to point to ant entry for this application.
{ *** note *** this will only work when task private data is avail.
{
      callers_ant_index := ant_entry;
        cae^.last_operation.req := mlc$sign_on_req;
        cae^.last_operation.stat_condition := status.condition;
        EXIT /locked/;
    ELSE
{
{ this case should never occur }
{
      status.condition := mlc$mli_internal_error;
      mli_error (case_err);
        EXIT /locked/;
      CASEND;
    END /locked/;
{
{ signon complete - status return is set
{
  IF status.condition = mlc$ok THEN
    status.normal := TRUE;
IF system_name.c170_c180_flag = mlc$c180 THEN
  IF mlv$job_recovery_info = NIL THEN
    ALLOCATE mlv$job_recovery_info IN osv$job_fixed_heap^;
    FOR j := 1 TO mlc$max_signons_per_job DO
      mlv$job_recovery_info^ [j].status := mlc$invalid;
    FOREND;
  IFEND;

/store_job_recovery/
  FOR j := 1 TO mlc$max_signons_per_job DO
    IF mlv$job_recovery_info^ [j].status = mlc$invalid THEN
      mlv$job_recovery_info^ [j].an := unique_application_name;
      mlv$job_recovery_info^ [j].mm := cae^.max_messages;
      mlv$job_recovery_info^ [j].sn := cae^.system_name;
      mlv$job_recovery_info^ [j].u := cae^.unique;
      mlv$job_recovery_info^ [j].h := cae^.handler;
      mlv$job_recovery_info^ [j].m := cae^.multiple;
      cae^.job_recovery_index := j;
      mlv$job_recovery_info^ [j].status := mlc$valid;
      mlv$job_signon_count := mlv$job_signon_count + 1;
      EXIT /store_job_recovery/;
    IFEND;
  FOREND /store_job_recovery/;
IFEND;
  IFEND;
  osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0, mlk$sign_on);

PROCEND mlp$sign_on_os;
?? OLDTITLE ??
?? NEWTITLE := 'mlp$sign_off' ??
?? EJECT ??
*copyc MLH$SIGN_OFF

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$sign_off_os (application_name:
    mlt$application_name;
    VAR status: ost$status);

?? NEWTITLE := 'release_ant_entry' ??
?? EJECT ??
{
{  PROCEDURE release_ant_entry
{
{    PURPOSE:
{      To release (sign off) the application from MLI.
{
{    PARAMETERS:
{      ant_entry: (input) ANT index of the application being signed off.
{      status: (output) status of the operation.
{
{    NOTES:
{      . It is important that the fields of the entry be destroyed before
{      the interlock and reservation are released.  The release of the
{      reservation *must* be the last operation performed because that is the
{      field that decides if an entry is in use or not.  Once it is clear,
{      the entry must be available for use.

PROCEDURE release_ant_entry (ant_entry: mlt$ant_index;
  VAR status: mlt$status);

  VAR
    stat: mlt$status, { local status }
        j: integer, { loop vrbl }
        sn_table_seed: integer,
        sn_hash: mlt$sn_table_index,
        cae: ^mlt$ant_entry; { pointer to the current ANT entry }

      cae := ^mlv$shared_segment.ant [ant_entry];
    release_ant_entry_resources (ant_entry, status);
    IF status = mlc$busy_interlock THEN
      RETURN;
    IFEND;
{
{ destroy fields - note that the interlock is cleared by the setting
{ of the application name field (kind of)
{
    cae^.application_name := mlc$empty_entry;
    cae^.system_name.c170_c180_flag := mlc$none;
    cae^.max_messages := 0;
      cae^.unique := - 1;
    CASE system_name.c170_c180_flag OF
      = mlc$c180 =
        sn_table_seed := system_name.name_180.index;
      = c170 =
        sn_table_seed := ((system_name.name_170) DIV 100(16))
          MOD 1000000(16);
    CASEND;
{
{  create index to bottom of chain for this system name
{
    sn_hash := (sn_table_seed MOD (mlc$max_sn_entry - 1)) + 1;
{
{  remove entry from system name chain
{
    IF ant_entry = mlv$shared_segment.sn_chain_table [sn_hash] THEN
      mlv$shared_segment.sn_chain_table [sn_hash]
        := cae^.sn_bkwd_p;
    ELSE
      mlv$shared_segment.ant [cae^.sn_fwd_p].sn_bkwd_p
        := cae^.sn_bkwd_p;
    IFEND;
    IF cae^.sn_bkwd_p <> 0 THEN
      mlv$shared_segment.ant [cae^.sn_bkwd_p].sn_fwd_p
        := cae^.sn_fwd_p;
    IFEND;
    cae^.sn_fwd_p := mlc$end_of_chain;
    cae^.sn_bkwd_p := mlc$end_of_chain;
{
{  destroy handler info
{
    cae^.handler := NIL;
{
{  if entry is chained, return to free pool.
{
    IF cae^.backward_p <> mlc$end_of_chain THEN
      IF cae^.forward_p <> mlc$end_of_chain THEN
        mlv$shared_segment.ant[cae^.forward_p].backward_p
          := cae^.backward_p;
      IFEND;
      mlv$shared_segment.ant[cae^.backward_p].forward_p
        := cae^.forward_p;
      cae^.forward_p := mlv$shared_segment.next_free_ant_entry;
      mlv$shared_segment.next_free_ant_entry := ant_entry;
    IFEND;
{
{ release entry reservation
{
    unlock (cae^.reservation, stat);
PROCEND release_ant_entry;

?? OLDTITLE ??


?? EJECT ??
{
{  MLP$SIGN_OFF
{

VAR
  cae: ^mlt$ant_entry, { pointer to the current ANT entry }
  ant_entry: mlt$ant_index, { index into the ANT }
  stat: mlt$status, { local status }
      ost: ost$status,
  sstat: mlt$search_status; { search_ant status }

    #INLINE ('keypoint', osk$entry, 0, mlk$sign_off);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0, mlk$sign_off);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN
{
{ validate  names
{
      validate_name (application_name, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$receiver_name_syntax_error;
        EXIT /locked/;
      IFEND;
{
{ process request
{
      search_ant (application_name, system_name, ant_entry, sstat);
      IF ant_entry <> 0 THEN
        cae := ^mlv$shared_segment.ant [ant_entry];
      ELSE
        cae := NIL;
      IFEND;
      CASE sstat OF
      = not_found =
        status.condition := mlc$receiver_not_signed_on;
        EXIT /locked/;
      = no_match =
        status.condition := mlc$system_name_no_match;
        EXIT /locked/;
      = found =
        release_ant_entry (ant_entry, stat);
        status.condition := stat;
{
{ note that release_ant_entry has unlocked both the entry and reservation
{ interlocks.
{
      CASEND;
    END /locked/;
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0, mlk$sign_off);


PROCEND mlp$sign_off_os;
?? OLDTITLE ??
?? NEWTITLE := 'mlp$add_sender ' ??
?? EJECT ??
*copyc MLH$ADD_SENDER

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$add_sender_os (application_name:
    mlt$application_name;
    sender_name: mlt$application_name;
    VAR status: ost$status);

?? NEWTITLE := 'build_permit_list_entry ' ??
?? EJECT ??
{
{  PROCEDURE build_permit_list_entry
{
{    PURPOSE:
{      To add a new sender to the application's permit list, if possible.
{      If the sender is already in the permit list, the operation is ignored.
{      If the sender is not in the permit list, then a new permit list entry
{      is reserved and initialized with the sender name, if possible.
{
{    PARAMETERS:
{      application_name: (input) the application name of the sender to be
{                        added to the permit list.
{      ant_entry: (input) ANT index of the application performing the permit.
{      status: (output) status of the operation.

PROCEDURE build_permit_list_entry (application_name: mlt$application_name;
  ant_entry: mlt$ant_index;
  VAR status: mlt$status);

  VAR
    permit_entry: mlt$permit_index; { index of current permit entry }
{
{ check for duplicate permits
{
  search_permit_list (application_name, ant_entry, permit_entry);
  IF permit_entry <> mlc$not_found THEN
    status := mlc$dup_permits_ignored;
    RETURN;
  IFEND;
{
{ check for empty entry
  search_permit_list (mlc$empty_entry, ant_entry, permit_entry);
  IF permit_entry = mlc$not_found THEN
    status := mlc$permit_list_full;
    RETURN;
  IFEND;
{
{ create new entry
{
      mlv$shared_segment.ant [ant_entry].permit_list^ [permit_entry].sender :=
            application_name;
  status := mlc$ok;
PROCEND build_permit_list_entry;
?? OLDTITLE ??

?? EJECT ??
{
{ MLP$ADD_SENDER
{

VAR
  ant_entry: mlt$ant_index, { index into ANT of current entry }
  stat: mlt$status, { local status }
  sstat: mlt$search_status, { local search_ant status }
      ost: ost$status,
  cae: ^mlt$ant_entry; { pointer to current ANT entry }

    #INLINE ('keypoint', osk$entry, 0, mlk$add_sender);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0, mlk$add_sender);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN
{
{ validate  names
{
      validate_name (application_name, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$receiver_name_syntax_error;
        EXIT /locked/;
      IFEND;
      IF sender_name <> mlc$unique_name THEN
        validate_name (sender_name, stat);
        IF stat <> mlc$ok THEN
          status.condition := mlc$sender_name_syntax_error;
          EXIT /locked/;
        IFEND;
      IFEND;
{
{ process request
{
      search_ant (application_name, system_name, ant_entry, sstat);
      CASE sstat OF
      = not_found =
        status.condition := mlc$receiver_not_signed_on;
        EXIT /locked/;
      = no_match =
        status.condition := mlc$system_name_no_match;
        EXIT /locked/;
      = found =
        cae := ^mlv$shared_segment.ant [ant_entry];
        build_permit_list_entry (sender_name, ant_entry, stat);
        status.condition := stat;
        cae^.last_operation.req := mlc$add_sender_req;
        cae^.last_operation.stat_condition := status.condition;
      CASEND;
    END /locked/;
    IF stat = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0, mlk$add_sender);

PROCEND mlp$add_sender_os;
?? OLDTITLE ??
?? NEWTITLE := 'mlp$delete_sender' ??
?? EJECT ??
*copyc MLH$DELETE_SENDER

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$delete_sender_os (application_name:
    mlt$application_name;
    sender_name: mlt$application_name;
    VAR status: ost$status);

?? NEWTITLE := 'release_permit_list_entry ' ??
?? EJECT ??
{
{  PROCEDURE release_permit_list_entry
{
{    PURPOSE:
{      To remove a sender from the permit list.  The sender must have been
{      previously added to the permit list.  An error status is returned if
{      there are any messages from the sender being deleted still waiting
{      to be received.
{
{    PARAMETERS:
{      ant_entry: (input) ANT index of the application the sender is being
{                 deleted from.
{      sender_name: (input) the name of the application whose permission
{                    to send is being removed.
{      status: (output) status of the operation.

PROCEDURE release_permit_list_entry (ant_entry: mlt$ant_index;
  sender_name: mlt$application_name;
  VAR status: mlt$status);

  VAR
        receive_entry: mlt$receive_index, { index of current receive list entry
        {}
    permit_entry: mlt$permit_index; { index of current permit list entry }

{{ check if name in list
{
  search_permit_list (sender_name, ant_entry, permit_entry);
  IF permit_entry = mlc$not_found THEN
    status := mlc$sender_not_permitted;
    RETURN;
  IFEND;
{
{ destroy the entry
{
      mlv$shared_segment.ant [ant_entry].permit_list^ [permit_entry].sender :=
            mlc$empty_entry;
{
{ check for messages queued from the deleted sender
{
  search_receive_list (sender_name, ant_entry, receive_entry);
  IF receive_entry = mlc$not_found THEN
{
{ no queued messages
{
    status := mlc$ok;
  ELSE
{
{ message were (are) queued
{
    status := mlc$msgs_from_sender_queued;
  IFEND;
PROCEND release_permit_list_entry;
?? OLDTITLE ??

?? EJECT ??
{
{ MLP$DELETE_SENDER
{

VAR
  sstat: mlt$search_status, { local search_ant status }
  cae: ^mlt$ant_entry, { pointer to the current ANT entry }
  ant_entry: mlt$ant_index, { index of the current ANT entry }
      ost: ost$status,
  stat: mlt$status; { local status }

    #INLINE ('keypoint', osk$entry, 0, mlk$delete_sender);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0,
            mlk$delete_sender);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN
{
{ validate  names
{
      validate_name (application_name, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$receiver_name_syntax_error;
        EXIT /locked/;
      IFEND;
      IF sender_name <> mlc$unique_name THEN
        validate_name (sender_name, stat);
        IF stat <> mlc$ok THEN
          status.condition := mlc$sender_name_syntax_error;
          EXIT /locked/;
        IFEND;
      IFEND;
{
{ process request
{
      search_ant (application_name, system_name, ant_entry, sstat);
      CASE sstat OF
      = not_found =
        status.condition := mlc$receiver_not_signed_on;
        EXIT /locked/;
      = no_match =
        status.condition := mlc$system_name_no_match;
        EXIT /locked/;
      = found =
        cae := ^mlv$shared_segment.ant [ant_entry];
        release_permit_list_entry (ant_entry, sender_name, stat);
        status.condition := stat;
        cae^.last_operation.req := mlc$delete_sender_req;
        cae^.last_operation.stat_condition := status.condition;
      CASEND;
    END /locked/;
    IF stat = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0,
          mlk$delete_sender);

PROCEND mlp$delete_sender_os;
?? OLDTITLE ??
?? NEWTITLE := 'mlp$confirm_send ' ??
?? EJECT ??
*copyc MLH$CONFIRM_SEND

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$confirm_send_os (application_name:
    mlt$application_name;
    destination_name: mlt$application_name;
    VAR status: ost$status);

?? EJECT ??
{
{ MLP$CONFIRM_SEND
{

VAR
  s_ant_entry: mlt$ant_index, { index into the ANT of the the sender }
  r_ant_entry: mlt$ant_index, { index into the ANT of the receiver }
  sstat: mlt$search_status, { local search_ant status }
  stat: mlt$status, { local status }
  sn: mlt$system_name, { dummy system name }
      ost: ost$status,
  cae: ^mlt$ant_entry; { pointer to the current ANT entry }

    #INLINE ('keypoint', osk$entry, 0, mlk$confirm_send);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0,
            mlk$confirm_send);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN
{
{ validate  names
{
      validate_name (application_name, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$sender_name_syntax_error;
        EXIT /locked/;
      IFEND;
      search_ant (application_name, system_name, s_ant_entry, sstat);
      CASE sstat OF
      = not_found =
        status.condition := mlc$sender_not_signed_on;
        EXIT /locked/;
      = no_match =
        status.condition := mlc$system_name_no_match;
        EXIT /locked/;
      = found =
        validate_name (destination_name, stat);
        IF stat <> mlc$ok THEN
          status.condition := mlc$receiver_name_syntax_error;
          EXIT /locked/;
        IFEND;
{
{ process request
{
  sn.c170_c180_flag := mlc$none;
  search_ant (destination_name, sn, r_ant_entry, sstat);

      /confirm/
        BEGIN
          CASE sstat OF
          = not_found =
            status.condition := mlc$receiver_not_signed_on;
            EXIT /locked/;
          = no_match =
{
{ this case must never occur
{
            mli_error (case_err);
            status.condition := mlc$mli_internal_error;
            EXIT /locked/;
          = found =
            cae := ^mlv$shared_segment.ant [r_ant_entry];
{
{ check for c170 to c170 request
{
            IF (cae^.system_name.c170_c180_flag = c170) AND (system_name.
              c170_c180_flag = c170) THEN
              status.condition := mlc$c170_c170_illegal;
              EXIT /confirm/;
            IFEND;
{
{ check sender allowed to send to the receiver
{
            confirm_sender_allowed_to_send (application_name, r_ant_entry,
              stat);
            IF stat <> mlc$ok THEN
              status.condition := stat;
              EXIT /confirm/;
            IFEND;
{
{ check receiver ready to receive
{
            confirm_receiver_ready (application_name, r_ant_entry, FALSE, stat);
            IF stat <> mlc$ok THEN
              status.condition := stat;
              EXIT /confirm/;
            IFEND;
          CASEND;
        END /confirm/;
        mlv$shared_segment.ant[s_ant_entry].last_operation.req := mlc$confirm_send_req;
        mlv$shared_segment.ant[s_ant_entry].last_operation.stat_condition := status.condition;
      CASEND;
    END /locked/;
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0, mlk$confirm_send);

PROCEND mlp$confirm_send_os;
?? OLDTITLE ??
?? NEWTITLE := 'mlp$fetch_receive_list' ??
?? EJECT ??
*copyc MLH$FETCH_RECEIVE_LIST

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$fetch_receive_list_os
    (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);

?? NEWTITLE := 'scan_receive_list ' ??
?? EJECT ??
{
{  PROCEDURE scan_receive_list
{
{    PURPOSE:
{      To find every valid receive list entry in an applications receive list
{      and copy the fields that make up a receive list entry to the user area.
{{    PARAMETERS:
{      ant_entry: (input) ANT index of the receiver application.
{      sender_name: (input) application name to return information for.
{      receive_count: (output) the number of entries found and returned to
{                     the user.
{      fetchrl_list: (output) the fetchrl list provided by the caller in
{                    which to put the receive list information.
{
{    NOTES:
{      . A valid entry is either:
{         1) any active entry if the sender name is null, or,
{         2) any active entry whose sender name field matches the requested
{            sender name.
{

PROCEDURE scan_receive_list (ant_entry: mlt$ant_index;
  sender_name: mlt$application_name;
  VAR receive_count: mlt$receive_count;
  VAR fetchrl_list: mlt$receive_list);

  VAR
        rl: ^mlt$int_receive_list, { pointer to the receive list being scanned
        {}
    i: mlt$receive_index, { receive list search index }
    mmts: mlt$receive_index; { max messages to search from this list }

  receive_count := 0;
      rl := mlv$shared_segment.ant [ant_entry].receive_list;
      mmts := mlv$shared_segment.ant [ant_entry].highest_rl_entry;
  FOR i := 1 TO mmts DO
{
{ check for valid entry
{
        IF rl^ [i].sender_name <> mlc$empty_entry THEN
{
{ check for name match
{
          IF (sender_name = mlc$unique_name) OR (sender_name = rl^ [i].
            sender_name) THEN
{
{ found entry to copy
{
        receive_count := receive_count + 1;
            copy_fetchrl_info (rl^ [i], fetchrl_list [receive_count]);
            fetchrl_list [receive_count].receive_index := i;
      IFEND;
    IFEND;
  FOREND;
PROCEND scan_receive_list;
?? OLDTITLE ??

?? NEWTITLE := 'copy_fetchrl_info' ??
?? EJECT ??
{
{  PROCEDURE copy_fetchrl_info
{
{    PURPOSE:
{      To copy the following fields from an active receive list entry to the
{      user area -
{        1) sender application name
{        2) sender arbitrary information
{        3) receive table index
{        4) message length
{
{    PARAMETERS:
{      receive_entry: (input) the receive list entry from which information
{                     is to be copied.
{      fetchrl_entry: (output) the user area where the information is to
{                    be placed.

PROCEDURE copy_fetchrl_info (receive_entry: mlt$int_receive_list_entry;
  VAR fetchrl_entry: mlt$receive_entry);

  fetchrl_entry.sender_name := receive_entry.sender_name;
  fetchrl_entry.arbitrary_info := receive_entry.arbitrary_info;
  fetchrl_entry.message_length := receive_entry.message_length;
PROCEND copy_fetchrl_info;
?? OLDTITLE ??

?? EJECT ??
{
{ MLP$FETCH_RECEIVE_LIST
{

VAR
  sstat: mlt$search_status, { local search_ant status }
  ant_entry: mlt$ant_index, { index into the ANT of the application }
  cae: ^mlt$ant_entry, { pointer to the ANT entry of the application }
      ost: ost$status,
  stat: mlt$status; { local status }

    #INLINE ('keypoint', osk$entry, 0, mlk$fetch_receive_list);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0,
            mlk$fetch_receive_list);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN
{
{ validate  names
{
      validate_name (application_name, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$receiver_name_syntax_error;
        EXIT /locked/;
      IFEND;
      IF sender_name <> mlc$unique_name THEN
        validate_name (sender_name, stat);
          IF stat <> mlc$ok THEN
            status.condition := mlc$sender_name_syntax_error;
          IFEND;
      IFEND;
{
{ process request
{
      search_ant (application_name, system_name, ant_entry, sstat);
      CASE sstat OF
      = not_found =
        status.condition := mlc$receiver_not_signed_on;
        EXIT /locked/;
      = no_match =
        status.condition := mlc$system_name_no_match;
        EXIT /locked/;
      = found =
{
{ interlock the application
{
        cae := ^mlv$shared_segment.ant [ant_entry];
        scan_receive_list (ant_entry, sender_name, receive_count,
          receive_list);
        cae^.last_operation.req := mlc$fetch_receive_list_req;
        cae^.last_operation.stat_condition := status.condition;
      CASEND;
    END /locked/;
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0,
          mlk$fetch_receive_list);

PROCEND mlp$fetch_receive_list_os;
?? OLDTITLE ??
?? NEWTITLE := 'confirm_send_and_lock ' ??
?? EJECT ??
{
{  PROCEDURE confirm_send_and_lock
{
{    PURPOSE:
{      To confirm that a send operation is allowed between two applications.
{
{    PARAMETERS:
{      sender_name: (input-output) sender application name.
{      receiver_name: (input-output) receiver application name.
{      ant_entry: (output) ANT index to receiver application ant_entry.
{      send_ant_entry: (output) ant index of sender application ant_entry.
{      status: (output) status of the operation.
{
{    NOTES:
{      . This procedure is identical to mlp$confirm_send except that it leaves
{      the ant_entry of the receiver application interlocked and returns
{      a pointer to that ant_entry when it returns.
{
{      . The ant_entry is left interlocked only if the confrim check is
{      successful.

    PROCEDURE confirm_send_and_lock (sender_name: mlt$application_name;
      receiver_name: mlt$application_name;
      force_send: boolean;
  VAR ant_entry: mlt$ant_index;
  VAR send_ant_entry: mlt$ant_index;
  VAR status: ost$status);

  VAR
    s_ant_entry: mlt$ant_index, { index into the ANT of the sender appl }
    r_ant_entry: mlt$ant_index, { index into the ANT of the receiver appl }
    sstat: mlt$search_status, { local search_ant status }
        stat: mlt$status, { local status }
        sn: mlt$system_name, { dummy system name }
        cae: ^mlt$ant_entry; { pointer to the current ANT entry }
{
      status.condition := mlc$ok;
      status.normal := FALSE;
send_ant_entry := 0;
{
{ process sender name
{
      validate_name (sender_name, stat);
  IF stat <> mlc$ok THEN
    status.condition := mlc$sender_name_syntax_error;
    RETURN;
  IFEND;
  search_ant (sender_name, system_name, s_ant_entry, sstat);
  CASE sstat OF
      = not_found =
        status.condition := mlc$sender_not_signed_on;
        RETURN;
      = no_match =
        status.condition := mlc$system_name_no_match;
        RETURN;
      = found =
send_ant_entry := s_ant_entry;
{
{ process receiver name
{
        validate_name (receiver_name, stat);
    IF stat <> mlc$ok THEN
      status.condition := mlc$receiver_name_syntax_error;
      RETURN;
    IFEND;
    sn.c170_c180_flag := mlc$none;
    search_ant (receiver_name, sn, r_ant_entry, sstat);

      /confirm/
        BEGIN
          CASE sstat OF
          = not_found =
            status.condition := mlc$receiver_not_signed_on;
            RETURN;
          = no_match =
{
{ this case must never occur
{
            mli_error (case_err);
            status.condition := mlc$mli_internal_error;
            RETURN;
          = found =
            cae := ^mlv$shared_segment.ant [r_ant_entry];
{
{ check for c170 to c170 request
{
            IF (cae^.system_name.c170_c180_flag = c170) AND (system_name.
              c170_c180_flag = c170) THEN
              status.condition := mlc$c170_c170_illegal;
              EXIT /confirm/;
        IFEND;
{
{ check sender allowed to send to the receiver
{
        confirm_sender_allowed_to_send (sender_name, r_ant_entry, stat);
        IF stat <> mlc$ok THEN
          status.condition := stat;
              EXIT /confirm/;
        IFEND;
{
{ check receiver ready to receiver
{
        confirm_receiver_ready (sender_name, r_ant_entry, force_send, stat);
        IF stat <> mlc$ok THEN
          status.condition := stat;
              EXIT /confirm/;
            IFEND;
          CASEND;
        END /confirm/;
    IF status.condition = mlc$ok THEN
      ant_entry := r_ant_entry;
    ELSE
      ant_entry := mlc$not_found;
    IFEND;
  CASEND;
  IF status.condition = mlc$ok THEN
    status.normal := TRUE;
  IFEND;
PROCEND confirm_send_and_lock;
?? OLDTITLE ??

?? NEWTITLE := 'build_rl_entry ' ??
?? EJECT ??
{
{  PROCEDURE build_rl_entry
{
{    PURPOSE:
{      1) To obtain space for the message from the buffer pool.
{      2) Move the message text from the user area to the MLI buffer.
{      3) Initialize the fields of a new receive list entry.
{      4) Send signal if required.
{
{    PARAMETERS:
{      sender_name: (input) application name of the sender.
{      arb_info: (input) arbitrary information provided by the sender.
{      length: (input) length in bytes of the message.
{      location: (input) pointer to the user message area.
{      ant_entry: (input) ANT index of the receiver application.
{      signal_option: (input) specifies if receiver is to be signaled.
{      destination_name: (input) application name of message receiver.
{      status: (output) status of the operation.

PROCEDURE build_rl_entry (sender_name: mlt$application_name;
  arb_info: mlt$arbitrary_info;
  length: mlt$message_length;
  ant_entry: mlt$ant_index;
  signal_option: mlt$signal;
  location: mlt$message_ptr;
      destination_name: mlt$application_name;
      force_send: boolean;
      VAR status: mlt$status);

      VAR
        stat: mlt$status, { local status }
        sig: pmt$signal,
        ps: ^mlt$pmt_signal,
        i: integer,
        ost: ost$status, { send_signal status }
        mptr: ^array [ * ] of cell, { pointer to MLI message buffer }
        receive_entry: mlt$receive_index, { index into receiver's receive list
        crl,
        orelp,
        relp: ^mlt$int_receive_list_entry; { pointer to rl entry being created
{
{ attempt to obtain the pool interlock
{
  lock (mlv$shared_segment.plock, status);
  IF status <> mlc$ok THEN
    RETURN;
  IFEND;

  /find_rl_entry/
    BEGIN
      IF NOT force_send THEN
      {Search for jsn match
      FOR i := 1 TO mlv$shared_segment.ant [ant_entry].highest_rl_entry DO
        IF (mlv$shared_segment.ant [ant_entry].receive_list^ [i].sender_name <>
            mlc$empty_entry) AND (mlv$shared_segment.ant [ant_entry].receive_list^ [i].ssn =
            jmv$jcb.system_name) THEN
          receive_entry := i;
          ALLOCATE crl IN mlv$shared_segment.pspace;
          IF crl = NIL THEN
            status := mlc$pool_buffer_not_avail;
            unlock (mlv$shared_segment.plock, stat);
            RETURN;
          IFEND;
          mlv$add_chain := mlv$add_chain + 1;
          {Find end of chain
          relp := ^mlv$shared_segment.ant [ant_entry].receive_list^ [i];
          WHILE relp^.chained_entry <> NIL DO
            relp := relp^.chained_entry;
          WHILEND;
          orelp := relp;
          relp^.chained_entry := crl;
          relp := crl;
          EXIT /find_rl_entry/;
        IFEND;
      FOREND;
      IFEND; {Force send}

{ chaining not required -
{ obtain an empty receive list entry

  search_receive_list (mlc$empty_entry, ant_entry, receive_entry);
  IF receive_entry = mlc$not_found THEN
{
{ this must never happen
{
    status := mlc$mli_internal_error;
    unlock (mlv$shared_segment.plock, stat);
    mli_error (send_rl_conflict);
    RETURN;
  IFEND;
  relp := ^mlv$shared_segment.ant [ant_entry].receive_list^
    [receive_entry];
  crl := NIL;
  END /find_rl_entry/;

    /locked/
  BEGIN
{
{ attempt to allocate space for the message
{
   IF length > 0 THEN
    ALLOCATE mptr: [1 .. length] IN mlv$shared_segment.pspace;
    IF mptr = NIL THEN
      status := mlc$pool_buffer_not_avail;
      IF crl <> NIL THEN
        mlv$add_chain := mlv$add_chain - 1;
        orelp^.chained_entry := NIL;
        FREE crl IN mlv$shared_segment.pspace;
      IFEND;
      unlock (mlv$shared_segment.plock, stat);
      RETURN;
    IFEND;
   ELSE
    mptr := NIL;
   IFEND;
      END /locked/;
  unlock (mlv$shared_segment.plock, stat);
{
{ build new receive list entry
{
  relp^.sender_name := sender_name;
  relp^.arbitrary_info := arb_info;
  relp^.message_location := mptr;
  relp^.message_length := length;
  relp^.chained_entry := NIL;
  relp^.ssn := jmv$jcb.system_name;
  mlv$shared_segment.ant [ant_entry].active_rl_count :=
    mlv$shared_segment.ant [ant_entry].active_rl_count + 1;
  IF mlv$shared_segment.ant [ant_entry].highest_rl_entry < receive_entry THEN
    mlv$shared_segment.ant [ant_entry].highest_rl_entry := receive_entry;
  IFEND;


{
{ send the message
{
  mlv$send_message := mlv$send_message + 1;
  mlv$send_bytes := mlv$send_bytes + length;
  status := mlc$ok;
  IF length > 0 THEN
    i#move (location, #LOC (mptr^), length);
  IFEND;
{
{ send signal if required
{
      IF signal_option <> NIL THEN
        IF mlv$shared_segment.ant [ant_entry].system_name.c170_c180_flag = c170
              THEN
          status := mlc$signal_to_c170_ignored;
        ELSE
          IF mlv$shared_segment.ant [ant_entry].handler = NIL THEN

{ ready task instead of signal

            pmp$ready_task (mlv$shared_segment.ant [ant_entry].system_name.
                  name_180, ost);
            IF NOT ost.normal THEN
              status := mlc$signal_failed_ignored;
            IFEND;
        ELSE
          sig.identifier := mlc$signal_id;
          ps := #LOC (sig.contents);
          ps^.data := signal_option^.data;
          ps^.from := sender_name;
          ps^.dest := destination_name;
          ps^.direction := mlc$send;
          pmp$send_signal (mlv$shared_segment.ant [ant_entry].system_name.
            name_180, sig, ost);
          #INLINE ('keypoint', osk$debug, 0, mlk$send_msg_send_signal);
          IF NOT ost.normal THEN
            status := mlc$signal_failed_ignored;
            #INLINE ('keypoint', osk$debug, 0,
                  mlk$send_message_signal_error);
      IFEND;
    IFEND;
  IFEND;
      IFEND;
PROCEND build_rl_entry;
?? OLDTITLE ??

?? NEWTITLE := 'mlp$send_message ' ??
?? EJECT ??
*copyc MLH$SEND_MESSAGE

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$send_message_os (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);

?? EJECT ??
{
{ MLP$SEND_MESSAGE
{

VAR
  ant_entry: mlt$ant_index, { index into the ANT for the receiver }
send_ant_entry: mlt$ant_index, {index into the ANT for the sender. }
  stat: mlt$status, { local status }
      ost: ost$status,
  cae: ^mlt$ant_entry; { pointer to sender ANT entry }

    #INLINE ('keypoint', osk$entry, 0, mlk$send_message);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0,
            mlk$send_message);
      RETURN;
    IFEND;

  /locked/
    BEGIN
{
{ use modified version of MLP$CONFIRM_SEND to do most of the checking.
{ note that this routine will leave the entry interlocked if it returns mlc$ok.
{
      confirm_send_and_lock (application_name, destination_name, FALSE, ant_entry,
       send_ant_entry, status);
IF NOT status.normal THEN
{
{ note that confirm_send_and_lock has set status.condition
{
        EXIT /locked/;
      IFEND;
      status.condition := mlc$ok;
      status.normal := FALSE;
      cae := ^mlv$shared_segment.ant [ant_entry];

    /send/
BEGIN
{
{ check for message too long
{
  IF message_length > mlc$max_message_length THEN
    status.condition := mlc$message_too_long;
          EXIT /send/;
  IFEND;
{
{ successful validation - send message
{
        build_rl_entry (application_name, arbitrary_info, message_length,
          ant_entry, signal, message_area, destination_name, FALSE, stat);
        IF stat <> mlc$ok THEN
          status.condition := stat;
          EXIT /send/;
        IFEND;
      END /send/;
    END /locked/;
if send_ant_entry <> 0 then
mlv$shared_segment.ant[send_ant_entry].last_operation.req := mlc$send_message_req;
mlv$shared_segment.ant[send_ant_entry].last_operation.stat_condition :=
status.condition;
ifend;
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0, mlk$send_message);

PROCEND mlp$send_message_os;
?? NEWTITLE := 'mlp$force_send_message ' ??
?? EJECT ??
*copyc MLH$SEND_MESSAGE

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$force_send_message (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);

?? EJECT ??
{
{ MLP$SEND_MESSAGE
{

VAR
  ant_entry: mlt$ant_index, { index into the ANT for the receiver }
send_ant_entry: mlt$ant_index, {index into the ANT for the sender. }
  stat: mlt$status, { local status }
      ost: ost$status,
  cae: ^mlt$ant_entry; { pointer to sender ANT entry }

    #INLINE ('keypoint', osk$entry, 0, mlk$send_message);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0,
            mlk$send_message);
      RETURN;
    IFEND;

  /locked/
    BEGIN
{
{ use modified version of MLP$CONFIRM_SEND to do most of the checking.
{ note that this routine will leave the entry interlocked if it returns mlc$ok.
{
      confirm_send_and_lock (application_name, destination_name, TRUE, ant_entry,
       send_ant_entry, status);
IF NOT status.normal THEN
{
{ note that confirm_send_and_lock has set status.condition
{
        EXIT /locked/;
      IFEND;
      status.condition := mlc$ok;
      status.normal := FALSE;
      cae := ^mlv$shared_segment.ant [ant_entry];

    /send/
BEGIN
{
{ check for message too long
{
  IF message_length > mlc$max_message_length THEN
    status.condition := mlc$message_too_long;
          EXIT /send/;
  IFEND;
{
{ successful validation - send message
{
        build_rl_entry (application_name, arbitrary_info, message_length,
          ant_entry, signal, message_area, destination_name, TRUE, stat);
        IF stat <> mlc$ok THEN
          status.condition := stat;
          EXIT /send/;
        IFEND;
      END /send/;
    END /locked/;
if send_ant_entry <> 0 then
mlv$shared_segment.ant[send_ant_entry].last_operation.req := mlc$send_message_req;
mlv$shared_segment.ant[send_ant_entry].last_operation.stat_condition :=
status.condition;
ifend;
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0, mlk$send_message);

PROCEND mlp$force_send_message;
?? OLDTITLE ??
?? NEWTITLE := 'mlp$receive_message ' ??
?? EJECT ??
*copyc MLH$RECEIVE_MESSAGE

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$receive_message_os (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);

?? NEWTITLE := 'receive_message ' ??
?? EJECT ??
{
{  PROCEDURE receive_message
{
{    PURPOSE:
{      1) To move the message from a MLI buffer to the user area.
{      2) Send a signal to the sender if required.
{      3) Release all resources associated with the message.
{
{    PARAMETERS:
{      length: (input) actual length to move, in bytes.  It is the smaller of
{              the actual message length and the length of the user area.
{      signal_option: (input) specifies if receiver is to be signaled.
{      user_loc: (input) location of the user area to move message to.
{      application_name: (input) application name of the receiver.
{      receive_entry: (input-output) the receive list entry whose message is
{                     being received.
{      status: (output) status of the operation.

PROCEDURE receive_message (signal_option: mlt$signal;
  user_loc: mlt$message_ptr;
  length: mlt$message_length;
      application_name: mlt$application_name;
  VAR receive_entry: mlt$int_receive_list_entry;
  VAR status: mlt$status);

  VAR
    ost: ost$status, { send_signal status }
        sig: pmt$signal,
        stat: mlt$status,
        ps: ^mlt$pmt_signal,
        i: integer,
    temp_rl: mlt$int_receive_list_entry,
    sn: mlt$system_name, { dummy system name for ANT search }
    ant_entry: mlt$ant_index, { ANT index of sender }
        buf_loc: ^array [ * ] of cell; { pointer to the MLI message buffer }
{
{ interlock the message pool here so that the message is not copied
{ if the pool is busy, since the space could not be returned to the pool.
{
  lock (mlv$shared_segment.plock, status);
  IF status <> mlc$ok THEN
    RETURN;
  IFEND;
{
{ copy message text from MLI to user area
{
  buf_loc := receive_entry.message_location;
  IF length > 0 THEN
    i#move (#LOC (buf_loc^), user_loc, length);
  IFEND;
{
{ send signal to sender if required
{
      IF signal_option <> NIL THEN
    status := mlc$ok;
{
{ find sender application in the ANT
{
    sn.c170_c180_flag := mlc$none;
    search_ant (receive_entry.sender_name, sn, ant_entry, sstat);
    CASE sstat OF
        = not_found, no_match =
          status := mlc$signal_failed_ignored;
        = found =
          IF mlv$shared_segment.ant [ant_entry].system_name.c170_c180_flag =
            c170 THEN
            status := mlc$signal_to_c170_ignored;
          ELSE
            IF mlv$shared_segment.ant [ant_entry].handler = NIL THEN

{ ready task instead of signal

              pmp$ready_task (mlv$shared_segment.ant [ant_entry].system_name.
                    name_180, ost);
              IF NOT ost.normal THEN
                status := mlc$signal_failed_ignored;
              IFEND;
            ELSE
            sig.identifier := mlc$signal_id;
            ps := #LOC (sig.contents);
            ps^.data := signal_option^.data;
            ps^.from := application_name;
            ps^.dest := receive_entry.sender_name;
            ps^.direction := mlc$receive;
            pmp$send_signal (mlv$shared_segment.ant [ant_entry].system_name.
              name_180, sig, ost);
            #INLINE ('keypoint', osk$debug, 0, mlk$rec_message_send_signal);
            IF NOT ost.normal THEN
              status := mlc$signal_failed_ignored;
              #INLINE ('keypoint', osk$debug, 0,
                    mlk$rec_message_signal_error);
        IFEND;
      IFEND;
          IFEND;
    CASEND;
  IFEND;
  IF receive_entry.message_location <> NIL THEN
    FREE receive_entry.message_location IN mlv$shared_segment.pspace;
  IFEND;
  IF receive_entry.chained_entry = NIL THEN
    receive_entry.sender_name := mlc$empty_entry;
  ELSE
    temp_rl := receive_entry.chained_entry^;
    FREE receive_entry.chained_entry IN mlv$shared_segment.pspace;
    mlv$remove_chain := mlv$remove_chain + 1;
    receive_entry := temp_rl;
  IFEND;
  unlock (mlv$shared_segment.plock, stat);
PROCEND receive_message;
?? OLDTITLE ??

?? EJECT ??
{
{ MLP$RECEIVE_MESSAGE
{

VAR
  ant_entry: mlt$ant_index, { index into the ANT of the receiver }
  cae: ^mlt$ant_entry, { pointer to the receiver ANT entry }
  stat: mlt$status, { local status }
  sstat: mlt$search_status, { local search_ant status }
  rec_index: mlt$receive_index, { index of message being received }
      ost: ost$status,
  c: cell,
  aml: mlt$message_length; { actual message length }
{
    #INLINE ('keypoint', osk$entry, 0, mlk$receive_message);

    IF message_area <> NIL THEN
      {Force page fault BEFORE mli_init
      c := message_area^;
    IFEND;

    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0,
            mlk$receive_message);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN
{
{ process receiver name
{
      validate_name (application_name, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$receiver_name_syntax_error;
        EXIT /locked/;
      IFEND;
      search_ant (application_name, system_name, ant_entry, sstat);
      CASE sstat OF
      = not_found =
        status.condition := mlc$receiver_not_signed_on;
        EXIT /locked/;
      = no_match =
        status.condition := mlc$system_name_no_match;
        EXIT /locked/;
      = found =
        cae := ^mlv$shared_segment.ant [ant_entry];
      /receive/
  BEGIN
    rec_index := receive_index;
{
{ check for valid receive index
{
    IF rec_index > cae^.max_messages THEN
      status.condition := mlc$receive_list_index_invalid;
            EXIT /receive/;
    IFEND;
{
{ if the receive index is zero then return any (the oldest) valid message
{
    IF rec_index = 0 THEN

          /find_any_entry/
      BEGIN
        FOR rec_index := 1 TO cae^.highest_rl_entry DO
                IF cae^.receive_list^ [rec_index].sender_name <>
                  mlc$empty_entry THEN
                  EXIT /find_any_entry/;
                IFEND;
              FOREND;
{
{ no valid entry was found
{
        status.condition := mlc$receive_list_index_invalid;
              EXIT /receive/;
            END /find_any_entry/;
    ELSE
{
{ a specific receive index was used - check that it points to a valid
{ message
{
            IF cae^.receive_list^ [rec_index].sender_name = mlc$empty_entry
              THEN
              status.condition := mlc$receive_list_index_invalid;
              EXIT /receive/;
      IFEND;
    IFEND;
{
{ return message info to caller
{
          message_length := cae^.receive_list^ [rec_index].message_length;
          arbitrary_info := cae^.receive_list^ [rec_index].arbitrary_info;
          sender_name := cae^.receive_list^ [rec_index].sender_name;
{
{ use smaller of message and user buffer lengths
{
    aml := message_length;
    IF aml > message_area_length THEN
      aml := message_area_length;
    IFEND;
          receive_message (signal, message_area, aml, application_name, cae^.
            receive_list^ [rec_index], stat);
          cae^.active_rl_count := cae^.active_rl_count - 1;
          IF cae^.active_rl_count = 0 THEN
            cae^.highest_rl_entry := 0;
          IFEND;

    IF stat <> mlc$ok THEN
      status.condition := stat;
    ELSE
      IF message_length > message_area_length THEN
        status.condition := mlc$message_truncated;
      IFEND;
    IFEND;
    message_length := aml;
        END /receive/;
        cae^.last_operation.req := mlc$receive_message_req;
        cae^.last_operation.stat_condition := status.condition;
      CASEND;
    END /locked/;
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0,
          mlk$receive_message);

PROCEND mlp$receive_message_os;
?? OLDTITLE ??
?? NEWTITLE := ' mlp$register_signal_handler ' ??
?? EJECT ??
*copyc MLH$REGISTER_SIGNAL_HANDLER

  PROCEDURE [XDCL, #GATE { TS_gate } ] mlp$register_signal_handler_os
    (application_name: mlt$application_name;
    handler: mlt$handler;
    VAR status: ost$status);

    VAR
      sstat: mlt$search_status, { search_ant status }
      stat: mlt$status, {local status}
      ant_entry: mlt$ant_index,
      i: integer, { loop vrbl }
      ost: ost$status,
      cae: ^mlt$ant_entry;

    #INLINE ('keypoint', osk$entry, 0, mlk$register_signal_handler);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0,
            mlk$register_signal_handler);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN
      validate_name (application_name, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$receiver_name_syntax_error;
        EXIT /locked/;
      IFEND;
      search_ant (application_name, system_name, ant_entry, sstat);
      IF ant_entry <> 0 THEN
        cae := ^mlv$shared_segment.ant [ant_entry];
      ELSE
        cae := NIL;
      IFEND;
      CASE sstat OF
      = not_found =
        status.condition := mlc$receiver_not_signed_on;
        EXIT /locked/;
      = no_match =
        status.condition := mlc$system_name_no_match;
        EXIT /locked/;
      = found =
        status.condition := mlc$ok;
      CASEND;
      cae^.handler := handler;
    END /locked/;
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
IF cae^.job_recovery_index <> 0 THEN
mlv$job_recovery_info^[cae^.job_recovery_index].h := handler;
IFEND;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0,
          mlk$register_signal_handler);
  PROCEND mlp$register_signal_handler_os;
?? OLDTITLE ??
?? NEWTITLE := ' mlp$get_handler_info' ??
?? EJECT ??
{   The purpose of this request is to obtain signal handler info from mli
{ for a given application.  The request is used only by the memory link
{ signal handler.
{
{        MLP$GET_HANDLER_INFO (RECEIVER, HANDLER, STATUS)
{
{ RECEIVER: (input) This parameter specifies the name of the application
{        for whom a handler is to be located.
{
{ HANDLER: (output) This parameter specifies the handler to be invoked by
{        the signal handler.
{
{ STATUS: (output) This parameter specifies the request status.
{
?? EJECT ??

  PROCEDURE [XDCL, #GATE {TS_gate} ] mlp$get_handler_info_os (application_name:
    mlt$application_name;
    VAR handler: mlt$handler;
    VAR status: ost$status);

    VAR
      stat: mlt$status,
      sstat: mlt$search_status,
      ant_entry: mlt$ant_index,
      ost: ost$status,
      cae: ^mlt$ant_entry;

    #INLINE ('keypoint', osk$entry, 0, mlk$get_handler_info);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0,
            mlk$get_handler_info);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN
      validate_name (application_name, stat);
      IF stat <> mlc$ok THEN
        status.condition := mlc$receiver_name_syntax_error;
        EXIT /locked/;
      IFEND;
      search_ant (application_name, system_name, ant_entry, sstat);
      IF ant_entry <> 0 THEN
        cae := ^mlv$shared_segment.ant [ant_entry];
      ELSE
        cae := NIL;
      IFEND;
      CASE sstat OF
      = not_found =
        status.condition := mlc$receiver_not_signed_on;
        EXIT /locked/;
      = no_match =
        status.condition := mlc$system_name_no_match;
        EXIT /locked/;
      = found =
      CASEND;
      handler := cae^.handler;
    END /locked/;
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0,
          mlk$get_handler_info);
  PROCEND mlp$get_handler_info_os;
?? OLDTITLE ??
?? NEWTITLE := 'PROCEDURE mlp$fetch_link_partner_info' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] mlp$fetch_link_partner_info_os (application_name:
    mlt$application_name;
        partner_name: mlt$application_name;
    VAR last_op: mlt$operation;
    VAR status: ost$status);


    VAR
      ant_entry: mlt$ant_index, {index to the ANT of the receiver}
      caep: ^mlt$ant_entry, {pointer to the partner ANT entry}
      cae: ^mlt$ant_entry, {pointer to requester ANT entry}
      sstat: mlt$search_status, {local search ant status}
      sn: mlt$system_name, {dummy system name}
      ost: ost$status,
      stat: mlt$status;


    #INLINE ('keypoint', osk$entry, 0, mlk$fetch_link_partner_info);
    mli_init (stat);
    status.normal := FALSE;
    IF stat <> mlc$ok THEN
      status.condition := stat;
      #INLINE ('keypoint', osk$exit, 0,
            mlk$fetch_link_partner_info);
      RETURN;
    IFEND;
    status.condition := mlc$ok;

  /locked/
    BEGIN

{validate requester name;
{
      validate_name (application_name, stat);

      IF stat <> mlc$ok THEN
        status.condition := mlc$receiver_name_syntax_error;
        EXIT /locked/;
      IFEND;
      search_ant (application_name, system_name, ant_entry, sstat);
      CASE sstat OF
      = not_found =
        status.condition := mlc$receiver_not_signed_on;
        EXIT /locked/;
      = no_match =
        status.condition := mlc$system_name_no_match;
        EXIT /locked/;
      = found =
        cae := ^mlv$shared_segment.ant [ant_entry];
{
{ find the partner job's ANT entry and validate name;
{

      /find_partner/
        BEGIN
          validate_name (partner_name, stat);
          IF stat <> mlc$ok THEN
            status.condition := mlc$sender_name_syntax_error;
            EXIT /find_partner/;
          IFEND;
          sn.c170_c180_flag := mlc$none;
          search_ant (partner_name, sn, ant_entry, sstat);
          CASE sstat OF
          = not_found =
            status.condition := mlc$receiver_not_signed_on;
            EXIT /find_partner/;
          = no_match =
{
{
{ This condition should not occure.
{
{
            mli_error (case_err);
            status.condition := mlc$mli_internal_error;
            EXIT /locked/;
          = found =
            caep := ^mlv$shared_segment.ant [ant_entry];
{
{ check for c170 to c170 request
{
            IF (caep^.system_name.c170_c180_flag = c170) AND (system_name.
                  c170_c180_flag = c170) THEN
              status.condition := mlc$c170_c170_illegal;
              EXIT /find_partner/;
            IFEND;
            last_op.req := caep^.last_operation.req;
            last_op.stat_condition := caep^.last_operation.stat_condition;
          CASEND;
        END /find_partner/;
        cae^.last_operation.req := mlc$fetch_link_partner_info_req;
        cae^.last_operation.stat_condition := status.condition;
      CASEND;
    END /locked/;
    IF status.condition = mlc$ok THEN
      status.normal := TRUE;
    IFEND;
    osp$clear_mainframe_sig_lock (mlv$lock);
    #INLINE ('keypoint', osk$exit, 0,
          mlk$fetch_link_partner_info);

  PROCEND mlp$fetch_link_partner_info_os;
?? OLDTITLE ??
?? EJECT ??
 PROCEDURE mlp$update_unique_an (an: mlt$application_name;
        unique: integer;
        sn: mlt$system_name;
    VAR status: ost$status);

    VAR
      stat: mlt$status,
      sstat: mlt$search_status,
      ae: mlt$ant_index,
      ost: ost$status;

    status.normal := TRUE;
    mli_init (stat);
    IF NOT status.normal THEN
      status.normal := FALSE;
      status.condition := stat;
      RETURN;
    IFEND;

    search_ant (an, sn, ae, sstat);
    CASE sstat OF
    = found =
      mlv$shared_segment.ant [ae].unique := unique;
IF mlv$shared_segment.ant [ae].job_recovery_index <> 0 THEN
  mlv$job_recovery_info^ [mlv$shared_segment.ant [ae].job_recovery_index].u := unique;
IFEND;
    ELSE
      status.normal := FALSE;
      status.condition := mlc$receiver_not_signed_on;
    CASEND;

    osp$clear_mainframe_sig_lock (mlv$lock);
  PROCEND mlp$update_unique_an;
?? EJECT ??
  VAR
    mlv$job_signon_count: [XDCL, #GATE, oss$job_fixed] integer :=0,
    mlv$job_recovery_info: [XDCL, #GATE, oss$job_fixed] ^mlt$job_recovery_info
      := NIL;

  TYPE
    mlt$job_recovery_info = array [1 .. mlc$max_signons_per_job] of record
      status: (mlc$invalid, mlc$valid),
      an: mlt$application_name,
      mm: mlt$max_messages,
      sn: mlt$system_name,
      u: integer,
      h: mlt$handler,
      m: boolean,
    recend;

  PROCEDURE [XDCL, #GATE] mlp$recover_job_environment (VAR status: ost$status);

    VAR
      i: integer,
      jri_copy: mlt$job_recovery_info,
      unique: mlt$application_name,
      mm: mlt$max_messages,
      gtid: ost$global_task_id;

    status.normal := TRUE;
    IF mlv$job_recovery_info = NIL THEN
      RETURN;
    IFEND;
    IF osv$170_os_type = osc$ot7_none THEN
      osp$set_status_abnormal ('OS', ose$mem_link_not_available, '', status);
      RETURN;
    IFEND;
    pmp$get_executing_task_gtid (gtid);
    jri_copy := mlv$job_recovery_info^;

    FOR i := 1 TO mlc$max_signons_per_job DO
      IF jri_copy [i].status = mlc$valid THEN
        IF jri_copy [i].sn.name_180 = gtid THEN
          IF jri_copy [i].m THEN
            mm := 0;
          ELSE
            mm := jri_copy [i].mm;
          IFEND;
          mlp$sign_on_os (jri_copy [i].an, mm, unique, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
IF jri_copy [i].u <> -1 THEN
  mlp$update_unique_an (jri_copy [i].an,
    jri_copy [i].u, jri_copy [i].sn, status);
  IF NOT status.normal THEN
    RETURN;
  IFEND;
IFEND;
          IF jri_copy [i].h <> NIL THEN
            mlp$register_signal_handler_os (unique, jri_copy [i].h,
                  status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
          mlv$job_recovery_info^ [i].status := mlc$invalid;
IFEND; IFEND;
        FOREND;
      PROCEND mlp$recover_job_environment;
MODEND mlm$memory_link_interface
