*DECK MFLINK
          IDENT  MFLRES 
          TITLE  MFLINK - FILE TRANSFER FACILITY. 
          SST    CM 
          LIST   F
          SYSCOM B1 
          ENTRY  MFLRES 
          ENTRY  MFLRPV 
          ENTRY  MFLPFEX
          ENTRY  SWT
*CALL COMCMAC 
  
 DEBUG    MICRO  1,5,*"PCOMMENT"* 
  
          COMMENT MFLINK - FILE TRANSFER FACILITY.
          COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1994. 
          SPACE  4,10 
*****     MFLINK - FILE TRANSFER FACILITY.
* 
*         J. G. CLARK        79/10/29.
*         D. J. REIMAN       81/06/22.
*         N. A. DEILY        82/04/11.
* 
*         COPYRIGHT (C) CONTROL DATA CORPORATION, 1979,1981,1982. 
*         ALL RIGHTS RESERVED.
          SPACE  4,10 
***       MFLINK IS THE REMOTE HOST PRODUCT FILE TRANSFER APPLICATION.
*         MFLINK IS CALLED BY THE CONTROL STATEMENT *MFLINK*.  MFLINK 
*         COMMUNICATES WITH THE SERVICER (FTFS OR PTFS) THROUGH 
*         THE RHF SUBSYSTEM.  FILE TRANSFER DIRECTIVES ARE
*         PROCESSED BY THE SERVICER WHICH DETERMINES IF ANY FILE
*         TRANSFERS ARE REQUIRED AND THE DIRECTION THEREOF. 
          SPACE  4,10 
***       CONTROL CARD CALL.
* 
*         MFLINK(FILE,ST=LID,DD=CM,I=TXTFILE,PC=C,EP,RT)
* 
*         FILE       SPECIFIES THE LOCAL FILE TO BE USED IN THE 
*                    TRANSFER.  DEFAULT = *LFILE*.
*         ST=LID     SPECIFIES THE LINKED MAINFRAME TO BE USED. 
*         DD=CM      SPECIFIES THE CONVERSION MODE TO BE USED IN THE
*                    TRANSFER.  DEFAULTS TO DEFAULT CHARACTER MODE. 
*         I=TXTFILE  SPECIFIES A FILE TO READ TEXT STRINGS FROM.
*                    DEFAULT = *0*. 
*         EP         DESELECTS AUTOMATIC ERROR RECOVERY AND RETRY.
*         PC         SPECIFIES DIRECTIVE PREFIX CHARACTER FOR 
*                    DIRECTIVES IMMEDIATELY FOLLOWING MFLINK IN 
*                    THE CONTROL STATEMENT RECORD.  DEFAULT = * 
*                    UNLESS I SPECIFIED.
*         RT         SELECTS REAL-TIME RESPONSE TO SUBSYSTEM ERRORS.
          SPACE  4,10 
**        MFLINK OVERVIEW.
* 
*         MFLINK ACTS AS AN INTERFACE BETWEEN THE USER AND THE REMOTE 
*         SYSTEM SERVICER APPLICATION (FTFS/PTFS).  DEPENDING ON
*         THE *I* AND *PC* PARAMETERS ON THE MFLINK STATEMENT AND 
*         ON WHETHER MFLINK IS BEING RUN INTERACTIVELY, MFLINK WILL 
*         GET A SET OF USER TEXT LINES BY EITHER READING PC-PREFIXED
*         CONTROL STATEMENTS IN THE CONTROL STATEMENT RECORD, 
*         READING A FILE, OR PROMPTING AND READING FROM THE TERMINAL. 
*         EACH TEXT LINE IS APPENDED TO THE RFT MESSAGE AS A USER 
*         TEXT PARAMETER.  THE SERVICER WILL PROCESS THE USER TEXTS 
*         AND WILL REPLY WITH AN RPOS MESSAGE (IF NO ERRORS ARE 
*         DETECTED) OR RNEG MESSAGE (OTHERWISE).  THE RPOS MESSAGE
*         WILL INCLUDE THE DIRECTION OF TRANSFER PARAMETER TO 
*         INFORM MFLINK WHETHER A FILE TRANSFER IS NECESSARY AND, IF
*         SO, IN WHICH DIRECTION.  IF A FILE TRANSFER IS INDICATED, 
*         MFLINK ISSUES THE GO MESSAGE AND CALLS NETXFR.  THE PROTOCOL
*         EXCHANGE IS TERMINATED BY THE STOP/STOPR MESSAGES AND 
*         ETP/ETPR/FINI SEQUENCES.  IT IS IMPORTANT TO REMEMBER THAT
*         AT NO TIME DOES MFLINK ATTACH ANY SIGNIFICANCE TO THE CONTENTS
*         OF THE USER TEXTS.  IT MERELY PASSES THEM ON TO THE 
*         SERVICER. 
* 
*         IF THE SERVICER INDICATES THAT MFLINK IS TO RECEIVE A 
*         FILE, MFLINK CHECKS THAT THE LOCAL FILE IS ASSIGNED WRITE 
*         PERMISSION, IF IT EXISTS.  ON NOS/BE, IF THE LOCAL FILE IS
*         AN ATTACHED PERMANENT FILE, IT MUST HAVE MODIFY AND EXTEND
*         PERMISSIONS, AS WELL. 
* 
*         FOR FILES TO BE SENT TO THE SERVICER, MFLINK ENSURES THAT 
*         THE LOCAL FILE EXISTS AND HAS READ PERMISSION.
* 
*         SINCE TYPICALLY A USER MAY WISH TO TRANSFER SEVERAL FILES 
*         TO OR FROM THE SAME REMOTE HOST, AS A CONVIENIENCE TO THE 
*         USER, THE SERVICER MAY RETURN CERTAIN USER TEXT DIRECTIVES
*         ON THE RPOS/RNEG MESSAGES FOR MFLINK TO SAVE AND USE ON 
*         SUBSEQUENT TRANSFERS TO THE SAME REMOTE HOST, SO THAT THE 
*         USER NEED ONLY SPECIFY THEM ONCE.  TYPICAL *RECOVERY* 
*         DIRECTIVES MIGHT INCLUDE NOS *USER* AND *CHARGE* OR NOS/BE
*         *ACCOUNT* STATEMENTS.  REFER TO THE APPROPRIATE REFERENCE 
*         MANUAL FOR THE INFORMATION ABOUT DIRECTIVES PROCESSED 
*         BY A PARTICULAR REMOTER SERVICER. 
* 
*         IF THE *EP* PARAMETER IS NOT SPECIFIED, MFLINK WILL 
*         ATTEMPT TO RETRY A CONNECTION OR TRANSFER A FIXED 
*         NUMBER OF TIMES IF A POTENTIALLY RECOVERABLE ERROR
*         OCCURS.  TO ALLOW FOR THESE ERROR RECOVERY RETRIES, 
*         MFLINK SAVES THE CURRENT SET OF RFT USER TEXT DIRECTIVES
*         ON A FILE UNTIL THE TRANSFER IS SUCCESSFULLY COMPLETED. 
* 
*         TO IMPLEMENT RECOVERY TEXT AND ERROR RETRY PROCESSING,
*         MFLINK USES THREE SCRATCH FILES:  RFILE, RFILE1, AND
*         RFILE2.  (SEE FET DEFINITIONS FOR ACTUAL ZZZZZ LFN USED). 
          SPACE  4,10 
  
**        MICROS
  
 PROGNAM  MICRO  1,10,* MFLINK - *
***       COMMON DECKS. 
  
  
*CALL CMACROS 
*CALL COMCAPR 
*CALL COMCCAE 
  
          LIST   X
*CALL COMCPTF 
*CALL COMFFTF 
          LIST   -X 
 MFLINK   TITLE  RESIDENT PROGRAM 
**        MFLINK - MAINFRAME LINK PROCESSOR.
* 
*         MFLINK IS A CONTROL CARD CALLABLE PROGRAM TO TRANSFER 
*         USER SUPPLIED TEXT STRINGS AND FILES TO/FROM A LINKED 
*         MAINFRAME.  THE LINKED MAINFRAME CAN BE ANY TYPE.  MFLINK 
*         DOES NOT PROCESS THE SUPPLIED TEXT STRINGS.  THE RECEIVING
*         PROCESS (PTFS/FTFS) DETERMINES THE REQUIRED ACTION AND
*         INFORMS MFLINK OF ANY FILE TRANSFERS AND THE DIRECTION
*         THEREOF.
* 
*         ENTRY  NONE.
* 
*         EXIT   DURING NORMAL TERMINATION AN ENDRUN TERMINATES 
*                MFLINK AND EXECUTION BEGINS WITH THE NEXT CONTROL CARD.
  
  
 MFLRES   SUBR
          SB1    1
          SA2    A1+B1       POINTER TO NETSAVL 
          SA1    X2          NETWORK INTERFACES LOADED
          BX6    X1 
          SA6    NIFTYPE     SAVE NETWORK INTERFACE TYPE
          SA1    RA.ORG      SAVE ENTRY POINT COUNT 
          BX6    X1 
          SA6    MFLB        SAVE FOR *FOL* (*DFINIT* DESTROYS) 
  
 DBG      IFC    EQ,*"DEBUG"*DEBUG* 
          SA2    RA.LWP 
          LX2    59-18       LOADED FROM LIBRARY FLAG 
          PL     X2,MFL1     IF LOADED FROM FILE
          SA2    DBG
          SX7    B1+B1
          BX7    -X7*X2      CLEAR NO REPRIEVE/ACCOUNTING FLAG
          SA7    A2 
  
 MFL1     BSS    0
  
 DBG      ENDIF 
  
          SA4    OVLLWA      GET HIGHEST HIGH ADDRESS 
  
*         REQUEST MEMORY UP TO THE LWA OF OVERLAY.
  
          MEMORY CM,MFLA,R,X4 
  
 MFL2     BSS    0
          RJ     =XDUMMAIN   EXECUTE MFLMAIN
          SA1    F           NETXFR FILE NAME 
          SA2    MFLB        GET ENTRY POINT COUNT
          BX6    X1 
          LX7    X2 
          SA6    XFRLFN      SAVE FOR *PTFXFR*
          SA7    RA.ORG      RESTORE COUNT
          RJ     =XDUMXFR    EXECUTE PTFXFR (FILE TRANSFER) 
          EQ     MFL2        TRY MORE 
  
 MFLA     CON    0           *MEMORY* STATUS WORD 
  
 MFLB     CON    0           ENTRY POINT COUNT
 MFLPFEX  SPACE  4,10 
**        MFLPFEX - EXTEND ALTERED NOS/BE PERM FILE.
* 
*         ENTRY  PFALTER = 1, IF PERMANENT FILE WAS ALTERED.
*                PFFDB   = FDB WITH PROPER LFN. 
* 
*         EXIT   PFALTER = -0, IF FILE EXTENDED.
  
 MFLPFEX  SUBR
  
 NBE      IFEQ   OS$NOSBE 
          SA1    PFALTER
          SX1    X1-1 
          NZ     X1,MFLPFEX 
          MX6    60          (X6) = -0
          SA6    A1          UPDATE STATE TO INDICATE ALTER NEEDED
          EXTEND PFFDB,RC 
 NBE      ENDIF 
  
          EQ     MFLPFEX
SWT       SPACE  4,10 
**        SWT - CALL SWT TO RELOAD USER PROGRAM (MFLCALL).
* 
*         SWT IS CALLED TO SET UP THE SWT CALL.  THE INFO 
*         NEEDED TO SET UP THE CALL HAS BEEN PLACED IN WORD 
*         SWTW BY MFLINK(MFK) AND MUST BE REFORMATTED FOR SWT.
*         THIS IS A NOS/BE FUNCTION ONLY. 
* 
*         SWTW FORMAT ON ENTRY = 42/0,6/0,6/SUB-ERROR,6/ERR CODE. 
*         SUB-ERROR CODES DEFINED FOR ERR CODE 21 ONLY -
*         0 = CONTROL CARD ERROR. 
*         1 = ERROR DURING NETON. 
*         2 = ERROR DURING TRANSFER SETUP.
*         SWTW FORMAT ON EXIT = 41/0,6/SUB-ERROR,6/ERR CODE,6/0,1/0.
  
 SWT      SUBR               ENTRY/EXIT 
  
 NOSBE    IFEQ   OS$NOSBE 
          SA1    SWTW        REFORMAT REPLY WORD
          SB2    7
          LX7    X1,B2
          SA7    A1 
          SYSTEM  SWT,R,SWTW,0
          ENDRUN
 NOSBE    ELSE
          EQ     SWT
 NOSBE    ENDIF 
 RPV      SPACE  4,10 
 MFLRPV   SUBR               ENTRY/EXIT 
          BX6    X1 
          SA1    X1+23       INTERRUPTED TERMINAL INPUT REQUEST 
          SX1    X1          MASK FET ADDR
          SA6    RPVB        SAVE FWA OF RECOVR PARAMETER BLOCK 
          SX6    1
          ZR     X1,RPV0.1   IF NO REQUEST OUTSTANDING
          SA1    X1          GET FWA OF FET 
          BX6    X1+X6       SET COMPLETE BIT 
          SA6    A1 
  
 RPV0.1   BSS    0
          RJ     =XDFTERM    TERMINATE DIRECTIVES FILE
          SB1    1
          RJ     MFLPFEX     EXTEND ANY ALTERED PERMANENT FILES 
          SX0    B1 
          SA5    RPVC        FWA OF FILE LIST 
  
 RPV1     BX6    X5+X0       LFN + COMPLETE BIT 
          SA6    RPVD        STORE IN FET 
          RETURN A6,RCL      GET RID OF FILE
          SA5    A5+B1       GET NEXT LFN 
          NZ     X5,RPV1     IF ANOTHER TO RETURN 
          SA1    RPVB        FWA OF RECOVR PARAMETER BLOCK
          SA1    X1+20       RECOVR ERROR FLAG WORD 
          LX1    59-7-12
 NBE      IFEQ   OS$NOSBE 
          NG     X1,RPV2.1   IF TERMINAL INTERRUPT
          SA5    SWTF 
          ZR     X5,RPV2.1   NOT MACRO CALL 
          SX7    ESFT        MFLINK ABORTED BY SYSTEM 
          SA7    SWTW 
          RJ     SWT
 NBE      ELSE
          PL     X1,RPV2.1   IF NOT TERMINAL INTERRUPT
          MESSAGE (=C* MFLINK - TERMINATED BY USER*),3,RCL
          SA1    RPVB 
          SA1    X1+24       RECOVR ERROR FLAG WORD 
          MX5    -12
          BX1    -X5*X1 
          SX1    X1-TIET     CHECK TYPE 
          NZ     X1,RPV2.1   IF NOT USER BREAK 1
          ABORT  ,ND
 NBE      ENDIF 
 RPV2.1   BSS    0
          EQ     MFLRPVX     RETURN 
  
 RPVB     BSS    1           FWA OF RECOVR PARAMETER BLOCK
  
 RPVC     BSS    0           SCRATCH FILE LIST
          CON    0LZZZZZR1
          CON    0LZZZZZR2
          CON    0LZZZZZDL
          DATA   0           END OF LIST
  
 RPVD     FILEB  100B,100B   DUMMY FET FOR RETURN 
  
  
          END 
          IDENT  MFLMAIN
 FTF0100  TITLE  MFLINK - FILE TRANSFER FACILITY (MAIN OVERLAY).
          SST    CM,DLYA
          LIST   F
          SYSCOM B1 
          ENTRY  MFLMAIN
*CALL COMCMAC 
*CALL CMACROS 
*CALL COMCAPR 
*CALL COMCCAE 
*CALL COMCPTF 
*CALL COMFFTF 
          SPACE  4,10 
          SPACE  4,10 
**        MAIN OVERLAY DATA AREA. 
* 
*         *WARNING* - 
* 
*         ALL DATA IN THE FOLLOWING AREA AND IN BLANK COMMON ARE NOT
*         PRESERVED.  IN PARTICULAR, ALL I/O OPERATIONS ON RFILE/1/2
*         MUST BE COMPLETE AND BUFFERS FLUSHED BEFORE CALLING TRANSFER
*         OVERLAY.
  
  
 HMAP     CON    HA          SEND AND RECEIVE BUFFER ADDRESS LIST 
          CON    SMB+1
 HMBP     CON    QBIT        HEADER AND MESSAGE BUFFER ADDRESS LIST 
          CON    STAT 
          CON    ACKT 
          CON    =0 
          CON    HA 
          CON    MB+1 
          CON    MBL
          CON    =0 
  
 OBUFL    EQU    65          OUTPUT FILE BUFFER LENGTH
  
 OUTPUT   BSS    0           INTERACTIVE OUTPUT FILE
 NOS      IFEQ   OS$NOS 
 ZZZZZOU  FILEB  OBUF,OBUFL,(FET=6) 
 NOS      ELSE
  
*         FET FOR NOS/BE INTERACTIVE OUTPUT FILE. 
*         WORD 1, BIT 42 = INTERCOM (USE FET WORD 5). 
*         WORD 1, BITS 23-18 = 1 (6-WORD FET).
*         WORD 5, BIT 20 = NO CARRIAGE CONTROL CHARACTER IN OUTPUT DATA.
  
 ZZZZZOU  VFD    42/0LZZZZZOU,18/3      WORD 0
          VFD    18/1,18/0,6/1,18/OBUF  WORD 1
          VFD    42/0,18/OBUF           WORD 2
          VFD    42/0,18/OBUF           WORD 3
          VFD    42/0,18/OBUF+OBUFL+1   WORD 4
          VFD    36/0,6/04B,18/0        WORD 5
 NOS      ENDIF 
  
 RBUFL    EQU    65          RECOVERY FILE BUFFER LENGTH
  
 RFILE    BSS    0           RECOVERY FILE FET
 ZZZZZR0  FILEB  RBUF,RBUFL,(FET=6) 
  
 RFILE1   BSS    0           TEXT SENT IN LAST RFT
 ZZZZZR1  FILEB  RBUF1,RBUFL,(FET=6)
  
 RFILE2   BSS    0           RECOVERY TEXT RETURNED BY RPOS/RNEG
 ZZZZZR2  FILEB  RBUF2,RBUFL,(FET=6)
  
 SHMP     CON    QBIT        SUPERVISORY PARAMETER ADDRESS LIST 
          CON    STAT 
          CON    REQT 
          CON    =0 
          CON    SHAB 
          CON    STAB 
          CON    STABL
          CON    =0 
  
 STAB     BSSZ   11          SUPERVISORY TEXT AREA
 STABL    CON    *-STAB      SUPERVISORY TEXT AREA LENGTH 
  
  
**        BLANK COMMON DATA AREAS.
  
  
          USE    // 
  
  
 ATTR     BSS    1           PARAMETER RETURN AREA
  
 FACQUAL  BSS    1           FACILITIES QUALIFIER 
 FACTEXT  BSS    1           FACILITIES TEXT
 FACTXTL  BSS    1           FACILITIES TEXT LENGTH 
  
 LCMD     BSS    1           LAST COMMAND PROCESSED 
  
 LINE     BSS    LINEL       TEXT RETURN BUFFER 
  
 NCRETRY  BSS    1           NETON AND CONNECT RETRY COUNT
  
 PDMESSA  BSS    1           PREVIOUS DELAY MESSAGE ADDRESS 
  
 OBUF     BSS    OBUFL       OUTPUT FILE BUFFER FOR INTERACTIVE USE 
  
 RBUF     BSS    RBUFL       RECOVERY FILE BUFFER 
  
 RBUF1    BSS    RBUFL       TEXT SENT IN LAST RFT BUFFER 
  
 RBUF2    BSS    RBUFL       RECOVERY TEXT RETURNED BY RPOS BUFFER
  
 TXTL     BSS    1           USER TEXT LENGTH 
  
 QUAL     BSS    1           PARAMETER RETURN QUALIFIER 
  
 MB       BSS    NTLMAX+1    MESSAGE BUFFER FOR NETGET
  
 SIZT     BSS    1           FILE SIZE IN CHARACTERS / 1024 
  
 SMB      BSS    NTLMAX+1    MESSAGE BUFFER FOR NETPUT
  
 ENDC     EQU    *           END OF BLANK COMMON BUFFERS
  
  
          USE    *
          SPACE  4,10 
**        SYMBOL DEFINITION COMMON DECKS. 
  
 NOS      IFEQ   OS$NOS 
          QUAL   EVT
          XTEXT  COMSEVT
          QUAL   *
          XTEXT  COMSSFM
          XTEXT  COMCSFM
 NOS      ENDIF 
*CALL     COMCUCS 
 MFK      TITLE  MAIN PROGRAM.
**        MFK - MFLINK MAIN PROGRAM.
* 
*         MFK IS THE MAIN LOOP PROCESSOR OF MFLINK. IT IS STRUCTURED
*         AS A SUBROUTINE SINCE THE (1,0) OVERLAY IN WHICH IT RESIDES 
*         IS CALLED FROM THE (0,0) OVERLAY.  THE (2,0) OVERLAY CONTAINS 
*         ONLY THE CALL TO NETXFR.  ALL OTHER PROCESSING IS DONE BY 
*         CALLS FROM MFK IN THE (1,0).  THIS OVERLAY STRUCTURE WAS
*         CHOSEN TO MINIMIZE CM REQUIREMENTS DURING FILE TRANSFERS. 
*         WHEN MFLINK IS FIRST ENTERED, THE (0,0) RESIDENT ROUTINE
*         IMMEDIATELY LOADS THE (1,0) AND CALLS MFK.  CONTROL REMAINS 
*         WITH MFK UNTIL EITHER MFLINK TERMINATES OR A FILE TRANSFER
*         IS REQUIRED IN WHICH CASE MFK RETURNS TO THE (0,0) WHICH
*         WILL LOAD (2,0), PERFORM NETXFR, RELOAD (1,0), AND CALL 
*         MFK.  BEFORE MFK EXITS FOR A NETXFR, CURRENT STATE IS 
*         SAVED IN GLOBAL VARIABLE *XFR* SO THAT MFK WILL KNOW WHERE
*         TO RESUME FROM WHEN RECALLED. 
* 
*         WARNING - WHENEVER A FILE TRANSFER IS REQUIRED AND (2,0) IS 
*         =======   CALLED, ALL LOCAL VARIABLES AND ALL RETURN JUMPS
*                   IN (1,0) WILL BE LOST.  ANY VARIABLES WHICH MUST
*                   BE PRESERVED ACROSS FILE TRANSFERS MUST BE IN 
*                   COMDECK COMFFTF FOR INCLUSION IN (0,0) COMMON 
*                   BLOCK AREA.  IN PARTICULAR, ALL BLANK COMMON
*                   BUFFERS WILL BE LOST.  SUBROUTINE *PFS* WILL
*                   ENSURE RECOVERY FILE FETS ARE NOT BUSY BEFORE 
*                   FILE TRANSFER IS COMMENCED. 
* 
*         PROCESS:  
*                ASLONGAS MFLINK STATEMENT EXISTS 
*                DO 
*                  PROCESS MFLINK STATEMENT 
*                  IF INTERACTIVE MODE
*                  THEN 
*                    TERMINATE ANY EXISTING CONNECTION. 
*                  IF NOT INITIAL MFLINK
*                  THEN 
*                    DAYFILE CONTROL STATEMENT
*                  IF ST PARAMETER SPECIFIED
*                  THEN 
*                    TERMINATE ANY EXISTING CONNECTION
*                    VALIDATE LID 
*                    CREATE NEW RFILE WITH ST HEADER
*                  ELSE 
*                    REWIND AND READ RFILE
*                    IF VALID ST HEADER 
*                    THEN 
*                      SET ST FROM RFILE
*                    ELSE 
*                      TERMINATE WITH ERROR 
*                  ASLONGAS NOT EOF 
*                  DO 
*                    GET USER TEXT
*                    COPY USER TEXT TO RFILE1 
*                  ASLONGAS TRANSFER NOT SUCCESSFUL AND RETRY COUNT 
*                    NOT EXCEEDED 
*                  DO 
*                    IF CONNECTION NOT ESTABLISHED
*                    THEN 
*                      CONNECT TO SERVICER
*                      IF RECOVERY TEXTS EXIST (RFILE)
*                      THEN 
*                        BUILD RFT USING RECOVERY TEXTS 
*                        DO ONE TRANSFER (RFT -> STOPR) 
*                    BUILD RFT USING USER TEXTS (RFILE1)
*                    DO ONE TRANSFER (RFT -> STOPR) 
*                    IF TRANSFER SUCCESSFUL 
*                    THEN 
*                      SEND SERVICER MESSAGES TO DAYFILE OR TERMINAL
*                      APPEND NEW RECOVERY TEXTS TO RFILE 
*                      READ NEXT CONTROL STATEMENT
*                    ELSE 
*                      IF FORCE TERMINATION FLAG SET
*                        OR RETRY COUNT EXCEEDED
*                      THEN 
*                        ABORT
  
  
 MFK      SUBR               ENTRY/EXIT 
  
 MFLMAIN  EQU    MFK         EXTERNAL ENTRY POINT 
  
          SA1    XFR         FILE TRANSFER FLAG 
          SX6    B1 
          IX1    X1-X6
          ZR     X1,MFK3     IF RETURNING FROM RECOVERY TEXT NETXFR 
          IX1    X1-X6
          ZR     X1,MFK6     IF RETURNING FROM USER TEXT NETXFR 
          RJ     PCP         PERFORM FIRST TIME INITIALIZATIONS 
          NZ     X6,MFK9     IF ERROR DETECTED
  
 MFK1     RJ     VMF         VALIDATE MFLINK STATEMENT
          NZ     X6,MFK9     IF ERROR IN MFLINK STATEMENT 
          RJ     GUT         GET USER TEXTS (CALLS TSC IF INTERACTIVE)
          NZ     X6,MFK9     IF ERROR DETECTED
          SA1    STAT 
          MI     X1,MFK2     IF ALREADY CONNECTED 
          BX6    X6-X6
          SA6    NWTYPE      RESET INITIAL NETWORK TYPE 
          SA6    NIFFTE      ENABLE ALL AVAILABLE INTERFACES
  
 MFK2     SA1    DDINI       INITIAL NETXFR DD
          BX6    X6-X6
          LX7    X1 
          SA7    DDXFR       RESET NETXFR DD
          SA6    FTE         RESET FORCE TERMINATION FLAG 
          SA6    RECFLG      SET RECOVERY NOT IN PROGRESS 
          SA6    REXMIT      RESET RETRANSMIT REQUESTED 
          SA6    RFI2FLG     SET NO TEXTS SAVED ON RFILE2 
          SA6    SWTW        RESET SWT STATUS WORD
          SA1    AASS        NORMAL STATE-OF-TRANSFER 
          BX6    X1 
          SA6    TSTA        RESET STATE-OF-TRANSFER
          RJ     NRC         NETON AND REQUEST CONNECTION 
 NOS      IFEQ   OS$NOS 
          ZR     X6,MFK2.1   IF NO ERROR
          SA1    RT 
          NZ     X1,MFK8.1   IF REAL-TIME RESPONSE
 MFK2.1   BSS    0
 NOS      ENDIF 
          NZ     X6,MFK8     IF ERROR 
          MI     X6,MFK5     IF ALREADY CONNECTED 
          SA1    RFILFLG     RECOVERY TEXTS EXIST FLAG
          ZR     X1,MFK5     IF NO RECOVERY TEXTS 
          SX6    B1 
          SA6    RECFLG      SET RECOVERY IN PROGRESS 
          MESSAGE PRMM,1,RCL *RECOVERING ST LID*
          REWIND RFILE,RCL   REWIND RECOVERY FILE 
          READNS X2,RCL      NON-STOP READ (IGNORE EOR) 
          READW  X2,LINE,B1  SKIP OVER RECOVERY FILE HEADER 
          MX6    0           SET RFILE FLAG 
          RJ     PFS         PERFORM TRANSFER SETUP 
          NZ     X6,MFK8     IF ERROR 
          MI     X6,MFK4     IF NO NETXFR NEEDED
          SX6    B1 
          SA6    XFR         SET XFR FLAG TO RETURN TO MFK3 
          EQ     MFKX        RETURN TO (0,0) TO CALL (2,0) NETXFR 
  
 MFK3     BX6    X6-X6       RETURN FROM NETXFR (2,0) 
          SA6    XFR         SET NO XFR IN PROGRESS 
          RJ     PFT         PERFORM TRANSFER CLEANUP 
          NZ     X6,MFK8     IF ERROR 
  
 MFK4     RJ     STC         SEND STOP COMMAND
          NZ     X6,MFK8     IF ERROR DETECTED
          BX6    X6-X6
          SA6    RECFLG      SET RECOVERY NOT IN PROGRESS 
  
 MFK5     MESSAGE PRSM,1,RCL *USER REQUEST SENT*
          REWIND RFILE1,RCL  REWIND USER TEXT FILE
          READ   X2          INITIATE READ ON USER TEXT FILE
          SX6    B1          SET NOT-RFILE FLAG 
          RJ     PFS         PERFORM TRANSFER SETUP 
          NZ     X6,MFK8     IF ERROR 
          MI     X6,MFK7     IF NO NETXFR NEEDED
          SX6    B1+B1
          SA6    XFR         SET XFR FLAG TO RETURN TO MFK6 
          EQ     MFKX        RETURN TO (0,0) TO CALL (2,0) NETXFR 
  
 MFK6     BX6    X6-X6       RETURN FROM NETXFR (2,0) 
          SA6    XFR         SET NO XFR IN PROGRESS 
          RJ     PFT         PERFORM TRANSFER CLEANUP 
          NZ     X6,MFK8     IF ERROR 
  
 MFK7     RJ     STC         SEND STOP COMMAND
          ZR     X6,MFK9     IF NO ERROR DETECTED 
  
*         HERE IF ERROR OCCURED DURING FILE TRANSFER. 
*         IF EP NOT SELECTED AND RETRY COUNT NOT EXCEEDED,
*         ATTEMPT TO RETRY TRANSFER.
  
 MFK8     SA1    FTE         FORCE TERMINATION FLAG 
          NZ     X1,MFK9     IF TERMINATION FLAG SET
          SA1    EP 
          SA2    RT 
          BX1    X1+X2
          NZ     X1,MFK8A    IF ERROR PROCESSING IS SELECTED
          RJ     TSC         TERMINATE SERVICER CONNECTION
          SA1    RTYCNT      RETRY COUNT
          SX6    B1 
          IX6    X1-X6       DECREMENT RETRY COUNT
          SA6    A1 
          MI     X1,MFK8.1   IF RETRY COUNT EXCEEDED
          SX4    SDELAYT     SHORT DELAY TIME 
          RJ     DEL         SHORT DELAY BETWEEN RETRIES
          EQ     MFK2        RETRY
  
*         HERE IF RETRY COUNT EXCEEDED FOR CURRENT NETWORK. 
*         DISABLE FURTHER ATTEMPTS TO THIS NETWORK AND ATTEMPT TO 
*         EFFECT TRANSFER THROUGH AN ALTERNATE NETWORK. 
  
 MFK8.1   SX6    MAXRTRY
          SA6    RTYCNT      RESET TRANSFER RETRY COUNT 
          SA1    NWTYPE      CURRENTLY SELECTED NETWORK 
          SX6    B1 
          SB6    X1 
          SA2    NIFFTE      NETWORKS ALREADY DISABLED
          LX6    B6,X6       (X6) = 2**(NWTYPE) 
          BX6    X2+X6       DISABLE CURRENT NETWORK
          SA6    A2 
          RJ     ANW         SELECT ALTERNATE NETWORK 
          NZ     X6,MFK2     IF ALTERNATE NETWORK POSSIBLE
  
 MFK8A    MX6    -1 
          SA6    FTE         SET FORCE TERMINATION AND ABORT
  
*         HERE AT END OF TRANSFER.
*         IF FORCE TERMINATION FLAG NOT SET,
*         CHECK NEXT CONTROL STATEMENT FOR ANOTHER *MFLINK*.
  
 MFK9     BSS    0
          RJ     CRT         COPY ANY NEW RECOVERY TEXT TO RFILE
          SA1    FTE
          NZ     X1,MFK10    IF TERMINATION FLAG SET
          SA2    SWTF 
          NZ     X2,MFK10    MFLINK MACRO CALL
          RJ     RNC         READ NEXT CONTROL STATEMENT
          NZ     X1,MFK10    IF NO MORE MFLINK STATEMENTS 
          MESSAGE (=C* MFLINK COMPLETE.*),3,RCL 
          MESSAGE RA.CCD,6,RCL
          EQ     MFK1        PROCESS NEXT MFLINK
  
 MFK10    RJ     TSC         TERMINATE SERVICER CONNECTION
 DBG      IFC    EQ,*"DEBUG"*DEBUG* 
          SA1    DBG
          LX1    59-1 
          MI     X1,MFK11    IF REPRIEVE TURNED OFF 
 DBG      ENDIF 
  
          RETURN RFILE1,RCL  RETURN SCRATCH FILES 
          RETURN RFILE2,RCL 
          RJ     =XDFTERM    ENSURE PC-PREFIXED STATEMENTS FLUSHED
          SB1    1
          RECOVR =XMFLRPV,0,0   CLEAR REPRIEVE PROCESSING 
  
 DBG      IFC    EQ,*"DEBUG"*DEBUG* 
 MFK11    BSS    0
 DBG      ENDIF 
  
          SA1    FTE
          MI     X1,MFK13    IF ERROR ABORT 
          NZ     X1,MFK12    IF SECURITY VIOLATION
          MESSAGE (=C* MFLINK COMPLETE.*),3,RCL 
          SA2    SWTF 
          ZR     X2,MFK11.1  NOT MACRO CALL 
          RJ     =XSWT
 MFK11.1  BSS    0
          ENDRUN             NORMAL TERMINATION 
  
 MFK12    BSS    0
  
 NOS      IFEQ   OS$NOS 
          DECCNT MFKA 
 NOS      ENDIF 
  
 MFK13    BSS    0
  
          MESSAGE  (=C* MFLINK ABORT.*),3,RCL 
  
 MFK14    SA2    SWTF 
          ZR     X2,MFK15    IF NOT A MACRO CALL
          RJ     =XSWT
  
 MFK15    ABORT  ,ND
  
 NOS      IFEQ   OS$NOS 
 MFKA     BSS    0           PARAMETER BLOCK FOR DECCNT 
          CON    0
          CON    1S3
          BSSZ   4
 NOS      ENDIF 
          TITLE  PRIMARY SUBROUTINES. 
 ANW      SPACE  4,10 
**        ANW - SWITCH TO ALTERNATE SUBSYSTEM.
* 
*         ANW DETERMINES IN THE CASE OF CONNECTION OR TRANSFER ERRORS 
*         IF A PATH EXISTS TO THE REQUESTED LID THROUGH AN ALTERNATE
*         SUBSYSTEM.
* 
*         ENTRY  (NWTYPE) = CURRENT NETWORK TYPE. 
*                (NIFFTE) = DISABLED NETWORKS.
* 
*         EXIT   (X6) = 0, IF ALL NETWORKS ARE DISABLED.
*                (NWTYPE) = FIRST AVAILABLE NETWORK,
*                           BEGINNING WITH (NWTYPE).
  
  
 ANW      SUBR
          SA1    NIFFTE      NETWORK INTERFACES DISABLED
          SA2    NIFTYPE     AVAILABLE INTERFACES 
          BX6    -X1*X2 
          SA2    NWTYPE      CURRENT NETWORK TYPE 
          SB6    X2 
          ZR     X6,ANW2     IF NO NETWORKS REMAIN
          AX0    B6,X6       SHIFT OFF PREVIOUSLY TRIED NETWORKS
          NZ     X0,ANW1     IF LOWER PRIORITY NETWORKS REMAIN
          SB6    B0          START OVER WITH HIGHEST PRIORITY 
          BX0    X6 
  
 ANW1     LX0    -1          CHECK NEXT NETWORK 
          MI     X0,ANW2     IF NETWORK INTERFACE AVAILABLE 
          SB6    B6+B1       INCREMENT NWTYPE 
          EQ     ANW1        TRY NEXT NETWORK 
  
 ANW2     SX7    B6          (X6) = NIFLEFT 
          SA7    A2          STORE NEW NWTYPE 
          EQ     ANWX        RETURN 
 CRT      SPACE  4,10 
**        CRT - COPY NEW RECOVERY TEXTS TO RFILE. 
* 
*         CRT IS CALLED AT THE END OF A USER TEXT TRANSFER TO COPY
*         ANY NEW RECOVERY TEXTS RETURNED BY THE SERVICER ON THE
*         *RPOS* OR *RNEG* COMMANDS TO THE END OF THE RECOVERY FILE,
*         RFILE.  BECAUSE OF THE POSSIBILITY OF TRANSMISSION ERRORS 
*         REQUIRING THE TRANSFER TO BE RETRIED, THE TEXTS RETURNED
*         ARE FIRST COPIED TO A SCRATCH FILE (RFILE2) BY SUBROUTINE 
*         *PUT*.  ONLY AT THE END OF A SUCCESSFUL TRANSFER IS *CRT* 
*         CALLED TO REWIND AND APPEND *RFILE2* TO *RFILE*.
* 
*         ENTRY  (RFILE) POSITIONED AT END-OF-INFORMATION,
*                (RFILE2) CONTAINS NEW RECOVERY TEXTS (IF ANY). 
* 
*         EXIT   NEW TEXTS APPENDED TO (RFILE). 
  
  
 CRT      SUBR               ENTRY/EXIT 
          SA1    RFI2FLG     TEXTS SAVED ON RFILE2 FLAG 
          ZR     X1,CRT2     IF NO TEXTS SAVED
          BX6    X6-X6
          SA6    A1          RESET TEXTS SAVED FLAG 
          SA1    RFILE2+2    IN POINTER 
          SA2    A1+B1       OUT POINTER
          BX1    X1-X2
          ZR     X1,CRT0     IF BUFFER EMPTY
          WRITER RFILE2,RCL  FLUSH BUFFER 
  
 CRT0     REWIND RFILE2,RCL 
          READNS X2,RCL      PRIME BUFFER 
          READC  X2,LINE,LINEL
          NZ     X1,CRT2     IF NO RECOVERY TEXTS SAVED 
  
 CRT1     SA4    LINE        FWA TEXT 
          RJ     CTC         COMPLEMENT TEXT CHARACTERS 
          WRITEC RFILE,LINE  APPEND TEXT TO RECOVERY FILE 
          READC  RFILE2,LINE,LINEL READ NEXT TEXT 
          ZR     X1,CRT1     IF MORE TEXTS TO COPY
          WRITER RFILE,RCL   FLUSH RECOVERY TEXT BUFFER 
  
 CRT2     EQ     CRTX        RETURN 
 CTC      SPACE  4,10 
**        CTC - COMPLEMENT TEXT CHARACTERS
* 
*         CTC COMPLEMENTS EACH CHARACTER IN A ZERO-BYTE-TERMINATED
*         TEXT BUFFER.
* 
*         ENTRY  A4 = FWA TEXT BUFFER.
* 
*         EXIT   TEXT CHARACTERS COMPLEMENTED.
* 
*         USES   A - 4,6
*                B - NONE.
*                X - 0,4,6. 
  
 CTC      SUBR
          BX6    X4          TEXT WORD
          MX0    6           MASK 
 CTC1     BX4    X0*X6       NEXT CHARACTER 
          ZR     X4,CTC2     IF 00
          BX4    X0-X4       COMPLEMENT 
          ZR     X4,CTC2     IF 77B 
          BX6    -X0*X6      CLEAR OLD CHARACTER
          BX6    X6+X4       STORE COMPLEMENT 
 CTC2     LX0    6           REPOSITION MASK
          PL     X0,CTC1     IF MORE CHARACTERS IN WORD 
          SA6    A4          REPLACE TEXT WORD
          MX4    -12         MASK FOR ZERO-BYTE 
          BX4    -X4*X6 
          ZR     X4,CTCX     IF END OF TEXT 
          SA4    A4+B1       GET NEXT TEXT WORD 
          BX6    X4 
          EQ     CTC1 
 DLY      SPACE  4,10 
**        DLY - DELAY A WHILE.
* 
*         DLY DELAYS FOR A VARIABLE INTERVAL THAT INCREASES WITH THE
*         NUMBER OF RETRIES.
* 
*         DLYA = MAX DELAY TIME (NOS) OR SWAPOUT FLAG (NOS/BE). 
*         UPDATE PREVIOUS DAYFILE MESSAGE ADDR. 
*         IF NEW DAYFILE MESSAGE: 
*           APPEND * RETRYING TO (LID) * TO MESSAGE.
*           SEND DAYFILE MESSAGE. 
*           IF INTERACTIVE JOB: 
*             SEND MESSAGE TO OUTPUT FILE.
*         NCRETRY = +1 (INCREMENT RETRY COUNT). 
*         IF RETRY COUNT WAS .LT. NUMSRTY:  
*             DELAY (SDELAYT) SECONDS.
*         ELSE:  (RETRY COUNT WAS .GE. NUMSRTY) 
*             IF NOS: 
*               IF RETRY COUNT WAS .LT. (MAX DELAY/2):  
*                 NCRETRY = *2 (DOUBLE RETRY COUNT).
*               ELSE: 
*                 NCRETRY = DLYINT (RESET RETRY COUNT). 
*               DELAY TIME = MIN(PREV RETRY COUNT, MAX DELAY).
*               ENTER TIME/EVENT ROLLOUT WITH DELAY TIME. 
*             ELSE:  (IF NOS/BE)
*               IF RETRY COUNT WAS .EQ. NUMSRTY:  
*                 ATTACH DELAY FILE (SWAPOUT JOB) 
*                 SEND DAYFILE MESSAGE AGAIN
*                 IF JOB NOT SWAPPED OUT: 
*                   DELAY FOR (LDELAYT) SECONDS.
*               ELSE: 
*                 IF RETRY COUNT WAS .EQ. NUMSRTY+1:  
*                   DELAY FOR (LDELAYT) SECONDS.
*                 ELSE: (RETRY COUNT WAS .GT. NUMSRTY+1)
*                   DECREMENT RETRY COUNT.
*                   IF SWAPOUT PERMITTED: 
*                     RETURN DELAY FILE.
*                     DELAY (SIDELT) SECONDS. 
*                     ATTACH DELAY FILE (SWAPOUT JOB).
*                     SEND DAYFILE MESSAGE AGAIN. 
*                   DELAY FOR (LDELAYT) SECONDS.
*         RETURN. 
* 
*         ENTRY  (X1) = MESSAGE ADDRESS.
*                (X6) = SWAPOUT FLAG (NOS/BE).
*                NCRETRY = RETRY COUNTER. 
*                PDMESSA = PREVIOUS DAYFILE MESSAGE ADDR. 
* 
*         EXIT   NONE 
* 
*         CALLS  DEL, ZTB.
* 
*         USES   X0, A1/X1, A2/X2, A3/X3, A4/X4, A6/X6. 
  
  
 DLY      SUBR
  
 NOS      IFEQ   OS$NOS 
          SA3    INTORG 
          SX6    DLYJOB      MAX DELAY (BATCH)
          ZR     X3,DLY0     IF NOT INTERACTIVE 
          SX6    DLYINT      MAX DELAY (INTERACTIVE)
 NOS      ENDIF 
  
 DLY0     SA6    DLYA        SAVE MAX DELAY (NOS) OR SWAP-OUT FLAG
          SA3    PDMESSA     FETCH OLD MESSAGE ADDR 
          SX6    X1          NEW MESSAGE ADDR 
          BX3    X3-X6       COMPARE OLD AND NEW ADDRS
          ZR     X3,DLY3     IF NOT A NEW MESSAGE 
          SA6    A3          SAVE NEW MESSAGE ADDR
          MX0    -12         MASK 
          SA3    DLYA        PRESET MESSAGE STORE 
          BX6    X3 
          SA6    A3 
*                            (A6 = DLYA = DLYB-1) 
          ERRNZ  DLYB-DLYA-1 TEST ASSUMPTION
          SA1    X1-1        PRESET MESSAGE FETCH 
  
 DLY1     SA1    A1+B1       GET NEXT WORD IN MESSAGE 
          BX6    -X0*X1      CHECK FOR ZERO-BYTE
          ZR     X6,DLY2     IF ZERO-BYTE 
          BX6    X1 
          SA6    A6+B1       MOVE WORD TO DLYB BUFFER 
          EQ     DLY1        GET NEXT WORD
  
 DLY2     RJ     =XZTB=      BLANK-FILL LAST WORD 
          SA6    A6+B1       STORE IN BUFFER
          SA1    =L*RETRYING TO (LID)*
          BX6    X1 
          SA6    A6+B1       APPEND OPERATOR TEXT 
          SA3    A1+B1
          SA4    ST 
          MX0    18 
          LX4    42          POSITION LID 
          LX0    42          POSITION MASK
          BX3    -X0*X3 
          BX6    X3+X4       INSERT LID IN MESSAGE
          SA6    A6+B1
          MX1    0           MESSAGE OPTION - JOB DAYFILE 
          SX2    DLYB        MESSAGE ADDR 
          RJ     SDM         SEND DAYFILE MESSAGE 
  
 DLY3     SA1    NCRETRY     FETCH RETRY COUNT
          SX6    X1+B1
          SA6    A1          INCREMENT COUNT
          SX4    SDELAYT     SET SHORT DELAY TIME 
          SX2    X1-NUMSRTY 
          NG     X2,DLY7     IF SHORT DELAY 
  
 NOS      IFEQ   OS$NOS 
          AX4    X6,B1       SET LONG DELAY 
          SA2    DLYA        FETCH MAX DELAY
          SX6    DLYINT      NEW RETRY COUNT = INTERACTIVE DELAY
          IX3    X2-X4
          NG     X3,DLY4     IF LONG DELAY .GT. MAX 
          LX6    X1,B1       NEW RETRY COUNT = OLD * 2
          BX2    X4 
 DLY4     SA6    A6          UPDATE RETRY COUNT 
          SX6    /EVT/EXTM
          LX6    12D
          BX6    X6+X2
          SA6    DLYA 
          ROLLOUT DLYA       ROLLOUT JOB
          EQ     DLY8        RETURN 
  
 NOS      ELSE
          AX4    X2,B1
          MX6    -1 
          ZR     X2,DLY5     IF 1ST LONG DELAY
          ZR     X4,DLY6     IF 2D LONG DELAY 
          IX6    X1+X6
          SA4    DLYA        FETCH SWAPOUT FLAG 
          SA6    A6          DECREMENT RETRY COUNT
          ZR     X4,DLY6     IF NOT SWAPPING JOB
          RETURN ZZZZZDL,R
          SX4    SIDELT      ALLOW JOB WAITING FOR DELAY FILE 
          RJ     DEL           TIME TO SWAP IN AND ATTACH FILE
  
 DLY5     BSS    0
          ATTACH FDBADDR,RC  ATTEMPT TO SWAP JOB
          MESSAGE DLYB,2,RCL REISSUE MESSAGE TO B-DISP
  
 DLY6     SX4    LDELAYT     SET LONG DELAY COUNT 
 NOS      ENDIF 
  
 DLY7     RJ     DEL         DELAY FOR (X4) SECONDS 
  
 DLY8     EQ     DLYX 
  
*         DLY FLAGS AND BUFFERS 
  
 DLYA     BSS    1           MAX DELAY TIME / SWAPOUT FLAG
 DLYB     BSS    10          MESSAGE AREA 
DEL       SPACE  4,10 
**        DEL - DELAY FOR A WHILE.
* 
*         WHILE DELAY TIME NOT ELAPSED DO 
*           RECALL FOR A WHILE. 
* 
*         ENTRY  (X4) = AMOUNT OF TIME TO DELAY (SECONDS) 
* 
*         EXIT   NONE.
* 
*         CALLS  RTIME, SYSTEM. 
* 
*         USES   X0, A1/X1, X4, A6/X6.
  
  
 DEL      SUBR
          MX0    -24         MASK FOR SECONDS 
          RTIME  DELA        GET CURRENT TIME 
          SA1    DELA 
          LX1    S=RTIME     POSITION CURRENT SECONDS 
          BX1    -X0*X1      MASK SECONDS 
          IX4    X4+X1       FORM FINAL TIME
          BX4    -X0*X4      MASK OUT OVERFLOW
 DEL1     IX6    X1-X4       CURRENT - FINAL TIME 
          PL     X6,DELX     IF DELAY COMPLETE
  
 NOS      IFEQ   OS$NOS 
          WAIT   1000D       WAIT 1 SECOND
  
 NOS      ELSE
          SYSTEM RCL,,3777B  RECALL A WHILE 
 NOS      ENDIF 
  
          RTIME  DELA        GET CURRENT TIME 
          SA1    DELA 
          LX1    S=RTIME     POSITION SECONDS 
          BX1    -X0*X1      MASK SECONDS 
          EQ     DEL1 
  
 DELA     BSS    1           CURRENT TIME 
 GUT      SPACE  4,10 
**        GUT - GET USER TEXTS. 
* 
*         GUT IS CALLED TO GET THE NEXT SET OF USER TEXT DIRECTIVES.
*         GUT CALLS DIRFRD TO OBTAIN TEXTS FROM EITHER PC-PREFIXED
*         CONTROL STATEMENTS IN THE CONTROL STATEMENT RECORD, FROM
*         A FILE, OR FROM THE TERMINAL.  IF GETTING TEXTS FROM THE
*         TERMINAL, ANY EXISTING SERVICER CONNECTION WILL BE
*         TERMINATED. 
* 
*         ENTRY  (I) AND (PC) SET UP BY *VMF*.
* 
*         EXIT   (X6) = 0, IF NO ERROR DETECTED 
*                     NE 0, IF ERROR. 
*                (INT) NE 0, IF GETTING TEXTS FROM TERMINAL.
*                *RFILE1* CONTAINS USER TEXTS.
  
  
 GUT      SUBR               ENTRY/EXIT 
          BX6    X6-X6
          SA6    GUTB        SET NO TEXTS FOUND 
          REWIND RFILE1,RCL  REWIND USER TEXTS FILE 
          RJL    =XDFINIT,I,(PC,=7LMFLINK ,INT,GUTA,GUTD) 
          SB1    1
          SA1    GUTA        DFINIT ERROR FLAG
          NZ     X1,GUT3     IF ERROR 
          SA1    INT         INTERACTIVE MODE FLAG
          ZR     X1,GUT1     IF NOT INTERACTIVE MODE
          RJ     TSC         TERMINATE SERVICER CONNECTION
  
 GUT1     RJL    =XDFREAD,LINE,(GUTC,GUTA)
          SB1    1
          SA1    GUTA        TEXT LENGTH
          MI     X1,GUT2     IF END OF TEXTS
          WRITEH RFILE1,LINE,LINEL
          SX6    B1 
          SA6    GUTB        SET TEXT FOUND 
          EQ     GUT1        GET NEXT TEXT
  
 GUT2     WRITER RFILE1,RCL  FLUSH TEXT FILE
          SA1    GUTB 
          BX6    X6-X6       ASSUME NORMAL RETURN 
          NZ     X1,GUT4     IF SOME TEXTS FOUND
*         MX1    0           MESSAGE OPTION - JOB DAYFILE 
          SX2    NUTM        MESSAGE ADDR 
          RJ     SDM         SEND DAYFILE MESSAGE 
  
 GUT3     MX6    -1 
          SA6    FTE         SET FORCE TERMINATION WITH ERROR 
  
 GUT4     EQ     GUTX        RETURN 
  
 GUTA     CON    0           DFINIT AND DIRFRD RETURN WORD
  
 GUTB     CON    0           TEXT FOUND FLAG
  
 GUTC     CON    LINEL       MAXIMUM TEXT LENGTH
  
 GUTD     CON    0           DIRECTIVE-FILE-REQUIRED FLAG 
 NRC      SPACE  4,10 
**        NRC - NETON AND REQUEST CONNECTION. 
* 
*         THIS ROUTINE IS CALLED TO ESTABLISH THE INITIAL 
*         CONNECTION WITH THE NETWORK.  NRC PERFORMS THE
*         *NETON* REQUEST AND IF SUCCESSFULL WILL SEND AN 
*         APPLICATION CONNECTION REQUEST (*CON/ACRQ/R*) VIA A 
*         *NETPUT* SUPERVISORY MESSAGE.  THE ROUTINE *ECL* IS 
*         THEN CALLED TO FINISH THE CONNECTION SEQUENCE.
* 
*         ENTRY  (APPL) = APPLICATION NAME. 
* 
*         EXIT   (STAT) = CURRENT CONNECTION STATUS 
*                (X6) < 0 IF ERROR
*                     = -0 IF ALREADY CONNECTED 
*                     = +0 IF NEW CONNECTION ESTABLISHED
  
  
 NRC      SUBR               ENTRY/EXIT 
          SA1    STAT 
          MX6    60          SET ALREADY CONNECTED
          MI     X1,NRC11    IF ALREADY CONNECTED 
          SX6    MAXRTRY-1
          SA6    NRCA        RESET NETWORK RETRY COUNT
          BX6    X6-X6
          SA6    LCMD        SET NO COMMAND RECEIVED
          SA6    NCRETRY     INITIALIZE RETRY COUNT 
          MX6    -1 
          SA6    NRCK        PREVIOUS CON/ACRQ/A REASON CODE
          SA6    PDMESSA     PREVIOUS MESSAGE ADDRESS 
  
 NRC1     SA1    STAT 
          ZR     X1,NRC2     IF ALREADY NETTED ON 
  
 NOS      IFEQ   OS$NOS 
          SA1    ST 
          SX6    B1 
          BX6    X1+X6       SET COMPLETE BIT 
          SA6    NRCB        STORE PARAMETER WORD 
          GETLIDA NRCB       GET LID ATTRIBUTES 
          SA1    NRCB        GET PARAMETER WORD 
          LX1    59-41       LEFT-JUSTIFY ATTRIBUTES
          BX2    X1 
          SA1    NRCH        *LID NO LONGER AVAILABLE*
          LX2    59-40-59+41 POSITION LINKED ATTRIBUTE
          BX3    X2 
          LX3    59-35-59+40 POSITION LOOPBACK ATTRIBUTE
          BX3    X2+X3       LINKED .OR. LOOPBACK 
          LX2    59-39-59+40 POSITION ENABLED ATTRIBUTE 
          BX4    X2 
          PL     X3,NRC9     IF NEITHER LINKED NOR LOOPBACK 
          SA1    NRCI        *LID DISABLED* 
          PL     X2,NRC9     IF LID DISABLED
          LX2    0-19-59+39  RHF PATH AVAILABLE 
          LX4    0-18-59+39  NAM PATH AVAILABLE 
          MX0    -1 
          BX2    -X0*X2      ISOLATE RHF AVAILABLE
          BX3    -X0*X4      ISOLATE NAM AVAILABLE
          LX3    1
          BX6    X2+X3       BIT 0 = RHF, BIT 1 = NAM 
 NOS      ELSE
          SX6    B1          ASSUME RHF AVAILABLE 
 NOS      ENDIF 
  
          SA1    NIFFTE      NETWORKS DISABLED
          SA2    NIFTYPE     INTERFACES AVAILABLE 
          BX3    -X1*X2      INTERFACES NOT DISABLED
          BX2    X3*X6       (PATHS IN SERVICE) * (NETS NOT DISABLED) 
          ZR     X2,NRC2.1   IF NO PATHS AVAILABLE
          BX6    -X2         ALL DISABLED EXCEPT PATHS IN SERVICE 
          SA6    A1 
          BX7    X1 
          SA7    NRCB        SAVE *NIFFTE* VALUE
          RJ     ANW         SELECT NETWORK INTERFACE 
          SA1    NRCB 
          BX6    X1 
          SA6    NIFFTE      RESTORE *NIFFTE* 
          RJL    =XFTUSNET,NWTYPE  SELECT NETWORK INTERFACE 
          RJL    =XFTUSETF,=1,(NRCB)
          RJL    =XFTUON,APPL,(QBIT,STAT,=1,=1) 
          SB1    1
          SA1    STAT 
          NZ     X1,NRC3     IF NETON UNSUCCESSFUL
          RJL    =XFTUDBG,=0,(=0,NRCB,=0) 
          SB1    1
  
 NRC2     BX6    X6-X6       CLEAR OUT SUPERVISORY REQUEST AREA 
          SA6    STAB 
          SA6    A6+B1
          SA3    ST          GET LID
          SA2    SRVAPPL
          LX3    18 
          BX6    X3 
          SA6    STAB        SET LID IN CON/ACRQ/R
          NSTORE STAB,CONANM=X2 
          NSTORE STAB,PFCSFC=CONACR 
          NSTORE SHAB,ABHABT=3
          NSTORE SHAB,ABHACT=B1 
          NSTORE SHAB,ABHTLC=2
          NSTORE SHAB,ABHADR=B0 
          MESSAGE  PCTM,1,R  *MFLINK - CONNECTING TO LID.*
          RJL    =XFTUPUT,SHAB,(STAB) 
          SB1    1
          RJ     =XSTT       SET TIMEOUT TIME 
          SA1    SHMP 
          RJ     =XECL       ESTABLISH CONNUNICATIONS LINK
          NZ     X1,NRC6     IF CONNECTION FAILED 
 NOSBE    IFEQ   OS$NOSBE 
          RETURN ZZZZZDL,R
 NOSBE    ENDIF 
          BX6    X6-X6       SET CONNECTION ESTABLISHED 
          EQ     NRC11
  
 NRC2.1   SA2    NIFFTE      HERE IF NO PATHS AVAILABLE 
          SX1    3
          LX1    57-0        *ABORT* ACTION CODE, NO MESSAGE
          NZ     X2,NRC9     IF NO PATHS ARE NOW AVAILABLE
*                              AND AT LEAST ONE WAS PREVIOUSLY
*                              DISABLED.
          SA1    NRCG        *NO PATHS AVAILABLE* 
          EQ     NRC9        IF NO PATHS AVAILABLE AND NONE DISABLED
  
 NRC3     SA1    STAT 
          SX1    X1-1 
          MI     X1,NRC4     IF INVALID NETON STATUS
          SX6    X1-NRCD
          MI     X6,NRC5     IF STATUS IN RANGE 
  
 NRC4     SX1    X1+B1
          RJ     =XCDZ       CONVERT BINARY TO DISPLAY CODE 
          SA1    NRCC+NRCD-1 *CT = NN.   *
          SA1    X1+2 
          MX0    2*6
          LX6    3*6         POSITION DIGITS
          LX0    -5*6 
          BX1    -X0*X1 
          BX6    X0*X6
          BX6    X1+X6
          SA6    A1 
          SX1    NRCD-1      *NETON REJECT = NN*
  
 NRC5     SA1    NRCC+X1     GET MESSAGE ADDRESS
          EQ     NRC9        SEND MESSAGE OR DELAY
  
 NRC6     SX2    ACBM        *CONNECTION BROKEN*
          IX2    X1-X2
          NZ     X2,NRC6.1   IF NOT CONNECTION BROKEN 
          RJ     TSC         TERMINATE SERVICER CONNECTION
          SX1    ACBM        RESTORE MESSAGE
          SX6    1           SWAPOUT ALLOWED
          EQ     NRC9        SEND MESSAGE OR DELAY
  
 NRC6.1   SX2    ACRM        *CONNECTION REJECT*
          IX2    X1-X2
          NZ     X2,NRC10    IF NOT CONNECTION REJECTED 
          RJ     TSC         TERMINATE SERVICER CONNECTION
          NFETCH STAB,RC,X1  GET *ACRQ/A* REASON CODE 
          MX0    -4 
          BX5    -X0*X1      EXTRACT RC1 SUBFIELD 
          SX2    X5-NRCF     CHECK REASON CODE
          NG     X2,NRC6.2   IF VALID 
          SX5    NRCEINV     *INVALID REASON CODE*
  
 NRC6.2   BSS    0
          SA2    NRCK        GET PREVIOUS REASON CODE 
          BX6    X1 
          BX2    X1-X2
          SA6    A2          STORE NEW REASON CODE
          ZR     X2,NRC8     IF SAME REASON CODE
          BX6    X6-X6
          SA6    PDMESSA     CLEAR PREVIOUS MESSAGE ADDRESS 
          RJ     =XCDD=      CONVERT TO DECIMAL DPC 
          SA1    NWTYPE 
          SA2    NRCJ        ADDRESS OF MESSAGE 
          SA1    X1+NRCL     *RHF* OR *NAM* 
          BX6    X1 
          SA6    X2+3        SET NETWORK IN MESSAGE 
          SX6    1R &1R-
          SA1    X2+5        (X1) = *E = NNN - *
          LX6    48-0 
          AX6    B2,X6
          BX6    X4-X6       (X6) = *NNN -     *
          LX6    -4*6        (X6) = *    NNN - *
          MX0    4*6
          BX1    X0*X1       (X1) = *E =       *
          BX6    -X0*X6      (X6) = *    NNN - *
          BX6    X1+X6       (X6) = *E = NNN - *
          SA6    A1          STORE IN MESSAGE 
          MESSAGE X2,6,RCL   DO NOT SEND TO NBE TERMINAL
  
 NRC8     SA1    NRCE+X5     GET MESSAGE ADDRESS
  
 NRC9     BX7    X1 
          SA7    NRCB        SAVE ERROR 
          SA2    RT 
          NZ     X2,NRC10    IF REAL TIME RESPONSE
          MI     X1,NRC10    IF FATAL ERROR 
          LX7    0-57        HERE IF CODE LESS THAN 4 
          MX6    -2 
          BX6    -X6*X7      CODES 0 THROUGH 3
          SB6    X6 
          MX6    -1 
          LX7    0-56-0+57   POSITION NBE SWAP FLAG (COMPLEMENTED)
          BX7    -X6*X7      (X1) = MESSAGE ADDRESS (OR 0)
          BX6    -X6-X7      (X6) = NBE SWAP ALLOWED FLAG 
          JP     B6+NRC9A    SIMULATED CASE STATEMENT 
  
 NRC9A    BSS    0           CASE STATEMENT JUMP VECTOR 
          LOC    0
 +        EQ     NRC9.0      DELAY, TRY ALL NETWORKS FROM CURRENT 
 +        EQ     NRC9.1      DELAY, TRY ALL STARTING FROM FIRST 
 +        EQ     NRC9.2      DELAY, RETRY CURRENT, THEN OTHERS
 +        EQ     NRC9.3      FORCE TERMINATION, DO NOT TRY OTHERS 
          LOC    *O 
  
 NRC9.0   RJ     DLY         DELAY
          SA1    NWTYPE      CURRENT NETWORK
          SX6    X1+B1
          SA6    A1          TRY NEXT AVAILABLE NETWORK 
          EQ     NRC9.8      END OF CASE
  
 NRC9.1   RJ     DLY         DELAY
          BX6    X6-X6
          SA6    NWTYPE      TRY HIGHEST PRIORITY NETWORK FIRST 
          SA6    NIFFTE      REENABLE ALL NETWORKS
          EQ     NRC9.8      END OF CASE
  
 NRC9.2   RJ     DLY         DELAY
          SA1    NRCA        CURRENT NETWORK RETRY COUNT
          SX6    X1-1        DECREMENT RETRY COUNT
          SA6    A1 
          PL     X6,NRC9.8   IF NOT EXPIRED 
          SX6    MAXRTRY-1
          SA6    A1          RESET RETRY COUNT
          SA1    NWTYPE 
          SX6    X1+B1       TRY NEXT AVAILABLE NETWORK 
          SA6    A1 
          EQ     NRC9.8      END OF CASE
  
 NRC9.3   BX7    -X7-X7      (X7) = -0
          MX6    -1 
          SA7    NIFFTE      DISABLE ALL RETRIES
          SA6    FTE         FORCE TERMINATION
          EQ     NRC9.8      END OF CASE
  
 NRC9.8   PL     X6,NRC1     IF RETRY POSSIBLE
          SA1    NRCB 
  
 NRC10    SX2    X1          MESSAGE ADDR 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          RJ     SDM         SEND DAYFILE MESSAGE 
  
 NOSBE    IFEQ   OS$NOSBE 
          RETURN ZZZZZDL,R
 NOSBE    ENDIF 
  
          MX6    -1          FLAG ERROR 
          SX7    1S6+ENFT 
          SA7    SWTW        SET MFLCALL STATUS 
  
 NRC11    EQ     NRCX        RETURN 
  
 NRCA     CON    0           CURRENT NETWORK RETRY COUNT
  
 NRCB     CON    0           TEMPORARY STORAGE
  
**        NRC ACTION RETRY CODES. 
* 
*         CON    NS57+IS56+* MFLINK - MESSAGE.* 
* 
*         WHERE  N = THREE-BIT CODE WHICH DETERMINES NRC RETRY ACTION.
*                (0 - 3) - SEE NRC9A CASE STATEMENT ABOVE.
*                (4) - FORCE TERMINATION, RETRY IN *MFK*. 
* 
*                I = 1, IF NBE SWAP NOT ALLOWED.
  
 NRCC     BSS    0           NETON STATUS MESSAGES
          LOC    1
          CON    0S57+1S56+=C* MFLINK - SUBSYSTEM UNAVAILABLE.* 
          CON    0S57+1S56+=C* MFLINK - SUBSYSTEM FULL.*
          CON    0S57+1S56+=C* MFLINK - APPLICATION DISABLED.*
 NRCD     CON    4S57+1S56+=C* MFLINK - NETON REJECT = NN.* 
          LOC    *O 
  
 NRCE     BSS    0           *CON/ACRQ/A* STATUS CODES
          LOC    0
 NRCEINV  CON    4S57+=C* MFLINK - CONNECT REJECT, INVALID REASON CODE.*
          CON    4S57+=C* MFLINK - LID UNKNOWN TO SUBSYSTEM.* 
          CON    4S57+=C* MFLINK - CONNECTION REJECTED BY REMOTE HOST.* 
          CON    2S57+=C* MFLINK - LOCAL NETWORK RESOURCE LIMIT. *
          CON    2S57+=C* MFLINK - REMOTE SUBSYSTEM RESOURCE LIMIT.*
          CON    0S57+=C* MFLINK - LID CURRENTLY UNAVAILABLE.*
          CON    0S57+=C* MFLINK - REMOTE SUBSYSTEM NOT RESPONDING.*
          LOC    *O 
 NRCF     EQU    *-NRCE      MAX VALID REASON CODE + 1
  
 NRCG     CON    1S57+=C* MFLINK - NO PATHS AVAILABLE TO LID.*
  
 NOS      IFEQ   OS$NOS 
  
 NRCH     CON    3S57+=C* MFLINK - LID NO LONGER AVAILABLE.*
  
 NRCI     CON    1S57+=C* MFLINK - LID DISABLED.* 
  
 NOS      ENDIF 
  
 NRCJ     CON    =C* MFLINK - CONNECTION REJECTED BY XXX.   REASON CODE 
,= NNN - *
  
 NRCK     CON    0           PREVIOUS CONNECTION REJECT CODE
  
 NRCL     BSS    0           INDEXED BY NETWORK TYPE
          CON    10HBY RHF. 
          CON    10HBY NAM. 
 PFS      SPACE  4,10 
**        PFS - PERFORM FILE TRANSFER SETUP.
* 
*         PFS INITIATES AND CONTROLS THE PROTOCOL EXCHANGE WITH THE 
*         SERVICER FROM *RFT* UP TO EITHER NETXFR REQUIRED OR *STOP*
*         REQUIRED (IF NO TRANSFER NEEDED). 
* 
*         ENTRY  (X2) = FET ADDRESS OF TEXT FILE
* 
*         EXIT   (X6) < 0 IF ERROR
*                     = -0 IF NO TRANSFER NEEDED
*                     = +0 IF TRANSFER REQUIRED 
  
  
 PFS      SUBR               ENTRY/EXIT 
          SA6    PFSA+1      SAVE RFILE FLAG
          BX6    X2 
          SA6    A6-B1       SAVE FET ADDR
  
*         BUILD *RFT* COMMAND BLOCK.
  
          ACSTORE  SMB,RFT,MBL
          RJL    =XSNP,HMAP,(SMB,/AP/ID,SELECT,/AP/IDL,CURID) 
          NZ     X1,PFS6     IF ERROR 
          SA1    NWTYPE      GET NETWORK TYPE 
          MX6    -6 
          SA2    X1+PFSE     FACILITIES AND LENGTH
          BX7    X6*X2       RHF=*C*  NAM=*CRMS*
          SA7    FACTEXT     STORE TEXT FOR RFT 
          LX7    6           REMOVE *C* FROM TEXT 
          BX7    X6*X7       RHF=0    NAM=*RMS* 
          SA7    FACIL       STORE TEXT FOR NETXFR
          BX6    -X6*X2      RFT TEXT LENGTH
          SA6    FACTXTL     RHF=1    NAM=4 
          RJL    =XSNP,HMAP,(SMB,/AP/FAC,SELECT,FACTXTL,FACTEXT)
          NZ     X1,PFS6     IF ERROR 
          RJL    =XSNP,HMAP,(SMB,/AP/TMOUT,SELECT,/AP/TMOUTL,DTMO)
          NZ     X1,PFS6     IF ERROR 
          RJL    =XSNP,HMAP,(SMB,/AP/LID,SELECT,/AP/LIDL,ST)
          NZ     X1,PFS6     IF ERROR 
          RJL    =XSNP,HMAP,(SMB,/AP/PID,SELECT,/AP/PIDL,PIDHOST) 
          NZ     X1,PFS6     IF ERROR 
          RJL    =XSNP,HMAP,(SMB,/AP/JOBN,SELECT,/AP/JOBNL,JOBNAME) 
          NZ     X1,PFS6     IF ERROR 
          RJL    =XSNP,HMAP,(SMB,/AP/HOSTT,SELECT,/AP/HOSTTL,HT)
          NZ     X1,PFS6     IF ERROR 
          RJL    =XGFL,F,(DDXFR)   GET FILE LENGTH
          SA6    PFSB        SAVE CODED LENGTH
          SA7    PFSC        SAVE GFL FLAGS 
          BX7    X5 
          SA7    PFSD        SAVE FILE STATUS WORD
          RJL    =XSNP,HMAP,(SMB,/AP/SIZE,SELECT,/AP/SIZEL,PFSB)
          NZ     X1,PFS6     IF ERROR 
          SA1    DD 
          ZR     X1,PFS1     IF NO DD SPECIFIED 
          RJL    =XSNP,HMAP,(SMB,/AP/TYPE,SELECT,/AP/TYPEL,DD)
          NZ     X1,PFS6     IF ERROR 
  
 PFS1     SA1    DBZ         DOWNLINE BLOCK SIZE
          SX2    NAMDBZ      DEFAULT MINIMUM BLOCK SIZE (NAM) 
          IX6    X1-X2
          AX6    59 
          BX1    -X6*X1 
          BX2    X6*X2
          BX6    X1+X2       (X6)=MAX(DBZ,NAMDBZ) 
          SA6    MBSIZE      SAVE FOR MBZ CALL (DBZ IGNORED FOR RHF)
          RJL    =XMBZ,DDXFR,(MBSIZE,NWTYPE)
          SA6    MBSIZE      MAXIMUM BLOCK SIZE 
          SA1    NWTYPE      GET NETWORK TYPE 
          ZR     X1,PFS1.1   IF RHF SUBSYSTEM 
          BX1    X6 
          RJ     =XCDZ       CONVERT TO DISPLAY 
          LX6    60-6*/AP/MBZL
          SA6    PFSH 
          RJL    =XSNP,HMAP,(SMB,/AP/MBZ,SELECT,/AP/MBZL,PFSH)
          NZ     X1,PFS6     IF ERROR 
          SX6    ACKNW       DEFAULT ACKNOWLEDGMENT 
          SA6    ACKWXFR
          BX1    X6 
          RJ     =XCDZ       CONVERT TO DISPLAY CODE
          LX6    60-6*/AP/AWL 
          SA6    PFSH 
          RJL    =XSNP,HMAP,(SMB,/AP/ACKW,SELECT,/AP/AWL,PFSH)
          NZ     X1,PFS6     IF ERROR 
  
 PFS1.1   SA2    PFSA        FET ADDRESS
          READC  X2,LINE,LINEL     READ NEXT TEXT 
          NZ     X1,PFS2     IF NO MORE TEXTS 
          RJL    =XGTL,LINE  DETERMINE LENGTH OF TEXT 
          SA6    TXTL        SAVE TEXT LENGTH 
          SA4    PFSA+1      CHECK RFILE FLAG 
          NZ     X4,PFS1.2   IF NOT RFILE 
          SA4    LINE        FWA TEXT 
          RJ     CTC         COMPLEMENT TEXT CHARACTERS 
 PFS1.2   BSS    0
          RJL    =XSNP,HMAP,(SMB,/AP/UTEXT,SELECT,TXTL,LINE)
          NZ     X1,PFS6     IF ERROR 
          EQ     PFS1.1      GET NEXT TEXT
  
*         SEND *RFT* COMMAND AND PROCESS COMMAND REPLY. 
  
 PFS2     SA1    HMAP 
          RJ     =XSRM       SEND AND RECEIVE MESSAGES
          NZ     X1,PFS6     IF ERROR IN TRANSMISSION 
          RJ     CAF         FETCH COMMAND (CALL ACFETCH) 
          SA2    RCPT        SET RESPONSE PROCESSOR ADDRESS TABLE 
          RJ     =XEPT       EXECUTE PROCESSOR FROM TABLE 
          NZ     X1,PFS6     IF ERROR IN COMMAND
          SA1    XMIT 
          PL     X1,PFS3     IF FILE TRANSFER REQUIRED
          MX6    60          SET NO TRANSFER REQUIRED FLAG
          SX7    NENT 
          SA7    SWTW        SET MFLCALL STATUS 
          EQ     PFS7        RETURN 
  
 PFS3     BSS    0
          SA3    XMIT 
          NZ     X3,PFS3.1   IF FILE IS TO BE SENT
          SA3    PFSC 
          MI     X3,PFS4     IF INCORRECT FILE TYPE 
          SA3    PFSD 
          MX0    12 
          BX2    X0*X3
          ZR     X2,PFS5     IF FILE DOES NOT EXIST 
          SB5    59-7 
          LX2    X3,B5
          SX1    CWOF        * CANNOT WRITE ON FILE * 
 NOS      IFEQ   OS$NOS 
          MI     X2,PFS5     IF FILE HAS WRITE PERM 
          EQ     PFS3.2 
 NOS      ELSE
          PL     X2,PFS3.2   IF NO WRITE PERM ON FILE 
          MX0    -3 
          BX4    -X0*X3 
          SX4    X4-4 
          NZ     X4,PFS5     IF NOT PERMANENT FILE
          SX0    1S9+1S8     *MODIFY* AND *EXTEND* PERMISSIONS
          BX4    X0*X3
          BX4    X4-X0
          NZ     X4,PFS3.2   IF PERM FILE WITHOUT MODIFY AND EXTEND 
          MX6    60          (X6) = -0
          SA6    PFALTER     SET FILE ALTER NEEDED STATE
          EQ     PFS5 
 NOS      ENDIF 
  
 PFS3.1   SA3    PFSC 
          SX1    CRFF        * CANNOT READ FROM FILE *
          MI     X3,PFS3.2   IF ERROR IN FILE TYPE
          SA3    PFSD 
          LX3    59-6 
          MI     X3,PFS5     IF FILE HAS READ PERM
  
 PFS3.2   SB5    54 
          MX0    6
          BX6    X6-X6
          SA2    F
  
 PFS3.3   BX3    X2*X0       GET CHAR FROM LFN
          ZR     X3,PFS3.4   IF NO MORE CHARS 
          BX6    X6+X3       MERGE LFN INTO MESSAGE 
          LX0    54 
          SB5    B5-6 
          EQ     PFS3.3 
  
 PFS3.4   SX3    1R.
          LX3    X3,B5
          BX6    X6+X3       MERGE PERIOD AT END OF MESSAGE 
          SA6    X1+3 
          MX6    -1 
          SA6    FTE         FORCE TERMINATION WITH ERROR 
          EQ     PFS6 
  
 PFS4     RETURN F,R         GET RID OF EXISTING FILE 
  
 PFS5     ACSTORE SMB,GO,MBL
          SA1    HMAP 
          RJ     =XSML       SEND MESSAGE TO SERVICER 
          NZ     X1,PFS6     IF ERROR 
  
 NBE      IFEQ   OS$NOSBE 
          SA1    PFALTER     CHECK IF PF ALTER REQUIRED 
          PL     X1,PFS5.1   IF NOT REQUIRED
          SX6    B1 
          SA6    A1          SET EXTEND REQUIRED
          REWIND F,RCL       SET FILE POSITION TO BOI 
          ALTER  PFFDB,RC    EVICT CURRENT FILE CONTENTS
 PFS5.1   BSS    0
 NBE      ENDIF 
  
          RECALL RFILE
          BX6    X6-X6       SET NO ERROR 
          SA1    RFI2FLG     *RFILE2*-WRITTEN FLAG
          ZR     X1,PFS7     IF *RFILE2* NOT WRITTEN
          SA1    RFILE2+2    IN POINTER 
          SA2    A1+B1       OUT POINTER
          BX6    X1-X2
          ZR     X6,PFS7     IF BUFFER EMPTY
          WRITER RFILE2,RCL  FLUSH BUFFER 
          BX6    X6-X6       SET NO ERROR 
          EQ     PFS7 
  
 PFS6     BSS    0
          SX2    X1          MESSAGE ADDR 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          RJ     SDM         SEND DAYFILE MESSAGE 
          MX6    -1          SET ERROR
          SX7    2S6+ENFT 
          SA7    SWTW        SET MFLCALL STATUS 
  
 PFS7     EQ     PFSX        RETURN 
  
 PFSA     CON    0           FET ADDRESS
          CON    0           RFILE FLAG (0=RFILE) 
  
 PFSB     CON    0           FILE LENGTH (DPC)
  
 PFSC     CON    0           GFL RETURN INFORMATION 
  
 PFSD     CON    0           FILE STATUS FROM FILINFO 
  
 PFSE     VFD    54/0LC,6/1     RHF FACILITIES TEXT AND LENGTH
          VFD    54/0LCRMS,6/4  NAM FACILITIES TEXT AND LENGTH
 PFSH     CON    0           CDZ RETURN (DPC) 
 PFT      SPACE  4,10 
**        PFT - PERFORM FILE TRANSFER CLEANUP.
* 
*         PFT IS CALLED TO CHECK THE STATUS RETURNED FROM NETXFR
*         AFTER A FILE TRANSFER HAS BEEN PERFORMED. 
* 
*         ENTRY  (XFRA) = NETXFR STATUS 
* 
*         EXIT   (X6) < 0 IF ERROR DETECTED 
*                     = 0 OTHERWISE 
  
  
 PFT      SUBR               ENTRY/EXIT 
          RJL    =XPTERXF,PEPM,(XFRA,PFTA,PFTB) 
          SA1    PFTA        NETXFR STATUS FLAGS
*         LX1    59-59       CONNECTION NOT VIABLE FLAG (BIT 59)
          SA2    PFTB        MESSAGE LOCATION 
          SA3    NWTYPE      CHECK SUBSYSTEM TYPE 
          PL     X1,PFT1     IF CONNECTION VIABLE 
          NZ     X3,PFT0.1   IF NOT RHF 
          BX6    X1 
          LX6    59-54
          PL     X6,PFT1     IF CONNECTION NOT BROKEN 
  
 PFT0.1   MX6    60 
          SA6    STAT        SET CONNECTION BROKEN STATUS 
  
 PFT1     NZ     X3,PFT2     IF NOT RHF 
          LX1    59-55       CHECK NO RETRY FLAG (BIT 55) 
          MX6    -1 
          PL     X1,PFT2     IF RETRY POSSIBLE
          SA6    RTYCNT      CLEAR RETRY COUNT (TRY ALTERNATE NETWORK)
 PFT2     ZR     X2,PFT4     IF NO ERROR MESSAGE
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          RJ     SDM         SEND DAYFILE MESSAGE 
          MX6    -1          SET ERROR DETECTED 
          SX7    EDFT 
          SA7    SWTW        SET MFLCALL STATUS 
          EQ     PFT6 
  
 PFT4     RJL    =XGFL,F,(DDXFR)   GET FILE LENGTH
          BX1    X7 
          RJ     =XCFD=      CONVERT FILE LENGTH TO F10.3 
          SA6    ULSA+1 
  
 DBG      IFC    EQ,*"DEBUG"*DEBUG* 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          SX2    ULSA        MESSAGE ADDR 
          RJ     SDM         SEND DAYFILE MESSAGE 
          SA1    DBG
          LX1    59-1 
          MI     X1,PFT5     IF DEBUG ON
 DBG      ENDIF 
  
          MESSAGE ULSA,5,RCL ISSUE ACCOUNTING MESSAGE 
  
 PFT5     BSS    0
  
 NBE      IFEQ   OS$NOSBE 
          RJ     =XMFLPFEX   EXTEND PERM FILE, IF NECESSARY 
 NBE      ENDIF 
  
          BX6    X6-X6       SET NORMAL RETURN
  
 PFT6     EQ     PFTX        RETURN 
  
 PFTA     CON    0           NETXFR STATUS FLAGS
  
 PFTB     CON    0           NETXFR MESSAGE ADDRESS 
 CAF      SPACE  4,10 
**        CAF - CALL ACFETCH. 
* 
*         THIS ROUTINE CALLS ACFETCH AND PUTS THE COMMAND NUMBER
*         INTO ERROR MESSAGE *INVALID COMMAND  XX*. 
* 
*         ENTRY  HA   = NETGET HEADER WORD
*                MB   = NETGET TEXT HEADER WORD 
* 
*         EXIT   LCMD = (X6) = COMMAND NUMBER.
*                ICSM = * INVALID COMMAND  XX* (XX = COMMAND NUMBER). 
*                (X1) = ICSM (ERROR MESSAGE ADDR).
* 
*         USES   A - 3, 6, 7. 
*                X - 1, 3, 5, 6, 7. 
* 
*         MACROS ACFETCH. 
  
  
 CAF      SUBR
          SA3    HA          GET TEXT LENGTH
          MX7    -12
          BX7    -X7*X3 
          SA7    MB          SET TEXT LENGTH FOR ACFETCH
          ACFETCH  MB,MB,LCMD 
          SX1    ICSM        * INVALID COMMAND  XX.*
          SA3    X1+2        GET DAYFILE MESSAGE WORD 
          MX7    -12
          LX5    12          POSITION DISPLAY-CODED COMMAND 
          BX7    X7*X3       MASK 
          BX7    X5+X7       INSERT COMMAND 
          SA7    A3          RESET ERROR MESSAGE
          EQ     CAFX        RETURN 
 RNC      SPACE  4,10 
**        RNC - READ NEXT CONTROL CARD. 
* 
*         THIS ROUTINE WILL READ THE NEXT CONTROL CARD AND
*         CHECK FOR A *MFLINK* CONTROL STATEMENT. 
* 
*         ENTRY  NONE 
* 
*         EXIT   (X1) = ZERO IF CONTROL CARD IS TO BE PROCESSED BY MFLIN
*                     = NON-ZERO IF CONTROL IS NOT TO BE PROCESSED
  
  
 RNC      SUBR               ENTRY/EXIT 
          BX6    X6-X6       CLEAR RA.CCD 
          SA6    RA.CCD 
          CONTRLC RNCA,READ  READ NEXT COMMAND (CLEAR NOS ARG=) 
          SA2    RNCA        GET STATUS WORD
          LX2    59-4 
          MI     X1,RNC2     IF END OF CONTROL STATEMENT RECORD 
          SA5    RA.CCD      FWA OF CONTROL STATEMENT IMAGE 
          SB7    -RA.ARG     FWA OF ARGUMENTS, ALLOW BLANKS 
          ZR     X5,RNC2     IF NO CONTROL STATEMENT FOUND
          BX6    X6-X6
          SA6    -B7         CLEAR FIRST ARGUMENT 
          RJ     UCS         UNPACK CONTROL STATEMENT 
          SA1    RA.ARG      FIRST ARGUMENT 
          SA2    =0LMFLINK
          MX0    7*6
          BX1    X1-X2
          BX1    X0*X1
          NZ     X1,RNC1     IF NOT *MFLINK*
          BX1    X1-X1       SET *MFLINK* FOUND 
          EQ     RNC3 
  
 RNC1     CONTRLC  RNCA,BKSP BACK SPACE CONTROL CARD POINTER
  
 RNC2     MX1    -1          SET NO CONTROL STATEMENT FOUND 
  
 RNC3     EQ     RNCX        RETURN 
  
 RNCA     CON    0           CONTRLC STATUS WORD
 SDM      SPACE  4,10 
**        SDM - SEND DAYFILE MESSAGE. 
* 
*         SDM SENDS A MESSAGE TO THE SYSTEM AND/OR JOB DAYFILE, 
*         AND TO THE USER-S TERMINAL IF JOB-ORIGIN IS INTERACTIVE.
* 
*         ENTRY  X1 = 0 (MESSAGE OPTION - JOB DAYFILE). 
*                   =-1 (MESSAGE OPTION - SYSTEM + JOB DAYFILE).
*                X2 = MESSAGE ADDR. 
*                INTORG = 0, IF NOT INTERACTIVE ORIGIN. 
* 
*         EXIT   X1 = 0.
  
  
 SDM      SUBR
          BX6    X2          MESSAGE ADDR 
          ZR     X2,SDM1     IF NO MESSAGE ADDR 
          SX2    X1+7        MESSAGE OPTION = 6 OR 7
          SA6    SDMA        SAVE MESSAGE ADDR
          MESSAGE X6,X2,RCL  SEND MESSAGE TO DAYFILE
          SA1    INTORG      CHECK JOB ORIGIN 
          ZR     X1,SDM1     IF NOT INTERACTIVE ORIGIN
 NOS      IFEQ   OS$NOS 
          TSTATUS SDMB       GET CURRENT TERMINAL STATUS
          SA1    SDMB+1 
          MX2    -6 
          LX1    0-48 
          BX1    -X2*X1      GET CONNECTION STATUS FIELD
          SX1    X1-2 
          NZ     X1,SDM1     IF NOT ONLINE
 NOS      ENDIF 
          SA2    SDMA        FETCH MESSAGE ADDR 
          WRITEC OUTPUT,X2,LINEL   SEND MESSAGE TO TERMINAL 
          WRITER OUTPUT,RCL 
  
 SDM1     MX1    0           X1 = 0 
          EQ     SDMX        RETURN 
  
 SDMA     BSS    1           MESSAGE ADDR 
  
 NOS      IFEQ   OS$NOS 
 SDMB     BSS    2           *TSTATUS* STATUS BLOCK 
 NOS      ENDIF 
 STC      SPACE  4,10 
**        STC - STOP COMMAND PROCESSING.
* 
*         STC SENDS THE STOP COMMAND AND PROCESSES
*         THE REPLY.
* 
*         ENTRY  TSTA HAS BEEN SETUP
* 
*         EXIT   (X6) < 0, IF ERROR 
*                     = 0, OTHERWISE
  
  
 STC      SUBR               ENTRY/EXIT 
          ACSTORE SMB,STOP,MBL     STOP COMMAND 
          RJL    =XSNP,HMAP,(SMB,/AP/STATE,SELECT,/AP/STATEL,TSTA)
          NZ     X1,STC2     IF ERROR 
          SA1    HMAP 
          RJ     =XSRM       SEND STOP AND WAIT FOR REPLY 
          NZ     X1,STC2     IF ERROR IN TRANSMISSION 
          RJ     CAF         CALL ACFETCH (GET COMMAND) 
          SA2    SCPT        SET STOP RESPONSE PROCESSOR TABLE
          RJ     =XEPT       EXECUTE RESPONSE PROCESSOR 
          NZ     X1,STC2     IF ERROR IN COMMAND OR PROCESSOR 
          SX1    FTRM        *FILE RETRANSMIT REQUESTED*
          NZ     X6,STC2     IF RETRANSMIT REQUESTED
          BX6    X6-X6       SET NO ERROR 
          IX1    X1-X1       CLEAR MESSAGE ADDR (FOR *SDM*) 
          SA3    FTE         CHECK FORCE-TERMINATION FLAG 
          ZR     X3,STC3     IF NOT FORCE-TERMINATION 
          SA3    SWTW 
          NZ     X3,STC3     IF MFLCALL REPLY HAS BEEN SET
  
 STC2     BSS    0
          SX2    X1          MESSAGE ADDR 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          RJ     SDM         SEND DAYFILE MESSAGE 
          MX6    -1          SET ERROR
          SX7    EAFT 
          SA7    SWTW        SET MFLCALL STATUS 
  
 STC3     EQ     STCX        RETURN 
 TSC      SPACE  4,10 
**        TSC - TERMINATE SERVICER CONNECTION.
* 
*         TSC WILL INITIATE THE TERMINATION PHASE PROTOCOL WITH THE 
*         SERVICER IF THE CONNECTION IS STILL VIABLE AND WILL 
*         TERMINATE THE CONNECTION AND NETOFF IF NOT ALREADY DONE.
* 
*         ENTRY  (STAT) = STATUS OF CONNECTION. 
* 
*         EXIT   (STAT) = 77B - NOT NETTED ON.
  
  
 TSC      SUBR               ENTRY/EXIT 
          SA1    STAT        CONNECTION STATUS
          ZR     X1,TSC4     IF NETTED ON BUT NOT CONNECTED 
          PL     X1,TSC5     IF NOT NETTED ON 
          MESSAGE PTCM,1,R   *MFLINK - TERMINATING CONNECTION*
          SA1    LCMD        LAST COMMAND RECEIVED
          SX6    X1-/AC/STOPR 
          ZR     X6,TSC2     IF *STOPR* RECEIVED
          SX6    X1-/AC/RNEG
          ZR     X6,TSC1     IF *RNEG* RECEIVED 
          SX6    X1-/AC/RPOS
          ZR     X6,TSC1     IF *RPOS* RECEIVED 
          EQ     TSC4        UNCERTAIN STATE, TERMINATE CONNECTION
  
 TSC1     SA1    TSTS        *TERMINATED, SEE MESSAGE*
          BX6    X1 
          SA6    TSTA        SET STATE-OF-TRANSFER
          RJ     STC         SEND *STOP*
          NZ     X6,TSC4     IF ERROR DETECTED
  
 TSC2     ACSTORE SMB,ETP,MBL 
          SA1    HMAP 
          RJ     =XSRM       SEND EPT AND WAIT FOR ETPR 
          NZ     X1,TSC3     IF ERROR 
          RJ     CAF         CALL ACFETCH (GET COMMAND) 
          SA2    ECPT        SET RESPONSE PROCESSOR TABLE 
          RJ     =XEPT       EXECUTE RESPONSE PROCESSOR 
          ZR     X1,TSC4     IF NO ERROR
  
 TSC3     BSS    0
          SX2    X1          MESSAGE ADDR 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          RJ     SDM         SEND DAYFILE MESSAGE 
  
 TSC4     SA1    SHMP 
          RJ     =XTNL       TERMINATE NETWORK LINK 
  
 TSC5     BX7    X7-X7
          SA7    LCMD        SET NO COMMAND RECEIVED
          RECALL
          EQ     TSCX        RETURN 
 VFN      SPACE  4,10 
**        VFN - VALIDATE FILE NAME. 
* 
*         VFN VERIFIES FILE NAME IS VALID.
* 
*         FOR NOS, ONE TO SEVEN CHARACTERS IN THE RANGE A TO 9. 
*         FOR NOS/BE, SAME AS NOS EXCEPT FIRST CHARACTER MUST 
*         BE IN THE RANGE A TO Z. 
* 
*         ENTRY  (X1) = LFN.
* 
*         EXIT   (X6) = 0, IF VALID LFN 
*                     NE 0, OTHERWISE.
  
  
 VFN      SUBR               ENTRY/EXIT 
          RJ     =XSFN=      SPACE FILL NAME
          SA2    =10LAAAAAAAAAA    LFN LOWER LIMIT AND BORROW MASK
          IX4    X6-X2
          BX3    X6-X2
          BX5    X4-X3
 NOS      IFEQ   OS$NOS 
          SA3    =7L9999999  LFN UPPER LIMIT
 NOS      ELSE
          SA3    =7LZ999999  LFN UPPER LIMIT
 NOS      ENDIF 
          IX4    X3-X1
          BX3    X3-X1
          BX3    X4-X3
          BX3    X3+X5
          BX6    X2*X3       RETURN BORROWED BITS 
          EQ     VFNX        RETURN 
 VMF      SPACE  4,10 
**        VMF - VALIDATE MFLINK PARAMETERS. 
* 
*         VMF UNPACKS AND VALIDATES THE MFLINK CONTROL STATEMENT IMAGE. 
* 
*         ENTRY  (RA.CCD) = CONTROL STATEMENT IMAGE.
* 
*         EXIT   (X6) = 0, IF NO ERROR. 
*                     = (FTE) = -1, IF ERROR. 
  
  
 VMF      SUBR               ENTRY/EXIT 
          SA5    RA.CCD      FWA OF CONTROL STATEMENT 
          SB7    -RA.ARG     FWA OF ARGUMENTS, ALLOW BLANK
          RJ     UCS         UNPACK CONTROL STATEMENT 
          NZ     X6,VMF7     IF ERROR IN UNPACK 
          BX6    X6-X6
          SA6    DD          SET DEFAULT NO DD
          SA6    EP          SET DEFAULT EP NOT SELECTED
          SA6    RC          SET DEFAULT RC NOT SELECTED
          SA6    RT          SET DEFAULT RT NOT SELECTED
          SA6    SWTF        SET DEFAULT SWTF NOT SELECTED
          SA6    I           SET DEFAULT I=0
          SA6    ST          SET DEFAULT ST NOT SPECIFIED 
 NOS      IFEQ   OS$NOS 
          SA1    /CONSTANT/NS2
 NOS      ELSE
          SA1    /CONSTANT/NOSBE
 NOS      ENDIF 
          BX6    X1 
          SA6    HT          SET HOST TYPE
          SX6    1R*
          LX6    59-5 
          SA6    PC          SET DEFAULT PC=* 
          SA1    =0LLFILE 
          SX6    B1 
          BX6    X1+X6       MERGE LFN AND COMPLETE BIT 
          SA6    F           SET DEFAULT LFN AS *LFILE* 
          SB6    B6-2        SKIP OVER *MFLINK* AND LFN 
          MI     B6,VMF2     IF NO LFN SPECIFIED
          SA1    RA.ARG+1    GET LFN
          MX0    7*6
          SX6    B1 
          BX1    X0*X1       MASK LFN 
          BX6    X1+X6       SET COMPLETE BIT 
          ZR     X1,VMF1     IF NO LFN SPECIFIED
          SA6    F           SAVE LFN 
  
 VMF1     ZR     B6,VMF2     IF NO MORE PARAMETERS
          SB4    B6          ARGUMENT COUNT 
          SA4    RA.ARG+2    FWA OF ARGUMENTS 
          SB5    VMFA        ARGUMENT TABLE 
          RJ     =XARG=      PROCESS ARGUMENTS
          NZ     X1,VMF7     IF ARGUMENT ERROR
  
*         VALIDATE           *LFN* PARAMETER. 
  
          SA1    F           GET LFN
          MX0    7*6
          BX1    X0*X1
  
 NBE      IFEQ   OS$NOSBE 
          MX6    -1 
          BX6    -X6+X1 
          SA6    PFFDB       SET UP FDB FOR PERM FILE OPERATIONS
          BX6    X6-X6
          SA6    PFALTER     SET NO PF ALTER REQUIRED 
 NBE      ENDIF 
  
          RJ     VFN         VALIDATE LFN 
          SX1    ILFM        *INVALID FILE NAME*
          NZ     X6,VMF8     IF INVALID LFN 
  
*         VALIDATE *DD* PARAMETER.
  
 VMF2     SA2    DD 
          SX1    =0LC6       DEFAULT FIP DD IF NO DD SPECIFIED
          ZR     X2,VMF3     IF NO DD SPECIFIED 
          MX0    12 
          BX2    -X0*X2 
          SX1    IDDM        * INVALID DATA DECLARATION * 
          NZ     X2,VMF8     IF INVALID DD
          SX1    DD          ADDRESS OF DD PARAMETER
  
 VMF3     RJ     =XDDC       CONVERT DATA DECLARATION 
          SA2    DD 
          SX1    IDDM        *INVALID DATA DECLARATION* 
          MI     X6,VMF8     IF INVALID DD
          SX3    2RUH 
          LX2    0-48 
          BX3    X2-X3
          ZR     X3,VMF8     IF DD WAS *UH*, INVALID DD 
          SA6    DDINI       INITIAL NETXFR DD
  
*         VALIDATE *EP* PARAMETER.
  
          SA1    EP 
          SX6    MAXRTRY     MAXIMUM RETRY COUNT
          AX1    2           (X1) = -0 IF EP ON, +0 IF OFF
          BX6    -X1*X6      (X6) = 0 IF EP ON, MAXRTRY IF OFF
          SA6    RTYCNT      SAVE RETRY COUNT 
  
*         VALIDATE *PC* PARAMETER 
  
          SA1    PC 
          MX0    42 
          BX2    X1*X0       GET PC VALUE 
          MX0    6
          BX2    -X0*X2 
          SX1    IPCM        * INVALID PC PARAMETER * 
          NZ     X2,VMF8     IF PC PARAM IS LONGER THAN 1 CHAR
  
*         VALIDATE *ST* PARAMETER.
  
          BX6    X6-X6
          SA6    RFILFLG     ASSUME NO RECOVERY TEXTS AVAILABLE 
          SA1    ST 
          ZR     X1,VMF5     IF NO *ST* SPECIFIED 
          RETURN RFILE,RCL   RETURN ANY EXISTING RECOVERY FILE
          RJ     TSC         TERMINATE ANY SERVICER CONNECTION
          RJ     VUL         VALIDATE USER LID
          NZ     X1,VMF8     IF INVALID LID 
          SA1    VMFB        RECOVERY FILE HEADER 
          SA2    ST 
          LX2    0-42 
          BX6    X1+X2       FORM *MFLINK-LID*
          SA1    RFILE+1     FIRST
          SX7    X1+B1
          SA7    A1+B1       SET (IN) = (FIRST) + 1 
          SX7    X1 
          SA7    A7+B1       SET (OUT) = (FIRST)
          SA6    X7          STORE HEADER IN BUFFER 
          WRITER A1-B1,RCL   WRITE HEADER RECORD
  
 NOS      IFEQ   OS$NOS 
          SETFS  RFILE,NAD   SET NO AUTO-DROP STATUS
 NOS      ENDIF 
  
          EQ     VMF6        CONTINUE VALIDATION
  
*         NO *ST* SPECIFIED, CHECK RECOVERY FILE FOR LID. 
  
 VMF5     REWIND RFILE,RCL
          READNS X2,RCL      NON-STOP READ
          READW  X2,VMFC,B1 
          BX6    X1 
          SX1    NLSM        *NO LID SPECIFIED* 
          NZ     X6,VMF8     IF FILE EMPTY
          SA2    VMFB        RECOVERY FILE HEADER 
          SA3    VMFC        WORD READ FROM RFILE 
          MX0    -3*6        MASK FOR LID 
          BX6    X2-X3       COMPARE FILE TO HEADER 
          BX6    X0*X6       IGNORE LID 
          NZ     X6,VMF8     IF INVALID HEADER
          BX6    -X0*X3      GET LID
          LX6    42-0        LEFT-JUSTIFY 
          ZR     X6,VMF8     IF LID EQUALS ZERO 
          SA6    ST          SAVE LID 
          RJ     VUL         VALIDATE USER LID
          NZ     X1,VMF8     IF INVALID LID 
          READW  RFILE,VMFC,B1     SEE IF TEXTS ON FILE 
          NZ     X1,VMF6     IF NO MORE DATA ON FILE
          MX6    59 
          SA6    RFILFLG     SET RECOVERY TEXTS AVAILABLE 
  
*         ALL PARAMETERS HAVE BEEN VALIDATED. 
  
 VMF6     RETURN RFILE1,RCL  GET RID OF SCRATCH FILES 
          RETURN RFILE2,RCL 
          BX6    X6-X6       SET NO ERROR 
          EQ     VMF9        RETURN 
  
 VMF7     SX1    ICCM        *INVALID CONTROL STATEMENT*
  
 VMF8     BSS    0
          SX2    X1          MESSAGE ADDR 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          RJ     SDM         SEND DAYFILE MESSAGE 
          MX6    -1          SET ABORT FLAG 
          SA6    FTE         FORCE TERMINATE WITH ERROR 
          SX7    ENFT 
          SA7    SWTW        SET SWT STATUS 
  
 VMF9     EQ     VMFX        RETURN 
  
 VMFA     BSS    0           CONTROL STATEMENT ARGUMENT TABLE 
          VFD    12/0LDD,18/=0,30/DD
          VFD    12/0LEP,18/-=-1,30/EP
          VFD    12/0LHT,18/HT,30/HT HOST TYPE
          VFD    12/0LI,18/=5LINPUT,30/I
          VFD    12/0LPC,18/=1L*,30/PC
          VFD    12/0LRC,18/-=-1,30/RC
          VFD    12/0LRT,18/-=-1,30/RT
          VFD    12/0LSW,18/-=-1,30/SWTF
          VFD    12/0LST,18/=0,30/ST
          CON    0           END OF TABLE 
  
 VMFB     CON    7LMFLINK-   RECOVERY FILE HEADER 
  
 VMFC     BSS    2           WORKING STORAGE AREA FOR RFILE READW 
 VUL      SPACE  4,10 
**        VUL - VALIDATE USER-SUPPLIED LID. 
* 
*         VUL VERIFIES LID IS THREE CHARACTERS, (A - 9).
*         (FOR NOS, LID WILL BE VALIDATED AGAINST THE SYSTEM
*         LID TABLE IN *NRC*.)
* 
*         ENTRY  (ST) = LID.
* 
*         EXIT   (X1) = 0, IF VALID LID,
*                     = ERROR MESSAGE ADDRESS, OTHERWISE. 
  
  
 VUL      SUBR               ENTRY/EXIT 
  
 NOS      IFEQ   OS$NOS 
          SA1    ST 
          MX0    3*6
          BX6    -X0*X1 
          NZ     X6,VUL8     IF MORE THAN THREE CHARACTERS
          SX6    B1 
          BX6    X1+X6       SET COMPLETE BIT 
          SA6    VULA        STORE PARAMETER WORD 
  
 VUL1     GETLIDA VULA       GET LID ATTRIBUTES 
          SA1    VULA        GET PARAMETER WORD 
          MX0    12 
          LX1    59-41       LEFT-JUSTIFY ATTRIBUTES
          BX2    X0*X1       MASK ATTRIBUTES
          ZR     X2,VUL8     IF LID DOES NOT EXIST
          LX2    59-40-59+41 POSITION LINKED ATTRIBUTE
          BX3    X2 
          LX3    59-35-59+40 POSITION LOOPBACK ATTRIBUTE
          BX3    X2+X3       LINKED .OR. LOOPBACK 
          LX2    59-39-59+40 POSITION ENABLED ATTRIBUTE 
          PL     X3,VUL8     IF NEITHER LINKED NOR LOOPBACK 
 NOS      ELSE
          SA1    ST 
          SX6    1R 
          LX6    41-5 
          BX1    X1+X6       ADD TRAILING BLANK TO CATCH SHORT LID
          RJ     =XSFN=      SPACE FILL NAME
          SA2    =0LAAAAAAAAAA     ST LOWER LIMIT AND BORROW MASK 
          SA1    ST 
          IX4    X6-X2       CHECK ST WITH SPACES AGAINST 
          BX3    X6-X2         LOWER LIMIT
          BX5    X4-X3
          SA3    =3L999      ST UPPER LIMIT 
          IX4    X3-X1
          BX3    X3-X1
          BX3    X4-X3
          BX3    X3+X5
          BX6    X2*X3       RETURN BORROWED BITS 
          NZ     X6,VUL8     IF INVALID LID 
 NOS      ENDIF 
  
          SA1    ST 
          SX6    1R.
          LX6    41-5 
          BX6    X1+X6       MERGE LID AND TERMINATOR 
          SA6    ALKA+2      SET ACCOUNTING MESSAGE 
          SA6    PCTM+3      SET *CONNECTING* MESSAGE 
          SA6    PRMM+3      SET *RECOVERING* MESSAGE 
          BX1    X1-X1       SET VALID LID
          EQ     VUL9        RETURN 
  
 VUL8     SX1    ILDM        *INCORRECT LID*
  
 VUL9     EQ     VULX        RETURN 
  
 VULA     CON    0           *GETLIDA* PARAMETER WORD 
          TITLE  COMMAND PROCESSORS.
**        COMMAND PROCESSORS. 
* 
*         THE FOLLOWING ROUTINES ARE CALLED BY THE EXECUTE PROCESSOR
*         FROM TABLE (*EPT*) ROUTINE.  WHEN A LEVEL 7 PROTOCOL COMMAND
*         IS RECEIVED THE PROCESSOR DEFINED FOR THE COMMAND (IN A 
*         COMMAND RESPONSE PROCESSOR TABLE) IS EXECUTED TO COMPLETE 
*         THE COMMAND PROCEDURE.  EXIT CONDITIONS SHOULD CONFORM
*         TO THE EXIT CONDITION REQUIREMENTS AS DESCRIBED HERE. 
* 
*         ENTRY  (LCMD) = VALUE OF THE COMMAND
*                (MB) = COMMAND AND PARAMETERS AS RECEIVED. 
* 
*         EXIT   (X1) = ERROR MESSAGE ADDRESS IF NON-ZERO 
*                     = ZERO IF NO ERROR. 
 CRN      SPACE  4,10 
**        CRN - REPLY NEGATIVE COMMAND PROCESSOR. 
* 
*         THIS ROUTINE PROCESSES THE PARAMETERS RELEVENT TO 
*         A REPLY NEGATIVE RESPONSE.  THE FILE TRANSFER INDICATOR 
*         IS SET TO NO FILE TRANSFER REQUIRED.
* 
*         ENTRY  (MB) = RECEIVED MESSAGE BLOCK
* 
*         EXIT   (X1) = ZERO. 
  
  
 CRN      SUBR               ENTRY/EXIT 
  
 CRN1     RJL    =XPRP,MB,(ATTR,QUAL,TXTL,LINE,TPPT)
          ZR     X1,CRN2     IF NO ERROR IN PARAMETERS
          NG     X1,CRN1     IF UNKNOWN ATTRIBUTE 
          SX2    X1          MESSAGE ADDR 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          RJ     SDM         SEND DAYFILE MESSAGE 
          EQ     CRN1        CONTINUE PROCESSING PARAMETERS 
  
 CRN2     SX6    -1          CLEAR TRANSMISSION FLAG
          SA6    XMIT 
          SA6    FTE         SET FORCE TERMINATION FLAG 
          EQ     CRNX        RETURN 
 CRP      SPACE  4,10 
**        CRP - REPLY POSITIVE COMMAND PROCESSOR. 
* 
*         CRP IS CALLED WHEN A REPLY POSITIVE COMMAND IS RECEIVED 
*         FROM THE SERVICER.  PARAMETERS RELEVENT TO THIS COMMAND 
*         ARE PROCESSED.  ERRORS IN THE PROCESSOR ARE RETURNED TO 
*         THE CALLER. 
* 
*         ENTRY  (MB) = RECEIVED MESSAGE BLOCK. 
* 
*         EXIT   (X1) = ZERO. 
  
  
 CRP      SUBR               ENTRY/EXIT 
          SX7    -1 
          SA7    XMIT        SET DEFAULT TRANSMISSION 
  
 CRP1     RJL    =XPRP,MB,(ATTR,QUAL,TXTL,LINE,PPPT)
          ZR     X1,CRP2     IF NO ERROR IN PARAMETERS
          PL     X1,CRP1.1   IF NOT UNKNOWN ATTRIBUTE 
          BX1    -X1         COMPLEMENT MESSAGE ADDR
 CRP1.1   BSS    0
          SX2    X1          MESSAGE ADDR 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          RJ     SDM         SEND DAYFILE MESSAGE 
          SA1    FTE         FORCE TERMINATION FLAG 
          NZ     X1,CRP1     IF ALREADY SET 
          SX6    -1 
          SA6    FTE         SET FORCE TERMINATION WITH ERROR 
          SA6    XMIT        CLEAR TRANSMISSION FLAG
          EQ     CRP1        CONTINUE PROCESSING PARAMETERS 
  
 CRP2     BSS    0
  
 DBG      IFC    EQ,*"DEBUG"*DEBUG* 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          SX2    ALKA        MESSAGE ADDR 
          RJ     SDM         SEND DAYFILE MESSAGE 
          SA1    DBG
          LX1    59-1 
          MI     X1,CRP3     IF DEBUG ON
 DBG      ENDIF 
  
          MESSAGE ALKA,5,RCL ISSUE ACCOUNTING MESSAGE 
  
 CRP3     BX1    X1-X1       SET NO ERROR MESSAGE 
          EQ     CRPX        RETURN 
 CSR      SPACE  4,10 
**        CSR - *STOPR* COMMAND PROCESSOR.
* 
*         CSR IS CALLED TO PROCESS THE *STOPR* COMMAND AND ANY
*         PARAMETERS ASSOCIATED WITH IT.  THE RETRANSMIT
*         STATUS IS RETURNED TO THE CALLER. 
* 
*         ENTRY  (MB) = RECEIVED MESSAGE BLOCK. 
* 
*         EXIT   (X1) = ZERO
*                (X6) = NON-ZERO IF RETRANSMIT REQUESTED
  
  
 CSR      SUBR               ENTRY/EXIT 
  
 CSR1     RJL    =XPRP,MB,(ATTR,QUAL,TXTL,LINE,NPPT)
          ZR     X1,CSR2     IF NO ERROR IN PARAMETERS
          NG     X1,CSR1     IF UNKNOWN ATTRIBUTE 
          SX2    X1          MESSAGE ADDR 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          RJ     SDM         SEND DAYFILE MESSAGE 
          EQ     CSR1        CONTINUE PROCESSING PARAMETERS 
  
 CSR2     SA2    REXMIT      RETURN AND CLEAR RETRANSMIT STATUS 
          BX6    X2 
          EQ     CSRX 
 CTR      SPACE  4,10 
**        CTR - ENTER TERMINATION PHASE REPLY COMMAND PROCESSOR.
* 
*         WHEN THE REPLY TO THE *ETP* COMMAND IS RECEIVED THIS
*         ROUTINE IS CALLED.
*         THE ENTER TERMINATION STATE COMMAND (*FINI*) IS SENT. 
* 
*         ENTRY  (MB) = RECEIVED MESSAGE BLOCK. 
* 
*         EXIT   (X1) = ERROR MESSAGE ADDRESS IF NETWORK ERROR
*                     = ZERO IF NO ERROR. 
  
  
 CTR      SUBR               ENTRY/EXIT 
          ACSTORE  SMB,FINI,MBL 
          SA1    HMAP 
          RJ     =XSML       SEND FINI TO FTFS
          EQ     CTRX        RETURN 
 ECPT     TITLE  COMMAND RESPONSE PROCESSOR TABLES. 
**        ECPT - ETP COMMAND RESPONSE PROCESSOR ADDRESS TABLE.
* 
**T       42/ CMND,18/ ADDR+1 
* 
*         ADDR   - ADDRESS OF COMMAND PROCESSOR.
*         CMND   - COMMAND VALUE. 
  
  
 ECPT     CADDRE ETPR,CTR 
          BSSZ   1
 RCPT     SPACE  4,10 
**        RCPT - RFT COMMAND RESPONSE PROCESSOR ADDRESS TABLE.
* 
**T       42/ CMND,18/ ADDR+1 
* 
*         ADDR   - ADDRESS OF COMMAND PROCESSOR.
*         CMND   - COMMAND VALUE. 
  
  
 RCPT     CADDRE RPOS,CRP 
          CADDRE RNEG,CRN 
          BSSZ   1
 SCPT     SPACE  4,10 
**        SCPT - STOP COMMAND RESPONSE PROCESSOR ADDRESS TABLE. 
* 
**T       42/ CMND,18/ ADDR+1 
* 
*         ADDR   - ADDRESS OF COMMAND PROCESSOR.
*         CMND   - COMMAND VALUE. 
  
  
 SCPT     CADDRE STOPR,CSR
          BSSZ   1
          TITLE  PARAMETER PROCESSORS.
**        PARAMETER PROCESSORS. 
* 
*         THE FOLLOWING ROUTINES PROCESS PARAMETERS ASSOCIATED
*         WITH A COMMAND(S).  THE ROUTINES ARE ENTERED BY THE EXECUTE 
*         PROCESSOR FROM TABLE (*EPT*) ROUTINE.  THE ASSOCIATION OF A 
*         PARAMETER PROCESSOR WITH A PARAMETER VALUE IS DONE VIA A
*         COMMAND PARAMETER PROCESSOR TABLE.
* 
*         EXIT   (X1) = ERROR MESSAGE ADDRESS IF NON-ZERO 
*                     = ZERO IF NO ERROR. 
 EXI      SPACE  4,10 
**        EXI - EXIT WITH NO ERROR. 
* 
*         EXI IS CALLED TO NOT PROCESS A PARAMETER. 
* 
*         ENTRY  NONE.
* 
*         EXIT   (X1) = ZERO. 
  
  
 EXI      SUBR               ENTRY/EXIT 
          MX1    0
          EQ     EXIX        EXIT WITH NO ERROR 
 PAW      SPACE  4,10 
**        PAW - PROCESS ACKNOWLEDGEMENT WINDOW PARAMETER. 
* 
*         PAW EXTRACTS THE ACKNOWLEDGEMENT WINDOW PARAMETER, CONVERTS 
*         IT TO BINARY AND SAVES FOR USE BY NETXFR. 
* 
*         ENTRY  (LINE) = ACKNOWLEGEMENT WINDOW PARAMETER.
* 
*         EXIT   (ACKWXFR) = ACKNOWLEGEMENT WINDOW PARAMETER IN BINARY. 
*                (X1) = ZERO. 
  
  
 .1       DECMIC /AP/ACKW,2 
  
 PAW      SUBR               ENTRY/EXIT 
          SA5    LINE 
          SB7    1
          RJ     =XDXB=      CONVERT TO BINARY
          NZ     X4,PAW1     IF ERROR 
          SA6    ACKWXFR
          MX1    0
          EQ     PAW2 
  
 PAW1     SX6    3R".1".
          SX1    PEPM        * PROTOCOL ERROR IN XX * 
          LX6    59-17
          SA6    PEPM+3 
  
 PAW2     EQ     PAWX 
 PCT      SPACE  4,10 
**        PCT - PROCESS CONTINUED MESSAGE BLOCK.
* 
*         PCT READS THE NEXT MESSAGE BLOCK FROM THE NETWORK.  THE 
*         LAST COMMAND RECEIVED MUST MATCH THE COMMAND IN THE 
*         CURRENT BLOCK.  CONTROL RETURNS TO THE CALLER AFTER 
*         SETTING OF THE TEXT HEADER (*ACFETCH*). 
* 
*         ENTRY  (LCMD) = LAST COMMAND VALUE. 
* 
*         EXIT   (MB) = CONTINUATION MESSAGE BLOCK
*                (X1) = ERROR MESSAGE ADDRESS IF ERROR
*                     = ZERO OTHERWISE. 
  
  
 PCT      SUBR               ENTRY/EXIT 
          SA1    HMBP 
          RJ     =XRML       RECEIVE CONTINUATION MESSAGE 
          NZ     X1,PCT1     IF ERROR IN RECEIVE
          SA3    LCMD        SAVE LAST COMMAND RECEIVED 
          BX7    X3 
          SA7    PCTA 
          RJ     CAF         CALL ACFETCH 
          SA1    PCTA        COMPARE LAST WITH CURRENT COMMAND
          IX1    X6-X1
          ZR     X1,PCT1     IF COMMANDS MATCH
          SX1    CNFM        * CONTINUATION BLOCK DID NOT FOLLOW.*
  
 PCT1     EQ     PCTX        RETURN 
  
 PCTA     BSS    1           LAST COMMAND RECEIVED
 PDM      SPACE  4,10 
**        PDM - PROCESS DAYFILE MESSAGE PARAMETER.
* 
*         PDM SENDS THE *DMSG* MESSAGE TO THE LOCAL DAYFILE.
* 
*         ENTRY  (LINE) = DAYFILE MESSAGE.
* 
*         EXIT   (X1) = ZERO. 
  
  
 PDM      SUBR               ENTRY/EXIT 
          MX1    0           MESSAGE OPTION - JOB DAYFILE 
          SX2    LINE        MESSAGE ADDR 
          RJ     SDM         SEND DAYFILE MESSAGE 
          EQ     PDMX        RETURN 
 PFA      SPACE  4,10 
**        PFA - PROCESS FACILITIES PARAMETER. 
* 
*         PFA CALLS FACCHK TO CHECK FACILITIES (ATTRIBUTE 03) RECEIVED
*         IN THE RPOS COMMAND, OR TO SET THE DEFAULT FACILITIES FOR THE 
*         RFT COMMAND.
* 
*         ENTRY  (NWTYPE)  = NETWORK TYPE (0-RHF, 1-NAM)
*                (TXTL)    = TEXT LENGTH (.GE. 0, CHECK RPOS FACILITIES)
*                          = TEXT LENGTH (.LT. 0, SET DEFAULT FOR RFT)
*                (LINE)    = TEXT RECEIVED, IF TXTL .GE. 0. 
*                          = IGNORED IF TXTL .LT. 0.
* 
*         EXIT (CHECK FACILITIES) 
*                (X1)      = ERROR MESSAGE ADDRESS
*                          = 0 (FACILTIES ACCEPTABLE) 
*                (FACIL)   = NETXFR FACILITIES
*         EXIT (SET DEFAULT FOR RFT COMMAND)      RHF    NAM
*                (FACTEXT) = TEXT FOR RFT      =  *C*    *CMRS* 
*                (FACTXTL) = TEXT LENGTH       =   1      4 
*                (FACQUAL) = QUALIFIER         =  *S*    *S*
*                (FACIL)   = NETXFR FACILITIES =   0     *MRS*
  
  
 .1       DECMIC /AP/FAC,2
  
 PFA      SUBR               ENTRY/EXIT 
          RJL    =XFACCHK,LINE,(TXTL,NWTYPE,PFAA,FACTEXT,FACTXTL,FACQUAL
,,FACIL,PFAB) 
          SA1    PFAB 
          ZR     X1,PFAX     IF NO ERROR
          SX6    3R".1" 
          SX1    PEPM        PROTOCOL ERROR IN XX 
          LX6    59-17
          SA6    PEPM+3 
          EQ     PFAX 
  
 PFAA     CON    1           FACCHK APPLICATION CODE (1=PTF)
 PFAB     BSS    1           ERROR FLAG 
 PID      SPACE  4,10 
**        PID - PROCESS PROTOCOL IDENTIFIER.
* 
*         PID COMPARES THE LOCAL TO THE REMOTE PROTOCOL IDENTIFIERS 
*         ACCOMPANYING THE RPOS OR RNEG COMMAND.
*         IF CHARACTERS 1-4 MATCH:  
*           RETURN (X1 = 0).
*         ELSE: 
*           IF CHARACTERS 1-2 (TYPE AND VERSION) DIFFER, OR 
*              CHARACTERS 3-4 (LEVEL) OF REMOTE EXCEEDS LOCAL:  
*             SET LCMD = -1 (TO BREAK CONNECTION).
*           PUT REMOTE HOST ID IN DAYFILE MESSAGE.
*           RETURN (X1 = DAYFILE MESSAGE).
* 
*         ENTRY  LINE  = REMOTE PROTOCOL IDENTIFIER.
*                CURID = LOCAL PROTOCOL IDENTIFIER. 
*                ST    = REMOTE HOST IDENTIFIER.
* 
*         EXIT   X1    = 0 (IF IDENTIFIERS MATCH).
*                      = MESSAGE ADDR (IF ERROR). 
*                LCMD  = -1 (IF CONNECTION BREAK REQUIRED). 
*                TSTA  = *SAIS* (IF STOP REQUIRED). 
  
  
 PID      SUBR               ENTRY/EXIT 
          SA2    LINE              REMOTE PROTOCOL ID 
          SA3    /CONSTANT/CURID   LOCAL PROTOCOL ID
          BX1    X2-X3       COMPARE CHAR 1-4 
          ZR     X1,PIDX     IF MATCH 
          MX6    2*6
          BX1    X6*X1       MASK CHAR 1-2
          IX6    X2-X3       COMPARE CHAR 3-4 
          SA2    WRBM+3      ERROR MESSAGE
          NZ     X1,PID1     IF CHAR 1-2 DIFFER 
          MI     X6,PID2     IF REMOTE LEVEL LOWER
  
 PID1     MX6    -1 
          SA6    LCMD        FORCE CONNECTION-BREAK (SKIP STOP) 
  
 PID2     SA3    ST          REMOTE HOST ID 
          MX6    3*6         PUT REMOTE HOST ID INTO MESSAGE
          BX3    X6*X3
          LX2    -4*6 
          BX6    -X6*X2 
          BX6    X6+X3
          LX6    4*6
          SA3    SAIS        STATE-OF-TRANSFER (FOR STOP COMMAND) 
          SA6    A2          UPDATE DAYFILE MESSAGE 
          BX6    X3          STATE OF TRANSFER
          SA6    TSTA 
          SX2    WRAM        ADDR OF 1ST MESSAGE
          MX1    -1          SYSTEM + JOB DAYFILE 
          RJ     SDM         SEND 1ST MESSAGE 
          SX1    WRBM        ADDR OF 2D MESSAGE 
          EQ     PIDX        RETURN 
 PMB      SPACE  4,10 
**        PMB - PROCESS MAXIMUM BLOCKSIZE.
* 
*         PMB EXTRACTS THE MAXIMUM BLOCKSIZE PARAMETER, CONVERTS IT 
*         TO BINARY AND SAVES FOR USE BY NETXFR.
* 
*         ENTRY  (LINE) = MAXIMUM BLOCKSIZE 
* 
*         EXIT   (MBSIZE) = MAXIMUM BLOCKSIZE IN BINARY.
*                (X1)     = ERROR MSG IF PROTOCOL ERROR.
*                         = ZERO IF NO ERROR. 
  
  
 .1       DECMIC /AP/MBZ,2
  
 PMB      SUBR
          SA5    LINE        GET TEXT (MAXIMUM BLOCK SIZE)
          SB7    1
          RJ     =XDXB=      CONVERT TO BINARY
          NZ     X4,PMB1     IF ERROR 
          SX1    X6-1 
          MI     X1,PMB1     IF BLOCK SIZE TOO SMALL
          SA6    MBSIZE      REPLACE MAXIMUM BLOCK SIZE (IN BINARY) 
          BX1    X1-X1       NO ERROR ON RETURN 
          EQ     PMB2 
  
 PMB1     SX6    3R".1".
          SX1    PEPM        * PROTOCOL ERROR IN XX. *
          LX6    59-17
          SA6    PEPM+3 
  
 PMB2     EQ     PMBX 
 PMD      SPACE  4,10 
**        PMD - PROCESS MODE OF ACCESS PARAMETER. 
* 
*         PMD EXTRACTS THE DIRECTION OF TRANSFER FROM THE TEXT
*         AND SETS THE TRANSFER DIRECTION.  IF THE TRANSFER IS
*         NOT ACCEPTABLE THE STATE OF THE TRANSFER WILL BE SET
*         TO REJECTED.
* 
*         ENTRY  NONE.
* 
*         EXIT   (XMIT) = TRANSFER DIRECTION FOR THE *NETXFR* TRANSFER
*                (X1) = ERROR MESSAGE ADDRESS IF PROTOCOL ERROR 
*                     = ZERO IF NO ERROR. 
  
  
 .1       DECMIC /AP/MODE,2 
  
 PMD1     NZ     X2,PMDX     IF FTE SET PREVIOUSLY
          SA6    XMIT        SET THE TRANSFER DIRECTION 
  
 PMD      SUBR               ENTRY/EXIT 
          SA1    LINE        CHECK TEXT FOR MODE
          MX0    -6 
          LX1    6
          BX1    -X0*X1      EXTRACT DIRECTION
          SX1    X1-1RN 
          MX6    0
          ZR     X1,PMDX     IF NULL TRANSFER 
          SX1    X1+1RN-1RG 
          SA2    FTE
          ZR     X1,PMD1     IF GIVE TRANSFER 
          SX1    X1+1RG-1RT 
          SX6    1
          ZR     X1,PMD1     IF TAKE TRANSFER 
          SX6    3R".1".
          SX1    PEPM        * PROTOCOL ERROR IN  XX.*
          LX6    59-17
          SA6    PEPM+3 
          EQ     PMDX        RETURN 
 POM      SPACE  4,10 
**        POM - PROCESS OPERATOR MESSAGE. 
* 
*         POM SENDS THE *DMSG* MESSAGE TO THE SYSTEM AND LOCAL DAYFILES.
* 
*         ENTRY  (LINE) = DAYFILE MESSAGE.
* 
*         EXIT   (X1) = ZERO. 
  
  
 POM      SUBR               ENTRY/EXIT 
          MX1    -1          MESSAGE OPTION - SYSTEM + JOB DAYFILE
          SX2    LINE        MESSAGE ADDR 
          RJ     SDM         SEND DAYFILE MESSAGE 
          EQ     POMX        RETURN 
 PPI      SPACE  4,10 
**        PPI - PROCESS PID PARAMETER.
* 
*         PPI ACCEPTS THE PHYSICAL ID (*PID*) AND ENTERS IT IN THE
*         CORRELATION ACCOUNTING MESSAGE. 
* 
*         ENTRY  (LINE) = *PID*.
* 
*         EXIT   (ALKA) = MODIFIED CORRELLATION ACCOUNTING MESSAGE
*                (X1) = ZERO. 
  
  
 PPI      SUBR               ENTRY/EXIT 
          SA2    LINE 
          BX1    X1-X1
          MX6    18          SET PID MASK 
          SA3    ALKA+1 
          BX7    X6*X2       EXTRACT PID FROM LINE
          LX6    12-42
          LX7    12-42       POSITION PID AND MASK
          BX6    -X6*X3 
          BX7    X6+X7       MERGE PID WITH MESSAGE 
          SA7    A3 
          EQ     PPIX        RETURN 
 PSL      SPACE  4,10 
**        PSL - PROCESS STATE-OF-TRANSFER LIST
* 
*         ENTRY  X1 = ADDR OF 1ST POINTER WORD. (EACH POINTER WORD HOLDS
*                       UP TO 3 ADDRESSES OF DEFINED VALUES.) 
*                X3 = VALUE TO MATCH. 
* 
*         EXIT   X1 = 0, IF MATCH FOUND.
*                X1 .NE. 0, IF NO MATCH.
* 
*         USES   A2/4, X1/2/4/6.
  
  
 PSL      SUBR
          SA2    X1          X2 = POINTER WORD
          MX6    -18         MASK 
 PSL1     LX2    18          POSITION NEXT ADDR 
          SX4    X2          FORM NEXT ADDR 
          ZR     X4,PSLX     IF END OF LIST (NO MATCH)
          SA4    X4          FETCH VALUE
          BX1    X4-X3       COMPARE
          ZR     X1,PSLX     IF MATCH FOUND 
          BX2    X6*X2       CLEAR ADDR 
          NZ     X2,PSL1     IF POINTER WORD NOT EMPTY
          SA2    A2+B1       FETCH NEXT POINTER WORD
          EQ     PSL1        CONTINUE 
 PST      SPACE  4,10 
**        PST - PROCESS STATE OF TRANSFER PARAMETER.
* 
*         PST DETERMINES FROM THE RECEIVED STATE OF TRANSFER WHETHER
*         THE TRANSFER WAS SUCCESSFUL OR NOT.  FOUR BASIC ACTIONS ARE 
*         DEFINED.
*                1) NO ERROR
*                2) RETRY 
*                3) ABORT 
*                4) ABORT, SECURITY CONFLICT
* 
*         ENTRY  (LINE) = DISPLAY CODED STATUS. 
* 
*         EXIT   (REXMIT) .NE. 0, IF RETRANSMIT REQUEST 
*                (FTE) = 1 IF ERROR, SECURITY VIOLATION (NOS).
*                      = -1 IF ERROR. 
*                (X1) = 0.
* 
*         CALLS  PSL. 
* 
*         USES   X1, A6/X6. 
  
  
 PST      SUBR               ENTRY/EXIT 
          SA3    LINE        CHECK TEXT OF PARAMETER
          SX1    PSTA        POINTER TO *NORMAL* VALUE-LIST 
          ZR     X3,PST3     IF STATE-OF-TRANSFER IS BINARY ZERO (OK) 
          RJ     PSL         CHECK VALUE
          ZR     X1,PST3     IF MATCH FOUND 
  
          SX1    PSTB        POINTER TO *RETRY* VALUE-LIST
          RJ     PSL         CHECK VALUE
          ZR     X1,PST2     IF MATCH FOUND 
  
 NOS      IFEQ   OS$NOS 
          SX1    PSTC        POINTER TO *SECURITY VIOLATION* VALUE-LIST 
          RJ     PSL         CHECK VALUE
          SX6    B1          FTE = 1 (DECR SECURITY COUNT AND ABORT)
          ZR     X1,PST1     IF MATCH FOUND 
 NOS      ENDIF 
  
          MX6    -1          FTE = -1 (ABORT) 
 PST1     SA6    FTE         SET FTE
          EQ     PST3 
  
 PST2     MX6    -1          SET RETRY FLAG 
          SA6    REXMIT 
  
 PST3     MX1    0           X1 = 0 
          EQ     PSTX        RETURN 
  
 PSTA     VFD    18/AASS,18/ASRS,18/TSAC,6/0
          VFD    18/SAIS,18/-0,18/0,6/0 
  
 PSTB     VFD    18/RPRS,18/SPRS,18/-0,6/0
  
 NOS      IFEQ   OS$NOS 
 PSTC     VFD    18/RUNS,18/UPIS,18/RAUS,6/0
          VFD    18/RAIS,18/-0,18/0,6/0 
 NOS      ENDIF 
 PUT      SPACE  4,10 
**        PUT - PROCESS USER TEXT 
* 
*         PUT ADDS THE USER TEXT SPECIFIED TO THE RECOVERY FILE 
* 
*         ENTRY  (LINE) = USER TEXT 
*                (TXTL) = TEXT LENGTH 
* 
*         EXIT   USER TEXT ADDED TO RECOVERY FILE 
  
  
 PUT      SUBR
          SA1    RECFLG 
          NZ     X1,PUT2     IF DURING RECOVERY 
          SA1    RFI2FLG     *RFILE2*-WRITTEN FLAG
          NZ     X1,PUT1     IF ALREADY INITIALIZED 
          REWIND RFILE2,RCL 
          SX6    B1 
          SA6    RFI2FLG     SET *RFILE2* INITIALIZED 
  
 PUT1     WRITEC RFILE2,LINE SAVE INCREMENTAL RECOVERY TEXT 
  
 PUT2     MX1    0
          EQ     PUTX        RETURN 
 TPPT     SPACE  4,10 
 NPPT     TITLE  COMMAND PARAMETER PROCESSOR TABLES.
**        TPPT - RNEG PARAMETER PROCESSOR ADDRESS TABLE.
* 
**T       42/ ATTR,18/ ADDR+1 
* 
*         ADDR   - ADDRESS OF ATTRIBUTE PROCESSOR.
*         ATTR   - ATTRIBUTE VALUE. 
  
  
 TPPT     PADDRE UTEXT,PUT
          PADDRE CONT,PCT 
          PADDRE DMSG,PDM 
          PADDRE ID,PID 
          PADDRE OMSG,POM 
          PADDRE STATE,PST
          BSSZ   1
 NPPT     SPACE  4,15 
**        NPPT - STOPR PARAMETER PROCESSOR ADDRESS TABLE. 
* 
**T       42/ ATTR,18/ ADDR+1 
* 
*         ADDR   - ADDRESS OF ATTRIBUTE PROCESSOR.
*         ATTR   - ATTRIBUTE VALUE. 
  
  
 NPPT     PADDRE CONT,PCT 
          PADDRE DMSG,PDM 
          PADDRE OMSG,POM 
          PADDRE STATE,PST
          PADDRE UTEXT,PUT
          BSSZ   1
 PPPT     SPACE  4,10 
**        PPPT - RPOS PARAMETER PROCESSOR ADDRESS TABLE.
* 
**T       42/ ATTR,18/ ADDR+1 
* 
*         ADDR   - ADDRESS OF ATTRIBUTE PROCESSOR.
*         ATTR   - ATTRIBUTE VALUE. 
  
  
 PPPT     PADDRE ACKW,PAW    ACKNOWLEDGE WINDOW 
          PADDRE CONT,PCT    CONTINUATION TEXT
          PADDRE DMSG,PDM 
          PADDRE ECHO,EXI 
          PADDRE FAC,PFA
          PADDRE HOSTT,=XPHT
          PADDRE ID,PID 
          PADDRE JOBN,=XPJN 
          PADDRE MBZ,PMB
          PADDRE MODE,PMD 
          PADDRE OMSG,POM 
          PADDRE PID,PPI
          PADDRE SIZE,EXI 
          PADDRE TMOUT,=XPTP
          PADDRE TYPE,=XPDP 
          PADDRE UTEXT,PUT
          BSSZ   1
 PCP      TITLE  PRESET.
  
  
**        PCP - PRESET FOR PROCESSING.
* 
*         PCP INITIALIZES *MFLINK* FOR PROCESSING.
* 
*         ENTRY  NONE.
* 
*         EXIT   (X6) = 0, IF NO ERROR
*                     .NE. 0, OTHERWISE.
  
  
 PCP      SUBR               ENTRY/EXIT 
 RA.JOT   EQU    66B
          SA1    RA.JOT      JOB ORIGIN TYPE
          MX0    -12
          LX1    0-24        POSITION JOT FIELD 
          BX1    -X0*X1 
          SX6    X1-3        (X6) = ZERO IF INTERACTIVE ORIGIN
          NZ     X6,PCP.5    IF NOT INTERACTIVE ORIGIN
          SX6    OUTPUT      GET OUTPUT FILE GET ADDRESS
          SA6    INTORG      NON-ZERO IS INTERACTIVE
          SA1    A6          FET ADDR 
          RJ     =XDF$CON    CONNECT ZZZZZOU
  
 PCP.5    RJ     =XGETHD     GET HOST PID 
          SA6    PIDHOST
          SX1    UNIF        *UNKNOWN NETWORK INTERFACE TYPE* MESSAGE 
          MX0    -2 
          SA2    NIFTYPE     CHECK NETWORK INTERFACES LOADED
          BX6    -X0*X2      BIT 1 = NAM, BIT 0 = RHF 
          ZR     X6,PCP2     IF ERROR 
          SA6    A2 
  
 NOS      IFEQ   OS$NOS 
          GETJN  JOBNAME
          SETSSM 0           DISABLE SECURE MEMORY
 NOS      ELSE
          RETURN ZZZZZDL,R   MAKE SURE DELAY FILE NOT ATTACHED
  
          SYSTEM FSN,R,FDBADDR,100B 
  
          SA1    PIDHOST
          MX0    18 
          BX1    X1*X0       GET HOST MAINFRAME PID 
          LX0    36 
          SA3    FDBADDR-4   GET DELAY FILE PFN 
          BX3    -X0*X3 
          LX1    36 
          BX6    X3+X1       APPEND PID TO PFN
          SA6    A3 
 NOS      ENDIF 
  
 DBG      IFC    EQ,*"DEBUG"*DEBUG* 
          SA1    DBG
          LX1    59-1 
          MI     X1,PCP1     IF DEBUG ON
 DBG      ENDIF 
  
          RJ     CUV         CHECK USER VALIDATION
          NZ     X1,PCP2     IF NOT VALIDATED 
  
 NBE      IFEQ   OS$NOSBE 
          SYSTEM RHH,R,JOBNAME,12B*100B 
 NBE      ENDIF 
  
          RECOVR =XMFLRPV,277B,0  SET REPRIEVE PROCESSING 
  
 PCP1     BX6    X6-X6       SET NO ERROR 
          EQ     PCP3        RETURN 
  
 PCP2     BSS    0
          SX2    X1          MESSAGE ADDR 
          MX1    0           MESSAGE OPTION - JOB DAYFILE 
          RJ     SDM         SEND DAYFILE MESSAGE 
          SX6    B1 
          SA6    FTE         FORCE TERMINATION WITH ERROR 
  
 PCP3     EQ     PCPX        RETURN 
 CUV      SPACE  4,10 
**        CUV - CHECK USER VALIDATION.
* 
*         UNDER NOS, CUV CHECKS THE ACCESS CONTROL WORD IN THE CONTROL
*         POINT AREA TO DETERMINE IF THE USER IS VALIDATED TO USE MFLINK
* 
*         UNDER NOS/BE, CUV ASSUMES ANY USER MAY USE MFLINK.
* 
*         EXIT   (X1) = ZERO IF VALID USER, 
*                     = ERROR MESSAGE ADDRESS OTHERWISE.
  
  
 CUV      SUBR
  
 NOS      IFEQ   OS$NOS 
          SYSTEM RSB,R,CUVA  READ AACW FROM CPA 
          SA2    CUVB 
          BX1    X1-X1       ASSUME VALID USER
          LX2    59-15       CHECK *CPLK* CAPABILITY
          MI     X2,CUV1     IF VALIDATED FOR MFLINK
          SX1    IAVM        *INVALID ACCESS VALIDATION*
 NOS      ELSE
          BX1    X1-X1       VALID USER IF NOS/BE 
 NOS      ENDIF 
  
 CUV1     EQ     CUVX        RETURN 
  
 NOS      IFEQ   OS$NOS 
  
 CUVA     VFD    12/0,12/1,18/0,18/CUVB 
  
 CUVB     CON    AACW        ACCESS CONTROL WORD
  
 NOS      ENDIF 
          SPACE  4,10 
          END 
