SPL,L,O 
!     NAME:   RU..
!     SOURCE: 92067-18226 
!     RELOC:  92067-16185 
!     PGMR:   A.M.G.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
       NAME RU..(8) "92067-16185 REV.2026 800221"   
! 
!  MODIFICATION RECORD: 
! 
!      DATE     REASON
!  1) 780630    TO USE RTE SESSION MONITOR SESSN ROUTINE
!  2) 781006    TO CLOSE DCB FOR TYPE 6 FILE AFTER IDRPL CALL 
!  3) 781117    TO NOT DO A :TR IF NEITHER THE PGM NOR TYPE 6 FOUND 
!  4) 790116    TO SKIP 1ST SCHEDULE ATTEMPT & TRY FOR TYPE 6 IF
!               GENERIC NAME NOT FOUND
!  5) 790123    TO RETURN "PROGRAM NOT FOUND" ERROR INSTEAD OF -6 
!               AND TO SEARCH ONLY LU 2 AND LU 3 FOR TYPE 6 FILE
!  6) 790123    TO INHIBIT RENAME ON TYPE 6 RP IF DON'T COPY BIT SET
!  7) 800221    TO CALL "IDRP" INSTEAD OF "IDRPL" THUS ALLOWING 
!               TYPE 6 FILES TO RESIDE ON ANY CARTRIDGE.
!               REMOVED CARTRIDGE DEFAULT TO LU 2 AND 3.  (DCL) 
! 
! 
       LET BUMP.,                           \UPDATES JOB TIME 
           SET.T,                           \RESETS JOB TIMER 
           MSS.,                            \PRINTS ERROR MESSAGE 
           EXEC,                            \SYSTEM CALLS 
           RMPAR,                           \RETRIEVE PARAMETERS
           FM.ER,                           \SEND MESSAGE TO LOG
           IDRP,                            \10-2:RP,XX PROCESSOR  800221 
           IDRPD,                           \10-2:RP,,XX PROCESSOR
           READF,                           \10-2 FMP FILE READ 
           IER.,                            \FMGR ERROR HANDLING
           OPEN,                            \FMP FILE OPEN ROUTINE
           OPEN.,                           \INTERNAL OPEN ROUTINE
           CLOS.,                           \INTERNAL CLOSE ROUTINE 
           .RENM,                           \RENAMING MOD. IN SES MODE
           SESSN,                           \TEST IF IN SESSION MODE
           IFMTM,                           \TEST IF MTM
           WRITF                            \FMP FILE WRITE ROUTINE 
              BE SUBROUTINE,EXTERNAL
! 
       LET .DFER                            \3-WORD TRANSFER
              BE SUBROUTINE,EXTERNAL,DIRECT 
! 
!10-2  LET IFBRK BE FUNCTION,EXTERNAL       !CHECK BREAK FLAG.
       LET ID.A BE FUNCTION,EXTERNAL        !GET IDSEG ADDRESS
       LET TL. BE FUNCTION,EXTERNAL,DIRECT  !CHECK RUN TIME LIMIT.
! 
       LET .E.R.,                           \FMGR ERROR WORD
           O.BUF,                           \FMGR DCB BUFFER
           TL.P,                            \RUN TIME LIMIT VALUES
           CAD.,                            \COMMAND ADD. IN TABLE
           ACTV.,                           \JOB ACTIVE FLAG
           NO.RD,                           \COMMAND READ FLAG
           G0..,                            \GLOBAL TABLE ADDRESS 
           BUF.,                            \BUFFER USED BY RP
           C.BUF,                           \TRANSLATED "RU" COMMAND
           ECH.,                            \LENGTH OF COMMAND
           TMP.,                            \ID SEG TEMP. STORAGE 
           SCR.,                            \SECOND 2 COMMAND CHARS.
           I.BUF,                           \10-2 DCB FOR :RP,XXXX
           N.OPL,                           \10-2 SC & CRN FOR OPEN 
           ..BF.,                           \BUFFER FOR "IDRP"      800221
           ..BL.                            \BUFFER LENGTH          800221
              BE INTEGER,EXTERNAL 
! 
       LET SREQ BE CONSTANT (100027K) 
       LET XEQT BE CONSTANT (1717K) 
       LET XTEMP BE CONSTANT(1721K) 
       LET SECT3 BE CONSTANT(1760K) 
! 
       LET PTR,PTR1,PTR2,PTR3,PTR4,PTR5,PTR6 BE INTEGER 
!10-2  LET PAR(4),PAR5,PARM1,PARM(7) BE INTEGER 
       LET SAVE BE INTEGER
       LET ABEND(4),ABX(7) BE INTEGER 
       LET TIME(4) BE INTEGER 
       LET JOB BE REAL
       LET LM(3) BE INTEGER 
       LET NNAM(3) BE INTEGER      !10-2-76 (DLB) 
       LET RN,BAT BE REAL 
       LET DUM,DUX BE INTEGER 
       LET T1,T2 BE INTEGER 
! 
!10-2  INITIALIZE PAR,PAR5,PARM1,PARM                     \ 
!10-2       TO 4(0),3,8(0)
       INITIALIZE ABEND,ABX TO " ABEND  XXXXX ABORTED " 
       INITIALIZE TIME,JOB,LM TO " ABEND  JOB LIMIT " 
       INITIALIZE RN TO "RUN "
! 
! 
! 
! 
! 
! 
RU..:  SUBROUTINE(NUM,PRAMS,ERR) GLOBAL 
       LET NUM,PRAMS,ERR BE INTEGER 
       CRCNT,PFL,RPSW _ 0;
       DM_@BAT                              !SET DUMMY TIME LOCATION
       IFNOT NUM THEN [ERR_50; RETURN]      !ARE THERE ENOUGH PARAMS? 
       IF PRAMS = 3 THEN GOTO GETN          !IF ASCII, CHECK NAME 
! 
       ERR _ 56;  RETURN                    !BAD PARAMETER. 
GETN:  PTR6 _ [PTR5 _ [PTR4 _ [PTR3 _       \ 
          [PTS2,PTR2 _ [PTR2F _ [PTR1 _     \ 
          @PRAMS+1] + 3] + 1] + 4] + 4]     \ 
          + 4] + 4
! 
!      IF FIRST PRAM NOT SUPPLIED AND 0G IS NUMERIC USE IT INSTEAD
! 
       IFNOT $PTR2F THEN [                  \ 
          IF G0.. = 1 THEN PTS2 _ @G0..+1]
!10-2  CALL .DFER(PARM1,$PTR1)              !SET NAME IN RP.. CALL
       CALL .DFER(NNAM,$PTR1)               !10-2 SET NAME FOR DUP CALL 
! 
      CRCNT_ECH.                            !SET COMMAND LENGTH 
! 10-2
       CALL SESSN($XEQT)?[                  \TEST IF IN SESSION OR
          CALL IFMTM($(@G0..+1))?[GOTO TSET]] !IF MTM BEFORE RENAMING 
       IF N.OPL = "IH" THEN GO TO TSET      !IF 'IH' DON'T RENAME 
       CALL .RENM(NNAM,.E.R.,RPSW)          !10-2 RENAME MODULE IF POSSIBLE 
       IF .E.R. THEN ERR _ .E.R.            !10-2 IF ERROR BRING FORWARD
       IF ERR THEN RETURN                   !10-2 CHECK IF ANY ERRORS 
! 
       IDADR_ID.A($PTR1)?[GOTO TYPE6]       !IF NO GENERIC, TRY FILE
       IF [NOCPY_$(IDADR+31) AND 2000K]     \IF "DON'T COPY" BIT SET, 
          THEN CALL .DFER(NNAM,$PTR1)       !USE OLD NAME 
TSET:  IF ACTV. THEN[IFNOT TL.() THEN [     \IF IN ACTIVE JOB,
          CALL SET.T(TL.P,BAT);             \SET RUN TIME LIMIT,
          PFL _ 1;  DM _ @DUM]]             !IF NECESSARY.
TRNON: CALL SET.T(T1,T1)
       IF SCR. = "IH" THEN CRCNT_0          !IF "IH" PASS ZERO LENGTH 
       $1 _ -1                              !MUST PASS THE
       CALL EXEC(SREQ,NNAM,$PTS2,$PTR3,     \10-2 WHOLE COMMAND 
           $PTR4,$PTR5,$PTR6,C.BUF,CRCNT)   !BUFFER TO EXEC.
       GOTO REPLC                           !ERROR EXIT.
! 
CHKB:  IF [SAVE _ $1] = -1 THEN             \ 
          GOTO ABCHK
! 
       CALL RMPAR($(@G0..+41))
ABCHK: IF PFL THEN CALL BUMP.(BAT,TL.P)     !UPDATE JOB TIME
       CALL SET.T(BAT,$DM)                  !RESET THE RUN TIME LIMIT 
       .E.R._0
       IF $$XTEMP # 100000K THEN GO TO EX   !FIND OUT IF PROGRAM DIED 
! 
       CALL .DFER(ABX,NNAM)                !10-2SET UP THE ABORT MESSAGE
       CALL FM.ER(2,ABEND,11)               !SEND IT TO THE LOG.
       IFNOT ACTV. THEN GO TO EX            !IF NOT IN JOB GO EXIT
! 
       CALL OPEN.(O.BUF,TMP.,$(@TMP.+3),0)  !OPEN THE LIST FILE 
       IF $(DM+1)> -1 THEN [                \IF TIME OUT ABORT
          IF T2 < 0 THEN [                  \ 
             IF PFL THEN JOB _ RN;          \IF RN LIMIT USE RN 
             WRITF(O.BUF,.E.R.,TIME,9);     \SEND THE MESSAGE TO LP 
             NO.RD,CAD._6;                  \TIME OUT ALWAYS ABORTS 
             IER.]]                         !CHECK FOR ERRORS 
       CALL WRITF(O.BUF,.E.R.,ABEND,11)     !SEND THE ABEND MESSAGE 
       IF .E.R.= -17 THEN .E.R._0           !SET OVERFLOW ERROR TO 0
!10-2EX:    IF RPSW THEN CALL RP..(2,PAR,ERR)    !PU THE ID IF RP'ED
EX:    IF RPSW THEN CALL IDRPD(NNAM,.E.R.); \10-2 
       CALL EXEC (5,-1)                     !10-2 RELEASE ANY TRACKS
       IF .E.R. THEN ERR _ .E.R.            !10-2 
       IER.                                 !REPORT ANY OTHER ERRORS
       IF ERR THEN RETURN                   !10-2 CHECK IF ANY ERRORS 
       CALL EXEC(14,1,C.BUF,40);ECH._.B.    !10-2 GET RETURNED STRNG FROM PROG
       IF ECH.>40 THEN RETURN               !10-2 BUG IN OP-SYSTEM
       IFNOT ECH. THEN RETURN               !10-2 CHECK IF STRING RETURNED
       IF (C.BUF AND 177400K)=35000K THEN[  \10-2 CHECK IF STARTING : 
       NO.RD _  -1; C.BUF _ C.BUF-15000K]   !10-2 SET RD BF FGG,CHANGE : > SPA
       RETURN 
! 
REPLC: SAVE _ $1
       CALL SET.T(BAT,$DM)                  !RESET THE JOB TIMER
       IF RPSW THEN GOTO PRMSG
! 
       IF    SAVE # "05" THEN GOTO PRMSG
! 
!10-2       CALL RP..(1,PAR5,ERR)                !IF EXEC COULDN'T FIND 
TYPE6: DIS2_$(@N.OPL+1)                        !DISC FROM NAMR
! 
!! REMOVE CARTRIDGE DEFAULT TO LU 2 AND 3  (DCL)     800221 
!!       DIS_[IF DIS2 THEN DIS2, ELSE -2]        !DEFAULT TO LU 2 
! 
       DIS_DIS2                                !GET CRN           800221
       CALL OPEN(I.BUF,.E.R.,$PTR1,5,N.OPL,DIS)!OPEN TYPE 6 FILE
! 
!! REMOVE CARTRIDGE DEFAULT TO LU 2 AND 3  (DCL)     800221 
!!       IF .E.R. = -6 THEN                 \IF NOT FOUND, THEN 
!!         [IFNOT DIS2 THEN                 \IF NOT SPECIFIED, THEN 
!!            [IF $SECT3 THEN               \IF LU 3, THEN
!!          CALL OPEN(I.BUF,.E.R.,$PTR1,5,N.OPL,-3)]]!TRY OPEN ON LU 3
! 
       IF .E.R. < 0 THEN [                       \IF ERROR, THEN
          IF .E.R. = -6 THEN .E.R._67;           \IF -6, MAKE 67
          ERR_.E.R.; RETURN]                     !SET ERROR, RETURN 
       CALL READF (I.BUF,.E.R.,BUF.,128)    !10-2 FOR LATER TESTS 
       IER.                                 !10-2 
       IF [NOCPY_$(@BUF.+31) AND 2000K]     \MASK DON'T COPY BIT
          THEN CALL .DFER(NNAM,$PTR1)       !IF NO COPY, USE OLD NAME 
       CALL IDRP (I.BUF,.E.R.,NNAM,..BF.,..BL.)  !DO :RP,         800221
       CALL CLOS.(I.BUF)                    !CLOSE THE TYPE 6 FILE
       IF .E.R. THEN ERR _ .E.R.            !10-2 
!      IF ERR = 19 THEN GO TO ERTS          !PROGRAM, LOOK FOR A FILE.
!      IF ERR = 16 THEN[                    \IF NON PROGRAM FILE FILE.
!ERTS:    IF BUF.= -1 THEN RETURN;          \IF EOF AT START OR 
!         IFNOT ($(@BUF.+1) AND 377K) THEN RETURN; \ A BINARY FILE
!         GO TO TRANS]                      !DON'T TR ELSE DO TR. 
! 
       IF ERR THEN RETURN 
       RPSW _ 1;  GOTO TSET              !FILE AND TRY AGAIN. 
! 
!TRANS:CAD.,NO.RD _ 1                    !CAN'T FIND PROGRAM. 
!      ERR _ 0;  RETURN                  !TREAT AS A "TR" FILE. 
PRMSG: ERR _ 49 
       IF RPSW THEN CALL IDRPD(NNAM,T1); \10-2 IF CANNOT RUN :RP,X > :RP,,X 
       CALL EXEC (5,-1)                  !10-2 RELEASE ANY TRACKS PICKED UP 
       RETURN 
       END
       END
       END$ 
                                                                                    