      SKP 
* 
*     NOW DUMP ALL USER DISCS 
* 
MSP0  EQU * 
      LDA DRPA,I
      CPA DRD32 
      JMP MSP12 ;;
      ADA .+14        POINTER TO
      STA DRPA,I    NEXT DISC 
      ADA .+6       FORM
      LDA 0,I         BASIC 
      SZA,RSS         DISC ADDRESS
      JMP MSP0      IF 0 THEN NONEXISTENT DISC
      AND XDMSK 
      STA DSCA,I
* 
      LDA ADLEN     INPUT 
      STA WORDA,I     ADT 
      CLA 
      STA TRTBA,I   SET NEW ADT LENGTH=0
      LDA ADLOC 
      LDB TBFI
      JSB DISCL,I 
* 
      LDA TBUFA     EXTRACT ADT 
      STA LTEMP       FOR THIS DISC 
MSP4  LDA LTEMP,I 
      CPA .-1       END OF TABLE? 
      JMP MSP2      YES - NO ADT FOR THIS DISC
      AND XDMSK     IS INTRY
      CPA DSCA,I      FOR THIS DISC?
      JMP MSP3      YES 
      ISZ LTEMP 
      ISZ LTEMP 
      JMP MSP4
MSP3  LDA LTEMP     NOW LOOP
      STA LTEMP+1     FOR END 
MSP6  ISZ LTEMP 
      ISZ LTEMP 
      LDA LTEMP,I Iw
      CPA .-1       END OF TABLE? 
      JMP MSP5
      AND XDMSK     IS IT FOR THIS
      CPA DSCA,I
      JMP MSP6      YES 
MSP5  LDA LTEMP     COMPUTE # OF WORDS
      CMA,INA       IN THIS ADT SECTION 
      ADA LTEMP+1 1
      STA WORDA,I 
      STA TRTBA,I 
      LDA DSCA,I    OUTPUT
      ADA .+2         ADT 
      LDB LTEMP+1       TO
      JSB DISCL,I         DISC
      LDB DRPA,I    DUMP ADT
      LDA 1,I           AND 
MSP2  EQU * *d
      STA TRTB1,I       DIRECTORY 
      ADB .+7                TRACK
      LDA 1,I                 LENGTHS 
      STA TRTB2,I           TO
      LDA .-3                     TAPE
      STA WORDA,I   OUTPUT
      LDA DSCA,I      ADT AND DIRECTORY 
      STA DISC1 
      INA                TRACK
      LDB TRTBA            LENGTHS
      JSB DISCL,I            TO 
      JMP SD3+2                DISC 
* 
SD2   EQU * 
      LDA WORDA,I   OUTPUT ADT
      LDB LTEMP+1     TO MAG TAPE 
      JSB MWRIT 
* 
*     NOW FROM TRACK TABLE
* *q
      LDB X203      INITIALIZE
      STB TCNTA,I     TABLE 
      LDB TRTBA 
      LDA .+48
      STA 1,I 
      INB 
      ISZ TCNTA,I 
      JMP *-3 3j
      CLA           TRACKS 0,1,2
      STA TRTBA,I 
      STA TRTB1,I 
      STA TRTB2,I 
* 
      LDB LTEMP     (LTEMP)=> DISC ADDRESS
      ADB .-2       PSEUDO ENTRY. 
      STB LTEMP 
MSP8  LDA LTEMP,I   A=DISC ADDRESS
      ISZ LTEMP     LTEMP=> LENGTH
      LDB LTEMP,I   B=LENGTH
      SZB,RSS       =0? 
      JMP MSP17     YES. LEAVE IT 0.
      AND PD77,I    NO. ISOLATE SECTOR ADDRESS. 
      ADA B         REMAINDER OF TRACK AVAILABLE? 
      CPA .+48
      RSS 
      CLB           NO. PUT 48 INTO TABLE.
      CMB,INB       YES. SET PROPER NUMBER. 
      ADB .+48
MSP17 STB LTEMP+2 
      LDB LTEMP     GET 
      ADB .-1         ADDRESS 
      STB LTEMP 
      LDA 1,I 
      AND XM64      ISOLATE TRACK PART
      STA LTEMP+3 
      LSR 7 
      AND XB377     ISOLATE TRACK 
      ADA TRTBA     COMPUTE TRACK ADRESS
      LDB LTEMP+2 
      STB 0,I       STORE LENGTH
* *q
      LDB LTEMP     GET NEXT
      ADB .-2         ADT ENTRY 
      LDA 1,I           BACK
      AND XM64      SAME TRACK? 
      CPA LTEMP+3 3J
      JMP *-4 
      STB LTEMP     NEW TRACK 
      ADB .+2         END OF ADT? 
      CPB LTEMP+1 
      RSS           YES.
      JMP MSP8      NO. 
* qq
MSP7  LDA D203      OUTPUT
      LDB TRTBA       TRACK 
      JSB MWRIT 
* qq
      JSB DLIB      DUMP LIBRARY TRACKS 
      JSB DDRC      DUMP DIRECTORIES
      LDA SFLGA,I   SELECTIVE DUMP? 
      SZA,RSS 
      JMP MSP0      NO. 
      JSB MGTPA,I   YES. REWIND.
      OCT 3 
      JMP INCMA,I 
* qq
      SKP 
* 
*     ALL USER PROGRAMS AND FILES 
*     HAVE BEEN DUMPED TO MAG TAPE
*     NOW DUMP SYSTEM 
*                   THE FIRST RECORD IS:
*                                       DEC -5
*                                 SEG1L DEC -1024 
*                                 SEG1A DEF ORG1
*                                 SEG2L DEC -6144 
*                                 SEG2A DEF ORG2
*                               SEG3L DEC -6144 
*                                 SEG3A DEF ORG3
*                                 SEG4L DEC -20 
*                                 SEG4A DEF ORG4
* 
MSP12 EQU * 
      LDA .-9 
      LDB SEGT
      JSB MWRIT 
* 
      LDA SEG1L     INPUT 
      STA WORDA,I     FIRST 
      LDA SEG1D,I   DISC
      LDB TBFI
      JSB DISCL,I 
      JSB WRTTP     WRITE TAPE
      LDA SEG2L     READ
      STA WORDA,I     SEGMENT 
      LDA SEG2D,I        TWO
      LDB TBFI
      JSB DISCL,I 
      JSB WRTTP     WRITE TO TAPE 
      LDA SEG3L     READAx
      STA WORDA,I   SEGMENT 
      LDA SEG3D,I        THREE
      LDB TBFI
      JSB DISCL,I 
      JSB WRTTP 
      LDA SEG4L     OUTPUT
      LDB SEG4A       LOADER
      JSB MWRIT         TABLE 
* q{
*     NOW GET SYSTEM OVERLAYS 
* 
      LDA X128
      STA WORDA,I 
      LDA COM6A,I      LIBRARY
      STA LTEMP 
      LDA LTEMP,I 
      LDB SLOLI 
      JSB DISCL,I 
      LDA WORDA,I 
      LDB SLOLA 
      JSB MWRIT 
      LDA SLOLA 
      LDB 0,I 
      INB 
      STB DTMP0 
      INA gg
      STA XADR1 
      ISZ LTEMP 
MSP11 LDA XADR1,I     IN
      STA WORDA,I IN
      LDA LTEMP,I 
      LDB TBFI
      JSB DISCL,I 
      JSB WRTTP     WRITE 
      ISZ LTEMP 
      ISZ XADR1 
      ISZ DTMP0 
      JMP MSP11 
* 
      JSB MGTPA,I   EOF 
      OCT 2 
      JMP EFA,I Il
     JMP TPE,I
      JSB MGTPA,I   REWIND
      OCT 5           & STANDBY 
* 
*     SLEEP IS COMPLETE 
* qq
      LDA .+18
      LDB SLCOM     "SLEEP COMPLETE"
      JSB T35DR,I 
* 
      JMP MAINA,I 
* 
*     DUMP LIBRARY TRACKS 
* 
DLIB  NOP 
      LDA X2030~
      STA TCNTA,I 
      LDA TRTBA 
      STA LTEMP 
MSLP8 LDA LTEMP,I 
      SZA,RSS       ZERO LENGTH?
      JMP MSLP7 
      ASL 7         COMPUTE LENGTH
      STA LTEMP+1 
      ADA X3072 
      SSA,RSS 
      JMP MSLP9 
MSPL2 LDA LTEMP+1 dd
      CMA,INA 
      STA WORDA,I 
MSPL1 EQU * 
      LDA DSCA,I    INPUT LIBRARY TRACK 
      LDB TBFI
      JSB DISCL,I 
      LDA WORDA,I 
      LDB TBUFA       TO TAPE 
      JSB MWRIT 
      LDA LTEMP+1 
      ADA WORDA,I 
      STA LTEMP+1 
      SZA,RSS 
      JMP MSLP7 
      CMA,INA A&
      STA WORDA,I 
      LDB TBFI
      LDA DSCA,I,7
      ADA .+242:
      JMP MSPL1+2 
MSLP7 LDA DSCA,I    GO
      ADA XB200       TO
      STA DSCA,I        NEXT
      ISZ LTEMP           TRACK 
      ISZ TCNTA,I   ALL DONE? 
      JMP MSLP8     NO
      JMP DLIB,I    YES 
* 
MSLP9 SZA,RSS 
      JMP MSPL2 
      LDA X3072 2
      STA WORDA,I 
      JMP MSPL1 1e
      SKP 
* qq
*     DUMP DIRECTORY TRACKS 
* 
DDRC  NOP 
      LDA DRPA,I    LOAD
      LDA 0,I         DIRECTORY 
      STA WORDA,I       FROM
      LDA DRPA,I          DISC
      ADA .+6             DISC
      STA DRPA,I
      LDA 0,I 
      LDB TBFI
      JSB DISCL,I 
* 
      LDA WORDA,I 
      LDB TBUFA       TO MAG TAPE 
      JSB MWRIT 
* 
      ISZ DRPA,I
      LDA DRPA,I    CHECK 2ND 
      LDA 0,I         TRACK 
      SZA,RSS       ZERO LENGTH => EMPTY
      JMP MSPL9 
      STA WORDA,I 
      LDA DRPA,I
      ADA .+6 
      LDA 0,I 
      LDB TBFI
      JSB DISCL,I 
* qq
      LDA WORDA,I 
      LDB TBUFA 
      JSB MWRIT 
MSPL9 EQU * 
      JSB MGTPA,I 
      OCT 2 
      JMP EFA,I Il
     JMP TPE,I
* 
      LDA DRPA,I
      ADA .-7         DIRECTORY 
      STA DRPA,I
      JMP DDRC,I
* 
*     WRITE SEGMENT TO TAPE 
* 
WRTTP NOP 
      LDA WORDA,I 
      LDB TBUFA 
      JSB MWRIT 
      JMP WRTTP,I 
* 
MREAD NOP PW
      JSB MGTPA,I 
      OCT 0 
      JMP EFA,I 
      JMP TPE,I 
      JMP MREAD,I 
* qq
MWRIT NOP 
      JSB MGTPA,I 
      OCT 1 
      JMP EFA,I 
      JMP TPE,I xx
      JMP MWRIT,I 
* yq
*     INITIALIZE DISC DATA
* 
DINIT NOP P1
      STA DINT1     SET DISC
      LDA INITC       DRIVER
     STA WRTA,I         FOR INITIALIZATION
      LDA ERRT
      STA ERRTA,I 
      LDA DINT1 
      JSB DISCL,I     GO TO DISC DRIVER 
      LDA WRTC         RESET TO 
      STA WRTA,I         NORMAL WRITE 
      LDA HLT11 
      STA ERRTA,I 
      JMP DINIT,I 
* 
DINTR ISZ DINIT      ERROR RETURN 
      JMP *-6 
INITC OCT 110000
WRTC  OCT 10000 
ERRT  RSS mm
ERRTA DEF DRV1
HLT11 HLT 11B 
* 
**     MOVE BLOCK OF MEMORY ROUTINE 
* *q
MOVEW NOP 
      SSB,INB,RSS 
      JMP MOVEW,I 
      LDA MOVES,I 
      STA MOVED,I 
      ISZ MOVES 
      ISZ MOVED 
      JMP MOVEW+1 
* qq
**    MOVE BACKWARDS
* 
MOVEB NOP 
      SSB,INB,RSS 
      JMP MOVEB,I 
      LDA MOVES,I 
      STA MOVED,I 
      LDA MOVES 
      ADA .-1 
      STA MOVES 
      LDA MOVED 
      ADA .-1 
      STA MOVED 
      JMP MOVEB+1 
MOVES NOP 
MOVED NOP 
* 
* 
DINT1 NOP 
WRTA DEF WRITE
NMOTP DEF NUMOT 
SEGT  DEF *+1 
      DEC -5
SEG1L DEC -1024 
SEG1A DEF ORG1
SEG2L DEC -6144 4|
SEG2A DEF ORG2
SEG3L DEC -6144 4]
SEG3A DEF ORG3
SEG4L DEC -21 
SEG4A DEF ORG4
SEG1D DEF DEQTA 
SEG2D DEF LDRTT 
SEG3D DEF LDRTT+1 
ORG1  EQU 0 
ORG2  EQU 14000B
ORG3  EQU ORG2+6144 
ORG4  EQU 4000B 
WORDA DEF WORDC C
MAINA DEF MAIN
X203  DEC -203
D203  EQU X203
XM64  DEC -64 
MAGTP DEF .MGTP 
OCTIN DEF INTCK 
SLCOM DEF .SLCM 
TBUFA DEF TBUFR 
TRTBA DEF TRTBL 
DSCA  DEF DISCA 
DRPA  DEF DRP 
TBFI  DEF TBUFR,I 
TRBLA DEF TRTBL 
TRTB1 DEF TRTBL+1 
TRTB2 DEF TRTBL+2 
XB377 OCT 377 
X3072 DEC -3072 
X128  DEC -128
D200  DEC 200 
PD77  DEF D.77
INTGI DEF INTGR 
COM6A DEF COM6
XB200 OCT 200 
XADR1 NOP 
SUB1  NOP ,,
SUB2  NOP 
DISC1 NOP 
DISC2 NOP 
DAD1  NOP 
DAD2  NOP 
COPMS DEF .CPMS 
INCMA DEF INCOM 
ADTTA DEF ADTTT 
TCNTA DEF TCNT
INBFR DEF INBUF 
GETCH DEF GETCR 
XBKSP DEF XBSP
CERRA DEF CERR
FSUBB DEF FSUB
CONMG DEF MTDIN 
DISCL DEF DISCD 
T35DR DEF TTY35 
MGTPA DEF MGTDR 
TPE   DEF TPERR 
EFA   DEF EOFER 
SCERA DEF .SCER 
SCERM DEF .SCEM 
XB400 OCT 400 
LD53A DEF LDR53 
XB100 OCT 100 
BAD   NOP 
ADTT  DEF ADTBL Ln
SFLGA DEF SFLAG 
ADTP  NOP 
X6144 DEC -6144 
XD48  DEC 48
M67B  OCT -67 
INF1  OCT 77777 
DL1   NOP 
DL2   NOP 
SYMSF DEF SYMSA 
LBMES DEF LBMSA 
M70B  OCT -70 
NUM   NOP 
INVLA DEF INVLD 
XB111 OCT -111
XDMSK OCT 100100
DRD32 DEF 100B+42 
SLOLA DEF SLOL
DTMP0 OCT 0 
SLOLI DEF SLOL,I
PLABC DEF LABCK 
FCKP  DEF FCHEK 
TRTBL BSS 204 
PLBCK DEF LABCK 
FCHKP DEF FCHEK 
.MGTP OCT 6412
      ASC 6,SELECT CODE?
.SLCM OCT 5123
      ASC 7,LEEP COMPLETE 
INVLD OCT 6412
      ASC 9,INVALID SUBCHANNEL
.CPMS OCT 6412
      ASC 7,COPY COMPLETE 
.SCER OCT 6412
      ASC 10,INVALID SELECT CODE
.SCEM OCT 6412
      ASC 10,RE-INPUT SELECT CODE 
DDBAD OCT 6412
      ASC 10,TRACK 0,1, OR 2 BAD
      OCT 6412
      ASC 10,CANNOT USE THIS DISC 
SLOL  EQU TRTBL 
      HED    PACK USER DISC ROUTINE 
PACK JSB PINT,I    GET SUBCHANNEL NUMBER        (D) 
      JSB PSBCK,I   VALID? IS DISC READY?       (D) 
      SZB,RSS                                   (D) 
      JMP PINVL,I   ZERO NOT ALLOWED            (D) 
      JSB FSUBP,I   GET DISC ADDRESS
      STA PDISC     SAVE DISC ADDRESS 
* qq
      LDA .-5       READ LABEL FROM DISC. 
      STA WORDD,I 
      LDA PDISC 
      LDB PTBFI 
      JSB DISCP,I 
      JSB FCHKP,I   CHECK USER DISC FLAG. 
      JSB PLBCK,I   CHECK LABEL FOR USER DISC.
* 
      LDA .-3       READ
      STA WORDD,I     LENGTHS TABLE 
      LDA PDISC         FROM DISC 
      INA 
      LDB PDLNI 
      JSB DISCP,I 
* 
      LDA PADLN     READ
      STA WORDD,I     ADT 
      LDA PDISC         FROM
      ADA .+2             DISC
      STA PDLOC 
      LDB PTBFI 
      JSB DISCP,I IP
      LDA PTBUF     SET POINTERS
      STA PADR
      CMA,INA A&
      ADA PADLN     END POINTER 
      CMA,INA 
      STA PADEN 
* 
PAC1  LDB PADR
      CPB PADEN 
      JMP PACKE Ey
      INB 
      LDA 1,I       GET LENGTHS 
      SZA,RSS 
      JMP PAC2      FULL
      CPA .+48
      JMP PAC2      EMPTY 
      ADB .-1       PACK
      STB PADR      TRACK 
      LDA 1,I 
      AND PM64      GET TRACK ADDRESS 
      STA PDAD      SAVE IT 
      LDA PADLN     OUTPUT
      STA WORDD,I     ADT 
      LDA PDLOC         TO
      LDB PTBUF           DISC
      JSB DISCP,I 
* 
      LDA STAB      SET TABLE POINTERS
      STA LTEMP+3 
      STA LTEMP+4 
      LDA PDAD
      STA LTEMP+1 
      STA LTEMP+2 
      LDA PDRL1     LOAD FIRST DIRECTORY TRACK
      STA WORDD,I 
      LDA PDISC 
      ADA P200
      LDB PTBFI I
      JSB DISCP,I 
      CLA 
      STA DFLAG     SET FLAG TO SAY TRACK 1 
PAC7  CLA 
      STA LTEMP+6   SET NO CHANGE FLAG
      LDB WORDD,I 
      CMB,INB       COMPUTE END OF TABLE
      ADB PTBUF ZZ
PAC3  CPB PTBUF     DONE? 
      JMP PAC4      YES 
      ADB .-2       B=> DISC ADR OF ENTRY 
      LDA 1,I 
      AND PM64      GET TRACK PART
      CPA PDAD      RIGHT TRACK?
      JMP PAC5      YES 
      ADB .-6       NO
      JMP PAC3
PAC5  LDA 1,I       GET DISC ADDRESS
      STA LTEMP+3,I   AGAIN 
      LDA LTEMP+1   ASSIGN NEW ADDRESS
      STA 1,I 
      INB 
      LDA 1,I       GET LENGTH
      ARS,ARS 
      ARS,ARS 
      ARS,ARS 
      ARS 
      CMA,INA       UPDATE
      ADA LTEMP+1     TABLE 
      STA LTEMP+1 
      ISZ LTEMP+3 
      STA LTEMP+3,I 
      ISZ LTEMP+3 
      ISZ LTEMP+6   WRITE DIRECTORY BACK
      ADB .-7 
      JMP PAC3
* qq
PAC4  LDA LTEMP+6 
      SZA,RSS 
      JMP PAC6      NO CHANGE TO DIRECTORY
      LDA DFLAG 
      SZA 
      JMP PAC48     WE'VE DONE BOTH TRACKS
      LDA PDISC     WRITE 
      ADA P200        DIRECTORY OUT 
      LDB PTBUF 
      JSB DISCP,I 
PAC42 EQU * 
      LDA PDRL2 
      STA WORDD,I 
      LDA PDISC 
      ADA P400
      LDB PTBFI 
      JSB DISCP,I 
      ISZ DFLAG 
      JMP PAC7
PAC6  LDA DFLAG 
      SZA 
      JMP PAC41 
      JMP PAC42 
PAC2  INB 
      JMP PAC1+1
PAC48 LDA LTEMP+6 
      SZA,RSS 
      JMP PAC41 
      LDA PDISC 
      ADA P400
      LDB PTBUF 
      JSB DISCP,I 
* 
PAC41 LDA LTEMP+4   DONE? 
      CPA LTEMP+3 JJ
      JMP PAC8      YES 
      DLD LTEMP+4,I NO
      CMB,INB 
      ADB LTEMP+2 
      CLA 
      ASL 7 
      STB WORDD,I 
      LDB LTEMP+2   READ
      LSL 10          FROM
      LSR 3             DISC
      ADB PTBFI           TO
      LDA LTEMP+4,I         CORRECT 
      JSB DISCP,I             NEW 
      ISZ LTEMP+4               POSITION
      LDA LTEMP+4,I 
      STA LTEMP+2 
      ISZ LTEMP+4 
      JMP PAC41 
* qq
PAC8  LDA LTEMP+2   WRITE 
      CMA,INA         PACKED
      ADA PDAD          TRACK 
      ASL 7               TO
      STA WORDD,I          DISC 
      LDA PDAD
      LDB PTBUF 
      JSB DISCP,I 
* qq
      LDA PADLN     READ
      STA WORDD,I   ADT 
      LDA PDLOC         TABLE 
      LDB PTBFI 
      JSB DISCP,I 
      LDB PTBUF 
PAC81 LDA PDAD
      CMA,CLE,INA 
      ADA 1,I 
      SEZ 
      JMP *+3 HH
      ADB .+2 
      JMP PAC81 
* 
      STB LTEMP+1   IS ENTRY
      LDA 1,I         ON THIS 
      AND PM64          TRACK 
      CPA PDAD
      JMP PAC82     YES 
* 
      LDA PDAD      IS TRACK
      ADA .+48
      CPA LTEMP+2 
      JMP PAC83     YES 
      LDB PADLN     NO
      ADB .-2         MAKE
      STB PADLN         ROOM FOR
      CMB                 NEW 
      ADB PTBUF             ENTRY 
      STB PMVD,I
      ADB .-2 
      STB PMVS,I
      CMB 
      ADB LTEMP+1 
      JSB PMVB,I
      JMP PAC84 
* 
PAC82 ADB .+2       SEARCH
      LDA 1,I         FOR ENTRY NOT ON THIS TRACK 
      AND PM646?
      CPA PDADA{
      JMP PAC82 
      STB PMVS,I
      ADB PADLN 
      STB PMVD,I
      LDB PTBUF 
      CMB,INB BQ
      ADB PMVD,I
      LDA PDAD
      ADA .+48
      CPA LTEMP+2 
      CLA,RSS 
      LDA .+2 
      ADA LTEMP+1 
      STA PMVD,I
      JSB PMVW,I
      LDA PMVD,I
      CMA,INA 
      ADA PTBUF 
      STA PADLN 
      LDA PDAD
      ADA .+48
      CPA LTEMP+2 
      JMP PAC83 
* 
PAC84 LDB LTEMP+2 
      CMB,INB 
      ADB PDAD
      ADB .+48
      LDA LTEMP+2 
      DST LTEMP+1,I 
* *q
PAC83 LDA PADLN 
      CMA,INA 
      ADA PTBUF FQ
      STA PADEN 
      ISZ PADR
      ISZ PADR
      JMP PAC1
* *q
PACKE LDA PADLN     OUTPUT
      STA WORDD,I     ADT 
      LDA PDLOC         TO
      LDB PTBUF           DIS 
      JSB DISCP,I 
      LDA .-3 
      STA WORDD,I 
      LDA PDISC     OUTPUT
      INA             LENGTHS 
      LDB PDLNA         TO
      JSB DISCP,I         DISC
* 
*     SECTOR PACK COMPLETE
*     NOW PACK TRACKS 
* qq
      LDA PTBUF     SET 
      STA PADR        POINTERS
      STA PADRT 
      CMA,INA 
      ADA PADLN 
      CMA,INA 
      STA PADEN 
* 
PAK11 LDB PADR      LOAD
      INB             TRACK 
      LDA 1,I           LENGTH
      SZA,RSS 
      JMP PAK1      PSEUDO ENTRY. 
      ADB .-1       NOT FULL. 
      STB PADR      UPDATE
      ADB .+2         POINTERS
      STB PADRT 
PAK22 INB 
      LDA 1,I       LOAD TRACK LENGTH 
      SZA,RSS 
      JMP PAK2
      CPA .+48
      JMP PAK2
      CMA,INA       GET LENGTH
      ADA .+48        OF TRACK
      CMA,INA 
      STA PADDL 
      LDB PADR
      INB           WILL
      ADA 1,I         IT FIT? 
      SSA 
      JMP PAK2      NO
* qq
      STA LTEMP+1   SAVE LENGTH LEFT
      LDA PADR,I    SAVE
      STA LTEMP+2     NEW DISC ADDRESS
      LDA PADRT,I   SAVE
      AND PM64
      STA PADRT,I 
      STA LTEMP+3     CURRENT TRACK ADDDRESS
      LDA PADRT T*
      INA           SET 
      LDB .+48        TRACK 
      STB 0,I           EMPTY 
      LDB PADR        LENGTH
      LDA LTEMP+1   UPDATE
      CMA,INA 
      ADA .+48         DISC 
      STA LTEMP+4 4
      LDA PADR,I           ADDRESS
      AND PM64???K
      ADA LTEMP+4 
      STA PADR,I
      INB               LEFT
      LDA LTEMP+1 
      STA 1,I 
      SZA A;
      JMP PAK3      NOT FULL
* 
      LDA PADR       FULL 
      STA PMVD,I      SO
      ADA .+2           DELETE
      STA PMVS,I          DELETE ENTRY
      LDB PTBUF 
      CMB,INB 
      ADB PADLN 
      ADB PMVS,I
      JSB PMVW,I
      LDA PADLN 
      ADA .+2 
      STA PADLN 
      STA WORDD,I   WRITE 
PAK3  LDA PDLOC       ADT 
      LDB PTBUF         TO
      JSB DISCP,I         DISC
* 
      LDA PADDL     READ
      ASL 7           IN TRACK
      STA WORDD,I 
      LDA LTEMP+3 
      LDB PTBFI 
      JSB DISCP,I 
      LDA LTEMP+2   OUTPUT
      LDB PTBUF       TO
      JSB DISCP,I       NEW LOCATION
      LDA LTEMP+3   SET 
      CMA,INA         MODIFICATION
      ADA LTEMP+2       VALUE 
      STA LTEMP+4 
*     UPDATE DIRECTORIES
* 
      CLA 
      STA DFLAG 
      LDA PDRL1     READ IN 
      STA WORDD,I     FIRST DIRECTORY TRACK 
      LDA PDISC 
      ADA P2000B
      LDB PTBFI 
      JSB DISCP,I 
      LDB PDRL1 
      CMB,INB 
      ADB PTBUF 
PAK5  CPB PTBUF     DONE? 
      JMP PAK7      YES 
      ADB .-2       LOAD
      LDA 1,I         DISC ADDRESS
      AND PM646?
      CPA LTEMP+3   ON OLD TRACK? 
      JMP PAK6      YES 
PAK61 ADB .-6 
      JMP PAK5
PAK6  LDA 1,I 
      ADA LTEMP+4   MODIFY ADDRESS
      STA 1,I 
      JMP PAK61 
PAK7  LDA DFLAG 
      SZA 
      JMP PAK71     SECOND TRACK
      ISZ DFLAG 
      LDA PDISC 
      ADA P200
      LDB PTBUF 
      JSB DISCP,I   OTPUT DIRECTORY 
      LDA PDRL2 
      STA WORDD,I   INPUT 
      LDA PDISC       2ND 
      ADA P400          DIRECTORY 
      LDB PTBFI           TRACK 
      JSB DISCP,I 
      LDB PDRL2 
      JMP PAK5-2
PAK71 LDA PDISC     OUTPUT
      ADA P400        TO
      LDB PTBUF         DISC
      JSB DISCP,I 
      LDA PADLN     RELOAD
      STA WORDD,I     ADT 
      LDA PDLOC 
      LDB PTBFI 
      JSB DISCP,I 
      LDA PADLN 
      CMA,INA 
      ADA PTBUF 
      STA PADEN 
      JMP PAK11 
* 
PAK2  LDB PADRT     END OF ADT? 
      ADB .+2 
      CPB PADEN 
      JMP PAK1      YES 
      STB PADRT T]
      JMP PAK22 
PAK1  LDB PADR      DONE? 
      ADB .+2 
      STB PADR
      CPB PADEN 
      JMP PAK12     YES 
      JMP PAK11     NO - NEXT TRACK 
* qq
PAK12 LDA PADLN     OUTPUT
      STA WORDD,I     ADT 
      LDA PDLOC         TO
      LDB PTBUF           DISC
      JSB DISCP,I IP
* 
      LDA .-3 
      STA WORDD,I IK
      LDA PDISC 
      INA 
      LDB PDLNA 
      JSB DISCP,I   OUTPUT LENGTHS TO DISC
      JMP PINCA,I   RETURN TO MAIN CONTROL
* 
* qq
WORDD DEF WORDC 
DISCP DEF DISCD 
PTBUF DEF TBUFR 
PTBFI DEF TBUFR,I 
PADLN OCT 0 
PDRL1 OCT 0 
PDRL2 OCT 0 ZZ
PDLNA DEF PADLN 
PDLNI DEF PADLN,I I
PDLOC OCT 0 
PADEN OCT 0 
PADR  OCT 0 
PADRT OCT 0 
PDISC OCT 0 
P200  OCT 200 0)
P400  OCT 400 
DFLAG OCT 0 
PM64  DEC -64 
PMB64 OCT -64 
PADDL NOP 
PMVD  DEF MOVED 
PMVS  DEF MOVES 
PMVW  DEF MOVEW 
PMVB  DEF MOVEB @H
PDAD  OCT 0 
FSUBP DEF FSUB
CRA   DEF CERR
GETA  DEF GETCR 
PINCA DEF INCOM 
STAB  DEF 14000B+6144 
PINVL DEF SUBC1 
PINT  DEF INTGR                                 (D) 
PSBCK DEF SUBCK                                 (D) 
EOL   EQU * 
TBUFR BSS 1 
      END 
