Retro1.org codex

          IDENT  SUBMIT,FETS 
          ABS
          ENTRY  SUBMIT
          ENTRY  RFL=
          ENTRY  SSJ=
          SYSCOM B1
          SST
*COMMENT  SUBMIT - ENTER JOB IN INPUT QUEUE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  SUBMIT - ENTER JOB IN INPUT QUEUE.
          SPACE  4,10
***       SUBMIT - ENTER JOB IN INPUT QUEUE.
*         G. R. MANSFIELD.  70/10/29.
          SPACE  4,10
***              SUBMIT PLACES THE REQUESTED FILE IN THE REQUESTED
*         INPUT QUEUE.
          SPACE  4,25
***       CALL.
*
*         SUBMIT (LFN,Q)C
*         OR
*         SUBMIT (LFN,Q,NR)C
*
*         LFN    SOURCE FILE NAME.
*         Q      INPUT QUEUE TYPE.
*                B OR BC = BATCH.
*                N OR NO = BATCH, WITH OUTPUT NOT TO BE PRINTED.
*                E=UN OR RB=UN = REMOTE BATCH, WITH OUTPUT TO BE SENT
*                  TO THE SPECIFIED USER NAME.  IF OMITTED, *UN*
*                  DEFAULTS TO THE USER NAME ASSOCIATED WITH THE
*                  SUBMITTING JOB.
*                TO = BATCH, WITH OUTPUT TO BE SENT TO THE WAIT QUEUE.
*         NR     IF SPECIFIED, NO FILES ARE REWOUND UNLESS
*                EXPLICITLY DONE WITH /REWIND DIRECTIVES.
*         C      ESCAPE CHARACTER FOR REFORMAT.
*
*         ASSUMED -
*         Q=B OR BC, IF SUBMITTED FROM NON-*IAOT* JOB.
*         Q=N OR NO, IF SUBMITTED FROM *IAOT* JOB.
*         LFN=NO DEFAULT (HOWEVER, *IAF* WILL EDIT THE COMMAND TO
*                INSERT THE PRIMARY FILE NAME IF *SUBMIT.* IS ENTERED
*                IN RESPONSE TO A COMMAND LINE PROMPT).
*         C=/
          SPACE  4,35
***       DAYFILE MESSAGES.
*
*         * CONFLICTING PARAMETERS.* = INPUT QUEUE TYPE SPECIFIED MORE
*         THAN ONCE.
*
*         * INCORRECT QUEUE SPECIFIED.* = QUEUE TYPE SPECIFIED NOT A
*         CORRECT TYPE FOR *SUBMIT*.
*
*         * NO READ FILE FOUND- LFN .* = LFN ON /READ DIRECTIVE COULD
*         NOT BE FOUND.
*
*         * NO SOURCE FILE SPECIFIED.* = NO SOURCE FILE NAME GIVEN.
*
*         * READ FILE BUSY- LFN .* = LFN ON /READ DIRECTIVE WAS BUSY.
*
*         * SUBMIT COMPLETE.  JSN IS XXXX.* = THE JOB WAS
*         SUBMITTED WITH THE JSN XXXX.
*
*         * SUBMIT FILE EMPTY.* = EOR/EOF FOUND ON FIRST READ OF SUBMIT
*         FILE.
*
*         * TOO MANY ARGUMENTS.* = TOO MANY ARGUMENTS WERE PRESENT ON
*         THE COMMAND.
*
*         * USER COMMAND HAS NOT BEEN EXECUTED.* = A */USER* DIRECTIVE
*         HAS BEEN SPECIFIED, BUT THE CALLING JOB HAS NEVER EXECUTED
*         A *USER* COMMAND.
*
*         * USER DIRECTIVE INCORRECT.* = A */USER* DIRECTIVE COULD
*         NOT BE PROCESSED, EITHER BECAUSE THE CALLING JOB HAS NEVER
*         ISSUED A *USER* COMMAND, OR BECAUSE THE DIRECTIVE DID NOT
*         FOLLOW BOTH A *JOB* DIRECTIVE AND A *JOB* COMMAND.
          SPACE  4,10
*CALL     COMCCMD
*CALL     COMCMAC
*CALL     COMSDSP
*CALL     COMSIOQ
*CALL     COMSMLS
*CALL     COMSPFM
*CALL     COMSSFM
*CALL     COMSSSD
          SPACE  4,10
****      ASSEMBLY CONSTANTS.
 
 
 BUFL     EQU    320D        WORKING BUFFER
 IBUFL    EQU    2001B       INPUT FILE BUFFER
 FBUFL    EQU    2001B
 RBUFL    EQU    2001B       READ FILE BUFFER
 SBUFL    EQU    100B        *SFM* BUFFER LENGTH
 TBUFL    EQU    BUFL/10+1   NO LINE TERMINATOR DATA BUFFER LENGTH
 WBUFL    EQU    1
****
          TITLE  COMMON DATA.
 DATA     SPACE  4,10
**        COMMON DATA.
 
 
          ORG    110B
 FETS     BSS    0
 
 I        BSS    0
 INPUT    FILEB  IBUF,IBUFL,(FET=8)
 
 F        BSS    0
 SCR      FILEB  FBUF,FBUFL,(FET=8)
 
 R        BSS    0
 TAPE1    FILEB  RBUF,RBUFL,(FET=8)
 
 RR       BSS    0
 PFMFIL   FILEB  RBUF,RBUFL,EPR,(FET=13B)
 
 W        BSS    0
 SCR2     FILEB  WBUF,WBUFL
 
 
 ALVL     CON    0           FILE ACCESS LEVEL
 EORBIT   CON    0           BIT59=EOR BIT, BIT47=/READ ACTIVE BIT
 FLAGS    CON    0           BIT59=NOSEQ, BIT47=TRANS, BIT35=NOPACK
 NRFLG    DATA   2RNR        NO REWIND FLAG
 IPTR     CON    0           INPUT FET *IN* POINTER
 IPTR2    CON    0           READ FILE FET *IN* POINTER
 LCNT     CON    1           LINE COUNTER
 OPTR     CON    0           INPUT FET OUT POINTER
 OPTR2    CON    0           READ FILE FET OUT POINTER
 RJ       CON    0           RETURN JUMP ADDRESS
 RJ2      CON    0           READ FILE ORIGINAL RETURN JUMP ADDRESS
 USRF     CON    0           A */USER* DIRECTIVE HAS BEEN PROCESSED
 TFUN     SPACE  4,10
**        TFUN - FAMILY NAME AND USER NAME TABLE FOR *DSP*.
*
*T W0     42/ FAMILY NAME,18/0
*T,W1     42/ USER NAME,18/0
 
 
 TFUN     BSSZ   2
 TDSP     SPACE  4,10
*         TDSP - *DSP* PARAMETER BLOCK.
 
 
 TDSP     VFD    42/0LSCR,18/0
          VFD    24/0,12/0LIN,6/0,18/FRFN+FREB+FRDC+FRCS
          BSSZ   DPBL-*+TDSP
          VFD    42/0,18/EFNV
          BSSZ   EPBL-*+TDSP
          TITLE  MAIN PROGRAM.
 SUBMIT   SPACE  4,100
**        SUBMIT - MAIN PROGRAM
*
*                THE ESCAPE CODE (*C* PARAMETER) IS A UNIQUE CHARACTER
*                THAT ENABLES THE SUBMIT PROCESSOR TO RECOGNIZE SPECIAL
*                DIRECTIVES THAT AFFECT THE FINAL FORMAT OF THE
*                SUBMIT FILE.  DEFAULT CHARACTER IS /.
*
*         FUNCTIONS
*
*         1.     READS FIRST UNIT RECORD AND CHECKS FOR *C*JOB
*                A.          IF THE FIRST DIRECTIVE IS NOT *C*JOB THE
*                            INPUT FILE IS COPIED AS IS TO BECOME THE
*                            ACTUAL SUBMIT FILE.
*
*                B.          IF THE FIRST DIRECTIVE IS *C*JOB THE INPUT
*                            FILE WILL BE REFORMATTED TO BECOME THE
*                            SUBMIT FILE.
*                  NOTE      REFORMATTING IS ACCOMPLISHED BY PLACING
*                            SUBMIT DIRECTIVES IN THE INPUT FILE.
*         2.     SETS QUEUE FOR EVENTUAL DISPOSAL OF OUTPUT
*         3.     SUBMIT FILE IS PASSED TO THE SYSTEM *ROUTE* MACRO
*         4.     MESSAGE IS ISSUED TO DAYFILE/INTERACTIVE TERMINAL
*
*
*         HOW DIRECTIVES INFLUENCE THE SUBMIT FILE.
*
*         1. MODES           EDITING IS DONE UNDER TWO MODES
*             A. NON-TRANSPARENT       EACH LINE OF THE INPUT FILE IS
*                                      EXAMINED FOR DIRECTIVES. DEFAULT
*                                      MODE WITH *C*JOB DIRECTIVE.
*         DIRECTIVE FORMAT  *C*NOTRANS
*
*             B. TRANSPARENT           ONLY GROUPS OF DIRECTIVES AT
*                                      THE BEGINNING OF EACH RECORD MAY
*                                      BE EXAMINED.
*         DIRECTIVE FORMAT  *C*TRANS
*
*         2. OPTIONS         EACH DIRECTIVE ENABLES THE USER TO
*                            DICTATE SOME ASPECT OF THE FINAL FORMAT OF
*                            THE SUBMIT FILE.
*
*         DIRECTIVE FORMAT   *C*CHARGE
*                            REPLACES THE DIRECTIVE WITH A *CHARGE*
*                            COMMAND USING THE CURRENTLY ACTIVE
*                            CHARGE AND PROJECT NUMBER IF THE CHARGE
*                            AND PROJECT NUMBERS HAVE BEEN VALIDATED.
*                            IF NO CHARGE NUMBER IS IN EFFECT OR IF
*                            THE CURRENT CHARGE AND PROJECT NUMBERS
*                            HAVE NOT BEEN VALIDATED NO ACTION IS
*                            TAKEN.
*
*         DIRECTIVE FORMAT  *C*EOR
*                            END OF RECORD IS WRITTEN ON SUBMIT FILE
*
*         DIRECTIVE FORMAT  *C*EOF
*                            END OF FILE IS WRITTEN ON SUBMIT FILE
*
*         DIRECTIVE FORMAT  *C*EC=A
*                            CHANGES ESCAPE CHARACTER FROM *C* TO A.
*
*         DIRECTIVE FORMAT  *C*NOSEQ
*                            WILL AFFECT FORMAT ONLY UNDER NON-TRANS-
*                            PARENT MODE.  NO ATTEMPT WILL BE MADE TO
*                            STRIP LINE NUMBERS FROM INPUT FILE LINES.
*
*         DIRECTIVE FORMAT  *C*SEQ
*                            WILL AFFECT FORMAT ONLY UNDER NON-TRANS-
*                            PARENT MODE.  LINE NUMBERS WILL BE
*                            STRIPPED OFF INPUT FILE LINES.  DEFAULT
*                            WITH *C*JOB DIRECTIVE.
*
*         DIRECTIVE FORMAT  *C*REWIND,FILENAME
*                            REWINDS ONE OF USER S LOCAL FILES
*
*         DIRECTIVE FORMAT  *C*READ,FILENAME
*                            COPIES USER,S LOCAL FILE TO SUBMIT FILE.
*                            EDITING IS DONE ON THE FILE AS THOUGH IT
*                            WERE SOURCE CODE OF THE INPUT FILE.
*
*         DIRECTIVE FORMAT  *C*PACK
*                            DEFAULT WHEN *C*JOB DIRECTIVE IS DETECTED.
*                            ALL EOR MARKS ARE REMOVED FROM A FILE.
*                            ALL EOF MARKS REMOVED FROM A MULTI-FILE
*                            FILE. AN EOF MARK WILL BE WRITTEN TO THE
*                            SUBMIT FILE ONLY WHEN EOI IS ENCOUNTERED
*                            IN THE INPUT FILE. EDITING STOPS AT THAT
*                            POINT.
*
*         DIRECTIVE FORMAT  *C*NOPACK
*                            INTERNAL FILE STRUCTURES ARE PRESERVED
*                            INTACT.  EACH INTERNAL EOR OR EOF MARK IS
*                            COPIED TO THE SUBMIT FILE.  FILES COPIED
*                            WITH *C*READ HAVE EOF AND EOI MARKS
*                            CONVERTED TO EOR MARKS.  WHEN EOI IS
*                            ENCOUNTERED ON THE INPUT FILE AN EOF IS
*                            WRITTEN TO THE SUBMIT FILE AND EDITING
*                            STOPS.
*
*         DIRECTIVE FORMAT  *C*USER
*                            READS *VALIDUS* FILE FOR THE PASSWORD OF
*                            THE USER NAME CURRENTLY IN EFFECT AND
*                            REPLACES THE DIRECTIVE WITH A *USER*
*                            DIRECTIVE USING THE CURRENT USER NAME
*                            AND PASSWORD.
 
 
 SUBMIT   BSS    0           ENTRY
          SB1    1
          MX6    0           SET NO READ FILE YET
          SA6    RR
          RJ     PRS
          RETURN F,R
          SA2    NRFLG
          ZR     X2,SBM0     IF NO REWIND
          REWIND I
 SBM0     READ   I
          READS  I,BUF,BUFL  READ FIRST LINE
          SX0    =C* SUBMIT FILE EMPTY.*
          NZ     X1,ABT      IF EOR/EOF
          SA1    BUF         SKIP SEQUENCE NUMBERS
          RJ     SSN
          RJ     CSF         CHECK SPECIAL FORMAT
          SA1    F+1         ASSIGN FILE TO INPUT DEVICE
          MX0    -48
          BX6    -X0*X1
          SX1    2RIN
          MX0    1           FILE ACCESS LEVEL BIT
          LX0    39-59
          LX1    59-11
          BX7    X6+X1
          BX7    X0+X7       MERGE ACCESS LEVEL BIT
          SA7    A1
          SA1    F+CFAL      GET ACCESS LEVEL FIELD
          MX0    -3
          LX0    36
          SA2    ALVL
          BX1    X0*X1       CLEAR OLD ACCESS LEVEL
          LX2    36
          BX6    X1+X2       MERGE NEW ACCESS LEVEL
          SA6    A1
          REQUEST  F,U,N     REQUEST EQUIPMENT WITH NO DAYFILE MESSAGE
          SX6    B2-JOB
          NZ     X6,SBM1     IF NOT JOB IDENTIFIER
          RJ     RFM         REFORMAT
          EQ     SBM2
 
 SBM1     RJ     CPF         COPY FILE
 SBM2     RECALL F
          SA1    USRF
          NZ     X1,SBM3     IF */USER* SPECIFIED
          SX6    B0+
          SA6    TDSP+7      CLEAR *NO VALIDATE* BIT
 SBM3     ROUTE  TDSP,RECALL
          CLOCK  SBMA        BUILD OUTPUT MESSAGE FOR TERMINAL
          SA1    TDSP
          SA2    =0LOUTPUT
          MX3    24
          BX6    X3*X1
          SA1    SBMB+2
          LX3    24
          BX1    -X3*X1
          LX6    24
          BX6    X1+X6
          SA6    SBMB+2
          SX3    B1
          BX6    X2+X3
          SA6    F
          WRITEW F,SBMA,5
          MESSAGE  SBMB,3,R  SEND JSN MESSAGE
          MX0    -6
          SA1    FWPR
          AX1    24
          BX3    -X0*X1
          SX6    X3-IAOT
          NZ     X6,SBM5     IF NOT INTERACTIVE JOB
          MESSAGE NOFIL+2,1  CLEAR CONTROL POINT MESSAGE
          WRITER F
 SBM5     ENDRUN
 
 
 SBMA     BSS    1
 SBMB     DATA   C* SUBMIT COMPLETE.  JSN IS XXXX.*
          TITLE  SUBROUTINES.
 ABT      SPACE  4,10
**        ABT - ABORT JOB.
*
*         ENTRY  (X0) = MESSAGE ADDRESS.
 
 
 ABT      BSS    0
          MESSAGE X0,,R
          ABORT
 CPF      SPACE  4,10
**        CPF -  COPY INPUT FILE TO SUBMIT FILE.
*
*         USES   X - 0, 1, 5.
*                B - 1, 6.
 
 
 CPF      SUBR               ENTRY/EXIT
          WRITES F,BUF,BUFL
          EQ     CPF2
 
 CPF1     READ   I
          RECALL F
 CPF2     READW  I,BUF,BUFL
          SX0    X1
          SX5    B6-BUF
          WRITEW F,BUF,X5
          NG     X0,CPF4     IF EOF/EOI
          NZ     X0,CPF3     IF EOR
          EQ     CPF2
 
 CPF3     WRITER F
          NG     X0,CPFX     IF EOI
          EQ     CPF1
 
 CPF4     SX0    X0+B1
          NG     X0,CPF5     IF EOI
          WRITEF F
          EQ     CPF1
 
 CPF5     NZ     X5,CPF3     IF DATA IN BUFFER
          EQ     CPFX        RETURN
 CSF      SPACE  4,15
**        CSF - CHECK SPECIAL FORMAT.
*
*         ENTRY  (A1) = ADDRESS OF FIRST CHARACTER.
*                (X1) = FIRST CHARACTER.
*
*         EXIT   (B2) = 0 IF NOT SPECIAL FORMAT.
*                     = ADDRESS OF PROCESSOR OTHERWISE.
*
*         USES   X - 2, 3, 4, 5, 6, 7.
*                B - 2, 5, 7.
*                A - 2, 3, 5.
 
 
 CSF7     BX7    X3-X6
          BX4    X2*X7
          MX2    48D
          BX7    -X2*X7
          SA3    A3+1
          SA5    A5+1
          ZR     X4,CSF4     IF MATCH FOUND
          NZ     X3,CSF1     IF NOT END OF TABLE
 
 
 CSF      SUBR               ENTRY/EXIT
          SA5    TCCFL
          SA3    TCCF
 CSF1     BX6    X6-X6       CLEAR ASSEMBLY
          SA2    A1          FIRST CHARACTER
          MX4    48D
          BX4    -X4*X5
          SB7    X4          SAVE SHIFT COUNT PER CC FORMAT
          SB2    B0          CLEAR RESPONSE
 CSF2     LX6    6           ADVANCE ASSEMBLY
          BX6    X6+X2
          LX5    1           SHIFT CHARACTER COUNT
          SA2    A2+B1       NEXT CHARACTER
          NG     X5,CSF2     LOOP FOR X5 CHARACTERS
          SB5    A3-TCCFR
          PL     B5,CSF3     IF /EC=,/READ,/REWIND
          SX2    X2-1R
          ZR     X2,CSF3     IF BLANK
          SA3    A3+1
          SA5    A5+1
          ZR     X3,CSFX     IF END OF LINE
          EQ     CSF1        LOOP
 
 CSF3     LX6    B7,X6
          SX4    59D
          SX2    B7
          IX4    X4-X2
          SB7    X4
          MX2    1
          AX2    B7,X2
          EQ     CSF7        CHECK FOR DIRECTIVE FORMAT
 
 CSF4     SB5    A3-1-TCCFR  TEST FOR /READ
          NZ     B5,CSF5     IF NOT /READ
          SA3    EORBIT      TEST READ ACTIVE BIT
          LX3    12D
          NG     X3,CSF6     IF READ ALREADY ACTIVE (DISREGARD /READ)
 CSF5     SB2    X7+         SET PROCESSOR ADDRESS
 CSF6     SA1    LCNT        DECREMENT COUNT OF COMMANDS
          SX6    X1-1
          SA6    A1
          EQ     CSFX        RETURN
 NLT      SPACE  4,10
**        NLT - WRITE NO LINE TERMINATOR DATA TO BUFFER.
*
*         ENTRY  (X1) = STATUS FROM *READS*.
*                (B6) = LWA+1 OF DATA TRANSFERRED ON *READS*.
*
*         EXIT   (X1) = SAME AS ENTRY.
*
*         USES   A - 2, 3, 7.
*                B - 4, 5, 7.
*                X - 0, 1, 2, 3, 7.
 
 
 NLT      SUBR               ENTRY/EXIT
          SB7    B6-BUF
          ZR     B7,NLTX     IF NO DATA TRANSFERRED
          SB7    BUF         SET CHARACTER BUFFER ADDRESS
          SB4    TBUF        SET WORD BUFFER ADDRESS
 NLT1     SB5    10          INITIALIZE NUMBER OF CHARACTERS IN WORD
          SX7    B0+         CLEAR CHARACTER BUFFER WORD
 NLT2     SA2    B7+         MERGE NEXT CHARACTER
          LX7    6
          SB7    B7+B1       INCREMENT CHARACTER BUFFER ADDRESS
          BX7    X7+X2
          EQ     B7,B6,NLT3  IF ALL CHARACTERS PROCESSED
          SB5    B5-B1       DECREMENT CHARACTERS IN WORD
          NZ     B5,NLT2     IF NOT END OF WORD
          SA7    B4          STORE WORD
          SB4    B4+B1       INCREMENT WORD BUFFER ADDRESS
          EQ     NLT1        PROCESS NEXT 10 CHARACTERS
 
 NLT3     SA7    B4          STORE LAST WORD
          SB4    B4+B1       SET NUMBER OF WORDS
          SB7    B4-TBUF
          BX0    X1          SAVE READ STATUS
          WRITEW F,TBUF,B7   WRITE DATA WITH NO TERMINATOR
          SA2    FLAGS       CHECK PACK MODE
          SA3    I           CHECK EOI STATUS
          LX2    59-35
          LX3    59-9
          PL     X2,NLT4     IF PACK MODE
          PL     X3,NLT4     IF NOT EOI
          WRITEF F           FLUSH BUFFER IF EOI IN NOPACK MODE
 NLT4     BX1    X0          RESTORE READ STATUS
          EQ     NLTX        RETURN
 RFM      SPACE  4,40
**        RFM - REFORMAT FILE.
*                *RFM* PROCESSES THE INPUT FILE WHENEVER A *C*JOB
*                DIRECTIVE IS DETECTED AS THE FIRST UNIT RECORD OF
*                THE FILE.
*                            PROCESSING IS DONE IN ONE OF TWO MODES
*         1.     NONTRANSPARENT MODE
*                            AFTER *C*JOB DIRECTIVE OR *C*NOTRANS*
*                DIRECTIVE EACH UNIT RECORD OF THE INPUT FILE IS
*                CHECKED FOR SPECIAL SUBMIT DIRECTIVES
*                A.          *C*TRANS FOUND
*                            EDITING REVERTS IMMEDIATELY TO TRANSPARENT
*                            MODE.  (SEE BELOW).
*                B.          OTHER DIRECTIVES
*                            THE DIRECTIVE APPEARANCE IS MARKED AND
*                            IT TAKES EFFECT WITH THE NEXT UNIT RECORD
*                C.          TEXT LINE
*                            TEXT LINES ARE EDITED ACCORDING TO THE
*                            CURRENT SETTING OF THE SUBMIT CONTROL
*                            OPTIONS.
*                D.          EOR/EOF/EOI
*                            SEE COMMENTS IN SUBROUTINE *SUBEO*.
*
*         2.     TRANSPARENT MODE
*                            AFTER *C*TRANS DIRECTIVE HAS BEEN
*                PROCESSED THE FIRST UNIT RECORD IS EXAMINED
*                A.          TEXT
*                            THE WHOLE RECORD IS TRANSFERED TO THE
*                            SUBMIT FILE AS IS
*                B.          *C*NOTRANS FOUND
*                            PROCESSING REVERTS IMMEDIATELY TO
*                            NON-TRANSPARENT MODE.  (SEE ABOVE).
*                C.          SUBMIT CONTROL OPTION
*                            THE CONTROL OPTION OCCURENCE IS MARKED
*                            EVEN IF IT MAY NOT INFLUENCE THE EDITING
*                            UNDER THIS MODE.  IF MODE REVERTS TO NON-
*                            TRANSPARENT, ALL OPTIONS USED UNDER
*                            TRANSPARENT MODE WILL TAKE EFFECT.
*                D.          EOR/EOF/EOI
*                            SEE COMMENTS IN SUBROUTINE *SUBEO*.
 
 
 RFM      SUBR               ENTRY/EXIT
 
*         PROCESS NONTRANSPARENT MODE
 
 PNM      BSS    0           NOTRANS
          EQ     PNM2        SKIP ADDITIONAL READ
 
 PNM1     READ   I,R
          RECALL F
 PNM2     SA1    I+3         SAVE OUTPTR(I)
          SA2    I+2         SAVE INPUT FET *IN* POINTER
          BX6    X1
          LX7    X2
          SA6    OPTR
          SA7    IPTR
          READS  I,BUF,BUFL  READ UNIT RECORD
          ZR     X1,PNM2.1   IF NO EOR/EOF/EOI
          SB7    B6-BUF
          ZR     B7,PNM2.0   IF END OF RECORD
          SA2    FLAGS       CHECK TRANS MODE BIT
          LX2    59-47
          PL     X2,PNM2.0   IF TRANS NOT SET
          SA2    OPTR        RESTORE POINTERS FOR TRANS DATA
          SA3    IPTR
          BX6    X2
          LX7    X3
          SA6    I+3
          SA7    I+2
          EQ     PTM6        SWITCH TO TRANS MODE
 
 PNM2.0   RJ     NLT         WRITE NO LINE TERMINATOR DATA TO BUFFER
          SX0    B0          INPUT FILE
          SX7    B0          NO WRITE REMAINDER
          SX5    RFMX        RETURN ADDRESS FOR EOI
          RJ     SUBEO       PROCESS EOF/EOR
          EQ     PNM1        PROCESS NEXT RECORD
 
 PNM2.1   SA1    LCNT        INCREMENT LINE COUNT
          SX6    X1+B1
          SA6    A1
          SA1    BUF         SET BEGINNING ADDRESS
          RJ     CSF         CHECK SPECIAL FORMAT
          NZ     B2,PNM3     IF SPECIAL FORMAT
          RJ     SSN         STRIP SEQUENCE NUMBER
          SB6    A1          SAVE BEGINNING ADDRESS AFTER STRIPPING
          SB3    B2          SAVE BEGINNING ADDRESS BEFORE STRIPPING
          RJ     CSF         CHECK SPECIAL FORMAT
          ZR     B2,PNM4     IF NOT SPECIAL FORMAT
 PNM3     SX7    PNM2        SAVE RETURN ADDRESS
          SA7    RJ
          JP     B2
 
 PNM4     SA2    FLAGS       TEST TRANS BIT
          LX2    12D
          PL     X2,PNM5     TRANS NOT SET
          SA1    OPTR        RESTORE *IN* AND *OUT* POINTERS
          SA2    IPTR
          BX6    X1
          LX7    X2
          SA6    I+3
          SA7    I+2
          EQ     PTM6        SWITCH TO TRANS MODE
 
 PNM5     SB2    BUF+BUFL
          SA2    FLAGS       TEST NOSEQ BIT
          PL     X2,PNM6     STRIP SEQUENCE NUMBERS
          SB6    B3          NO SEQUENCE NUMBER STRIPPING
 PNM6     SB7    B2-B6       CALCULATE WRITE LENGTH
          WRITES F,B6,B7
          EQ     PNM2        LOOP TO NEXT RECORD
 
*         PROCESS TRANSPARENT MODE
 
 PTM      BSS    0
 PTM1     READ   I
          RECALL F
 PTM2     SA1    I+3         SAVE OUTPTR(I)
          BX6    X1
          SA6    OPTR
          SA1    X6          CHECK FOR END OF LINE BYTE
          MX7    -12
          BX7    -X7*X1
          NZ     X7,PTM5     IF NOT A POSSIBLE SPECIAL FORMAT DIRECTIVE
          READS  I,BUF,BUFL  READ UNIT RECORD FROM INPUT FILE
          ZR     X1,PTM3     IF NO EOR/EOF
          SX0    B0          INPUT FILE
          SX7    B0          NO RECORD REMAINDER
          SX5    RFMX        RETURN ADDRESS FOR EOI
          RJ     SUBEO       PROCESS TERMINATION CONDITION
          EQ     PTM1        PROCESS NEXT RECORD
 
 PTM3     SA1    LCNT        INCREMENT LINE COUNT
          SX6    X1+B1
          SA6    A1
          SA1    BUF         SET BEGINNING ADDRESS
          RJ     CSF         CHECK SPECIAL FORMAT WITH NO SEQ NO STRIP
          NZ     B2,PTM4     IF SPECIAL FORMAT
          RJ     SSN         STRIP SEQUENCE NUMBER
          SB6    A1          SAVE BEGINNING ADDRESS AFTER STRIPPING
          SB3    B2          SAVE BEGINNING ADDRESS BEFORE STRIPPING
          RJ     CSF         CHECK SPECIAL FORMAT
          ZR     B2,PTM5     IF NOT SPECIAL FORMAT
 PTM4     SX7    PTM2        SAVE RETURN ADDRESS
          SA7    RJ
          JP     B2
 
 PTM5     SA2    FLAGS       TEST FOR TRANS BIT SET
          LX2    12D
          SA3    OPTR        RESTORE OUT POINTER
          BX6    X3
          SA6    I+3
          PL     X2,PNM2     IF NOT SET, SWITCH TO NONTRANSPARENT MODE
 PTM6     READW  I,BUF,BUFL
          RJ     SUBUFS      SET TRANSFER TO BUF
          ZR     X1,PTM7     IF NO EOR/EOF
          SX0    B0          INPUT FILE
          SX7    B1          PROCESS INCOMPLETE RECORD
          SX5    RFMX        RETURN ADDRESS FOR EOI
          RJ     SUBEO       PROCESS TERMINATION CONDITION
          EQ     PTM1        PROCESS NEXT RECORD
 
 PTM7     WRITEW F,BUF,BUFL
          RJ     SUBUFR      CLEAR TRANSFER TO BUF
          EQ     PTM6        LOOP
 SUBEO    SPACE  4,40
**        SUBEO  PROCESS FILE TERMINATION CONDITION.
*
*         ENTRY  (I) = FILE FET ADDRESS.
*                (X1) = EOR/EOF/EOI STATUS FROM READW OR READS
*                (X0) IF 0 - FILE IS INPUT FILE
*                        1 - FILE FROM /READ,....
*                (X5) = ALTERNATE RETURN ADDRESS
*                (X7) = 0 IF ENTIRE RECORD.
*                     = 1 IF PARTIAL RECORD POSSIBLE.
*
*         EXIT   THE ROUTINE WILL RETURN VIA REGULAR LINKAGE WHEN
*                     EOR/EOF ON INPUT FILE
*                     EOR ON READ FILE
*                THE ROUTINE WILL RETURN TO THE ALTERNATE RETURN
*                ADDRESS WHEN
*                     EOI ON INPUT FILE
*                     EOF ON READ FILE
*
*
*                THIS ROUTINE PROCESSES A TERMINAL CONDITION FOR A FILE
*                AS FOLLOWS
*         1.     END-OF-INFORMATION
*                A. INPUT FILE
*                             THE REFORMATTING ROUTINE IS TERMINATED BUT
*                             THE SUBMIT BUFFER F IS FLUSHED IF NOT
*                             EMPTY WITH A WRITEF MACRO.
*         2.     END OF FILE
*                A. INPUT FILE
*                             IF THE PACK CONTROL OPTION IS
*                             IN EFFECT  THE FILE MARK IS IGNORED.
*                             ELSE A FILE MARK IS WRITTEN TO THE OUTPUT
*                             FILE F
*                B. READ FILE
*                            READING FROM FILE IS TERMINATED, EDITING
*                            WILL BE THE SAME AS IF EOR WAS DETECTED.
*         3.     END OF RECORD
*                A. INPUT FILE
*                B. READ FILE
*                             IF THE PACK OPTION IS IN EFFECT THE RECORD
*                             MARK IS IGNORED, ELSE A RECORD MARK IS
*                             WRITTEN TO THE OUTPUT FILE F.
 
 
 SUBEO    SUBR               ENTRY/EXIT
          SA2    FLAGS       PACK/NOPAK
          LX2    59-35
 
*         SEPARATE EOR FROM EOF.
 
          PL     X1,SUB6     IF EOR
          NZ     X0,SUB4     IF EOF ON READ FILE
 
*         END OF FILE.
 
          SA4    SUBTR
          BX0    X2
          ZR     X4,SUB1     IF BUFFER EMPTY
          WRITEW F,BUF,X4
          RJ     SUBUFR      CLEAR TRANSFER COUNT
 SUB1     SA3    I           CHECK EOI STATUS
          LX3    59-9
          PL     X0,SUB2     IF PACK MODE
          NG     X3,SUB3     IF EOI/INPUT/NOPACK
          WRITEF F           EOF/NOPACK, FLUSH FILE
          EQ     SUBEOX      REGULAR RETURN
 
 SUB2     PL     X3,SUBEOX   IF NOT EOI
          WRITEF F           ON EOI,FLUSH OUTPUT BUFFER
 SUB3     SB7    X5          SET ALTERNATE RETURN ADDRESS
          JP     B7
 
*         READ FILE EOF OR EOI.
 
 SUB4     ZR     X7,SUB5     IF NO PARTIAL RECORD READ
          SA4    SUBTR
          ZR     X4,SUB5     IF NO DATA
          BX0    X2
          WRITEW F,BUF,X4    WRITE LAST AMOUNT OF DATA
          RJ     SUBUFR      CLEAR TRANSFER COUNT
          BX2    X0
          SX0    B0          SET EOF
          EQ     SUB8
 
 SUB5     SA3    F+2         *IN*
          SX0    B0          X0  SET TO EOF
          SA4    A3+B1       OUT
          BX6    X3-X4       IN-OUT
          ZR     X6,SUB9     IF OUTPUT BUFFER EMPTY
          EQ     SUB8        READ FILE TERMINATED WITH EOR
 
*         END OF RECORD.
 
 SUB6     ZR     X7,SUB7     IF NO PARTIAL RECORD READ
          BX0    X2
          SA4    SUBTR
          ZR     X4,SUB6.1   IF NO DATA
          WRITEW F,BUF,X1-BUF
          RJ     SUBUFR      CLEAR TRANSFER TO BUF
          BX2    X0
 SUB6.1   SX1    B1          FORCE EOR FLAG
 
*         PROCESS READ FILE EOR OR EOF.
 
 SUB7     SX0    X1+         RESTORE EOR/EOF FLAG
 SUB8     PL     X2,SUB9     IF PACK MODE
          WRITER F           NOPACK PRESERVES THE RECORD MARK
 SUB9     ZR     X0,SUB3     IF EOF ON READ FILE
          EQ     SUBEOX      EOR
 SUBUFS   SPACE  4,10
**        SUBUFS - SET NUMBER OF WORDS TRANSFERRED TO BUF FROM I.
*
*         ENTRY  (B6) = LWA+1 OF DATA TRANSFERRED.
*
*         EXIT   (SUBTR) = NUMBER OF WORDS TRANSFERRED.
*
*         USES   A - 6.
*                X - 4, 6.
 
 
 SUBUFS   SUBR               ENTRY/EXIT
          SX4    B6
          SX6    BUF
          IX6    X4-X6
          SA6    SUBTR
          EQ     SUBUFSX     RETURN
 SUBUFR   SPACE  4,10
**        SUBUFR - RESET TRANSFER CELL TO ZERO.
*
*         EXIT   (SUBTR) = 0.
*
*         USES   A - 6.
*                X - 6.
 
 
 SUBUFR   SUBR               ENTRY/EXIT
          SX6    B0+
          SA6    SUBTR
          EQ     SUBUFRX     RETURN
 
 SUBTR    BSSZ   1
          TITLE  SPECIAL DIRECTIVE PROCESSORS.
 CHARGE   SPACE  4,10
**        CHARGE - PROCESS CHARGE.
*
*         USES   A - 1, 2.
*                X - 1, 2.
*                B - 2, 5.
*
*         CALLS  SNM.
*
*         MACROS GETCN, WRITEC.
 
 
 CHARGE   BSS    0
          SA1    CHGA
          NZ     X1,CHG1     IF NOT FIRST *CHARGE* DIRECTIVE
          GETCN  CHGA        GET CHARGE INFORMATION
          SA1    CHGA        READ CHARGE NUMBER
          SB5    CHGB        SET COMMAND TEMPLATE ADDRESS
          SB2    1R#
          RJ     SNM         SET CHARGE NUMBER
          SA1    CHGA+1      READ FIRST PART OF PROJECT NUMBER
          SB2    1R<
          RJ     SNM         SET PROJECT NUMBER
          SA1    CHGA+2      READ SECOND PART OF PROJECT NUMBER
          SB2    1R>
          RJ     SNM         SET PROJECT NUMBER
 CHG1     SA1    CHGA+3
          PL     X1,CHG2     IF CHARGE NOT VALIDATED
          WRITEC F,CHGB      WRITE COMMAND TO SUBMIT FILE
 CHG2     SA2    RJ          SET RETURN ADDRESS
          SB2    X2
          JP     B2          RETURN
 
 CHGA     BSSZ   4           *GETCN* BLOCK
 CHGB     DATA   C/$CHARGE,##########,<<<<<<<<<<>>>>>>>>>>./
 JOB      SPACE  4,10
**        JOB - PROCESS JOB.
 
 
 JOB      BSS    0
          WRITER F,R
          SA2    RJ
          SB2    X2
          JP     B2
 EOR      SPACE  4,10
**        EOR - PROCESS EOR.
 
 
 EOR      BSS    0
          WRITER F,R
          SA2    RJ
          SB2    X2
          JP     B2
 EOF      SPACE  4,10
**        EOF - PROCESS EOF.
 
 
 EOF      BSS    0
          WRITEF F,R
          SA2    RJ
          SB2    X2
          JP     B2
 SEQ      SPACE  4,10
**        SEQ - PROCESS SEQ.
 
 
 SEQ      BSS    0
          SA1    FLAGS
          MX2    1
          BX6    -X2*X1
          SA6    FLAGS
          SA2    RJ
          SB2    X2
          JP     B2
 NOSEQ    SPACE  4,10
**        NOSEQ - PROCESS NOSEQ.
 
 
 NOSEQ    BSS    0
          SA1    FLAGS
          MX2    1
          BX6    X2+X1
          SA6    FLAGS
          SA2    RJ
          SB2    X2
          JP     B2
 TRANS    SPACE  4,10
**        TRANS - PROCESS TRANS.
 
 
 TRANS    BSS    0
          SA1    FLAGS
          LX1    12D
          MX2    1
          BX6    X2+X1
          LX6    48D
          SA6    FLAGS
          SA2    RJ
          SB2    X2
          JP     B2
 NOTRANS  SPACE  4,10
**        NOTRANS - PROCESS NOTRANS.
 
 
 NOTRANS  BSS    0
          SA1    FLAGS
          LX1    12D
          MX2    1
          BX6    -X2*X1
          LX6    48D
          SA6    FLAGS
          SA2    RJ
          SB2    X2
          JP     B2
 NOPACK   SPACE  4,10
**        NOPACK - PROCESS NOPACK.
 
 
 NOPACK   BSS    0
          SA1    FLAGS
          LX1    24D
          MX2    1
          BX6    X2+X1
          LX6    36D
          SA6    FLAGS
          SA2    RJ
          SB2    X2
          JP     B2
 PACK     SPACE  4,10
**        PACK - PROCESS PACK.
 
 
 PACK     BSS    0
          SA1    FLAGS
          LX1    24D
          MX2    1
          BX6    -X2*X1
          LX6    36D
          SA6    FLAGS
          SA2    RJ
          SB2    X2
          JP     B2
 REWIND   SPACE  4,10
**        REWIND - REWIND FILE.
*
*         USES   A - 1, 2, 6.
*                B - 2.
*                X - 1, 2, 3, 6.
*
*         CALLS  GLF, SFN.
 
 
 REWIND   BSS    0
          RJ     GLF         GET LOCAL FILE NEME
          NZ     X4,RWD6     IF INCORRECT SEPARATOR, PUT OUT AS DATA
          NZ     B2,RWD1     IF VALID CHARACTERS IN FILEMAME
          SA2    =0LTAPE1    SET DEFAULT FILENAME IN FET
          BX6    X2
          SA1    EORBIT      TEST READ ACTIVE BIT
          LX1    12D
          PL     X1,RWD3     NOT ACTIVE
          EQ     RWD6        ACTIVE,PUT OUT AS DATA
 
 RWD1     RJ     SFN         SHIFT FILENAME, TEST FOR SUBMIT FILENAME
          ZR     X2,RWD6     IF EQUAL,PUT OUT AS DATA
 RWD2     SA1    EORBIT      TEST FOR READ ACTIVE
          LX1    12D
          PL     X1,RWD3     READ NOT ACTIVE
          SA1    R           TEST FOR READ FILENAME
          MX3    42D
          BX2    X3*X1
          BX2    X2-X6
          ZR     X2,RWD6     IF EQUAL,PUT OUT AS DATA
 RWD3     SX1    1
          IX6    X6+X1
          SA6    W           STORE FILENAME IN FET
          REWIND W,R         REWIND FILE
          SA1    RJ          GET RETURN ADDRESS
          SB2    X1
          JP     B2          RETURN
 
 RWD6     SA1    RJ          TEST RETURN ADDRESS = TO NONTRANS
                             PARENT MODE ROUTINE
          SX2    PNM2
          BX2    X1-X2
          ZR     X2,PNM4     RETURN TO NONTRANSPARENT MODE ROUTINE
          SX2    PTM2
          BX2    X1-X2
          ZR     X2,PTM5
          SX2    RTM1
          BX2    X1-X2
          ZR     X2,RTM5
          EQ     RNM3
 USER     SPACE  4,10
**        USER - PROCESS USER.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6.
*                B - 2, 5.
*
*         CALLS  SNM.
*
*         MACROS ABORT, MESSAGE, RECALL, SYSTEM, WRITEC.
 
 
 USER     BSS    0           ENTRY
          SA1    PFPB+2
          MX0    42
          BX5    X0*X1
          NZ     X5,USE2     IF *USER* COMMAND HAS BEEN EXECUTED
          MESSAGE  (=C* USER COMMAND HAS NOT BEEN EXECUTED.*),,R
 USE1     MESSAGE  (=C* USER DIRECTIVE INCORRECT.*),,R
          ABORT
 
 USE2     SA2    LCNT        CHECK LINE COUNT
          SX6    X2-1
          NZ     X6,USE1     IF MORE THAN ONE COMMAND PROCESSED
          SA2    USRF
          NZ     X2,USE1     IF USER DIRECTIVE ALREADY PROCESSED
          SX6    B1          SET */USER* FLAG
          SA6    A2
          SYSTEM SFM,R,USEC,RSDF*100B  GET FAMILY ORDINAL TABLE
          SA1    SBUF+0      GET SYSTEM DEFAULT FAMILY NAME
          SA2    PFPB+0      CHECK FOR DEFAULT FAMILY
          SB5    USEB        SET ADDRESS OF DEFAULT FAMILY TEMPLATE
          BX2    X1-X2
          BX2    X0*X2
          ZR     X2,USE3     IF CURRENT FAMILY IS THE DEFAULT FAMILY
          SB5    USEA        SET ADDRESS OF ALTERNATE FAMILY TEMPLATE
          SA1    PFPB+0      SET FAMILY NAME IN *USER* COMMAND
          BX1    X0*X1
          SB2    1R#
          RJ     SNM         SET NAME IN MESSAGE
 USE3     SB2    1R*         SET USER NAME IN *USER* COMMAND
          BX1    X5
          RJ     SNM         SET NAME IN MESSAGE
 USE4     WRITEC F,B5
          RECALL F
          SA2    RJ
          SB2    X2
          JP     B2          RETURN
 
*         *USER* COMMAND TEMPLATES.
 
 USEA     DATA   C/$USER,*******,,#######./  ALTERNATE FAMILY TEMPLATE
 
 USEB     DATA   C/$USER,*******,./          DEFAULT FAMILY TEMPLATE
 
 USEC     VFD    12/RFDF,12/0,12/SBUFL,6/0,18/SBUF  *RSDF* CONTROL WORD
          CON    0           END OF CONTROL WORDS
 GLF      SPACE  4,10
**        GLF - GET LOCAL FILE NAME.
*
*         ENTRY  (A2) = ADDRESS OF NEXT CHARACTER IN STRING BUFFER.
*
*         EXIT   (X4) .NE. 0 IF INCORRECT SEPARATOR.
*                (B2) = NUMBER OF CHARACTERS IN NAME.
*
*         USES   A - 1.
*                X - 1, 3, 4, 5, 6.
*                B - 2.
 
 
 GLF      SUBR               ENTRY/EXIT
          SA1    A2          TEST FOR , OR BLANK SEPARATOR
          SX4    1R,
          BX4    X1-X4
          ZR     X4,GLF2
          SX4    1R
          BX4    X1-X4
          NZ     X4,GLFX     IF INCORRECT SEPARATOR
 GLF2     SA1    A2+1        GET LOCAL FILENAME
          SB2    B0          SET BUFFER INDEX
          MX5    7           SET FILENAME CHARACTER LIMIT
          SX3    1R
          BX6    X6-X6       CLEAR ASSEMBLY
 GLF1     BX4    X1-X3       TEST FOR BLANK
          ZR     X4,GLFX     IF BLANK
          LX6    6
          BX6    X6+X1       PLANT CHARACTER
          LX5    1           SHIFT CHARACTER COUNT
          SB2    B2+B1       INCREMENT CHARACTER INDEX
          SA1    A1+B1       GET NEXT CHARACTER
          NG     X5,GLF1     IF NOT 7 CHARACTERS
          BX4    X1-X3       TEST FOR BLANK
          EQ     GLFX        RETURN
 SFN      SPACE  4,10
**        SFN - SHIFT AND TEST FILE NAME.
*
*         ENTRY  (B2) = NUMBER OF CHARACTERS IN NAME.
*
*         EXIT   (X2) = 0 IF NAME SAME AS SUBMIT FILE NAME.
*
*         USES   A - 2.
*                X - 2, 3, 4.
*                B - 2.
 
 
 SFN      SUBR               ENTRY/EXIT
          SX4    B2          SHIFT FILENAME + TEST FOR SUBMIT FILENAME
          SX3    10D         GENERATE SHIFT COUNT
          IX4    X3-X4
          BX3    X4
          LX4    2
          LX3    1
          IX4    X4+X3
          SB2    X4
          LX6    B2,X6
          SA2    I           TEST READ FILENAME SAME AS SUBMIT FILE NAME
          MX3    42D
          BX2    X3*X2
          BX2    X2-X6
          EQ     SFNX        RETURN
 READ     SPACE  4,10
**        READ - READ AND COPY LOCAL FILE.
*
*         USES   A - 1, 2, 6.
*                X - 0, 1, 2, 3, 4, 6.
*                B - 3.
*
*         CALLS  GLF, RNM, RTM, SFN.
*
*         MACROS ATTACH, GET, RECALL, RETURN, REWIND, SETFAL, STATUS.
 
 
 READ     BSS    0
          RJ     GLF         GET LOCAL FILENAME
          NZ     X4,READ13   IF INCORRECT SEPARATOR, PUT OUT AS DATA
 READ1    NZ     B2,READ2    IF VALID CHARACTERS IN FILENAME
          SA2    =0LTAPE1    SET DEFAULT FILENAME IN FET
          BX6    X2
          EQ     READ3
 
 READ2    RJ     SFN         SHIFT FILENAME + TEST FOR SUBMIT FILENAME
          ZR     X2,READ13   IF EQUAL, PUT OUT AS DATA
 READ3    SX1    1
          IX6    X6+X1
          SA6    R           STORE FILENAME IN FET
          SA6    RR
 READ4    SA1    RJ          STORE ORIGINAL RETURN JUMP
          BX6    X1
          SA6    RJ2
          SA1    EORBIT      SET READ ACTIVE BIT
          MX2    1
          LX1    12D
          BX6    X1+X2
          LX6    48D
          SA6    EORBIT
          SA1    RR+1        SET ACCESS LEVEL PROCESSING BIT
          MX6    1
          LX6    39-59
          BX6    X1+X6
          SA6    A1
          STATUS RR
          SA1    RR
          MX3    60-7
          BX4    -X3*X1
          SX3    X4-1
          NZ     X3,READ8    IF FILE LOCAL
          GET    RR
          SB3    B0
 READ5    SA1    RR          CHECK *PFM* ERROR STATUS
          MX3    60-4
          AX1    10
          BX6    -X3*X1
          ZR     X6,READ10   IF FILE OBTAINED
          SX3    X6-1
          ZR     X3,READ6    IF FILE BUSY
          NE     B3,B0,READ7 IF BOTH *GET* AND *ATTACH* FAILED
          SA1    R
          BX6    X1
          SA6    RR          RESET LFN AND STATUS
          ATTACH RR,,,,,,,,NF
          SB3    B1          SET *ATTACH* FLAG
          EQ     READ5       CHECK *PFM* ERROR STATUS
 
 READ6    SA1    R           * READ FILE BUSY - LFN*
          MX3    42
          BX6    X3*X1
          SA6    BSFIL+2     SET FILE NAME IN MESSAGE
          SX0    BSFIL
          EQ     ABT         ABORT
 
 READ7    SA1    R           * NO READ FILE FOUND - LFN*
          MX3    42
          BX6    X3*X1
          SA6    NOFIL+2     SET FILE NAME IN MESSAGE
          SX0    NOFIL
          EQ     ABT         ABORT
 
 READ8    SA1    NRFLG
          ZR     X1,READ9    IF NO REWIND
          REWIND RR,R
 READ9    MX6    0
          SA6    RR          SET *LOCAL FILE* FLAG
 
*         CHECK ACCESS LEVEL OF READ FILE.
 
 READ10   SA1    RR+CFAL     GET ACCESS LEVEL OF READ FILE
          MX6    -3
          LX1    -36
          BX6    -X6*X1
          SA1    ALVL        GET ACCESS LEVEL OF SUBMIT FILE
          IX1    X1-X6
          PL     X1,READ10.1 IF READ FILE LEVEL .LE. SUBMIT FILE LEVEL
          SA6    A1+
          RECALL F
          SETFAL F,ALVL      SET SUBMIT FILE LEVEL TO READ FILE LEVEL
 
*         CALL APPROPRIATE READ PROCESSOR.
 
 READ10.1 SA1    FLAGS       TEST FOR TRANS BIT ON
          LX1    12D
          NG     X1,RTM      TRANS
          EQ     RNM         NOTRANS
 
 READ11   SA1    EORBIT      SET READ ACTIVE BIT INACTIVE
          MX2    1
          LX1    12D
          BX6    -X1*X2
          LX6    48D
          SA6    EORBIT
          SA1    RR
          ZR     X1,READ12   READ FILE NOT ATTACHED BY SUBMIT
          RETURN RR,R
          MX6    0
          SA6    RR          CLEAR RETURN FLAG
 READ12   SA2    RJ2         RESTORE ORIGINAL RETURN ADDRESS
          SB2    X2
          JP     B2          RETURN
 
 READ13   SA1    RJ          TEST RETURN ADDRESS = TO NONTRANSPARENT
          SX2    PNM2            MODE ROUTINE
          BX2    X1-X2
          ZR     X2,PNM4     RETURN TO NONTRANSPARENT MODE ROUTINE
          EQ     PTM5        RETURN TO TRANSPARENT MODE ROUTINE
 RNM      SPACE  4,10
**        RNM - PROCESS NONTRANSPARENT READ MODE.
*
*         USES   A - 1, 2, 3, 6, 7.
*                X - 0, 1, 2, 3, 5, 6, 7.
*                B - 2, 3, 6, 7.
*
*         CALLS  CSF, NLT, SSN, SUBEO.
*
*         MACROS READ, READS, RECALL, WRITES.
 
 
 RNM      BSS    0           ENTRY
 RNM0     READ   R,R         READ NEXT BUFFER LOAD
          RECALL F
 RNM1     SA1    R+3         SAVE OUTPTR(R)
          SA2    R+2         SAVE READ FILE FET *IN* POINTER
          BX6    X1
          LX7    X2
          SA6    OPTR2
          SA7    IPTR2
          READS  R,BUF,BUFL  READ UNIT RECORD
          ZR     X1,RNM1.1   IF NO EOR/EOF/EOI
          SB7    B6-BUF
          ZR     B7,RNM1.0   IF END OF RECORD
          SA2    FLAGS       CHECK TRANS MODE BIT
          LX2    59-47
          PL     X2,RNM1.0   IF TRANS NOT SET
          SA2    OPTR2       RESTORE POINTERS FOR TRANS DATA
          SA3    IPTR2
          BX6    X2
          LX7    X3
          SA6    R+3
          SA7    R+2
          EQ     RTM6        SWITCH TO TRANS MODE
 
 RNM1.0   RJ     NLT         WRITE NO LINE TERMINATOR DATA TO BUFFER
          SX0    B1          READ FILE
          BX7    X7-X7       SET NO PARTIAL RECORD
          SX5    READ11      RETURN ADDRESS ON EOF
          RJ     SUBEO
          EQ     RNM0        READ NEXT BUFFER LOAD
 
 RNM1.1   SA1    LCNT        INCREMENT LINE COUNT
          SX6    X1+B1
          SA6    A1
          SA1    BUF         SET STARTING ADDRESS
          RJ     CSF         CHECK SPECIAL FORMAT
          NZ     B2,RNM2     IF SPECIAL FORMAT
          RJ     SSN         STRIP SEQUENCE NUMBER
          SB6    A1          SAVE BEGINNING ADDRESS AFTER STRIPPING
          SB3    B2          SAVE BEGINNING ADDRESS BEFORE STRIPPING
          RJ     CSF         CHECK SPECIAL FORMAT AFTER STRIPPING
          ZR     B2,RNM3     IF NOT SPECIAL FORMAT
 RNM2     SX7    RNM1        SAVE RETURN ADDRESS
          SA7    RJ
          JP     B2          PROCESS SPECIAL FORMAT
 
 RNM3     SA2    FLAGS       TEST TRANS BIT
          LX2    12D
          PL     X2,RNM4     TRANS NOT SET
          SA1    OPTR2       RESTORE *IN* AND *OUT* POINTERS
          SA2    IPTR2
          BX6    X1
          LX7    X2
          SA6    R+3
          SA7    R+2
          EQ     RTM6        SWITCH TO TRANS MODE
 
 RNM4     SB2    BUF+BUFL
          SA2    FLAGS       TEST NOSEQ BIT
          PL     X2,RNM5     STRIP SEQUENCE NUMBERS
          SB6    B3          NO SEQUENCE NUMBER STRIPPING
 RNM5     SB7    B2-B6       CALCULATE WRITE LENGTH
          WRITES F,B6,B7
          EQ     RNM1        LOOP TO NEXT RECORD
 RTM      SPACE  4,10
**        RTM - PROCESS TRANSPARENT READ MODE.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 3, 6.
*                X - 0, 1, 2, 3, 5, 6, 7.
*
*         CALLS  CSF, SSN, SUBEO, SUBUFR, SUBUFS.
*
*         MACROS READ, READS, READW, RECALL, WRITEW.
 
 
 RTM      BSS    0           ENTRY
 RTM0     READ   R,R         READ NEXT BUFFER LOAD
          RECALL F
 RTM1     SA1    R+3         SAVE OUTPTR(R)
          BX6    X1
          SA6    OPTR2
          SA1    X6          CHECK FOR END OF LINE BYTE
          MX7    -12
          BX7    -X7*X1
          NZ     X7,RTM5     IF NOT A POSSIBLE SPECIAL FORMAT DIRECTIVE
          READS  R,BUF,BUFL  READ UNIT RECORD FROM READ FILE
          ZR     X1,RTM2     IF NO EOF/EOI
          SX0    B1          READ FILE
          SX7    B0          NO PARTIAL RECORD
          SX5    READ11      RETURN ADDRESS ON EOF
          RJ     SUBEO
          EQ     RTM0        READ NEXT BUFFER LOAD
 
 RTM2     SA1    LCNT        INCREMENT LINE COUNT
          SX6    X1+B1
          SA6    A1
          SA1    BUF         SET STARTING ADDRESS
          RJ     CSF         CHECK SPECIAL FORMAT (BEFORE STRIPPING)
          NZ     B2,RTM4     IF SPECIAL FORMAT
          RJ     SSN         STRIP SEQUENCE NUMBER
          SB6    A1          SAVE BEGINNING ADDRESS AFTER STRIPPING
          SB3    B2          SAVE BEGINNING ADDRESS BEFORE STRIPPING
          RJ     CSF         CHECK SPECIAL FORMAT (AFTER STRIPPING)
          ZR     B2,RTM5     IF NOT SPECIAL FORMAT
 RTM4     SX7    RTM1        SAVE RETURN ADDRESS
          SA7    RJ
          JP     B2          PROCESS SPECIAL FORMAT
 
 RTM5     SA2    FLAGS       TEST FOR TRANS BIT SET
          LX2    12D
          SA3    OPTR2       RESTORE OUT POINTER
          BX6    X3
          SA6    R+3
          PL     X2,RNM1     IF NOT SET, SWITCH TO NON-TRANSPARENT MODE
 RTM6     READW  R,BUF,BUFL
          RJ     SUBUFS      SET BUF LENGTH
          ZR     X1,RTM7     IF NO EOR/EOF/EOI
          SX0    B1          READ FILE
          SX7    B1          PARTIAL RECORD
          SX5    READ11      SET RETURN ON EOI OR EOF
          RJ     SUBEO
          EQ     RTM0        READ NEXT BUFFER LOAD
 
 RTM7     WRITEW F,BUF,BUFL
          RJ     SUBUFR      RESET BUF LENGTH TO 0
          EQ     RTM6        LOOP
 ESCAPE   SPACE  4,10
**        ESCAPE - PROCESS NEW ESCAPE CODE.
 
 
 ESCAPE   BSS    0
          SA1    A2          PICK UP NEW ESCAPE CODE
          LX1    54D
          SA2    TCCF
          MX3    -54
 ESCAPE1  BX2    -X3*X2
          IX7    X2+X1       PLANT NEW ESCAPE CODE
          SA7    A2
          SA2    A2+B1
          NZ     X2,ESCAPE1
          SA2    RJ
          SB2    X2
          JP     B2          RETURN
          TITLE  TABLES.
 TCCF     SPACE  4,10
**        TCCF - TABLE OF DIRECTIVE FORMATS.
 
 
 TCCF     BSS    0
 
          CON    4L/JOB+JOB
          CON    7L/CHARGE+CHARGE
          CON    4L/EOF+EOF
          CON    4L/EOR+EOR
          CON    6L/NOSEQ+NOSEQ
          CON    4L/SEQ+SEQ
          CON    6L/TRANS+TRANS
          CON    8L/NOTRANS+NOTRANS
          CON    7L/NOPACK+NOPACK
          CON    5L/PACK+PACK
          CON    5L/USER+USER
 TCCFR    CON    5L/READ+READ
 TCCFW    CON    7L/REWIND+REWIND
 TCCFE    CON    4L/EC=+ESCAPE
 
          CON    0
 
 NOFIL    DATA   20H NO READ FILE FOUND-
          DATA   0
 BSFIL    DATA   20H READ FILE BUSY-
          DATA   0
          SPACE  4,10
 TCCFL    DATA   74000000000000000044B     /JOB LENGTH
          DATA   77400000000000000022B     /CHARGE LENGTH
          DATA   74000000000000000044B     /EOF LENGTH
          DATA   74000000000000000044B     /EOR LENGTH
          DATA   77000000000000000030B     /NOSEQ LENGTH
          DATA   74000000000000000044B     /SEQ LENGTH
          DATA   77000000000000000030B     /TRANS LENGTH
          DATA   77600000000000000014B     /NOTRANS LENGTH
          DATA   77400000000000000022B     /NOPACK LENGTH
          DATA   76000000000000000036B     /PACK LENGTH
          DATA   76000000000000000036B     /USER LENGTH
          DATA   76000000000000000036B     /READ LENGTH
          DATA   77400000000000000022B     /REWIND LENGTH
          DATA   74000000000000000044B     /EC= LENGTH
          CON    0
          TITLE  COMMON DECKS.
*         COMMON DECKS.
 
 
*CALL     COMCCIO
*CALL     COMCCPM
*CALL     COMCLFM
*CALL     COMCPFM
*CALL     COMCRDS
*CALL     COMCRDW
*CALL     COMCSNM
*CALL     COMCSFM
*CALL     COMCSSN
*CALL     COMCSYS
*CALL     COMCWTC
*CALL     COMCWTS
*CALL     COMCWTW
*CALL     COMSPFM
*CALL     COMSPRD
*CALL     COMSSSJ
 SSJB     SPACE  4,10
*         SPECIAL SYSTEM JOB PARAMETER AREA.
 
 SSJ=     EQU    0
 PFPB     SPACE  4,10
*         PERMANENT FILE PARAMETER BLOCK.
 
 PFPB     BSSZ   3
          TITLE  BUFFERS.
*         BUFFERS.
 
 
          USE    //
          SEG
 BUF      SPACE  4,10
 BUF      EQU    *
 IBUF     EQU    BUF+BUFL
 FBUF     EQU    IBUF+IBUFL
 RBUF     EQU    FBUF+FBUFL
 SBUF     EQU    RBUF+RBUFL
 TBUF     EQU    SBUF+SBUFL
 WBUF     EQU    TBUF+TBUFL
 RFL=     EQU    WBUF+WBUFL
 PRS      TITLE  PRESET.
 PRS      SPACE  4,10
**        PRS - PRESET PROGRAM.
 
 
          ORG    BUF
 PRS      SUBR               ENTRY/EXIT
          GETPFP PFPB        GET PERMANENT FILE PARAMETERS
          SX6    RBUF        SET *PFM* ERROR MESSAGE ADDRESS
          SA6    RR+CFPW
          RJ     SCC         SET CONTROL CHARACTER
          SA1    FWPR
          MX2    -6
          AX1    24
          BX2    -X2*X1
          SX6    X2-IAOT
          SB7    B0          INITIALIZE QUEUE FLAG
          NZ     X6,PRS1     IF NOT INTERACTIVE
          SA1    TPAR+PRSF   CHANGE DEFAULT QUEUE
          BX6    X1
          SA6    PRSE
 PRS1     SA1    ACTR        CHECK ARGUMENT COUNT
          SA4    ARGR
          MX0    42
          SB4    X1
          NZ     B4,PRS2     IF ARGUMENTS PRESENT
 PRS1.1   SX0    PRSA        * NO SOURCE FILE SPECIFIED.*
          EQ     ABT         ABORT JOB
 
 PRS2     SX2    B1          SET SOURCE FILE NAME
          BX4    X0*X4
          ZR     X4,PRS1.1   IF EMPTY FILE NAME
          SX0    PRSC        * TOO MANY ARGUMENTS.*
          SB3    B4-4
          GT     B3,ABT      IF TOO MANY ARGUMENTS
          BX6    X4+X2
          SB4    B4-B1
          SA6    I
 PRS2.1   ZR     B4,PRS4     IF END OF ARGUMENTS
          SA1    TPAR
          SA4    A4+1        CHECK QUEUE TYPE
          MX0    12
          BX6    X0*X4
 PRS3     BX2    X0*X1
          BX2    X6-X2
          ZR     X2,PRS3.1   IF MATCH FOUND
          SA1    A1+1
          NZ     X1,PRS3     IF NOT END OF TABLE
          LX6    12
          SX7    X6-2RNR
          SB4    B4-B1
          SA7    NRFLG       SET NO REWIND FLAG
          ZR     X7,PRS3.2   IF *NR* OPTION
          SX0    PRSB        * INCORRECT QUEUE SPECIFIED.*
          ZR     X6,PRS2.1   IF NO PARAMETER PRESENT
          EQ     ABT         ABORT JOB
 
 PRS3.1   SX0    PRSD        * CONFLICTING PARAMETERS.*
          NZ     B7,ABT      IF QUEUE ALREADY SELECTED
          SB7    B1
          SB4    B4-B1
          BX7    X1
          MX0    -6
          SA7    PRSE
          LX1    59-18       CHECK FOR REMOTE QUEUE
          BX7    -X0*X4
          PL     X1,PRS2.1   IF NOT REMOTE QUEUE
          MX6    24          SET TID FIELD
          LX6    24
          SA6    TDSP+2
          SX7    X7-1R=
          NZ     X7,PRS2.1   IF NOT *=* SEPARATOR
          SA4    A4+B1       GET USER NAME
          MX0    42
          BX7    X0*X4
          SB4    B4-B1
          SA7    TFUN+1
          SX0    -TFUN       RESET TID FIELD
          BX6    X6*X0
          SA6    A6
          EQ     PRS2.1      GET NEXT ARGUMENT
 
 PRS3.2   SX0    PRSC        * TOO MANY ARGUMENTS.*
          NZ     B4,ABT      IF ANOTHER ARGUMENT
 
*         SAVE FILE ACCESS LEVEL.
 
 PRS4     SA1    I+1         SET BIT TO RETURN FILE ACCESS LEVEL
          MX0    1
          LX0    39-59
          BX6    X0+X1
          SA6    A1
          STATUS I,P
          SA1    I+CFAL      GET ACCESS LEVEL
          MX0    -3
          LX1    -36
          BX6    -X0*X1
          SA6    ALVL
          SA1    PRSE        SET ORIGIN TYPE
          ZR     X1,PRSX     IF NO QUEUE GIVEN AND NOT *IAOT*
          MX0    -18
          BX3    -X0*X1
          SA2    TDSP+1
          SX6    FRCS        CLEAR PRESET CENTRAL SITE BIT
          BX4    -X6*X2
          BX7    X4+X3       ADD NEW FLAG BITS
          SA7    A2          SET FLAGS
          MX0    -12
          AX1    36
          BX4    -X0*X1
          ZR     X4,PRSX     IF NO DISPOSITION CODE CHANGE
          LX0    35-11
          BX2    X0*X7
          LX4    24
          BX7    X2+X4
          SA7    A7+         SET DISPOSITION CODE
          EQ     PRSX        RETURN
 
 PRSA     DATA   C* NO SOURCE FILE SPECIFIED.*
 
 PRSB     DATA   C* INCORRECT QUEUE SPECIFIED.*
 
 PRSC     DATA   C* TOO MANY ARGUMENTS.*
 
 PRSD     DATA   C* CONFLICTING PARAMETERS.*
 
 PRSE     CON    0
 TPAR     SPACE  4,10
**        TPAR - PARAMETER CONVERSION TABLE.
*
*T        12/KEYWORD,12/DISP CODE,17/0,1/R,18/FLAGS
*
*         R - SET IF REMOTE BATCH TYPE KEYWORD.
*         FLAGS - FLAGS TO PRESET IN *DSP* CALL.
 
 
 TPAR     BSS    0
          LOC    0
 PRSF     VFD    12/0LN,12/0LNO,17/0,1/0,18/FRCS
          VFD    12/0LB,12/0,17/0,1/0,18/FRCS
          VFD    12/0LE,12/0,17/0,1/1,18/FRTI
          VFD    12/0LNO,12/0LNO,17/0,1/0,18/FRCS
          VFD    12/0LBC,12/0,17/0,1/0,18/FRCS
          VFD    12/0LRB,12/0,17/0,1/1,18/FRTI
          VFD    12/0LTO,12/0LTO,17/0,1/0,18/FRCS
          CON    0           END OF TABLE
          LOC    *O
 
 PRSG     BSSZ   1           *DISSJ* PARAMETER
 PRSH     BSS    1           USER NAME
 SCC      SPACE  4,10
**        SCC - SET CONTROL CHARACTER.
*
*         EXIT   CONTROL CHARACTER REPLACED IN *TCCF*.
*
*         USES   X - 1, 2, 3, 6, 7.
*                A - 1, 7.
 
 
 SCC      SUBR               ENTRY/EXIT
          MX2    -6          SCAN DIRECTIVE
          SA1    CCDR
          MX3    1
 SCC1     LX1    6
          BX6    -X2*X1
          SX7    X6-1R)
          ZR     X6,SCCX     IF END OF LINE
          SX6    X6-1R.
          ZR     X7,SCC2     IF *)*
          ZR     X6,SCC2     IF *.*
          LX3    6
          PL     X3,SCC1     LOOP TO END OF WORD
          SA1    A1+B1
          EQ     SCC1
 
 SCC2     LX3    6
          PL     X3,SCC3     IF NOT END OF WORD
          SA1    A1+B1
 SCC3     LX1    6
          BX6    -X2*X1
          SX7    X6-1R
          ZR     X6,SCCX     IF END OF LINE
          ZR     X7,SCCX     IF * *
          LX6    54
          SA1    TCCF
          MX2    -54
 SCC4     BX1    -X2*X1      REPLACE CONTROL CHARACTER IN TABLE
          IX7    X1+X6
          SA7    A1
          SA1    A1+B1       GET NEXT TABLE ENTRY
          NZ     X1,SCC4     IF NOT END OF TABLE
          EQ     SCCX        RETURN
          SPACE  4
          END