Retro1.org codex

          IDENT  CHKPT,FETS
          ABS
          SST
          SYSCOM B1
          ENTRY  CKP
          ENTRY  SFP
          ENTRY  DMP=
          ENTRY  RFL=
          ENTRY  SSJ=
          TITLE  CHKPT - CENTRAL MEMORY CHECKPOINT.
*COMMENT  CHKPT - CENTRAL MEMORY CHECKPOINT.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4
***       CHKPT - CENTRAL MEMORY CHECKPOINT.
*         V.A. WALSH.  72/05/05.
*         K.R. COMBS.  73/06/01.
*         M.S. CARTER. 76/10/08.
          SPACE  4
***       *CHKPT*  PERFORMS THE CENTRAL MEMORY PORTION OF CHECKPOINT.
*         THE CONTROL POINT AREA AND THE USER FIELD LENGTH ARE
*         EXPECTED TO BE WRITTEN ON FILE DM* BEFORE *CHKPT* EXECUTION.
*         *CHKPT* CREATES A CHECKPOINT FILE CONTAINING INFORMATION
*         ABOUT THE USER FILE AS WELL AS A COPY OF THE DM* FILE.
*
*
*         OPERATOR COMMAND-
*
*         CKP.               CHECKPOINT ALL LOCAL FILES.
*
*         CONTROL STATEMENT CALL-
*
*         CKP.               CHECKPOINT ALL LOCAL FILES.
*
*         CKP(LFN1,LFN2,...,LFNN)   CHECKPOINT ONLY THOSE FILES
*                            SPECIFIED BY LFNI.
*         CONTINUATION CARDS WILL NOT BE PROCESSED.
*
*         MACRO CALL-
*
*         CHECKPT ADDR,SP
*                ADDR - ADDRESS OF PARAMETER LIST.
*                SP   - SELECTIVE CHECKPOINT FLAG.
*                     IF NULL - CHECKPOINT LOCAL FILES (DEFAULT).
*                     IF NOT NULL - CHECKPOINT SPECIFIED FILES.
*
*         PARAMETER LIST FORMAT.
*
*T,ADDR   12/CN,30/0,6/N,11/0,1/C
*T,ADDR+1 42/LFN1,6/F,12/0
*T,ADDR+2 42/LFN2,6/F,12/0
*                .
*                .
*                .
*T,ADDR+N 42/LFNN,6/F,12/0
*
*         CN = CURRENT CHECKPOINT NUMBER.
*         N = NUMBER OF ENTRIES IN TABLE.
*         C = COMPLETION BIT SET BY CHKPT.
*         LFNI = LOCAL FILE NAME.
*         F = COPY TYPE.
*                0 - BOI TO PRESENT POSITION.
*                1 - PRESENT POSITION TO EOI.
*                2 - ENTIRE FILE.
*                3 - LAST OPERATION ON FILE WILL
*                    DETERMINE THE COPY TYPE.
*                4 - NO COPY BUT INFORMATION TABLE
*                    ON FILE IS COPIED.
          SPACE  4
***       DAYFILE MESSAGES -
*
*         * CHECKPOINT FILE ERROR.* = CHECKPOINT FILE(S) NOT
*         SPECIFIED CORRECTLY.
*
*         * SECURE FILES - CHECKPOINT ABORT.* = FILE SECURITY SPECIFIED
*         ON FILE(S) BEING CHECKPOINTED, ABORT CHECKPOINT.
*
*         * CHECKPOINT NNNN COMPLETE.* = CHECKPOINT NNNN HAS COMPLETED.
*
*         * CHECKPOINT NNNN COMPLETED TO XXXXXXX.* = CHECKPOINT NNNN
*         HAS BEEN COMPLETED TO FILE XXXXXXX.
*         (ISSUED ON ALTERNATE CB FILES ONLY)
*
*         * CHKPT UNABLE TO READ TAPE.* = ERRORS HAVE OCCURRED
*         WHILE READING A TAPE FILE WHICH CHKPT CANNOT PROCESS.
*
*         * CKP REQUEST.* = A CHECKPOINT HAS BEEN INITIATED.
*
*         * POSITION ERROR ON--XXXXXXX.* = AN ADDRESS ERROR PREVENTED
*         FILE XXXXXXX FROM BEING REPOSITIONED AFTER BEING CHECKPOINTED.
*
*         * ERROR - FILE(S) NOT PROCESSED.* = FILE(S) HAD ERROR IN
*         PRESET, THEREFORE NOT CHECKPOINTED.
*
*         * CONTENTS NOT CHECKPOINTED FOR FILE XXXXXXX.* = FOR FILE
*         XXXXXXX THE USER SELECTED OTHER THAN OPTION 4
*         (INFORMATION TABLE ONLY).  THE USER REQUEST HAS BEEN
*         IGNORED AND ONLY THE INFORMATION TABLE WAS COPIED TO THE
*         CHECKPOINT FILE.
*
*         * CHECKPOINT FILE ACCESS LEVEL ERROR.* = IN A SECURE
*         SYSTEM, THE CHECKPOINT FILE ACCESS LEVEL IS NOT THE
*         SAME AS THE JOB ACCESS LEVEL LIMIT.  THIS MUST BE THE
*         CASE TO INSURE THAT THE CHECKPOINT FILE IS SECURE
*         ENOUGH TO CONTAIN ALL LOCAL FILES.  THE ACCESS LEVEL
*         OF THE CHECKPOINT FILE IS NOT CHANGED TO THIS LEVEL
*         SINCE THIS IS NOT POSSIBLE FOR MAGNETIC TAPE FILES OR
*         DIRECT ACCESS PERMANENT FILES, AND THESE ARE THE USUAL
*         FILE TYPES USED FOR CHECKPOINT FILES.  WHEN THE
*         CHECKPOINT FILE IS ASSIGNED IT SHOULD BE ASSIGNED AT
*         THE JOB ACCESS LEVEL LIMIT.
          TITLE  CHKPT - DEFINITIONS.
          SPACE  4
*         ASSEMBLY CONSTANTS.
 
 BUFL     EQU    1000B
 IBUFL    EQU    2001B
 OBUFL    EQU    2001B
 SBUFL    EQU    402B
 TBUFL    EQU    1001B
          SPACE  4
**        READC - REDEFINE MACRO TO READ CONTROL WORDS.
*
*         FORMAT READC  F,S,N
*
*                WHERE F = ADDRESS OF FET
*                      S = ADDRESS OF BUFFER
*                      N = LENGTH OF BUFFER IN WORDS
*
*         USES   X - 2.
*                B - 6, 7.
*
*         CALLS  RDA.
 
 
          PURGMAC READC
 
 READC    MACRO  F,S,N
          MACREF  READC
          R= B6,S
          R= B7,N
          R= X2,F
          RJ RDA
          ENDM
          TITLE  STORAGE ASSIGNMENT.
          ORG    101B
 FETS     BSS    0
          BSS    2           STORAGE FOR READC CONTROLS
 I        BSS    0
 INPUT    FILEB  IBUF,IBUFL,EPR,(FET=14)
 O        BSS    0
 CCCCCCC  FILEB  OBUF,OBUFL,(FET=10)
 P        BSS    0
 CCCCCCM  RFILEB 2,1,(FET=8)
          SPACE  4
*         PARAMETER FLAG LOCATIONS.
 
 CKNO     CON    1           CHECKPOINT NUMBER
 MDFL     CON    CKST        MODE FLAG
 TICF     CON    0           TERMINAL INTERRUPT CONTROL FLAG WORD
 SPFL     BSSZ   1           SELECTIVE CHECKPOINT FLAG
 PTR      BSSZ   1           POINTER FOR BLOCKED COPY(PTS TO BLOCK WORD)
 HDRB     BSSZ   1           HEADER STORAGE WORD
 CSFP     BSSZ   1           CONTROL STATEMENT FILE POSITION
 PAR      BSS    101B        FILE LIST AREA
          SPACE  4,10
*         COMMON DECKS.
 
 
*CALL     COMCMAC
*CALL     COMSLFD
*CALL     COMSSFM
*CALL     COMSSSJ
          SPACE 4,10
*         SPECIAL ENTRY POINTS.
 
 
 DMP=     EQU    0           DUMP ENTIRE FIELD LENGTH
 SFP      EQU    0           ENTRY POINT FOR SFP CALL
 SSJ=     BSSZ   SSJL        SPECIAL SYSTEM JOB AREA
          TITLE  MAIN PROGRAM.
**        CKP - MAIN LOOP.
*
*         ENTRY - DM* FILE CONTAINS FIELD LENGTH AND CONTROL
*         POINT DUMP.
 
 
 CKP      RJ     PRS         PRESET PROGRAM
          RECALL O
          RJ     HDR         WRITE HEADER ON CHKPT FILE
          RJ     WRT         WRITE FILE TABLE TO CHKPT FILE
          RJ     CPF         COPY LOCAL FILES TO CHKPT FILE
 
*         COPY DM* FILE TO CHKPT FILE.
 
          SA1    =C/DM*/
          SX3    3
          BX6    X1+X3       SET FILE NAME TO DM*
          MX5    0
          SA6    I
          REWIND I
          SX6    40000B      SET DATA TYPE
          SB5    B1
          RJ     BLO         COPY DM* FILE TO CHKPT FILE
 
*         PROCESS END OF CHECKPOINT.
 
          SX6    50000B      SET END OF CKP
          SA6    A6+
          WRITEW O,BUF,A6-BUF+1
          WRITER O,R
          SA1    CKNO        GET NUMBER OF THIS CHECKPOINT
          RJ     CDD         CONVERT TO DISPLAY CODE
          SA2    CKPA+1
          MX0    -24
          BX7    -X0*X6
          SA1    HDRB        CONTROL WORD FOR LAST WRITE TO CKP FILE
          LX7    24
          MX6    1
          BX7    X7+X2       ADD CHECKPOINT NUMBER TO DAYFILE MESSAGE
          SA7    A2+
          BX6    X1+X6
          WRITEO O
          WRITER O,R
          BKSP   O           BACKSPACE TO BE READY FOR NEXT CHKPT
          SA1    SPPR+1      SET COMPLETION BIT IN PARAMETER TABLE
          MX0    12
          SA2    CKNO        GET NUMBER OF THIS CHECKPOINT
          LX2    48
          BX6    -X0*X1      MASK NEW NUMBER IN RESPONSE
          SX7    B1
          BX6    X6+X7       ADD COMPLETION BIT
          BX6    X6+X2       ADD NEW CHECKPOINT NUMBER
          SA6    A1          RESTORE PARAMETER WORD
          SX6    3
          SA1    =C*CCCCCCO* RETURN CONTROL STATEMENT FILE
          BX6    X1+X6
          SA6    I
          RETURN A6
          MESSAGE CKPA       CHECKPOINT COMPLETE MESSAGE
          ENDRUN
 
 CKPA     DATA   10H CHECKPOIN
          VFD    12/2HT ,24/0,24/4H COM
          DATA   6LPLETE.
 CKPB     DATA   10HPLETED TO   SCRATCH WORD-USED IF ALTERNATE CB FILES
          TITLE  SUBROUTINES
 BLO      SPACE  4
**        BLO - COPY FILE TO CHKPT FILE IN BLOCKED MODE.
*
*         ENTRY  (X6) = DATA TYPE.
*                (X5) = -1 IF COPY TO POSITION.
*                (B5) = 0 IF EMPTY FILE.
*
*         EXIT   FILE IN FET I COPIED TO FILE IN FET O
*
*         CALLS  NONE.
*
*         USES   A - 1, 2, 3, 4, 6, 7.
*                B - 2, 5, 6.
*                X - 1, 2, 3, 4, 6, 7.
*
*         MACROS  READ, READW, RECALL, WRITEW.
 
 
 BLO      SUBR               ENTRY/EXIT
          SA6    REC         STORE DATA TYPE
          ZR     B5,BLO6     IF CONTROL WORD NEEDED FOR EMPTY FILE
          SX7    BLO1        SET ERROR PROCESSING RETURN ADDRESS
          SA7    ERPA
          PL     X5,BLO1     IF NOT COPY TO POSITION
          SA2    I+1         SET RANDOM FILE BIT
          MX1    1
          LX1    60-12
          BX6    X1+X2
          SA6    A2
          BX6    X6-X6
          SA6    I+6         CLEAR RANDOM ADDRESS RETURN
 BLO1     READ   I
          PL     X5,BLO2     IF NOT COPY TO POSITION
          SA1    I+6
          AX1    30
          SA2    I+9
          AX2    12
          IX3    X2-X1
          MX1    -24
          BX3    -X1*X3
          SB5    B0
          PL     X3,BLO2     IF NOT PAST POSITION
          EQ     BLO6
 
 BLO2     SA1    PTR         RETRIEVE BLOCK WORD
          SA2    X1
          MX3    -9
          BX3    -X3*X2
          SA4    REC         SET DATA TYPE
          BX6    X3+X4
          SA6    X1          UPDATE BLOCK WORD
          READW  I,(X1+B1),X3 READ DATA IN AFTER CONTROL WORD
          NZ     X1,BLO3     IF EOR OR EOF
          RECALL I
          WRITEW O,BUF,BUFL
          SX6    777B
          SA6    BUF         RESET BLOCK WORD
          SX7    A6
          SA7    PTR         RESET LOCATION POINTER
          EQ     BLO2        LOOP
 
*         IF END OF RECORD.
 
 BLO3     SA2    PTR         UPDATE POINTERS
          SB5    X2          CONTROL WORD ADDRESS
          SB5    B6-B5       NEW ADDRESS - OLD ONE
          SA4    REC
          SX4    X4+1000B    SET EOR FLAG
          SB5    B5-B1       NUMBER OF WORDS READ
          SX6    X4+B5
          SB2    BUF+777B    END OF BUFFER ADDRESS
          SA6    X2          UPDATE BLOCK WORD
          SX6    B2-B6       NUMBER WORDS LEFT IN BUF
          NG     X1,BLO4     IF EOF OR EOI
          SA6    B6
          SX7    A6          CURRENT POSITION
          SA7    PTR         UPDATE LOCATION POINTER
          NZ     X6,BLO1     IF NOT END OF BUFFER
          WRITEW O,BUF,BUFL-1
          SX6    777B
          SA6    BUF         RESET BLOCK WORD
          EQ     BLO5        LOOP
 
*         IF END OF FILE.
 
 BLO4     SA1    PTR
          SA2    X1          RETRIEVE BLOCK WORD
          SX6    X2+1000B    SET EOF FLAG
          SA4    I
          LX4    59-9
          SA6    X1
          NG     X4,BLO6     IF EOI
          SX6    B2-B6
          SA6    B6          SET NEW BLOCK WORD
          NZ     X6,BLO5     IF NOT AT END
          WRITEW O,BUF,BUFL-1
          SX6    777B
          SA6    BUF         RESET BLOCK WORD
 BLO5     SX7    A6
          SA7    PTR         RESET LOCATION POINTER
          EQ     BLO1        LOOP
 
*         IF EOI.
 
 BLO6     SA1    PTR
          SA3    REC         GET DATA TYPE
          SX6    X3+3000B    SET EOI FLAG
          SX6    X6+B5       SET LENGTH OF BLOCK
          SA6    X1
          SB2    A6+B5       ADDRESS OF LAST WORD READ
          SB6    BUF+777B
          SB6    B6-B2       NUMBER WORDS LEFT IN BUF
          SX6    B6-B1
          SA6    B2+B1       SET NEW BLOCK WORD
          NZ     X6,BLO7     IF NOT AT END
          WRITEW O,BUF,BUFL-1
          SX6    777B
          SA6    BUF
 BLO7     SX7    A6
          SA7    PTR         RESET OR UPDATE LOCATION POINTER
 
          SA1    I+1
          MX2    1
          LX2    60-12
          BX7    -X2*X1
          SA7    A1          CLEAR RANDOM PROCESSING BIT
          EQ     BLOX        RETURN
 ERP$     SPACE  4,10
**        ERP$ - TAPE ERROR PROCESSING ROUTINE.
*
*         ENTRY  RETURN ADDRESS SET IN (ERPA).
*
*         EXIT   TO ADDRESS IN (ERPA) IF PARITY OR WRONG PARITY ERROR
*                OTHERWISE ABORT.  ALSO ABORT IF SECOND OCCURRANCE
*                OF WRONG PARITY ERROR.
*
*         USES   A - 1, 2, 3, 6, 7.
*                B - 3.
*                X - 1, 2, 3, 6, 7.
*
*         MACROS  ABORT, MESSAGE, REWIND.
 
 
 ERP$     SX2    37000B
          SA1    I
          BX3    X2*X1
          AX3    9
          SX2    X3-2
          ZR     X2,ERP2     IF PARITY ERROR
          SX3    X2-2
          ZR     X3,ERP3     IF WRONG PARITY
 ERP1     MESSAGE (=C* CHKPT UNABLE TO READ TAPE.*)
          ABORT
 
*         PARITY ERROR PROCESSING.
 
 ERP2     SX2    740777B     CLEAR ERROR RETURN
          SA3    ERPA
          BX6    X2*X1
          SA6    A1
          SB3    X3
          JP     B3          RETURN TO CALLER
 
*         WRONG PARITY PROCESSING.
 
 ERP3     SX3    100000B
          SA2    REC         SET PARITY BIT FOR CONTROL WORD
          BX6    X2+X3
          SA3    ERPA        CHECK IF FIRST ERROR
          SA6    A2
          NG     X3,ERP1     IF SECOND TRY
          MX2    1           FLAG SECOND TRY
          BX7    X2+X3
          SX2    2           TOGGLE PARITY BIT
          SA7    A3
          BX1    X2-X1
          SX2    740777B     CLEAR ERROR CODE RETURNED
          BX6    X2*X1
          SA6    A1
          SB3    X3+
          REWIND A1,R
          JP     B3          RETURN TO CALLER
 
 ERPA     BSS    1           RETURN ADDRESS FOR ERROR PROCESSING
 
 REC      BSSZ   1
 CPF      SPACE  4
**        CPF - COPY FILES.
*
*         ENTRY  NONE.
*
*         EXIT   FILES IN FILE TABLE COPIED TO CHECKPOINT FILE
*                AND REPOSITIONED.
*
*         CALLS  BLO, POF.
*
*         USES   A - 0, 1, 2, 3, 6.
*                B - 5.
*                X - 0, 1, 2, 3, 4, 5, 6.
*
*         MACROS  REWIND.
 
 
 CPF      SUBR               ENTRY/EXIT
          SA0    SBUF-2      SET TABLE ENTRY
 CPF1     MX3    -12
          SB5    B0          PRESET EMPTY FILE FLAG
          SA0    A0+2
          SA1    A0          GET TABLE ENTRY
          SA2    A1+B1
          ZR     X1,CPFX     RETURN IF END OF TABLE
          SX5    B1+B1       PRESET COPY TYPE
          MX0    42
          BX7    X1
          BX6    X6-X6
          SA6    I+7
          SA7    A6+B1       SAVE FNT
          BX6    X2
          SA6    A7+B1       SAVE FST
          MX4    -24
          LX4    12
          BX4    -X4*X2      ISOLATE RANDOM ADDRESS
          BX3    X4
          ZR     X4,CPF2     IF EMPTY FILE
          SA4    =C*CCCCCCO*
          BX4    X4-X1
          BX6    X0*X4
          SX3    3           SET DEFAULT OF BINARY
          ZR     X6,CPF3     IF CONTROL STATEMENT FILE
 CPF2     MX5    -3
          BX4    X2
          AX4    9
          BX5    -X5*X4
          SX4    X5-4
          ZR     X4,CPF1     IF NO COPY
          ZR     X3,CPF4     IF EMPTY BUT COPY TYPE ALREADY SPECIFIED
 CPF3     BX4    X0*X1       SET NAME AND STATUS IF FET
          BX6    X4+X3
          SA6    I
          SX5    X5-1
          SB5    B1          CLEAR EMPTY FILE FLAG
          ZR     X5,CPF4     IF NO REWIND REQUIRED
          REWIND I,R
 CPF4     SX6    30000B      SET DATA TYPE
          RJ     BLO         COPY FILE IN BLOCKED MODE
          REWIND I,R
          RJ     POF         POSITION FILE
          EQ     CPF1        LOOP
 HDR      SPACE  4
**        HDR - WRITE HEADER.
*
*         ENTRY  NONE.
*
*         EXIT   HEADER WRITTEN ON CHECKPOINT FILE.
*
*         CALLS  NONE.
*
*         USES   A - 1, 2, 6.
*                X - 1, 2, 6, 7.
*                B - NONE.
*
*         MACROS  GETJN, PDATE, WRITEW.
 
 
 HDR      SUBR               ENTRY/EXIT
          PDATE  I+7         GET DATE AND TIME
          SX6    10002B      SET CODE WORD
          SA6    BUF
          SA2    CKNO        GET CHECKPOINT NUMBER
          SA1    MDFL        GET MODE FLAG
          LX1    12
          BX6    X1+X2
          SA2    I+7
          LX2    18
          BX6    X2+X6
          SA6    A6+B1
          SA6    HDRB        STORE HEADER
          GETJN  BUF+2       GET JSN
          WRITEW O,BUF,3
          SX6    777B
          SA6    BUF
          SX6    A6
          SA6    PTR
          EQ     HDRX        RETURN
 POF      SPACE  4,15
**        POF - POSITION FILE.
*
*         ENTRY  MASS STORAGE FILE REWOUND.
*
*         EXIT   MASS STORAGE FILE REPOSITIONED TO RANDOM INDEX
*                VALUE AT TIME OF CHECKPOINT REQUEST UNLESS AN ERROR
*                OCCURRED.
*
*         USES   X - 0, 1, 4, 6, 7.
*                A - 1, 6.
*                B - 3.
*
*         MACROS EREXIT, MESSAGE, READ.
 
 
 POF      SUBR               ENTRY/EXIT
          SA1    I+9         SET RANDOM ADDRESS
          AX1    12
          MX0    -24
          BX6    -X0*X1
          ZR     X6,POFX     IF NO RANDOM ADDRESS
          SA6    P+6
          SA1    I
          BX6    X1
          SA6    P           SET FILE NAME
          EREXIT POF1
          READ   P,R
          EREXIT 0
          EQ     POFX        RETURN
 
 POF1     MX0    42
          SA1    I
          BX1    X0*X1       FILE NAME
          SX4    1R.
          RJ     SFN         GENERATE BIT MASK FOR FILE NAME
          CX7    X7          NUMBER OF BITS IN FILE NAME
          BX7    -X7
          SB3    X7+54       SHIFT COUNT TO POSITION PERIOD
          LX4    X4,B3
          BX6    X1+X4       INSERT FILE NAME INTO DAYFILE MESSAGE
          SA6    POFA+2
          MESSAGE POFA       * POSITION ERROR ON--XXXXXXX.*
          EREXIT 0
          EQ     POFX        RETURN
 
 POFA     DATA   C* POSITION ERROR ON--XXXXXXX.*
 RDA      SPACE  4
**        RDA - READ DATA.
*         PROCESSES CALLS TO READ WORDS (RDW=).
*         DEBLOCKS DATA IF CONTROL WORD READS.
*
*         ENTRY  B6 = BUFFER ADDRESS.
*                B7 = NUMBER OF WORDS NEEDED.
*                X0 = BLOCK COUNT.
*                X2 = FET ADDRESS.
*
*         EXIT   FET-2 CONTAINS NUMBER OF WORDS REMAINING IF BUFFER
*                FILLED.
*                XO = BLOCK COUNT (UPDATED).
*                X1 = -2 IF EOI.
*
*         CALLS  RDW=.
*
*         USES   A - 1, 3, 6, 7.
*                B - 5, 6, 7.
*                X - 0, 1, 4, 6, 7.
 
 
 RDA5     SX6    B5-B7       UPDATE WORDS REMAINING
          SA6    A1
 
          RJ     RDW=        READ WORDS
 RDA      PS                 ENTRY/EXIT
 RDA1     SA1    X2-2        GET NUMBER OF WORDS BEFORE CONTROL WORD
          SB5    X1+
          PL     X1,RDA2     IF NOT FIRST READ
          SX7    B7+         SET WORDS NEEDED
          SA7    RDAA
          JP     RDA4
 
 RDA2     GE     B5,B7,RDA5  IF ENOUGH DATA TO FILL BUFFER
          SA3    X2-1        CHECK EOR FLAG
          PL     X3,RDA3     IF NOT EOR ON FILE
          MX6    1           SET NEW READ FLAG
          SB7    B5+B1       SET WORDS TO READ
          SA6    A3
          SA6    A1
          RJ     RDW=        READ WORDS
          SX1    B6-B1       SET EOR INDICATION
          SB6    B6-B1       BACK UP LWA TO ALLOW FOR CONTROL WORD
          JP     RDA         RETURN
 
 RDA3     SX6    B7-B5       SAVE ADDITIONAL WORDS NEEDED
          SA6    RDAA
          SB7    B5+B1       SET WORDS TO TRANSFER
          RJ     RDW=        READ WORDS
          SB6    B6-B1       BACK UP OVER LAST CONTROL WORD
 RDA4     SB7    B1          READ CONTROL WORD
          RJ     RDW=
          NG     X1,RDA      IF EOF/EOI
          SB6    B6-B1       BACK UP WORKING BUFFER
          SA1    B6          CONTROL WORD
          SX7    5
          SX4    X1+4        ROUND UP
          AX1    36          EXTRACT BLOCK SIZE
          SX3    X1
          IX7    X4/X7       WORDS IN BLOCK
          IX6    X7-X3       SAVE EOR FLAG
          SA7    X2-2        STORE WORD COUNT
          SA6    X2-1        EOR FLAG
          SA1    RDAA        RESET WORDS NEEDED
          SB7    X1
          SX0    X0+B1       INCREMENT BLOCK COUNT
          JP     RDA1        LOOP
 
 RDAA     CON    0
 WRT      SPACE  4
**        WRT - WRITE TABLE.
*
*         ENTRY  NONE.
*
*         EXIT   FILE TABLE WRITTEN ON CHECKPOINT FILE.
*
*         USES   X - ALL.
*                A - ALL.
*                B - 2, 5.
*
*         MACROS ABORT, MESSAGE, MOVE, WRITEO, WRITEW.
 
 
 WRT      SUBR               ENTRY/EXIT
          MX0    42
          SX6    20000B      SET DATA TYPE
          SA6    REC
          SA5    BUF         SET BUFFER ADDRESS
          SB2    B1+B1
 
*         SEARCH FILE LIST.
 
          SA0    SBUF-1      SET FNT TABLE ADDRESS
 WRT1     SA0    A0+B2
          SA1    A0
          ZR     X1,WRT15    IF END OF FNT TABLE
          MX6    -2          SET FILE TYPE INDICATOR TO ZERO IF TAPE
          BX3    X1
          AX3    13
          BX3    -X6*X3
          SB3    X3-1
          SA3    =C*CCCCCCO*
          BX2    X1-X3
          BX2    X0*X2
          NZ     X2,WRT1.1   IF NOT CONTROL STATEMENT FILE
          SA2    CSFP        GET CONTROL STATEMENT FILE POSITION
          MX6    -6          SAVE WORD COUNT
          BX6    -X6*X2
          BX6    X6+X3
          MX3    -24         SAVE PRU NUMBER
          LX3    6
          BX3    -X3*X2
          LX3    6
          BX7    X3
          SA6    A5          STORE ENTRY
          SA7    A6+B1
          SA5    A5+B2
          EQ     WRT1        LOOP FOR ALL FNT ENTRIES
 
*         CHECK FOR CCL FILES.
 
 WRT1.1   SA3    WRTD        *ZZZZZC0*
          SA4    WRTE        *ZZZZZC2*
          BX7    X0*X1
          IX3    X7-X3
          NG     X3,WRT2     IF NOT CCL FILE
          IX4    X4-X7
          NG     X4,WRT2     IF NOT CCL FILE
          SX7    4
          EQ     B3,WRT7     IF TAPE
          R=     X7,2
          EQ     WRT7        MAKE TABLE ENTRY
 
 WRT2     SA3    PAR         SET FILE LIST ADDRESS
          MX6    -30
          BX3    -X6*X3
          ZR     X3,WRT11    IF NO TABLE
          AX3    12          GET NUMBER OF FILES IN LIST
          SB5    X3
 WRT3     SA3    A3+B1
          BX6    X1-X3
          BX6    X0*X6
          ZR     X6,WRT5     IF FOUND IN LIST
          SB5    B5-B1
          NZ     B5,WRT3     LOOP ALL FILE ENTRIES
          SA3    SPFL        CHECK IF SELECTIVE CHECKPOINT
          ZR     X3,WRT11    IF ALL FILES REQUIRED
          SA3    WRTC        CHECK FOR SYSTEM FILES
 WRT4     BX6    X1-X3
          BX2    X0*X6
          ZR     X2,WRT4.1   IF SYSTEM FILE
          SA3    A3+B1
          NZ     X3,WRT4     LOOP
          BX1    X0*X1
          SA3    WRTF        *ZZCCLAA*
          IX6    X3-X1
          ZR     X6,WRT4.1   IF SPECIAL CCL FILE
          PL     X6,WRT1     IF NOT SPECIAL CCL FILE
          SA3    A3+B1
          IX2    X3-X1
          NG     X2,WRT1     IF NOT SPECIAL CCL FILE
 WRT4.1   NZ     B3,WRT6     IF NOT TAPE
          SX7    4
          EQ     WRT7        STORE IN TABLE
 
 WRT5     SX7    X3          GET COPY TYPE
          AX7    12
          NZ     B3,WRT5.1   IF NOT TAPE
          SX2    X7-4
          ZR     X2,WRT7     IF COPY TYPE IS CORRECT FOR TAPE
          SA3    PGNR
          NZ     X3,WRT4.1   IF CONTROL CARD CALL
 
*         ISSUE WARNING MESSAGE AND FORCE SELECTION OF COPY TYPE 4
*         FOR MAGNETIC TAPE.
 
          SB6    A1+         SAVE FNT ADDRESS
          SB2    1R+
          SB3    WRTB        ASSEMBLY AREA
          SB5    -WRTA
          BX1    X0*X1
          RJ     SNM         SET NAME IN MESSAGE
          MESSAGE  WRTB,3,R
          SA1    B6          RESTORE FNT ENTRY
          R=     B2,2
          SX7    4           FORCE COPY TYPE
          EQ     WRT7        CONTINUE WITH PROCESSING
 
 WRT5.1   SX2    X7-3
          NZ     X2,WRT7     IF NO STATUS CHECK NEEDED
 
*         CHECK STATUS FOR COPY TYPE.
 
 WRT6     SA3    A1+B1       GET FST
          SX7    B0+         SET COPY TYPE
          LX3    59-0
          NG     X3,WRT7     IF FILE WRITTEN
          MX4    -3
          BX4    -X4*X3
          SX3    X4-3
          ZR     X3,WRT7     IF EOI
          SX7    2           SET COPY TYPE
 
*         STORE IN TABLE.
 
 WRT7     SA1    A1          GET FNT/FST
          SA3    A1+B1
          MX2    -4
          BX6    X3
          LX6    -4
          BX4    -X2*X6
          SX4    X4-4
          NZ     X4,WRT8     IF NOT EXECUTE-ONLY
          SX7    4
 WRT8     MX2    -6
          BX4    -X2*X1      EXTRACT FILE STATUS
          SX2    X4-UPST
          ZR     X2,WRT16    IF SECURE FILES
          MX4    -24
          LX4    12
          BX4    -X4*X3
          NZ     X4,WRT10    IF NOT EMPTY FILE
          SX7    4           SET NO COPY
 WRT10    BX6    X1
          MX0    3
          LX7    9
          LX0    11-59
          BX4    -X0*X3
          BX7    X7+X4
          SA6    A5
          MX0    42
          SA7    A6+B1
          SA5    A5+B2       UPDATE LOCATION POINTER
          EQ     WRT1        LOOP ALL FNT ENTRIES
 
 WRT11    SA3    TSSF        CHECK FOR SPECIAL SYSTEM FILES
          MX4    42
 WRT12    BX6    X3-X1
          BX6    X4*X6
          ZR     X6,WRT1     IF SPECIAL SYSTEM FILE
          SA3    A3+B1
          NZ     X3,WRT12    IF NOT END OF TABLE
 
*         CHECK FOR TAPE FILE.
 
          EQ     B3,WRT14    IF TAPE FILE
 
*         CHECK FILE TYPE.
 
 WRT13    MX4    -12         CHECK FILE TYPE
          BX4    -X4*X1
          AX4    6
          SX6    X4-LOFT
          ZR     X6,WRT6     IF LOCAL
          SX6    X4-LIFT
          ZR     X6,WRT14    IF LIBRARY
          SX6    X4-PTFT
          ZR     X6,WRT6     IF PRIMARY TERMINAL
          SX6    X4-QFFT
          ZR     X6,WRT6     IF QUEUE FILE
          SX6    X4-INFT
          ZR     X6,WRT6     IF INPUT FILE
          SX6    X4-PMFT
          NZ     X6,WRT1     LOOP IF NOT DIRECT ACCESS FILE
          BX7    X1          CHECK WRITE LOCKOUT FLAG
          LX7    59-12
          PL     X7,WRT6     IF NOT READ ONLY
          SA3    A1+B1       CHECK FILE MODE
          MX4    -4
          AX3    4
          BX4    -X4*X3
          SX6    X4-10B
          ZR     X6,WRT6     IF READ/UPDATE
          SX6    X4-6
          ZR     X6,WRT6     IF READ/APPEND
          SX6    X4-5
          ZR     X6,WRT6     IF READ/MODIFY
 WRT14    SX7    4           SET COPY TYPE
          EQ     WRT7
 
*         END TABLE.
 
 WRT15    BX6    X6-X6       SET ZERO WORD
          SA6    A5
 
          SA4    REC
          SX5    A6-BUF+1
          BX6    X4+X5
          WRITEO O           WRITE CODE WORD
          WRITEW O,BUF,X5    WRITE TABLE
          MOVE   X5,BUF,SBUF
          SX6    777B        RESET POINTERS
          SA6    BUF
          SX7    A6
          SA7    PTR
          EQ     WRTX        RETURN
 
 WRT16    MESSAGE (=C* SECURE FILES - CHECKPOINT ABORT.*)
          ABORT
 
 WRTA     DATA   C* CONTENTS NOT CHECKPOINTED FOR FILE +++++++.*
 WRTB     BSSZ   5           ASSEMBLY AREA
 
*         LIST OF FILES TO BE CHECKPOINTED.
 
 WRTC     DATA   C*INPUT*
          DATA   C*OUTPUT*
          DATA   C*LGO*
          DATA   C*PUNCH*
          DATA   C*PUNCHB*
          DATA   C*P8*
          DATA   C*CCCCCCO*
          CON    0
 WRTD     DATA   C*ZZZZZC0*
 WRTE     DATA   C*ZZZZZC2*
 WRTF     DATA   C*ZZCCLAA*
          DATA   C*ZZCCLZZ*
 
*         LIST OF FILES NOT TO BE CHECKPOINTED.
 
 TSSF     BSS    0
          VFD    36/6LINPUT*,24/0
          VFD    18/3LDM*,42/0
          VFD    42/7LCCCCCCC,18/0
          CON    0
 COM      SPACE  4
          TITLE  COMMON DECKS AND BUFFERS.
*         COMMON DECKS.
 
 
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCLFM
*CALL     COMCMVE
*CALL     COMCRDO
*CALL     COMCRDW
*CALL     COMCSFN
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMCWTO
*CALL     COMCWTW
 BUF      SPACE  4
*         BUFFER ASSIGNMENTS.
 
 
          USE    BUFFERS
 BUF      EQU    *
 IBUF     EQU    BUF+BUFL
 OBUF     EQU    IBUF+IBUFL
 SBUF     EQU    OBUF+OBUFL
 TBUF     EQU    SBUF+SBUFL
 RFL=     EQU    TBUF+TBUFL
          TITLE  PRESET.
 PRS      SPACE  4
**        PRESET ROUTINE.
*
*         ENTRY  FILE /DM*/ PRESENT.
*
*         EXIT   CHECKPOINT FILE POSITIONED.
*                FILE LIST IN PAR.
*                FNT LIST IN SBUF.
*                CONTROL STATEMENT FILE ATTACHED.
*                CHECKPOINTED NUMBER INCREMENTED.
*
*         CALLS  VAL.
*
*         USES   A - 1, 2, 3, 4, 5, 6, 7.
*                B - 1, 2, 4.
*                X - ALL.
*
*         MACROS  ABORT, ACCSF, BKSP, BKSPRU, DISTC,
*                 GETFNT, MESSAGE, MOVE, READ, READO,
*                 READW, REWIND, SETFS, SKIPEI, STATUS,
*                 WRITEO, WRITEW.
 
 
          ORG    BUF+1
 PRS       SUBR               ENTRY/EXIT
          SB1    1
          SA1    JOPR        CHECK JOB ORIGIN TYPE
          AX1    24
          SX2    X1-TXOT
          NZ     X2,PRS1     IF NOT TXOT ORIGIN TYPE
          DISTC  ON,TICF     SET DISABLE TERMINAL CONTROL
 PRS1     SA1    PGNR        CHECK FOR CONTROL CARD CALL
          NZ     X1,PRS2     IF CONTROL CARD
          SA4    SPPR
          MX0    -18
          BX5    -X0*X4
          ZR     X5,PRS4     IF NO LIST ADDRESS
          MOVE   20B,(SPPR+1),PAR      GET LIST
          SA1    SPPR
          AX1    18
          SX6    X1
          SA6    SPFL        SET SELECTIVE CHECKPOINT
          SA1    PAR
          AX1    12
          SX1    X1-20B
          NG     X1,PRS4     IF CONTAINS ENTIRE LIST
 
*         GET FILE LIST FROM DM* FILE SINCE TOO LONG FOR CONTROL PT AREA
 
          SA3    =C/DM*/
          SX4    3
          BX6    X3+X4
          SA6    I
          READ   I
          READW  I,PAR,100B
          SA1    PAR+20B
          MX0    -12
          BX0    -X0*X1
          SB2    6           SET SHIFT COUNT
          AX4    B2,X5
          IX0    X0-X4       GET PRU,S TO BACKSPACE
          SKIPEI I
          BKSPRU I,X0,R
          MX0    -6
          BX5    -X0*X5
          SA1    I+1         SET IN = OUT = FIRST
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          READ   I
          READW  I,PAR,X5
 
*         READ LIST INTO PAR.
 
          READW  I,PAR,100B  (ONLY 77B FILES ALLOWED)
          REWIND I
          EQ     PRS4        REQUEST CHECKPOINT
 
*         PROCESS CONTROL CARD CALL.
 
*         CREATE LIST.
 
 PRS2     SA1    ACTR
          SB4    X1
          SX6    X1
          ZR     B4,PRS4     IF NO ARGUMENTS
          LX6    12
          SA6    SPFL        SET SELECTIVE CHECKPOINT FLAG
          SA6    PAR         SET NUMBER OF FILES
          SA1    ARGR        GET FIRST FILE NAME
          SX3    30000B      SET COPY TYPE
 PRS3     BX6    X1+X3
          SA6    A6+B1
          SB4    B4-B1
          SA1    A1+B1       GET NEXT FILE
          NZ     B4,PRS3     IF MORE FILES, LOOP
 
 PRS4     MESSAGE (=C* CKP REQUEST.*)
          SA1    SPFL
          ZR     X1,PRS5     IF NOT SELECTIVE CHECKPOINT
          SA3    PAR         SET FILE LIST ADDRESS
          SX6    X3
          SA6    A1
 PRS5     SX6    777B        PRESET POINTERS
          SA6    BUF
          SX7    A6+
          SA7    PTR
 
*         GET CONTROL STATEMENT FILE.
 
          SX6    3
          SA5    =C*CCCCCCO*
          BX6    X5+X6
          SA6    I           SET NAME IN FET
          STATUS I
          SA1    I
          SX1    X1-1
          NZ     X1,PRS6     IF ALREADY PRESENT
          ACCSF  I,CSFP,LOCK ATTACH FILE WITH POSITION RETURNED
 
*         GET LIST OF ALL FILES.
 
 PRS6     SX6    B0          SET INITIAL CALL
          SA6    SBUF
          SA1    PRSC
          BX6    X1
          SA6    I+8
          GETFNT I
          SA1    SBUF
          NZ     X1,PRS7     IF NOT ALL FILES RETURNED
          SA1    I+8
          PL     X1,PRS8     IF NO ERROR
 PRS7     MESSAGE  (=C* ERROR - FILE(S) NOT PROCESSED.*)
 
*         PROCESS CHECKPOINT FILE(S).
 
 PRS8     SA1    I+9
          ZR     X1,PRS16    IF NO CHECKPOINT FILE
          NG     X1,PRS17    IF MORE THAN TWO FILES
          SX3    3
          SA2    A1+1        FST ENTRY FOR FILE O
          MX0    42
          BX4    X0*X1
          BX6    X4+X3
          SA6    O           PUT CHECKPOINT FILE NAME IN FET
          MX7    -6
          BX6    -X7*X1
          SA6    MDFL        SAVE MODE OF FILE (CB OR CK)
          MX3    -24
          AX2    12
          BX0    -X3*X2      SAVE RANDOM INDEX OR BLOCK NUMBER
          SA1    A2+B1
          ZR     X1,PRS10    IF NO ALTERNATE FILE
          SA2    A1+1        ALTERNATE FILE FST ENTRY
          BX4    -X7*X1
          SX7    X4-CKST
          ZR     X7,PRS17    IF CK FILE AMONG ALTERNATE FILES
          BX6    X4-X6
          MX4    42
          NZ     X6,PRS17    IF CK FILE AMONG ALTERNATE FILES
          SX6    3
          BX4    X4*X1
          BX7    X6+X4
          SA7    I           SET ALTERNATE FILE NAME IN SCRATCH FET
          SX6    77B
          SA6    MDFL        SET MODE FLAG FOR ALTERNATE FILES
          AX2    12
          BX6    -X3*X2
          ZR     X6,PRS9     IF ALTERNATE FILE EMPTY AND LOCAL
          SX6    X6-1
          ZR     X6,PRS10    IF ALTERNATE FILE EMPTY OR REWOUND
          READ   I
          READO  I
          NG     X1,PRS10    IF EOF/EOI - NO DATA ON FILE
          PL     X6,PRS10    IF NOT CODE WORD CANT BE CHECKPOINT FILE
          SA6    PRSA        SAVE CODE WORD
          BKSP   I,R
          SA1    X2+B1       SET IN = OUT = FIRST
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          EQ     PRS10       DO NOT REWIND *I*
 
*         THE REWIND ON *I* TAKES PLACE TO ENSURE THE FILE IS
*         POSITIONED AT BOI.  THIS IS NECESSARY FOR TAPE
*         FILES ON WHICH AN OPEN/WRITE WAS JUST PERFORMED.
 
 PRS9     REWIND I           POSITION CHECKPOINT FILE TO BOI
 PRS10    ZR     X0,PRS14    IF CHECKPOINT FILE EMPTY AND LOCAL
          SX6    X0-1
          ZR     X6,PRS15    IF CHECKPOINT FILE EMPTY OR REWOUND
          READ   O
          READO  O
          NG     X1,PRS15    IF EOF/EOI - NO DATA ON FILE
          PL     X6,PRS14    IF CHECKPOINT FILE MISPOSITIONED
          SA6    PRSB        SAVE CODE WORD
          BKSP   O,R
          SA1    X2+B1       SET IN = OUT = FIRST
          SX7    X1
          SA7    A1+B1
          SA7    A7+B1
          SA5    PRSB        RETRIEVE CODE WORD
          MX0    -12
          SA1    MDFL
          SX1    X1-77B
          BX5    -X0*X5
          NZ     X1,PRS12    IF NO ALTERNATE FILE
          SX4    X5
          SA5    PRSA
          BX5    -X0*X5
          IX7    X4-X5       COMPARE CHECKPOINT NUMBERS
          NG     X7,PRS11    IF NO NEED TO SWITCH FILES
          SA2    O           SWITCH FILE NAMES
          SX5    X4
          SA1    I
          BX6    X1
          SA6    O
          BX6    X2
          SA6    A1
 PRS11    MX3    42
          SA1    O           FILE NAME
          BX1    X3*X1
          SX4    1R.
          RJ     SFN         GENERATE BIT MASK FOR FILE NAME
          CX7    X7          NUMBER OF BITS IN FILE NAME
          SA2    CKPB
          BX7    -X7
          SB3    X7+54       SHIFT COUNT TO POSITION PERIOD
          BX7    X2
          LX4    X4,B3
          SA7    A2-1        GENERATE DAYFILE MESSAGE
          BX6    X1+X4
          SA6    A2
 PRS12    SX6    X5+B1       INCREMENT CHECKPOINT NUMBER
          LX6    47
          PL     X6,PRS13    IF CHECKPOINT NUMBER LIMIT NOT REACHED
          MX6    1
          LX6    -12
 PRS13    LX6    -47
          BX1    X6
          SA6    CKNO        SAVE CHECKPOINT NUMBER
          RJ     VAL         VALIDATE ACCESS LEVEL
          READ   O
          READO  O
          BX5    X6
          BKSP   O
          MX0    -59
          BX6    -X0*X5      CLEAR LAST CHECKPOINT FLAG
          WRITEO  O
          WRITER  O,R
          SA1    MDFL        CHECK MODE FLAG
          SX1    X1-CKST
          ZR     X1,PRSX     IF CK FILE, CONTINUE CHECKPOINT AT EOI
          REWIND O           WRITE OVER NEXT TO LAST CHECKPOINT FILE
          EQ     PRSX        RETURN
 
 PRS14    REWIND O
 PRS15    SA1    MDFL        MODE FLAG
          SX1    X1-CKST     CHECK FOR CK ON 1 CB FILE
          ZR     X1,PRS16.1  IF CK TYPE FILE
          NG     X1,PRS16.1  IF ONLY 1 CB FILE
          SA1    PRSA
          SA2    A1+B1
          BX1    X1+X2       CHECK IF EITHER FILE HAS BEEN USED
          ZR     X1,PRS11    IF NEITHER FILE HAS BEEN USED
          SX5    1           SET CHECKPOINT NUMBER TWO
          JP     PRS11       LOOP
 
 PRS16    SETFS  O,CKST      SET FILE CCCCCCC STATUS TO CK
 PRS16.1  RJ     VAL         VALIDATE ACCESS LEVEL
          EQ     PRSX
 
 PRS17    MESSAGE (=C* CHECKPOINT FILE ERROR.*)
          ABORT
 
 PRSA     BSSZ   1           TEMPORARY STORAGE FOR FILE I
 PRSB     BSSZ   1           TEMPORARY STORAGE FOR FILE O
 PRSC     VFD    38/0,1/1,3/0,18/SBUF  *GETFNT* CONTROL WORD
 VAL      SPACE  4,15
**        VAL - VALIDATE ACCESS LEVEL.
*
*         ENTRY  CHECKPOINT FILE CREATED AND NAME IN FET.
*
*         EXIT   ABORT, IF SECURE SYSTEM AND CHECKPOINT
*                FILE ACCESS LEVEL IS NOT JOB ACCESS LEVEL
*                LIMIT.
*
*         USES   X - 0, 1, 3, 6, 7.
*                A - 1, 7.
*
*         MACROS ABORT, GETJAL, GETSSL, MESSAGE, STATUS.
 
 
 VAL      SUBR               ENTRY/EXIT
          GETSSL VALA        GET SYSTEM SECURITY MODE
          SA1    VALA
          MX0    -3
          LX1    12
          BX6    -X0*X1
          ZR     X6,VALX     IF NOT SECURE SYSTEM
          GETJAL VALA        GET JOB ACCESS LEVEL LIMIT
          SA1    VALA
          LX1    -6
          BX3    -X0*X1
          SX6    B1          SET SECURITY PROCESSING BIT
          LX6    39-0
          SA1    O+1
          BX7    X1+X6
          SA7    A1
          STATUS O,P         GET FILE ACCESS LEVEL
          SA1    O+4
          LX1    -36
          BX2    -X0*X1
          IX6    X2-X3
          ZR     X6,VALX     IF ACCESS LEVELS ARE EQUAL
          MESSAGE (=C* CHECKPOINT FILE ACCESS LEVEL ERROR.*)
          ABORT
 
 VALA     CON    0           REPLY WORD
          SPACE  4,10
          ERRNG  IBUF-*+1
 
          END