JSB CKPNT     ENTRY FOUND ? 
      JMP CKDPN     NO
      LDA CPFPO     GET OPEN TABLE ENTRY ADDR 
      ADA D2        INCREMENT TO PACK NO. OFFSET FIELD
      LDB A,I       GET PACK NO. OFFSET 
      STB PNOFF     SAVE IT 
      ADA MD2       START OF OPEN TABLE ENTRY 
      JSB STPNO     STORE NEW PACK NO. OFFSET 
      LDA PNOFF     GET OLD OFFSET
      JSB MVPNT     UPDATE PACK NO. TABLE 
      CLA,INA       SEARCH FOR EXISTING ENTRY 
      CLB           PN000 
      JSB CKPNT     UPDATE 'PNEAD' FOR PN000
      JSB ER16      BRANCH NEVER OCCURS 
      JMP MOVDA     MOVE DATA 
CKDPN EQU * 
      LDA CPFPO     GET OPEN TABLE ADDR 
      ADA D10       INCREMENT OT PACK NO. FIELD 
      LDB A,I       GET PACK NO.
      STB PNOFF     SAVE PACK NO. 
      CLB           NEW PACK NO. IS 0 
      STB A,I       STORE NEW PACK NO.
      CLA,INA       SEARCH FOR EXISTING ENTRY 
      LDB PNOFF     GET OLD PACK NO.
      JSB CKPNT     CAN OLD PACK NO. ENTRY BE USED FOR PN000? 
      RSS           YES 
      JMP GPNE      NO
      CLA,INA       SEARCH FOR EXISTING ENTRY 
      CLB           PN000 
      JSB CKPNT     UPDATE 'PNEAD' FOR PN000
      JSB ER16      ERROR NEVER OCCURS
      JMP MVPNE     INIT REAL PACK NO. ENTRY
GPNE  EQU * 
      CLA           SEARCH FOR AVAILABLE ENTRY
      JSB CKPNT     ENTRY AVAILABLE ? 
      JMP NENTA     NO
      CLA,INA       SET PACK NO. USED SWITCH
      STA PNESW     STORE SWITCH
MVPNE EQU * 
      LDA MD4       SIZE OF PACK NO. ENTRY(-) 
      STA MOVCT 
      LDA ADPNE     ADDR OF SOURCE(DUMMY PACK NO. ENTRY)
      LDB PNEAD     ADDR OF REAL PACK NO. ENTRY 
      JSB MOVE      MOVE PACK NO. ENTRY 
      JMP MOVDA     GO MOVE DATA
NENTA EQU * 
      LDA CPFPO     GET OPEN TABLE ENTRY ADDR 
      ADA D10       INCREMENT TO PACK NO. FIELD 
      LDB PNOFF     GET OLD PACK NO.
      STB A,I       RESTORE ORIGINAL PACK NO. 
      JSB ER16      NO
SPN00 EQU * 
      JSB GPN00 
      JMP CONTU     CONTINUE
GPN00 NOP 
      CLA,INA       SEARCH FOR EXISTING ENTRY 
      CLB           PN000 
      JSB CKPNT     ENTRY FOR PN000 EXIST ? 
      RSS           NO
      JMP SUWAP     YES 
      LDA ADPNE     GET ADDR OF DUMMY PACK NO. ENTRY
      STA PNEAD     USE DUMMY ENTRY 
      LDA SYSSC     GET SYSTEM SUBCHANNEL 
      STA PAKSC     STORE SUBCHANNEL
      JSB SETD2     SET UP FOR DOS-M SEARCH 
      LDB APN00     GET ADDR OF NAME
      JSB SRCD1     PN000 EXIST ? 
      JMP CPN00     NO
      ADB D3        INCREMENT TO STARTING T/S FIELD 
      LDA B,I       GET STARTING T/S
      STB SVAEN     SAVE DIREC ENTRY ADDR 
      LDB PNEAD     GET PACK NO. ENTRY ADDR 
      STA B,I       STORE STARTING T/S IN PACK NO. ENTRY
      STA STSWA     STORE STARTING T/S
      LDB SVAEN     RESTORE DIREC ENTRY ADDR
      INB           INCREMENT TO FILE SIZE FIELD
      LDA B,I       GET FILE SIZE 
      LDB PNEAD     GET PACK NO. ENTRY ADDR 
      INB           INCREMENT TO FILE SIZE FIELD
      STA B,I       STORE FILE SIZE 
      LDA SECTR     GET DIRECTORY SIZE
      ADA MD1 
      INB           INCREMENT TO DIREC SIZE FIELD 
      STA B,I       STORE DIRECTORY SIZE
      CLA           LSA 
      INB           INCREMENT TO LSA FIELD
      STA B,I       STORE LSA IN PACK NO. ENTRY 
      CLA           SET NO. SECT. USED TO 0 
      STA NSUWA 
      JMP SUWAP 
CPN00 EQU * 
      JSB CRPN0     CREATE PN00 
SUWAP EQU * 
      JSB CLWAP     CALC. WORK AREA PARAMETERS
      JMP GPN00,I   RETURN
CONTU EQU * 
      LDA NSUWA     NO. SECT. USED IN W/A 
      CMA,INA 
      ADA FLNGH     CALC. NO. AVAILABLE SECT. 
      CMA 
      ADA CPNSF     NO. SECT. IN FILE 
      SSA,RSS       W/A .GE. FILE SIZE? 
      JSB ER17      NO
      JMP CKPN0     GO CHECK FOR A PACK NO. ENTRY 
MOVDA EQU * 
      LDA SYSSC     SYST. SUB CH. 
      STA CPDSC     DESIRED SUB CH. 
      JSB CPMOV     MOVE SECTORS
      LDA CPFPO     GET OPEN TABLE ENTRY ADDR 
      JSB STPNO     STORE NEW PACK NO. OFFSET 
      LDB CPFPO     FILE POSITION IN O.T. 
      ADB D3
      LDA BWATS     BEGINNING WORK AREA "T/S" 
      JSB STT.S     CONV. TO T/S
      STA B,I       NEW T/S 
      ADB D6
      CLA 
      STA B,I       CLEAR DIRECTORY ENTRY T/S FIELD 
      INB 
      STA B,I       NEW PACK NO.
      ADB D3
      STA B,I       FORCE CUR. T/S TO ZERO
      ADB MD1 
      LDA SYSSC     SYST. SUB CH. 
      STA B,I       NEW SUB CH. 
      LDA NSUWA     NO. SECT. USED IN W/A 
      ADA CPNSF     NO. SECT. IN FILE 
      STA NSUWA     UPDATE NEW NO.
      LDB PNEAD     GET PACK NO. ENTRY ADDR 
      ADB D3        INCREMENT TO LSA FIELD
      STA B,I       STORE NEW LSA 
      LDA PNESW     GET PACK NO. ENTRY USED SWITCH
      SZA,RSS       NEW ENTRY USED ?
      JMP EFCON     NO
      LDA NXPTL     UPDATE ADDR OF NEXT PACK NO. ENTRY
      ADA D4
      STA NXPTL 
      JMP EFCON     RETURN TO MAIN
      SPC 1 
GOCPY EQU *         COPY PACK TO PACK 
      LDA PAKSC     GET SOURCE FILE SUBCHANNEL
      STA CPCSC     SET UP SUBCHANNEL FOR COPY
      LDA CPCTS+1   GET DISC ADR. OF SOURCE 
      STA CPCTS     SET UP DISC ADR FOR COPY
      LDA CPNSF     NO. OF SECT. IN THIS FILE 
      STA NOSTM     NO. OF SECT. TO MOVE
      JSB CPMOV     MOVE
      JMP EFCON     RETURN TO MAIN
      SPC 1 
CPYT  EQU *         COPY TERMINATE
      LDA DPNO      DESIRED PACK NO.
      JSB GETPN     GET SPECIAL PACK NO.
      JSB ER22
      ADB D3        INCREMENT TO STARTING T/S FIELD 
      LDA B,I       GET STARTING T/S
      STA DPNE      STORE STARTING T/S
      LDA ADPNE     GET ADDR OF DUMMY PACK NO. ENTRY
      STA PNEAD     STORE ADDR
      JSB SETD1     SET UP FOR EFMP DIR 
      LDB CPFPO     ADDR. OF FILE NAME
      JSB SRCD1     SEARCH DIRECTORY
      JSB ER22
      ADB D8
      CLA 
      STA B,I       "HRA" ON DISC 
      CLA,INA       WRITE 
      LDB PAKSC     SUBCHANNEL
      JSB PRWIO     UPDATE DIRECTORY ENTRY
      JSB ER22
      SKP 
CPMOV NOP           COPY MOVE 
      LDA NOTRB     NO. OF TRB'S
      LDB TRBSZ 
      JSB MPY 
      STA MTRBS     MAX. TRB SIZE 
CPYMR EQU *         COPY MORE 
      CLB 
      STB NOSTM+1   INITIALIZE NO. SECT. MOVED THIS TIME
      CMA,INA 
      ADA NOSTM     NO. SECT LEFT TO MOVE 
      LDB NOSTM 
      STA NOSTM     UPDATE NO. LEFT TO MOVE 
      SSA,RSS 
      LDB MTRBS     GET SMALLER OF TWO
      SZB,RSS       FINISHED? 
      JMP CPMOV,I   YES 
      STB GNS       NO. SECT. TO XFER 
      LDA CPCSC     CURRENT SUB CH. 
      STA GSC 
      LDA CPCTS     CURRENT T/S 
      JSB STT.S     CONV. TO T/S
      LDB TRBUF     START OF I/O AREA 
      JSB GRTXX     READ SECTORS
      LDA CPDSC     DESIRED DISC
      STA GSC 
      LDA CPNXS     NEXT "T/S"
      JSB STT.S     CONV. TO T/S
      LDB TRBUF     START OF I/O AREA 
      JSB GWTXX     WRITE DESIRED SECTORS 
      LDA CPCTS     CURRENT T/S 
      ADA GNS       NO. SECT. MOVED 
      STA CPCTS     UPDATE CURRENT T/S
      LDA CPNXS     NEXT "T/S"
      ADA GNS       NO. SECT. MOVED 
      STA CPNXS     UPDATE NEXT "T/S" 
      LDA NOSTM+1   NO. OF SECT. MOVED THIS TIME
      ADA GNS       NO. SECT. MOVED 
      STA NOSTM+1 
      LDA MTRBS     MAX. TRB SECTORS
      LDB NOSTM     NO. SECT. LEFT TO MOVE
      SSB,RSS       FINISHED? 
      JMP CPYMR+2   NO, COPY MORE 
      JMP CPMOV,I   RETURN
      SPC 3 
* CALFS - CALCULATE FILE SIZE (IN SECTORS)
* ENTER:
*         B = STARTING ADDR. OF FILE
* EXIT: 
*         A = FILE SIZE (IN SECTORS)
* 
CALFS NOP           CALC. FILE SIZE 
      ADB D4
      LDA B,I       FILE LENGTH (IN RECORDS)
      INB 
      LDB B,I       RECORD LENGTH (IN WORDS)
      JSB MPY 
      JSB DIV 
      DEF D128
      SOC           OVERFLOW? 
      JSB ER23      YES, ERROR SHOULD NOT OCCUR 
      SZB           OVERFLOW? 
      INA           YES, ADD 1 FULL SECTOR
      JMP CALFS,I   RETURN
      SPC 1 
CLSTM NOP           CAL. NO. SECT. TO MOVE
      LDA NOTRB     NO. OF TRB'S
      LDB TRBSZ 
      JSB MPY 
      STA MTRBS     MAX. TRB SECTORS
      LDA NSUWA     NO. SECT. USED IN W/A 
      CMA,INA 
      ADA FLNGH     DOS-M FILE LENGTH (OF W/A 
      STA B 
      CMA 
      ADA MTRBS     CALC. LENGTH OF WORK AREA LEFT
      SSA,RSS       FILE LENGTH .LT. MAX. SECTORS.
      STB MTRBS     SAVE SMALLEST NO. SECT. TO WRITE
      LDA B         WORK AREA LEFT
      CMA 
      ADA CPNSF     NO. OF SECT. IN FILE TO COPY
      SSA,RSS       W/A .GE. FILE LENGTH
      STB NOSTM     NO. OF SECT. TO MOVE AT 1 TIME
      STA CPALF     COPY-ALL FLAG 
* CPALF = (-), ALL RECORDS COPIED 
*       = (+), NO. OF RECORDS YET TO COPIED-1 
      LDA SYSSC     SYST. SUB CH
      STA CPDSC     PACK DESIRED SUB CH.
      JMP CLSTM,I   RETURN
      SPC 3 
CLWAP NOP           CALC. WORK AREA PARAMETERS
      LDB PNEAD     GET PACK NO. ENTRY ADDR 
      LDA B,I       GET STARTING T/S
      JSB T.STS     CONV. TO SECT.
      ADA NSUWA     NO. SECT. USED IN W/A 
      STA CPNXS     STARTING "T/S" IN W/A 
      STA BWATS     BEGINNING FREE W/A "T/S"
      INB 
      LDA B,I       FILE LENGTH(IN SECTORS) 
      STA FLNGH 
      LDB CPFPO     FILE POSITION IN W/A
      JSB CALFS     CALC. FILE SIZE (IN SECT.)
      STA CPNSF     SAVE NO. SECT. IN FILE
      STA NOSTM     NO. SECT. TO MOVE 
      JMP CLWAP,I   RETURN
      SPC 1 
GETDP NOP           GET DESTINATION PACK
      LDA DPNO      DESIRED PACK NO.
      JSB GETPN     GET PACK NO.
      JMP *+3       PACK NOT AVAILABLE
      ISZ GETDP     P+2, PACK AVAILABLE 
      JMP GETDP,I   RETURN
      JSB $SYIO 
      DEC 2         WRITE 
      OCT 1         L.U.
      DEF MS1       INSERT DESTINATION PACK 
      ABS LM1 
      DEF *+2 
      JMP $WAIT 
      HLT 76B 
      JSB RCORT     READ C OR T 
      JMP GETDP,I   P+1, TERMINATE
      JMP GETDP+1   CONTINUE
      SPC 1 
GETSP NOP           GET SOURCE PACK 
      LDA CPCPN 
      JSB GETPN     GET PACK NO.
      JMP *+3       PACK NOT AVAILABLE
      ISZ GETSP     P+2, PACK AVAILABLE 
      JMP GETSP,I   RETURN
      JSB $SYIO 
      DEC 2         WRITE 
      OCT 1         L.U.
      DEF MS2       INSERT SOURCE PACK
      ABS LM2       NO. WORDS 
      DEF *+2 
      JMP $WAIT 
      HLT 76B 
      JSB RCORT     READ C OR T 
      JMP GETSP,I   P+1, TERMINATE
      JMP GETSP+1   CONTINUE
      SPC 1 
RCORT NOP           READ C OR T 
      JSB $SYIO 
      DEC 2         WRITE 
      OCT 1         L.U.
      DEF MS3       ENTER C OR T
      ABS LM3 
      DEF *+2 
      JMP $WAIT 
      JSB $SYIO 
      DEC 1         READ
      OCT 401 
      DEF MS4 
      ABS LM4 
      DEF *+2 
      JMP $WAIT 
      LDA MS4       C OR T
      AND H8BT
      CPA T 
      JMP RCORT,I   P+1, TERMINATE
      CPA C 
      RSS 
      JMP RCORT+1   INVALID, REPEAT 
      ISZ RCORT     P+2 
      JMP RCORT,I   CONTINUE
C     OCT 041400
T     OCT 052000
MS1   ASC 19,INSERT DESTINATION PACK AND PRESS RUN. 
LM1   EQU *-MS1 
MS2   ASC 17,INSERT SOURCE PACK AND PRESS RUN.
LM2   EQU *-MS2 
MS3   ASC  7,ENTER C OR T.
LM3   EQU *-MS3 
MS4   OCT 0 
LM4   EQU *-MS4 
CPCSC OCT 0         CURRENT SUB CH. 
CPCTS OCT 0,0       CURRENT "T/S" (IN SECTORS)
CPDSC OCT 0         DESIRED SUB CH. 
CPNXS OCT 0,0       NEXT FILE SECT. 
MTRBS OCT 0         MAX. TRB SECTORS
NOSTM OCT 0,0       NO. SECT. LEFT TO MOVE
      SPC 1 
BWATS OCT 0         BEGINNING FREE W/A "T/S"
CPALF OCT 0         COPY-ALL FLAG,(-)FIN,(+)SEC.LF-1
CPCPN OCT 0         CURRENT PACK NO.
CPFPO OCT 0         COPY-FILE POSITION IN O.T.
CPNSF OCT 0,0       NO. OF SECT. IN THIS FILE 
SCODE OCT 0         SECURITY CODE 
PNOFF OCT 0         PACK NO. OFFSET 
PNSAV BSS 1         PACK NO. ENTRY ADDR 
PNESW BSS 1         PACK NO. ENTRY USED SWITCH
      HED MISCEL. 
MOVE  NOP 
      JSB MASUB 
      DEC 1 
POST  NOP 
      JSB MASUB 
      DEC 2 
CKVSU NOP 
      JSB MASUB 
      DEC 4 
NAM0? NOP 
      JSB MASUB 
      DEC 5 
CRPN0 NOP 
      JSB MASUB 
      DEC 6 
CKPN  NOP 
      JSB MASUB 
      DEC 7 
SVPNS NOP 
      JSB MASUB 
      DEC 8 
SETD1 NOP 
      JSB MASUB 
      DEC 10
SETD2 NOP 
      JSB MASUB 
      DEC 11
REPNS NOP 
      JSB MASUB 
      DEC 13
MVPNT NOP 
      JSB MASUB 
      DEC 16
GETPN NOP 
      JSB MASUB 
      DEC 17
CKOPN NOP 
      JSB MASUB 
      DEC 18
SRCD1 NOP 
      JSB MASUB 
      DEC 19
GTNPN NOP 
      JSB MASUB 
      DEC 20
CKDSP NOP 
      JSB MASUB 
      DEC 21
CMPAR NOP 
      JSB MASUB 
      DEC 23
CKPNT NOP 
      JSB MASUB 
      DEC 24
T.STS NOP 
      JSB MASUB 
      DEC 26
STT.S NOP 
      JSB MASUB 
      DEC 27
GRTXX NOP 
      JSB MASUB 
      DEC 29
GWTXX NOP 
      JSB MASUB 
      DEC 30
CKSPC NOP 
      JSB MASUB 
      DEC 31
STPNO NOP 
      JSB MASUB 
      DEC 32
PRETS NOP 
      JSB MASUB 
      DEC 34
PRWIO NOP 
      JSB MASUB 
      DEC 35
MPY   NOP 
      JSB MASUB 
      DEC 36
DIV   NOP 
      JSB MASUB 
      DEC 37
      SKP 
ER2   EQU * 
      OCT 0 
      LDA D2
      JSB ERR 
ER3   EQU * 
      OCT 0 
      LDA D3
      JSB ERR 
ER4   EQU * 
      OCT 0 
      LDA D4
      JSB ERR 
ER6   EQU * 
      OCT 0 
      LDA D6
      JSB ERR 
ER11  EQU * 
      OCT 0 
      LDA D11 
      JSB ERR 
ER15  EQU * 
      OCT 0 
      LDA D15 
      JSB ERR 
ER16  EQU * 
      OCT 0 
      LDA D16 
      JSB ERR 
ER17  EQU * 
      OCT 0 
      LDA D17 
      JSB ERR 
ER22  EQU * 
      OCT 0 
      LDA D22 
      JSB ERR 
ER23  EQU * 
      OCT 0 
      LDA D23 
      JSB ERR 
ER24  EQU * 
      OCT 0 
      LDA D24 
      JSB ERR 
ERR   NOP 
      LDB ERR 
      ADB MD3 
      LDB B,I       PICK UP LOC OF ERROR
      JMP ERROR 
      HED CONSTANTS AND VARIABLES 
A     EQU 0 
B     EQU 1 
.     EQU 53B 
L8BT  EQU 74B 
H8BT  EQU 75B 
SECTR EQU 116B
SYSSC EQU 155B
MD10  EQU .-10
MD9   EQU .-9 
MD8   EQU .-8 
MD7   EQU .-7 
MD4   EQU .-4 
MD3   EQU .-3 
MD2   EQU .-2 
MD1   EQU .-1 
D1    EQU .+1 
D2    EQU .+2 
D3    EQU .+3 
D4    EQU .+4 
D6    EQU .+6 
D7    EQU .+7 
D8    EQU .+8 
D10   EQU .+10
D11   DEC 11
D12   DEC 12
D15   DEC 15
D16  DEC 16 
D17   DEC 17
D22   DEC 22
D23   DEC 23
D24   DEC 24
D128  DEC 128 
D999  DEC 999 
MXWPE DEC 9 
AARG1 DEF ARG1
ARG1  OCT 0 
ARG2  OCT 0 
ARG3  OCT 0 
ARG4  OCT 0 
ARG5  OCT 0 
ARG6  OCT 0 
ARG7  OCT 0 
ARG8  OCT 0 
      END