          CTEXT  COMCMLI - PROCESS MEMORY LINK INTERFACE REQUEST.
MLI       SPACE  4
          IF     -DEF,QUAL$,1
          QUAL   COMCMLI
          IF     -DEF,RA.ORG,1
          ENTRY  MLV$MLI
          BASE   D
*         COMMENT            COPYRIGHT CONTROL DATA SYSTEMS INC. 1992
MLI       SPACE  4
***       COMCMLI - PROCESS MEMORY LINK INTERFACE REQUEST.
*         D. A. HENSELER. 79/04/24.
MLI       SPACE  4
***       COMCMLI CONTAINS ROUTINES FOR PROCESSING REQUESTS FOR THE
*         NOS/VE MEMORY LINK INTERFACE.
MLI       SPACE  4
***       MLI - PROCESS MEMORY LINK INTERFACE REQUEST.
*
*         ENTRY  MLIPAR BLOCK SET UP WITH FUNCTION CODE AND ALL
*                PARAMETERS REQUIRED BY THAT FUNCTION.
*
*         EXIT   REQUEST PROCESSED.
*                STATUS RETURNED TO MLIPAR BLOCK STATUS WORD.
*
*         USES   X - 1, 2, 6.
*                B - NONE.
*                A - 1, 6.
*
*         CALLS  ITB, ITA.
*
*         MACROS CALLVS, RECALL, MESSAGE, ABORT, SUBR.
          SPACE  2
          SKIP   RA.MTR
          ERR    CALLING DECK SHOULD CALL -SYSCOM-
          IF     -DEF,RA.ORG,1
 OPL      XTEXT  COMSSSD

          IF     -DEF,MLIFTN,1
 MLIFTN   EQU    CVSMLIU     SET TO UNPRIVIGED MEMORY LINK FUNCTION
MLI=      SUBR               ENTRY/EXIT
          IF     -DEF,MLI=X,1
MLI=X     EQU    MLI=
          IF     -DEF,NVSI,1
NVSI      EQU    SS.NVE
          SA4    NTHSR
          R=     X2,2
          IX3    X4+X2
          NZ     X3,MLI11    IF TO RESUME WAITING
          SA1    MLIPAR+MLPFN CHECK FOR VALID FUNCTION
          NG     X1,MLI4     IF ILLEGAL FUNCTION
          IF     DEF,RA.ORG,2      SWAPOUT FUNCTION IS NOS/BE ONLY
          SX6    X1-MLFSW
          ZR     X6,MLI7           PROCESS VIA SUBSYSTEM
          SX6    MLFCO+1
          IX6    X1-X6
          PL     X6,MLI4     IF ILLEGAL FUNCTION
          MX6    0
          SA6    MLIB        RESET RETRY COUNT

* IF THE FUNCTION IS SIGNON OR SIGNOFF THEN PASS THE REQUEST TO THE
* MLI SUBSYSTEM TO BE PROCESSED.

          IFLT   MLFON+MLFOF,2,4
          AX1    1           GETS RID OF A 1
          NZ     X1,MLI0     IF NOT SIGNON AND NOT SIGNOFF
          EQ     MLI7        JSN PROCESSING
          SKIP   6           LEAVE CODE IN JUST IN CASE....
          R=     X2,MLFON
          BX3    X1-X2
          ZR     X3,MLI7     IF SIGNON
          R=     X2,MLFOF
          BX3    X1-X2
          ZR     X3,MLI7     IF SIGNOFF
MLI0      BSS    0
          SA1    MLIA
          ZR     X1,MLI1     IF NOT TO ISSUE DAYFILE TRACE MESSAGE
          RJ     ITB
          SPACE  1
* ENTRY:
*  X1 = NTH REQUEST CODE (CVSMLI).
*  X2 = ADDRESS OF MLI REQUEST BLOCK.
*  X3 = MLI SUB-FUNCTION CODE (MLFSIN, MLFSPL).
*
* EXIT:
*  X0 = 0 IF REQUEST ACCEPTED AND COMPLETED.
*       1 IF QUEUE FULL.
*       2 IF REQUEST ACCEPTED BUT NOT COMPLETE.
*  X1 = 0 IF NOS/VE NOT UP, OTHERWISE UNCHANGED.
*  X4 = NTH SAVE REGISTER.  MUST NOTE BE DESTROYED.
          SPACE  1
 MLI1     SX4    0           CLEAR MLI INDEX
          MX6    0
          SA6    WCNT        ZERO CURRENT WAIT COUNT
          SX2    MLIPAR      PARAMETER BLOCK ADDRESS
          CALLVS X2,X4,MLIFTN,0
          ZR     X0,MLI12    IF REQUEST COMPLETE
          BX1    X0
          AX1    30
          NZ     X1,MLI5     IF NOS/VE DOWN
          SX0    X0-1
          NZ     X0,MLI11    IF REQUEST NOT COMPLETE.
          SPACE  1
* RECALL AND RE-ISSUE THE REQUEST
          SPACE  1
          IF     -DEF,RA.ORG
          SA5    MLV$MLI
          WAIT   X5           USER TIMED RECALL FOR NOS
          ELSE   1
          RECALL              PERIODIC RECALL FOR NOS/BE
          EQ     MLI1
          SPACE  1
* WAIT FOR THE REQUEST TO COMPLETE.  MUST USE PERIODIC RECALL BECAUSE
* AUTO RECALL WORKS ONLY WITH A PP.
          SPACE  1
MLI11     BSS    0
          SX6    -2
          SA6    NTHSR       SET NO WAIT
          IF     -DEF,RA.ORG
          SA5    MLV$MLI
          WAIT   X5          USER DEFINED RECALL PERIOD FOR NOS
          ELSE   1
          RECALL             SYSTEM DEFINED PERIODIC RECALL FOR NOS/BE
          SX1    MLIPAR      PARAMETER BLOCK ADDRESS
          CALLVS X1,X4,MLIFTN,0
          ZR     X0,MLI12    IF REQUEST COMPLETE
          AX0    30
          NZ     X0,MLI5     IF NOS/VE DOWN

* KLUDGE FOR GIM REQUESTS - TIMEOUT WAITING FOR REQUEST TO COMPLETE.

          SA1    WCNT
          SA2    MAXWAIT
          SX6    X1+1        WARNING: 18 BIT ADD
          SA6    A1
          IX6    X2-X6
          NZ     X6,MLI11    CHECK AGAIN

* SAVE WAITING ENVIRONMENT FOR LATER RESTART

          BX6    X4
          SA6    NTHSR
          MX6    0
          SA6    WCNT
          EQ     MLI5
          SPACE  1
MLI12     BSS    0
          SPACE  1
* END OF SPECIAL EIE CODE
          SPACE  1
          SA1    MLIPAR+MLPSV GET STATUS RETURNED
          SX2    X1-MLSBI    CHECK FOR BUSY INTERLOCK STATUS
          NZ     X2,MLI3     IF NOT BUSY INTERLOCK

* PROCESS BUSY STATUS.  RETRY SAME OPERATION A MAXIMUM OF MLEMXR TIMES.

          SA1    MLIRTC
          SX2    1
          IX6    X1+X2       INCREASE MLIRTC BY ONE
          SA6    A1
          SA1    MLIB
          SX6    X1+1
          SX2    X6-MLEMXR
          PL     X2,MLI2     IF TOO MANY RETRYS
          SA6    A1          UPDATE RETRY COUNT
          IF     -DEF,RA.ORG
          SA5    MLV$MLI
          WAIT   X5          USER DEFINED RECALL TIME FOR NOS
          ELSE   1
          RECALL             SYSTEM DEFINED RECALL TIME FOR NOS/BE
          EQ     MLI1

* RETRY LIMIT EXCEEDED.

MLI2      SA1    MLIA
          ZR     X1,MLI=X    IF NOT TO ISSUE DAYFILE TRACE MESSAGE.
          MESSAGE (=C* MLI RETRY LIMIT EXCEEDED. *),MLETDF,R

* RETURN TO CALLER.

MLI3      SA1    MLIA
          ZR     X1,MLI=X    IF NOT TO ISSUE DAYFILE TRACE MESSAGE
          RJ     ITA
          EQ     MLI=X

* PROCESS ILLEGAL MLI FUNCTION.

MLI4      BSS    0
          SX6    MLSIF
          SA6    MLIPAR+MLPSV  RETURN ILLEGAL FUNCTION STATUS
          SA1    MLIA
          ZR     X1,MLI=X    IF NOT TO ISSUE DAYFILE TRACE MESSAGE
          MESSAGE (=C* MLI ILLEGAL FUNCTION.*),MLETDF,R
          EQ     MLI=X
          SPACE  1
* EI RETURNED WITH X1=0 WHICH MEANS THAT NOS/VE IS NOT RUNNING.
          SPACE  1
MLI5      BSS    0
          SX6    MLSND
          SA6    MLIPAR+MLPSV  RETURN NOS/VE DOWN STATUS
          SA1    MLIA
          ZR     X1,MLI=X    IF NOT TO ISSUE DAYFILE TRACE MESSAGE
          MESSAGE (=C* NOS/VE DOWN.*),3,R
          EQ     MLI=X

* PROCESS SIGNON/SIGNOFF VIA MLI SUBSYSTEM

 MLI7     BSS    0
          SA1    MLID
          MX0    48
          BX6    X0*X1
          SA6    A1
          MX0    11
          CALLSS NVSI,MLID,R
          SA1    MLID
          LX0    12
          BX3    X1*X0
          ZR     X3,MLI3     IF NO ERROR
          SX0    12B         BIT 1 AND BIT 3
          BX3    X0*X1
          NZ     X3,MLI5     SUBSYSTEM NOT PRESENT OR NOT SCP

* PROCESS ERROR ON CALLSS REQUEST

          LX1    30
          RJ     CTO
          SA6    MLIF
          RJ     CTO
          SA6    MLIF+1
          MESSAGE MLIE,0,R
          ABORT
MLIE      DATA   20H MLI SUBSYS ERR =
MLIF      BSS    1
          BSS    1
          DATA   0

MLV$MLI   VFD    60/30B
MLIA      VFD    60/MLEITM   DAYFILE TRACE MESSAGE FLAG
MLIB      BSS    1           RETRY COUNT
MLID      VFD    24/0,12/0,6/MLEPBS,4/0,1/1,1/0,11/0,1/0
MLIPAR    BSS    MLEPBS      MLI PARAMETER BLOCK
MLIRTC    DATA   0           BUSY RETRY COUNT CUMULATIVE TOTAL
WCNT      DATA   0
MAXWAIT   DATA   -2
NTHSR     DATA   -2
ITB    SPACE  4
***       ITB - ISSUE DAYFILE TRACE MESSAGE BEFORE MLI REQUEST.
*
*         ENTRY  VALID FUNCTION SET IN THE MLIPAR BLOCK.
*
*         EXIT   DAYFILE MESSAGE OF THE FORMAT-
*                   MLI REQ XXXXX NNNNNN
*                ISSUED.  XXXXX IS A FUNCTION NAME - SIGNON, SIGNOFF,
*                ADDSPL, DELSPL, SEND, RECEIVE, FETCHRL, CONFIRM.
*                NNNNNN IS THE APPLICATION NAME MAKING THE REQUEST
*                DISPLAYED AS 20 OCTAL DIGITS.IF STO OPTION 2 IS ACTIVE,
*                THE MLI PARAMETER BLOCK IS WRITTEN TO FILE MLIDUMP.
*
*         USES   X - 0, 1, 2, 6.
*                B - NONE.
*                A - 1, 2, 6.
*
*         MACROS MESSAGE, SUBR, WRITEW.
*
*         CALLS  CTO.
          SPACE  2
ITB       SUBR               ENTRY/EXIT
          SA1    MLIPAR+MLPFN GET FUNCTION NUMBER
          SA2    X1+ITBA     GET FUNCTION NAME
          BX6    X2
          SA1    MLIPAR+MLPAN GET APPLICATION NAME
          LX1    30
          SA6    ITBC
          RJ     CTO         CONVERT LEFT HALF
          SA6    ITBC+1
          RJ     CTO         CONVERT RIGHT HALF
          SA6    ITBC+2
          MESSAGE ITBB,MLETDF,R
DUMP      IF     DEF,DUMPMLI

* OUTPUT PARAMETER BLOCK IF REQUESTED.

          SA1    MLIA        GET TRACE OPTION
          SX0    2
          BX2    X0-X1
          NZ     X2,ITBX     IF NOT TO DUMP MLIPAR BLOCK
          WRITEW MLIDUMP,MLIPAR,MLEPBS
          WRITER MLIDUMP,R
DUMP      ENDIF
          EQ     ITBX        RETURN

ITBA      BSS    0           FUNCTION NAME TABLE
          DATA   10HSIGNON
          DATA   10HSIGNOFF
          DATA   10HADDSPL
          DATA   10HDELSPL
          DATA   10HSEND
          DATA   10HRECEIVE
          DATA   10HFETCHRL
          DATA   10HCONFIRM
ITBB      DATA   10H MLI REQ
ITBC      BSS    3
          DATA   0
DUMP      IF     DEF,DUMPMLI
MLIDUMP   FILEB  DUMPB,501B
DUMPB     BSS    501B
DUMP      ENDIF
ITA    SPACE  4
***       ITA - ISSUE DAYFILE TRACE MESSAGE AFTER MLI REQUEST.
*
*         ENTRY  STATUS SET IN MLIPAR BLOCK.
*
*         EXIT   DAYFILE MESSAGE OF THE FORMAT-
*                   MLI STS DDDDDD
*                ISSUED.  DDDDDD IS A 20 DIGIT OCTAL NUMBER REPRESENTING
*                STATUS RETURNED BY MLI.
*
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1, 6.
*
*         MACROS MESSAGE, SUBR.
*
*         CALLS  CTO.
          SPACE  2
ITA       SUBR               ENTRY/EXIT
          SA1    MLIPAR+MLPSV GET STATUS
          LX1    30          GET UPPER 30 BITS FOR CONVERSION
          RJ     CTO
          SA6    ITAB
          RJ     CTO
          SA6    ITAB+1
          MESSAGE ITAA,MLETDF,R
          EQ     ITAX        RETURN

ITAA      DATA   10H MLI STS
ITAB      BSS    2
          DATA   0
STO    SPACE  4
***       STO - SET TRACE OPTION.
*
*         ENTRY  (X6) = OPTION VALUE.  ZERO MEANS DO NOT ISSUE ANY TRACE
*                       MESSAGES. ONE MEANS ISSUE TRACE MESSAGES TO THE
*                       DAYFILE SPECIFIED BY THE SYMBOL MLETDF.
*                       TWO MEANS ISSUE TRACE MESSAGES (SAME AS ONE)
*                       AND WRITE THE MLIPAR BLOCK TO LOCAL FILE
*                       MLIDUMP. IF THE OLD VALUE IS TWO AND IT IS BEING
*                       CHANGED, A WRITER IS ISSUED TO THE MLIDUMP FILE.
*                       THE DUMP CAPABILITY IS ONLY ASSEMBLED INTO MLI=
*                       IF THE SYMBOL DUMPMLI IS DEFINED.
*
*         USES   X - 0, 1.
*                B - NONE.
*                A - 1, 6.
*
*         MACROS SUBR, MESSAGE, WRITER.
          SPACE  2
STO       SUBR               ENTRY/EXIT
          SA1    MLIA        GET CURRENT VALUE
          R=     X0,2
          BX0    X0-X1
          SA6    A1          STORE NEW OPTION VALUE
DUMP      IF     DEF,DUMPMLI
          NZ     X0,STO1     IF OLD VALUE WAS NOT TWO
          SX0    2
          BX0    X0-X6
          ZR     X0,STO1     IF NEW VALUE IS TWO

* FLUSH MLIDUMP BUFFER

          WRITER MLIDUMP,R
          SA1    MLIA        RESTORE OPTION VALUE
          BX6    X1
STO1      BSS    0
DUMP      ENDIF
          ZR     X6,STOX     IF TURNING OFF (NO MESSAGE)
          MESSAGE (=C* MLI TRACE ON. *),MLETDF,R
          EQ     STOX

          SKIP   2
STO2      MESSAGE (=C* MLI TRACE OFF. *),MLETDF,R
          EQ     STOX
CTO       SPACE  4
***       CTO - CONVERT THE RIGHTMOST 30 BITS FROM X1 TO 10 DISPLAY CODE
*               OCTAL DIGITS IN X6.
*
*         ENTRY  (X1) = VALUE TO CONVERT.
*
*         EXIT   (X6) = 10 DISPLAY CODE DIGITS.  NO ZERO SUPPRESSION.
*
*         USES   X - 1, 2, 3, 6, 7.
*                B - 2.
*                A - NONE.
*
*         MACROS SUBR.
          SPACE  2
CTO       SUBR               ENTRY/EXIT
          MX6    0           INITIALIZE ASSEMBLY
          MX2    -3          DIGIT MASK
          SB2    10          DIGIT COUNTER
CTO1      BX7    -X2*X1      GET DIGIT
          SB2    B2-1        DECREMENT DIGIT COUNT
          SX3    X7+1R0      CONVERT DIGIT TO CHARACTER
          LX6    54          POSITION ASSEMBLY
          AX1    3           SHIFT OFF DIGIT
          BX6    X6+X3       ADD CHARACTER TO ASSEMBLY
          NZ     B2,CTO1     IF MORE DIGITS
          LX6    54
          EQ     CTOX        RETURN
          SPACE  4
          BASE   *
QUAL$     IF     -DEF,QUAL$
          QUAL   *
MLV$MLI   EQU    /COMCMLI/MLV$MLI
MLI=      EQU    /COMCMLI/MLI=
STO       EQU    /COMCMLI/STO
MLIPAR    EQU    /COMCMLI/MLIPAR
MLIRTC    EQU    /COMCMLI/MLIRTC
MAXWAIT   EQU    /COMCMLI/MAXWAIT
QUAL$     ENDIF
          ENDX
