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