ASMB,R,L,C
      HED JOB ROUTINE 
*     NAME:   JOB 
*     SOURCE: 92002-18005 
*     RELOC:  92002-16005 
*     PGMR:   A.M.G.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  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,2,30 92002-16005 REV. 1805 760715 
      SUP 
* 
      EXT EXEC      SYSTEM CALLS
      EXT RMPAR     PARAMETER RETRIEVAL 
      EXT $PARS     SYSTEM PARSE ROUTINE
      EXT OPEN      FILE MANAGER OPEN 
      EXT READF     FILE MANAGER READ 
      EXT WRITF     FILE MANAGER WRITE
      EXT $LIBR     CALL FOR PRIVILEGED OPERATION 
      EXT $LIBX     LEAVE PRIVILEGED OPERATION
      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
* 
IDCB  BSS 144 
ONBF  BSS 4         DO NOT REARRANGE THESE BUFFERS
COMND BSS 16
BUFR2 BSS 17
BUFR  BSS 41
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 
      LDA COMND+5   IS FIRST PARAMETER ASCII? 
      SSA           OR NEGATIVE 
      JMP BEM2      FORGET INTERACTIVE SET UP 
* 
      ADA CCOMP 
      SSA,RSS 
      JMP BEM2      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 EXEC      CHECK IF INTERACTIVE
      DEF INTYS     DEVICE
      DEF D13 
      DEF CONWD 
      DEF EQT5
      DEF CLRN
      DEF LKRN
INTYS LDA EQT5      GET THE TYPE
      AND TYPW      ISOLATE 
      LDB CONWD     PRESET B FOR INTERACTIVE
INTY0 SZA,RSS       IF ZERO THEN INTERACTIVE
      JMP INT       SO GO SET UP
* 
      CPA TYP05     05
      RSS           COULD BE  MUST CHECK SUBCHANNEL 
      CPA TYP07     07
      RSS           AGAIN CHECK SUBCHANNEL
      JMP BEM1      NOT INTERACTIVE CONTINUE
* 
      LDA LKRN      GET THE SUBCHANNEL
      AND D7        ISOLATE THE LOW BITS
      JMP INTY0     GO TEST FOR ZERO
* 
INT   STB OLU       SET AS OUTPUT LU TOO
      CLA 
      STA RDREC     SET TO PROMPT 
      JMP BEM2      SKIP THE LU LOCK IF INTERACTIVE 
* 
BEM1  JSB LURQ      LOCK THE LU IF NOT INTERACTIVE
      DEF BEM2
      DEF D1        LOCK WITH WAIT
      DEF CONWD     THIS LU 
      DEF D1        ONLY ONE OF THEM
BEM2  CLA 
      STA EOJSW     CLEAR EOJ SWITCH. 
      JMP OPFL3     GET OUT OF DCB FOR OPEN 
* 
TST0  EQU COMND+10-* ERROR MEANS WE ARE ABOUT TO OVERLAY
* 
      ORG BUFR      SKIP OVER THE RU PRAMS
* 
OPFL3 JSB OPEN      OPEN JOBFIL 
      DEF *+6 
      DEF IDCB
      DEF IERR
      DEF JOBFL 
      DEF IOPTN 
      DEF ISECU 
      CPA M8        DID WE SUCCEED? 
      JMP OPFL3     KEEP TRYING.
* 
      SSA 
      JSB JERR      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 (CLOSES JOBFIL) 
      DEF *+7 
      DEF IDCB
      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 IDCB
      DEF IERR
      DEF M8        NEGATIVE NO TO PURGE EXTENTS
OPN2  JSB OPEN      RE OPEN JOBFILE 
      DEF *+6 
      DEF IDCB
      DEF IERR
      DEF JOBFL 
      DEF IOPTN 
      DEF ISECU 
      CPA M8        OK? 
      JMP OPN2      NO LOCKED TO ANOTHER
* 
      SSA           ERROR?
      JSB JERR      REPORT AND EXIT 
* 
      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.
* 
* 
      JSB EXEC      READ THE STRING 
      DEF STRTN 
      DEF D14 
      DEF D1
DBUFX DEF BUFR
      DEF BUFLN 
STRTN SZB,RSS       IF NO STRING
      JMP TERM      JUST EXIT 
* 
      LDA DBUFX     GET THE BUFFER ADDRESS
      JSB $LIBR     PARSE THE RECORD
      NOP 
      JSB $PARS     USE SYSTEM ROUTINE
      DEF ONBF
      JSB $LIBX 
      DEF *+1 
      DEF *+1       GO DO THE XEQ THING 
      JSB XEQQ      DO XEQ THING
      JMP TERM      GO EXIT 
* 
EQT5  NOP 
TYP05 OCT 2400
TYP07 OCT 3400
TYPW  OCT 37400 
DYSTA NOP 
* 
* 
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 M2
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 
      JSB JERR      ERROR CONDITION - FLUSH THE JOB.
* 
      JSB TSTEX     TEST EXTENT OVERFLOW
      JMP WRIT,I    OK EXIT 
* 
      JMP WRIT+1    TRY AGAIN IF NEEDED 
* 
PRS   LDA BUFR
      AND MASKL 
      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 
      JSB $LIBR     PARSE A BM COMMAND. 
      NOP 
      LDB IBUFL 
      JSB $PARS 
      DEF COMND 
      JSB $LIBX 
      DEF *+1 
      DEF *+1 
      LDA BUFR
      XOR BUFR+1    GET SECOND TWO CHARS
      AND B377
      XOR BUFR+1
      ALF,ALF       NOW HAVE TWO AFTER THE ':'
      CPA "EO"
      JMP EOJCD     :EOJ
* 
      CPA "XE"
      JMP XEQ       :XEQ
* 
      CPA "JO"
      RSS 
      JMP OTHER 
* 
      CLA           :JOB
      CPA EOJSW 
      JMP OPFIL 
* 
      JSB EOJ       CLOSE LAST SPOOLFILE. 
OPFIL JSB LKRNP 
      JSB JSRCH     FIND A JOB RECORD 
      LDA D17 
      JSB GTREC     GET JOBFIL RECORD 17. 
      LDA M5
      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 M16 
      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.
      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.
      LDA RECNO     JOBFIL RECD. # OF JOB.
      STA COMND+11
      STA NUM        WRITE THE JOB RECORD AND 
      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
* 
      JSB JERR      REPORT NOT FOUND ERROR
* 
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 XEQQ      DO XEQ THING
      JMP RDREC     GO GET NEXT RECORD
* 
* 
XEQQ  NOP           XEQ SUBROUTINE
      JSB JSRCH     SEARCH FOR A PLACE TO PUT THIS. 
      LDA DBUF2 
      JSB CLEAR 
      LDB "R" 
      JSB FJOBF     SET UP THE JOBFIL RECORD. 
      LDB JNAMA     GET JOB NAME ADDRESS
      LDA COMND+4   IF LU 
      CPA D1        SUPPLIED
      LDB DCOM5     USE IT
      STB MVNAM     SET ADDRESS 
      JSB .DFER 
      DEF BUFR2+3 
MVNAM NOP           USE CLEANED UP NAME 
      LDA COMND+13  GET THE CR INFO 
      STA BUFR2+6   AND SET IT
      JSB QUEUE     WRITE IT OUT. 
      JMP XEQQ,I    RETURN
* 
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 D3
      DEF DYSTA 
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
* 
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 
* 
QUEUE NOP           WRITE OUT JOB RECORD AND QUEUE IT 
      JSB WRTRC     WRITE IT OUT
      LDA BUFR2+2   GET STATUS
      CPA "RH"      IF HELD 
      JMP QUEUE,I   JUST RETURN 
* 
      LDA BUFR2 
      STA SAVE      SAVE JOB PRIORITY.
      CLB 
      CCA           COMPUTE THE ADDRESS OF
      ADA RECNO     THE QUEUE FLAG
      DIV D16 
      ADB DBUF      CALCULATE THE BUFFER ADDRESS
      STB SAVE1     SAVE IT 
      JSB GTREC     GET THE RECORD
      LDA SAVE      SET THE PRIORITY
      STA SAVE1,I   IN THE QUEUE
      JSB WRTRC     WRITE THE RECORD BACK OUT 
      JSB POST1     POST THE FILE BUFFER. 
      JSB CLRN
      CLA 
      STA EOJSW 
      JSB EXEC
      DEF *+4       SCHEDULE THE FILE MANAGER.
      DEF NWAIT 
      DEF FLMAN 
      DEF M5
      JMP QUEUE,I 
* 
      JMP QUEUE,I 
* 
"RH"  ASC 1,RH
"H"   OCT 110 
"I"   OCT 111 
"R"   OCT 122 
* 
WRTRC NOP 
      JSB WRITF 
      DEF *+6 
      DEF IDCB
      DEF IERR
DBUF2 DEF BUFR2 
      DEF D16 
      DEF NUM 
      LDA IERR
      SSA 
      JSB JERR
* 
      JMP WRTRC,I 
* 
GTREC NOP 
      STA NUM 
      JSB READF 
      DEF *+7 
      DEF IDCB
      DEF IERR
DBUF  DEF BUFR2 
      DEF D16 
      DEF LEN 
      DEF NUM 
      LDA IERR
      SSA 
      JSB JERR
* 
      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 GTREC 
      LDA BUFR2 
      SSA,RSS 
      JMP *+4 
* 
      LDA NUM 
      STA RECNO 
      JMP JSRCH,I 
* 
      LDA NUM 
      CPA RECNT 
      RSS 
      JMP JSR2
* 
      JSB POST1 
      JSB CLRN      NONE AVAILABLE.  WAIT UNTIL 
      JSB HLDIN     THERE IS. 
      JMP JSR1
* 
CLEAR NOP 
      LDB M16 
      STB FJOBF 
      CLB 
      STB A,I 
      INA 
      ISZ FJOBF 
      JMP *-3 
* 
      JMP CLEAR,I 
* 
FJOBF NOP 
      STB BUFR2+2 
      LDB COMND+8   IF PRIOITY IS ASCII 
      CPB D2        THEN USE DEFAULT
      CLA,RSS 
      LDA COMND+9   STORE PRIORITY, STATUS, JOB NAME, 
      SZA,RSS 
      LDA DEFPR     DEFAULT PRIORITY, IF NECESSARY. 
      CPA NSPRM 
      LDA DEFPR 
      STA BUFR2 
      LDA M18 
      ADA RECNO 
      STA BUFR2+1   STORE JOB #.
      LDA M6
      STA CNTR
      LDB DCOM5 
      CLE,ELB 
      STB UPTR
      LDB JNAMA 
      CLE,ELB 
      STB PPTR
FXNM1 LDA BLANK 
      LDB UPTR
      SZB 
      JSB UNPAK 
      CPA RCOLN 
      JMP BLFIL 
* 
      SZA,RSS 
      JMP BLFIL 
* 
      JSB PAK 
      ISZ CNTR
      JMP FXNM1 
* 
      JMP FJOBF,I 
* 
BLFIL CLB 
      STB UPTR
      JMP FXNM1 
* 
JNAMA DEF BUFR2+7 
CNTR  BSS 1 
M6    DEC -6
* 
UPTR  NOP 
UNPAK NOP 
      LDB UPTR
      ISZ UPTR
      CLE,ERB 
      LDA B,I 
      SEZ,RSS 
      ALF,ALF 
      AND B377
      JMP UNPAK,I 
* 
PCHAR NOP 
PPTR  NOP 
PAK   NOP 
      STA PCHAR 
      LDB PPTR
      ISZ PPTR
      CLE,ERB 
      LDA B,I 
      SEZ 
      ALF,ALF 
      AND B377
      ALF,ALF 
      IOR PCHAR 
      SEZ,RSS 
      ALF,ALF 
      STA B,I 
      JMP PAK,I 
* 
JERR  NOP 
      JSB EXEC      SEND ERROR MESSAGE
      DEF EXMS
      DEF D2
      DEF OLU 
      DEF TERMM 
      DEF D7
EXMS  JMP TERM
* 
A     EQU 0 
B     EQU 1 
DEFPR DEC 9999
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 OCT 40
RCOLN OCT 72
M2    DEC -2
SCOL  ASC 1,;_      PROMPT
RCODE DEC 1 
IOPTN OCT 3 
WCODE DEC 2 
D2    EQU WCODE 
DFLAG OCT 40021 
B70   OCT 70
B77   OCT 77
B377  OCT 377 
M5    DEC -5
BUFAD DEF BUFR2 
BUFLN DEC -80 
EOJSW BSS 1 
JRN   BSS 1 
WRN   BSS 1 
JSTAT BSS 1 
NWWC  OCT 100002
MASKL 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
M18   DEC -18 
WD4AD DEF BUFR2+4 
IERR  BSS 1 
SMPA  ASC 3,SMP 
JOBFL ASC 3,JOBFIL
ISECU OCT 123456
M8    DEC -8
M16   DEC -16 
"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. 
* 
      ORG * 
      END BEM 
                                                                                                                                                                                                                                