ASMB,R,Q,C      ASSEMBLE STATEMENT FOR RTE IV 
* 
      HED SPOOL MONITOR DRIVER FOR RTE IV 
*     NAME:   DVS43 
*     SOURCE: 92067-18030 (RTE IV)
*     RELOC:  92067-16028 (RTE IV)
*     PGMR:   A.M.G.,G.A.A.,C.M.M.,J.M.N. 
* 
*  ***************************************************************
*  * (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 DVS43 92067-16028 REV.2013 800125 
* 
      ENT IS43,CS43,N.SEQ 
      SUP 
* 
* 
*     ***  SPOOL EQT ENTRIES  *** 
* 
*  EQT1   SAME AS STANDARD
*  .
*  .
*  .
*  EQT7   SAME AS STANDARD (READ WRITE), BUFFER MASK (POST) 
*  EQT8   TRANSFER AMOUNT IN WORDS
*  EQT9   USED TO SAVE TLOG WHILE WAKING SPOUT. 
*  EQT10  RECORD LENGTH 
*  EQT11  FLAGS:  BIT 15 - 1 IF WRITE CALL TO INCOR 
*                 BIT 14 - BATCH CHECK FAILED ONCE
*                 BIT 13 - EOF SENT BACK ONCE (OR BATCH 
*                            CHECK FAILED)
*                 BIT 12 - HOLDING I/O ON THIS LU.
*                 BIT 9,10,11- TRANSFER VECTOR FOR EXTND/TO 
*                          RETURNS: 
*                          0= POST WAIT FOR XSIO CALL 
*                          1= WAIT FOR EXTND TO START SPOUT 
*                          2= WAIT FOR BUFFER ECT. IN INCOR 
*                          3= WAIT FOR READ/WRITE  EXTND
*                          4= WAIT FOR BACKSPACE EXTENT 
*                          5= WAIT IN RWIND FOR EXTND 
*                          6= NOT USED
*                          7= NOT USED
*                 BIT  7,8-  00 READ AND WRITE
*                            01 READ ONLY 
*                            10 WRITE ONLY
*                 BIT  6 - NOT USED 
*                 BIT  5 - NOT USED 
*                 BIT  4 - ORDINARY FILE
*                 BIT  3 - SPOOL POOL FILE
*                 BIT  2 - REQUEST LENGTH IN CHARACTERS 
*                 BIT  1 - NOT USED 
*                 BIT  0 - TEMP EOF FLAG
*  EQT12  # OF EXTENSION WORDS - BSREC OR PUSH/GETRD  RETURN POINT SAVE 
*  EQT13  POINTER TO EXTENSION
*  EQT14  SAME AS STANDARD
*  EQT15  SAME AS STANDARD
* 
*     ***  EQT EXTENSION  *** 
* 
*  EQT16   EQT18 SAVE 
*  EQT17  EQT19/EQT21 SAVE
*  EQT18  CURRENT TRACK 
*  EQT19  CURRENT OFFSET
*  EQT20  FILE EXTENSION #
*  EQT21  CURRENT SECTOR #
*  EQT22  TRANSFER COUNTER
*  EQT23  CURRENT PACKING BUFFER ADDRESS
*  EQT24  BEGINNING TRACK IN THIS EXTENT
*  EQT25  BEGINNING SECTOR IN THIS EXTENT 
*  EQT26  # OF SECTORS IN THE FILE (AND EACH EXTENT)
*  EQT27  TR/LU                DIRECTORY ADDRESS OF 
*  EQT28  OFFSET/SECTOR        MASTER ENTRY.
*  EQT29  ID SEGMENT ADDRESS OF PGM REQUESTING INPUT CHECK
*         FILE COUNTER FOR SPOUT (ALWAYS NEGATIVE)
*  EQT30  # OF SECTORS PER TRACK
*  EQT31  RECORD COUNT
*  EQT32  SPOUT CLASS PARAMETER 1 
*  EQT33  SPOUT CLASS PARAMETER 2 
* 
* 
* 
      EXT $LIST     RTE PROGRAM SCHEDULING
      EXT $XSIO     RTE SYSTEM I/O
      EXT $XEQ      SYSTEM IDLE LOOP
      EXT $ETEQ     RTE - SETUP UP EQT ON BASE PAGE 
      EXT $DRVM      IN RTE IV TO SETUP USER MAP
      EXT $RSM      IN RTE IV TO RESTORE PREVIOUS MAP 
      EXT $UPIO     IN RTE IV FOR CLEAR IO RETURN 
********************
* ERROR EXITS      *
********************
* 
*    REJECT REQUEST ERROR CODES (CAUSE IOXX ERROR REPORTS)
* 
*    XX = 20  ATTEMPT TO READ A WRITE ONLY FILE 
*       = 21  ATTEMPT TO READ PAST EOF
*       = 22  SECOND ATTEMPT TO READ A JCL RECORD (FIRST RETURNS EOF) 
*       = 23  ATTEMPT TO WRITE ON A READ ONLY FILE
*       = 24  ATTEMPT TO WRITE PAST EOF (OR SPOOL FILE OVERFLOW)
*       = 25  REQUEST ON A EQT THAT HAS NOT BEEN SET UP WITH A FILE.
* 
*    EOF EXITS  MADE ON READ OR WRITE REQUESTS (SEE BELOW)
* 
*   TLOG = 0  STANDARD EOF  ALL OK IF READ, IF WRITE OF # 0 RECORD
*             IMPLIES FILE IS FULL. NEXT ATTEMPT TO WRITE WILL
*            CAUSE IO24 (SEE ABOVE) 
*        = -1 EOF WAS A -2, MEANS FILE WAS TERMINATED FOR OVERFLOW
*        = -5 SAME AS FMGR -5 ERROR I.E. NO EXTENT ON READ OR LENGTHS 
*             AT THE ENDS OF THE RECORD DON'T MATCH.
      HED SPOOL MONITOR DRIVER  REQUEST DECODE SECTION
N.SEQ NOP 
IS43  NOP 
      LDA IS43
SRTNI STA RTNI      SAVE FIRST RETURN ADDRESS 
      CLA 
      STA SRTNI 
* 
      LDB EQT6,I    TEST FOR CLEAR IO RQ
      CPB BSN3      BSN3=100003B
      JMP IS43,I    SYSTEM CLEAR ACCEPT IT. 
* 
      JSB EXEQT 
      LDA EQT27,I   IS THIS SPOOL 
      SZA,RSS       EQT INITIALIZED?
      JMP ABORT     NO - REJECT THE CALL. 
* 
      LDA EQT8,I
      STA EQT10,I 
      CLB 
      SSA,RSS 
      JMP WDS 
* 
      CMA,INA 
      SLA,ARS 
      INA 
      STA EQT8,I
      LDB D4
WDS   CMA           SAVE NEG. OF # OF WORDS TO
      STA EQT22,I   WORDS TO TRANSFER 
      LDA EQT5,I    CLEAR EOF BIT.
      IOR D128
      XOR D128
      STA EQT5,I
      LDA EQT11,I 
      AND DISPM 
      IOR B 
      LDB A         IF LAST EXIT WAS WITH BATCH CHECK 
      RBL,ELB 
      SEZ,RSS       WELL WAS IT?
      JMP ST11      NO PROCEED
* 
      LDB EQT1,I    YES  IS THIS THE KEEPER OF THE
      CPB EQT29,I   KEYS??
      AND CLEOF     YES  CLEAR THE EOF FLAGS
ST11  STA EQT11,I   INITIALIZE EQT11
      ALF,SLA       HOLDING I/O TO THIS LU. 
      JMP ABORT     YES. AN ABORTING ERROR (SPOUT KNOWS)
* 
      LDA EQT18,I   SAVE CURRENT FILE LOCATION
      STA EQT16,I   IN CASE AN EXTENT IS NEEDED 
      LDA EQT19,I   AND NOT AVAILABLE 
      AND B377      KEEP LOW BITS OF LENGTH (ITS <0)
      ALF,ALF 
      IOR EQT21,I 
      STA EQT17,I 
* 
      LDA EQT6,I
      AND B77 
      LDB D20       SET UP THE ERROR CODE 
      RBR,ELB       20 NORMAL, 21 IF POSSIBLE BATCH CHECK 
      CPA D1
      JMP RR        READ REQUEST
* 
      LDB D23       SET FOR WRITE ERRORS
      CPA D2
      JMP WR        WRITE REQUEST 
* 
*  COME HERE FOR CONTROL REQUEST
* 
      LDA EQT11,I 
      ALF,ALF       READ ONLY FILE? 
      SSA 
      JMP CR1       YES.
* 
      AND TFLAG     DOES FILE HAVE HEADERS? 
      SZA 
      JMP CR1       NO.  INTERPRET REQUEST. 
* 
      STA EQT8,I    SET UP TO PUT THE CONTROL 
      CMA           INFORMATION IN THE BUFFER 
      STA EQT22,I   TO BE WRITTEN OUT.
      JMP WR
* 
CR1   LDA EQT6,I    GET THE CONWD.
      RRR 6 
      AND B77       ISOLATE CONTROL FUNCTION
      CMA,INA,SZA,RSS DECODE THE REQUEST
      JMP ILL       ZERO IS A BAD GUY.
* 
      LDB D23 
      INA,SZA,RSS   1 IS EOF
      JMP WREOF           SO OFF TO THE EOF WRITER
* 
      INA,SZA,RSS   2 IS BACK SPACE RECORD
      JMP BSREC         SO OFF THE THE BACK SPACE ROUTINE 
* 
      INA,SZA,RSS   3 IS FORWARD SPACE RECORD 
      JMP FSREC        SO GO DO THAT
* 
      INA,SZA,RSS   4 IS REWIND 
      JMP RWIND        SO OFF TO DO IT
* 
      INA,SZA       5 IS ALSO REWIND
      CPA N7        14  IS BACKSPACE FILE BUT ONLY ONE SO REWIND
RWIND CCA,RSS           OFF TO IT.
* 
      JMP ILL       NONE OF THE ABOVE  CAN NOT DO IT
* 
      STA EQT20,I   REWIND SPOOL FILE BY CALLING THE
      LDA B5000     EXTND PROGRAM TO GET
      JMP GTEXT     EXTENT 0 (MASTER ENTRY).
* 
* 
*  RETURN TO RW2 AFTER EXTND CALL OR FROM BACKSPACE.
* 
RW2   LDA DM128     MAKE SURE ALL POINTERS
      STA EQT19,I   ARE CONSISTENT WITH 
* 
      CLA           CLEAR THE RECORD COUNT
RW3   STA EQT31,I 
      LDA EQT11,I   CLEAR EOF BIT IF SET. 
      AND CLEOF 
      STA EQT11,I 
      CLB           RETURN A CLEAR TLOG 
      JMP POST1 
* 
ILL   LDA D2        NONE OF THE ABOVE 
      JMP RTRN      REJECT REQUEST
* 
ABORT LDA D25       SEND ABORT ERROR IO25 
* 
*     COMMON RETURN POINT 
* 
RTRN  STA XA        SAVE A REG
      LDA EQT1,I    IS CLEAR IO IN PROGRESS 
      RAL,CLE,SLA,ERA CLEAR SIGN BIT IN CASE
      CLB,RSS       YES SET B TO CLEAR TIME OUT 
      JMP RTRN2     NO  GO EXIT 
* 
      STA EQT1,I    SET EQT1 WITH CLEARED FLAG BIT
      STB EQT15,I   CLEAR THE TIME OUT WORD 
      LDA EQT5,I    CLEAR THE BUSY BIT
      ALR,RAL       AND 
      STA EQT5,I    SET IT BACK 
      JMP $UPIO     NOW GO TO UPIO
* 
RTRN2 LDA XA        NO RESTORE A AND RETURN 
      JMP RTNI,I
* 
XA    BSS 1 
RTNI  BSS 1 
DISPM OCT 70630 
D23   DEC 23
D25   DEC 25
D20   DEC 20
TFLAG OCT 10000 
N7    DEC -7
B4000 OCT 4000
CLEOF OCT 117777
B5000 OCT 5000
B77   OCT 77
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
B3701 OCT 3701
BSN3  OCT 100003
* 
* 
* 
* 
BSREC LDA EQT11,I   IF AT A REAL EOF
      RAL,RAL       THEN
      SSA 
      JMP BSR0      JUST SET UP THE POINTERS
* 
      CCA           BACKSPACE ROUTINE 
      JSB BSPTO     BACK UP THE POINTER 
      LDA SAVE,I    GET THE TRAILING LENGTH WORD
      CMA           SET TO BACK OVER THE RECORD 
      JSB BSPTO     DO IT 
BSR0  CCA           BACK UP THE RECORD POINTER
      ADA EQT31,I   BY ONE
      JMP RW3       GO SET AND EXIT 
      HED SPOOL MONITOR DRIVER  BACKSPACE POINTER ROUTINE 
BSPTO NOP           BACKSPACE 'A' WORDS IN THE FILE 
      LDB BSPTO     SAVE ENTRY POINT IN CASE
      STB EQT12,I   WE ARE INTERRUPTED. 
      ADA EQT19,I   DECREMENT THE BUFFER OFFSET 
      CMA           SET FOR DIVIDE
      CLB           SET FOR DIVIDE
      DIV D128      A IS BLOCK OFFSET, B NEW BUFFER OFFSET
      CMB           SET BUFFER OFFSET NEGATIVE
      STB EQT19,I   SET THE BUFFER OFFSET 
      CMA,INA,SZA,RSS SET BLOCKS NEGATIVE 
      JMP BSP1      IF ZERO THEN IN SAME BUFFER 
* 
      STA SAVE      SAVE THE BLOCK OFFSET 
      JSB SUBT      GET CURRENT SECTOR POSITION 
      ADA SAVE      ADJUST TO NEW 
      ADA SAVE      (IT WAS BLOCKS REMEMBER)
      CLB           SET FOR DIVIDE
      CMA,SSA,INA   SET POS. NUMBER TO GO BACK
      JMP BSP2      SAME EXTENT GO SET UP 
* 
      DIV EQT26,I   A= # EXTENTS BACK, B= SECTOR OFFSET IN THAT EXTENT
      SZB           ADJUST IF ZERO REMAINDER
      INA           SET UP TO GO
      CMA 
      ADA EQT20,I   BACK AND GET
      STA EQT20,I   THE EXTENT. 
      INA           IF LESS THAN
      SSA           -1 THEN 
      JMP RWIND     JUST REWIND 
* 
      CMB,INB,SZB 
      ADB EQT26,I   SAVE INDEX INTO 
      STB EQT17,I   THE EXTENT. 
BS13  LDA B4000     GET THE RETURN VECTOR 
      JMP GTEXT     GO GET THE EXTENT 
* 
BSP2  CMA,INA,RSS   SET POSITIVE OFFSET 
BS10  LDA EQT17,I   RETURN FROM EXTENT TO HERE
B40   CLE           CLEAR E FOR OVERFLOW TEST 
      ADA EQT25,I   TAKE INDEX FROM BEGINNING 
      CLB,SEZ,CLE   OF TRACK WHERE THE
      INB           STEP B IF OVERFLOW
      DIV EQT30,I   CURRENT EXTENT BEGINS.
      ADA EQT24,I   FIND OUT HOW MANY 
      STA EQT18,I   TRACKS TO ADVANCE.
      STB EQT21,I   SAVE CURRENT TRACK AND SECTOR.
BSP1  CLE           SET FOR READ ACCESS 
      JMP BSCOR     MAKE PRESENT AND RETURN 
      HED SPOOL MONITOR DRIVER READ ROUTINE 
FSREC CLA           FAKE OUT THE READ 
      STA EQT8,I    ROUTINES SO THAT
      INA           THEY WILL FORWARD 
      STA EQT6,I    SPACE ONE RECORD. 
      CMA,INA 
      STA EQT22,I 
* 
RR    LDA EQT6,I
      CPA B3701     IS THIS REALLY A POST REQUEST?
      JMP POST      YES.
* 
      LDA EQT11,I   CHECK IF FILE IS WRITE ONLY.
      ALF,ALF 
      SLA 
      JMP EOFRT     SEND BACK IO20. 
* 
      AND B40       ALREADY DONE AN EOF ON
      INB           SET FOR EOF # 2 ERROR 
      SZA           THIS FILE?
      JMP EOFRT 
* 
      JSB GETRD     GET READY TO ACCESS THE BUFFER
* 
      LDA SAVE,I    NO,GET AND SAVE LENGTH OF 
      STA EQT10,I   DISK RECORD.
      STA B         SET IN B IN CASE EOF
      SSA           EOF I.E. LESS THAN 0
      JMP EORET     YES  EOF RETURN.
* 
      ADA EQT22,I   # OF WORDS LEFT IN RECORD 
      SSA,RSS       IF BUFFER PROVIDED IS TOO SHORT 
      JMP STFLG     THEN JUST USE IT
* 
      STB EQT8,I    ELSE SAVE TOTAL # WORDS TO BE 
      CMB           TRANSFERRED.
      STB EQT22,I   SET TRANSFER COUNTER. 
STFLG JSB PUSH      PUSH THE BUFFER ADDRESSES 
      LDB EQT29,I   GET THE BATCH CHECK FLAG
      SZB           IF ZERO OR
      CPB EQT1,I    CURRENT USER
      RSS 
      SSB           OR NEGATIVE 
      JMP EORT      ALL OK GOT TEST FOR END OF RECORD 
* 
      LDA SAVE,I    IF THIS IS A ":" HE IS
      AND MASKL     IN DEEP 
      CPA COLON 
      JMP BINF      SHIT, HE BLEW IT
* 
EORT  ISZ EQT22,I   ALL WORDS MOVED?? 
      JMP TRWD      NO GO MOVE A WORD 
* 
      LDA EQT10,I   SET UP TO SKIP ANY RESIDUE
      CMA           AND TO GET THE LAST WORD
      ADA EQT8,I
      STA EQT22,I   SET COUNT 
RCONT LDA SAVE,I    HANG ONTO THIS WORD.  AT END
      STA EQT7,I    OF RECORD, IT WILL CONTAIN LENGTH.
      JSB PUSH      ADVANCE TO END OF RECORD. 
      ISZ EQT22,I   FINISHED? 
      JMP RCONT     NO GET THE NEXT ONE 
* 
      LDA EQT7,I    YES DO LINE LENGTHS SURROUNDING 
      CPA EQT10,I   THIS RECORD MATCH?
      JMP NORML     YES - EVERYTHING NORMAL.
* 
ERN5  LDB N6        SET UP FOR EOF WITH PREJUDICE (-5)
      JMP EORET     NO MATCH - SEND EOF STATUS. 
* 
* 
N6    DEC -6
* 
TRWD  LDB EQT7,I    GET THE WORD ADDRESS
      LDA WTMAP     GET THE MAP WORD
      CMA,SSA,SLA,RSS  WHICH MAP ?
      JMP SMAP1        SYSTEM MAP 
* 
      LDA SAVE,I    GET THE WORD
      XSA B,I       SEND IT INTO THE USER MAP 
      JMP IDON
* 
SMAP1 LDA SAVE,I     GET THE WORD 
      STA B,I        PUT IT INTO BUFFER OF BUFFERED REQUEST 
IDON  ISZ EQT7,I    STEP THE USER BUFFER ADDRESS
      JSB PUSH      PUSH MY ADDRESSES 
      JMP EORT      GO TEST FOR END 
      HED SPOOL MONITOR DRIVER POSITION TO NEXT WORD ROUTINES 
PUSH  NOP           ROUTINE TO PUSH THE BUFFER ADDRESS
      ISZ SAVE      PUSH THE BUFFER ADDRESS 
      ISZ EQT19,I   CHECK THE BUFFER COUNT
      JMP PUSH,I    ALL OK SO CONTINUE
* 
      LDA PUSH      NEED A NEW SECTOR SO SAVE 
      STA EQT12,I   THE RETURN ADDRESS
      LDA D2        ADD 2 TO THE
      ADA EQT21,I   SECTOR ADDRESS
      CPA EQT30,I   END OF TRACK??
      CLA            YES SET TO ZERO
      STA EQT21,I   RESET THE SECTOR
      SZA,RSS       IF FIRST SECTOR 
      ISZ EQT18,I   BUMP THE TRACK
      LDA DM128     SET THE BUFFER POINTER BACK 
      STA EQT19,I   TO THE FIRST WORD 
      JSB SUBT      CHECK IF END OF EXTENT
      CPA EQT26,I   WELL
      JMP RDEXT     YES  GET NEXT EXTENT
* 
      JMP XCOR      STILL IN FILE GO GET THE BUFFER 
* 
RDEXT LDA B3000     NOT IN FILE, SO GET AND EXTENT
GTEXT CLB,INB       SET UP THE TEMP WORDS FOR EXTND 
      STB PRM1
      LDB EQT1
      STB PRM2
      LDB A         SAVE A
      LDA EQT6,I    CHECK IF WRITE
      AND D2        ISOLATE READ BIT (0 IF READ)
      ADA D6        USE 8 FOR WRITE  6 FOR READ 
      STA PRM3      PUT IN THIRD EXTND PRAM 
      LDA B         RESTORE A & CALL FOR EXTND
      JSB LIST
      JMP WTOUT     GO AWAY FOR A WHILE.
* 
GETRD NOP           THIS ROUTINE MAKES SURE THE BUFFER IS 
      LDB GETRD     IN CORE AND ADDRESSABLE 
      STB EQT12,I   SET RETURN ADDRESS
XCOR  LDB EQT6,I    WSET E FOR THE INCOR CALL 
      RBR,ERB       0= READ, 1= WRITE,CONTROL 
BSCOR JSB INCOR     GO GET THE SECTOR 
* 
      LDA EQT19,I   SET UP THE BUFFER POINTER 
      ADA D132      EQT19 STARTS AT -128 AND
      ADA EQT23,I   BUFFER IS 4 WORDS BEYOND EQT23
      STA SAVE      SET THE POINTER 
      LDA EQT1,I    GET THE CLEAR IN PROGRESS FLAG
      SSA           THEN
      JMP ERN5      GO EXIT 
* 
      LDB EQT12,I   GET THE RETURN ADDRESS
      JMP B,I       AND CONTINUE
      HED SPOOL MONITOR DRIVER TIME DELAY EXIT / CONSTANTS
B3000 OCT 3000
DM128 DEC -128
* 
NTRDY LDA N4        SET TIME OUT SO THAT WE 
      STA EQT15,I   CAN GET BACK IN HERE. 
      LDA EQT4,I
      IOR TFLAG     SET THE HANDLE-OWN-TO FLAG
      STA EQT4,I
* 
WTOUT CCE 
      LDA EQT5,I    SET AVAIL=2 IN
      RAL,ERA       THE EQT 
      STA EQT5,I
* 
      JSB $RSM      IN RTE IV, RESTORE PREVIOUS 
      JMP $XEQ      MAP AND GO TO SYSTEM IDLE LOOP. 
* 
MASKL OCT 177400
COLON OCT 35000 
N4    DEC -4
B20K  OCT 20000 
D6    DEC 6 
* 
EQT1  EQU 1660B 
EQT4  EQU 1663B 
EQT5  EQU 1664B 
EQT6  EQU 1665B 
EQT7  EQU 1666B 
EQT8  EQU 1667B 
EQT9  EQU 1670B 
EQT10 EQU 1671B 
EQT11 EQU 1672B 
EQT12 EQU 1771B 
EQT13 EQU 1772B 
EQT15 EQU 1774B 
EQT16 NOP 
EQT17 NOP 
EQT18 NOP 
EQT19 NOP 
EQT20 NOP 
EQT21 NOP 
EQT22 NOP 
EQT23 NOP 
EQT24 NOP 
EQT25 NOP 
EQT26 NOP 
EQT27 NOP 
EQT28 NOP 
EQT29 NOP 
EQT30 NOP 
EQT31 NOP 
EQT32 NOP 
EQT33 NOP 
* 
* 
* 
EOFLG NOP 
      LDA EQT5,I    SET EOF FLAG IN EQT5. 
      IOR D128
      STA EQT5,I
      LDA EQT11,I   SET FLAG TO INDICATE
      IOR B20K      EOF ALREADY SENT ONCE.
      STA EQT11,I 
      JMP EOFLG,I 
* 
EOFRT LDA EQT5,I    SET THE 
      IOR D128      EOF FLAG
      STA EQT5,I
* 
      LDA B         GET THE RETURN CODE 
      JMP RTRN
* 
*  THE FOLLOWING ROUTINE FINDS OUT THE DIFFERENCE 
*  IN SECTORS BETWEEN THE CURRENT POSITION AND
*  THE BEGINNING OF THIS EXTENT.
*  RETURNS THE RLEATIVE SECTOR OF CURRENT ADDRESS SECTOR
* 
SUBT  NOP 
      LDA EQT24,I   HOW MANY TRACKS READ WRITTEN? 
      CMA,INA 
      ADA EQT18,I   GET RESULT IN SECTORS.
      MPY EQT30,I 
      LDB EQT25,I   ADD NUMBER OF SECTORS TO
      CMB,INB       GET TOTAL.
      ADA B         ACCUMULATE
      ADA EQT21,I 
      JMP SUBT,I
      HED SPOOL MONITOR DRIVER POST ROUTINES
*  COME HERE TO POST BUFFERS BEFORE SPOOL CLOSE.
* 
POST6 LDB EQT23,I   SHOW BUFFER EMPTY AS IT MAY NOT 
      CLA           BE THE SAME AS THE
      INB           DISC ANY MORE 
      STA B,I       SET LU TO ZERO TO CLEAR 
POST4 LDB EQT7,I    ADVANCE TO THE NEXT BUFFER
      RBL           FIRST THE BIT MAP 
      LDA EQT23,I   NOW THE ADDRESS 
      ADA D132
      JMP POST2     CONTINUE THE FLUSH
* 
D132  DEC 132 
* 
POST  LDA PKBUF     MUST FIND ALL BUFFERS 
      CLB,INB       THAT NEED TO BE WRITTEN.
POST2 STB EQT7,I
      LDB A,I       MAKE SURE WE DON'T
      STA EQT23,I 
      CPB D5        POST A BUFFER THAT IS 
      JMP POST4     BEING READ OR WRITTEN.
* 
      SSB 
      JMP POST1     ALL FINISHED. 
* 
      LDA WRBUF     DOES THIS NEED TO 
      AND EQT7,I    BE WRITTEN OUT. 
      CCE,SZA 
      JMP POST6     NO.  GO CLEAR THE INCORE FLAG IN CASE 
* 
      JSB SXSIO     YES - DO IT.
      JMP NTRDY 
* 
      LDB EQT23,I   INDICATE THAT THE BUFFER
      LDA D5        IS UNAVAILABLE BY SETTING 
      STA B,I       THE AGE WORD. 
      JSB IOCAL,I 
      LDB EQT23,I   FREE UP THE BUFFER
      CLA,INA       FOR USE.
      STA B,I 
      LDA EQT7,I    INDICATE BUFFER NEED NOT
      IOR WRBUF     BE WRITTEN. 
      STA WRBUF 
      JMP POST6     CLEAR THE LU SO WON'T BE FAKED OUT
      HED SPOOL MONITOR DRIVER CLEAN UP AND EXIT CODE 
BINF  CCA            BATCH CHECK ':' FOUND SO 
      JSB BSPTO     BACK SPACE TO LENGTH WORD FOR NEXT TIME 
      LDA EQT11,I   AND SET THE 
      IOR B40K      BATCH CHECK FAILED BIT
      STA EQT11,I   IN THE EQT
      CCB            SET TLOG FOR A 0 RETURN
EORET JSB EOFLG     SET EOF FLAGS 
      INB           SET B FOR TLOG
POST1 STB EQT9,I    SAVE B REGISTER.
      LDA EQT32,I   NEED WE CALL BACK SPOUT?
      ALF,SLA 
      RSS 
      JMP POST5 
* 
CSPT  CCA           SET UP ENTND TEMP WORDS 
      STA PRM1
      LDA EQT32,I 
      STA PRM2
      LDA EQT33,I 
      STA PRM3
      LDA B1000     GET THE RETURN VECTOR 
      JSB LIST      CALL FOR EXTND
* 
      LDA EQT32,I   SUCCESS, SO 
      XOR TFLAG     CLEAR BIT WHICH INDICATES NEED
      STA EQT32,I   TO CALL SPOUT.
      LDB EQT9,I    RESTORE THE TLOG. 
POST5 LDA D4        NO - DO IMMEDIATE COMPLETION. 
      JMP RTRN
* 
B1000 OCT 1000
B40K  OCT 40000 
PKBUF DEF BUFS
B377  OCT 377 
D5    DEC 5 
IOCAL NOP 
N1    DEC -1
SAVE  NOP 
SAVE1 NOP 
TRSEC NOP 
FLU   NOP 
WRBUF DEC -1
      HED SPOOL MONITOR DRIVER GET CURRENT BLOCK ROUTINES 
*  THE FOLLOWING CHECKS AND MAKES SURE THE DESIRED
*  SECTOR IS IN CORE. THIS ROUTINE MAY CAUSE ONE OR MORE
*  EXITS TO WAIT FOR RESOURCES. 
* 
*   ON ENTRY E = 1 INDICATES A WRITE, E = 0 A READ
*   ON EXIT THE REQUESTED SECTOR IS IN CORE 
* 
*   THE RETURN ADDRESS MAY BE SAVED IN EQT9 IF INCOR IS EVER CALLED 
*   FROM MORE THAN ONE LOCATION.
* 
*   THE RETURN VECTOR IS 2000.
* 
* 
INCOR NOP 
      LDA EQT11,I   SAVE THE DIRECTION BIT
      RAL,ERA       IN EQT11 BIT 15 
      STA EQT11,I 
INC0  LDA EQT27,I   GET THE LU AND
      AND B77       ISOLATE IT
      STA FLU 
      CLA,INA       SET BEGINING BUFFER READ/WRITE FLAG 
      LDB PKBUF     GET BEGINNING ADDRESS OF BUFFERS. 
INC1  STB EQT23,I 
      STB TRSEC 
      LDB B,I       LOOK AT 1ST WORD OF BUFFER. 
      INB,SZB,RSS   FINISHED? 
      JMP INC4      YES.
* 
      ISZ TRSEC     LOOK AT BUFFER PTR. TO LU.
      LDB TRSEC,I   DOES IT MATCH THIS ONE? 
      CPB FLU 
      RSS           YES TRY THE NEXT ONE
      JMP INC3      NO. 
* 
      ISZ TRSEC     LOOK AT TRACK #.
      LDB TRSEC,I 
      CPB EQT18,I   IS IT EQUAL TO THE
      JMP INC2      TRACK DESIRED?
* 
INC3  RAL           MOVE THE WRITE FLAG TO NEXT BUFFER
      LDB EQT23,I   INDEX THE ADDRESS 
      ADB D132      ALSO
      JMP INC1      TRY THE NEXT BUFFER 
* 
INC2  ISZ TRSEC     LOOK ALSO AT
      LDB EQT21,I   SECTOR POINTER. 
      CPB TRSEC,I   MATCH THE ONE DESIRED?
      RSS           YES.
      JMP INC3      NO. 
* 
      LDB EQT23,I   GET THE AGE FLAG
      LDB B,I       TO B
      CPB D5        BUFFER - IS BUFFER AVAILABLE? 
      JMP INC5      NO - MUST WAIT UNTIL IT'S POSTED. 
* 
      LDB EQT11,I   BUFFER IS IN CORE 
      CMA           IF TO BE WRITTEN ON 
      AND WRBUF     SET THE PROPER FLAG 
      SSB           SKIP IF READ ACCESS 
      STA WRBUF 
      JMP OKRET     GO EXIT  WE ARE READY NOW 
* 
* 
* 
*  THE FOLLOWING GRABS UP AN AVAILABLE BUFFER AND 
*  CHECKS IF IT NEEDS TO BE WRITTEN OUT.
* 
INC4  STB SAVE1 
      LDB PKBUF 
      CLA,INA 
OK4   STA SAVE      FIND LEAST RECENTLY USED BUFFR. 
      LDA B,I       ARE WE AT THE END OF
      SSA           THE BUFFERS?
      JMP OK2       YES.  PICK LEAST RECENTLY USED. 
* 
      CPA D5        IS THE BUFFER AVAILABLE?
      JMP OK1       NO. 
* 
      CMA,INA       YES. KEEP LOOKING THROUGH.
      ADA SAVE1,I   CHECK AGE AGAINST CURRENT 
      SSA,RSS       IS THIS BUFFER A POSSIBLE?
      JMP OK3       NO.  AGE IT.
* 
      STB SAVE1     YES.  SAVE THIS BUFFER'S ADDRESS. 
      LDA SAVE      SAVE BUFFER POSITION. 
      STA FLU       AND WRITE FLAG LOCATION 
      JMP OK3 
* 
OK2   LDB SAVE1     DID WE FIND A BUFFER? 
      SZB,RSS 
      JMP INC5      NO - WAIT FOR TIME OUT
* 
      LDA D5        YES - MARK BUFFER AS UNAVAILABLE. 
      STA B,I 
      STB EQT23,I   SAVE CURRENT SMD BUFFER ADDRESS.
      LDA FLU       GET THE BUFFER # BIT
      AND WRBUF     ISOLATE MUST BE WRITTEN FLAG
      CMA,CLE,INA   SET E IF MUST BE WRITTEN
      LDA WRBUF     GET THE MUST WRITE FLAG WORD
      IOR FLU       SET THE NO WRITE FLAG 
      LDB EQT11,I   READ OR WRITE?
      SSB           SKIP IF READ ELSE 
      XOR FLU       CLEAR TO INDICATE MUST WRITE
      STA WRBUF     PUT THE FLAG WORD BACK
      SEZ,RSS       MUST WE WRITE THIS ONE OUT FIRST? 
      JMP OKOUT     NO.  BYPASS THIS STUFF. 
* 
      JSB SXSIO     WRITE OUT THE BUFFER. 
      JMP NOK       NO AVAILABLE $XSIO CALL.
* 
OKOUT LDB EQT23,I   MARK BUFFER WITH NEW INFO.
      INB 
      LDA EQT27,I   PUT 
      AND B77         LU
      STA B,I 
      INB              TRACK
      LDA EQT18,I 
      STA B,I 
      INB 
      LDA EQT21,I    AND SECTOR 
      STA B,I       IN BUFFER HEAD
      SEZ           IF MUST WRITE THEN
      JSB IOCAL,I   DO IT NOW 
      LDA EQT11,I   READ OR WRITE REQUEST?
      LDB EQT19,I   IF READ OR WRITE FROM 
      CPB DM128     OTHER THAN BEGINING OFBLOCK 
      SSA,RSS       THEN MUST READ
      CLE,RSS       MUST READ 
      JMP OKRET     NEED NOT READ  GO EXIT
* 
      JSB SXSIO     READ IN THE DESIRED SECTOR. 
      JMP OK5 
* 
      JSB IOCAL,I   DO THE READ 
OKRET CLA,INA       SET AGE BACK ON BUFFER
      LDB EQT23,I   THAT IS BEING USED. 
      STA B,I 
      JMP INCOR,I 
* 
NOK   LDA FLU       COULD NOT WRITE OUT A SELECTED BUFFER 
      CMA           SET 
      AND WRBUF     THE MUST BE WRITTEN FLAG
      JMP OK8       GO FREE THE BUFFER AND WAIT 
* 
OK3   LDA B,I       IF AGE # 4
      CPA D4
      RSS 
      ISZ B,I       BUMP IT THEN
OK1   ADB D132      INDEX TO THE NEXT BUFFER
      LDA B,I       IS THER ONE?? 
      SSA           WELL? 
      JMP OK2       NO  GO SEE IF ONE WAS FOUND 
* 
      LDA SAVE      YES  MOVE 
      RAL           THE FLAG AROUND 
      JMP OK4       AND GO TEST THIS ONE
* 
OK5   LDB EQT23,I   NO XSIO CALL AVAILABLE
      INB           FOR READ
      CLA           CLEAR THE LU
      STA B,I       AND MUST WRITE FLAGS
      LDA FLU       AND 
      IOR WRBUF 
OK8   STA WRBUF 
      LDA D4        SET THE FREE FLAG 
      LDB EQT23,I   IN THE BUFFER 
                                                                                                                                                                                                            