
      HED SELECTIVE LOAD AND DUMP 
      ORG 22000B
* 
*      ROUTINE TO ASK FOR LOAD OR DUMP COMMANDS 
* 
RLDC  NOP 
      LDA COFLS,I   OPTIONS WANTED? 
      SZA,RSS 
      JMP RLDC,I    NO, DON'T ASK 
RLDD  EQU * 
      CLA 
      STA CUDRS,I   NO DIR TRACK IN CORE
      STA CUADS,I   SET CURRENT ADT TO ZERO 
      STA JDECS,I   SET FILE COUNT TO ZERO
      STA MTRRS,I   CLEAR EOF FLAG
      STA NOMES     SAY DO NOT SUPPRESS MESSAGE 
      LDA SD24      GET WORD COUNT
      LDB RLMSS       AND ADDRESS 
      JSB ASRS,I        FOR "LOAD OR DUMP COMMANDS?"
      CLA 
      JSB ASRS,I    AND WAIT FOR REPLY
      JSB GETCS,I   GET THE FIRST CHARACTER 
      JMP RLDC,I    CR, OPTIONS NOT WANTED
      CPA SASL      CHECK FOR "LOAD"
      JMP RLOA
      CPA SASD      CHECK FOR "DUMP"
      JMP RLDU
      CPA SASN      "NO"? 
      JMP RLDC,I    YES 
* 
      LDA SD15      GET CHARACTER COUNT 
      LDB ILINS       AND BUFFER ADDRESS
      JSB ASRS,I        FOR "ILLEGAL INPUT" 
      JMP RLDD            AND ASK AGAIN 
* 
RLOA  CCA,RSS 
RLDU  CLA 
      STA LDFLG     SET FLAG FOR LOAD OR DUMP 
* 
*      THE DIRECTORY IS READ AND ALL OF THE 
* 'MUST BE RECOVERED' FLAGS ARE CLEARED.
* 
      LDA DIRES     => FIRST DIREC ENTRY
ENPBA EQU * 
      STA STMP0 
      JSB DIRGS,I   GET THE DIRECTORY TRACK IN
      SZA,RSS       CHECK FOR LENGTH OF ZERO
      JMP ENPBE     ZERO LENGTH, NO PROBLEM 
      CCB 
      DIV SD12      PRODUCE THE COUNT OF ENTRIES
      STA STMP1       AND SAVE IT 
      LDB IDTBS     => FIRST ENTRY
      ADB SD10      => FLAG WORD
      CLA 
ENPBC EQU * 
      STA B,I       CLEAR 'MUST BE RECOVERED' FLAG
      ADB SD12      ADVANCE TO THE NEXT ENTRY 
      ISZ STMP1     CHECK THE COUNT 
      JMP ENPBC 
      JSB CDTWS,I   WRITE THE DIR TRACK BACK
ENPBE EQU * 
      LDA STMP0     LOAD THE DIREC POINTER
      ADA SD7       ADVANCE TO THE NEXT TRACK 
      CPA DIRCT     CHECK FOR THE END OF THE TABLE
      RSS           SKIP OUT WHEN DONE
      JMP ENPBA 
* 
*      ROUTINE TO ASK THE OPERATOR FOR A LIST OF
* <ID> OR <ID>,<NAME> ENTRIES.  IF AN <ID> IS 
* ENTERED, IT IS PLACED INTO A TABLE.  IF <ID>,<NAME> 
* IS ENTERED AND WE ARE SELECTIVE DUMPING, THE
* ENTRY IS FOUND IN THE DIRECTORY AND FLAGGED TO
* BE DUMPED.  IF <ID>,<NAME> IS ENTERED AND WE ARE
* SELECTIVE LOADING, THE ENTRY IS PLACED INTO THE 
* DIRECTORY WITH THE 'MUST BE RECOVERED' FLAG SET.
* 
*     LDFLG MUST BE ZERO FOR DUMP, NON-ZERO FOR LOAD
*     ENTEP => END OF CONSTRUCTED ID TABLE
*     ENTBP => FIRST WORD OF CONSTRUCTED ID TABLE 
* 
      LDA ENTBP     INITIALIZE THE
      STA ENTEP       END POINTER 
      CCA           SET THE FLAGS TO DISTINGUISH
      STA SRFLS,I     THIS FROM NORMAL LOAD 
      STA SDFLS,I       OR DUMP 
      LDA SD54      LOAD THE CHARACTER COUNT
      LDB ENTMA       AND BUFFER ADDRESS
      JSB ASRS,I        FOR THE INSTRUCTIONS
ENPAA EQU * 
      CLA 
      JSB ASRS,I    ASK FOR AN INPUT LINE 
* 
*      PACK THE ID PART OF THE LINE.
* 
      JSB GETCS,I   GET THE NEXT CHARACTER
      JMP ENTIL     CR - - ERROR
      STA STMP0     SAVE CHAR FOR 'END' CHECK 
      ADA SM133     TEST FOR LETTER 
      SSA,RSS 
      JMP ENTIL 
      ADA SB32
      SSA,INA 
      JMP ENTIL 
      ASL 10        SHIFT TO POSITION 
      STA STMP1     AND SAVE FOR LATER MERGE
      LDA SM3       SET DIGIT COUNT 
      STA STMP2 
      CLB 
ENPAB EQU * 
      STB STMP3 
      JSB GETCS,I   GET THE NEXT CHARACTER
      JMP ENTIL     CR - - ERROR
      CPA SASN      "N"?
      JMP ENPEN     YES, CHECK FOR "END"
      ADA SM72B 
      SSA,RSS 
      JMP ENTIL     NOT DIGIT 
      ADA SD10
      SSA 
      JMP ENTIL     NOT DIGIT 
      LDB STMP3 
      RBL,RBL       * 4 
      ADB STMP3     * 5 
      RBL           * 10
      ADB A         PACK IN THIS DIGIT
      ISZ STMP2     CHECK THE DIGIT COUNT 
      JMP ENPAB 
      ADB STMP1     MERGE IN THE LETTER 
      STB ADS0,I    SAVE THE ID 
* 
*      NOW WE HAVE THE ID.  SEARCH THE IDEC TABLE 
* TO FIND OUT WHAT ID TRACK IT'S ON.
* 
      LDB IDECT     => LAST ENTRY 
ENPA  EQU * 
      STB STMP0     SAVE THIS TRACKS POINTER
      INB           ADVANCE TO THE DISC ADDRESS 
      LDA B,I       CHECK 
      INB             IF NON-EXISTENT TRACK 
      SZA,RSS           I.E.
      LDA B,I             DOUBLE WORD ADDRESS = 0 
      SZA,RSS 
      JMP ENPB      NON-EXISTENT TRACK
      INB           => TRACK LENGTH 
      LDA B,I 
      SZA,RSS       SKIP IF ENTRIES ON TRACK
      JMP ENPB      THIS TRACK IS EMPTY 
      ADB SM3       => FIRST ID ON TRACK
      LDA B,I       GET THE FIRST ID
      CMA,INA 
      ADA ADS0,I    > OR < ?
      SSA,RSS 
      JMP ENPC      FOUND THE TRACK 
ENPB  EQU * 
      LDB STMP0 
      CPB IDECS     CHECK FOR DONE
      JMP ENPC      DONE, MUST BE ON FIRST TRACK
      ADB SM4       NOT DONE,TRY PREVIOUS TRACK 
      JMP ENPA
* 
ENPC  EQU * 
      INB           => DISC ADDRESS 
      LDA B 
      ADB SD2       => LENGTH 
      LDB B,I       GET LENGTH
      STB MWORD       AND SAVE FOR DISC DRIVER
      SZB,RSS       CHECK FOR EMPTY TRACK 
      JMP ENPN
      BRS,BRS 
      BRS 
      STB STMP0     SAVE THIS COUNT FOR LATER 
      LDB IDTBT     => BUFFER 
      JSB DISCS,I   READ IN APPROPRIATE ID TRACK
* 
      CLA 
      STA CUDRS,I   TELL DIRGE THE BUFFER IS JUNK 
      LDB IDTBS     => FIRST ID ON TRACK
ENPF  EQU * 
      LDA B,I       GET THE FIRST ID
      CPA ADS0,I    IS THIS THE ONE 
      JMP ENPT      THE ENTRY IS PRESENT
      ADB SD8       MOVE TO NEXT
      ISZ STMP0     CHECK COUNT ON TRACK
      JMP ENPF
ENPN  EQU * 
      LDA SD14      LOAD CHARACTER COUNT
      LDB ENPDS     AND ADDRESS 
      JSB ASRS,I        FOR "NO SUCH ID"
      JMP ENPAA 
* 
*      THE ENTRY HAS BEEN FOUND IN THE IDT. 
* NOW CONTINUE CHECKING THE LINE TO SEE WHAT
* OTHER SURPRISES MIGHT OCCUR.
* 
ENPT  EQU * 
      JSB GETCS,I   GET THE NEXT CHARACTER
      JMP ENRI      CR - ONLY <ID>
      CPA SASCM     CHECK FOR COMMA 
      RSS 
      JMP ENTIL     MUST USE COMMA
      LDA SAS       INITIALIZE TO BLANKS
      STA ADS1,I
      STA ADS2,I
      STA ADS3,I
      LDA SM6       NAMES ARE SIX CHARACTERS
      STA STMP0 
      LDA ADS1      => NAME BUFFER
      RAL 
      STA STMP1 
ENPTB EQU * 
      JSB GETCS,I   GET THE NEXT CHARACTER
      JMP ENPW      CR - DONE 
      STA STMP2     SAVE THE CHARACTER FOR A MINUTE 
      CPA SASCM     CHECK FOR COMMA 
      JMP ENTIL       THEY ARE NOT ALLOWED
      AND SB140 
      SZA 
      CPA SB140 
      JMP ENPTB     IGNORE CONTROL CHARACTERS 
      LDB STMP1     GET THE BUFFER POINTER
      CLE,ERB 
      LDA B,I       FETCH THE WORD
      SEZ,RSS 
      ALF,ALF       SHIFT TO POSITION IF NECESSARY
      AND SMSK      MASK OFF
      IOR STMP2     AND PLUG IN THE CURRENT CHAR
      SEZ,RSS 
      ALF,ALF       DO THIS SHIFT BIT AGAIN 
      STA B,I       AND RESTORE THE WORD
      ISZ STMP1     ADVANCE 
      ISZ STMP0       POINTER AND CHECK THE COUNT 
      JMP ENPTB 
      JSB GETCS,I   6 CHAR NAME OR ERROR? 
      JMP ENPW      CR - OKAY 
      JMP ENTIL     SEVEN CHAR NAME 
* 
ENPW  EQU * 
      LDA ADS1,I    GET THE FIRST WORD
      AND SMSK
      ALF,ALF         FOR THE FIRST CHARACTER 
      CPA SB44      CHECK FOR $ 
      JMP ENTIL 
      CPA SB52        OR *
      JMP ENTIL 
      CPA SB40          OR BLANK
      JMP ENTIL           ALL OF WHICH ARE ILLEGAL
* 
*      WE NOW HAVE AN <ID>,<NAME> .  LET'S CHECK
* TO SEE IF IT'S IN THE DIRECTORY AND THEN DO 
* SOMETHING WITH IT.
* 
      JSB DRLKS,I   SEARCH DIRECTORY
      JMP ENQE      NOT IN DIRECTORY
      LDA LDFLG     CHECK FOR LOAD OR DUMP
      SZA,RSS 
      JMP ENQAB     DUMP, OKAY
* 
*      SELECTIVE LOAD AND ENTRY IS ALREADY PRESENT
* 
      LDA SD24      GET CHARACTER COUNT 
      LDB ENQES       AND ADDRESS 
      JSB ASRS,I        FOR "ENTRY ALREADY PRESENT" 
      JMP ENPAA 
* 
ENQAB EQU * 
      LDB DIRPS,I   => ENTRY
      ADB SD10      => 'MUST BE RECOVERED FLAG' 
      CCA             WHICH SERVES AS MUST BE DUMPED
      STA B,I 
      ADA JDECS,I   INCREASE THE COUNT
      STA JDECS,I 
      JSB CDTWS,I   REWRITE THE DIR TRACK 
      JMP ENPCR 
* 
ENQE  EQU * 
      LDA LDFLG     CHECK FOR LOAD OR DUMP
      SZA 
      JMP ENQEB     LOAD, OKAY
      SKP 
* 
*      SELECTIVE DUMP AND ENTRY NOT FOUND 
* 
      LDA SD16      LOAD CHARACTER COUNT
      LDB ENQNS       AND ADDRESS 
      JSB ASRS,I    FOR "NO SUCH ENTRY" 
      JMP ENPAA 
* 
*      PLACE THE ENTRY IN DIRECTORY.
ENQEB EQU * 
      JSB DREN      PUT ENTRY INTO DIRECTORY
      JMP ENPCR 
      JMP ENPCR     AND GO LOOK FOR ANOTHER ENTRY 
* 
* 
ENPEN EQU * 
      LDA STMP2     SEE WHICH CHARACTER THIS IS 
      CPA SM3       BETTER BE FIRST 
      RSS 
      JMP ENTIL     WHAT'S THIS?  E00N MAYBE? 
      LDA STMP0     GET THE FIRST CHARACTER 
      CPA SASE      CHECK FOR "E" 
      JMP ENPEG     YES, ASSUME 'END' 
ENTIL EQU * 
      LDA SD15      LOAD THE CHARACTER COUNT
      LDB ILINS       AND BUFFER ADDRESS
      JSB ASRS,I        FOR "ILLEGAL INPUT" 
      JMP ENPCR     GO ASK FOR ANOTHER LINE 
* 
*      AN ENTRY OF <ID> WAS TYPED.  WE PLACE THIS 
* ID INTO THE TABLE RESERVED FOR THIS GAME. 
* FIRST, SEARCH TO SEE IF ALREADY PRESENT 
* 
ENRI  EQU * 
      LDA ADS0,I    GET THE ID
      JSB EFID        AND LOOK FOR IT 
      JMP ENRIF     NOT FOUND, OKAY 
      JMP ENPCR     ALREADY PRESENT, IGNORE 
* 
ENRIF EQU * 
      STA ENTEP,I   STORE NEW ID INTO TABLE 
      ISZ ENTEP     ADVANCE THE END POINTER 
ENPCR EQU * 
      CLA,INA 
      LDB ENCRP 
      JSB ASRS,I
      JMP ENPAA 
* 
* 
ENPEG EQU * 
      LDA JDECS,I   CHECK NUMBER OF ENTRIES ADDED 
      SZA           IF ZERO,
      JMP ENPEJ 
      LDA ENTEP       CHECK THE ID TABLE
      CPA ENTBP         FOR ANY IDS 
      JMP RLDD      SO I'LL DO NOTHING
ENPEJ EQU * 
      LDA MAGSC     CHECK FOR A SELECT CODE 
      SZA           SKIP IF NONE
      JMP ENPEH 
      JSB GMTSS,I   GET MT SELECT CODE
      JMP ENPEG     MUST SUPPLY ONE 
ENPEH EQU * 
      LDA MAGSC     GET THE SELECT CODE 
      JSB MTDIS,I     AND CONFIGURE THE DRIVERS 
      JSB MTS,I     REWIND THE TAPE 
      OCT 3 
      LDA LDFLG     CHECK FOR LOAD OR DUMP
      SZA 
      JMP ENCSL     START SELECTIVE LOAD         [B]
      LDA MTKDS     GET THE 'RETURN' ADDRESS
      JMP MDSES,I   WRITE LABEL, EOF, AND DUMP
ENCSL EQU *                                      [B]
      DLD TLRT+TLSL SAVE SYSTEM AND 
      DST STMP0       FEATURE LEVEL CODES 
      JSB TPLRS,I   READ FIRST TAPE'S LABEL 
      LDA TLSLS,I   CHECK FEATURE LEVEL 
      JSB CKFCS,I     AGAINST SYSTEM'S
      DEF STAPE 
      JMP ENCSM     RESPONSIBILITY NOT ACCEPTED 
      DLD STMP0     OK, RESTORE SYSTEM'S
      DST TLRT+TLSL   LEVEL CODES IN BUFFER 
      JMP SPSFS,I       AND ENTER SELECTIVE LOAD
ENCSM EQU * 
      DLD STMP0     RESTORE SYSTEM'S
      DST TLRT+TLSL   LEVEL CODES IN BUFFER 
      CLA,INA       SUPPRESS "ENTRIES 
      STA NOMES       NOT FOUND" MESSAGE
      JMP SPRBA,I   PURGE DIRECTORY ENTRIES 
      HED DIRECTORY ENTRY ROUTINE 
* 
* 
DREN  NOP 
      CCA           ADD ONE TO
      ADA JDECS,I     THE FILE COUNTER
      STA JDECS,I       AND STORE IT BACK 
* 
*      INSERT A DUMMY ENTRY INTO THE DIRECTORY
* 
      CCA 
      STA ADS10,I   SET THE MUST BE RECOVERED FLAG
      LDB CUDRT,I   GET THE DIR TRACK LENGTH
      CPB M8184       AND CHECK FOR FULL
      JMP DREN2     TRACK IS FULL - GO SUPERSAVE
* 
      CMB 
      ADB IDTBS 
      STB MBVES     SET THE MOVE SOURCE 
      ADB SD12        AND 
      STB MBVED         DESTINATION 
      CMB 
      ADB SD12
      ADB DIRPS,I 
      JSB MBVE      AND CREATE A HOLE IN THE DIR
* 
      LDA ADS0      => FIRST WORD OF FAKE ENTRY 
      STA MOVSS,I   SET MOVE SOURCE 
      LDA DIRPS,I   => DIR HOLE 
      STA MOVDS,I   SET MOVE DESTINATION
      LDB SM12      GET THE ENTRY SIZE
      JSB MOVWS,I   AND CALL THE MOVER
* 
      LDA CUDRS,I   GET THE DIR POINTER 
      LDB A,I       B = DIR TRACK LENGTH
      ADB SM12      UPDATE THE LENGTH 
      STB A,I 
      INA 
      STA MOVDS,I   SET THE MOVE DESTINATION
      LDA IDTBS       AND 
      STA MOVSS,I       SOURCE
      LDB SM4       MOVE ID AND NAME INTO DIREC 
      JSB MOVWS,I 
* 
      JSB CDTWS,I   REWRITE THE DIR TRACK 
      ISZ DREN      NORMAL RETURN IS SKIP 
      JMP DREN,I    RETURN
* 
* 
DREN2 CLA 
      STA SUPTG     SAY WANT INSERTION
      JSB ENSU
      RSS           DIRECTORY FULL RETURN 
      ISZ DREN      NORMAL RETURN 
      JMP DREN,I
      SKP 
* 
* 
*    THE SUPERSAVE SUBROUTINE IS CALLED WITH: 
*    SUPTG > 0 FOR BALANCING THE DIRECTORY TRACKS ONLY. 
*          = 0 FOR INSERTING A DIRECTORY ENTRY ON A TRACK 
*            THAT IS ALREADY FULL, AS WELL AS BALANCING 
*            ALL THE DIRECTORY TRACKS. AND IN THIS CASE,
*           ADTBL THROUGH ADTBL+11 MUST CONTAIN THE ENTRY 
*            TO BE INSERTED.
* 
*    EXIT TO P+1 IF DIRECTORY TRACKS ARE FULL;
*            P+2 FOR NORMAL RETURN
* 
ENSU  NOP 
      LDB SUPTG 
      SZB,RSS 
      JMP ENSU1 
      CLA 
      STA SUPS-1
      STA SUPS
      JMP ENSU2 
ENSU1 CCA 
      STA SUPS-1
      LDA SM12
      STA SUPS
      CLA 
ENSU2 STA SUP 
      STA SUPB
      LDA DEFNN 
      STA SUPP
      LDA SDIR0     GET FIRST DIRECTORY TRACK PTR 
* 
* COMPUTE THE TOTAL NUMBER OF WORDS IN ALL
* OF THE DIRECTORY TRACKS.
* 
      ADA SD5       => DIRECTORY DISC ADDRESS 
SUP1  EQU * 
      LDB A,I       GET 1ST WORD OF THE DOUBLE WORD 
      INA           (A)=> 2ND WORD OF DISC ADDRESS
      SZB,RSS       IF 1ST WORD = 0,
      LDB A,I         CHECK IF 2ND WORD = 0 TOO.
      ADA SM6       (A) => LENGTH 
      SZB,RSS 
      JMP SUP2      DISC ADDR = 0 
      LDB A,I       GET THE DIRECTORY LENGTH
      CLE,SZB,RSS   IS IT ZERO? 
      JMP SUP2-1    YES 
      ADB SUPS      NO, ADD TO THE
      STB SUPS        TOTAL 
      LDB SUPS-1
      SEZ,RSS       FOR DOUBLE WORD NUMBER
      ADB SM1 
      STB SUPS-1
      ISZ SUPB      INCREMENT THE DIR TRACK COUNT 
SUP2  EQU * 
      CPA SDIRL     LAST DIRECTORY TRACK? 
      JMP *+3       YES 
      ADA SD12      NO. GO TO NEXT ONE
      JMP SUP1
* 
      LDA SUPS      GET THE TOTAL NUMBER OF 
      LDB SUPS-1      WORDS IN THE DIRECTORY
      DIV SD12      COMPUTE THE NUMBER OF ENTRIES 
      CCB 
      DIV SUPB      FIND NUMBER ON EACH TRACK 
      CPA SM682 
      JMP SUPR2     TEST FOR FULL DIRECTORY 
      CPA SM683 
      JMP SUPER     DIRECTORY IS FULL 
SUP3  ADA SM1       INCREASE # OF ENTRIES/TRACK BY 1
      STA SUPS        AND SAVE IN SUPS
      ADB SM1       LET B COUNT HOW MANY WILL HAVE
      STB SUPB        THIS LARGER SIZE
* 
      LDB SDIR0     GET PTR TO FIRST DIR TRACK
      ADB SD5       => DISC ADDRESS 
SUP4  EQU * 
      LDA B,I       TEST
      INB             FOR 
      SZA,RSS           NONEXISTENT 
      LDA B,I             DIRECTORY (DISC ADDR = 0) 
      SZA,RSS       IF NO TRACK ALLOCATED,
      JMP SUP5        WE CAN'T PUT ANYTHING ON IT 
      ISZ SUPB      TEST FOR MORE BIG TRACKS
      RSS           YES, DON'T SWITCH SIZES 
      ISZ SUPS      SWITCH TO SMALLER SIZE
      NOP           IN CASE SUPS = -1 
      LDA SUPS      GET NEGATIVE COUNT
      ALS,ALS       CONVERT 
      STA SUPS-1    * 4 
      ALS             TO WORDS
      ADA SUPS-1    * 12
SUP5  EQU * 
      STA SUPP,I    STORE INTO TABLE
      ADB SM6 
      CPB SDIRL     CHECK FOR DONE
      JMP SUP6
      ADB SD12      ADVANCE TO NEXT TRACK 
      ISZ SUPP      AND MOVE THE TABLE POINTER
      JMP SUP4
* 
*      TABLE NN NOW CONTAINS THE NEW LENGTHS OF THE 
* EIGHTY DIRECTORY TRACKS 
* 
SUP6  EQU * 
      LDA DEFNN     SET UP THE POINTER
      STA SUPP        TO THE TABLE AGAIN
      SKP 
* 
*      SQUEEZE ALL OF THE DIRECTORY ENTRIES ONTO
* THE LASTMOST OF THE AVAILABLE TRACKS
* 
      LDA SDIRL     => FIRST TRACK
      STA SUPK1       FOR READ
      ADA SD5       => DISC ADDRESS 
SUP20 EQU * 
      LDB A,I       GET 1ST WORD OF DISC ADDRESS
      INA           => 2ND WORD 
      SZB,RSS       CHECK IF
      LDB A,I         THE TRACK EXISTS: I.E.
      SZB               DISC ADDRESS = 0
      JMP SUP21     YES. IT EXISTS
      ADA SM8       NO. 
      JMP SUP20 
SUP21 EQU * 
      ADA SM6       => FIRST TRACK FOR WRITE
      STA SUPL1 
      CLA           NUMBER OF WORDS THAT ARE
      STA SUPK2       IN THE BUFFER 
* 
      LDA SUPK1 
SUP22 EQU * 
      LDB A,I       GET LENGTH FOR READ 
      SZB,RSS       ZERO? 
      JMP SUP27     YES 
      ADB SUPK2     NO, ADD IN # OF WORDS IN BUFFER 
      ADB S8184 
      SSB           >8184?
      JMP SUP23     YES 
      LDB A,I       NO, SET 
      STB MWORD       THE LENGTH
      ADB SUPK2     UPDATE THE NUMBER OF
      STB SUPK2       WORDS IN CORE 
      ADB LULEN 
      ADB BIS15     FOR INPUT 
      ADA SD5       => DISC ADDRESS 
      JSB DISCS,I     AND READ IT IN
* 
      LDB SUPK2 
      CPB M8184     EXACTLY 8184 WORDS? 
      RSS           YES 
      JMP SUP27     NO
      STB MWORD 
      LDA SUPL1     SET THE LENGTH
      STB A,I         INTO DIREC
      ADA SD5       => DISC ADDRESS 
      LDB X2056     CORE ADRESS 
      JSB DISCS,I 
      CLB           BUFFER NOW EMPTY
      STB SUPK2 
      JMP SUP24 
      SKP 
SUP23 EQU * 
      CMB,INB 
      BRS,BRS       COMPUTE 
      BRS,BRS         NUMBER OF 
      BRS,BRS           EXTRA 
      BRS,BRS             BLOCKS
      STB SUPES            AND SAVE 
      BLF,BLF       NO. OF EXTRA
      STB SUPEX       WORDS 
      ADB A,I       NO. OF WORDS
      STB MWORD       TO READ 
      ADB SUPK2 
      ADB LULEN 
      STB MOVSS,I   SET MOVE ADDRESS
      ADA SD5       => DISC ADDRESS 
      DLD A,I       GET DISC ADDRESS
      CLE 
      ADB SUPES     ADD IN
      SEZ             EXTRA 
      INA               BLOCKS
      DST STMP8     SAVE FOR DISC READ
      LDA STP8A     => DISC ADDRESS 
      LDB MOVSS,I 
      ADB BIS15     SET FOR INPUT 
      JSB DISCS,I 
* 
      LDB M8184     NO. OF WORDS
      STB MWORD       TO WRITE
      LDA SUPL1 
      STB A,I       SAVE IN THE DIREC TABLE 
      ADA SD5       => DISC ADDRESS 
      LDB X2056     CORE ADDRESS
      JSB DISCS,I   WRITE DIRECTORY TO DISC 
* 
      LDB X2056     NUMBER OF 
      CMB,INB         EXTRA 
      ADB MOVSS,I       WORDS 
      STB SUPK2           TO MOVE 
      LDA LULEN 
      ADA B 
      STA MOVDS,I   DESTINATION POINTER 
      JSB MOVWS,I   MOVE THEN 
* 
      LDB SUPEX     NUMBER OF WORDS 
      CMB,INB         TO READ FROM
      STB MWORD         THE PARTIAL TRACK 
      ADB SUPK2 
      STB SUPK2     NUMBER OF WORDS IN THE BUFFER 
      ADB LULEN 
      ADB BIS15     SET FOR INPUT 
      LDA SUPK1 
      ADA SD5       => DISC ADDRESS 
      JSB DISCS,I   READ IN THE PARTIAL TRACK 
* 
SUP24 EQU * 
      LDA SUPL1     ADVANCE TO THE NEXT 
      ADA SM2         TRACK TO WRITE
SUP25 EQU * 
      LDB A,I       IS
      INA             THE 
      SZB,RSS           DOUBLE WORD 
      LDB A,I             DISC ADDRESS
      SZB                   = 0?
      JMP SUP26     NO. 
      ADA SM8 
      JMP SUP25 
SUP26 EQU * 
      ADA SM6       ADVANCE PTR TO LENGTH WORD
      STA SUPL1     SAVE THE POINTER
* 
SUP27 EQU * 
      LDA SUPK1     => CURRENT READ TRACK 
      CPA SDIR0     LAST ONE? 
      JMP SUP28     YES 
      ADA SM7       NO, ADVANCE TO NEXT ONE 
      STA SUPK1 
      JMP SUP22 
* 
SUP28 EQU * 
      LDB SUPK2     NO. OF WORDS IN BUFFER
      SZB,RSS       ZERO? 
      JMP SUP30     YES 
      STB MWORD     NO, MUST WRITE OUT THE BUFFER 
      LDA SUPL1     SET THE LENGTH
      STB A,I         INTO DIREC
      ADA SD5       => DISC ADDRESS 
      ADB LULEN     GET THE CORE ADDRESS
      JSB DISCS,I 
* 
      LDA SUPL1 
SUP29 EQU * 
      CPA SDIR0     LAST WRITE TRACK? 
      JMP SUP31     YES, DONE 
      ADA SM7       NO, MOVE TO NEXT ONE
      RSS 
SUP30 EQU * 
      LDA SUPL1 
      ADA SD5       => DISC ADDRESS 
      LDB A,I       1ST WORD OF DISC ADDRESS = 0? 
      INA 
      SZB,RSS       NO. 
      LDB A,I       YES. HOW ABOUT 2ND WORD?
      ADA SM6 
      SZB,RSS       IS IT ZERO? 
      JMP SUP29     YES 
      CLB           NO, SET THE 
      STB A,I         LENGTH TO ZERO
      JMP SUP29 
      SKP 
