SPL,L,O 
!     NAME:   NX.JB 
!     SOURCE: 92067-18244 
!     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 NX.JB(8) "92067-16185 REV.1903 790301"
! 
!  MODIFICATION RECORD: 
! 
!        DATE   REASON
!  (1)  780420  TO WORK WITH 6 WORDS PER ENTRY IN THE TRANSFER
!               STACK (GLM) 
!  (2)  780720  TO DETACH FROM SESSION FOR BATCH PROCESSING (BL)
!  (3)  780913  TO HANDLE NEW JOB FILE FORMAT AND JOB/SESSION (GAA) 
!  (4)  790103  TO REQUEST RN LOCK WITH NO ABORT (BL) 
! 
!  THE FOLLOWING ROUTINE SEARCHES THE JOBFIL FOR
!  THE NEXT JOB TO PROCESS. 
! 
       LET J.REC,             \RECORD # IN JOBFIL OF CURRENT JOB
           J.NAM,             \JOB NAME ARRAY 
           JRN.,              \JOBFIL RN #
           CAM.I,             \COMMAND INPUT DCB
           I.BUF,             \DCB AREA 
           BUF.,              \GENERAL FILE I/O BUFFER
           CAMS.,             \COMMAND STACK
           P.TR,              \POINTER TO CURRENT CAMS. POSITION
           NO.RD,             \NO READ FLAG FOR PARSE SEGMENT 
           ACTV.,             \JOB ACTIVE FLAG
           CAD.,              \NEXT COMMAND ADDRESS LOCATION
           CAM.O,             \LOG DEVICE 
           TTY.,              \INTERACTIVE DEVICE SWITCH
           TMP.,              \LIST LU
           CUSE.,             \CURRENT SEGMENT SUFFIX 
           G0..,              \ENTRY INTO GLOBAL STORAGE TABLE
           OVRD.,             \OVERRIDE FLAG
           S.TTY,             \8P - SESSION TERMINAL LU 
           S.CAP              \9P - SESSION CAPABILITY
            BE INTEGER,EXTERNAL 
! 
       LET L.SEG  BE LABEL,EXTERNAL  !RETURN ADDRESS IN MAIN
       LET .LGON                            \LOGON FROM ACCT # ROUTINE
          BE PSEUDO,EXTERNAL,DIRECT 
! 
       LET POST,                            \POST FILE BUFFERS
           ICAPS,                           \CAPABILITY FETCH ROUTINE 
           LUSES,                           \SESSION ID TRANSLATER
           FG.LU                            \LU SWITCHER FOR SESS.
         BE FUNCTION,EXTERNAL 
! 
! 
       LET READF,             \FMGR READ
           WRITF,             \FMGR WRITE 
           MSS.,              \ERROR MESSAGE WRITER 
           CLOSE,             \FMGR CLOSE FILE
           EXEC,              \SYSTEM I/O 
           FM.ER,             \FMGR ERROR MESSAGE ROUTINE 
           LU.CL,             \LU SWITCH CLEAN UP 
           LULU.,             \MODIFIES LU TRANSFORM TABLE
           OPEN,              \FMGR OPEN FILE 
           OPEN.,             \INTERNAL OPEN ROUTINE
           APOSN,             \FMGR POSITION FILE 
           SPOPN,             \CALLS SMP TO OPEN UP SPOOL 
           B.FLG,             \SET BATCH FLAG IN ID SEG.
           RNRQ,              \RESOURCE NUMBER CONTROL
           DTACH              \DETACH FROM SESSION
            BE SUBROUTINE,EXTERNAL
! 
       LET PTR,PTR1,PTR2,     \BUFFER POINTERS
           NEXT,             \SAVED INDEX INTO JOBFIL LIST
           JOBFL(3),          \NAME OF 'JOBFIL' 
           LGOFF(3),          \NAME OF 'LGOFF ' 
           CDEV,              \COMMAND DEVICE 
           CDEV1(2),          \ 
           FM,GR,UBL,                       \ASC FMGR 
           JSTAT              \STATUS OF JOBFIL RN. 
              BE INTEGER
! 
       INITIALIZE LGOFF TO "LGOFF " 
       INITIALIZE CDEV,CDEV1 TO 5,0.0 
       INITIALIZE JOBFL TO "JOBFIL" 
       INITIALIZE FM,GR,UBL TO "FMGR",20000K
       LET RD,WR                            BE SUBROUTINE,DIRECT
! 
       LET .DFER     BE SUBROUTINE,EXTERNAL,DIRECT
       LET A    BE CONSTANT(0)
       LET XEQT BE CONSTANT(1717K)
! 
!  *****  SUBROUTINE STARTS HERE  ***** 
! 
NX.JB: SUBROUTINE(N,PLIST,ERR) GLOBAL 
       LET N,PLIST,ERR BE INTEGER 
! 
       ASSEMBLE ["EXT $SPCR";"LDA $SPCR";"STA SPCR"]
       ASSEMBLE ["EXT $LGOF";"LDA $LGOF";"STA LGOF"]
       IFNOT SPCR THEN GO TO ERRET          !IF SPOOL NOT SET UP: EXIT
       PTR4_[PTR3_[PTR2_[PTR1_$1717K+12]+1]+1]+6
       IF $PTR1 = FM THEN[                  \ONLY FMGR CAN RUN
          IF $PTR2 = GR THEN[\
             IF ($PTR3 AND 177400K) = UBL    THEN \ 
                GO TO OK]]
       GO TO ERRET                          !ELSE JUST GO TERMINATE 
! 
OK:    IF ($PTR4 AND 40000K) THEN[          \IF WE ARE CURRENTLY A SON
          CALL EXEC(12,FM,1,0,-1);          \PUT SELF IN TIME LIST FOR 10 MS
          CALL EXEC(6,0,0,-1)]              !AND TERMINATE PASSING A -1 TO SELF 
! 
       CALL DTACH                           !DETACH FROM SESSION
       JSTAT _ 1
       IF POST(I.BUF) # -11 THEN GO TO GETRN !IS JOBFIL OPEN? 
       OVRD. _ [NEXT _ OVRD.] OR 100000K    !SAVE AND SET OVERRIDE FLAG 
       OPEN(I.BUF,ER ,JOBFL,3,123456K,SPCR) !OPEN UP JOBFIL.
       OVRD. _ NEXT                         !RESTORE THE OVERRIDE FLAG
       IF ER  = 2 THEN GO TO GETRN          !IF NO JOBFIL,RETURN. 
ERRET: CLOSE(I.BUF)                         !MAKE SURE JOBFIL CLOSED. 
       CALL EXEC(6)                         !NOTHING TO DO. 
! 
GETRN: RD(17) 
       PTR15_[PTR10_[PTR7_[PTR6_[PTR4_[PTR3_      \SET POINTERS 
          [PTR2_[PTR1_@BUF.+1]+1]+1]+1]+2]+1]\
          +3]+5 
       WBF_[PTS15_[PTS11_[PTS9_[PTS8_[PTS7_      \
          [PTS6_[PTS5_[PTS2_[PTS1_[PTS_     \ 
          PTR15+1]+1]                       \ 
          +1]+3]+1]+1]+1]+1]+2]+4]+1
       JRN. _ BUF.                          !SAVE JOBFIL RN.
       IF $PTR15 = "D" THEN GO TO ERRET     !IF SHUT DOWN THEN EXIT 
       POST(I.BUF)
       RNRQ(40001K,JRN.,JSTAT)
       GOTO ERRET 
! 
!      THIS SECTION OF CODE PROCESSES THE JOB QUEUE.
!      THE JOB QUEUE IS LOCATED IN THE FIRST 16 RECORDS OF THE JOBFIL.
!      EACH POSSIBLE JOB HAS A ONE WORD ENTRY IN THIS QUEUE.  THIS
!      WORD, BY ITS POSITION IN THE FILE INDICATES, AN ASSOCIATED JOB 
!      RECORD (RECORD # = OFSET FROM 1'ST WORD + 17). 
!      THE FIRST WORD OF THE JOB QUEUE CONTAINS THE JOBFIL RN (SET BY GASP).
!      THE SECOND WORD CONTAINS TWO 8-BIT POINTERS TO A) THE NEXT JOB 
!      TO RUN <NEXT> (LEFT BYTE) AND B) THE HEAD OF THE JOB WAITING QUEUE 
!      <HEAD> (RIGHT BYTE).  THE REST OF THE 256 WORD QUEUE CONTAINS A
!      LINKED LIST OF JOBS.  EACH LIST ELEMENT HAS TWO 8-BIT PARTS
!      A) THE JOB PRIORITY (LEFT BYTE) AND B) A POINTER TO THE NEXT 
!      ENTRY IN THE QUEUE (RIGHT BYTE).  A POINTER OF ZERO INDICATES
!      THE END OF THE LIST. 
! 
!      WHEN A JOB IS STARTED A CHECK IS MADE TO SEE IF <NEXT> 
!      IS THE SAME AS <HEAD>.  IF NOT THEN THE JOB POINTED TO BY
!      <HEAD> IS TO BE ABORTED.  IF THEY ARE THE SAME THEN THE
!      <NEXT> POINTED IS UPDATED TO POINT TO THE JOB POINTED TO 
!      BY THE POINTED AT <HEAD> (I.E. THE NEXT JOB AFTER THE ONE
!      INDICATED BY <HEAD>).  THE JOB INDICATED BY <HEAD> IS THEN 
!      SET UP AND STARTED.  BY THIS CONVENTION WE DERIVE THE FOLLOWING
!      BENIFITS:
! 
!      1) JOB ARE LINKED IN A FIRST IN, FIRST OUT FASHION WITHIN ITS
!         PRIORITY. 
!      2) IF FMGR IS ABORTED WHILE RUNING A JOB THE <NEXT> AND <HEAD> 
!         FLAGS WILL SO INDICATE AND THE OFFENDING JOB MAY BE ABORTED 
!         ON THE NEXT ENTRY TO THIS ROUTINE.
!      3) THE <NEXT> POINTER INDICATES WHERE THE JOB LIST SEARCH MUST 
!         BEGIN FOR A NEW JOB TO BE INSERTED IN THE LIST. 
!      4) GASP MAY SCHEDULE A JOB ABORTION BY REQUEUEING A JOB TO BE
!         BE IN THE LIST BETWEEN <NEXT> AND <HEAD>. 
!      5) JOB DISPATCH IS RELATIVELY EASY (JOB QUEUEING IS HARDER 
!         HOWEVER, BUT THAT CODE IS ELSE WHERE (GASP,JOB)). 
! 
! 
       RD(1)                                !READ THE HEAD OF THE QUEUE 
       NEXT_($PTR1 -< 8) AND 377K           !GET THE NEXT POINTER 
       HEAD_$PTR1 AND 377K                  !AND THE HEAD OF THE LIST 
       IFNOT HEAD THEN GO TO ERRET          !IF HEAD IS ZERO THEN NO JOBS 
       IF NEXT # HEAD THEN[                 \IF HEAD # NEXT THE HEAD MUST BE ABORTED
          J.REC_HEAD+17;                    \SET UP THE JOB RECORD NUMBER 
          GO TO ABRT1]                      !AND GO FINISH THE ABORT
! 
!      NO JOBS TO ABORT  COMPUTE LOCATION OF THE CONTROL ENTRY FOR
!      THE JOB AT THE HEAD OF THE LIST SO THAT WE MAY UP DATE THE 
!      <NEXT> POINTER.
! 
       REC_(HEAD/16)+1                      !16 WORD RECORDS
       BUFPT_$1+@BUF.                       !REMAINDER IS THE BUFFER OFFSET 
       IF REC # 1 THEN CALL RD(REC)         !IN NOT IN MEMORY GET IT
       NEXT_$BUFPT AND 377K                 !GET THE NEXT POINTER 
       IF REC # 1 THEN CALL RD(1)           !IF RECORD 1 NOT IN THEN GET IT BACK
       $PTR1_(NEXT -< 8)+HEAD               !SET THE NEW NEXT POINTER 
       CALL WR(1)                           !WRITE IT TO THE FILE 
! 
!      NOW SET UP THE JOB  WE SET NEXT = J.REC TO FLAG NOT TO ABORT 
! 
       J.REC,NEXT_HEAD+17                   !COMPUTE THE JOB'S RECORD NUMBER
! 
ABRT1: RD(J.REC)                            !NEXT JOB SELECTED. 
       $PTR2    _ "A"                       !MAKE JOB ACTIVE
       WR(J.REC)                            !WRITE OUT JOBFIL RECD. 
       CALL POST(I.BUF)                     !POST THE FILE
       CALL RNRQ(4,JRN.,JSTAT)              !AND RELEASE THE LOCK 
       CALL .DFER(J.NAM,$PTR7)              !SET JOB NAME IN CASE ABORT 
       FOR I_PTS TO PTS15 DO[ $I_0]         !ZERO OUT AREA WHICH WILL 
! 
!      SET UP A SPOOL CONTROL RECORD TO INSPOOL THE JOB 
! 
       $PTS_1                               !FIX UP SET UP BUFFER 
       $PTS1_5                              !SET SWITCH LU INCASE SESSION 
       IFNOT [FL_$PTR3 AND 177400K] THEN    \IF DIRECT, SET LU
          $PTS1 _ $PTR3 
       CALL .DFER($PTS2,$PTR3)              !NAME OF FILE.
       $PTS5     _ 123456K                  !SECURITY CODE. 
       $PTS6     _ $PTR6                    !CARTRIDGE ID.
       $PTS7     _ 11K                      !DRIVER TYPE. 
       I_103K 
       IF $PTR3 = "SP" THEN[IF $PTR4 = "OL" \SET UP DISPOSITION 
          THEN I_112K ]                     !FLAGS FOR SPOOL POOL 
       $PTS8_I+40220K 
       $PTS9     _ $PTR10                   !SPOOL PRIORITY.
       $PTS11 _ J.REC + 100000K             !JOB NUMBER.
! 
       CALL LU.CL                           !RELEASE ANY OPEN SPOOLS
       LULU.(0,0) 
       GO TO OP 
OP:    .LGON($WBF),ERR_$PTR1                !LOG ON THIS USER USING ACCT# 
       ERRF _ .B.                           !LOG ON ERROR FLAG
       S.CAP_0                              !FROM THE JOB RECORD
       S.TTY_1                              !SET LOG LU 
       IF ERR < -1 THEN[                    \IF SESSION LOG ON ERROR
          IF ERRF = 8  THEN[                \IF DUP.SESSION ID THEN 
             IFNOT [SID _ LUSES(255)] THEN GO TO OP;  \ 
             CLNUM_0;                       \SET UP A RETURN CLASS
             CALL EXEC(20,0,0,0,0,0,CLNUM); \GET THE CLASS NUMBER 
             CALL EXEC(20,0,CLNUM,1,20377K,SID,LGOF); \LOG OFF
             DLNUM_CLNUM+20000K;            \SET DON'T DEALLOCATE BIT 
             CALL EXEC(100012K,LGOFF);      \THE JOB SESSION
             GO TO SESRT;                   \ABORT RETURN DEALLOCATE THE #
             CALL EXEC(21,DLNUM,0,0,I,I,I); \GET MY CLASS PUT 
SESRT:       CALL EXEC(21,DLNUM,0,0,I,F,I); \GET LOGOFF CLASS PUT 
             IF F > 0 THEN GO TO SESRT;     \ 
CLRCL:       CALL EXEC(100025K,CLNUM,0,0,I,I,I);\RELEASE THE CLASS NUMBER 
             GO TO OP;                      \DONE ON ABORT RETURN 
             GO TO CLRCL];                  \ELSE DO ANOTHER GET
\ 
          CALL FM.ER(2,$WBF,ERR);           \SEND THE PASSED BACK MESSAGE 
          ERR _ 69;                         \SET ERROR
          GO TO ABRT]                       !ABORT THE JOB
       IFNOT ERR  THEN S.CAP_ICAPS()        !IF LOGON OK THEN SET CAPABILITY
       IFNOT NOT ERR THEN ERR_ 0            !IF ERR = -1 SET TO 0 (NOT=> COMP)
       IF FL    THEN SPOPN($PTS,$PTS1)      !OPEN THE INPUT SPOOL.
       IF $PTS1 < 0 THEN [                  \IF NO LU AVAILABLE,
          ERR _ $PTS1;  GOTO ABRT]          !ABORT THE JOB. 
       LULU.(5,$PTS1)                       !SET UP LU TRANSFORM. 
       GOTO NOMOR                           !IF ERROR GO ABORT
! 
       IF S.CAP THEN[                       \IF A DIRECT LU AND IN SESSION
          IFNOT FL THEN[                    \THEN WE MUST SET UP A SWITCH 
             ERR _ FG.LU(5,$PTS1,0,$WBF);   \FOR LU 5 
             IF ERR THEN GO TO ABRT]] 
! 
       PTR5_[PTR4_[PTR1_[PTR_@G0.. -8]      \GLOBALS 0S AND 1S. 
          +1] +3] +1
       $PTR1_$PTS1
       $PTR4    _ 3 
       CALL .DFER($PTR5,$PTS2)
       IF NEXT # J.REC THEN GO TO ABRT     !IF ABORT THEN GO DO IT
! 
ABT2:  CALL B.FLG(1)                        !SET BATCH FLAG.
       TMP. _ 1                             !SET UP A LIST LU FOR NOW 
       P.TR_@CAMS.                          !ZAP THE COMMAND STACK
       ACTV. _ 1                            !SET JOB STMT. EXPECTD FLAG 
       IF JSTAT = 2 THEN [POST(I.BUF);      \POST FILE BUFFERS
          CALL RNRQ(4,JRN.,JSTAT)]          !AND CLEAR THE JOBFIL RN
       CALL OPEN.(CAM.I,CDEV,CDEV1,401K)    !OPEN THE COMMAND DEVICE
       IF TTY. THEN CAM.O _ 5               !IF TTY SET LOG DEVICE. 
       CUSE._ "1 "                          !SET UP TO CALL THE HOME SEG
       IF ERR THEN CALL MSS.(ERR)           !IF ERR REPORT IT 
       GO TO L.SEG                          !AVOID CLOSE OF JOBFIL (JO NEEDS) 
! 
!      EITHER A UNEXPECT ACTIVE JOB OR INPROPER SYS GEN. SO 
!      ABORT THE JOB
! 
NOMOR: ERR _ -24                            !IND. NO LU SWITCHES. 
ABRT:  CAD.,NO.RD_6                         !SET FLAGS TO GO TO ABORT 
       ACTV._ @CAMS. + 6                    !SET SO ABORT TAKES IT.*780420* 
       GO TO ABT2                           !GO EXIT
       END
! 
!      SUBROUTINE TO READ A RECORD TO BUF.
! 
RD:    SUBROUTINE(R) DIRECT 
       CALL READF(I.BUF,ERR,BUF.,16,LEN,R)  !READ THE RECORD
       IF ERR THEN GO TO ERRET              !IF ERROR EXIT
       RETURN                               !ELSE RETURN
       END
! 
!      SUBROUTINE TO WRITE A RECORD 
! 
WR:    SUBROUTINE(W) DIRECT 
       CALL WRITF(I.BUF,ERR,BUF.,16,W)      !WRITE THE RECORD 
       IF ERR THEN GO TO ERRET              !IF ERROR EXIT
       RETURN                               !ELSE RETURN
       END
       END
       END$ 
                                                    