       SPL,L,O
!     NAME:   JO..
!     SOURCE: 92067-18241 
!     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 JO..(8) "92067-16185 REV.1903 790514" 
! 
!      CHANGE HISTORY 
!      MODIFIED TO WORK WITH SIX WORDS PER ENTRY IN TRANSFER
!               STACK (GLM). *780420* 
!      MODIFIED TO WORK WITH SESSION MONITOR (GAA) 780914 
! 
! 
!  THE FOLLOWING ROUTINE PROCESSES THE :JOB CARD. 
! 
      LET ST.TM BE FUNCTION,REAL,EXTERNAL 
! 
       LET READF,WRITF,CLOSE,AVAIL,B.FLG,   \ 
          SET.T,EXEC,AB..,ONOFF,LULU.,EOJ,  \ 
          OPEN,EO..,SPOPN,RNRQ BE      \
             SUBROUTINE,EXTERNAL
! 
      LET TL.P,TM.VL BE REAL,EXTERNAL 
! 
       LET RANGE,                           \FIND SPOOL FILE CR 
           LOGLU,                           \FIND LOG DEVICE LU 
           KCVT,                            \CONVERT BIN TO 2 DIGIT ASCII 
           POST                             \POST FILE BUFFERS
                 BE FUNCTION,EXTERNAL 
! 
       LET ACTV.,I.BUF,BUF.,CAD.,NO.RD,JRN.,\ 
          OVRD.,N.OPL,G0..,TMP.,J.REC,P.TR BE     \ 
          INTEGER,EXTERNAL
! 
      LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT 
! 
      LET DM BE REAL
! 
       LET BLKS(3) BE INTEGER 
       INITIALIZE BLKS TO "      "
       LET SPOL.,SPOL1 BE INTEGER 
       LET JOBFL BE INTEGER(3),GLOBAL 
       LET PAR1,PAR2,PARM2,PAR3,PARM3,PAR4, \ 
          NSSW,MASK,FNUM,LEN,PTR,PTR2,RSTAT,\ 
          SETUP,SMDLU,MASK BE INTEGER 
! 
       INITIALIZE JOBFL TO "JOBFIL" 
       INITIALIZE SPOL.,SPOL1 TO "SPOL" 
! 
       LET NMASK BE CONSTANT(10000K)
       LET SEC BE CONSTANT(123456K) 
       LET IOPTN BE CONSTANT(3) 
! 
JO..:  SUBROUTINE(N,PLIST,ERR) GLOBAL 
       LET N,PLIST,ERR BE INTEGER 
       NSSW _ 0                             !RESET NO-SPOOL SWITCH. 
       PAR4 _ [PARM3 _ [PAR3 _ [PARM2 _     \SET UP POINTERS. 
          [PAR2 _ [PAR1 _ @PLIST + 1] + 7]  \ 
          + 1] + 3] + 1] + 4
       CALL EO..(-1,PLIST,ERR)              !CHECK EOJ. 
       IFNOT PLIST THEN CALL .DFER($PAR1,BLKS) !IF NO NAME USE BLANKS 
       RSTAT,ACTV. _ P.TR                   !SET ACTIVE JOB SWITCH
       CALL EXEC(11,BUF.,$(@BUF.+5))
       TL.P,TM.VL _  ST.TM(N.OPL,$(@N.OPL+1))!SET UP TIME 
       CALL B.FLG(1)                        !PUT IN BATCH MODE
       CALL SET.T(TM.VL,DM)                 !FOR THE JOB. 
       ASSEMBLE["EXT $SPCR";"LDA $SPCR";"STA SPCR"] ! GET SPOOL CR
       IF  $PAR2 = 3  THEN[                 \DEFAULT JOB PRIORITY,
          $PAR4_$PARM2;$PARM2,$PARM3 _ 99;  \IF NECESSARY, AND CHECK
            GOTO OPJOB]                     !FOR "NS" KEYWORD.
       IFNOT $PARM2 THEN $PARM2 _ 99
       IF ($PARM2 < 0) OR ($PARM2 > 255) THEN [\
          $PARM2_255]                       !PRIORITY OUT OF RANGE  USE 255 
       IF  $PAR3 = 3 THEN[                  \DEFAULT SPOOL PRIORITY 
          $PAR4_$PARM3; $PARM3 _ $PARM2]    !IF NECESSARY, AND CHECK
       IFNOT $PARM3 THEN $PARM3 _ $PARM2    !FOR "NS" KEYWORD.
       IF ($PARM3 < 0) OR ($PARM3 > 9999) THEN \TEST LIMITS ON SPOOL PR 
          $PARM3_9999                       !DEFAULT SPOOL PR IF OUT OF RANGE 
OPJOB: IF $PAR4 = "NS" THEN NSSW _ 400K 
       DPF_412K                             !SET DISPOSITION FOR  OUT 
       IF $PAR4 = "NO" THEN DPF_410K        !IF HOLD REQUESTED SET IT 
       IFNOT J.REC THEN GOTO EJECT
       IF POST(I.BUF) = -9     THEN[        \IF JOB FILE NOT OPEN 
         OVRD. _ [FNUM _ OVRD.] OR 100000K; \SAVE AND SET OVERRIDE FLAG 
         CALL OPEN(I.BUF,ERR,JOBFL,IOPTN,SEC,SPCR); \OPEN UP JOBFIL.
         OVRD. _ FNUM]                      !RESET THE OVERRIDE FLAG
       IF ERR < 0 THEN GOTO ABORT           !STUFF.  ABORT ON OTHER 
       MASK,FNUM,ERR _ 0                    !ERROR.  IF "NS" KEY, 
       SETUP _ [PTR _ @BUF.+5] + 1          !BYPASS SOME SETUP. 
       POST(I.BUF)
       RNRQ(1,JRN.,RSTAT)                   !LOCK JOBFIL RN.
       IF NSSW THEN [PTR _ SETUP + 16;      \ 
          TMP._LOGLU(ID);                   \IF NO LIST DEFAULT IT TO LOGLU 
          GOTO RDJOB] 
       LULU.(6,0)                           !MAKE SURE WE HAVE
       GOTO NOMAP                           !$LUSW SPACE. 
       REPEAT 16 TIMES DO                   \CLEAR SETUP BUFFER.
          [$[PTR _ PTR+1] _ 0]
       $(SETUP+1) _ 6                       !SET THE LIST LU IN SPOPN BUFFR 
       $[REAL](SETUP+2) _ $[REAL]@SPOL. 
       CALL READF(I.BUF,ERR,$[PTR_PTR+1],   \READ JOBFIL RECORD 17. 
          16,LEN,17)
       IF ERR THEN GOTO ABORT 
       CALL AVAIL($(PTR+4),MASK,FNUM)       !FIND AVAIL. SPOOL FILE.(SET BIT) 
       $(SETUP+4) _ KCVT(FNUM) OR NMASK 
       CALL READF(I.BUF,ERR,$(PTR+32))      !READ JOBFIL RECORD 18. 
       IF ERR THEN GOTO ABORT 
       $(SETUP+5) _ SEC                     !SECURITY CODE. 
       $(SETUP+6) _ RANGE(FNUM,$(PTR+32))   !FIND CARTRIDGE ID. 
       $(SETUP+7) _ 12K                     !DRIVER TYPE (LP).
       $(SETUP+8) _ DPF                     !DISPOSITION FLAGS. 
       $(SETUP+9) _ $PARM3                  !SPOOL PRIORITY 
       $(SETUP+10) _ "W"                    !SPOOL STATUS.
       $(SETUP+11) _ J.REC + 100000K        !PUT IN THE JOB REC. NO.
       $(SETUP+15) _ 6                      !SAVE OUTSPOOL LU.
       WRITF(I.BUF,ERR,$PTR,16,17)
       POST(I.BUF)                          !CLEAR WAY FOR SMP. 
       RNRQ(4,JRN.,RSTAT) 
       SPOPN($SETUP,PAR2)                   !CALL SMP TO OPEN SPOOL.
       POST(I.BUF)
       RNRQ(1,JRN.,RSTAT) 
       IF PAR2< 1 THEN GOTO SFAIL           !FAILED RELEASE SPOOL FILE
       $[PAR4 _ @G0..-8] _ 1                !SET THE GLOBALS, 
       $(PAR4+1) _ PAR2                     !0S AND 1S WITH 
       $(PAR4+4) _ 3                        !THE NAME AND LU# 
       CALL .DFER($(PAR4+5),$(SETUP+2))     !OF THE LIST SPOOL
       CALL LULU.(6,PAR2) 
       GOTO EJECT 
RDJOB: CALL READF(I.BUF,ERR,$[PTR2_PTR+16], \READ JOBFIL RECORD FOR 
          16,LEN,J.REC)                     !CURRENT JOB. 
       $PTR2 _ $PARM2 + NSSW                !UPDATE THE INFORMATION.
       CALL .DFER($(PTR2+7),$PAR1)          !SET JOB NAME IN RECORD 
       $[PAR4 _ PTR2 + 10] _ $PARM3         !SPOOL PRIORITY 
       LEN _ PAR4 + 1 + ((FNUM-1) >-4)
       $LEN _ $LEN OR MASK                  !SET SPOOL-IN-USE BIT.
       WRITF(I.BUF,ERR,$PTR2,16,J.REC)      !REWRITE THE JOB RECORD 
       IF ERR THEN GOTO RELRN 
EJECT: G0.. _ [IF $(P.TR-3) THEN 3,ELSE 1]  !SET ASCII\NUMERIC FLAG*780420* 
       CALL .DFER($(@G0..+1),$(P.TR-5))     !SAVE CURRENT NAMR     *780420* 
       IFNOT $PAR1 THEN $PAR1,$(PAR1+1),    \ 
          $(PAR1+2) _ 20040K
       IFNOT NSSW THEN [                    \IF PRINTING NOT INHIBITED
         TMP. _ 6;                          \SET UP LIST LU AND 
         CALL EXEC(3,1106K,-1);             \DO TOP OF FORM AND 
         CALL ONOFF($PAR1,BUF.);            \PUT OUT THE TIME ON MESSAGE
         CALL EXEC(3,1106K,-1)]             !AND THROW AWAY THAT PAGE TOO 
       GOTO RELRN 
! 
SFAIL: CALL READF(I.BUF,ERR,$PTR,16,LEN,17) !SETUP FAILED GET POOL FLAGS
       LEN_PTR+4+((FNUM-1) >- 4)            !COMPUTE ADDRESS OF FLAG WE SET 
       $LEN_$LEN AND (NOT MASK)             !AND CLEAR IT 
       CALL WRITF(I.BUF,ERR,$PTR,16,17)     !REWRITE THE FLAGS
       GO TO SUSP                           !NOW GO REPORT THE ERROR
! 
ABORT: CAD. _ 6;  NO.RD _ 1                 !SET UP FOR AB..
       GOTO RELRN 
NOMAP: ERR _ -24
       GOTO RELRN 
SUSP:  ERR _ PAR2 
RELRN: IF RSTAT = 2 THEN [POST(I.BUF);      \ 
          RNRQ(4,JRN.,RSTAT)] 
       RETURN 
! 
       END
       END
       END$ 
                            