SUBMIT
          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 
