*DECK FTFS
          IDENT  FTSRES 
          TITLE  FTFS - PERMANENT FILE TRANSFER SERVICER. 
          SST    CM 
          SYSCOM B1 
          LIST   F
          ENTRY  FTSRES 
          ENTRY  SUL
          ENTRY  SLF
          ENTRY  SEJ
  
 DEBUG    MICRO  1,5,*"PCOMMENT"* 
  
  
          COMMENT  PERMANENT FILE TRANSFER SERVICER.
          COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1994. 
          SPACE  4,10 
***       FTFS - PERMANENT FILE TRANSFER SERVICER.
* 
*         J. G. CLARK        79/10/29.
*         D. J. REIMAN       81/06/22.
*         G. S. ANDERSON     83/11/29.
          SPACE  4,10 
***       FTFS IS THE PERMANENT FILE TRANSFER FACILITY SERVICER.
*         FTFS IS STARTED BY *RHF* IN RESPONSE TO A CONNECTION
*         REQUEST FROM THE *FTF* APPLICATION.  FTFS PROVIDES THE
*         CONTROL CARD AND FILE TRANSFER PROCESSING ON THE REMOTE 
*         MAINFRAME FOR AN MFLINK USER. 
          SPACE  4,10 
***       DIRECTIVES PROCESSED. 
* 
*         ACCOUNT.    NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         ATTACH.     NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         CATALOG.    NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         COMMENT.    NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         DSMOUNT.    NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         LABEL.      NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         MFDUMP.     FTFS CONTROL CARD.   (EXTERNALLY PROCESSED) 
*         MFGIVE.     FTFS CONTROL CARD.   (INTERNALLY PROCESSED) 
*         MFLOAD.     FTFS CONTROL CARD.   (EXTERNALLY PROCESSED) 
*         MFTAKE.     FTFS CONTROL CARD.   (INTERNALLY PROCESSED) 
*         MOUNT.      NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         PAUSE.      NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         PURGE.      NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         RENAME.     NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         REQUEST.    NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         RETURN.     NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         SETNAME.    NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         UNLOAD.     NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
*         VSN.        NOS/BE CONTROL CARD. (EXTERNALLY PROCESSED) 
* 
*         FOR A DESCRIPTION OF THE PARAMETERS REFER TO THE NOS/BE 
*         REFERENCE MANUAL. 
          SPACE  4,10 
**        SPECIAL PROGRAMMING NOTE. 
* 
*         FTFS USES THE R1 - R3 JOB REGISTERS TO PRESERVE 
*         JOB STATUS INFORMATION FOR RE-ENTRY PURPOSES. 
*         ANY MODIFICATIONS TO THE CURRENT FTFS, THE
*         CONTROL CARDS THAT ARE SUPPORTED BY FTFS, OR THE
*         RHF SKELETON PROCEDURE MAY AFFECT THE OPERATION 
*         OF FTFS.
  
  
**        MICROS
  
 PROGNAM  MICRO  1,10,*  FTFS  - *
          SPACE  4,15 
*CALL COMCMAC 
*CALL COMCAPR 
*CALL COMCCAE 
*CALL CMACROS 
  
 NBEONLY  IFEQ   OS$NOS 
 FTSRES   SUBR
          EQ     FTSRES 
 SUL      EQU    FTSRES 
 SLF      EQU    FTSRES 
 SEJ      EQU    FTSRES 
          LIST   *
 NBEONLY  ELSE
          LIST   X
  
*CALL COMCPTF 
          LIST   -X 
          SPACE  4,10 
*CALL     COMPTFS 
*CALL COMPRPV 
 FTFS     TITLE  MAIN PROGRAM.
**        FTFS - MFLINK SERVICER MAIN PROGRAM.
* 
*         FTFS CONTROLS THE TRANSFER OF APPLICATION PROTOCOL
*         MESSAGE BLOCKS AND PERMANENT FILES TO/FROM *MFLINK*.
*         WHEN A USER TEXT CONTROL CARD IS RECEIVED, THE
*         CORRESPONDING CONTROL CARD IS INTERNALLY PROCESSED BY 
*         FTFS OR THE CONTROL CARD IS PUT IN THE INPUT FILE AND 
*         IS PROCESSED BY THE CORRESPONDING NOS/BE CONTROL CARD 
*         PROCESSOR.  IF A FILE TRANSFER IS REQUIRED FTFS WILL
*         UTILIZE THE FIP ROUTINE *NETXFR* TO HANDLE THE FILE 
*         TRANSFER PROTOCOL AND THE FILE TRANSFER.
* 
*         SET REPRIEVE BLOCK. 
*         GET JOB CONTROL INFORMATION.
*         CALL RHH TO GET JOB NAME AND HOST PID.
*         REPEAT
*           CALL MAIN OVERLAY.
*           IF READY FOR FILE TRANSFER
*           THEN
*             CALL XFR OVERLAY. 
*         UNTIL NOT NETTED ON 
*           OR  EXTERNAL CONTROL CARD TO PROCESS. 
*         SET JOB CONTROL INFORMATION.
* 
*         ENTRY - MUST HAVE SOURCE ID OF $RH AND BE LOADED FROM 
*                 THE SYSTEM LIBRARY. 
* 
*         EXIT  - JOB CONTROL REGESTERS ARE SET TO CURRENT
*                 EXECUTION STATUS TO ALLOW RE-ENTRY. 
  
  
 FTSRES   SUBR
          SB1    1
          MX6    1
          RJ     FXT         CLEAR FORCE-EXIT-PROCESSING FLAG 
          RECOVR SEJ,277B,0        SET UP REPRIEVE LIST 
          RECOVR =XRHCRPV,277B,0   COMMON REPRIEVE ROUTINE
          SB1    1
          SA4    OVLLWA      GET HIGHEST HIGH ADDRESS 
  
*         REQUEST MEMORY UP TO THE LWA OF OVERLAY.
  
          MEMORY CM,MEMWRD,R,X4     REQUEST MEMORY
          GETJCI JCI
 FTFS1    SB1    1
          RJ     =XDUMMAIN   EXECUTE FTSMAIN
          SA1    JCI+1
          SX3    X1-RFXFR 
          NZ     X3,FTFS2    IF NOT READY FOR TRANSFER
          SA1    PFSRPVT
          ZR     X1,FTFS1.1  IF NO SYSTEM ERROR 
          SA1    RETLFN 
          ZR     X1,FTFS1.1  IF NO FILE TO RETURN 
          RETURN RETLFN,R    RETURN NETXFR FILE 
 FTFS1.1  SA1    F           NETXFR FILE NAME 
          BX6    X1 
          SA6    XFRLFN      SAVE FOR *PTFXFR*
          RJ     =XDUMXFR    EXECUTE PTFXFR 
          SA1    JCI+1
          MX0    -18
          SX2    PXFRREP
          BX3    X1*X0
          BX6    X3+X2
          SA6    A1          SET STATE TO PROCESS NETXFR REPLY
 FTFS2    SA3    NETONF 
          ZR     X3,FTFS4    IF NOT NETTED ON 
          SA1    CCTOPF 
          SX3    X1-ECCTOP
          NZ     X3,FTFS1    IF NO EXTERNAL CONTROL CARD
          SA3    PFSRPVT
          ZR     X3,FTFS3    IF NO SYSTEM ERROR 
          SX6    NCCTOP 
          SA6    A1          RESET CONTROL CARD FLAG
          EQ     FTFS1       LOOP 
  
 FTFS3    SA1    JCI
          MX0    -1 
          BX6    X1*X0
          SA6    A1          CLEAR COMPLETE BIT 
          SETJCI JCI
          MX6    0
          RJ     FXT         SET FORCE-EXIT-PROCESSING FLAG 
 FTFS4    ENDRUN
  
 MEMWRD   BSSZ   1           MEMORY REPLY WORD
 FXT      SPACE  4,10 
**        FXT - CLEAR/SET FORCE EXIT PROCESSING FLAG
* 
*         FXT CALL RHH TO CLEAR OR SET THE FORCE-EXIT-PROCESSING FLAG 
*         (S.CPFEP IN CPA WORD W.CPFP, BYTE C.CPFP).
* 
*         ENTRY  X6 .NE. 0 (CLEAR)
*                   .EQ. 0 (SET)
* 
*         EXIT   FXTA, BIT 59 = S.CPFEP (0/1, CLEAR/SET). 
* 
*         CALLS  SYSTEM.
  
  
 FXT      SUBR
          ZR     X6,FXT1     IF SETTING FORCE-EXIT-PROCESSING FLAG
          MX6    1
 FXT1     SA6    FXTA        RHH REQUEST WORD 
          SYSTEM RHH,RCL,FXTA,7*100B
          EQ     FXTX        RETURN 
  
 FXTA     BSS    1
SEJ       SPACE  4,10 
**        SEJ - SET END OF JOB CONTROL CARDS. 
* 
*         THIS ROUTINE MAKES SURE THE CONTROL CARD STREAM 
*         IS UPDATED AT END OF PROCESSING TO ALLOW FTFS TO
*         TERMINATE SUCCESSFULLY. 
* 
*         ENTRY - NONE. 
* 
*         EXIT  - CONTROL CARD STREAM UPDATED.
  
  
 SEJ      SUBR
          RJ     SUL         SET INPUT FILE LFN 
          RETURN ZZZZZUT,R
          OPEN   ZZZZZUT,WRITE,R
          WRITEW ZZZZZUT,ENDFTFS,ENDFTFL
          WRITER ZZZZZUT,R   FLUSH BUFFER 
          SA1    ZZZZZUT
          MX0    -1 
          BX6    X1*X0
          SA6    A1          CLEAR COMPLETE BIT 
          ENCSF  ZZZZZUT,SETBOI  UPDATE CONTROL CARDS BUFF
          RJ     SLF         SET INPUT FILE LFN FLAG
          EQ     SEJX 
  
 SETBOI   VFD    30/0,24/1,6/0
 ENDFTFS  BSS    0           END OF JOB CONTROL CARDS 
          DIS    ,*APR,11.* 
          DIS    ,*EXIT(S).*
          DIS    ,*PAUSE.FTFS FAILED, GO=DUMP, KILL=NO LISTING.*
 ENDFTFL  EQU    *-ENDFTFS
SUL       SPACE  4,10 
**        SUL - SET USER TEXT LFN.
* 
*         THIS ROUTINE SETS UP THE ZZZZZUT FET TO USE AN LFN
*         THAT IS NOT CURRENTLY BEING USED AS THE INPUT FILE
*         LFN.
* 
*         ENTRY - (R3)  = CURRENT INPUT FILE LFN STATUS 
*                         IS KEPT IN BIT 17.
*                         (0) = ZZZZZTU IS CURRENT LFN. 
*                         (1) = ZZZZZUT IS CURRENT LFN. 
* 
*         EXIT  - THE ZZZZZUT FET HAS PROPER LFN. 
  
  
 SUL      SUBR
          SA1    JCI+1
          LX1    59-53
          PL     X1,SUL1     USE ZZZZZUT
          SA2    ZZTULFN
          BX6    X2 
          SA6    ZZZZZUT     USE ZZZZZTU AS LFN IN FET
          EQ     SUL2 
  
 SUL1     SA2    ZZUTLFN
          BX6    X2 
          SA6    ZZZZZUT     USE ZZZZZUT AS INPUT FILE LFN
 SUL2     REWIND ZZZZZUT,R
          EQ     SULX 
SLF       SPACE  4,10 
**        SLF - SET INPUT FILE LFN IN USE FLAG. 
* 
*         THIS ROUTINE TOGGLES THE INPUT FILE LFN IN USE
*         FLAG WHICH IS BIT 17 OF *R3*. 
* 
*         ENTRY - BIT 17 REFLECTS PREVIOUS INPUT FILE.
* 
*         EXIT  - BIT 17 REFLECTS CURRENT INPUT FILE. 
  
  
 SLF      SUBR
          SA1    JCI+1
          MX0    1
          LX0    53-59
          BX6    X1-X0
          SA6    A1          TOGGLE LFN BIT 
          EQ     SLFX 
  
 NBEONLY  ENDIF 
  
          END 
          IDENT  FTSMAIN
          SST    CM 
          SYSCOM B1 
          LIST   F
          ENTRY  FTSMAIN
*CALL     COMCMAC 
*CALL     COMCAPR 
*CALL     COMCCAE 
*CALL CMACROS 
  
 NBEONLY  IFEQ   OS$NOS 
 FTSMAIN  SUBR
          EQ     FTSMAIN
          LIST   *
 NBEONLY  ELSE
  
*CALL     COMCPTF 
*CALL     COMQUPC 
*CALL     COMPTFS 
*CALL COMPRPV 
          SPACE  4,10 
****      DAYFILE MESSAGES. 
  
 PROGNAM  MICRO  1,10,*  FTFS  - * NORMAL MESSAGE PREFIX
 PROGNCN  MICRO  1,10,*  FTFS  -+* CONTINUED MESSAGE PREFIX 
 FIPNAME  MICRO  1,10,*  FIP  -  *  NORMAL FIP MESSAGE PREFIX 
 FIPNAMC  MICRO  1,10,*   FIP  - *  CONTINUED FIP MESSAGE PREFIX
  
*         BECAUSE NOS/BE *MSG* SPLITS DAYFILE MESSAGES BETWEEN
*         41 AND 80 CHARACTERS LONG INTO TWO MESSAGES,
*         ALL FTFS MESSAGES LONGER THAN 40 CHARACTERS SHOULD
*         BE PREFIXED BY MICRO "PROGNCN". 
*         WHEN FTFS ROUTINE *SDM* SENDS MESSAGES FROM THE JOB 
*         DAYFILE BACK TO THE INITIATOR, IT CONCATENATES THE
*         TWO PARTS OF THE "PROGNCN"-PREFIXED MESSAGES. 
*         (FIP MESSAGES FOLLOW A SIMILAR CONVENTION.) 
* 
*                          1         2         3         4
*                 1234567890123456789012345678901234567890
*                   FTFS  - XXX ... 
*                   FIP  -  XXX... (NORMAL MESSAGE) 
*                    FIP  - XXX... (LONG MESSAGE) 
  
          USE    CONSTANT 
  
*         MESSAGES ISSUED WITH AN UNCONDITIONAL ABORT.
  
 CNFM     DIS    ,*"PROGNCN"CONTINUATION BLOCK DID NOT FOLLOW.* 
 ICCM     DIS    ,*"PROGNAM"INVALID CONTROL STMT.*
 IFSM     DIS    ,*"PROGNAM"INVALID FTFS STATE.*
  
*         DAYFILE MESSAGES ISSUED TO REMOTE INITIATOR.
  
 ACRD     DIS    ,*"PROGNCN"ACCOUNT STMT MUST BE FIRST DIRECTIVE.*
 ARCD     DIS    ,*"PROGNCN"ACCOUNT STMT REQUIRED FOR CATALOG.* 
 DDER     DIS    ,*"PROGNAM"INVALID DATA DECLARATION TYPE.* 
 HNSD     DIS    ,*"PROGNAM"HOST NOT SPECIFIED TYPE.* 
 ICCD     DIS    ,*"PROGNCN"DIRECTIVE XXXXXXXXXX OF USER TEXT INVALID.* 
 LFID     DIS    ,*"PROGNAM"LFN OF XFR FILE IS INVALID.*
 MALD     DIS    ,*"PROGNCN"MFGIVE/MFTAKE ALLOW ONLY LFN PARAMETER.*
 MRLD     DIS    ,*"PROGNCN"MFGIVE/MFTAKE REQUIRE LFN PARAMETER.* 
 PRCD     DIS    ,*"PROGNAM"FILE TRANSFER COMPLETE.*
 MFXD     DIS    ,*"PROGNCN"MULTIPLE FILE TRANSFERS REQUESTED.* 
 RLVD     DIS    ,*"PROGNAM"BAD LABEL - REQUEST.* 
 TAED     DIS    ,*"PROGNAM"TAPE ASSIGNMENT ERROR.* 
  
          USE    *
  
****
          SPACE  4,10 
 DDC6     DATA   2LC6        C6 DD TYPE 
 DDC8     DATA   2LC8        C8 DD TYPE 
 DDUH     DATA   2LUH        UH DD TYPE 
 DDUS     DATA   2LUS        US DD TYPE 
  
 HMAP     CON    HA          SEND AND RECEIVE BUFFER ADDRESS LIST 
          CON    SMB+1       *NETPUT* MESSAGE BUFFER
 HMBP     CON    QBIT        RECEIVE BUFFER ADDRESS LIST
          CON    STAT        APPLICATION CONNECTION STATUS
          CON    ACKT        *RHFWAIT* INTERVAL FOR *FC/ACK*/MESSAGE
          CON    =0          *RHFWAIT* WAIT FOR EVENT FLAG
          CON    HA          MESSAGE HEADER ADDRESS 
          CON    MB+1        RECEIVE MESSAGE BUFFER ADDRESS 
          CON    MBL         MESSAGE BUFFER LENGTH
          CON    =0 
  
 MB       BSSZ   NTLMAX+2    *NETGET* MESSAGE BUFFER
  
 MBL      CON    NTLMAX      MESSAGE BUFFER LENGTH
  
 SHMP     CON    QBIT        SUPERVISORY PARAMETER ADDRESS LIST 
          CON    STAT        APPLICATION CONNECTION STATUS
          CON    REQT        *RHFWAIT* INTERVAL FOR *FC/ACK*/MESSAGE
          CON    =0          *RHFWAIT* WAIT FOR EVENT FLAG
          CON    SHAB        SUPERVISORY MESSAGE HEADER ADDRESS 
          CON    STAB        SUPERVISORY MESSAGE BUFFER ADDRESS 
          CON    STABL       MESSAGE BUFFER LENGTH
  
 ZZZZZRP  FILEC  SMB,ENDRP-SMB+1  RPOS FILE (USED BY FTFS)
 RPFIRST  EQU    ZZZZZRP+1
 RPIN     EQU    ZZZZZRP+2
 RPOUT    EQU    ZZZZZRP+3
 RPLIMIT  EQU    ZZZZZRP+4
  
 SMB      BSSZ   NTLMAX+2    *NETPUT* MESSAGE BUFFER
 DDTYPE   BSS    1           DATA DECLARATION 
 HOST     BSS    1           PID OF HOST
 JOBNAME  BSS    1           JOB NAME OF FTFS 
 LFN      BSS    1           IF NON-ZERO, CONTAINS LFN TO RETURN
 RBUFL    EQU    101B        LENGTH OF RECOVERY TEXT BUFFER 
 RBUF     BSS    RBUFL       RECOVERY TEXT BUFFER 
 ZZZZZRT  FILEC  RBUF,RBUFL,(FET=6)  RECOVERY TEXT FILE 
 ENDRP    BSS    1
          SPACE  4,10 
**        PRESET DATA AREAS.
  
  
          USE    // 
  
  
*         THE FOLLOWING DATA AREAS WILL BE CLEARED AFTER RECEIVING
*         EVERY *RFT* COMMAND.
  
 DARA     BSS    0           START OF AREA TO BE CLEARED
  
 ACCESS   BSS    1           MODE OF ACCESS PARAMETER TEXT
  
 FXCT     BSS    1           FILE TRANSFER COUNT PER *RFT*
  
 SIZT     BSS    1           FILE SIZE IN CHARACTERS / 1024 
  
 TSTA     BSS    1           TRANSFER STATE 
  
 ATTR     BSS    1           PARAMETER RETURN ATTRIBUTE 
  
 OMSGL    BSS    1           OPERATOR MESSAGE LENGTH IN CHARACTERS
  
 QUAL     BSS    1           PARAMETER RETURN QUALIFIER 
  
 TXTL     BSS    1           TEXT RETURNED LENGTH 
  
 ENDB     EQU    *           END OF PRESET BUFFER 
  
          USE    *
  
 ACTREQ   EQU    0           ACCOUNT CARD REQUIRED
 ACTRFC   EQU    0           ACCOUNT CARD REQUIRED FOR CATALOG
 CCFTFS   DATA   5HFTFS.     FTFS INTERNAL PROCESS HEADER 
 CCMFC    CON    0           USED FOR MFGIVE AND MFTAKE 
 CCLFN    CON    0           LFN OF MFGIVE OR MFTAKE
 CCTYPE   CON    0           SPECIAL CONTROL CARD FLAG
 DIR      CON    0           DIRECTION OF FILE TRANSFER 
 FACQUAL  BSS    1           FACILITIES QUALIFIER 
 FACTEXT  BSS    1           FACILITIES TEXT
 FACTXTL  BSS    1           FACILITIES TEXT LENGTH 
 INTPF    CON    0           INTERNALLY PROCESSED FLAG
 MFDMFL   CON    0           MFDUMP OR MFLOAD BEING PROCESSED 
 MFDMP    EQU    1           MFDUMP BEING PROCESSED 
 MFLOD    EQU    2           MFLOAD BEING PROCESSED 
 NODIR    EQU    2           NO DIRECTION SET 
 NUMCC    CON    0           NUMBER OF CONTROL CARDS PROCESSED
 RECEIVE  EQU    0           RECEIVE FILE 
 RW       CON    0           RHH REPLY WORD 
 SEND     EQU    1           SEND FILE
          TITLE FTFS - FILE TRANSFER SERVICER (MAIN OVERLAY). 
 FTSMAIN  SPACE  4,20 
**        FTFS - MAIN LOOP. 
* 
*         IF NOT NETTED ON
*         THEN
*           ISSUE NETON REQUEST TO RHF. 
*           IF NETON SUCCESSFUL 
*           THEN
*             SET NETTED ON FLAG. 
*           ELSE
*             ISSUE ERROR MESSAGE AND ABORT.
*         REPEAT
*           CASE (DEPENDING ON STATE) DO
*             (FIRST ENTRY TO FTFS) 
*               SET UP DAYFILE FNT (RHH CALL).
*               SET FORCE EXIT PROCESSING. (RHH CALL) 
*               CREATE LOCAL FILES. 
*               SET STATE TO NOT CONNECTED. 
*             (NOT CONNECTED) 
*               CALL ECL TO ESTABLISH CONNECTION. 
*               IF CONNECTED
*               THEN
*                 SET STATE TO IDLE.
*               ELSE
*                 ISSUE ERROR MESSAGE AND ABORT.
*             (IDLE)
*               WAIT FOR MESSAGE. (RFT OR ETP)
*               PROCESS MESSAGE.
*             (RFT RECEIVED, PROCESS CONTROL CARDS) 
*               REPEAT
*                 CALL CONTROL CARD PROCESSOR.
*               UNTIL STATE CHANGE
*                 OR  EXTERNAL CONTROL CARD TO PROCESS. 
*             (RPOS SENT, WAIT REPLY) 
*               WAIT FOR MESSAGE. (STOP OR GO)
*               PROCESS MESSAGE.
*             (RNEG SENT, WAIT REPLY) 
*               WAIT FOR MESSAGE. (STOP)
*               PROCESS MESSAGE.
*             (READY FOR FILE TRANSFER) 
*               RETURN.  (PROCESSED IN XFR OVERLAY) 
*             (TRANSFER COMPLETE) 
*               PROCESS NETXFR REPLY. 
*             (TRANSFER COMPLETE, PROCESS CONTROL CARDS)
*               REPEAT
*                 CALL CONTROL CARD PROCESSOR.
*               UNTIL STATE CHANGE
*                 OR  EXTERNAL CONTROL CARD TO PROCESS
*             (USER TEXT PROCESSING COMPLETE) 
*               WAIT FOR MESSAGE. (STOP)
*               PROCESS MESSAGE.
*             (WRAP UP) 
*               WAIT FOR MESSAGE. (FINI)
*               PROCESS MESSAGE.
*         UNTIL NOT NETTED ON 
*           OR  READY FOR FILE TRANSFER 
*           OR  EXTERNAL CONTROL CARD TO PROCESS
* 
*         ENTRY - (JCI - JCI+1) = JOB CCL REGISTERS.
* 
*         EXIT  - (JCI - JCI+1) = CURRENT PROGRAM STATUS. 
  
  
 FTSMAIN  SUBR
          SA1    NETONF 
          NZ     X1,FTM1     IF NETTED ON 
          RJ     GRP         RESTORE RPOS BUFFER ON RE-ENTRY
          SA1    JCI+1
          MX0    6
          BX2    X1*X0
          NZ     X2,FTM1     IF ERROR FLAGS SET 
          RJ     NTN         NETON TO RHF 
 FTM1     SA1    JCI+1
          SA2    X1+CURSTAT 
          SB7    X2 
          JP     B7 
  
* 
*         THIS IS A SIMULATED CASE STATEMENT BASED ON STATE.
* 
  
*         FIRST TIME ENTERED. 
  
 FTE      RJ     PRS         PRESET FOR PROCESSING
          SYSTEM RHH,R,RW,4*100B         SET NEW DAYFILE FNT
          RJ     SCP         SET CURRENT PRU
          OPEN   ZZZZZRP,WRITE,R     RPOS FILE
          OPEN   ZZZZZRT,WRITE,R     RECOVERY TEXT FILE 
          SX1    NOTCON 
          RJ     UDS         STATE = NOT CONNECTED
          EQ     FTM2 
  
*         NOT CONNECTED 
  
 NCN      SA1    CNCDEL      CONNECTION DELAY TIME
          BX6    X1 
          SA6    TOUT 
          RJ     =XSTT       SET TIMEOUT TIMER
          SA1    SHMP 
          RJ     =XECL       OBTAIN CONNECT REQUEST 
          NZ     X1,FTM3     IF NOT SUCCESSFUL CONNECTION 
          SX6    TIMEOUT     DEFAULT TIMEOUT
          SA6    TOUT 
          RJ     =XSTT       RESET TIMEOUT
          SX1    IDLE 
          RJ     UDS         STATE = IDLE 
          MX6    1
          RJ     RCC         CALL RECOVR TO ACTIVATE PFSRPV 
          EQ     FTM2 
  
*         IDLE   (WAITING FOR RFT OR ETP) 
  
 IDS      RJ     =XSTT       SET TIMEOUT TIMER
          SA1    HMBP 
          RJ     =XRML       RECEIVE MESSAGE FROM REMOTE APPL 
          NZ     X1,FTM3     IF ERROR IN RECEIVING MESSAGE
          RJ     CAF         CALL ACFETCH (GET COMMAND) 
          SA2    ICPT        IDLE COMMAND PROCESSOR TABLE 
          RJ     =XEPT       EXECUTE PROCESSOR TABLE
          NZ     X1,FTM3     IF PROCESSING ERROR
          EQ     FTM2 
  
*         RFT RECEIVED, PROCESS CONTROL CARDS.
  
 RRP      RJ     CCP         CONTROL CARD PROCESSOR 
          SA1    JCI+1
          SX3    X1-RFTRPCC 
          NZ     X3,FTM2     IF STATE CHANGE
          SA1    CCTOPF 
          SX2    X1-ECCTOP
          ZR     X2,FTM2     IF EXTERNAL CONTROL CARD TO PROCESS
          EQ     RRP
  
*         RPOS SENT, WAIT REPLY. (WAITING FOR STOP OR GO) 
  
 RPS      RJ     =XSTT       SET TIMEOUT TIMER
          SA1    HMBP 
          RJ     =XRML       RECEIVE MESSAGE FROM REMOTE APPL 
          NZ     X1,FTM3     IF ERROR IN RECEIVING MESSAGE
          RJ     CAF         CALL ACFETCH (GET COMMAND) 
          SA2    PCPT        RPOS REPLY PROCESSOR TABLE 
          RJ     =XEPT       EXECUTE PROCESSOR TABLE
          NZ     X1,FTM3     IF PROCESSING ERROR
          EQ     FTM2 
  
*         RNEG SENT, WAIT REPLY. (WAITING FOR STOP) 
  
 RNS      RJ     =XSTT       SET TIMEOUT TIMER
          SA1    HMBP 
          RJ     =XRML       RECEIVE MESSAGE FROM REMOTE APPL 
          NZ     X1,FTM3     IF ERROR IN RECEIVING MESSAGE
          RJ     CAF         CALL ACFETCH (GET COMMAND) 
          SA2    NCPT        RNEG REPLY PROCESSOR TABLE 
          RJ     =XEPT       EXECUTE PROCESSOR TABLE
          NZ     X1,FTM3     IF PROCESSING ERROR
          EQ     FTM2 
  
*         READY FOR FILE TRANSFER.
  
 RFX      EQ     FTM2        PROCESSED IN XFR OVERLAY 
  
*         PROCESS NETXFR REPLY. 
  
 PNR      RJ     COG         PROCESS NETXFR REPLY 
          EQ     FTM2 
  
*         TRANSFER COMPLETE, PROCESS CONTROL CARDS. 
  
 XCC      RJ     CCP         CONTROL CARD PROCESSOR 
          SA1    JCI+1
          SX3    X1-XFRCPCC 
          NZ     X3,FTM2     IF STATE CHANGE
          SA1    CCTOPF 
          SX2    X1-ECCTOP
          ZR     X2,FTM2     IF EXTERNAL CONTROL CARD TO PROCESS
          EQ     XCC
  
*         USER TEXT PROCESSED. (WAIT FOR STOP)
  
 UTP      RJ     =XSTT       SET TIMEOUT TIMER
          SA1    HMBP 
          RJ     =XRML       RECEIVE MESSAGE FROM REMOTE APPL 
          NZ     X1,FTM3     IF ERROR IN RECEIVING MESSAGE
          RJ     CAF         CALL ACFETCH (GET COMMAND) 
          SA2    DCPT        TRANSFER COMPLETE PROCESSOR TABLE
          RJ     =XEPT       EXECUTE PROCESSOR TABLE
          NZ     X1,FTM3     IF PROCESSING ERROR
          EQ     FTM2 
  
*         WRAP UP. (WAIT FOR FINI)
  
 WUP      RJ     =XSTT       SET TIMEOUT TIMER
          MX6    0
          RJ     RCC         CALL RECOVR TO DEACTIVATE PFSRPV 
          SA1    HMBP 
          RJ     =XRML       RECEIVE MESSAGE FROM REMOTE APPL 
          NZ     X1,FTM3     IF ERROR IN RECEIVING MESSAGE
          RJ     CAF         CALL ACFETCH (GET COMMAND) 
          SA2    ECPT        ETP REPLY PROCESSOR TABLE
          RJ     =XEPT       EXECUTE PROCESSOR TABLE
          NZ     X1,FTM3     IF PROCESSING ERROR
          EQ     FTM2 
  
*         END OF CASE STATEMENT.
  
 FTM2     SA3    NETONF 
          ZR     X3,FTSMAINX IF NOT NETTED ON 
          SA1    JCI+1
          SX3    X1-RFXFR 
          ZR     X3,FTSMAINX IF READY FOR FILE TRANSFER 
          SA1    CCTOPF 
          SX2    X1-ECCTOP
          ZR     X2,FTM4     IF EXTERNAL CONTROL CARD TO PROCESS
          EQ     FTM1 
  
 FTM3     RJ     ABT         ISSUE MESSAGE AND ABORT
  
 FTM4     SB1    1
          NSTORE STAB,PFCSFC=CTRINF 
          NSTORE STAB,CTFC=B1 
          NSTORE SHAB,ABHABT=3
          NSTORE SHAB,ABHACT=B1 
          NSTORE SHAB,ABHTLC=2
          NSTORE SHAB,ABHADR=0
          RJL    =XFTUPUT,SHAB,(STAB)  SET EOJ CONNECT
          SB1    1
          SA1    RPFIRST
          SA2    RETLFN 
          BX6    X1 
          BX7    X2 
          SA3    RPLIMIT
          SA6    RPOUT       SET OUT TO FIRST 
          SA7    LFN         SAVE LFN OF RETURN FILE
          SX6    X3-1 
          SA6    RPIN        SET IN TO FLUSH BUFFER 
          RECALL ZZZZZRT     ENSURE RECOVERY TEXT FILE IS NOT BUSY
          WRITEF ZZZZZRP,R   SAVE RPOS BUFFER IN ZZZZZRP
          EQ     FTSMAINX 
  
*         CASE STATEMENT ENTRY POINTS, BASED ON CURRENT STATE.
  
 CURSTAT  BSS    0
          CON    FTE         FIRST TIME ENTERED 
          CON    NCN         NOT CONNECTED
          CON    IDS         IDLE 
          CON    RRP         RFT RECEIVED, PROCESS CONTROL CARDS
          CON    RPS         RPOS SENT, WAIT REPLY
          CON    RNS         RNEG SENT, WAIT REPLY
          CON    RFX         READY FOR FILE TRANSFER
          CON    PNR         PROCESS NETXFR REPLY 
          CON    XCC         TRANSFER COMPLETE, PROCESS CONTROL CARDS 
          CON    UTP         USER TEXT PROCESSED
          CON    WUP         WRAP-UP
          TITLE UTILITY SUBROUTINES 
ABT       SPACE  4,10 
**        ABT - ABORT 
* 
*         ABT ISSUES AN ERROR MESSAGE AND ABORTS. 
* 
*         ENTRY  (X1) = ERROR MESSAGE ADDRESS.
* 
*         EXIT CPU ABORT
* 
*         CALLS  MSG=, SYS=.
  
  
 ABT      SUBR               ENTRY
          ZR     X1,ABT1     IF NO ERROR MESSAGE
          MESSAGE  X1,0,R 
  
 ABT1     SA1    STAT        CONNECTION STATUS
          PL     X1,ABT2     IF NO CONNECTION 
          NZ     X1,ABT2     IF NOT BROKEN
          SA1    ABTFLG      FORCE ABORT FLAG 
          ZR     X1,ABT3     IF FORCED ABORT NOT SELECTED 
  
 ABT2     ABORT 
  
 ABT3     SA1    NETONF      CHECK NETTED-ON FLAG 
          ZR     X1,ABT4     IF NOT NETTED-ON 
          RJ     =XFTUOFF 
          SB1    1
  
 ABT4     RJ     =XSEJ       SET END OF JOB CONTROL CARDS 
          ENDRUN
 CAF      SPACE  4,10 
**        CAF - CALL ACFETCH. 
* 
*         THIS ROUTINE CALLS ACFETCH AND PUTS THE COMMAND NUMBER
*         INTO THE 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  GET COMMAND 
          MX7    -12
          SX1    ICSM        INITIALIZE ERROR MESSAGE 
          LX5    12          POSITION COMMAND 
          SA3    X1+2 
          BX7    X7*X3       MASK 
          BX7    X5+X7       INSERT COMMAND 
          SA7    A3          RESET ERROR MESSAGE
          EQ     CAFX        RETURN 
CCP       SPACE  4,10 
**        CCP - CONTROL CARD PROCESSOR. 
* 
*         IF CONTROL CARD NOT READ
*         THEN
*           READ CONTROL CARD FROM INPUT FILE.
*         IF CONTROL CARD INTERNALLY PROCESSED
*         THEN
*           UNPACK CONTROL CARD.
*           IF BAD CONTROL CARD 
*           THEN
*             ISSUE MESSAGE AND ABORT.
*           ELSE
*             CALL EPT TO PROCESS THE CONTROL CARD. 
*         ELSE
*           BACKSPACE CONTROL CARD BUFFER POINTER.
*           SET EXTERNAL CONTROL CARD FLAG. 
* 
*         ENTRY - (CCTOPF) = CURRENT CONTROL CARD STATUS. 
* 
*         EXIT  - (CCTOPF) = UPDATED TO CURRENT CC STATUS.
  
  
 CCP      SUBR
          SA1    CCTOPF 
          SX2    X1-NCCTOP
          NZ     X2,CCP1     IF CONTROL CARD TO PROCESS 
          BX6    X6-X6
          SA6    STSWRD      CLEAR COMPLETE BIT 
          CONTRLC STSWRD,READ 
 CCP1     SA4    RA.CCD 
          SA5    FTFSPRW
          BX3    X4-X5
          NZ     X3,CCP3     IF NOT PROCESSED BY FTFS 
          SA2    CCTOPF 
          SX2    X2-NCCTOP
          NZ     X2,CCP2     IF ALREADY DAYFILED
          SX1    RA.CCD 
          MESSAGE X1,3,R
 CCP2     SA5    RA.CCD+1    FWA OF CONTROL CARD
          SB1    1
          SB7    RA.ARG      BUFFER FOR CONTROL CARD
          RJ     UPC         UNPACK CONTROL CARD
          SX1    ICCM        SET ERROR MESSAGE
          NZ     X6,CCP4     IF UNPACK ERROR
          SA1    RA.ARG 
          SA2    ICCT        INTERNAL CONTROL CARD PROCESSOR
          BX6    X1 
          AX6    18 
          SX1    ICCM        SET ERROR MESSAGE
          RJ     =XEPT       EXECUTE PROCESSOR TABLE
          NZ     X1,CCP4     IF ERROR IN PROCESSING 
          SX6    NCCTOP 
          SA6    CCTOPF      SET TO NO CONTROL CARD TO PROCESS
          EQ     CCPX 
  
 CCP3     BX6    X6-X6
          SA6    STSWRD      CLEAR COMPLETE BIT 
          CONTRLC STSWRD,BKSP 
          SX6    ECCTOP 
          SA6    CCTOPF      SET TO EXTERNAL CONTROL CARD TO PROC.
          EQ     CCPX 
  
 CCP4     RJ     ABT         FATAL ERROR, ABORT 
  
 FTFSPRW  DATA   5HFTFS.     PROCESSED BY FTFS WORD 
  
 STSWRD   CON    0           STATUS WORD
 CDD      SPACE  4,10 
**        CDD - CHECK DATA DECLARATION
* 
*         CDD CHECKS THE DD PARAMETER AND BASED ON THE MAINFRAME
*         TYPE THE DD PARAMETER MAY BE CHANGED. 
*         IF THE MAINFRAME TYPE IS -
*                NOSBE - DD IS CHANGED TO UH
*                NOS AND DD IS C6 - DD IS CHANGED TO US 
*                NS2 AND DD IS C6 OR C8 - DD IS CHANGED TO US 
*         ALSO CHECK FOR DD = UH, IF SO FORCE A RNEG. 
* 
*         ENTRY - DDXFR IS SET UP 
*                 HOSTYP IS SET UP
* 
*         EXIT  - TYPE PARAMETER IS SETUP IN THE RPOS 
*                 IF ERROR RNEG IS FORCED 
  
  
 CDD      SUBR               ENTRY/EXIT 
          SA1    UHPL 
          RJ     =XDDC       GET CODE FOR UH
          SA1    DDXFR
          BX1    X1-X6
          ZR     X1,CDD8     IF UH IS DD TYPE SPECIFIED JUMP
          SA2    HOSTYP 
          SA3    /CONSTANT/NOSBE
          BX3    X2-X3
          ZR     X3,CDD6     IF REMOTE HOST IS NOS/BE JUMP
          SA3    /CONSTANT/NOS
          BX3    X2-X3
          ZR     X3,CDD2     IF REMOTE HOST IS NOS JUMP 
          SA3    /CONSTANT/NS2
          BX3    X2-X3
          NZ     X3,CDDX     RETURN IF REMOTE HOST IS NOT NS2,NOS,NOS/BE
          SA1    C8PL 
          RJ     =XDDC       GET CODE FOR C8
          SA1    DDXFR
          BX5    X1-X6
          ZR     X5,CDD4     IF DD IS C8 AND REMOTE HOST IS NS2 
 CDD2     BSS    0
          SA1    C6PL 
          RJ     =XDDC       GET CODE FOR C6
          SA1    DDXFR
          BX5    X1-X6
          NZ     X5,CDDX     IF DD TYPE IS NOT C6,RETURN
* 
*         DD IS C8 AND REMOTE HOST IS NS2 OR DD IS C6 AND REMOTE HOST 
*         IS NS2 OR NOS, MODIFY DD TO BE USED TO US.
* 
 CDD4     BSS    0
          SA1    USPL 
          RJ     =XDDC       CONVERT US 
          SA6    DDXFR       SET DDXFR TO US
          RJL    =XSNP,HMAP,(SMB,/AP/TYPE,MODIFY,/AP/TYPEL,DDUS)
          NZ     X1,CDD9     IF ERROR, ABORT
          EQ     CDDX        RETURN 
  
* 
*         REMOTE HOST IS NOS/BE, MODIFY DD TO BE USED TO UH.
* 
 CDD6     BSS    0
          SA1    UHPL 
          RJ     =XDDC       CONVERT UH 
          SA6    DDXFR       SET DDXFR TO UH
          RJL    =XSNP,HMAP,(SMB,/AP/TYPE,MODIFY,/AP/TYPEL,DDUH)
          NZ     X1,CDD9     IF ERROR, ABORT
          EQ     CDDX        RETURN 
  
* 
*         DD TYPE SPECIFIED IS UH FORCE A RNEG - SEVICERS ARE THE 
*         ONLY APPLICATIONS TO SEND A UH DD PARAMETER.
* 
 CDD8     BSS    0
          SA1    RSTS 
          BX6    X1 
          SA6    TSTA        SET TRANSFER STATE 
          MX6    -1 
          SX7    DDER 
          SA6    RTYP        FORCE RNEG 
          SA7    OMSGE       SET OPERATOR MESSAGE 
          EQ     CDDX        RETURN 
  
 CDD9     RJ     ABT         ISSUE MESSAGE AND ABORT
  
 C6PL     CON    DDC6        C6 PARAMETER FOR DDC CALL
  
 C8PL     CON    DDC8        C8 PARAMETER FOR DDC CALL
  
 UHPL     CON    DDUH        UH PARAMETER FOR DDC CALL
  
 USPL     CON    DDUS        US PARAMETER FOR DDC CALL
 CHF      SPACE  4
**        CHF - FETCH CHARACTER.
* 
*         RETURN ONE CHARACTER FROM A TEXT STRING.
* 
*         ENTRY  (B2) = ADDRESS OF WORD CONTAINING CHARACTER
*                (X2) = CHARACTER-IN-WORD INDEX (0 - 9) 
* 
*         EXIT   (X6) - BITS 59-6 = 0, BITS 5-0 = CHARACTER 
*                (B2) AND (X2) ARE ADVANCED TO POINT TO NEXT CHARACTER. 
          SPACE  2
 CHF      SUBR
          SX6    6
          IX6    X2*X6
          SB4    X6+6 
          SA5    B2          FETCH WORD 
          LX5    B4 
          MX6    -6 
          BX6    -X6*X5      ISOLATE WANTED CHARACTER 
          SX2    X2+B1       ADVANCE CHARACTER-IN-WORD INDEX
          SX5    X2-10
          MI    X5,CHFX     IF NOT NEXT WORD
          SB2    B2+B1       POINT TO NEXT WORD 
          MX2    0
          EQ     CHFX        EXIT 
 CHI      SPACE  4
**        CHI - GET CHARACTER INDEX.
* 
*         CONVERT CHARACTER NUMBER TO WORD NUMBER FROM START OF TEXT
*         STRING AND CHARACTER-IN-WORD INDEX. 
* 
*         ENTRY  (X1) = CHARACTER NUMBER (1 THROUGH N)
* 
*         EXIT   (B2) = WORD NUMBER (0 THROUGH N) 
*                (X2) = CHARACTER-IN-WORD INDEX (0 THROUGH 9) 
          SPACE  2
 CHI      SUBR
          SX1    X1-1 
          PX2    X1 
          NX2 
          SA5    =10.E0 
          FX2    X2/X5
          UX2    X2,B2
          LX2    X2,B2
          SB2    X2          WORD NUMBER
          SX7    10 
          IX2    X2*X7
          IX2    X1-X2       CHARACTER-IN-WORD INDEX
          EQ     CHIX        EXIT 
 CHP      SPACE  4
**        CHP - PUT CHARACTER.
* 
*         PUT CHARACTER INTO TEXT STRING. 
* 
*         ENTRY  (B3) = WORD ADDRESS
*                (X3) = CHARACTER-IN-WORD ADDRESS (0 - 9) 
*                (X6) = CHARACTER IN BITS 5-0 
* 
*         EXIT   (B3) AND (X3) ARE ADVANCED TO POINT TO NEXT CHARACTER. 
*                THE CHARACTER IS INSERTED IN THE TEXT STRING.
          SPACE  2
 CHP      SUBR
          SX5    6
          IX5    X3*X5
          SX7    54 
          IX5    X7-X5
          SB4    X5 
          SA5    B3          FETCH WORD 
          LX6    B4          SHIFT CHARACTER
          MX7    -6 
          LX7    B4          SHIFT MASK 
          BX7    X7*X5       CLEAR CHARACTER IN WORD
          BX7    X7+X6       INSERT CHARACTER IN WORD 
          SA7    A5          STORE WORD BACK
          SX3    X3+B1       ADVANCE INDEX
          SX5    X3-10
          MI    X5,CHPX     IF NOT NEXT WORD
          SB3    B3+B1       ADVANCE POINTERS TO NEXT WORD
          MX3    0
          EQ     CHPX        EXIT 
          SPACE  4
GRP       SPACE  4,10 
**        GRP - GET RPOS FROM ZZZZZRP.
* 
*         THIS ROUTINE LOADS THE RPOS INTO THE SEND MESSAGE BUFFER
*         FROM THE LOCAL FILE ZZZZZRP.
* 
*         ENTRY - (ZZZZZRP) = RPOS MESSAGE. 
* 
*         EXIT  - (SMB) = RPOS MESSAGE. 
  
  
 GRP      SUBR
          OPEN   ZZZZZRP,READ,R 
          SA1    RPFIRST
          BX6    X1 
          SA6    RPIN        MAKE SURE FW OF RPOS IN (SMB)
          SA6    RPOUT
          READ   ZZZZZRP,R   READ INTO SMB
          SA2    LFN
          BX7    X2 
          SA7    RETLFN      RESTORE LFN OF RETURN FILE 
          EQ     GRPX 
NTN       SPACE  4,10 
**        NTN - NETON TO RHF. 
* 
*         THIS ROUTINE ISSUES THE NETON REQUEST TO RHF AND
*         PROCESSES THE RESPONSE. 
* 
*         ENTRY - EITHER NOT NETTED ON OR EOJ CONNECT SET.
* 
*         EXIT  - (NETONF) AND (STATUS) REFLECT NETON STATUS. 
  
  
 NTN      SUBR
          RJL    =XFTUON,APPL,(QBIT,STAT,=1,=1) 
          SB1    1
          SA2    STAT 
          NZ     X2,NTN1     IF NOT NETTED ON 
          SX6    1
          SA6    NETONF      SET NETTED ON FLAG 
          RJL    =XFTUDBG,=0,(=0,NTNA,=0) 
          EQ     NTNX 
  
 NTN1     SX1    X2-1 
          MI     X1,NTN2     IF RETURN CODE TOO SMALL 
          SX6    X1-NTNC
          MI     X6,NTN3     IF RETURN CODE IN RANGE
  
 NTN2     SX1    X1+B1
          RJ     =XCDZ       CONVERT TO DPC 
          SA1    NTNB+NTNC-1 * = NN.    * 
          SA1    X1+2 
          MX0    2*6
          LX6    3*6
          LX0    -5*6 
          BX1    -X0*X1 
          BX6    X0*X6
          BX6    X1+X6
          SA6    A1 
          SX1    NTNC-1      *NETON REJECT = NN.* 
  
 NTN3     SA2    NTNB+X1     GET ADDRESS OF MESSAGE 
          SX1    X2          GET MESSAGE ADDRESS
          RJ     ABT         ISSUE MESSAGE AND ABORT
  
  
  
 NTNA     BSSZ   1           RETURN CODE FROM NETDBG
  
 NTNB     BSS    0           NETON REJECT CODES 
          LOC    1
          CON    0S59+=C*  FTFS  - SUBSYSTEM UNAVAILABLE.*
          CON    0S59+=C*  FTFS  - SUBSYSTEM FULL.* 
          CON    0S59+=C*  FTFS  - APPLICATION DISABLED.* 
  
 NTNC     CON    1S59+=C*  FTFS  - NETON REJECT = NN.*
          LOC    *O 
 PRS      SPACE  4,10 
**        PRS - PRESET FOR PROCESSING.
* 
* 
*         PROCESS CONTROL STATEMENT ARGUMENTS.
*         SET MAXIMUM CONNECTION DELAY. 
*         GET HOST PID. 
*         GET JOB NAME. 
* 
*         ENTRY - NONE. 
* 
*         EXIT  - NONE. 
  
  
 PRS      SUBR               ENTRY/EXIT 
          SA1    RA.ACT      CONTROL STATEMENT ARGUMENT COUNT 
          SB4    X1 
          SA4    RA.ARG      FWA OF ARGUMENTS 
          SB5    PRSB        ARGUMENT TABLE 
          RJ     =XARG=      PROCESS ARGUMENTS
*         NZ     X4,****     (IGNORE ANY ERRORS)
          SA5    CNCDEL      CONNECTION DELAY 
          SB7    1
          RJ     =XDXB=      CONVERT DPC TO BINARY
          SX7    30          MINIMUM CONNECTION DELAY 
          NZ     X4,PRS1     IF INCORRECT NUMBER
          IX5    X6-X7
          MI     X5,PRS1     IF LESS THAN MINIMUM 
          BX7    X6          USE VALUE FROM CS
  
 PRS1     SA7    CNCDEL      STORE CONNECTION DELAY 
          RJ     =XGETHD     GET HOST PID 
          SA6    HOST 
          BX6    X6-X6
          SA6    JOBNAME
          SYSTEM RHH,R,JOBNAME,12B*100B 
          SA1    =10H"PROGNCN"  LONG MESSAGE PREFIX 
          BX6    X1 
          SA6    PFSRPVM     RESET REPRIEVE MESSAGE PREFIX
          EQ     PRSX 
  
 PRSA     CON    0           TEMPORARY STORAGE
  
 PRSB     BSS    0           CONTROL STATEMENT ARGUMENT TABLE 
          VFD    12/0LA,18/-=-1,30/ABTFLG 
          VFD    12/0LCD,18/CNCDEL,30/CNCDEL
          CON    0
  
 RCC      SPACE  4,10 
**        RCC    RECOVR CALL. 
* 
*         RCC CALLS RECOVR TO ACTIVATE OR DEACTIVATE PFSRPV (REPRIEVE). 
* 
*         ENTRY  X6 = 0 (DEACTIVATE). 
*                X6 .NE. 0 (ACTIVATE).
* 
*         EXIT   PFSRPVA = 0/277B (PFSRPV INACTIVE/ACTIVE). 
* 
*         USES   A - 1, 6.
*                X - 1, 6.
* 
*         CALLS  RECOVR.
  
  
 RCC      SUBR
          ZR     X6,RCC1     IF DEACTIVATING
          SX6    277B        SET RECOVR MASK
 RCC1     SA1    PFSRPVA     OLD MASK 
          SA6    A1 
          BX1    X1-X6
          ZR     X1,RCCX     IF NO CHANGE 
          RECOVR =XPFSRPV,X6,0
          EQ     RCCX        RETURN 
 RNE      SPACE  4,10 
**        RNE - FORCE REPLY NEGATIVE WITH ERROR.
* 
*         RNE ISSUES THE DAYFILE MESSAGE AND SETS THE RTYP FLAG 
*         SO THAT AN RNEG IS SENT.
* 
*         ENTRY - (X6) = ERROR MESSAGE ADDRESS. 
* 
*         EXIT  - (X1) = ZERO 
*                 (RTYP) = -1 (SEND REPLY NEGATIVE) 
*                 (TSTA) = TRANSFER REJECTED STATUS.
  
  
 RNE      SUBR               ENTRY/EXIT 
          MESSAGE  X6,3,R 
          SA2    RSTS        *REJECTED, SEE TEXT* 
          MX1    0
          BX7    X2 
          SA7    TSTA        SET TRANSFER STATUS
          MX7    -1 
          SA7    RTYP        SEND RNEG FLAG 
          EQ     RNEX        RETURN 
SCC       SPACE  4,10 
**        SCC - SCAN CONTROL CARD IMAGE FROM DAYFILE. 
* 
*         IF INTERNALLY PROCESSED CONTROL CARD
*         THEN
*           IF *ABORT* OR *DONE*
*           THEN
*             SET RETURN TO NOT SEND DAYFILE MESSAGE. 
*           ELSE
*             SKIP PAST INTERNAL CONTROL CARD FLAG. 
* 
*         ENTRY - (X1) = ADDRESS OF DAYFILE MESSAGE.
* 
*         EXIT  - (X1) = 0, SKIP DAYFILE MESSAGE. 
*                      " 0, FWA OF MESSAGE TO SEND. 
  
  
 SCC      SUBR
          SA2    X1+1 
          SA3    EXIT 
          BX6    X2-X3
          MX0    30 
          BX6    X6*X0
          ZR     X6,SCC1     IF *EXIT* CONTROL CARD 
          SA3    FTFSPRW
          BX6    X2-X3
          NZ     X6,SCCX     IF NOT PROCESSED BY FTFS 
          SA2    X1+2 
          SA3    DONE 
          BX6    X2-X3
          BX6    X6*X0
          ZR     X6,SCC1     IF *DONE* CONTROL CARD 
          SA3    ABORT
          MX0    36 
          BX6    X2-X3
          BX6    X6*X0
          ZR     X6,SCC1     IF *ABORT* CONTROL CARD
          SA4    X1          GET TIME FROM DAYFILE
          SX1    X1+1 
          BX6    X4 
          SA6    X1          REPLACE *FTFS.* WITH TIME
          EQ     SCCX 
  
 SCC1     MX1    0           SKIP CONTROL CARD
          EQ     SCCX 
  
 EXIT     DIS    ,*EXIT(S)* 
 DONE     DIS    ,*DONE.* 
 ABORT    DIS    ,*ABORT.*
SCP       SPACE  4,10 
**        SCP - SAVE CURRENT PRU INDEX. 
* 
*         GET FILE INFORMATION. 
*         GET CURRENT PRU FROM FILINFO BLOCK. 
*         SAVE CURRENT PRU IN CCL REGISTERS.
* 
*         ENTRY - NONE. 
* 
*         EXIT  - CCL REGISTERS UPDATED TO CURRENT PRU. 
  
  
 SCP      SUBR
          SA1    FILPARM
          MX0    -1 
          BX6    X1*X0
          SA6    A1          CLEAR COMPLETE BIT 
          FILINFO FILPARM 
          SA3    FILPARM+3   CURRENT PRU INDEX WORD 
          MX6    -24
          LX3    -30-6       CHANGE WORDS TO PRUS 
          BX6    -X6*X3      MASK OUT PRU INDEX 
          SX1    1
          IX6    X6+X1
          LX6    18          POSITION PRU INDEX 
          SA1    JCI+1
          MX0    -24
          LX0    18 
          BX7    X0*X1       SAVE R1 AND EF 
          BX7    X7+X6       REPLACE R2 AND R3
          SA7    A1 
          EQ     SCPX 
  
 FILPARM  VFD    42/0LZZZZZDF,6/4,12/0
          BSSZ   4
SDM       SPACE  4,10 
**        SDM - SEND DAYFILE MESSAGES 
* 
*         CALL SRT TO SEND RECOVERY TEXTS IF NEEDED.
*         FLUSH DAYFILE.
*         SAVE CURRENT PRU. 
*         REPEAT
*           READ DAYFILE MESSAGE. 
*           IF MESSAGE TO BE SENT TO REMOTE 
*           THEN
*             IF CONTINUED MESSAGE
*             THEN
*               READ AND CONCATENATE SECOND PART OF MESSAGE.
*             PLACE MESSAGE IN NETPUT BUFFER. 
*         UNTIL EOI REACHED 
* 
*         ENTRY - (JCI+1) = PRU TO START READING FROM.
*                 ZZZZZDF IS LOCAL FILE WITH MATCHING RBT 
*                 OF JOB DAYFILE. 
* 
*         EXIT  - (JCI+1) = PRU + 1 OF DAYFILE SENT.
  
  
 SDM      SUBR
          RJ     SRT         SEND RECOVERY TEXTS
          SA1    JCI+1
          MX0    -24
          AX1    18 
          SA3    DFPRUI 
          BX2    -X0*X1      EXTRACT CURRENT PRU
          BX6    X0*X3
          BX6    X6+X2       SET PRU TO READ
          SA6    A3 
          BX6    X6-X6
          SA6    RW          CLEAR COMPLETE BIT 
          SYSTEM RHH,R,RW,5*100B
          RJ     SCP         SAVE CURRENT PRU 
 SDM1     READNS  ZZZZZDF,R 
 SDM2     READC  ZZZZZDF,TEXT,TEXTL 
          SX7    X1+B1
          MI     X7,SDMX     IF EOI 
          NZ     X1,SDM1     IF EOR OR EOF
          SX1    TEXT 
          RJ     SCC         SCAN CONTROL CARD
          ZR     X1,SDM2     IF NOT SENDING CONTROL CARD
          BX6    X1 
          SA2    X1+B1       SECOND WORD OF MESSAGE 
          SA6    SDMA 
          SA3    =10H"FIPNAMC"
          BX6    X2-X3
          ZR     X6,SDM2.1   IF LONG FIP MESSAGE
          SA3    =10H"PROGNCN"     CONTINUED MESSAGE PREFIX 
          BX6    X2-X3
          NZ     X6,SDM3     IF NOT CONTINUED FTFS MESSAGE
          SA3    =10H"PROGNAM"
 SDM2.1   BX6    X3 
          SA6    A2          CHANGE TO NORMAL FTFS PREFIX 
          SX5    X1+5        SAVE FWA OF SECOND HALF OF MESSAGE 
          READW  ZZZZZDF,X5,B1     SKIP TIME FIELD
          READC  X2,X5,TEXTL-5-1   READ SECOND LINE OF MESSAGE
          SA1    SDMA        FWA OF MESSAGE 
 SDM3     RJ     =XGTL       DETERMINE MESSAGE LENGTH 
          SA6    TXTL 
          SA5    SDMA 
          RJL    =XSNP,HMAP,(SMB,/AP/DMSG,SELECT,TXTL,X5) 
          ZR     X1,SDM2     IF NO ERROR
          RJ     ABT         ABORT
  
 SDMA     CON    0           FWA OF TEXT
 SNR      SPACE  4,10 
**        SNR - SEND NEGATIVE RESPONSE. 
* 
*         SNR REPLIES TO A *RFT* WITH A *RNEG* WHEN IT HAS BEEN 
*         DETERMINED THAT NO PERMANENT FILE TRANSACTION CAN OCCUR 
*         DUE TO A PARAMETER OR PRE-PROCESSOR ERROR.
* 
*         PUT ANY DAYFILE MESSAGES IN RNEG BUFFER.
*         PUT OPERATOR MESSAGE IN RNEG BUFFER.
*         PUT TRANSFER STATE IN RNEG BUFFER.
*         RETURN FILE TRANSFER FILE.
*         SEND RNEG TO MFLINK.
*         UPDATE STATE. 
* 
*         ENTRY - (TSTA) = ERROR STATE
*                 (OMSGE) = OPERATOR MESSAGE ADDRESS
*                (PIDERR) = NON-ZERO, IF PROTOCOL IDENT MISMATCH. 
* 
*         EXIT  - RNEG SENT TO MFLINK.
*                 (STATE) = RNEG SENT, WAIT FOR REPLY.
* 
  
  
 SNR1     SA1    TSTA 
          NZ     X1,SNR1.1   IF STATE OF TRANSFER SET 
          SA1    RSTS        *REJECTED, SEE TEXT* 
          BX6    X1 
          SA6    TSTA 
 SNR1.1   RJL    =XSNP,HMAP,(SMB,/AP/STATE,SELECT,/AP/STATEL,TSTA)
          NZ     X1,SNR0     IF ERROR 
          SA1    F
          ZR     X1,SNR2     IF EMPTY FILE TRANSFER FET 
          SA1    F
          MX0    -1 
          BX2    X1*X0
          BX6    -X0+X2 
          SA6    A1          SET COMPLETE BIT 
          RETURN F,R         RETURN ANY PERMANENT FILE
 SNR2     SA1    HMAP 
          RJ     =XSML       SEND RNEG MESSAGE
          NZ     X1,SNR0     IF ERROR IN TRANSFER 
          SX1    RNEGSWR
          RJ     UDS         STATE = NNEG SENT, WAIT REPLY
  
 SNR      SUBR               ENTRY/EXIT 
          ACSTORE  SMB,RNEG,MBL 
          SA1    PIDERR 
          ZR     X1,SNR0.1   IF PROTOCOL IDENTS MATCH 
          RJL    =XSNP,HMAP,(SMB,/AP/ID,SELECT,/AP/IDL,CURID) 
          NZ     X1,SNR0     IF ERROR 
 SNR0.1   BSS    0
          RJ     WSM         WRITE SYSTEM ERROR MESSAGE 
          ZR     X6,SNR0.2   IF NO SYSTEM ERROR OCCURRED
          SA1    RSTS        *REJECTED, SEE TEXT* 
          BX6    X1 
          SA6    TSTA 
 SNR0.2   BSS    0
          RJ     SDM         SEND DAYFILE MESSAGES
          SA1    OMSGE
          ZR     X1,SNR1     IF NO OPERATOR MESSAGE 
          RJ     =XGTL       GET TEXT LENGTH
          SA6    OMSGL       SAVE TEXT LENGTH 
          SA5    OMSGE
          MX6    0
          SA6    A5          CLEAR ERROR MESSAGE ADDRESS
          RJL    =XSNP,HMAP,(SMB,/AP/OMSG,SELECT,OMSGL,X5)
          ZR     X1,SNR1     IF NO ERRORS 
  
 SNR0     RJ     ABT
 SPR      SPACE  4,10 
**        SPR - SEND POSITIVE RESPONSE. 
* 
*         SPR IS CALLED TO SEND A POSITIVE RESPONSE AFTER INITIAL 
*         POSITIVE PARAMETER PROCESSING OF *RFT* COMMAND. 
* 
*         DAYFILE ACCOUNTING MESSAGE. 
*         PUT MODE OF ACCESS, JOBNAME, HOST PID, HOST TYPE, 
*           ID BEING USED, CONTINUATION CHARACTER, AND RECOVERY 
*           TEXT IN THE RPOS BUFFER.
*         SAVE RPOS BUFFER ON FILE ZZZZZRP. 
* 
*         ENTRY - RFT MUST HAVE BEEN RECEIVED AND THE RFT PARAMETERS
*                 HAVE BEEN SUCCESSFULLY PROCESSED. 
* 
*         EXIT - NONE.
  
  
 SPR      SUBR               ENTRY/EXIT 
 SPRA     MESSAGE  ALKA,5,R  *ACLK, JOBNAMM, PID, LID.* 
 DBG      IFC    EQ,*"DEBUG"*DEBUG* 
          MESSAGE  ALKA,0,R 
 DBG      ENDIF 
          SA1    SPRB 
          BX6    X1 
          SA6    SPRA        DISABLE ACCOUNT MESSAGE LOGGING
 SPR1     BSS    0
 SPR2     RJL    =XSNP,HMAP,(SMB,/AP/MODE,SELECT,/AP/MODEL,ACCESS)
          NZ     X1,SPR9     IF ERROR 
          RJL    =XSNP,HMAP,(SMB,/AP/JOBN,SELECT,/AP/JOBNL,JOBNAME) 
          NZ     X1,SPR9     IF ERROR 
          RJL    =XSNP,HMAP,(SMB,/AP/PID,SELECT,/AP/PIDL,HOST)
          NZ     X1,SPR9     IF ERROR 
          RJL    =XSNP,HMAP,(SMB,/AP/HOSTT,SELECT,/AP/HOSTTL,NOSBE) 
          NZ     X1,SPR9     IF ERROR 
          SA1    FACTXTL
          NG     X1,SPR2.1   IF NO FACILITIES REQUIRED
          RJL    =XSNP,HMAP,(SMB,/AP/FAC,FACQUAL,FACTXTL,FACTEXT) 
          NZ     X1,SPR9     IF ERROR 
 SPR2.1   BSS    0
          SA1    MBSIZE      NETXFR MAXIMUM BLOCK SIZE
          SA2    MBS         BLOCK SIZE SELECTED BY INITIATOR 
          ZR     X2,SPR3     IF NONE SENT 
          BX6    X1-X2
          ZR     X6,SPR3     IF RFT MBZ MATCHES NETXFR MBZ
          RJ     =XCDZ
          LX6    60-6*/AP/MBZL
          SA6    SPRA 
          RJL    =XSNP,HMAP,(SMB,/AP/MBZ,MODIFY,/AP/MBZL,SPRA)
          NZ     X1,SPR9     IF ERROR 
  
 SPR3     BSS    0
          SA1    DDXFR
          BX6    X1 
          SA6    DDTYPE      DD SAVED IN RPOS BUFFER FOR XFR
          EQ     SPRX        RETURN 
  
 SPR9     RJ     ABT         ABORT
  
 SPRB     EQ     SPR1        ** REPLACES *SPRA* TO DISABLE CHECK ** 
SRT       SPACE  4,10 
**        SRT - SEND RECOVERY TEXT
* 
*         SRT REWINDS AND READS THE RECOVERY TEXT FILE.  EACH TEXT
*         LINE IS PUT IN THE *NETPUT* BUFFER AS USER TEXT.
* 
*         IF NO RECOVERY TEXT RECEIVED
*              OR RECOVERY TEXT ALREADY SENT
*         THEN
*           RETURN. 
*         FLUSH ZZZZZRT BUFFER. 
*         REWIND ZZZZZRT. 
*         ASLONGAS NOT EOR/EOF/EOI DO 
*           READ LINE FROM ZZZZZRT. 
*           PUT LINE IN RPOS BUFFER.
*         SET RECOVERY TEXT SENT FLAG.
* 
*         ENTRY - BIT 15 OF *R3* IS 0 IF RECOVERY TEXT NOT SENT.
* 
*         EXIT  - RECOVERY TEXT PUT IN RPOS BUFFER. 
  
  
 SRT      SUBR
          SA1    RBUF        FWA OF RECOVERY TEXT BUFFER
          ZR     X1,SRTX     IF NO RECOVERY TEXT IN BUFFER
          SA1    JCI+1
          LX1    59-51
          MI     X1,SRTX     IF RECOVERY TEXT SENT
          WRITER ZZZZZRT,R   FLUSH BUFFER 
          REWIND ZZZZZRT,R   REWIND RFILE 
          READNS ZZZZZRT,R   START READ ON RECOVERY FILE
 SRT1     READC  ZZZZZRT,TEXT,TEXTL 
          NZ     X1,SRT2     IF EOR/EOF/EOI 
          SX1    TEXT 
          RJ     =XGTL       GET TEXT LENGTH
          SA6    TXTL 
          RJL    =XSNP,HMAP,(SMB,/AP/UTEXT,SELECT,TXTL,TEXT)
          ZR     X1,SRT1     IF NO ERROR
          RJ     ABT
  
 SRT2     SA1    JCI+1
          MX0    1
          LX0    51-59
          BX6    X1-X0
          SA6    A1          SET RECOVERY TEXT SENT FLAG
          EQ     SRTX 
UDS       SPACE  4,10 
**        UDS - UPDATE STATE. 
* 
*         THIS ROUTINE CHANGES THE CURRENT STATE TO THE STATE 
*         SUPPLIED IN *X1*. 
* 
*         ENTRY - (X1) = NEW STATE. 
* 
*         EXIT  - CCL REGISTER UPDATED TO REFLECT NEW STATE.
  
  
 UDS      SUBR
          SA2    JCI+1
          MX0    -18
          BX3    X2*X0       SAVE REMAINDER OF CCL REGISTERS
          BX6    X3+X1       INSERT NEW STATE 
          SA6    A2          SET CCL REGISTERS
          EQ     UDSX 
VFN       SPACE  4,10 
**        VFN - VALIDATE FILE NAME. 
* 
*         VFN VERIFIES FILE NAME IS VALID.
* 
*         LFN MUST BE 1 TO SEVEN CHARACTERS (A-Z OR 0-9) WITH 
*         THE FIRST CHARACTER IN THE RANGE OF A TO Z. 
* 
*         ENTRY - (RA.ARG+1) = LFN RIGHT JUSTIFIED. 
* 
*         EXIT  - (X6) = 0, IF VALID LFN
*                      NE 0, OTHERWISE. 
*                 (CCLFN) = LFN.
  
  
 VFN      SUBR               ENTRY/EXIT 
          SA1    RA.ARG+1 
          MX0    42 
          BX1    X1*X0
          BX6    X1 
          SA6    CCLFN       SAVE LFN 
          RJ     =XSFN=      SPACE FILL NAME (X1) = LFN 
          SA2    =10LAAAAAAAAAA    LFN LOWER LIMIT AND BORROW MASK
          IX4    X6-X2
          BX3    X6-X2
          BX5    X4-X3
          SA3    =7LZ999999  LFN UPPER LIMIT
          IX4    X3-X1
          BX3    X3-X1
          BX3    X4-X3
          BX3    X3+X5
          BX6    X2*X3       RETURN BORROWED BITS 
          ZR     X6,VFNX     IF VALID LFN 
          SX6    LFID        LFN INVALID
          RJ     RNE         FORCE RNEG 
          MX6    1
          EQ     VFNX        RETURN 
 WSM      SPACE  4,10 
**        WSM - WRITE SYSTEM ERROR MESSAGE. 
* 
*         WSM WRITES A SYSTEM ERROR MESSAGE TO THE DAYFILE. 
* 
*         ENTRY  PFSRPVT = 0 (NO SYSTEM ERROR). 
*                        = 1 (MESSAGE WRITTEN PREVIOUSLY).
*                        .NE. 0 OR 1 (NEW MESSAGE TO WRITE).
*                PFSRPVM = FWA OF MESSAGE.
* 
*         EXIT   X6 = PFSRPVT = 0 (NO MESSAGE). 
*                             = 1 (MESSAGE WRITTEN).
* 
*         USES   A - 1, 6.
*                X - 1, 6.
* 
*         CALLS  WRITEC.
  
  
 WSM      SUBR
          SA1    PFSRPVT
          BX6    X1 
          AX1    1
          ZR     X1,WSMX     IF NO ERROR OR NEW MESSAGE 
          MESSAGE  PFSRPVM,3,RCL
          SX6    1
          SA6    PFSRPVT     FLAG MESSAGE WRITTEN 
          EQ     WSMX        RETURN 
          TITLE  COMMAND PROCESSORS.
          SPACE  4,20 
**        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 PARAMETER BLOCK AS RECEIVED. 
* 
*         EXIT  - (X1) = ERROR MESSAGE ADDRESS IF PROCESSOR ERROR 
*                      = ZERO IF NO ERROR DETECTED
*                 ALL PARAMETERS ASSOCIATED WITH THE COMMAND ARE
*                PROCESSED. 
 CET      SPACE  4,10 
**        CET - ETP COMMAND PROCESSOR.
* 
*         THIS ROUTINE IS ENTERED AFTER RECEIVING THE ENTER 
*         TERMINATION PHASE COMMAND FROM *MFLINK*.  THE *ETPR*
*         IS BUILT AND SENT BACK TO *MFLINK*.  THE STATE IS 
*         CHANGED TO WRAP UP. 
* 
*         ENTRY - (MB) = MESSAGE BUFFER RECEIVED. 
* 
*         EXIT  - (X1) = ERROR MESSAGE ADDRESS IF ERROR DETECTED
*                      = ZERO IF NO ERROR 
*                 THE *ETPR* WAS SENT AND STATE UPDATED.
  
  
 CET      SUBR               ENTRY/EXIT 
          ACSTORE  SMB,ETPR,MBL 
          SA1    HMAP 
          RJ     =XSML       SEND *ETP* REPLY 
          NZ     X1,CETX     IF ERROR IN PROCESSOR
          SX1    WRAPUP 
          RJ     UDS         STATE = WRAP UP
          MX1    0
          EQ     CETX        RETURN 
 CFI      SPACE  4,10 
**        CFI - FINI COMMAND PROCESSOR. 
* 
*         CFI IS CALLED TO PROCESS THE *FINI* COMMAND RECEIVED
*         FROM THE INITIATOR.  THE NETWORK CONNECTION IS
*         TERMINATED AND THE STATE IS CHANGED TO NOT CONNECTED. 
*         IF THE CONNECTION IS NORMALLY TERMINATED CFI WILL ALSO
*         ISSUE THE NETOFF. 
* 
*         ENTRY - THE *FINI* COMMAND BLOCK WAS RECEIVED.
* 
*         EXIT  - (X1) = 0, NORMAL TERMINATION. 
*                      " 0, BLOCK RECEIVE ERROR.
  
  
 CFI      SUBR               ENTRY ONLY 
          SA4    STAT        CHECK STATUS WORD
          MX5    60 
          BX4    X4-X5
          ZR     X4,CFI2     IF CONNECTION BROKEN ALREADY RECEIVED
          SA1    HMBP 
          RJ     =XRML       WAIT FOR CONNECTION BROKEN 
          SA4    STAT 
          MX5    60 
          BX4    X4-X5
          ZR     X4,CFI2     IF CONNECTION BROKEN 
          NZ     X1,CFI1     IF ERROR RECEIVED
  
*         CONTROL SHOULD NOT PASS THROUGH HERE.  IF THE NETWORK 
*         OR THE INITIATOR HAS NOT TERMINATED THE CONNECTION
*         *FTFS* WILL AT THIS TIME. 
  
          SX1    NSEM        * NETWORK SEQUENCE ERROR.* 
  
 CFI1     EQ     CFIX 
  
 CFI2     SX1    NOTCON 
          RJ     UDS         STATE = NOT CONNECTED
          RJ     =XFTUOFF 
          SB1    1
          BX6    X6-X6
          SA6    NETONF 
          RJ     =XSEJ       SET END OF JOB CONTROL CARDS 
          MX1    0
          EQ     CFIX 
 CFT      SPACE  4,10 
**        CFT - RFT COMMAND PROCESSOR.
* 
*         CFT PROCESSES ALL PARAMETERS ASSOCIATED WITH THE
*         REQUEST FILE TRANSFER COMMAND.  THE FILE TRANSFER 
*         STATUS IS INITIALLY SET TO *NULL*.
* 
*         INITIALIZE PARAMETER FLAGS AND LOCAL FILES. 
*         SET UP *RPOS* RESPONSE AND 1ST PARAMETER (PROTOCOL ID). 
*         PROCESS RFT PARAMETERS. 
*         IF PARAMETERS SUCCESSFULLY PROCESSED
*         THEN
*           CHANGE THE JOB INPUT FILE TO EXECUTE THE USER 
*             SPECIFIED CONTROL CARDS.
*           UPDATE STATE. 
*         ELSE
*           SEND NEGATIVE REPLY.
* 
*         ENTRY - (MB) = MESSAGE BUFFER CONTAING *RFT* PARAMETERS.
* 
*         EXIT  - (X1) = ZERO 
  
  
 CFT      SUBR               ENTRY/EXIT 
          SX7    -1 
          SA7    FACTXTL     SET DEFAULT TO NO FACILITIES REQUIRED
          SA7    XMIT        SET DEFAULT TO NO TRANSFER 
          SX6    NODIR
          SA6    DIR         SET INITIALLY TO NO DIRECTION
          SA2    NULL 
          BX7    X2 
          SA7    ACCESS      INITIALIZE ACCESS TO NULL
          MX6    0
          SA6    PUR         CLEAR ENTRY POINTS USED AS FLAGS 
          SA6    =XPJN
          SA6    PLD
          SA6    MBS         CLEAR MAXIMUM BLOCK SIZE 
          SA6    NUMCC
          SA6    RTYP 
          SA6    RETLFN      CLEAR LFN OF FILE TO RETURN
          SA6    TSTA 
          ACSTORE SMB,RPOS,MBL     RPOS COMMAND 
          RJL    =XSNP,HMAP,(SMB,/AP/ID,SELECT,/AP/IDL,CURID) 
          SA1    C6PL 
          RJ     =XDDC       GET CODE FOR C6
          SA6    DDXFR       RESET DDXFR TO C6
          REWIND ZZZZZRP,R
          REWIND ZZZZZRT,R
          RJ     =XSUL       SET USER TEXT LFN
          RETURN ZZZZZUT,R
          OPEN   ZZZZZUT,WRITE,R
 CFT0     RJL    =XPRP,MB,(ATTR,QUAL,TXTL,TEXT,RPPT)
          ZR     X1,CFT1     IF NO ERROR DETECTED 
          NG     X1,CFT0.1   IF UNKNOWN ATTRIBUTE 
          MESSAGE  X1,0,R 
 CFT0.1   BSS    0
          RJL    =XSNP,HMAP,(SMB,ATTR,IGNORE,TXTL,TEXT) 
          EQ     CFT0        PROCESS NEXT PARAMETER 
  
 CFT1     SA1    RTYP 
          NZ     X1,CFT4     IF ERROR IN RFT PARAMETERS 
          RJ     WSM         WRITE SYSTEM ERROR MESSAGE 
          NZ     X6,CFT4     IF SYSTEM ERROR OCCURRED 
          SA2    NULL 
          SA3    ACCESS 
          BX4    X2-X3
          ZR     X4,CFT2     IF NO TRANSFER SPECIFIED 
          RJ     CDD         CHECK DATA DECLARATION 
          SA1    RTYP 
          NZ     X1,CFT4     IF INVALID DATA DECLARATION
 CFT2     SA1    PUR
          SA2    =XPJN
          SA3    PLD
          ZR     X1,CFT3     IF NO USER TEXT PROCESSED
          ZR     X2,CFT3     IF NO JOB NAME PROCESSED 
          ZR     X3,CFT3     IF NO LID PROCESSED
          RJL    =XMBZ,DDXFR,(DBZ,NWTYPE) 
          SA6    MBSIZE      MAXIMUM BLOCK SIZE 
          SA1    MBS         BLOCK SIZE SENT BY INITIATOR 
          ZR     X1,CFT2.1   IF NONE SENT 
          IX2    X1-X6
          PL     X2,CFT2.1   IF NETXFR MBZ .LE. RFT MBZ 
 .1       DECMIC /AP/MBZ,2
          SX6    3R".1".
          LX6    59-17
          SA6    PEPM+3 
          MESSAGE PEPM,0,RCL
          EQ     CFT4 
  
 CFT2.1   BSS    0
          WRITEW ZZZZZUT,ENDCCS,ENDCCSL 
          WRITER ZZZZZUT,R
          SA1    ZZZZZUT
          MX0    -1 
          BX6    X0*X1
          SA6    A1          CLEAR COMPLETE BIT 
          ENCSF  ZZZZZUT,SETBOI 
          RJ     =XSLF       SET INPUT FILE LFN FLAG
          SX6    NCCTOP 
          SA6    CCTOPF 
          RJ     SPR         SET RPOS 
          SX1    RFTRPCC
          RJ     UDS         STATE = RFT RECEIVED, PROC. CC 
          MX1    0
          EQ     CFTX        RETURN 
  
 CFT3     SA2    RUTS        *REJECTED, UNSPECIFIC XFER*
          BX6    X2 
          SA6    TSTA        SET TRANSFER STATUS
 CFT4     RJ     SNR         SEND NEGATIVE REPLY
          MX1    0
          EQ     CFTX        RETURN 
  
 ENDCCS   BSS    0           END OF CONTROL CARD STREAM 
          DIS    ,*FTFS.     DONE.* 
          DIS    ,*EXIT(S)* 
          DIS    ,*FTFS.     ABORT.*
 ENDCCSL  EQU    *-ENDCCS 
 SETBOI   VFD    30/0,24/1,6/0
 CGO      SPACE  4,10 
**        CGO - GO COMMAND PROCESSOR. 
* 
*         CGO IS ENTERED WHEN THE *GO* COMMAND IS RECEIVED FROM 
*         THE INITIATOR.  NO PARAMETERS ARE VALID AND THE 
*         TRANSFER DIRECTION MUST HAVE BEEN PREVIOUSLY SET. 
* 
*         ENTRY - (MB) = GO COMMAND.
* 
*         EXIT  - (X1) = 0, GO SUCCESSFULLY RECEIVED. 
*                      " 0, RECEIVE ERROR.
*                  STATE = READY FOR FILE TRANSFER. 
  
  
 CGO      SUBR               ENTRY/EXIT 
          SX1    RFXFR
          RJ     UDS         STATE = READY FOR FILE TRANSFER
          MX6    0
          RJ     RCC         CALL RECOVR TO DEACTIVATE PFSRPV 
          MX1    0
          EQ     CGOX        RETURN 
 COG      SPACE  4,15 
**        COG - COMPLETE *GO* COMMAND PROCESSING. 
* 
*         COG IS ENTERED TO COMPLETE *GO* PROCESSING AFTER *NETXFR* 
*         HAS DONE THE ACTUAL FILE TRANSFER.
* 
*         IF FATAL FILE TRANSFER ERROR
*         THEN
*           ISSUE ERROR MESSAGE AND ABORT.
*         ELSE
*           IF RETRYABLE ERROR
*           THEN
*             ISSUE MESSAGE AND TERMINATE.
*           ELSE
*             IF PREMATURE TERMINATION
*             THEN
*               SET ABNORMAL TRANSFER STATUS. 
*               SET STATE = USER TEXT PROCESSING COMPLETE.
*               UPDATE INPUT FILE.
*             ELSE
*               ISSUE DAYFILE MESSAGE TO DENOTE SUCCESSFUL TRANSFER.
*               SET STATE = TRANSFER COMPLETE, PROCESS CONTROL CARDS. 
* 
*         ENTRY - (XMIT) = 0, IF RECEIVED FILE TRANSFER.
*                        = 1, IF SENT FILE TRANSFER.
*                 (XFRA) = FILE TRANSFER STATUS.
* 
*         EXIT  - (TSTA) = FILE TRANSFER STATUS.
*                 (STATE) = CURRENT FTFS STATE. 
  
  
 COG      SUBR               ENTRY/EXIT 
          SX6    1
          RJ     RCC         CALL RECOVR TO ACTIVATE PFSRPV 
          RJL    =XPTERXF,PEPM,(XFRA,COGA,COGB) 
          SA2    COGA        NETXFR STATUS FLAGS
*         LX2    59-59       CONNECTION-BROKEN FLAG 
          SA1    COGB        MESSAGE LOCATION 
          PL     X2,COG1     IF CONNECTION VIABLE 
          BX6    X2 
          LX6    59-54
          PL     X6,COG1     IF CONNECTION NOT BROKEN 
          MX6    60 
          SA6    STAT        SET CONNECTION BROKEN STATUS 
          RJ     ABT
 COG1     ZR     X1,COG4     IF NO ERROR
          RJ     WSM         SEND SYSTEM ERROR MESSAGE
          SA1    TSTS        *TERMINATED, SEE TEXT* 
          NZ     X6,COG5     IF SYSTEM ERROR OCCURRED 
          SA2    COGA 
          SA3    XMIT 
          LX2    59-55
          NG     X2,COG5     IF NO RETRY POSSIBLE 
          SA1    RPRS        *RECEIVE PROBLEM, RETRY* 
          ZR     X3,COG5     IF RECEIVING 
          SA1    SPRS        *SENDER PROBLEM, RETRY*
          EQ     COG5 
  
 COG4     SA1    PFSRPVT
          NZ     X1,COG1     IF SYSTEM ERROR
          RJL    =XGFL,F,(DDXFR)  GET FILE LENGTH 
          BX1    X7 
          RJ     =XCFD=      CONVERT LENGTH TO F10.3 FORMAT 
          SA6    ULSA+1 
          MESSAGE  ULSA,5,R  *UCLS,PF,XX.XXXKUNS.*
          SX6    PRCD+1 
          MESSAGE X6,3,R     *PF REQUEST COMPLETE.* 
          SX1    XFRCPCC     STATE = TRANSFER COMPLETE, PROCESS CC
          EQ     COG6        RETURN 
  
 COG5     BX6    X1 
          SA6    TSTA        RESET TRANSFER STATE 
          SX1    UTXTPRC     STATE = USER TEXT PROCESSING COMPLETE
  
 COG6     RJ     UDS         UPDATE STATE 
          MX1    0
          EQ     COGX 
  
 COGA     CON    0           CONNECTION BROKEN FLAG 
  
 COGB     CON    0           NETXFR MESSAGE ADDRESS 
 CST      SPACE  4,10 
**        CST - STOP COMMAND PROCESSOR. 
* 
*         CST IS CALLED AFTER RECEIVING THE *STOP* COMMAND
*         FROM *MFLINK*.
* 
*         SETUP STOPR BUFFER. 
*         PROCESS STOP PARAMETERS.
*         IF PARAMETERS VALID.
*         THEN
*           PUT TRANSFER STATE AND DAYFILE MESSAGES IN STOPR BUFFER.
*           SEND STOPR TO MFLINK. 
*           RETURN FILE IF NECESSARY. 
*           UPDATE STATE TO IDLE. 
*         ELSE
*           ISSUE ERROR MESSAGE AND ABORT.
* 
*         ENTRY - (MB) = COMMAND BUFFER RECEIVED
*               - (TSTA) = FILE TRANSFER STATUS.
* 
*         EXIT  - (X1) = 0. 
*                 STOPR SENT AND STATE UPDATED. 
  
  
 CST3     RJL    =XSNP,HMAP,(SMB,/AP/STATE,SELECT,/AP/STATEL,TSTA)
          NZ     X1,CSTX     IF ERROR 
          RJ     SDM         SEND DAYFILE MESSAGES
          SA1    HMAP        SET PARAMETER LIST ADDRESS 
          RJ     =XSML       SEND *STOPR* 
          SX5    B0+
          NZ     X1,CSTX     IF ERROR IN TRANSFER 
          SA1    RETLFN 
          ZR     X1,CST4     IF NO FILE RETURN NECESSARY
          RETURN RETLFN,R 
 CST4     BSS    0
          SX1    IDLE 
          RJ     UDS         STATE = IDLE 
          MX1    0
  
 CST      SUBR               ENTRY/EXIT 
          ACSTORE  SMB,STOPR,MBL
 CST1     RJL    =XPRP,MB,(ATTR,QUAL,TXTL,TEXT,SPPT)
          ZR     X1,CST2     IF NO ERROR IN PARAMETER 
          NG     X1,CST1     IF UNKNOWN ATTRIBUTE 
          MESSAGE  X1,0,R 
          RJL    =XSNP,HMAP,(SMB,ATTR,IGNORE,TXTL,TEXT) 
          ZR     X1,CST1     IF NO ERROR, CONTINUE
          EQ     CSTX 
  
 CST2     SA1    TSTA 
          NZ     X1,CST3     IF TRANSFER STATE SET
          SA2    AASS 
          BX6    X2 
          SA6    A1          ASSUME SUCCESSFUL COMPLETION 
          EQ     CST3 
 ECPT     TITLE  COMMAND RESPONSE PROCESSOR TABLES. 
**        ECPT - ETPR COMMAND RESPONSE PROCESSOR ADDRESS TABLE. 
* 
**T,ECPT   42/ CMND,18/ ADDR+1
* 
*         ADDR   - ADDRESS OF COMMAND PROCESSOR.
*         CMND   - COMMAND VALUE. 
  
  
 ECPT     CADDRE FINI,CFI 
          BSSZ   1
 ICPT     SPACE  4,10 
**        ICPT - VALID IDLE STATE COMMAND PROCESSOR ADDRESS TABLE.
* 
**T,ICPT   42/ CMND,18/ ADDR+1
* 
*         ADDR   - ADDRESS OF COMMAND PROCESSOR.
*         CMND   - COMMAND VALUE. 
  
  
 ICPT     CADDRE RFT,CFT
          CADDRE ETP,CET
          BSSZ   1
 PCPT     SPACE  4,10 
**        PCPT - RPOS COMMAND RESPONSE PROCESSOR ADDRESS TABLE. 
* 
**T,PCPT   42/ CMND,18/ ADDR+1
* 
*         ADDR   - ADDRESS OF COMMAND PROCESSOR.
*         CMND   - COMMAND VALUE. 
  
  
 PCPT     CADDRE GO,CGO 
 NCPT     SPACE  4,10 
**        NCPT - RNEG COMMAND RESPONSE PROCESSOR ADDRESS TABLE. 
* 
**T,NCPT   42/ CMND,18/ ADDR+1
* 
*         ADDR   - ADDRESS OF COMMAND PROCESSOR.
*         CMND   - COMMAND VALUE. 
  
  
 NCPT     CADDRE STOP,CST 
          BSSZ   1
 DCPT     SPACE  4,10 
**        DCPT - DATA TRANSFER PHASE COMMAND ADDRESS TABLE. 
* 
**T,DCPT   42/ CMND,18/ ADDR+1
* 
*         ADDR   - ADDRESS OF COMMAND PROCESSOR.
*         CMND   - COMMAND VALUE. 
  
  
 DCPT     EQU    NCPT 
          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.  THE PROCESSORS MUST 
*         CONFORM TO THE CONDITIONS AS STATED HERE. 
* 
*         ENTRY  (A1) = ADDRESS OF THE PARAMETER LIST 
* 
*         PARAMETER LIST FORMAT 
*         ATTR   - ATTRIBUTE VALUE OF THE PARAMETER 
*         QUAL   - QUALIFIER OF THE PARAMETER 
*         TEXT   - THE TEXT PORTION OF THE PARAMETER
*         TXTL   - THE LENGTH OF THE TEXT PORTION.
* 
*         EXIT   (X1) = ERROR MESSAGE ADDRESS IF ERROR DETECTED 
*                     = ZERO IF NO ERROR. 
PCT       SPACE  4
**        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) = ZERO.
  
  
 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 (GET COMMAND) 
          SA1    PCTA        COMPARE LAST AND CURRENT COMMANDS
          IX1    X6-X1
          ZR     X1,PCTX     IF COMMANDS MATCH
          SX1    CNFM        *CONTINUATION BLOCK DID NOT FOLLOW.* 
 PCT1     RJ     ABT         ISSUE DAYFILE MESSAGE AND ABORT
  
 PCTA     BSS    1           LAST COMMAND RECEIVED
 PDM      SPACE  4,10 
**        PDM - PROCESS DAYFILE MESSAGE.
* 
*         PDM ISSUES THE OPERATOR OR DAYFILE MESSAGES SENT
*         BY THE INITIATOR.  OPERATOR MESSAGES ARE ISSUED TO
*         THE SYSTEM AND LOCAL DAYFILES.  DAYFILE MESSAGES
*         ARE ISSUED TO ONLY THE LOCAL DAYFILE. 
* 
*         ENTRY - (A1) = PARAMETER LIST ADDRESS 
* 
*         PARAMETER LIST FORMAT 
*         ATTR   - PARAMETER ATTRIBUTE (*DMSG* OR *OMSG*) 
*         QUAL   - PARAMETER QUALIFIER
*         TEXTL  - PARAMETER TEXT LENGTH
*         TEXT   - DAYFILE MESSAGE. 
* 
*         EXIT  - (X1) = ZERO.
  
  
 PDM      SUBRL  (ATTR,,,#TEXT) 
          SA1    ATTR 
          SB2    3           SET DEFAULT FOR DAYFILE MESSAGE
          SX1    X1-/AP/DMSG
          ZR     X1,PDM1     IF DAYFILE MESSAGE 
          SB2    B0+
 PDM1     SA2    "TEXT"      GET MESSAGE ADDRESS
          MESSAGE  X2,B2,R
          EQ     PDMX        RETURN 
  
  
          QUAL   *
 PEP      SPACE  4,10 
**        PEP - PROCESS ECHO PARAMETER. 
* 
*         PEP ECHOES THE ECHO PARAMETER TEXT ON THE *RPOS*
*         COMMAND.  IF RNEG SENT, THIS IS OVERWRITTEN.
* 
*         ENTRY - (TEXT) = PARAMETER TEXT TO BE ECHOED
*               - (TXTL) = TEXT LENGTH. 
* 
*         EXIT  - (X1) = ZERO 
*               - THE PARAMETER IS ECHOED ON THE *RPOS* COMMAND.
  
  
 PEP      SUBR               ENTRY/EXIT 
          RJL    =XSNP,HMAP,(SMB,/AP/ECHO,SELECT,TXTL,TEXT) 
          NZ     X1,PEP1     IF ERROR 
          MX1    0           NO ERROR 
          EQ     PEPX        RETURN 
  
 PEP1     RJ     ABT         ABORT
 PFA      SPACE  4,10 
**        PFA - PROCESS FACILITIES PARAMETER
* 
*         PFA VALIDATES FACILITIES RECEIVED IN RFT COMMAND. 
* 
*         ENTRY  (TEXT)      FACILITIES PARAMETER 
*                (TXTL)      TEXT LENGTH
*                (NWTYPE)    NETWORK TYPE 
* 
*         EXIT   (X1)      = ERROR MESSAGE ADDRESS
*                          = 0 (NO ERROR) 
*                (FACQUAL) = *M* (FOR RPOS) 
*                (FACTEXT) = RPOS FACILITIES TEXT 
*                (FACTXTL) = RPOS FACILITIES TEXT LENGTH
*                          = -1 (NO RPOS PARAMETER NEEDED)
*                (FACIL)   = NETXFR FACILITIES
* 
*         USES   ALL REGISTERS. 
* 
*         CALLS  FACCHK.
  
  
 .1       DECMIC /AP/FAC,2
  
 PFA      SUBR
          RJL    =XFACCHK,TEXT,(TXTL,NWTYPE,PFAA,FACTEXT,FACTXTL,FACQUAL
,,FACIL,PFAB) 
          SA2    PFAB        CHECK ERROR
          NG     X2,PFA9     IF INVALID CHARACTER OR TEXT LENGTH > 240
          MX1    0
          NZ     X2,PFAX     IF RPOS PARAMETER REQUIRED 
          MX6    -1 
          SA6    FACTXTL     SET TEXT LENGTH = -1 
          EQ     PFAX 
  
 PFA9     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 ID PARAMETER. 
* 
*         PID COMPARES THE LOCAL AND REMOTE PROTOCOL IDENTIFIERS. 
*         IF CHARACTERS 1-4 MATCH:  
*           SET PIDERR = 0. 
*           RETURN (RPOS RESPONSE). 
*         ELSE
*           SET PIDERR NON-ZERO.
*           SET TSTA = *RUTS*, RTYP = -1 (RNEG RESPONSE). 
* 
*         ENTRY - (TEXT) = RECEIVED PARAMETER TEXT
*                 (CURID) = ASSEMBLED CURRENT ID. 
* 
*         EXIT  - (RTYP) = NEGATIVE IF *RNEG* TO BE RETURNED
*                 (TSTA) = *RUTS* IF PROTOCOL ID DOES NOT MATCH.
*                (PIDERR) = NON-ZERO, IF PROTOCOL IDENT MISMATCH. 
  
  
 PID      SUBR               ENTRY/EXIT 
          SA2    TEXT 
          SA3    /CONSTANT/CURID  CHECK RECEIVED WITH *CURID* 
          BX6    X2-X3
          SA6    PIDERR      CLEAR/SET PID MISMATCH FLAG
          MX1    0
          ZR     X6,PIDX     IF IDENTS MATCH
          SA2    RUTS        *REJECTED, UNSPECIFIC TRANSFER*
          MX6    -1 
          BX7    X2 
          SA6    RTYP        SET REPLY NEGATIVE 
          SA7    TSTA        SET TRANSFER STATUS
          EQ     PIDX        RETURN 
  
 PIDERR   BSS    1           PID MISMATCH FLAG
 PLD      SPACE  4,10 
**        PLD - PROCESS LID PARAMETER.
* 
*         PLD MOVES THE RECEIVED LOGICAL ID TO THE ACCOUNTING 
*         MESSAGE AREA. 
* 
*         ENTRY - (TEXT) = RECEIVED *LID*.
* 
*         EXIT  - (ALKA+2) = *LID*. 
*                 (RLID)   = *LID*
  
  
 PLD      SUBR               ENTRY/EXIT 
          SA2    TEXT 
          MX3    3*6
          BX2    X2*X3       ENSURE 3 CHARACTER *LID* 
          SX6    B1 
          BX6    X2+X6
          SA6    RLID        STORE *LID*
          SX3    1R.         SET MESSAGE TERMINATOR 
          LX3    41-5        POSITION TERMINATOR
          BX6    X2+X3
          SA6    ALKA+2      STORE ACCOUNTING MESSAGE 
          MX1    0
          EQ     PLDX        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  (TEXT) = MAXIMUM BLOCKSIZE 
*                (DBZ)  = DOWNLINE BLOCK SIZE FROM *CON/REQ/R*. 
* 
*         EXIT   (MBS)  = BLOCK SIZE PARAMETER FROM INITIATOR.
*                (DBZ)  = MIN(DBZ,MBS)
*                (X1)   = ERROR MSG IF PROTOCOL ERROR.
*                       = ZERO IF NO ERROR. 
  
  
 .1       DECMIC /AP/MBZ,2
  
 PMB      SUBR
          SA5    TEXT        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    MBS         SAVE MAXIMUM BLOCK SIZE (IN BINARY)
          SA2    DBZ         DOWNLINE BLOCK SIZE
          IX1    X6-X2
          AX1    59 
          BX2    -X1*X2 
          BX6    X1*X6
          BX6    X2+X6
          SA6    DBZ         (DBZ) = MIN(MBS,DBZ) 
          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 
 PPI      SPACE  4,10 
**        PPI - PROCESS PID PARAMETER.
* 
*         PPI ACCEPTS THE PHYSICAL ID (*PID*) AND ENTERS IT IN THE
*         CORRELATION ACCOUNTING MESSAGE. 
* 
*         ENTRY - (TEXT) = *PID*. 
* 
*         EXIT  - (ALKA) = MODIFIED CORRELLATION ACCOUNTING MESSAGE 
*                 (X1) = ZERO.
  
  
 PPI      SUBR               ENTRY/EXIT 
          SA2    TEXT 
          BX1    X1-X1
          MX6    18          SET PID MASK 
          SA3    ALKA+1 
          BX7    X6*X2       EXTRACT PID FROM TEXT
          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 
 PRH      SPACE  4,10 
**        PRH - PROCESS REQUESTED HOST TYPE PARAMETER.
* 
*         PRH WILL SEND A REJECTION TO THE INITIATOR WITH AN
*         ERROR MESSAGE IF THE REQUESTED HOST TYPE IS NOT *NOS*.
*         IF THE REQUESTED TYPE IS *NOS* NO ACTION WILL BE TAKEN. 
* 
*         ENTRY - (TEXT) = REQUESTED HOST TYPE. 
* 
*         EXIT  - (RTYP) = NEGATIVE IF THE REQUESTED TYPE IS NOT *NOS*
*                 (X1) = ZERO.
  
  
 PRH1     SX6    HNSD        *FTFS - HOST NOT SPECIFIED TYPE.*
          RJ     RNE         FORCE REPLY NEGATAIVE WITH MESSAGE 
  
 PRH      SUBR               ENTRY/EXIT 
          SA1    TEXT 
          SA2    /CONSTANT/NOSBE
          BX6    X1-X2
          NZ     X6,PRH1     SEND REPLY NEGATIVE IF NOT *NOS/BE*
          MX1    0
          EQ     PRHX        EXIT WITH NO ERROR 
 PST      SPACE  4,10 
**        PST - PROCESS STATE OF TRANSFER.
* 
*         PST MOVES THE RECEIVED STATE OF TRANSFER TO *TSTA* IF 
*         *TSTA* DOES NOT ALREADY CONTAIN A VALUE.
* 
*         ENTRY - (TSTA) = ZERO IF NO ERRORS HAVE BEEN DETECTED 
*                        = NON-ZERO IF ANY TRANSFER ERROR STATUS
*                 (TEXT) = RECEIVED STATE OF TRANSFER.
* 
*         EXIT  - (TSTA) = (TEXT) IF NO PREVIOUS ERROR AND (TEXT) IS
*                          NOT *AASS* OR *TSCS* 
*                 (X1) = ZERO.
  
  
 PST      SUBR               ENTRY/EXIT 
          SA4    AASS        *ACCEPTABLE AND SATISFACTORY*
          SA2    TSTA 
          SA3    TEXT        GET RECEIVED STATUS
          MX1    0
          BX4    X3-X4
          SA5    TSAC        *TERMINATED, SATISFACTORY AND COMPLETE*
          NZ     X2,PSTX     IF STATE ALREADY SET 
          BX5    X3-X5
          ZR     X4,PSTX     IF ACCEPTABLE STATUS 
          ZR     X5,PSTX     IF ACCEPTABLE STATUS 
          BX6    X3 
          SA6    A2          SET NEW STATE
          EQ     PSTX        RETURN 
 PUR      SPACE  4,10 
**        PUR - PROCESS USER REQUEST. 
* 
*         PUR PROCESSES THE USER TEXT PARAMETER.  THE CONTROL 
*         CARD WILL BE CRACKED AND THE CORRESPONDING PROCESSOR
*         CALLED. 
* 
*         ADD TERMINATOR TO CONTROL CARD IF NONE PRESENT. 
*         UNPACK CONTROL CARD.
*         IF NO ERRORS IN UNPACKING 
*         THEN
*           CALL CONTROL CARD PROCESSOR.
*           IF NO ERRORS IN PROCESSING
*           THEN
*             PLACE CONTROL CARD IN USER TEXT FILE. 
*           ELSE
*             SEND ERROR MESSAGE AND FORCE RNEG.
*         ELSE
*           SEND ERROR MESSAGE AND FORCE RNEG.
* 
*         ENTRY - (TEXT) = USER TEXT TO BE PROCESSED. 
*                 (TXTL) - LENGTH OF USER TEXT IN CHARACTERS. 
* 
*         EXIT  - RTYP IS NEGATIVE IF A REPLY NEGATIVE
*                   IS TO BE SENT.
*                 TSTA HAS THE CURRENT STATE OF THE TRANSFER. 
  
  
 PUR      SUBR               ENTRY/EXIT 
          SX6    B0 
          SA6    CCTYPE      RESET TYPE 
          SA6    INTPF       RESET INTERNALLY PROCESSED FLAG
          SA6    MFDMFL      RESET MFDUMP/MFLOAD FLAG 
          SB1    1
          SA1    TXTL        GET TEXT LENGTH
          RJ     CHI         GET CHARACTER INDEX
          SB2    TEXT+B2     SAVE CHARACTER GET POINTER 
          RJ     CHF         GET LAST CHARACTER 
          SX1    X6-1R. 
          ZR     X1,PUR0.1   IF LAST CHARACTER *.*
          SX1    X6-1R) 
          ZR     X1,PUR0.1   IF LAST CHARACTER *)*
          SA1    TXTL        GET TEXT LENGTH
          SX1    X1+B1
          RJ     CHI         GET CHARACTER INDEX
          BX3    X2 
          SB3    B2+TEXT     LAST WORD ADDRESS OF TEXT
          SX6    1R.
          RJ     CHP         PUT *.* AS LAST CHARACTER
          BX6    X6-X6       ADD END OF LINE
          SA6    A7+B1
 PUR0.1   SA1    NUMCC
          SX6    X1+B1
          SA6    A1          INCREMENT NUMBER OF CONTROL CARDS
          SA2    RA.ARG      CHECK IF SECONDARY USER TEXT 
          SA5    TEXT 
          SB7    A2 
          RJ     UPC         UNPACK CONTROL CARD TO PARAMETER AREA
          SA1    RA.ARG 
          NZ     X6,PUR2     IF ERROR IN UNPACK 
          SA2    VCCT 
          SA4    RA.ACT 
          MX0    42 
          BX4    X4*X0       SAVE LIBRARY NAME
          SX6    B6-B1
          SX3    X1 
          BX6    X6+X4       SET UP NAME + PARAM COUNT
          SA6    RA.ACT      SET PARAMETER COUNT
          NZ     X3,PUR2     IF INVALID STATEMENT 
          BX6    X1 
          AX6    18 
          SX1    ICCD        SET DEFAULT ERROR MESSAGE
          RJ     =XEPT       EXECUTE CONTROL STATEMENT PROCESSOR
          NZ     X1,PUR2     IF ERROR IN UNPACK 
 ACT      IFNE   ACTREQ,0 
          SA2    NUMCC
          SX2    X2-1 
          NZ     X2,PUR0     ONLY CHECK FIRST CARD FOR ACCOUNT
          SA1    JCI+1
          LX1    59-52
          PL     X1,PUR3     IF NO ACCOUNT SPECIFIED
 ACT      ENDIF 
 PUR0     BSS    0
          SA1    RTYP 
          NZ     X1,PUR1     IF SENDING RNEG
          RJ     BTF         BUILD USER TEXT FILE 
 PUR1     MX1    0
          EQ     PURX 
  
 PUR2     SA1    NUMCC
          RJ     =XCDD=      CONVERT TO DECIMAL DISPLAY 
          SA6    ICCD+2      PLACE DIRECTIVE NUMBER IN MESSAGE
          SX6    ICCD 
          EQ     PUR4 
  
 PUR3     BSS    0
 ACT      IFNE   ACTREQ,0 
          SX6    ACRD        ACCOUNT CARD REQUIRED
 ACT      ENDIF 
  
 PUR4     RJ     RNE         FORCE RNEG 
          EQ     PURX 
BTF       SPACE  4,8
**        BTF - BUILD USER TEXT FILE. 
* 
*         THIS PROCEEDURE IS CALLED AFTER AN RFT MESSAGE
*         HAS BEEN RECEIVED WITH A USER TEXT PARAMETER. 
*         IT WILL ADD THE USER TEXT FROM THE RFT MESSAGE
*         TO THE FILE ZZZZUT. 
* 
*         IF MFGIVE OR MFTAKE MUST BE GENERATED 
*         THEN
*           PLACE LFN IN CONTROL CARD.
*         IF CATALOG
*         THEN
*           WRITE MFTAKE TO ZZZZZUT.
*         IF INTERNAL CONTROL CARD
*         THEN
*           PREFIX CONTROL CARD WITH *FTFS.     * 
*         WRITE USER TEXT TO ZZZZZUT. 
*         IF ATTACH 
*         THEN
*           WRITE MFGIVE TO ZZZZZUT.
* 
*         ENTRY - (TEXT) - USER TEXT. 
* 
*         EXIT  - USER TEXT ADDED TO ZZZZZUT FILE 
  
  
 BTF      SUBR
          SB1    1
          SA5    CCTYPE 
          ZR     X5,BTF3     DO NOT GENERATE MFTAKE/MFGIVE
          SA1    CCLFN       GET LFN
          SB2    8
          MX0    6
 BTF1     BSS    0
          BX5    X0*X1       GET CHARACTER
          ZR     X5,BTF2     IF ZERO CHARACTER
          SB2    B2-B1
          EQ     B2,BTF2     LFN IS 7 CHARACTERS
          LX0    54          SHIFT MASK 
          EQ     BTF1        TRY NEXT CHARACTER 
  
 BTF2     BSS    0
          SA2    TER
          BX6    X2*X0       GET POSITIONED TERMINATOR
          MX0    42 
          BX1    X1*X0       REMOVE GARBAGE FROM LFN
          BX6    X1+X6       MERGE TERMINATOR WITH LFN
          SA6    A1          REWRITE LFN
          SA5    CCTYPE 
          SX5    X5-1 
          ZR     X5,BTF3     DO NOT GENERATE MFTAKE 
          SA4    MFTK 
          BX7    X4 
          SA7    CCMFC       MOVE MFTAKE INTO CONTROL CARD
          WRITEC ZZZZZUT,CCFTFS 
  
 BTF3     BSS    0
          SA1    INTPF
          ZR     X1,BTF4     IF NOT INTERNALLY PROCESSED
          WRITEW ZZZZZUT,CCFTFS,1 
 BTF4     WRITEC ZZZZZUT,TEXT       WRITE OUT CONTROL CARD
          SA5    CCTYPE 
          SX5    X5-1 
          NZ     X5,BTF5     DO NOT GENERATE MFGIVE 
          SA4    MFGV 
          BX7    X4 
          SA7    CCMFC       MOVE MFGIVE INTO CONTROL CARD
          WRITEC ZZZZZUT,CCFTFS 
 BTF5     BSS    0
          SA1    MFDMFL 
          ZR     X1,BTF7     IF NOT MFLOAD OR MFDUMP
          SX2    X1-MFDMP 
          ZR     X2,BTF6     IF MFDUMP BEING PROCESSED
          WRITEC ZZZZZUT,MLOAD
          EQ     BTF7 
  
 BTF6     BSS    0
          WRITEC ZZZZZUT,MDUMP
 BTF7     BSS    0
          EQ     BTFX        RETURN 
  
  
 MFGV     DATA   H*MFGIVE,   *
 MFTK     DATA   H*MFTAKE,   *
  
  
 TER      DATA   0L........ 
  
 MDUMP    DIS    ,*FTFS.     MFTAKE,LFN.* 
 MLOAD    DIS    ,*FTFS.     MFGIVE,LFN.* 
          SPACE  4
 RPPT     TITLE  COMMAND PARAMETER PROCESSOR TABLES.
**        RPPT - RFT COMMAND PARAMETER PROCESSOR ADDRESS TABLE. 
* 
**T,RPPT   42/ ATTR,18/ ADDR+1
* 
*         ADDR   - ADDRESS OF PARAMETER PROCESSOR.
*         ATTR   - VALUE OF ATTRIBUTE.
  
  
 RPPT     PADDRE ACKW,EXI 
          PADDRE CONT,PCT 
          PADDRE ECHO,PEP                                          ECHO 
          PADDRE FAC,PFA
          PADDRE HOSTT,=XPHT
          PADDRE ID,PID 
          PADDRE JOBN,=XPJN 
          PADDRE LID,PLD
          PADDRE MBZ,PMB
          PADDRE PID,PPI
          PADDRE RHOST,PRH
          PADDRE SIZE,EXI 
          PADDRE TMOUT,=XPTP
          PADDRE TYPE,=XPDP 
          PADDRE UTEXT,PUR
          BSSZ   1
 SPPT     SPACE  4,10 
**        SPPT - STOP COMMAND PARAMETER PROCESSOR ADDRESS TABLE.
* 
**T,SPPT   42/ ATTR,18/ ADDR+1
* 
*         ADDR   - ADDRESS OF PARAMETER PROCESSOR.
*         ATTR   - VALUE OF ATTRIBUTE.
  
  
 SPPT     PADDRE CONT,PCT 
          PADDRE DMSG,PDM 
          PADDRE OMSG,PDM 
          PADDRE STATE,PST
          BSSZ   1
          TITLE  CONTROL CARD PROCESSORS. 
**        CONTROL CARD PROCESSORS.
* 
*         THE FOLLOWING ROUTINES PROCESS CONTROL CARDS WHICH ARE
*         SENT TO FTFS FROM MFLINK AS USER TEXT PARAMETERS ON AN RFT. 
* 
*         ENTRY - (TEXT) = THE CONTROL CARD TO BE PROCESSED.
* 
*         EXIT   (X1) IS AN ERROR MESSAGE ADDRESS IF NON-ZERO (THE
*                MESSAGE WILL BE ISSUED TO THE DAYFILE WITH AN ABORT).
ACT       SPACE  4,10 
**        ACT    ACCOUNT CONTROL CARD PROCESSING. 
* 
*         ACT IS CALLED WHEN PROCESSING THE RFT PARAMETERS A USER 
*         TEXT PARAMETER CONTAINING AN ACCOUNT CARD IS ENCOUNTERED. 
* 
*         ENTRY - ACCOUNT CONTROL CARD HAS BEEN UNPACKED. 
* 
*         EXIT  - ACCOUNT SPECIFIED FLAG SET. 
*                 ACCOUNT CARD WRITTEN TO RECOVERY TEXT FILE. 
  
  
 ACT      SUBR
          SA1    JCI+1
          MX0    1
          LX0    52-59
          BX6    -X0*X1      SAVE REMAINDER OF WORD *JCI* 
          BX6    X6+X0
          SA6    A1          SET ACCOUNT SPECIFIED FLAG 
          WRITEC ZZZZZRT,TEXT     WRITE TO RECOVERY TEXT FILE 
          MX1    0
          EQ     ACTX 
 ATT      SPACE  4,10 
**        ATT    ATTACH CONTROL CARD PROCESSING 
* 
*         ATT IS CALLED WHEN AN ATTACH CONTROL CARD IS
*         ENCOUNTERED. IT SAVES THE LFN AND SETS WORD 
*         CCTYPE TO 1.
* 
*         ENTRY - ATTACH CONTROL CARD HAS BEEN CRACKED
* 
*         EXIT  - LFN SAVED AND CCTYPE SET TO 1 
* 
*         CALLS  MFG
  
  
 ATT      SUBR
          SX7    1
          SA7    CCTYPE      SAVE TYPE
          RJ     MFG
          EQ     ATTX        RETURN 
 CAT      SPACE  4,10 
**        CAT    CATALOG CONTROL CARD PROCESSOR 
* 
*         CAT IS CALLED WHEN A CATALOG CONTROL CARD IS
*         ENCOUNTERED. IT SAVES THE LFN AND SETS CCTYPE 
*         TO 2
* 
*         ENTRY - CATALOG CONTROL CARD HAS BEEN CRACKED 
+ 
* 
*         EXIT  - LFN SAVED AND CCTYPE SET TO 2 
  
  
 CAT      SUBR
 ACTREQ   IFNE   ACTRFC,0 
          SA1    JCI+1
          LX1    59-52
          MI     X1,CAT1     IF ACCOUNT SPECIFIED 
          SX6    ARCD 
          RJ     RNE         FORCE RNEG 
          EQ     CATX 
 ACTREQ   ENDIF 
 CAT1     SX7    2
          SA7    CCTYPE      SAVE TYPE
          RJ     MFT         SET UP DIRECTION 
          EQ     CATX        RETURN 
 EXI      SPACE  4,10 
**        EXI - EXIT WITH NO ERROR. 
* 
*         EXI IS CALLED TO NOT PROCESS A PARAMETER. 
* 
*         ENTRY - A PARAMETER NOT TO BE PROCESSED WAS FETCHED.
* 
*         EXIT  - (X1) IS ZERO. 
  
  
 EXI      SUBR               ENTRY/EXIT 
          MX1    0
          EQ     EXIX        EXIT WITH NO ERROR 
MFD       SPACE  4,10 
**        MFD - MFDUMP CONTROL CARD PROCESSING
* 
*         MFD IS CALLED WHENEVER A MFDUMP USER TEXT 
*         STRING IS ENCOUNTERED.
* 
*         SET MFDUMP/MFLOAD CONTROL CARD FLAG.
*         CALL MFT TO DO THE PROCESSING.
* 
*         ENTRY - NONE. 
* 
*         EXIT  - (X1) = 0, CONTROL CARD PROCESSING COMPLETE. 
*                      " 0, FATAL ERROR ENCOUNTERED.
  
  
 MFD      SUBR
          SX6    MFDMP
          SA6    MFDMFL      SET MFDUMP/MFLOAD FLAG 
          RJ     MFT         CALL MFTAKE TO PROCESS 
          EQ     MFDX 
 MFG      SPACE  4,10 
**        MFG - MFGIVE CONTROL CARD PROCESSING
* 
*         MFG IS CALLED WHENEVER A MFGIVE USER TEXT 
*         STRING IS ENCOUNTERED.
* 
*         IF TRANSFER DIRECTION ALREADY ESTABLISHED 
*         THEN
*           ISSUE MESSAGE AND FORCE RNEG. 
*         ELSE
*           SET DIRECTION AND MODE OF ACCESS. 
*           IF CALLED BY *ATT*
*           THEN
*             VALIDATE LFN. 
*           ELSE
*             VALIDATE CONTROL CARD.
*           IF ANY ERRORS 
*           THEN
*             ISSUE APPROPRIATE MESSAGE AND FORCE RNEG. 
* 
*         ENTRY - NONE
* 
*         EXIT -
*               (X1) = 0 - PROCESSED GOOD 
*                    " 0 - ERROR
  
  
 MFG      SUBR               ENTRY/EXIT 
          SA2    DIR         GET DIRECTION
          SX2    X2-NODIR 
          NZ     X2,MFG1     DIRECTION ESTABLISHED - ERROR
          SA1    GIVE 
          BX6    X1 
          SA6    ACCESS      SET MODE OF ACCESS 
          SX6    SEND 
          SA6    A2          SET DIRECTION TO SEND
          SA3    MFDMFL 
          NZ     X3,MFG5     IF MFLOAD CONTROL CARD 
          SA2    CCTYPE 
          NZ     X2,MFG2     IF SPECIAL CONTROL CARD
          SX6    1
          SA6    INTPF       PROCESSED INTERNALLY 
          SA1    RA.ACT 
          SX2    X1-1 
          ZR     X2,MFG2     ONLY LFN IS SPECIFIED (CORRECT)
          MI     X2,MFG3     NO LFN IS SPECIFIED (ERROR)
          EQ     MFG4        MORE THEN THE LFN IS SPECIFIED (ERROR) 
  
 MFG1     SX6    MFXD        MAXIMUM TRANSFERS EXCEEDED 
          RJ     RNE         FORCE RNEG 
          EQ     MFGX 
  
 MFG2     RJ     VFN         VALIDATE LOCAL FILE NAME 
          NZ     X6,MFGX     IF INVALID FILE NAME 
          EQ     MFG5 
  
 MFG3     SX6    MRLD        LFN IS REQUIRED PARAMETER
          RJ     RNE         FORCE RNEG 
          EQ     MFGX 
  
 MFG4     SX6    MALD        ONLY PARAMETER ALLOWED IS LFN
          RJ     RNE
          EQ     MFGX 
  
 MFG5     MX1    0           NORMAL RETURN
          EQ     MFGX 
MFL       SPACE  4,10 
**        MFL - MFLOAD CONTROL CARD PROCESSING
* 
*         MFL IS CALLED WHENEVER A MFLOAD USER TEXT 
*         STRING IS ENCOUNTERED.
* 
*         SET MFDUMP/MFLOAD CONTROL CARD FLAG.
*         CALL MFG TO DO THE PROCESSING.
* 
*         ENTRY - NONE. 
* 
*         EXIT  - (X1) = 0, CONTROL CARD PROCESSING COMPLETE. 
*                      " 0, FATAL ERROR ENCOUNTERED.
  
  
 MFL      SUBR
          SX6    MFLOD
          SA6    MFDMFL      SET MFDUMP/MFLOAD FLAG 
          RJ     MFG         CALL MFGIVE TO PROCESS 
          EQ     MFLX 
 MFT      SPACE  4,10 
**        MFT - MFTAKE CONTROL CARD PROCESSING
* 
*         MFT IS CALLED WHENEVER A MFTAKE USER TEXT 
*         STRING IS ENCOUNTERED.
* 
*         IF DIRECTION ALREADY ESTABLISHED
*         THEN
*           ISSUE MESSAGE AND FORCE RNEG. 
*         ELSE
*           SET MODE OF ACCESS AND DIRECTION. 
*           IF CALLED BY *CAT*
*           THEN
*             VERIFY LFN. 
*           ELSE
*             VALIDATE CONTROL CARD.
*           IF ANY ERRORS ENCOUNTERED 
*           THEN
*             ISSUE APPROPRIATE ERROR MESSAGE AND FORCE RNEG. 
* 
*         ENTRY - NONE
* 
*         EXIT -
*               (X1) = 0 - PROCESSED GOOD 
*                    " 0 - ERROR
  
  
  
 MFT      SUBR               ENTRY/EXIT 
          SA2    DIR         GET DIRECTION
          SX2    X2-NODIR 
          NZ     X2,MFT1     DIRECTION ESTABLISHED - ERROR
          SA1    TAKE 
          BX6    X1 
          SA6    ACCESS      SET MODE OF ACCESS 
          SX6    RECEIVE
          SA6    A2          SET DIRECTION TO RECEIVE 
          SA3    MFDMFL 
          NZ     X3,MFT5     IF MFDUMP CONTROL CARD 
          SA2    CCTYPE 
          NZ     X2,MFT2     IF SPECIAL CONTROL CARD
          SX6    1
          SA6    INTPF       PROCESSED INTERNALLY 
          SA1    RA.ACT 
          SX2    X1-1 
          ZR     X2,MFT2     ONLY LFN IS SPECIFIED (CORRECT)
          MI     X2,MFT3     NO LFN IS SPECIFIED (ERROR)
          EQ     MFT4        MORE THEN THE LFN IS SPECIFIED (ERROR) 
  
 MFT1     SX6    MFXD        MAXIMUM TRANSFERS EXCEEDED 
          RJ     RNE         FORCE RNEG 
          EQ     MFTX 
  
 MFT2     RJ     VFN         VALIDATE LOCAL FILE NAME 
          NZ     X6,MFTX     IF INVALID FILE NAME 
          EQ     MFT5 
  
 MFT3     SX6    MRLD        LFN IS REQUIRED PARAMETER
          RJ     RNE         FORCE RNEG 
          EQ     MFTX 
  
 MFT4     SX6    MALD        ONLY PARAMETER ALLOWED IS LFN
          RJ     RNE
          EQ     MFTX 
  
 MFT5     MX1    0           NORMAL RETURN
          EQ     MFTX 
 TPDN     SPACE  4,10 
**        TPDN - TAPE DENSITY CHECK 
* 
*         TPDN IS CALL TO CHECK THE TAPE DENSITY PARAMETER FOR REQUEST
*         AND LABEL CONTROL CARDS.
* 
*         ENTRY - REQUEST OR LABEL CONTROL CARD HAS BEEN CRACKED
* 
*         EXIT  - TAPE DENSITY PARAMETER HAS BEEN CHECKED AND IF
*                 NECESSARY RHH HAS BEEN CALLED 
  
 TPDN     SUBR
          BX6    X6-X6       ENTRY FOR LABEL CONTROL CARD 
          SA6    DFTLB       SET DEFAULT LABEL FLAG 
          EQ     TPRQ1
  
 TPRQ     SUBR               ENTRY FOR REQUEST CONTROL CARD 
          SX6    1
          SA6    DFTLB       SET NOT LABEL
          SA5    TPRQ 
          BX6    X5 
          SA6    TPDN        USE COMMON EXIT
  
 TPRQ1    BSS    0
          SA2    RA.ACT      GET NUMBER OF PARAMETERS 
          SA4    RA.ARG+2    SKIP PAST LFN PARAMETER
          SB2    X2-1        DECREMENT PARAMETER COUNT
          SB1    1
          ZR     B2,TPDN7    NO PARAMETERS
  
 TPDN1    SA3    TPDNA       * M= * 
          SA5    DFTLB       LABEL STATEMENT FLAG 
          BX3    X3-X4       (X3) = 0 IF PARAMETER IS * M= *
          BX3    X3+X5       (X3) = 0 IF LABEL AND * M= * 
          ZR     X3,TPDN7    IF MULTI-FILE LABEL
          MX6    1           POSITION MASK FOR FIRST PARAMETER
          AX4    18          SHIFT OFF LOWER 18 BITS
          SA3    MT 
          SA5    HI 
          AX3    18 
          IX3    X4-X3
          ZR     X3,TPDN2    MT PARAMETER 
          SA3    HY 
          AX5    18 
          IX5    X4-X5
          ZR     X5,TPDN2    HI PARAMETER 
          SA5    NT 
          AX3    18 
          IX3    X4-X3
          ZR     X3,TPDN2    HY PARAMETER 
          SA3    HD 
          LX6    60-1        POSITION MASK FOR NEXT PARAMETER 
          AX5    18 
          IX5    X4-X5
          ZR     X5,TPDN2    NT PARAMETER 
          SA5    PE 
          LX6    60-1        POSITION MASK FOR NEXT PARAMETER 
          AX3    18 
          IX3    X4-X3
          ZR     X3,TPDN2    HD PARAMETER 
          SA3    GE 
          LX6    60-1        POSITION MASK FOR NEXT PARAMETER 
          AX5    18 
          IX5    X4-X5
          ZR     X5,TPDN2    PE PARAMETER 
          LX6    60-1        POSITION MASK FOR NEXT PARAMETER 
          AX3    18 
          IX3    X4-X3
          ZR     X3,TPDN2    GE PARAMETER 
          SA4    A4+1        GET NEXT PARAMETER 
          SB2    B2-B1       DECREMENT PARAMETER COUNT
          ZR     B2,TPDN3    NO MORE PARAMETERS 
          EQ     TPDN1       CHECK NEXT PARANETER 
  
 TPDN2    BSS    0
          SA5    RHHPL       READ PARAMETER LIST
          BX6    X5+X6       ADD THIS MASK BIT
          SA6    RHHPL       SAVE MASK IN RHH PARAMETER LIST
          SA4    A4+B1       GET NEXT PARAMETER 
          SB2    B2-B1       DECREMENT PARAMETER COUNT
          ZR     B2,TPDN3    NO MORE PARAMETERS 
          EQ     TPDN1
  
 TPDN3    SA4    RHHPL       READ PARMETER LIST 
          CX4    X4          COUNT NUMBER OF BITS SET 
          SX4    X4-1 
          ZR     X4,TPDN4    ONLY ONE BIT SET 
          MI     X4,TPDN5    NO BITS SET USE DEFAULT IF LABEL 
          SA4    RHHPL
          MX6    1           X MASK 
          LX6    60-1        0X MASK
          BX6    X4*X6       CHECK FOR NT PARAMETER 
          ZR     X6,TPDN6    NO NT PARAMETER AND MORE THAN
                             ONE BIT SET BAD CONTROL CARD 
          MX6    3           XXX MASK 
          LX6    60-2        00XXX MASK 
          BX6    X4*X6       GET DENSITY BIT
          SA6    RHHPL       BOTH NT AND DENSITY CLEAR NT 
  
 TPDN4    BSS    0
          SYSTEM  RHH,R,RHHPL,6*100B
          MX0    -12
          SA4    RHHPL       REPLY WORD 
          LX4    24          SHIFT TO ERROR BITS
          BX3    -X0*X4      MASK OUT ERROR BITS
          ZR     X3,TPDN7    IF NO ERROR
          SX6    TAED        *FTFS TAPE ASIGNMENT ERROR*
          RJ     RNE
          EQ     TPDN8
  
 TPDN5    SA5    DFTLB
          NZ     X5,TPDN7    EXIT - IF LABEL FLAG IS NOT ZERO 
          MX6    1           MASK BIT FOR MT
          SA6    RHHPL       SET DEFAULT MT FOR LABEL 
          EQ     TPDN4
  
 TPDN6    SX6    RLVD        *FTFS - BAD LABEL - REQUEST* 
          RJ     RNE         SET REPLY NEGATIVE 
          EQ     TPDN8       EXIT 
  
 TPDN7    MX6    0           SET NO ERROR 
          BX1    X1-X1       SET NO MESSAGE 
  
 TPDN8    EQ     TPDNX
  
 RHHPL    BSSZ   1           RHH PARAMETER LIST 
 DFTLB    BSSZ   1           DEFAULT LABEL FLAG (ZERO IF LABEL) 
          SPACE  4,10 
 MT       DATA   2LMT 
 NT       DATA   2LNT 
 HI       DATA   2LHI 
 HY       DATA   2LHY 
 HD       DATA   2LHD 
 PE       DATA   2LPE 
 GE       DATA   2LGE 
 TPDNA    VFD    42/0LM,18/1R=
          SPACE  4,10 
**        VCCT - TABLE OF VALID CONTROL CARDS.
* 
**T       42/ CSTMT,18/ ADDR+1
* 
*         CSTMT  - CONTROL STATEMENT NAME RIGHT JUSTIFIED.
*         ADDR   - ADDRESS OF STATEMENT PROCESSOR.
  
  
 VCCT     CSTMT  ACCOUNT,ACT
          CSTMT  ATTACH,ATT 
          CSTMT  CATALOG,CAT
          CSTMT  COMMENT,EXI
          CSTMT  DSMOUNT,EXI
          CSTMT  LABEL,TPDN 
          CSTMT  MFDUMP,MFD 
          CSTMT  MFGIVE,MFG 
          CSTMT  MFLOAD,MFL 
          CSTMT  MFTAKE,MFT 
          CSTMT  MOUNT,EXI
          CSTMT  PAUSE,EXI
          CSTMT  PURGE,EXI
          CSTMT  RENAME,EXI 
          CSTMT  REQUEST,TPRQ 
          CSTMT  RETURN,EXI 
          CSTMT  SETNAME,EXI
          CSTMT  UNLOAD,EXI 
          CSTMT  VSN,EXI
          BSSZ   1
          TITLE  INTERNAL CONTROL CARD PROCESSORS.
**        INTERNAL CONTROL CARD PROCESSORS. 
* 
*         THE FOLLOWING ROUTINES DO THE INTERNAL PROCESSING OF
*         CONTROL CARDS FOR FTFS. 
* 
*         ENTRY - (RA.ARG) = THE CONTROL CARD IN AN UNPACKED FORMAT.
* 
*         EXIT   (X1) IS AN ERROR MESSAGE ADDRESS IF NON-ZERO (THE
*                MESSAGE WILL BE ISSUED TO THE DAYFILE WITH AN ABORT).
ABO       SPACE  4,10 
**        ABO - FTFS ABORTED WHILE EXECUTING USER TEXT. 
* 
*         IF RFT RECEIVED AND PROCESSING CONTROL CARDS
*         THEN
*           CHANGE FILE TRANSFER STATE. 
*           SEND RNEG.
*           SET STATE = RNEG SENT WAIT FOR REPY.
*         ELSE
*           IF TRANSFER COMPLETE AND PROCESSING CONTROL CARDS 
*           THEN
*             SET STATE = USER TEXT PROCESSING COMPLETE.
*           ELSE
*             ISSUE ERROR MESSAGE AND ABORT.
* 
*         ENTRY - (JCI - JCI+1) = JOB STATE INFORMATION.
* 
*         EXIT  - CURRENT STATE UPDATED.
*                 (X1) = 0, NORMAL RETURN.
  
  
 ABO      SUBR
          RETURN ZZZZZDF,R   RETURN OLD COPY OF DAYFILE FNT (IF ANY)
          BX6    X6-X6
          SA6    RW          CLEAR COMPLETE BIT 
          SYSTEM RHH,R,RW,4*100B   CREATE NEW FNT OF DAYFILE
          SA1    JCI+1
          SX2    X1-RFTRPCC 
          ZR     X2,ABO2     IF PROCESSING CONTROL CARDS AFTER RFT
          SX3    X1-XFRCPCC 
          ZR     X3,ABO3     IF PROCESSING CONTROL CARDS AFTER XFR
          SA1    IFSM        INVALID FTFS STATE 
 ABO1     RJ     ABT         ISSUE MESSAGE AND ABORT
  
 ABO2     RJ     NTN         NETON TO RHF 
          SA1    RSTS 
          BX6    X1 
          SA6    TSTA        STATUS = REJECTED, SEE TEXT
          RJ     SNR         SEND RNEG
          MX1    0
          EQ     ABOX 
  
 ABO3     RJ     NTN         NETON TO RHF 
          SA1    TSTS 
          BX6    X1 
          SA6    TSTA        STATUS = TERMINATE ABNORMALLY, SEE TEXT
          SX1    UTXTPRC
          RJ     UDS         STATE = USER TEXT PROCESSING COMPLETE
          MX1    0
          EQ     ABOX 
DON       SPACE  4,10 
**        DON - FTFS USER TEXT PROCESSING COMPLETE. 
* 
*         IF PROCESSING CONTROL CARDS AFTER RFT 
*         THEN
*           SET STATUS = TO ACCEPTABLE AND SATISFACTORY.
*           PLACE DAYFILE MESSAGES IN RPOS. 
*           SEND RPOS.
*           SET STATE = RPOS SENT, WAIT FOR REPLY.
*         ELSE
*           IF PROCESSING CONTROL CARDS AFTER XFR 
*           THEN
*             SET STATE = TO USER TEXT PROCESSING COMPLETE. 
*           ELSE
*             ISSUE ERROR MESSAGE AND ABORT.
* 
*         ENTRY - (JCI - JCI+1) = CURRENT JOB STATUS. 
* 
*         EXIT  - CURRENT STATE UPDATED.
*                 (X1) = 0, NORMAL RETURN.
  
  
 DON      SUBR
          MX6    0
          SA6    TSTA 
          SA1    SPRB 
          BX6    X1 
          SA6    SPRA        MAKE SURE ACCOUNT NOT SENT AGAIN 
          SA1    JCI+1
          SX2    X1-RFTRPCC 
          ZR     X2,DON2     IF PROCESSING CC AFTER RFT 
          SX3    X1-XFRCPCC 
          ZR     X3,DON3     IF PROCESSING CC AFTER XFR 
          SA1    IFSM        INVALID FTFS STATE 
 DON1     RJ     ABT         ISSUE MESSAGE AND ABORT
  
 DON2     BSS    0
          RJ     SDM         SEND DAYFILE MESSAGES
          SB1    1
          SA1    HMAP 
          RJ     =XSML       SEND RPOS
          NZ     X1,DON1     IF FATAL ERROR 
          SX1    RPOSSWR
          RJ     UDS         STATE = RPOS SENT, WAIT FOR REPLY
          MX1    0
          EQ     DONX 
  
 DON3     BSS    0
          SX1    UTXTPRC
          RJ     UDS         STATE = USER TEXT PROCESSING COMPLETE
          MX1    0
          EQ     DONX 
MGV       SPACE  4,10 
**        MGV - PROCESS MFGIVE CONTROL CARD.
* 
*         SET TRANSFER DIRECTION. 
*         SET DATA DECLARATION. 
*         CHECK FILE ATTRIBUTES.
*         IF NO ERRORS
*         THEN
*           SEND RPOS.
*           SET STATE = RPOS SENT WAIT FOR REPLY. 
* 
*         ENTRY - (JCI - JCI+1) = CURRENT JOB STATE.
* 
*         EXIT  - CURRENT JOB STATE UPDATED.
*                 (X1) = NORMAL RETURN. 
  
  
 MGV      SUBR
          SB1    1
          SX7    SEND 
          SA7    XMIT        SET TRANSFER DIRECTION 
          SA1    GIVE 
          BX7    X1 
          SA7    ACCESS      SET MODE OF ACCESS 
          SA1    DDTYPE 
          BX6    X1 
          SA6    DDXFR       SET DATA DECLARATION FOR XFR 
          RJ     CFA         CHECK FILE ATTRIBUTES
          NZ     X1,MGV1     IF TRANSFER NOT POSSIBLE 
          RJL    =XSNP,HMAP,(SMB,/AP/SIZE,SELECT,/AP/SIZEL,FSIZE) 
          NZ     X1,MGV2     IF FATAL ERROR 
          RJ     SDM         SEND DAYFILE MESSAGES
          SA1    HMAP 
          RJ     =XSML       SEND RPOS
          NZ     X1,MGV2     IF FATAL ERROR 
          SX1    RPOSSWR
          RJ     UDS         STATE = RPOS SENT, WAIT FOR REPLY
          MX1    0
          EQ     MGVX 
  
 MGV1     RJ     SNR         SEND NEGATIVE REPLY
          MX1    0
          EQ     MGVX 
  
 MGV2     RJ     ABT         ISSUE MESSAGE AND ABORT
MTK       SPACE  4,10 
**        MTK - MFTAKE CONTROL CARD PROCESSOR.
* 
*         SET FILE DIRECTION. 
*         SET FILE DATA DECLARATION.
*         CHECK FILE ATTRIBUTES.
*         IF NO ERRORS
*         THEN
*           SEND RPOS.
*           IF FILE IS NOT DEFINED
*           THEN
*             REQUEST FILE ON PF DEVICE.
*           SET STATE = RPOS SENT WAIT FOR REPLY. 
* 
*         ENTRY - (JCI - JCI+1) = CURRENT JOB STATE.
*                 (ZZZZZRP) = LOCAL FILE CONTAINING RPOS. 
* 
*         EXIT  - CURRENT STATE UPDATED.
*                 (X1) = 0, NORMAL RETURN.
  
  
 MTK      SUBR
          SB1    1
          SX7    RECEIVE
          SA7    XMIT        SET TRANSFER DIRECTION 
          SA1    TAKE 
          BX7    X1 
          SA7    ACCESS      SET MODE OF ACCESS 
          SA1    DDTYPE 
          BX6    X1 
          SA6    DDXFR       SET DATA DECLARATION 
          RJ     CFA         CHECK FILE ATTRIBUTES
          NZ     X1,MTK1     IF FATAL ERROR 
          RJ     SDM         SEND DAYFILE MESSAGES
          SA1    HMAP 
          RJ     =XSML       SEND RPOS
          NZ     X1,MTK2     IF FATAL ERROR 
          SA1    F
          MX0    -18
          BX7    X1*X0       CLEAR COMPLETE BIT 
          SA7    MTKA 
          REQUEST MTKA       ATTEMP REQUEST ON PF DEVICE
  
*         IGNORE ERRORS, FILE MAY ALREADY BE DEFINED. 
  
          SX1    RPOSSWR
          RJ     UDS         STATE = RPOS SENT, WAIT FOR REPLY
          MX1    0
          EQ     MTKX 
  
 MTK1     RJ     SNR         SEND NEGATIVE REPLY
          MX1    0
          EQ     MTKX 
  
 MTK2     RJ     ABT         ISSUE MESSAGE AND ABORT
  
 MTKA     BSSZ   1           REQUEST CALL BUFFER
          CON    1S31+1S20   PF DEVICE AND REAL TIME RESPONSE 
          SPACE  4,10 
**        ICCT - INTERNAL CONTROL CARDS PROCESSER TABLE.
* 
**T       42/ CSTMT,18/ ADDR+1
* 
*         CSTMT  - CONTROL STATEMENT NAME RIGHT JUSTIFIED.
*         ADDR   - ADDRESS OF STATEMENT PROCESSOR.
  
  
 ICCT     CSTMT  ABORT,ABO
          CSTMT  DONE,DON 
          CSTMT  MFGIVE,MGV 
          CSTMT  MFTAKE,MTK 
          BSSZ   1
CFA       SPACE  4,10 
**        CFA - CHECK FILE ATTRIBUTES.
* 
*         GET LFN.
*         IF INVALID LFN
*         THEN
*           ISSUE MESSAGE AND ABORT.
*         ELSE
*           GET FILE LENGTH.
*           IF FILE IS ON A MASS STORAGE DEVICE 
*           THEN
*             SAVE LFN TO RETURN FILE.
*           CHECK FILE PERMISSIONS. 
* 
*         ENTRY - (RA.ARG) = LOCAL FILE NAME. 
* 
*         EXIT  - (X1) = 0, FILE VALID FOR TRANSFER.
*                      " 0, RNEG SHOULD BE SENT.
  
  
 CFA      SUBR
          SA1    RA.ARG+1 
          MX0    42 
          BX2    X1*X0
          ZR     X2,CFA1     IF NO LFN SPECIFIED. 
          SA4    F
          BX6    -X0*X4 
          BX6    X6+X2
          SA6    A4          ACTUAL LFN NOW IN LOCATION F 
          RJL    =XGFL,F,(DDXFR)    GET FILE LENGTH 
          SA6    FSIZE       SAVE FILE LENGTH 
          BX4    X5          SAVE (X5) FOR CFP
          LX4    59-19
          MI     X4,CFA0     IF FILE IS ON A 9-TRACK TAPE 
          LX4    59-18-59+19
          MI     X4,CFA0     IF FILE IS ON A 7-TRACK TAPE 
          SA1    F
          BX6    X1 
          SA6    RETLFN      SAVE LFN OF FILE TO RETURN 
 CFA0     BSS    0
          RJ     CFP         CHECK FILE PERMISSIONS 
          BX1    X6          PLACE REPLY CODE IN X1 
          EQ     CFAX 
  
 CFA1     SX1    ICCM 
          RJ     ABT         ISSUE ERROR MESSAGE AND ABORT
  
 FSIZE    BSSZ   1           FILE SIZE
CFP       SPACE  4,10 
**        CFP    CHECK FILE PERMISSIONS 
* 
*         IF SENDING THE FILE 
*         THEN
*           IF FILE EXISTS WITHOUT READ PERMISSION
*           THEN
*             ISSUE ERROR MESSAGE.
*             RETURN FILE.
*         ELSE
*           IF FILE EXISTS WITHOUT WRITE PERMISSION 
*           THEN
*             ISSUE ERROR MESSAGE.
*             RETURN FILE.
*         RETURN. 
* 
*         ENTRY - (X5) = FILINFO STATUS WORD. 
*                 (X7) = GFL RETURN CODE. 
* 
*         EXIT  - (X6) = 0, IF FILE TO BE USED IS VALID.
  
  
 CFP      SUBR
          SA1    ACCESS 
          SA2    GIVE 
          BX2    X1-X2
          NZ     X2,CFP1     IF NOT MFGIVE
          SX1    CRFF        * CANNOT READ FROM FILE *
          MI     X7,CFP2     IF NOT CORRECT FILE TYPE 
          MX0    12 
          BX2    X5*X0
          ZR     X2,CFP2     IF FILE DOES NOT EXIST 
          LX5    59-6 
          PL     X5,CFP2     IF NO READ PERMISSION
          BX6    X6-X6       FILE IS VALID
          EQ     CFPX 
  
 CFP1     MX6    0           SET RETURN TO FILE VALID 
          SX1    CWOF        * CANNOT WRITE ON FILE * 
          MI     X7,CFP5     IF INCORRECT FILE TYPE 
          MX0    12 
          BX2    X0*X5
          ZR     X2,CFPX     IF FILE DOES NOT EXIST 
          LX5    59-7 
          MI     X5,CFPX     IF FILE HAS WRITE PERM 
  
 CFP2     SB5    54 
          MX0    6
          BX7    X7-X7
          SA2    F
  
 CFP3     BX3    X2*X0       GET NEXT LFN CHAR
          ZR     X3,CFP4     IF NO MORE CHARS 
          BX7    X7+X3       MERGE LFN INTO MESSAGE 
          LX0    54 
          SB5    B5-6 
          EQ     CFP3 
  
 CFP4     SX3    1R.
          LX3    X3,B5
          BX7    X7+X3       MERGE PERIOD AT END OF MESSAGE 
          SA7    X1+3 
          MESSAGE X1,3,R
  
 CFP5     SX6    RNAS 
          SA6    TSTA        FILE NOT ACCESSABLE
          MX6    1           INVALID FILE TYPE SEND RNEG
          EQ     CFPX 
          SPACE  4,10 
  
  
          USE    *
          SPACE  4
 NBEONLY  ENDIF 
  
          END 
