ASMB,Q,C
      HED JOB ROUTINE 
*     NAME:   JOB 
*     SOURCE: 92067-18354 
*     RELOC:  92067-16350 
*     PGMR:   G.A.A.
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
      NAM JOB,130,30 92067-16350 REV. 1903 790529 
      SUP 
* 
      EXT EXEC      SYSTEM CALLS
      EXT RMPAR     PARAMETER RETRIEVAL 
      EXT OPEN      FILE MANAGER OPEN 
      EXT READF     FILE MANAGER READ 
      EXT WRITF     FILE MANAGER WRITE
      EXT CLOSE     FILE MANAGER CLOSE FILE 
      EXT REIO       REENTRANT I/O ROUTINE
      EXT .DRCT     PICK UP DIRECT ADDRESS
      EXT RNRQ      RESOURCE NUMBER CONTROL 
      EXT POST      POST FILE BUFFER
      EXT .DFER     MOVE THREE WORDS ROUTINE
      EXT LURQ      LOCK LU ROUTINE 
      EXT SPOPN     SPOOL OPEN ROUTINE
      EXT $LUAV     SPOOL LU TABLE
      EXT NAMR      PARSE ROUTINE FOR NAMERS
      EXT IFTTY     INTERACTIVE TEST FUNCTION 
      EXT .UACT     ROUTINE TO CONVERT USER NAME TO ACCT# 
      EXT OVRD.     OVERRIDE FLAG 
      EXT .CACT     ROUTINE TO GET CURRENT USER ACCT# 
      EXT $SPCR     JOBFIL DISC CR (-LU)
      EXT LOGLU     LOG LU FINDER 
      EXT KHAR      CHARACTER PUSHERS-GET 
      EXT SETDB     CHARACTER PUSHERS-SET DESTINATION 
      EXT SETSB     CHARACTER PUSHERS-SET SOURCE
      EXT CPUT      CHARACTER PUSHERS-PUT CHAR. 
* 
IDCB  BSS 144 
ONBF  BSS 4         DO NOT REARRANGE THESE BUFFERS
COMND BSS 16
BUFR  BSS 41
BUFR2 BSS 17
SAVE  BSS 1 
SAVE1 BSS 1 
RECNO BSS 1 
RECNT BSS 1 
FILNO BSS 1 
SPLU  BSS 1 
IBUFL BSS 1 
BUFL1 BSS 1 
OLU   OCT 401 
* 
      ORG IDCB      PUT INIT CODE IN BUFFERS
* 
BEM   JSB RMPAR     RETRIEVE PARAMETERS.
      DEF *+2 
      DEF COMND+5 
      JSB LOGLU     FETCH THE LOG LU
      DEF *+2 
      DEF OLU 
      STA OLU       SET THE DEFAULT LOG LU
      LDA COMND+5   IS FIRST PARAMETER ASCII? 
      SSA           OR NEGATIVE 
      JMP BEN2      FORGET INTERACTIVE SET UP 
* 
      ADA CCOMP 
      SSA,RSS 
      JMP BEN2      YES.
* 
      LDA COMND+5   GET INPUT DEVICE LU.
      SZA,RSS       MAKE DEVICE 5 THE DEFAULT.
      LDA D5
      IOR CNWD
      STA CONWD 
      ADA B200      FORM DYNAMIC STATUS COMMAND WORD
      STA DYSTA     SAVE IT 
      JSB IFTTY     CHECK IF INTERACTIVE
      DEF INTYS     DEVICE
      DEF CONWD 
INTYS LDB CONWD     PRESET B FOR INTERACTIVE
INTY0 SSA,RSS       IF NEGATIVE THEN INTERACTIVE
      JMP BEM1      NOT INTERACTIVE CONTINUE
* 
INT   STB OLU       SET AS OUTPUT LU TOO
      CLA 
      STA RDREC     SET TO PROMPT 
      JMP BEN2      SKIP THE LU LOCK IF INTERACTIVE 
* 
BEM1  JSB LURQ      LOCK THE LU IF NOT INTERACTIVE
      DEF BEN2
      DEF D1        LOCK WITH WAIT
      DEF CONWD     THIS LU 
      DEF D1        ONLY ONE OF THEM
BEN2  CLA 
      STA EOJSW     CLEAR EOJ SWITCH. 
      JSB EXEC      FETCH THE TURN ON STRING
      DEF SRTN
      DEF D14 
      DEF D1        READ IT 
      DEF BUFR      TO THE INPUT BUFFER 
      DEF BUFLN 
SRTN  STB IBUFL     IBUFL IS THE INPUT LENGTH IN + CHAR.
      CMB,CCE,INB   AND 
      STB BUFL1     BUFL1 IS THE INPUT LENGTH IN - CHAR.
      LDA OVRD.     SAVE THE OLD OVERRIDE FLAG
      STA OVRD      AND 
      RAL,ERA       SET THE SIGN BIT ON IT
      STA OVRD.     SET THE NEW FLAG FOR CLEAN UP 
      JMP OPFL3     GET OUT OF DCB FOR OPEN 
* 
TST0  EQU COMND+10-* ERROR MEANS WE ARE ABOUT TO OVERLAY
* 
      ORG BUFR2     SKIP OVER THE RU PRAMS
* 
OPFL3 XLA $SPCR     GET THE JOB FILE CR 
SPCR  STA SPCR      SAVE IT HERE
OPFL4 JSB OPEN      OPEN JOBFIL 
      DEF *+7 
      DEF IDCB
      DEF IERR
      DEF JOBFL 
      DEF IOPTN 
      DEF ISECU 
      DEF SPCR      SPOOL DISC
      CPA N8        DID WE SUCCEED? 
      JMP OPFL4     KEEP TRYING.
* 
      JSB JOBFE      OPEN ERROR.  RING BELLS. 
* 
      LDA D17 
      JSB GTREC     GET JOBFIL RECORD 17. 
      LDA BUFR2     SAVE JOBFIL RN. 
      STA JRN 
      LDA BUFR2+14  SAVE RN FOR HOLDING INSPOOLING. 
      STA WRN 
      LDA BUFR2+1 
      STA RECNT     SAVE RECORD COUNT.
      JMP CLEAN     SKIP OUT OF BUFFERS 
      ORR           BACK TO STD. CORE 
* 
*     THE FOLLOWING CODE CLEANS UP AFTER THIS PROGRAM IF IT WAS 
*     ABORTED WHILE DOING AN INSPOOL. 
* 
*     TO CLEAN UP WE MUST:
* 
*     1. CALL SMP TO KILL THE SPOOL POOL FILE (CLEANS UP SMP'S RECORDS) 
*     2. OPEN AND CLOSE THE POOL FILE PURGING EXTENTS (GET BACK DISC) 
*     3. CLEAR THE BIT MAP BIT THAT SAYS THE FILE IS ASSIGNED 
*     4. CLEAR THE JOBFILE RECORD(RETURN IT TO POOL)
*     5. CLEAR THE FLAGS IN JOBFIL RECORD 17 THAT SAY THESE THINGS
*        MUST BE DONE 
* 
*     THIS CODE IS DONE IN SUCH AN ORDER THAT NO MORE HARM IS DONE
*     IF IT IS ABORTED AT ANY TIME SO WATCH OUT DON'T REARRANGE IT. 
* 
*     YES I KNOW IT WOULD BE FASTER AND TAKE LESS CODE BUT WE NEED
*     FAIL SAFE OPERATION HERE. 
* 
*     FLAGS KEPT IN REC 17 TO HELP: 
* 
*     WORD 10 SPLCON REC # OF SPOOL CON ENTRY (SAFE EVEN AFTER REBOOT)
*     WORD 11 WORD ADDRESS OF BIT MAP BIT TO CLEAR
*     WORD 12 BIT TO CLEAR IN SPOOL POOL BIT MAP
*     WORD 13 JOBFIL RECORD NUMBER OF RECORD TO CLEAR 
* 
CLEAN JSB LKRNP     POST AND LOCK THE RN
      LDA D17       GET A CLEAN 
      JSB GTREC     RECORD 17 
      LDB BUFR2+10  GET THE SPLCON RECORD NUMBER IF ONE 
      SZB,RSS       IS THEIR? 
      JMP NOSP      NO SKIP SMP CALL
* 
      JSB CLRN      CLEAR RN FOR SMP
      JSB EXEC      CALL SMP TO CLEAN UP ITS RECORDS
      DEF *+5 
      DEF D23 
      DEF SMPA
      DEF D13       KILL CODE 
      DEF BUFR2+10  RECORD NUMBER 
      JSB LKRNP     POST AND LOCK THE RN
      LDA D17       GET THE RECORD AGAIN
      JSB GTREC 
      CLB           CLEAR FLAG TO SHOW
      STB BUFR2+10  WE HAVE CALLED
      JSB WRTRC     WRITE IT AND
      JSB POST1     MAKE SURE IT GETS TO THE DISC 
NOSP  LDA BUFR2+13  NOW GO GET THE
      SZA,RSS       JOB RECORD IF ONE 
      JMP NJREC     NO JOB RECORD  SKIP RELEASE 
* 
      JSB GTREC     GET THE RECORD
      JSB OPEN      OPEN THE SPOOL FILE 
      DEF *+7 
      DEF JDCB
      DEF IERR
      DEF BUFR2+3   NAM FROM JOBREC 
      DEF ZERO      EXCLUSIVE OPEN
      DEF ISECU     SAME SECURITY CODE
      DEF BUFR2+6   CARTRIDGE 
      JSB CLOSE     CLOSE IT AND TRUNCATE EXTENTS 
      DEF *+4 
      DEF JDCB
      DEF IERR
      DEF N8        NEGATIVE NO TO PURGE EXTENTS
* 
      CCA           STILL HAVE JOB RECORD AND RN LOCK 
      STA BUFR2     CLEAR USAGE FLAG
      JSB WRTRC     WRITE IT OUT
      LDA D17       NOW RETRIEVE
      JSB GTREC     RECORD 17 
      CLA           CLEAR THE RECORD FLAG 
      STA BUFR2+13
NJREC LDB BUFR2+11  GET THE OFFSET TO 
      SZB,RSS       THE BIT MAP 
      JMP NBITS     NONE
* 
      ADB DBUF      INDEX TO THE WORD 
      LDA BUFR2+12  GET THE BIT TO BE CLEARED 
      CMA           CHANGE TO AND MASK
      AND B,I       CLEAR THE BIT 
      STA B,I       SET IT BACK 
      CLA 
      STA BUFR2+11  CLEAR THE PRESENTS FLAG 
NBITS JSB WRTRC     WRITE IT OUT
      JSB CLRNP     POST AND CLEAR THE RN 
* 
*     END OF CLEAN UP CODE
* 
      LDA COMND+5   IS THE FIRST PARAMETER
      SSA           NEGATIVE??
      JMP TERM      YES  CALL WAS TO CLEAN UP ONLY
* 
      ADA CCOMP     AN ASCII PARAMETER? 
      SSA           IF SO, TREAT AS A 
      JMP RDREC     SIMULATED XEQ.
* 
      LDB IBUFL     RESTORE THE TLOG
STRTN SZB,RSS       IF NO STRING
      JMP TERM      JUST EXIT 
* 
      CLA,INA       SET UP THE INITIAL CHAR. POS FOR NAMR 
      STA CHPOS     AND 
      JSB IN        SKIP OVER THE RU, 
      JSB IN        AND THE JOB,
      JSB IN        AND GET THE FILE NAME 
      JSB XEQQ      DO XEQ THING
      JMP TERM      GO EXIT 
* 
* 
RDREC JMP NACT      IF NOT INTERACTIVE JUMP 
* 
      JSB EXEC      ELSE SEND A 
      DEF NACT      ";" 
      DEF NWWC      WRITE REQUEST 
      DEF OLU       AS A PROMPT 
      DEF SCOL
      DEF N2
NACT  NOP           IGNORE ERRORS.
      JSB REIO      READ A CARD (OR TAPE LINE). 
      DEF *+5 
      DEF RCODE 
      DEF CONWD 
DBUFR DEF BUFR
      DEF BUFLN 
      STB IBUFL 
      CMB,INB 
      STB BUFL1 
      STA STAT      SAVE STATUS WORD. 
      STA LASTH     CLEAR LAST HOLD FLAG
      RAL,CLE,ELA   MOVE DOWN BIT TO E REG. 
      ALF,RAL       MOVE EOF BIT TO SIGN
      RAL           POSITION. 
      SSA 
      JMP EOF       EOF CONDITION.
* 
      SZB           ZERO LENGTH?
      JMP PRS       NO - NORMAL RECORD. 
* 
      AND B70       IF DEVICE TYPE < 10  OR 
      SEZ,CCE,SZA   DEVICE NOT DOWN, THEN EOF.
      JMP NACT      ELSE RETRY THE READ.
* 
      JMP EOF 
* 
WRIT  NOP           WRITE A RECORD ROUTINE
      JSB REIO      WRITE THE CARD TO CURRENT SPOOL FILE. 
      DEF *+5 
      DEF NWWC
      DEF ICNWD 
      DEF BUFR
      DEF BUFL1 
      JMP IOER      ERROR CONDITION - FLUSH THE JOB.
* 
      JSB TSTEX     TEST EXTENT OVERFLOW
      JMP WRIT,I    OK EXIT 
* 
      JMP WRIT+1    TRY AGAIN IF NEEDED 
* 
IOER  JSB ERMS      ERROR ON WRITE TO THE SPOOL FILE
      DEF WRITE     SO REPORT IT
      JSB JERR      JERR DOES NOT RETURN ON ERROR 
WRITE ASC 3,WRITE 
DYSTA NOP 
N8    DEC -8
CHPOS NOP 
OPPS  ASC 2,OOPS
* 
PRS   LDA BUFR
      AND C377
      CPA COLON     IS THIS A BM COMMAND CARD?
      JMP PRCOM     YES.  PARSE IT. 
* 
OTHER CLA 
      CPA EOJSW     ARE WE READING IN A JOB?
      JMP RDREC     NO.  IGNORE THE CARD. 
* 
WRREC JSB WRIT      WRITE THE CARD TO CURRENT SPOOL FILE. 
* 
      LDA STAT      HAVE WE AN EOF
      ALF,ALF       CONDITION?
      SSA,RSS 
      JMP RDREC     NO - GO READ NEXT CARD. 
* 
      AND B77       YES - IS THIS A PT READER?
      CPA RCODE 
      RSS           YES - DO AN EOF.
      JMP RDREC 
* 
      JSB WAITM     WRITE OUT A MESSAGE 
      ASC 3,PT
D7    DEC 7         MESSAGE LENGTH
      JSB EXEC      NOW PAUSE UNTIL 
      DEF CONT      THE OPERATOR PUTS 
      DEF D7        THE NEXT TAPE IN THE
      DEF ZERO      AND SETS JOB GOING
      DEF RCODE     AGAIN.
CONT  JMP RDREC     LOOK FOR MORE INPUT.
* 
TSTEX NOP           TEST FOR EXTENT OVERFLOW
      ALF,ALF       GET EOF BIT TO SIGN 
      SSA,RSS       EOF SET?
      JMP TSTEX,I   NO RETURN OK
* 
      JSB EXEC      CAN USE EXEC CALL BECAUSE 
      DEF *+3       THIS CALL JUST REMOVES THE EOF STATUS 
      DEF D3
      DEF BSCWD     BACK SPACE TO BE READY TO RETRY 
* 
      LDA LASTH     HAVE WE ALREADY SENT THE MESSAGE? 
      SZA,RSS 
      JMP WEXT      YES JUST WAIT 
* 
      CLA           SET FLAG TO SHOW ALREADY SENDT
      STA LASTH 
      JSB WAITM     SEND THE EXTENT WAIT MESSAGE
      ASC 3,EXTENT
B11   OCT 11        9 WORDS 
* 
WEXT  JSB WAIT      WAIT FOR THE RN 
      ISZ TSTEX     TRY AGAIN 
      JMP TSTEX,I   EXIT IS P+2 
* 
EOF   LDA EOJSW     HOPPER EMPTY OR EOT.
      SZA,RSS 
      JMP TERM      TERMINATE IF NOT READING A JOB. 
* 
      CLA 
* 
      STA BUFL1     WRITE 0 LENGTH RECORD.
      JMP WRREC 
* 
TERM  JSB CLOSE 
      DEF *+4 
      DEF IDCB
      DEF IERR
      DEF ZERO
      CLA,INA       CLEAR JOBFIL RN IF NECESSARY. 
      CPA JSTAT 
      RSS 
      JSB CLRN
      JSB EXEC      TERMINATE THE BEM.
      DEF *+2 
      DEF D6
* 
* 
PRCOM LDA DBUFR 
      LDA D2        SKIP ":"
      STA CHPOS     IN THE INPUT LINE 
      JSB IN        PARSE FIRST PRAM
      SSA           IF END OF LINE FOUND
      JMP OTHER     FORGET THE WHOLE THING
* 
      LDA COMND     GET THE COMAND
      CPA "EO"      SO WHAT DO WE HAVE??
      JMP EOJCD     :EOJ
* 
      CPA "XE"
      JMP XEQ       :XEQ
* 
      CPA "JO"
      RSS 
      JMP OTHER 
* 
      CLA           :JOB
      CPA EOJSW 
      JMP OPFIL     *+2 
* 
      JSB EOJ       CLOSE LAST SPOOLFILE. 
OPFIL JSB LKRNP 
      JSB JSRCH     FIND A JOB RECORD 
      LDA D17 
      JSB GTREC     GET JOBFIL RECORD 17. 
      LDA N5
      STA BUFR2+9   TRY TO FIND AN AVAILABLE
      LDA WD4AD 
      STA CLRN
      CLA,INA       SPOOL FILE
      STA FILNO 
      CLB,INB 
      CCA 
      STA CLEAR 
OLOOP LDA N16 
      STA BUFR2+11
ILOOP LDA CLRN,I
      AND B 
      SZA,RSS 
      JMP HAVIT 
* 
NOT1  RBL 
      ISZ FILNO 
      ISZ BUFR2+11
      JMP ILOOP 
* 
      ISZ CLRN
      ISZ BUFR2+9 
      JMP OLOOP 
* 
      JSB POST1 
NOHAV JSB CLRN      WAIT UNTIL THERE IS AN
      JSB HLDIN     AVAILABLE SPOOL FILE. 
      JMP OPFIL 
* 
D10   DEC 10
"00"  ASC 1,00
D3    DEC 3 
SVBIT NOP 
* 
HAVIT ISZ CLEAR     TEST IF FIRST AVAILABLE FILE
      RSS           IF SECOND SKIP TO USE IT
      JMP NOT1      DO NOT USE FIRST ONE (LEAVE FOR OUT SPOOL)
* 
      LDA FILNO     SET UP THE SPOOL USAGE FLAG 
      CMA,INA       DIVISION OF FILE # BY 16. 
      ADA BUFR2+2   IS FILNO > # OF SPOOL 
      SSA            POOL FILES?
      JMP NOHAV     YES - NO GOOD.
* 
      LDA CLRN,I    NO - OK.
      XOR B         FIX AVAILABILITY BITS.
      STB SVBIT     SAVE BIT FOR REC 17 
      STA SAVFL     SAVE THE NEW WORD 
      LDA D18       HAVE AN AVAILABLE SPOOL FILE. 
      JSB GTREC     GET JOBFIL RECORD 18. 
      CLB           SET UP FOR DIVIDE 
      LDA FILNO     CONVERT THE FILE NUMBER TO ASCII
      DIV D10 
      ALF,ALF       A HAS HIGH ORDER, B LOW 
      ADA B 
      ADA "00"      ADD THE ASC '00'
      STA SAVE1 
      LDA BUFAD     FIND THE LOCATION INFORMATION 
      STA SAVE      FOR THE FILE. 
RANGE LDA SAVE,I
      ALF,ALF 
      ADA SAVE,I
      AND B377
      CMA,INA 
      ADA FILNO 
      ISZ SAVE
      SSA 
      JMP *+3 
* 
      ISZ SAVE
      JMP RANGE 
* 
      LDA SAVE,I
      STA SAVE
      LDA DBUF2 
      JSB CLEAR 
      LDA SAVE
      STA BUFR2+6   SAVE DISC LABEL.
      LDA SAVE1 
      STA BUFR2+5 
      LDA SPOL
      STA BUFR2+3   SAVE FIRST PART OF FILE NAME. 
      LDA SPOL+1
      STA BUFR2+4 
      LDB "I"       FINISH SETTING UP THE JOBFIL
      JSB FJOBF     ENTRY.
      JMP RDREC     ERROR FLUSH THE JOB 
      JSB .DRCT 
      DEF COMND 
      JSB CLEAR 
      JSB .DFER     FORM THE BUFFER TO PASS 
      DEF COMND+2   TO THE SMP. 
      DEF BUFR2+3   MOVE JOB LOCATION.
      LDA BUFR2+6 
      STA COMND+6   CARTRIDGE ID. 
      LDA ISECU 
      STA COMND+5   SECURITY CODE.
      LDA DFLAG 
      STA COMND+8   DISPOSITION FLAGS.
      CCE           SET UP E FOR RECNO
      LDA RECNO     JOBFIL RECD. # OF JOB.
      STA NUM       SET THE RECORD NUMBER FOR WRITE 
      RAL,ERA       SET SIGN BIT TO FLAG AS A JOB SPOOL 
      STA COMND+11
      JSB WRTRC     SET UP TO UPDATE
      LDA D17       RECORD 17 
      JSB GTREC     AND 
      LDA RECNO     SET THE IN
      STA BUFR2+13  PROCESS FLAG
      LDA SAVFL     SET THE SPOOL FILE
      STA CLRN,I    IN USE FLAG 
      LDA SVBIT     GET THE BIT POSITION
      STA BUFR2+12  SET IT
      LDA DBUF      COMPUTE THE BUFFER OFFSET 
      CMA,INA       TO THE BIT
      ADA CLRN      AND 
      STA BUFR2+11  SET THAT
      JSB WRTRC     AND WRITE THE RECORD
      JSB CLRNP     POST AND UNLOCK THE FILE
* 
STUP2 CLA 
      STA COMND+7   DRIVER TYPE.
      JSB SPOPN     CALL TO OPEN THE SPOOL FILE 
      DEF *+3       RETURN
      DEF COMND     SET UP BUFFER 
      DEF SPLU      THE LU
      LDA SPLU      GET THE LU THAT IS PASSED BACK
      SSA,RSS       WAS SETUP SUCCESSFUL? 
      JMP STUP1     YES, GO DO IT 
* 
      JSB HLDIN     NO WAIT UNTIL AN LU OR SUCH 
      JMP STUP2     FREES UP.  SMP WILL CALL BACK.
* 
STUP1 STA EOJSW 
      STA ICNWD     SET CONTROL WORD FOR WRITES.
      ADA B200      SET UP A BACKSPACE
      STA BSCWD     FOR EXTENT PROBLEMS 
      JSB LKRNP     LOCK UP THE JOB FILE
      LDA D17       AND GET THE JOB RECORD
      JSB GTREC     AGAIN 
      JSB .DRCT     GET THE LU FROM 
      DEF $LUAV     THE LU TABLE
      LDB A,I       GET LENGTH
      STB CLRN      SET FOR COUNT 
NXTLU INA           STEP TO LU
      LDB A,I       GET THE LU
      INA           STEP TO THE RECORD NUMBER 
      RBL,CLE,ERB   CLEAR SIGN IF SET 
      CPB SPLU      THIS THE LU?
      JMP FSPLU     YES GO SET UP 
* 
      ISZ CLRN      STEP COUNT
      JMP NXTLU     TRY NEXT ONE
* 
      DLD OOPS      SET UP THE MESSAGE
      JSB FMPER 
      DEF INCK
INCK  ASC 3,CHECK 
OOPS  ASC 2,OOPS
* 
FSPLU LDA A,I       GET THE RECORD NUMBER 
      STA BUFR2+10  SET IN THE JOB FILE REC 17
      JSB WRTRC     WRITE IT OUT
      JSB CLRNP     POST AND CLEAR THE RN 
      JMP WRREC     GO WRITE OUT THE JOB CARD.
* 
SAVFL NOP 
BSCWD NOP 
B200  OCT 200 
* 
WAIT  NOP 
      JSB RNRQ      LOCK THE WAIT RN GLOBALLY.
      DEF *+4       WHEN A CONDITION IN SMP 
      DEF D2        FREES AN LU OR A FILE OR
      DEF WRN       A FULL OUTSPOOL QUEUE, SMP
      DEF SAVE      CLEARS THIS RN SO THAT OTHER
      JSB RNRQ      PROGRAMS CAN CONTINUE.
      DEF *+4 
      DEF D6
      DEF WRN       LOCK THE RN.
      DEF SAVE
      JMP WAIT,I
* 
HLDIN NOP 
      LDA HLDIN     GET ADDRESS OF LAST CALL
      CPA LASTH     SAME??
      JMP HLD1      YES DON'T RESEND THE MESSAGE
* 
      STA LASTH     NO SET NEW ADDRESS AND SEND THE MESSAGE 
      JSB WAITM     SEND WAIT ON SPOOL RESOURCE MESSAGE 
      ASC 3,SPOOL 
D13   DEC 13
HLD1  JSB WAIT      WAIT FOR IT 
      JMP HLDIN,I   RETURN
* 
WAITM NOP           MESSAGE FIXER AND SENDER
      JSB .DFER     FIX UP THE MESSAGE
      DEF MES       MOVE IN THE 3 WORDS 
      DEF WAITM,I 
      STA WAITM     SET THE ADDRESS OF THE LENGTH 
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF OLU 
      DEF RESWT 
      DEF WAITM,I 
      ISZ WAITM     ADVANCE THE RETURN ADDRESS AND
      JMP WAITM,I   RETURN
* 
LASTH NOP           ADDRESS OF LAST HOLD
* 
XEQ   CLA 
      CPA EOJSW     IF THERE IS A JOB SPOOL 
      RSS           NOT COMPLETED, THEN END IT. 
      JSB EOJ 
      JSB IN        PARSE THE JOB FILE NAME 
      JSB XEQQ      DO XEQ THING
      JMP RDREC     GO GET NEXT RECORD
* 
COMN2 BSS 10
XEPR  NOP 
OVRD  NOP           SPACE TO SAVE THE OVERRIDE FLAG 
* 
*     XEQQ SUBROUTINE 
* 
*     THIS SUBROUTINE FINISHES THE ENTRY OF XE COMMANDS EITHER FROM 
*     ':XE,NAMR,PRIORITY' OR FROM 'RU,JOB,NAMR,PRIORITY'
* 
*     ASSUMPTIONS:
* 
*     1.  FILE NAMR IS PARSED IN COMND BUFFER 
*     2.  NEXT CALL TO NAMR WILL GET THE JOB PRIORITY.
* 
*     ACTION: 
* 
*1.  THE JOB FILE NAME IS ENTERED IN THE JOB RECORD THEN
*2.  THE JOB FILE IS OPENED AND THE DISC ADDRESS IS TAKEN FROM THE DCB
*3.  THE JOB CARD (MUST BE FIRST CARD) IS READ AND THE USER ID IS 
*    USED BY THE ROUTINE FJOBF TO FINISH THE JOB RECORD 
*4.  THE JOB RECORD IS ENTERED IN THE JOB FILE AND QUEUED FOR EXECUTION 
* 
XEQQ  NOP           XEQ SUBROUTINE - ENTER AFTER PARSE OF FILE
      LDA DBUF2     CLEAR THE JOB SET UP BUFFER 
      JSB CLEAR 
      JSB IN2       INPUT THE PRIORITY INFO 
      LDA COMN2     AND 
      STA XEPR      SET IT IN THE TEMP
      JSB .DFER     MOVE IN THE JOB'S FILE NAME 
      DEF BUFR2+3 
      DEF COMND     FROM THE COMAND BUFFER
      LDA COMND+3   CHECK IF THE NAME 
      AND D3        IS REALLY AND LU
      CPA D1        IF SO 
      JMP XELU      GO HANDLE IT
* 
      LDA OVRD      RESTORE THE OVERRIDE FLAG FOR 
      STA OVRD.     USER ACCESS 
      JSB OPEN      ELSE OPEN THE JOB FILE
      DEF XEOPN 
      DEF JDCB
      DEF IERR
      DEF COMND 
      DEF D1
      DEF COMND+4 
      DEF COMND+5 
XEOPN LDB OVRD      SET UP THE OVERRIDE FLAG FOR JOBFIL AGAIN 
      CCE 
      RBL,ERB 
      STB OVRD. 
      JSB FMPER     CHECK FOR ERRORS
      DEF COMND     (NO RETURN IF ERROR)
      LDA JDCB      PICK UP THE DISC LU FROM THE DCB ********************** 
      AND B77       ISOLATE IT AND
      CMA,INA       SET UP AS THE CR FOR
      STA BUFR2+6   THE JOB FILE
      JSB READF     READ THE JOB CARD TO
      DEF *+6       A LOCAL BUFFER
      DEF JDCB
      DEF IERR
      DEF BUFR
      DEF D40 
      DEF IBUFL 
      LDB IBUFL     SET UP THE CHAR. COUNTERS 
      RBL           FOR NAMR AND
      STB IBUFL     AND ECHO ROUTINES 
      CMB,INB 
      STB BUFL1 
      JSB FMPER     TEST FOR READ ERRORS
      DEF COMND     ADDRESS OF THE FILE NAME
      JSB CLOSE     WE HAVE ALL WE WANT FROM THE FILE SO
      DEF *+2       CLOSE IT
DJDCB DEF JDCB
      LDA BUFR      CHECK TO BE SURE THE LINE STARTS WITH A ':' 
      AND C377
      CPA COLON     WELL??
      CLA,INA,RSS   YES OK
      JMP JO?       NO GO TELL IT ON THE MOUNTAIN 
* 
      INA           SET TO SKIP THE ':' 
      STA CHPOS     SET UP THE CHAR POINTER FOR NAMR
      JSB IN2       AND PARSE THE JOB CARD
      SSA           END OF LINE?
      JMP JO?       TO BAD  GO FLUSH OUT AN ERROR 
* 
      LDA COMN2     IF A JOB
      CPA "JO"      CARD
      RSS           WAS READ
      JMP JO?       NO - REPORT ERROR 
* 
XELUS LDB "R"       SET THE JOB STATUS IN B AND 
      JSB FJOBF     GO FINISH THE JOB ENTRY RECORD
      JMP XEQQ,I    ERROR  - EXIT WITH OUT Q
* 
      JSB JSRCH     SEARCH FOR A PLACE TO PUT THIS. 
      JSB QUEUE     PUT THE JOB IN THE QUEUE
      JMP XEQQ,I    RETURN
* 
* 
XELU  JSB .CACT     HERE IF XE COMMAND TO AN LU 
      SZA,RSS       IF NOT IN SESSION AND 
      JMP XELUE     SESSION MONITOR INSTALLED   ERROR 
* 
      CLA           SET UP TO FOURCE
      STA IBUFL     NAMR TO RETURN
      INA 
      STA CHPOS     *** ZIP***
      JMP XELUS     AND GO ENTER THE JOB
* 
XELUE JSB BGMS      SEND MESSAGE
      DEF "ESS"     '/JOB: ERROR NOT IN SESSION'
      ASC 4,IN SNOT (THIS IS SORTED BY MS)
      JMP XEQQ,I    RETURN
* 
"ESS" ASC 3,ESSION
* 
JO?   DLD "JO?"     SEND MESSAGE
      JSB ERMS      '/JOB: EROR :JO? ON FILE XXXXX' 
      DEF COMND     ADDRESS OF FILE NAME
      JMP XEQQ,I    RETURN
* 
"JO?" ASC 2,:JO?
* 
EOJCD CLA 
      CPA EOJSW 
      JMP RDREC 
* 
      JSB WRIT      WRITE THE EOJ RECORD
      JSB EOJP      PROCESS THE EOJ 
      JSB EXEC      DO DYNAMIC STATUS 
      DEF RTNST 
      DEF D3I 
      DEF DYSTA 
      JMP RDREC     IGNOR REJECT
* 
RTNST ALF,ALF 
      RAL,RAL       HOPPER EMPTY? 
      SSA,RSS 
      JMP RDREC     NO CONTINUE 
* 
      RAR,RAR       ISOLATE DRIVER TYPE 
      AND B73 
      CPA B11       CARD READER? (CHECKS 11 OR 15)
      JMP TERM      YES - TERMINATE.
* 
      JMP RDREC     NO CONTINUE 
* 
B73   OCT 73
N5    DEC -5
D3I   OCT 100003
* 
EOJ   NOP 
      JSB REIO      PUT AN ":EOJ" IN THE BUFFER TO BE 
      DEF *+5 
      DEF WCODE 
      DEF ICNWD 
      DEF EOJC
      DEF D2
      JSB TSTEX     TEST FOR EXTENT OVERFLOW
      RSS           NO CONTINUE 
      JMP EOJ+1     YES TRY AGAIN 
* 
      JSB EOJP      PROCESS THE EOJ 
      JMP EOJ,I     RETURN
* 
EOJP  NOP           EOJ COMMON PROCESSOR
      JSB EXEC      SCHEDULE THE SMP TO CLOSE THE 
      DEF *+5       SPOOL FILE.  PASS IT THE CLOSE
      DEF D23       CODE AND THE LU# OF THE SPOOL 
      DEF SMPA
      DEF D4
      DEF SPLU
      JSB LKRNP     MAKE SURE BUFFER IS CLEAR 
      LDA RECNO 
      JSB GTREC     GET APPROPRIATE JOBFIL RECORD.
      LDA BUFR2+2   GET THE STATUS
      AND B377      IN CASE GASP HAS BEEN HERE
      CPA "H"       NOW IN HOLD?
      LDA "RH"      YES MAKE "RH" 
      CPA "I"       WHAT IT SHOULD BE?
      LDA "R"       YES SET "R" 
      STA BUFR2+2 
      JSB QUEUE     WRITE OUT AND Q THE JOBFIL RECORD.
      JSB LKRNP     POST AND LOCK 
      LDA D17       CLEAR THE INPUT IN PROGRESS 
      JSB GTREC     FLAG IN 
      CLA           RECORD
      STA BUFR2+10
      STA BUFR2+11
      STA BUFR2+12  17. 
      STA BUFR2+13
      JSB WRTRC     SEND IT BACK TO THE DISC. 
      JSB CLRNP     UNLOCK THE FILE 
      JMP EOJP,I     RETURN 
* 
*     THE JOB Q IS KEPT IN THE FIRST 256 WORDS OF THE JOBFIL
*     THE FIRST WORD IS THE RN NUMBER TO LOCK THE SECOND WORD 
*     IS A POINTER THE THE HEAD OF THE JOB Q BY PRIORITY
*     AND A POINTER THE THE NEXT JOB TO EXECUTE.  THESE WILL
*     BE THE SAME WHEN NO JOBS ARE RUNING AND NONE ARE TO BE
*     PURGED.  IF A JOB IS RUNING THE NEXT JOB POINTER WILL BE
*     ONE DOWN THE Q.  IF JOBS ARE TO BE PURGED THEY WILL BE
*     IN THE Q BEFOR THE NEXT JOB.  IF THE NEXT JOB POINTER IS
*     0 THEN ALL JOBS IN THE Q ARE TO BE PURGED (OR THERE ARE 
*     NO JOBS IN THE Q).
*     THIS WORD HAS THE NEXT JOB POINTER IN THE HIGH 8 BITS 
*     AND THE HEAD OF THE Q IN THE LOW 8 BITS 
* 
*     THESE POINTERS ARE OFFSETS INTO THE 256 WORDS OF JOB Q. 
* 
*     THE JOB Q WORDS ALSO HAVE POINTERS IN THE LOW 8 BITS
*     TO THE NEXT JOB IN THE LIST AND THE JOBS PRIORITY IN THE
*     HIGH 8 BITS OF THE WORD.
* 
QUEUE NOP           WRITE OUT JOB RECORD AND QUEUE IT 
      JSB WRTRC     WRITE IT OUT
      LDA BUFR2+2   GET STATUS
      CPA "RH"      IF HELD 
      JMP QUEX      JUST RETURN 
* 
      LDA BUFR2     GET THE JOB'S PRIORITY
      ALF,ALF       MOVE IT TO THE HIGH BYTE
      STA SAVE      AND SAVE IT (NOTE LOW BYTE IS ZERO) 
      LDA RECNO     USE RECORD # TO CACULATE
      ADA N17       THE BUFFER ADDRESS OF THE JOB'S 
      ADA DJDCB     ENTRY IN THE JOB QUEUE
      STA PTRJB     AND SAVE IT 
      JSB QUSET     SET UP TO READ THE JOB QUEUE
QURD  JSB READF     READ THE JOB Q
      DEF *+7 
      DEF IDCB
      DEF IERR
RDAD  NOP 
      DEF D16 
      DEF LEN 
      DEF NUM 
      JSB QUCHK     TEST FOR ERRORS SET FOR NEXT READ 
      JMP QURD      READ 16 RECORDS (QUCHK SKIPS AFTER 16)
* 
*     WHOLE JOB Q IS NOW IN JDCB
* 
      LDA DJDCB     SET POINTER TO
      INA           HEAD OF THE LIST
      STA QUCUR     QUCUR IS THE CURRENT HEAD 
      LDA A,I       GET THE HEAD OF THE LIST
      AND C377      GET THE NEXT POINTER
      ALF,ALF       ROTATE TO LOW AND 
      STA QUNXT     SAVE IT 
QUPUS LDA QUCUR,I   START WITH THE HEAD 
      AND B377      ISOLATE THE POINTER 
      CPA QUNXT     SKIP OVER ACTIVE OR TO BE PURGED ENTRIES
      JMP QUSHR     FOUND END SO GO DO PRIORITY SEARCH
* 
      ADA DJDCB     ELSE UP DATE THE POINTER
      STA QUCUR 
      JMP QUPUS     AROUND WE GO
* 
QUSHR LDB BUFR2+2   GET JOB STATUS
      SZA           IF ZERO THEN END OF LIST
      CPB "A"         ALSO IF ACTIVE
      JMP QUHER     SO QUEUE IT HERE
* 
      ADA DJDCB     ELSE LOOK AT THE ENTRY
      LDB A,I       GET THE CURRENT ENTRIES PRIORITY
      CMB,CLE       NEGATE THE HIGH END 
      ADB B400      ADD ONE IN HIGH HALF
      ADB SAVE      COMPAIR PRIORITIES OF THE JOBS
      SEZ,RSS       THIS THE SPOT?? 
      JMP QUHER     YES GO Q IT 
* 
      STA QUCUR     NO  RUN DOWN ONE LEVEL
      LDA A,I       GET THE NEXT ONE
      AND B377      ISOLATE IT
      JMP QUSHR     GO TEST THIS ONE
* 
QUHER CMA,INA,SZA   GET OFFSET OF THE JOB (IF ZERO IT IS ZERO)
      ADA DJDCB     SKIPS THIS IF END OF LIST 
      CMA,INA       A IS NOW THE OFFSET 
      ADA SAVE      ADD IN THE JOBS PRIORITY
      STA PTRJB,I   SET THIS ENTRY IN THE Q 
      LDA RECNO     COMPUTE A POINTER 
      ADA N17       TO THE NEW JOB
      XOR QUCUR,I   AND FIX UP THE ENTRY
      AND B377      FOR THE JOB JUST
      XOR QUCUR,I   BEFOR THE NEW ONE 
      STA QUCUR,I   UNDER THE RULES OF WOO. 
      LDA PTRJB,I   IF THE NEW ENTRY POINTS AT THE
      AND B377      SAME JOB AS THE NEXT FLAG 
      LDB BUFR2+2   GET JOB STATUS
      CPA QUNXT     THEN IT IS AT THE HEAD OF THE Q 
      CPB "A"       AND THE NEXT FLAG MUST BE UPDATED 
      JMP QUFIN     NO  WE ARE OK AS IS (ALSO FOR "A")
* 
      LDA QUCUR,I   GET THE POINTER FROM THE ENTRY
      ALF,ALF       PUT IT IN THE RIGHT PART OF THE WORD
      XOR JDCB+1    MIRGE IT IN UNDER THE RULES OF WOO
      AND C377      DONT TRUST QUHED AS IT MAY HAVE CHANGED 
      XOR JDCB+1
      STA JDCB+1    SET THE NEW HEAD
* 
QUFIN JSB QUSET     SETUP TO WRITE IT OUT 
QUWRL JSB WRITF     WRITE OUT A RECORD
      DEF *+6 
      DEF IDCB
      DEF IERR
      DEF RDAD,I
      DEF D16 
      DEF NUM 
      JSB QUCHK     CECK FOR ERRORS AND IF 16 DONE YET
      JMP QUWRL     MORE TO DO
* 
QUEX  JSB POST1     POST THE FILE BUFFER. 
      JSB CLRN
      CLA 
      STA EOJSW 
      JSB EXEC
      DEF *+4       SCHEDULE THE FILE MANAGER.
      DEF NWAIT 
      DEF FLMAN 
      DEF N5
      JMP QUEUE,I 
* 
      JMP QUEUE,I 
* 
B400  OCT 400 
QUCUR NOP 
QUNXT NOP 
QUSET NOP           ROUTINE TO SET UP TO READ THE JOB Q 
      LDA N16       SET UP TO READ 16 RECORDS 
      STA COUNT 
      LDA DJDCB     SET THE STARTING RECORD ADDRESS 
      STA RDAD
      CLA,INA       AND THE STARTING RECORD NUMBER
      STA NUM       AND 
      JMP QUSET,I   RETURN
* 
* 
QUCHK NOP           ROUTINE TO CHECK FOR Q I/O COMPLETION 
      LDA RDAD      UPDATE THE RECORD ADDRESS 
      ADA D16       BY THE RECORD SIZE
      STA RDAD
      ISZ NUM       STEP THE RECORD NUMBER
      ISZ COUNT     IF NOT YET DONE 
      JMP QUCHK,I   RETURN P+1
* 
      ISZ QUCHK     ELSE RETURN P+2 
      JMP QUCHK,I 
* 
* 
N17   DEC -17 
PTRJB NOP 
OUCUR NOP 
OUNEX NOP 
N16   DEC -16 
COUNT NOP 
"RH"  ASC 1,RH
"H"   OCT 110 
"I"   OCT 111 
"R"   OCT 122 
"A"   OCT 101 
* 
WRTRC NOP 
      JSB WRITF 
      DEF *+6 
      DEF IDCB
      DEF IERR
DBUF2 DEF BUFR2 
      DEF D16 
      DEF NUM 
      JSB JOBFE 
* 
      JMP WRTRC,I 
* 
GTREC NOP 
      STA NUM 
      JSB READF 
      DEF *+7 
      DEF IDCB
      DEF IERR
DBUF  DEF BUFR2 
      DEF D16 
      DEF LEN 
      DEF NUM 
      JSB JOBFE 
* 
      JMP GTREC,I 
* 
LEN   BSS 1 
NUM   BSS 1 
* 
POST1 NOP 
      JSB POST
      DEF *+2 
      DEF IDCB
      JMP POST1,I 
* 
CLRNP NOP 
      JSB POST1 
      JSB CLRN
      JMP CLRNP,I 
* 
LKRNP NOP 
      JSB POST1 
      JSB LKRN
      JMP LKRNP,I 
* 
CLRN  NOP 
      JSB RNRQ
      DEF *+4 
      DEF D4
      DEF JRN 
      DEF JSTAT 
      JMP CLRN,I
* 
LKRN  NOP 
      JSB RNRQ
      DEF *+4 
      DEF RCODE 
      DEF JRN 
      DEF JSTAT 
      JMP LKRN,I
* 
JSRCH NOP 
JSR1  JSB POST1 
      JSB LKRN
      LDA D18       SEARCH FOR FREE JOBFIL RECORD.
JSR2  INA 
      JSB GTRC2 
      LDA BUFR3 
      SSA,RSS 
      JMP NOTYT 
* 
      LDA NUM 
      STA RECNO 
      JMP JSRCH,I 
* 
NOTYT LDA NUM 
      CPA RECNT 
      RSS 
      JMP JSR2
* 
      JSB POST1 
      JSB CLRN      NONE AVAILABLE.  WAIT UNTIL 
      JSB HLDIN     THERE IS. 
      JMP JSR1
* 
GTRC2 NOP           READ TO BUFR3 ROUTINE 
      LDB DBUF3     SET BUFFER ADDRESS
      STB DBUF      IN GETREC CALL
      JSB GTREC     USE GTREC TO DO THE READ
      LDB D2BUF     RESTORE THE ADDRESS 
      STB DBUF      AND 
      JMP GTRC2,I   RETURN
* 
D2BUF DEF BUFR2 
DBUF3 DEF BUFR3 
CLEAR NOP 
      LDB N16 
      STB FJOBF 
      CLB 
      STB A,I 
      INA 
      ISZ FJOBF 
      JMP *-3 
* 
      JMP CLEAR,I 
* 
*     THE ROUTINE FJOBF WILL FILL OUT THE FOLLOWING JOB RECORD
*     FIELDS: 
* 
*     PRORITY  WORDS 0 AND 10 
*     ACCOUNT# WORD  1
*     STATUS   WORD  2
*     NAME     WORDS 7,8 AND 9
* 
*     THE JOB LOCATION IS FILLED IN OUTSIDE OF THIS ROUTINE 
* 
*     ASSUMPTIONS:
* 
*     1.  THE JOB RECORD IS SET UP SO THAT A CALL TO IN (OR IN2)
*         WILL PARSE THE JOB NAME NEXT
*         OR
*     2.  THE JOB IS DIRECT WHICH IMPLIES THAT THE NAME IS BLANK, 
*         AND THE ACCOUNT IS THE CURRENT USERS.  IN THIS CASE CALLS 
*         TO PARSE SHOULD RETURN  'ZIP'.
* 
* 
* 
FJOBF NOP 
      STB BUFR2+2   SAVE THE STATUS IN THE JOB RECORD 
      JSB IN        PARSE THE JOB NAME
      LDA COMND+3   IF THERE IS NO NAME 
      LDB DBLK      THEN
      AND D3        SET UP TO USE BLANKS
      CPA D3        WELL  IS THERE A NAME?
      LDB DCOMN     YES SET UP TO MOVE IT 
      STB FJSOR     SET NAME SOURCE 
      JSB .DFER     MOVE IN THE JOB NAME
      DEF BUFR2+7   ADDRESS OF THE NAME 
FJSOR NOP           ADDRESS OF THE SOURCE OF THE JOB NAME 
* 
      JSB SETSB     SET UP THE SOURCE BUFFER
      DEF *+4 
      DEF BUFR      SAME AS THE 'IN' BUFFER 
      DEF CHPOS     EVEN TO CHAR POSITION 
      DEF IBUFL 
      JSB SETDB     NOW SET THE DESTINATION 
      DEF *+3 
      DEF ERMS2     USE ERROR MESSAGE BUFFER
      DEF CCOUN     CHAR. COUNTER FOR DESTINATION 
      CLA           CLEAR 
      STA CCOUN     THE DESTINATION COUNT 
LPUSR LDA CCOUN     PROTECT AGAINST GROSS 
      CPA D40       ERRORS (MAX LEGAL IS 32 BUT WE HAVE BUFFER) 
      JMP CSESS     OVER FLOW  PASS WHAT WE HAVE
* 
NXCH  JSB KHAR      FETCH THE NEXT CHAR FROM THE STRING 
      DEF *+2 
      DEF CH        KEEP COPY FOR CPUT
      CPA BLANK     IF BLANK
      JMP NXCH      IGNOR IT
* 
      SZA           IF END OF LINE OR 
      CPA COMMA     END OF PRAM THEN
      JMP CSESS     GO CALL THE SESSION ROUTINE 
* 
      JSB CPUT      NONE OF THE ABOVE SO PUT IN 
      DEF *+2       DESTINATION BUFFER
      DEF CH
      JMP LPUSR     GO GET NEXT CHAR. 
* 
CSESS LDA CCOUN     GET THE CHAR. COUNT 
      SZA,RSS       IF NONE THEN
      JMP FJNON     USE DEFAULT 
* 
NOUSR JSB CPUT      PAD WITH A BLANK IN CASE ODD
      DEF *+2 
      DEF BLANK 
      LDA CCOUN     RESTORE THE CHAR COUNT
      LDB DERM2     IN A AND THE CHAR. ADDRESS IN B 
      JSB .UACT     CALL THE SESSION MON. INTERFACE TO GET ACCT #.
DERM2 DEF ERMS2     PASS ADDRESS OF THE ERROR BUFFER
FJUAC SSA           SEE IF IT RINGS TRUE
      CPA N1        IF POSITIVE OR SESSION NOT INSTALLED
      JMP FJUOK     THEN USER IS OK.
* 
* 
      CPB B77       IF WE NEED A PASS WORD THEN 
      INA           LEAVE OFF THE TRAILINE LEFT ARROW 
      ADA N12       ERROR IS IN BUFFER  ADD LENGTH
      JSB WER       OF PREAMBLE AND PRINT IT
      JMP FJOBE     NOW TAKE ERROR EXIT 
* 
* 
FJNON JSB .CACT     USER ID NOT SUPPLIED  USE 
      SZA,RSS       IF NOT IN SESSION THEN
      JMP NOUSR     GO FOURCE A NO SUCH USER MESSAGE
* 
      JMP FJUAC      THE CURRENT USERS ACCOUNT
* 
DBLK  DEF BLANK 
* 
FJUOK CPA N1        IF SESSION IS NOT THEN
      CLA           SET ACCOUNT FLAG TO ZERO
      STA BUFR2+1   SET ACCOUNT # IN JOB REC. 
      LDB XEPR      IF PRIORITY IN XE COMMAND 
      SZB           THEN
      JMP FJPR      GO USE IT 
* 
      LDB DEFPR     ELSE GET THE DEFAULT PRIORITY 
      LDA COMND+3 
      AND D3        CHECK FOR A PRIORITY
      CPA D1        SUPPLIED  WELL? 
      LDB COMND     YES PICK IT UP
      SZB,RSS       IF IT IS ZERO 
      INB           SET IT TO 1 
FJPR  STB BUFR2     SET PRIORITY IN THE JOB RECORD
      CPA D3        IF CURRENT PRAM IS ASCII THEN GO NO FURTHER 
      JMP FJSPR     AND USE SAME PRIORITY FOR SPOOL 
* 
      JSB IN        ELSE TRY AGAIN
      LDA COMND+3   GET THE FLAG WORD 
      AND D3        AND TEST FOR ASC
      LDB BUFR2     DEFAULT TO SAME AS JOB
      CPA D1        A NUMBER SUPPLIED?
      LDB COMND     YES PICK IT 
      SZB,RSS       IF ZERO 
      INB           SET IT TO 1 
FJSPR STB BUFR2+10  SET THE SPOOL PRIORITY
      LDA BUFR2     GET THE SUPPLIED JOB PRIORITY 
      AND B377      ISOLATE THE LOW BITS
      SZA,RSS       IF RESULT IS ZERO 
      LDA B377      USE 255 
      STA BUFR2     AND SET THE PRIORITY
      ISZ FJOBF     SET TO TAKE OK EXIT 
FJOBE DLD "ON"      RESTORE THE ERROR MESSAGE 
      DST ERMYY     BUFFER
      JMP FJOBF,I   RETURN
* 
IN    NOP           ROUTINE TO CALL NAMR
      JSB NAMR
      DEF INEX
INDEF DEF COMND 
DBF   DEF BUFR
      DEF IBUFL 
      DEF CHPOS 
INEX  JMP IN,I      RETURN
* 
IN2   NOP           ROUTINE TO CALL NAMR USING COMD2 BUFFER 
      LDA DCOM2     SET THE DEF 
      STA INDEF     IN IN 
      JSB IN        DO IT 
      LDB DCOMN 
      STB INDEF     RESTORE THE DEF 
      JMP IN2,I     RETURN
* 
DCOM2 DEF COMN2 
DCOMN DEF COMND 
N1    DEC -1
B77   OCT 77
N12   DEC -12 
COMMA ASC 1,, 
CH    NOP 
CCOUN NOP 
* 
* 
JERR  NOP 
      JSB EXEC      SEND ERROR MESSAGE
      DEF EXMS
      DEF D2
      DEF OLU 
      DEF TERMM 
      DEF D7
EXMS  JMP TERM
* 
*     BGMS          SEND A MESSAGE OF THE FORMAT: 
* 
*     /JOB: ERROR YYYYZZZZXXXXXX
* 
*     THE CALLING SEQUENCE IS:
* 
*     JSB BGMS
*     DEF XXXXXX    POINTER TO XXXXXX 
*     ASC 4,ZZZZYYYY
* 
*     (THIS SEQUENCE IS USED BECAUSE IT IS CONVIENT TO USE ERMS)
* 
BGMS  NOP           SEND A BIG MESSAGE
      LDA BGMS,I    GET THE DEF 
      STA BGCL      SAVE IT IN THE CALL 
      ISZ BGMS      STEP TO THE ASCII DATA
      DLD BGMS,I    GET THE YYYY INFO 
      DST ERMYY     SET IT IN THE MESSAGE 
      ISZ BGMS      ADVANCE THE POINTER 
      ISZ BGMS      ADVANCE THE POINTER 
      DLD BGMS,I    GET THE ZZZZ DATA 
      ISZ BGMS      ADVANCE THE POINTER 
      ISZ BGMS      ADVANCE THE POINTER 
      JSB ERMS      SEND THE MESSAGE
BGCL  NOP           POINTER THE THE XXXXXX DATA 
      DLD "ON"      RESTORE THE ' ON ' TO THE 
      DST ERMYY     YYYY FIELD
      JMP BGMS,I    AND RETURN
* 
"ON"  ASC 2, ON 
* 
* 
*     FMPER CHECKS FOR ERRORS ON A FILE ACCESS AND IF ONE 
*     ABORTS JOB AFTER PRINTING THE FOLLOWING MESSAGES: 
* 
*     '/JOB: ERROR -NNN ON XXXXXX'
*     'END JOB ABNORM'
* 
*     WHERE -NNN IS THE FMP ERROR CODE AND
*     XXXXXX IS THE FILE NAME AS PASSED IN THE CALL 
* 
*     CALLING SEQUENCE: 
* 
*     JSB FMPER 
*     DEF XXXXXX    DEF TO THE SIX CHAR. FILE NAME
* 
*     FMPER RETURNS ONLY IF A > -1 ON ENTRY 
* 
FMPER NOP 
      LDB FMPER,I 
      STB FMMS      SET UP TO MOVE THE FILE NAME
      ISZ FMPER     SET THE RETURN ADDRESS
      CMA,SSA,INA   IF A > -1 
      JMP FMPER,I   RETURN
* 
      CLB           SET UP TO CONVERT THE FMP ERROR CODE
      DIV D10       SEPERATE THE DIGITS 
      ALF,ALF       NOW MIRGE THEM BACK 
      ADB A         AND 
      ADB "00"      CONVERT TO ASCII
      LDA BLMIN     PICK UP A " -"
      JSB ERMS      PRINT THE ERROR MESSAGE 
FMMS  NOP           POINTER TO XXXXXX 
      JSB JERR      NOW TERMINATE 
* 
BLMIN ASC 1, -
* 
JOBFE NOP           SEND ERROR MESSAGES ON JOBFIL ACCESSES
      JSB FMPER 
      DEF JOBFL 
      JMP JOBFE,I   RETURN
* 
* 
*     ERMS  IS A ROUTINE TO PRINT THE FOLLOWING MESSAGE:
* 
*     '/JOB: ERROR ZZZZ ON XXXXXX'
* 
*     THE CALLING SEQUENCE IS:
* 
*     DLD ZZZZ      PUT ZZZZ IN A,B 
*     JSB ERMS      CALL HERE 
*     DEF XXXXXX    DEF TO THE ASCII XXXXXX FIELD 
* 
*     RETURN
* 
ERMS  NOP 
      DST ERMS2     SET THE ZZZZ FIELD DOWN 
      LDA ERMS,I    GET THE DEF 
      STA ERADD     SET IT IN THE CALL
      JSB .DFER     MOVE IN THE XXXXXX FIELD
      DEF ERMS3     ADDRESS OF THE XXXXXX FIELD 
ERADD NOP           ADDRESS OF THE SOURCE 
      LDA LERMS     USE STANDARD LENGTH 
      JSB WER       SEND THE MESSAGE
      ISZ ERMS      SET PROPER RETURN 
      JMP ERMS,I    RETURN
* 
* 
WER   NOP           ROUTINE TO ECHO BAD LINE AND ERROR
      STA LWER      PASS IN ERROR MESSAGE SIZE
      JSB REIO      ECHO THE OFFENDING COMMAND
      DEF *+5 
      DEF WCODE 
      DEF OLU 
      DEF BUFR
      DEF BUFL1 
* 
      JSB REIO      SEND THE ERROR MESSAGE
      DEF *+5 
      DEF WCODE 
      DEF OLU 
      DEF ERMS0 
      DEF LWER
      JMP WER,I     AND RETURN
* 
LWER  NOP 
ERMS0 ASC 6,/JOB: ERROR 
ERMS2 ASC 2,IO07    DUMMY 
ERMYY ASC 2, ON 
ERMS3 ASC 3,XXXXXX
      BSS 30        BUFFER FOR ERRORS FROM .UACT
LERMS DEC -26 
A     EQU 0 
B     EQU 1 
DEFPR DEC 99
NSPRM ASC 1,NS
NWAIT OCT 100012
FLMAN ASC 3,FMGR
D5    DEC 5 
SPOL  ASC 2,SPOL
TERMM ASC 7,END JOB ABNORM
DCOM5 DEF COMND+5 
CCOMP OCT -20000
BLANK ASC 3,
RCOLN OCT 72
N2    DEC -2
SCOL  ASC 1,;_      PROMPT
RCODE DEC 1 
IOPTN OCT 3 
WCODE DEC 2 
D2    EQU WCODE 
DFLAG OCT 40021 
B70   OCT 70
B377  OCT 377 
BUFAD DEF BUFR2 
BUFLN DEC -80 
EOJSW BSS 1 
JRN   BSS 1 
WRN   BSS 1 
JSTAT BSS 1 
NWWC  OCT 100002
C377  OCT 177400
COLON OCT 35000 
CNWD  OCT 400 
CONWD BSS 1 
ICNWD BSS 1 
STAT  BSS 1 
D6    DEC 6 
D23   DEC 23
D4    DEC 4 
ZERO  DEC 0 
D16   DEC 16
D17   DEC 17
D18   DEC 18
WD4AD DEF BUFR2+4 
IERR  BSS 1 
SMPA  ASC 3,SMP 
JOBFL ASC 3,JOBFIL
ISECU OCT 123456
"JO"  ASC 1,JO
"EO"  ASC 1,EO
EOJC  ASC 1,:E
      ASC 1,OJ
"XE"  ASC 1,XE
D1    DEC 1 
D14   DEC 14
RESWT ASC  6,JOB WAIT ON SPOOL RESOURCE 
MES   ASC 3,SPOOL 
      ASC 4,RESOURCE. 
JDCB  BSS 256       USED FOR XEQ FILE AND JOB Q 
BUFR3 EQU JDCB+144
D40   DEC 40
* 
      ORG * 
      END BEM 
                              