Retro1.org codex

          IDENT  RESTART,FETS
          ABS
          SST
          SYSCOM B1
          ENTRY  RESTART
          ENTRY  LIB=
          ENTRY  DMP=
          ENTRY  RFL=
          ENTRY  SSJ=
          TITLE  RESTART - RESTART CHECKPOINTED JOB.
*COMMENT  RESTART - RESTART CHECKPOINTED JOB.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4
***       RESTART - RESTARTS A JOB FROM INFORMATION ON A
*                   CHECKPOINT FILE.
*         V.A. WALSH. 72/06/01.
*         K.R. COMBS. 73/06/01.
*         M.S. CARTER. 76/06/01.
          SPACE  4
***       CONTROL CARD FORMAT -
*
*         RESTART(FILE,N,RI,NA,FC)
*                *FILE* = FILENAME OF CHECKPOINT FILE.
*                *N*    = NUMBER OF CHECKPOINT TO USE. IF N=*, THE
*                         LAST CHECKPOINT ON THE FILE WILL BE USED.
*                         IF NOT PRESENT, SYSTEM ASSUMES 1.
*                *RI*   = REPLACE INPUT OPTION. IF PRESENT, THE INPUT
*                         FILE OF THE CHECKPOINT JOB WONT BE RESTORED.
*                *NA*   = NO ABORT OPTION. IF PRESENT, RESTART WILL
*                         NOT ABORT IF ALL FILES NEEDED ARE NOT PRESENT.
*                         IF A PARITY ERROR IS ENCOUNTERED, CHECKPOINT
*                         N-1 WILL BE RESTARTED IF AVAILABLE.
*                *FC*   = FILE CHECK OPTION. IF SET, RESTART WILL
*                         CHECK IF FILE IS PRESENT AND WILL NOT
*                         REPLACE THE FILE IF IT IS THERE ALREADY.
          SPACE  4
***       DAYFILE MESSAGES
*
*         * CHECKPOINT NOT FOUND.* = SPECIFIED CHECKPOINT NOT FOUND.
*
*         * CHECKPOINT FILE ERROR.* = ILLEGAL FORMAT ON FILE.
*
*         * ERROR IN ARGUMENTS.* = RESTART PARAMETERS INCORRECT.
*
*         * FILENAM NOT FOUND.* = FILE COULD NOT BE FOUND OR RETRIEVED.
*
*         * FILE ERROR  FILENAM.* = ILLEGAL ADDRESS ON FILE *FILENAM*.
*
*         * JSNN RESTARTED FROM YY/MM/DD. HH.MM.SS.* = JOB WAS
*         RESTARTED FROM CHECKPOINT OF GIVEN DATE.
*
*         * PARITY ERROR - RESTARTED FROM      NN.* = JOB WAS RESTARTED
*         CHECKPOINT NN WHEN ERROR AS ENCOUNTERED.
          SPACE  4
***       CHECKPOINT FILE FORMAT.
*
*T        60/10002B          HEADER
*T        6/0,18/DATE,18/TIME,6/CK,12/CKP NO.
*T        24/JSN,36/0
*
*T        60/20NNNB          FILE TABLE
*
*T        42/FILENAM,3/,2/I,1/W,6/FILE TYPE,6/FILE STATUS
*T        24/FL,24/RB,3/COPY TYPE,1/,4/M,3/RS,1/L
*         .
*         .
*         .
*T        60/0               END OF TABLE
*
*T        60/P30NNNB         FILE COPIES
*
*         FILE 1
*
*T        60/P31NNNB         EOR FLAG
*
*T        60/P33NNNB         EOI FLAG
*
*         FILE 2
*
*T        60/P30NNNB         DATA
*
*T        60/P32000B         EOF FLAG
*
*T        60/P33000B         EOI FLAG
*         .
*         .
*         .
*         FILE N
*
*T        60/P30NNNB         DATA
*
*T        60/P33000B         EOI FLAG
*
*T        60/40NNNB          DUMP FILE
*
*         CONTENTS OF DM*
*
*T        60/50000B          END OF CHECKPOINT FILE
*
*         EOR
*
*         CHECKPOINT CONTROL WORD
*T        6/0,18/DATE,18/TIME,6/CK,12/CKP NO.
*
*         EOR
*
*
*
*         P - PARITY BIT IF CODED FILE.
*         CK - CHECKPOINT MODE
*         NNN - NUMBER OF WORDS IN NEXT BLOCK.
*         M - MODE OF USE ALLOWED.
*         I - TYPE OF FILE.
*         W - SET IF WRITE LOCKOUT.
*         FL - FILE LENGTH (0 IF NOT MS)
*         RB - RANDOM INDEX (IF MS).
*              BLOCK COUNT (IF TAPE).
*         RS - READ STATUS.
*         L - SET IF LAST OPERATION WAS WRITE.
          SPACE  4
*         ASSEMBLY CONSTANTS
 
 BUFL     EQU    1001B
 IBUFL    EQU    2001B
 OBUFL    EQU    4011B
 SBUFL    EQU    401B
 TBUFL    EQU    1003B       LENGTH OF TAPE BUFFER
 LIB=     EQU    0           READ EXECUTE-ONLY FILES
          SPACE  4
**        READX - REDEFINE MACRO TO READ CONTROL WORDS.
*
*         FORMAT READX  F,S,N
*
*                WHERE F = FET ADDRESS.
*                      S = BUFFER ADDRESS.
*                      N = LENGTH OF BUFFER IN WORDS.
 
 
 READX    MACRO  F,S,N
          R= B6,S
          R= B7,N
          R= X2,F
          RJ RDA
          ENDM
 
 
*CALL     COMCMAC
*CALL     COMCCMD
*CALL     COMSLFM
          QUAL   MTX
*CALL     COMSMTX
          QUAL   *
*CALL     COMSPFM
*CALL     COMSSSJ
          TITLE  STORAGE ASSIGNMENT.
          ORG    101B
 FETS     BSS    0
 I        BSS    0
 CCCCCCX  FILEB  IBUF,IBUFL,EPR
          BSS    2
 O        BSS    0
 CCCCCCY  FILEB  OBUF,OBUFL,EPR,(FET=12)
 P        BSS    0
 CCCCCCZ  RFILEB 2,1,(FET=12),EPR
          SPACE  4,10
**        LISTS OF CCL FILE NAMES AND NOS SCRATCH FILE
*         NAMES USED TO TEMPORARILY SAVE CCL FILES WHEN *RI*
*         IS NOT SPECIFIED.  EACH ENTRY IS IN THE FORM -
*
*T        42/FILENAM,17/0,1/P.
*
*         WHERE P = 1 IF THE FILE IS TO BE PROCESSED.
 
 
 CCLF     VFD    42/0LZZZZZC0,17/0,1/1
          VFD    42/0LZZZZZC1,17/0,1/1
          VFD    42/0LZZZZZC2,17/0,1/1
 CCLFL    EQU    *-CCLF
          CON    0           END OF CCL FILES
 SCRF     VFD    42/0LZZZZZG0,17/0,1/0
          VFD    42/0LZZZZZG1,17/0,1/0
          VFD    42/0LZZZZZG2,17/0,1/0
          CON    0           END OF SCRATCH FILES
          SPACE  4
*         PARAMETER FLAG LOCATIONS.
 
 CKNO     CON    1           CHECKPOINT NUMBER
 RIFL     BSSZ   1           REPLACE INPUT FLAG
 NAFL     BSSZ   1           NO ABORT FLAG
 FCFL     BSSZ   1           FILE CHECK FLAG
 DTYP     BSSZ   1           DATA TYPE
 HDRB     BSSZ   1           HEADER STORAGE WORD
 FIID     BSS    1           DATA FILE ID
 
 
*         SPECIAL ENTRY POINTS.
 
 DMP=     EQU    450000B     CREATE EMPTY DUMP FILE
 SSJ=     EQU    SSJD        SSJ= DROP FILES OPTION
          TITLE  MAIN PROGRAM.
**        RESTART - MAIN LOOP.
 
 
 RESTART  RJ     PRS         PRESET PROGRAM
          SB4    CCLF        FWA OF CCL FILE LIST
          SB5    SCRF        FWA OF SCRATCH FILE LIST
          SB3    B0          SELECT RENAME FUNCTION
          RJ     RCC         RENAME/RETURN CCL FILES
          RJ     PRT         PROCESS FILE TABLE
 
          SA1    =C/DM*/     SET UP DM* FILE
          SX3    3
          BX6    X1+X3
          SA6    O
          REWIND O,R
          READO  I
          MX0    -9
          BX0    -X0*X6      GET BLOCK LENGTH
          MX3    -3
          AX6    9
          BX6    -X3*X6      GET BLOCK TYPE FLAG
          SA0    X6          SAVE BLOCK TYPE FLAG
          READW  I,BUF,X0
          SX5    BUF+2
          RJ     IWB         INSURE WORD IN BUFFER
          SA1    X5+
          MX6    30B
          BX6    X6*X1
          AX6    6
          SA6    MEMR
          AX6    30
          SX6    X6-PRS
          PL     X6,RST1     IF FIELD LENGTH BIG ENOUGH FOR RESTART
          SX6    PRS
          LX6    30
          SA6    A6
 RST1     SX5    X5-2+ECSW
          RJ     IWB         INSURE WORD IN BUFFER
          SA2    UESC
          SA1    X5          GET ECS FL/*UEBS*
          SB2    X2+39
          MX6    -12
          BX6    -X6*X1
          LX6    B2          FORM EM FL FOR MEMORY MACRO
          SA6    MEME        STORE ECS FIELD LENGTH
          SA1    RIFL        CHECK FOR *RI*
          ZR     X1,RST2     IF OLD CONTROL STATEMENTS TO BE USED
          GETJCI RSTA        GET CCL PARAMETERS
          SX5    X5-ECSW+JCDW
          RJ     IWB         INSURE WORD IN BUFFER
          SA1    RSTA
          BX6    X1
          SA6    X5
          SX5    X5-JCDW+JCRW
          RJ     IWB         INSURE WORD IN BUFFER
          SA1    RSTA+1
          BX6    X1
          SA6    X5
 RST2     SX6    4           SET UP RETURN JUMP
          SX1    RST3
          LX6    54
          LX1    30
          BX6    X1+X6
          SA6    CPY
          SX6    4           SET START OF (DM*) FILE BLOCK TYPE FLAG
          SA6    DTYP
          EQ     CPY0.5
 
 RST3     REWIND O,R
 
*         POSITION FILE IN CASE OF SUBSEQUENT CHECKPOINT
 
          READO  I           GET TO EOR
          SA1    HDRB        GET HEADER WORD
          BX6    X1
          MX0    1
          BX6    -X0*X6      CLEAR TOP BIT
          BX6    X0+X6       SET TOP BIT TO SHOW LAST CHKPT
          WRITEO I
          WRITER I,R
          BKSP   I,R         POSITION FOR SUBSEQUENT CHECKPOINT
 
          MESSAGE MSGB,,R
 
          MEMORY CM,MEMR,R   GET MEMORY NEEDED FOR RESTARTED JOB
          MEMORY ECS,MEME,R  GET ECS NEEDED FOR RESTARTED JOB
          RECALL O
          LOCK   O,R         LOCK DM* FILE TO INDICATE RESTART COMPLETE
 
*         RETURN SCRATCH FILES IF NEEDED.
 
          SB3    B1+         SELECT RETURN FUNCTION
          SB4    SCRF
          RJ     RCC         RENAME/RETURN CCL FILES
          ENDRUN
 
 RSTA     BSS    2           *GETJCI* PARAMETER RETURN BLOCK
 MEMR     BSS    1           NEEDED FL FROM DM* FILE
 MEME     BSS    1           NEEDED ECS FROM EXCHANGE PACKAGE
 MSGB     DATA   C* ++++ RESTARTED FROM(((((((((())))))))))*
          TITLE  SUBROUTINES
 ERP$     SPACE  4
**        ERP$ -  ERROR PROCESSING ROUTINE.
*
*         ENTRY  TAPE ERROR.
*
*         EXIT   ABORT IF FIRST CHECKPOINT
*                RESTART RESTART AT PREVIOUS CHECKPOINT.
*
*         CALLS  NONE.
*
*         USES   A - 2,7.
*                B - NONE.
*                X - 2,3,7.
 
 
 ERP$     SA2    NAFL
          ZR     X2,CPY5     IF ABORT SET
          SA2    CKNO
          SX7    X2-1
          ZR     X2,CPY5     ABORT
          SA7    CKNO
          SA7    MSGE+3
          SKIPB  I,3         POSITION TO N-1
          SA2    I
          MX3    -3
          AX2    3
          SX2    X2-5
          BX3    -X3*X2
          ZR     X2,CPY5     ABORT
          MESSAGE MSGE,,R
          EQ     PRS4        START AGAIN
 
 MSGE     DATA   C* PARITY ERROR - RESTARTED FROM        NN.*
 CPY      SPACE  4,15
**        CPY - COPY FILE.
*
*         ENTRY  FILE NAME SET IN FET I.
*                (X6) = DATA TYPE.
*
*         EXIT   FILE WRITTEN FROM FET O.
*
*         USES   A - 0, 1, 2, 3, 4, 6, 7.
*                X - 0, 1, 2, 3, 4, 6, 7.
*                B - ALL.
*
*         CALLS  RCC.
*
*         MACROS ABORT, MESSAGE, RECALL, READO, READW, WRITEF, WRITEF,
*                WRITEW.
 
 
 CPY      SUBR               ENTRY/EXIT
          SA6    DTYP        SAVE DATA TYPE
 CPY0     READO  I
          MX0    -9
          BX0    -X0*X6      GET BLOCK LENGTH
          SA1    DTYP        CHECK FOR VALID BLOCK TYPE
          MX3    -3
          AX6    9
          BX4    -X3*X6      GET BLOCK TYPE FLAG
          AX6    3
          SA0    X4
          BX4    -X3*X6      DATA TYPE
          BX2    X3*X6       PARITY BIT
          BX4    X4-X1
          NZ     X4,CPY4     IF ILLEGAL DATA TYPE
          ZR     X2,CPY0.1   IF NO CHANGE (BINARY)
          RECALL O
          SA1    O
          SX2    B1
          BX6    X3*X1
          BX6    X6+X2
          SA6    A1
 CPY0.1   ZR     X0,CPY1     IF NO DATA
          READW  I,BUF,X0
 CPY0.5   WRITEW O,BUF,X0
          SX6    A0          CHECK BLOCK TYPE FLAG
          ZR     X6,CPY0     IF NOT EOR
 CPY1     SB2    A0-B1       CHECK BLOCK TYPE FLAG
          NZ     B2,CPY2     IF NOT EOR
          WRITER O,R
          EQ     CPY0        LOOP TIL END OF RECORD
 
*         IF END OF FILE.
 
 CPY2     SX6    A0-2        CHECK BLOCK TYPE FLAG
          ZR     X6,CPY3     IF EOF
          WRITE  O,R
          SA1    O+2
          SA2    A1+B1
          IX2    X1-X2
          SX2    X2
          ZR     X2,CPYX     IF NO DATA
 CPY3     WRITEF O,R
          SX6    A0-3        CHECK BLOCK TYPE FLAG
          ZR     X6,CPYX     IF EOI
          EQ     CPY0        LOOP TIL END OF INFORMATION
 
 CPY4     MESSAGE (=C* CHECKPOINT FILE ERROR.*)
 CPY5     SB4    SCRF        FWA OF SCRATCH FILE LIST
          SB5    CCLF        FWA OF CCL FILE LIST
          SB3    B0          SELECT RENAME FUNCTION
          RJ     RCC         RENAME/RETURN CCL FILES
          ABORT
 IWB      SPACE  4,15
**        IWB - INSURE WORD IN BUFFER.
*
*         IWB INSURES THAT THE DESIRED WORD IS ACTUALLY IN THE
*         BUFFER.  IF IT IS NOT IN THE PRESENT BLOCK, THEN THE
*         PRESENT BLOCK IS COPIED AND THE NEXT BLOCK IS OBTAINED.
*
*         ENTRY  (X0) = NUMBER OF WORDS IN BLOCK TO BE WRITTEN.
*                (X5) = BUF + DESIRED WORD.
*                (A0) = BLOCK TYPE.
*
*         EXIT   (X0) = NUMBER OF WORDS IN NEW BLOCK.
*                (X5) = LOCATION OF DESIRED WORD.
*                (A0) = NEW BLOCK TYPE IF DATA TRANSFERED.
*
*         USES   X - 0, 2, 3, 4, 5, 6.
*
*         MACROS READO, READW, WRITEW.
 
 
 IWB      SUBR               ENTRY/EXIT
          SX2    X5-BUF+1
          IX2    X0-X2
          PL     X2,IWBX     IF WORD IN BUFFER
          IX5    X5-X0
          WRITEW O,BUF,X0
          READO  I
          MX0    -9          GET BLOCK LENGTH
          BX0    -X0*X6
          MX3    -3          GET BLOCK TYPE
          AX6    9
          BX4    -X3*X6      BLOCK TYPE
          AX6    3
          SA0    X4
          BX4    -X3*X6      DATA TYPE
          SX4    X4-4
          NZ     X4,CPY4     IF INCORRECT DATA TYPE
          ZR     X0,CPY4     IF -DM*- FILE TOO SHORT
          READW  I,BUF,X0
          EQ     IWBX        RETURN
 PSF      SPACE  4,15
**        PSF - POSITION FILE.
*
*         ENTRY  FILE NAME IN FETS O AND P.
*                USES FET P FOR DISK FILES, POSITIONING BY RANDOM ADDR.
*                USED FET O FOR TAPE FILES, POSITIONING BY CONTROL WORD.
*
*         CALLS  NONE.
*
*         EXIT   FILE POSITIONED.
*
*         USES   A - 0, 1, 2, 3, 4, 6.
*                X - ALL.
*
*         MACROS BKSPRU, FILINFO, MESSAGE, READ, READCW, READX, RECALL,
*                REWIND, SKIPF.
 
 
 PSF9     REWIND P           POSITION FOR COPY TYPE 1
 
 PSF      SUBR               ENTRY/EXIT
          RECALL O
          RECALL P
 
          SA1    O
          AX1    10
          MX3    -4
          BX4    -X3*X1
          NZ     X4,PRT16    IF ERROR
 
          SA1    P
          AX1    10
          BX4    -X3*X1
          NZ     X4,PRT16    IF ERROR
 
          SA1    O+9
          MX0    -3
          LX1    2-11
          BX3    -X0*X1
          SX3    X3-1
          ZR     X3,PSF9     IF COPY TYPE 1
 
          SA1    O+8
          AX1    13
          MX3    -2
          BX4    -X3*X1
          SX2    X4-1
          ZR     X2,PSF3     IF TAPE FILE
          SX4    X4-2
          ZR     X4,PSFX     IF TTY FILE
 
*         POSITION MASS STORAGE.
 
          REWIND P,R
          SA1    O+9         SET RANDOM ADDRESS
          AX1    12
          MX3    -24
          BX6    -X3*X1
          SX1    B1+
          IX1    X6-X1       ACCOUNT FOR RANDOM POSITIONING
          ZR     X1,PSFX     IF BOI DESIRED
 PSF1     SA6    P+6
          READ   P,R         DO RANDOM READ
          SA1    P
          AX1    10
          MX0    -4
          BX0    -X0*X1
          ZR     X0,PSFX     IF NO ERROR OCCURRED
 
*         DISPLAY ERROR MESSAGE
 
 PSF2     SA1    O
          MX0    42
          BX6    X0*X1       ISOLATE FILE NAME
          SA1    MSGD+1
          MX0    12
          BX1    X0*X1
          LX6    -18
          BX6    X1+X6       MASK INTO MESSAGE
          SA6    A1
          MESSAGE MSGD
          EQ     PSFX        RETURN
 
*         POSITION TAPES.
 
 PSF3     REWIND O,R
          SA1    O+9         GET BLOCK COUNT
          AX1    12
          MX3    -24
          BX5    -X3*X1      DESIRED BLOCK COUNT
          ZR     X5,PSFX     IF REWOUND
          MX0    42          FORMAT *FILINFO* REQUEST
          SA1    O           FILE NAME
          SX2    PSFAL*10000B+1  LENGTH AND COMPLETE BIT
          BX6    X0*X1
          BX6    X6+X2
          SA6    PSFA
          FILINFO  PSFA      GET TAPE FORMAT
          SA1    PSFA+5
          AX1    6
          SX7    X1-/MTX/TFF
          PL     X7,PSF8     IF *F*, *S* OR *L* TAPE FORMAT
 
*         PROCESS *I* AND *SI* FORMAT TAPES.
 
          SX0    B0+         PRESET BLOCK COUNT
 PSF3.1   MX6    1           SET FIRST READ
          SA6    O-2
          READCW O
 PSF4     READX  O,TBUF,TBUFL
          SX1    X1+2
          ZR     X1,PSFX     IF EOI
          IX3    X0-X5
          PL     X3,PSF4.1   IF AT POSITION
          SX1    X1-1
          ZR     X1,PSF3.1   IF EOF
          EQ     PSF4
 
 PSF4.1   RECALL O
          SA1    O           CHECK STATUS IN FET
          LX1    59-9
          NG     X1,PSFX     IF END OF INFORMATION
          SA1    O+2         GET IN
          SA2    A1+1        GET OUT
          IX3    X1-X2       IN-OUT
          SA4    A1-B1       GET FIRST
          SX4    X4
          IX4    X1-X4       IN-FIRST
          ZR     X3,PSFX     IF EMPTY BUFFER
          PL     X3,PSF4.2   IF IN .GE. OUT
          SA3    A2+1
          SX3    X3+
          IX3    X3-X2       LIMIT-OUT
          IX3    X4+X3       NUMBER OF WORDS IN BUFFER
 PSF4.2   SA1    O-2
          NG     X1,PSF5     IF AT END OF CURRENT BLOCK
          SX2    X2+B1
          SX4    B1+
          IX3    X3-X4
          ZR     X1,PSF5     IF NO MORE WORDS IN CURRENT BLOCK
          IX6    X3-X1
          BX7    X1
          ZR     X6,PSFX     IF AT POSITION
          EQ     PSF5.1      COMPUTE NEXT OUT
 
 PSF5     SA1    X2+         GET NEXT CONTROL WORD
          SX7    5
          SX4    X1+16B      ACCOUNT FOR CONTROL WORDS AND EXTRA BYTES
          IX7    X4/X7       GET NUMBER OF WORDS IN BLOCK
          IX6    X3-X7       COMPARE TO NUMBER OF WORDS IN BUFFER
          SX0    X0+B1       INCREMENT BLOCK COUNT
          ZR     X6,PSF6     IF 1 BLOCK
 PSF5.1   SX3    X6          WORDS BEYOND BLOCK
          IX2    X2+X7       NEW OUT (NEXT CONTROL WORD)
          SA1    O+4
          SX1    X1
          IX1    X2-X1       COMPARE TO LIMIT
          NG     X1,PSF5     IF NO END AROUND
          SA2    A4          GET FIRST
          SX2    X2+
          IX2    X2+X1       SET NEW OUT
          EQ     PSF5
 
 PSF6     IX3    X0-X5
          ZR     X3,PSFX     IF AT POSITION
          BKSPRU O,X3,R
 PSF7     SA1    O           CHECK FOR ERROR
          MX0    -4
          AX1    10
          BX0    -X0*X1
          NZ     X0,PSF2     IF ERROR ON I/O
          EQ     PSFX        RETURN
 
*         PROCESS *F*, *S* AND *L* FORMAT TAPES.
 
 PSF8     SKIPF  O,X5,R
          EQ     PSF7        CHECK FOR ERROR
 
 PSFA     BSSZ   5           STANDARD *FILINFO* PARAMETER BLOCK
          VFD    48/0,6/0,6/FMTK  TAPE FORMAT
 PSFAL    EQU    *-PSFA      LENGTH OF PARAMETER BLOCK
 MSGD     DATA   C* FILE ERROR         .*
          DATA   0
 PRT      SPACE  4,15
**        PRT - PROCESS FILE TABLE.
*
*         EXIT   ALL FILES IN THE FILE TABLE ARE RECOVERED FROM
*                THE CHECKPOINT FILE.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 2.
*
*         CALLS  CPY, PSF, SFN, SMD.
*
*         MACROS ASSIGN, ATTACH, ENCSF, GET, MESSAGE, READO, READW,
*                RETURN, REWIND, SETFS, STATUS.
 
 
 PRT      SUBR               ENTRY/EXIT
          READO  I           READ FILE TABLE HEADER
          MX0    -9
          BX4    -X0*X6      GET LENGTH
          AX6    12
          SX3    X6-2
          NZ     X3,CPY4     IF WRONG DATA TYPE
          READW  I,SBUF,X4   READ FILE TABLE
 
          SA5    SBUF-2
 PRT0     SA5    A5+2        GET FIRST WORD TABLE ENTRY
          ZR     X5,PRT17    IF END OF TABLE
          SX7    3           DEFAULT ID BINARY FILE
          MX0    42
          BX6    X0*X5       ISOLATE FILE NAME
          BX6    X6+X7
          SA6    P           SET FILENAME IN FET
          SB2    B0          CLEAR CCL FILE FLAG
          SA6    O           SET FILENAME IN FET
          SA2    A5+B1       GET WORD 2 OF TABLE ENTRY
          BX6    X5
          BX7    X2
          SA6    O+8         PLACE FNT ENTRY IN FET
          SA7    A6+B1       PLACE FST ENTRY IN FET
          SA1    =C*CCCCCCO*
          BX3    X1-X5
          BX3    X0*X3
          NZ     X3,PRT1     IF NOT *CCCCCCO*
          SA1    RIFL        CHECK FOR RI PARAMETER
          NZ     X1,PRT10    IF NEW FILE WANTED
          MX0    -6          CONSTRUCT *ENCSF* CALL WORD
          BX5    -X0*X5
          MX0    -24
          AX2    6
          LX0    6
          BX6    -X0*X2      GET RANDOM ADDRESS
          BX6    X6+X5
          SA6    PRTA
          REWIND O,R
          SX6    3
          RJ     CPY         GET OLD CONTROL STATEMENT FILE
          REWIND O,R
          ENCSF  O,PRTA      ENTER AND POSITION CONTROL STATEMENT FILE
          EQ     PRT0        LOOP FOR REMAINING FILES
 
*         PREPARE FOR PROCESSING CCL FILES.
 
 PRT1     SA3    CCLF        *ZZZZZC0*
          BX1    X0*X5
          BX3    X0*X3
          SA4    CCLF+CCLFL-1  *ZZZZZC2*
          BX4    X0*X4
          IX3    X1-X3
          NG     X3,PRT5     IF NOT CCL FILE
          IX4    X4-X1
          NG     X4,PRT5     IF NOT CCL FILE
          SB2    B1+         SET CCL FILE FLAG
 
*         CHECK COPY TYPE.
 
 PRT5     MX3    -3
          BX4    X2
          LX4    2-11
          BX3    -X3*X4      GET COPY TYPE
          SX4    X3-4
          MX3    -6
          BX6    -X3*X5
          SA6    FIID        SAVE STATUS
          NE     B2,PRT5.1   IF CCL FILE
          SA1    FCFL        CHECK FILE CHECK FLAG
          NZ     X1,PRT9     IF SET
          SA1    =C*INPUT*
          BX6    X1-X5
          BX6    X0*X6
          NZ     X6,PRT6     IF NOT INPUT
          RETURN O,R         RETURN BEFORE CREATING
          EQ     PRT7
 
 PRT5.1   SA1    RIFL        CHECK FOR *RI* PARAMETER
          NZ     X1,PRT10    IF NEW CONTROL STATEMENTS WANTED
 PRT6     REWIND O,R
 PRT7     ZR     X4,PRT11    IF NO FILE COPY
          SX6    3
          RJ     CPY         COPY FILE
 PRT8     RJ     PSF         POSITION THE FILE
          SA2    FIID
          SETFS  O,X2
          EQ     PRT0        LOOP FOR REMAINING FILES
 
*         CHECK IF FILE ALREADY PRESENT.
 
 PRT9     STATUS O
          SA1    O
          SX3    X1-1
          ZR     X3,PRT7     IF NOT FOUND
          SA2    A2          WORD 2 OF TABLE ENTRY
          MX1    -4
          LX2    -4
          BX1    -X1*X2
          SX1    X1-4
          ZR     X1,PRT8     IF EXECUTE-ONLY
          ZR     X4,PRT8     IF NO FILE COPY ON CHECKPOINT FILE
 
*         COPY FILE TO BE RID OF IT
 
 PRT10    SA1    =C*CCCCCCM*
          SX3    3
          BX6    X1+X3
          SA6    O
          SX6    3
          RJ     CPY         COPY OLD FILE TO NEW HOME
          REWIND O,R
          EQ     PRT0        LOOP FOR REMAINING FILES
 
*         IF NO FILE COPY.
 
 PRT11    MX3    -24
          LX3    12
          SA2    A2          WORD 2 OF TABLE ENTRY
          BX4    -X3*X2      ISOLATE RANDOM INDEX
          MX3    -6          CHECK FILE TYPE
          ZR     X4,PRT0     IF EMPTY FILE
          AX5    6
          BX4    -X3*X5
          SX3    X4-LIFT
          NZ     X3,PRT13    IF NOT LIBRARY FILE
          ASSIGN P           REASSIGN SYSTEM FILE
          EQ     PRT8        LOOP FOR REMAINING FILES
 
 PRT13    SX3    X4-PMFT
          NZ     X3,PRT14    IF NOT DIRECT ACCESS FILE
 
*         CHECK  MODE.
 
          SA2    A5+B1
          RJ     SMD         SET MODE
          ATTACH P,,,,MODA,,,,NF
          EQ     PRT8        LOOP FOR REMAINING FILES
 
 PRT14    SX3    X4-LOFT
          NZ     X3,PRT16    IF ILLEGAL FILE TYPE
          SA1    O+8
          MX3    -2
          AX1    13
          BX1    -X3*X1
          SX3    X1-1
          ZR     X3,PRT8     IF TAPE FILE
 PRT15    GET    P
          EQ     PRT8        LOOP FOR REMAINING FILES
 
*         IF FILE NOT FOUND.
 
 PRT16    MX0    42
          SA1    O
          BX1    X0*X1
          RJ     SFN         SPACE FILL FILE NAME
          LX6    -6
          SA6    MSGA
          MESSAGE A6
 
*         CHECK NO ABORT FLAG.
 
          SA2    NAFL
          NZ     X2,PRT0     IF NO ABORT, LOOP FOR REMAINING FILES
          EQ     CPY5
 
*         RETURN *CCCCCCM* AND EXIT.
 
 PRT17    SA1    =C*CCCCCCM*
          SX3    3
          BX6    X1+X3
          SA6    O
          RETURN O,R
          EQ     PRTX        RETURN
 
 
 PRTA     BSS    1           PARAMETER AREA FOR *ENCSF* CALL
 
 MSGA     DATA   C*           NOT FOUND.*
 RCC      SPACE  4,15
**        RCC - RENAME/RETURN CCL FILES.
*
*         ENTRY  (B3) = 0, IF RENAME FUNCTION.
*                     = 1, IF RETURN FUCNTION.
*                (B4) = FWA OF LIST OF FILES TO BE RENAMED/RETURNED.
*                (B5) = FWA OF LIST OF FILE NAMES TO USE FOR RENAME.
*
*         USES   X - 0, 1, 2, 5, 6.
*                A - 1, 5, 6.
*                B - 2.
*
*         MACROS RENAME, RETURN.
 
 
 RCC3     BX6    X6-X6
          SA6    O+6
 
 RCC      SUBR               ENTRY/EXIT
          SA1    RIFL
          NZ     X1,RCCX     IF PROCESSING NOT NEEDED
          SB2    -1
 RCC1     SB2    B2+1
          SA5    B4+B2       GET NEXT FILE NAME TO PROCESS
          SX2    B1
          ZR     X5,RCC3     IF ALL FILES PROCESSED
          BX6    X5+X2
          LX5    59-0
          PL     X5,RCC1     IF NOT TO PROCESS FILE
          SA6    O
          EQ     B3,B1,RCC2  IF *RETURN* FUNCTION SELECTED
          RENAME O,B5+B2
          SA1    O
          MX0    -8
          LX1    7-17
          BX2    -X0*X1
          SA5    B5+B2
          NZ     X2,RCC1     IF FILE NOT RENAMED
          SX6    B1          SET FILE RENAMED INDICATOR
          BX6    X5+X6
          SA6    A5+
          EQ     RCC1        PROCESS NEXT SELECTED FILE
 
 RCC2     RETURN O,R
          EQ     RCC1        PROCESS NEXT SELECTED FILE
 RDA      SPACE  4
**        RDA - READ DATA.
*         PROCESSES CALLS TO READ WORDS (RDW=).
*         DEBLOCKS DATA FROM CONTROL WORD READS FOR TAPE POSITIONING.
*
*         ENTRY  (X0) = BLOCK COUNT.
*                (X2) = FET ADDRESS.
*                (B6) = ADDRESS TO READ TO.
*                (B7) = NUMBER OF WORDS TO READ.
*
*         EXIT   (X0) = BLOCK COUNT UPDATED.
*                ((X2)-2) = NUMBER OF WORDS REMAINING IN CURRENT
*                BLOCK IF POSITION IS NOT AT EOR/EOF/EOI.
*
*         CALLS  RDW=
*
*         USES   A - 1,3,6,7
*                B - 5,6,7
*                X - 0,1,2,3,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-1        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+1        INCREMENT BLOCK COUNT
          JP     RDA1        LOOP
 
 RDAA     CON    0           NUMBER OF WORDS NEED TO READ
 SMD      SPACE  4
**        SMD - SET FILE ACCESS MODE.
*
*         ENTRY  (X2) = WORD 2 OF TABLE ENTRY (REFORMATTED FST).
*
*         EXIT   (MODA) = MODE.
*
*         USES   X - 1, 2, 3, 4, 6.
*                A - 3, 6.
 
 
 SMD      SUBR               ENTRY/EXIT
          LX2    59-7
          MX4    4
          SA3    MODE        SET TABLE ADDRESS
 SMD1     BX1    X3-X2
          BX1    X4*X1
          ZR     X1,SMD2     IF FOUND
          SA3    A3+B1
          NZ     X3,SMD1     LOOP
          SX6    PTRD        SET READ MODE DEFAULT
          SA6    MODA
          EQ     SMDX        RETURN
 
 SMD2     SX6    X3
          SA6    MODA
          EQ     SMDX        RETURN
 
 
 MODE     BSS    0           MODE TABLE
          VFD    4/1,56/PTWR    WRITE
          VFD    4/0,56/PTRD    READ
          VFD    4/3,56/PTAP    APPEND
          VFD    4/4,56/PTEX    EXECUTE
          VFD    4/2,56/PTMD    MODIFY
          VFD    4/5,56/PTRM    READ/MODIFY
          VFD    4/6,56/PTRA    READ/APPEND
          VFD    4/7,56/PTUP    UPDATE
          VFD    4/10B,56/PTRU  READ/UPDATE
          CON    0
 
 MODA     CON    0           FILE ACCESS MODE
          TITLE  COMMON DECKS AND BUFFERS.
 COM      SPACE  4
*         COMMON DECKS.
 
 
*CALL     COMCARG
*CALL     COMCCDD
*CALL     COMCCIO
*CALL     COMCCPM
*CALL     COMCDXB
*CALL     COMCEDT
*CALL     COMCLFM
*CALL     COMCPFM
*CALL     COMCRDC
*CALL     COMCRDO
*CALL     COMCRDW
*CALL     COMCSFN
*CALL     COMCSNM
*CALL     COMCSYS
*CALL     COMCWTO
*CALL     COMCWTW
          SPACE  4
          TITLE  PRESET.
 PRS      SPACE  4
**        PRS    PRESET ROUTINE.
*
*         ENTRY  NONE.
*
*         EXIT   FILE POSITIONED TO CORRECT CHECKPOINT.
*
*         CALLS  ARG,DXB.
*
*         USES   A - 1,2,4,5,6,7.
*                B - 2,4,5.
*                X - ALL.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1
 
*         PROCESS ARGUMENTS.
 
          SA1    ACTR
          SB2    X1
          ZR     B2,PRS7     IF NO ARGUMENTS
          SA1    ARGR
          ZR     X1,PRS7     IF ERROR
          SX3    3
          BX6    X1+X3
          SB2    B2-B1
          SA6    I           SET FILE NAME
          REWIND I
          ZR     B2,PRS2     IF END OF ARGUMENTS
          SA1    ARGR+1
          ZR     X1,PRS1     IF NOT SET
          BX6    X1
          SA6    CKNO        SET CHECKPOINT NUMBER
 PRS1     SB4    B2-B1
          ZR     B4,PRS2     IF END OF ARGUMENTS
          SA4    A1+B1
          SB5    TARG
          RJ     ARG
 
          NZ     X1,PRS7     IF ERROR IN ARGUMENT
 PRS2     SA5    CKNO        GET CHECKPOINT NUMBER
          SX4    X5-1
          ZR     X4,PRS3     IF DEFAULT SET
          SA4    ASK
          BX4    X4-X5
          ZR     X4,PRS3     IF LAST CHECKPOINT DESIRED
          SB7    B1          CONVERT TO BINARY ASSUMING DECIMAL NUMBER
          RJ     DXB
          NZ     X4,PRS7     IF ERROR
          SA6    CKNO        SET NO. OF CHECKPOINT DESIRED
 
*         POSITION FILE TO CHECKPOINT RECORD.
 
 PRS3     READSKP I,,R       SKIP TO END OF RECORD
          SA1    X2          CHECK STATUS
          LX1    59-3
          NG     X1,CPY4     IF EOF/EOI
          SA1    IBUF        LOOK AT FIRST WORD OF BUFFER
          SX1    X1-10002B   CHECK FOR HEADER WORD
          NZ     X1,PRS3     IF NOT HEADER
          BKSP   I,R
 PRS4     SA1    I+1         SET IN = OUT = FIRST
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
 
*         SEARCH FOR CORRECT CHECKPOINT.
 
          READ   I
          READO  I           READ HEADER WORD 1
          NZ     X1,CPY4     IF EOR OR EOF
          ZR     X6,CPY4     IF NO DATA
          SX1    X6-10002B
          NZ     X1,CPY4     IF WRONG DATA TYPE
          READO  I           READ HEADER WORD 2
          MX0    -12
          BX3    -X0*X6      GET NO. OF THIS CHECKPOINT
          SA2    CKNO
          SA4    ASK
          BX4    X4-X2
          IX1    X2-X3
          ZR     X4,PRS5     IF LAST CHECKPOINT WANTED
          NG     X1,CPY4     IF ERROR
          ZR     X1,PRS6     IF CORRECT CHECKPOINT NUMBER
 
*         CHECK CHECKPOINT CODE WORD.
 
 PRS5     SKIPF  I,1,R       SKIP RECORD
          SA1    I+1         SET IN = OUT = FIRST
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          READ   I
          READO  I           READ HEADER WORD 1
          PL     X6,PRS4     IF NOT LAST CHECKPOINT
          SA2    CKNO
          SA4    ASK
          BX4    X2-X4
          NZ     X4,PRS8     IF ERROR
 
*         POSITION TO START OF CHECKPOINT RECORD.
 
          SKIPB  I,2         POSITION FILE
          SA1    I+1         SET IN = OUT = FIRST
          SX6    X1
          SA6    A1+B1
          SA6    A6+B1
          READ   I
          READO  I           READ HEADER WORD 1
          READO  I           READ HEADER WORD 2
          MX0    -12
          BX7    -X0*X6
          SA7    CKNO        SET CHECKPOINT NUMBER
 
*         GET CHECKPOINT DATE AND TIME.
 
 PRS6     SA6    HDRB        SAVE HEADER WORD
          AX6    18
          BX5    X6
          SX1    X6
          ETIME  X1          CONVERT TIME
          SB2    1R)
          SB5    MSGB
          BX1    X6
          RJ     SNM         SET TIME IN MESSAGE
          AX5    18
          SX1    X5
          EDATE  X1          CONVERT DATE
          SB2    1R(
          SB5    MSGB
          BX1    X6
          RJ     SNM         SET DATE IN MESSAGE
          READO  I           READ HEADER WORD 3
          SB2    1R+
          SB5    MSGB
          BX1    X6
          RJ     SNM         SET JSN IN MESSAGE
 
*         GET USER EM SHIFT COUNT.
 
          SYSTEM RSB,R,PRSA
          SA1    UESC
          MX0    -3
          LX1    0-33
          BX6    -X0*X1
          SA6    A1
          EQ     PRSX        RETURN
 
 PRS7     MESSAGE (=C* ERROR IN ARGUMENTS.*)
          EQ     CPY5
 
 PRS8     MESSAGE (=C* CHECKPOINT NOT FOUND.*)
          EQ     CPY5
 
 ASK      DATA   1L*
 PRSA     VFD    24/1,18/MEFL,18/UESC
 UESC     VFD    1/1,59/0    USER EXTENDED MEMORY SHIFT COUNT
 
 TARG     BSS    0
 RI       ARG    =-1,RIFL
 NA       ARG    =-1,NAFL
 FC       ARG    =-1,FCFL
          CON    0
 
*         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+4
 
          END