Retro1.org codex

.PROC,SSCONTL. 
*         THIS JOB BUILDS TWO PROGRAMS THAT ARE NEEDED TO TIME EVENT
*         A SSMOVE DESTAGE JOB OR A LOW DISK SPACE SSMOVE JOB.
*
*         *TIMESCR* PROGRAM IS CALLED BY A JOB THAT PLACES A SSMOVE
*         PROGRAM IN THE ROLLOUT QUEUE WAITTING FOR A PRESET TIME
*         TO START THE SSMOVE EXECUTION.
*         THIS DESTAGE RELATED PROCEEDURE IS CALL BY THE PROC *DESTAGE*.
*         ** THE BINNARY DECK IS CALLED *TIMEB*.
*
*         *PROFULL* PROGRAM IS CALLED BY A JOB THAT PLACES A SSMOVE
*         PROGRAM IN THE ROLLOUT QUEUE WAITTING FOR A LOW DISK SPACE
*         THRESHOLD FLAG TO BE SET.
*         THE *PROFULL* BINNARIES MUST BE SYSEDITED OR BE PLACED ON
*         THE DEAD START TO EXECUTED.  (AN SSJ= PROGRAM THAT READS
*         THE EST AND MST WITH SYSTEM MACRO-S FOR THE LOW DISK
*         THRESHOLD FLAGS.)
*         * THE BINNARY DECK IS CALLED *DKFULL*.
*
*         THIS LOW DISK SPACE PROGRAM IS CALLED BY THE PROC *DKFULL*
*
ATTACH,OPL/UN=LIBRARY.
COPYBR,TIMESRC,X.
COPYBR,PROFULL,X1.
REWIND,*.
COPYBF,X,TIMESRC.
COPYBR,X1,PROFULL.
REWIND,*.
MODIFY,P=0,C=0,N=N,F,Z./*CREATE,TIMESRC
REWIND,*.
MODIFY,P,LO=E,Z./*OPLFILE,N/*EDIT,TIMESRC
FTN,I=COMPILE,L=L,B=TIMEB,S=PSSTEXT,S=NOSTEXT.
REWIND,*.
MODIFY,P=0,C=0,N=N,F,Z./*CREATE,PROFULL
REWIND,*.
MODIFY,P,LO=E,Z./*OPLFILE,N/*EDIT,DKFULL
COMPASS,I,B=DKFUL,S=NOSTEXT,S=PSSTEXT,L=M.
REWIND,*.
MODIFY,P,LO=E,Z./*EDIT,MAC2
COMPASS,I,B=MACBIN,S=NOSTEXT,S=PSSTEXT,S=SSYTEXT,L=0.
REWIND,*.
LIBGEN(F=MACBIN,P=MACLIB,NX=0)
LDSET(LIB=MACLIB,PRESET=0,MAP=SBEX/MAP)
LOAD(DKFUL)
NOGO(DKFULL,DKFULL,$RFL=$,$SSJ=$)
PURGE,TIMEB,DKFULL/NA.
SAVE,TIMEB,DKFULL.
REVERT.     SAVE TIMEB AND DKFULLB.
DIS.
EXIT.
REVERT.   ERRORS......
.DATA,TIMESRC.
TIMESRC
      PROGRAM TIMESRC ( TAPE1 )
 
CCC   *TIMESRC* CONTROLS THE CALLING OF *SSMOVE*.
C
C     *TIMESRC* READS LOCAL FILE TAPE1 TO DETERMINE
C     THE NEXT TIME TO CALL *SSMOVE*.  WHEN THE
C     TRIGGER TIME IS HIT, THEN *TIMESRC* ENDS AND
C     THE CCL PROCEDURE FILE IS ALLOWED TO CONTINUE.
C
C     THE CCL PROCEDURE WILL THEN CALL *SSMOVE*.
C
C     FORMAT OF TAPE1.
C
C     N RECORDS OF FORMAT I4  - HHMM.
C                             HH = HOUR OF NEXT DESTAGE.
C                             MM = MINUTES OF NEXT DESTAGE.
 
      INTEGER CURTM
 
C
C     READ NEXT TIME TO DESTAGE.
C
 
      READ ( 1 , 9000 ) IHR , ISE
9000  FORMAT ( 2I2 )
      NTM = SHIFT ( IHR , 6 ) .OR. ISE
 
C
C     DETERMINE CURRENT TIME
C
 
10    CALL GETCTM ( CURTM )
      CURTM = CURTM .AND. 777700B
      CURTM = SHIFT ( CURTM , -6 )
 
C
C     IF CURRENT TIME .GT. TIME TO DESTAGE, THEN
C     END TO ALLOW PROCEDURE TO CALL *SSMOVE*.
C
 
      IF ( NTM .GT. CURTM ) GOTO 100
      STOP
 
C
C     IF *SSMOVE* SHOULD RUN IN LESS THAN 15 MINUTES,
C     INCREASE THE FREQUENCY OF THE ROLLINS.
C
 
100   CURTM = CURTM - 15
      IF ( CURTM .GT. NTM ) 110 , 120
 
110   ITIME = 3
      CALL ROLL ( ITIME )
      GOTO 10
 
120   ITIME = 15
      CALL ROLL ( ITIME )
      GOTO 10
 
      END
          IDENT GETCTM
          ENTRY GETCTM
          SPACE  4
 GETCTM   BSSZ   1
          SA1    A1
          PDATE  X1
          EQ     GETCTM
          END
          IDENT  ROLL
          ENTRY  ROLL
          SPACE  4
 ROLL     BSSZ   1
          SA1    X1
          SX2    60D         CONVERT TIME TO SECONDS
          IX6    X1*X2
          SA6    ADDR
          ROLLOUT  ADDR
          EQ     ROLL        RETURN AFTER ROLLOUT
 
 ADDR     BSSZ   1
          END
.DATA,PROFULL.
DKFULL
          IDENT  DKFULL
 
          SYSCOM B1
          SST
          ENTRY  RFL=
          ENTRY  SSJ=
          ENTRY  DKFULL
          EXT    RDESTC
 
***       *DKFULL* CONTROLS THE CALLING OF *SSMOVE* WHEN THE
*         DISK LOW SPACE THRESHOLD IS REACHED.
*
 
 
 DKFULL   SB2    ESTB              BUFFER TO RECEIVE EST ENTRIES
          SB1    1
          SB3    ESTN
          SB4    -B1               READ MASS STORAGE ENTRIES
          RJ     =XRDESTC          READ EST INTO *ESTB*
          SA5    ESTN
          SB6    X5                SET LAST MASS STORAGE ORDINAL + 1
 
*SEARCH EST FOR MASS STORAGE DEVICES THAT ARE FULL.
 
 
 DFL1     SB4    B4+B1
          EQ     B4,B6,DFL2        IF END OF MASS STORAGE DEVICES
 
          SX1    B4                CALCULATE *ESTB* OFFSET
          R=     X6,ESTE
          IX1    X1*X6
          SA1    ESTB+X1+EQDE      GET NEXT EST ENTRY
          PL     X1,DFL1           IF NOT MASS STORAGE DEVICE
          BX6    X1
          LX6    59-54
          NG     X6,DFL1           IF DEVICE UNAVAIBLE FOR ACCESS
          RJ     RDM               READ MST
          SA2    MSTB+ACGL-TDGL
          LX2    59-4
          NG     X2,DFL1           IF ERROR IDLE SET ON DEVICE
          SA2    MSTB+MDGL-TDGL
          LX2    59-58
          NG     X2,DFL1           IF AUXILIARY DEVICE
          SA2    MSTB+DULL-TDGL
          LX2    59-11
          NG     X2,DFL1           IF FAMILY IDLE DOWN FLAG IS SET
          SA2    MSTB+THLL-TDGL
          LX2    59-35
          NG     X2,DFL3           FULL DISK FOUND
          EQ     DFL1              CHECK NEXT ENTRY
 
 DFL2     ROLLOUT ADDR
          EQ     DKFULL            CHECK REASON FOR ROLLIN
 
 DFL3     ENDRUN
 
 
***       RDM - READ FULL *MST* ENTRY.
*
*         ENTRY  (X1) = EST ENTRY.
*
*         EXIT   (X3) = MST ADDRESS.
*                (MSTA) = MST POINTER PARAMETER.
*                (MSTB) = *MSTN* CONTIGUOUS WORDS STARTING AT *TDGL*
*                         OF THE MST ENTRY.
*
*         USES   A - 6, 7.
*                X - 0, 2, 3, 6, 7.
*
*         MACROS SYSTEM.
 
 
 RDM      SUBR                     ENTRY/EXIT
          MX0    -12
          BX3    -X0*X1            GET ADDRESS OF MST ENTRY
          LX3    3
          SX2    X3+TDGL           READ WORD *TDGL* OF MST
          LX2    35-17
          MX7    1
          SA7    MSTB
          SX7    MSTXL             NUMBER OF MST ENTRY WORDS TO READ
          LX7    59-23
          BX6    X7+X2
          SX2    MSTB
          BX6    X2+X6
          SA6    MSTA
          SYSTEM RSB,R,A6
          EQ     RDMX              RETURN
 
 
 
 SSJ=     BSS    0           SSJ= PARAMETER BLOCK
          BSSZ   1
          CON    0
          BSSZ   SSJL        PAD SSJ= PARAMETERS
          BSS    1
 
 
*         BUFFERS
 
 ADDR     VFD    24/0,24/LSPE,12/7020B  LOW SPACE THRESHOLD/ HOUR TIMER
 
 ESTB     BSS    ESMX*ESTE         EST BUFFER
 ESTN     BSS    1                 LAST MASS STORAGE ORDINAL + 1
 MSTA     BSS    1                 MST POINTER PARAMETER WORD
 MSTB     BSS    MSTXL             MST ENTRY BUFFER
 
 
*         COMMON DECKS
 
*CALL COMSEVT
*CALL COMCMAC
          USE    //
 RFL=     BSS    0
          USE    *
          END    DKFULL