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$