ASMB,R,B,L,C,X     $EX33                        7905                            
      HED EFMP EXEC MODULE
      NAM $EX33,1,0                             7905                            
      ENT $EX33 
      EXT $SYIO,$WAIT 
      EXT ERROR, EFCON
      EXT A$BUF,SECIO,TRKIO,NOPAS,EBIAS,SRCDR 
      EXT AINVC,FLNGH,NOTRB,NSUWA,NXTFP,MOVCT 
      EXT STSWA,TRBUF,TRBSZ,ARQP1,APN00,DPNO
      EXT PAKSC,NOSEC,PNEAD,OPNTB,GSC,GNS 
      EXT NXPTL,GSC,GNS 
      EXT MASUB 
****************************************************            7905            
*                                                  *            7905            
*        REV         4-21-75                       *            7905            
*                                                  *            7905            
****************************************************            7905            
      SPC 3 
$EX33 EQU * 
      NOP           DUMMY 
      LDB  MD8      NO. OF ARGS. TO MOVE
      STB  MOVCT
      LDA  ARQP1    ADDR. OF SOURCE 
      LDB  AARG1    ADDR. OF DESTINATION
      JSB  MOVE     MOVE ARGS.
      LDA  ARG2,I   FUNCTION NO.
      CPA  D11
      JMP  FUN11
      CPA  D12
      JMP  FUN12
      JMP  EFCON
      HED REPACK FUNCTION 
* 
*         REPACK FUNCTION 
* 
FUN11 EQU * 
      JSB CKVSU     CHECK FOR VALID SETUP 
      LDA ARG3,I    PAKNO 
      JSB CKPN      CHECK PACK NO.
      SZA,RSS 
      JSB ER15
      JSB GETPN     PACK NO. AVAILABLE ?
      JSB ER6       NO
      LDA ADPNE     ADDR OF DUMMY PACK NO. ENTRY
      STA PNEAD     STORE ADDR
SVNXT EQU * 
      STB SVAEN     SAVE ADDR OF ENTRY
      JSB SVPNS     SAVE SEARCH ENVIRONMENT 
      LDB SVAEN     RESTORE ADDR OF ENTRY 
      ADB D3        INCREMENT TO STARTING T/S FIELD 
      LDA B,I       GET STARTING T/S
      LDB PNEAD     GET ADDR OF PACK NO. ENTRY
      STA B,I       STORE STARTING T/S IN PACK NO. ENTRY
      JMP REPAK     GO REPACK 
RPNXT EQU * 
      LDA ARG3,I    GET PACK NO.
      SSA,RSS       TRY ALL PACKS ? 
      JMP EFCON     NO, RETURN
      JSB REPNS     RESTORE SEARCH ENVIRONMENT
      JSB GTNPN     PACK NO. AVAILABLE ?
      JMP EFCON     NO, RETURN
      JMP SVNXT     YES 
REPAK EQU *         REPACK THIS PACK
      JSB POST      POST ALL TRB'S
      JSB SETD1     SET UP FOR EFMP DIR.
      LDB AINVC     ADDR. OF INVALID CHAR. NAME 
      JSB SRCD1     SEARCH DIRECTORY
      JMP RPNXT     REPACK NEXT PACK
      ADB D3
      LDA PNEAD     GET ADDR OF PACK NO. ENTRY
      LDA A,I       GET STARTING T/S
      JSB T.STS     CALCULATE T/S OF 1ST DESTROYED DATA 
      ADA B,I 
      ADA MD1 
      JSB STT.S 
      STA RPNTS     REPACK NEXT T/S 
FNXVF EQU *         FIND NEXT VALID FILE
      JSB GTSDE     GET A SINGLE DIRECTORY ENTRY
      JMP UDNAT     NO MORE IN DIR. 
      STB RPFPO     REPACK-FILE POSITION
      LDA AINVC     ADDR OF INVALID CHAR
      JSB CMPAR     THIS FILE INVALID?
      RSS           NO
      JMP FNXVF     YES 
      LDB RPFPO     FILE POSITION 
      JSB CALFS     CALC. FILE SIZE 
      STA NOSTM     NO. OF SECT. TO MOVE
      LDA PAKSC     GET SUBCHANNEL
      STA CPCSC     COPY CURRENT SUB CH.
      STA CPDSC     COPY DESIRED SUB CH.
      LDA RPNTS     NEXT T/S FOR DATA 
      JSB T.STS     CONV TO SECT
      STA CPNXS     COPY NEXT "T/S" 
      LDB PNEAD     ADDR OF PACK NO. ENTRY
      LDA B,I       GET STATING T/S 
      LDB RPFPO     FILE POSITION 
      ADB D3
      JSB T.STS     CONV. TO SECT.
      STA STSEC     SAVE STARTING SECTOR
      ADA B,I       SECTOR OF DATA TO BE MOVED
      ADA MD1 
      STA CPCTS     COPY CURRENT "T/S"
      LDA STSEC     GET STARTING SECTOR 
      CMA,INA       CALCULATE NEW STARTING REL SECTOR 
      ADA CPNXS 
      ADA D1
      STA B,I       UPDATE DIRECTORY ENTRY
      JSB CPMOV     COPY-MOVE DATA
      CLA,INA       WRITE 
      LDB PAKSC     SUBCHANNEL
      JSB PRWIO     UPDATE DIRECTORY ENTRY
      LDB RPFPO     ADDR. OF THIS FILE NAME 
      JSB CKOPN     CHECK IF OPEN 
      JMP RPMVE     NOT OPEN
      ADB D12 
      LDA B,I       SUB CH. IN O.T. 
      CPA PAKSC     SAME AS FILE BEING MOVED ?
      RSS           YES 
      JMP RPMVE 
      ADB MD2       BACK UP TO PACK NO. FIELD 
      LDA DPNO      GET PACK NO.
      CPA B,I       SAME PACK NO. ? 
      RSS           YES 
      JMP RPMVE     NO
      ADB MD7 
      LDA RPNTS     NEW T/S FOR THIS FILE 
      STA B,I       UPDATE NEW T/S
RPMVE EQU * 
      LDA RPNTS     NEXT DATA T/S 
      JSB T.STS     CONV. TO SECT.
      ADA NOSTM+1   NO. OF SECT. MOVED
      JSB STT.S     CONV. BACK TO T/S 
      STA RPNTS     UPDATE NEXT DATA T/S
      JMP FNXVF     FIND NEXT VALID FILE
      SPC 1 
UDNAT EQU *         UPDATE NEXT AVAIL. T/S
      LDA PNEAD     ADDR OF PACK NO. ENTRY
      LDA A,I       GET STARTING T/S
      JSB PRETS     PREPARE T/S FOR I/O 
      CLA           READ
      LDB PAKSC     SUBCHANNEL
      JSB PRWIO     READ 1ST SECTOR 
      LDA RPNTS     CALCULATE LAST USED SECTOR
      JSB T.STS 
      STA RPNTS 
      LDA PNEAD     CALCULATE STARTING SECTOR 
      LDA A,I 
      JSB T.STS 
      CMA,INA 
      ADA RPNTS     CALCULATE NEW RELATIVE ENDING SECTOR
      LDB A$BUF 
      ADB D8
      STA B,I       UPDATE LAST SECTOR ALLOCATED FIELD IN CORE
      CLA,INA       WRITE 
      LDB PAKSC     SUBCHANNEL
      JSB PRWIO     UPDATE DISC DIRECTORY LSA 
* REPACK DIRECTORY. DATA HAS BEEN REPACKED
      JSB  SETD1    SET UP FOR EFMP DIR 
      LDB AINVC     ADDR. OF INVALID CHAR.
      JSB SRCD1     SEARCH DIRECTORY
      JSB ER23      JUMP SHOULD NEVER OCCUR 
      LDA SECIO     INITIALIZE TRACK AND SECTOR FOR REPACKED DIRECTORY
      STA NXSEC 
      LDA TRKIO 
      STA NXTRK 
      ALF,ALF 
      XOR SECIO 
      STA NXSID     NEXT SECT. TO BE USED IN DIR. 
      CMB,INB 
      ADB A$BUF     CALC. BIAS IN $BUF
      CMB,INB 
      ADB TRBUF     BIAS 2ND DIR. TO BE USED
      STB NXLID     NEXT LOC. TO BE USED IN DIR.
      CLB,INB 
      STB GNS       NO. SECT. TO READ 
      LDB PAKSC     SUBCHANNEL
      STB GSC 
      LDB TRBUF     ADDR OF TRB 
      JSB GRTXX     READ SAME SECT. AS $BUF TO TRB
      LDB TRBUF 
      ADB D128
      STB E2BP1     END OF 2ND. BUF. PLUS 1 
GNXVF EQU * 
      JSB GTSDE     GET NEXT DIR. ENTRY 
      JMP RPEOD     REPACK EOD
      STB RPFPO     SAVE FILE POSITION IN $BUF
      LDA AINVC     ADDR. OF INVALID CHAR.
      JSB CMPAR     THIS FILE DISTROYED?
      RSS           NO
      JMP GNXVF     YES 
      LDA NXLID     NEXT LOC. IN DIR. (IN TRBUF)
      ADA MXWPE     MAX. WDS./ENTRY 
      CMA,INA 
      ADA E2BP1     END OF TRBUF+1
      SSA,RSS       .LE.(ROOM FOR THIS ENTRY)?
      JMP RPDOK     YES 
      CCA 
      STA NXLID,I   PACK EOS FLAG 
      JSB WTRBD     WRITE DIR. IN TRBUF 
RPDOK EQU *         REPACKED DIR. OK SO FAR 
      LDA MXWPE     MAX. WDS./ENTRY 
      CMA,INA 
      STA MOVCT     NO. WDS. TO MOVE
      LDA RPFPO     FILE POSITION IN $BUF (SOURCE)
      LDB NXLID     FILE POSITION IN TRBUF (DEST.)
      JSB MOVE      MOVE DIR. ENTRY 
      STB NXLID     UPDATE NEXT LOC. IN TRBUF 
      LDA TRKIO     GET TRACK OF CURRENT ENTRY
      ALF,ALF 
      XOR SECIO     GET SECTOR OF CURRENT ENTRY 
      CPA NXSID     CURRENT ENTRY SAME AS NEW ENTRY 
      JMP GNXVF     YES 
      LDB NXLID     GET ADDR OF FILE NAME 
      ADB MD9 
      JSB CKOPN     IS FILE OPEN ?
      JMP GNXVF     NO
      ADB D12       INCREMENT TO SUBCHANNEL FIELD 
      LDA B,I       GET SUBCHANNEL
      CPA PAKSC     SAME SUBCHANNEL AS FILE BEING REPACKED ?
      RSS           YES 
      JMP GNXVF     NO
      ADB MD2       BACK UP TO PACK NO. FIELD 
      LDA DPNO      GET PACK NO.
      CPA B,I       SAME PACK NO. ? 
      RSS           YES 
      JMP GNXVF     NO
      ADB MD1       BACK UP TO DIRECTORY ENTRY T/S FIELD
      LDA NXSID     GET NEW DIRECTORY ENTRY T/S 
      STA B,I       STORE NEW DIRECTORY ENTRY T/S IN OPEN TABLE 
      JMP GNXVF     GET NEXT VALID FILE 
      SPC 1 
RPEOD EQU *         REPACK EOD FLAG 
      LDA TRBUF     EOD FLAG AT WORD ONE OF     7905                            
      CPA NXLID       OF A SECTOR               7905                            
      RSS           YES                         7905                            
      JMP RPNO.     NO                          7905                            
      STB TEMP      SAVE THE B-REG              7905                            
      LDA NXSID     READ PREVIOUS SECTOR        7905                            
      ADA MD1                                   7905                            
      STA NXSID                                 7905                            
      LDB TRBUF     GET BUFFR ADDR              7905                            
      JSB GRTXX     READ SECTOR                 7905                            
      LDA E2BP1     CALCULATE END OF DIRECTORY  7905                            
      ADA MD2         FOR THIS SECTOR           7905                            
      STA NXLID     RESET POINTER               7905                            
      LDB TEMP      RESET B-REG                 7905                            
RPNO. EQU *                                     7905                            
      CLA 
      STA NXLID,I   PACK EOD FLAG 
      JSB WTRBD     WRITE DIR. FROM TRBUF 
      JMP RPNXT     REPACK NEXT PACK
TEMP  NOP                                       7905                            
      SPC 1 
WTRBD NOP           WRITE DIR. CONTAINED IN TRBUF 
      CLB,INB 
      STB GNS       NO. SECT. TO WRITE
      LDB PAKSC     SUBCHANNEL
      STB GSC 
      LDB TRBUF     ADDR. OF TRB
      LDA NXSID     SECT. IN TRB
      JSB GWTXX     GENERAL WRITE 
      LDA NXSEC     GET SECTOR
      INA           INCREMENT TO NEXT SECTOR
      STA NXSEC     STORE NEW SECTOR
      CMA,INA 
      ADA SECTR 
      SZA           END OF TRACK ?
      JMP GNTSD     NO
      STA NXSEC     YES, SECTOR 0 
      LDA NXTRK     GET CURRENT TRACK 
      INA           INCREMENT TO NEXT TRACK 
      STA NXTRK     STORE NEW TRACK 
GNTSD EQU * 
      LDA NXTRK     UPDATE NXSID FIELD
      ALF,ALF 
      XOR NXSEC 
      STA NXSID 
      LDA TRBUF 
      STA NXLID     REINTIALIZE NEXT LOC. IN TRBUF
      JMP WTRBD,I   RETURN
      SPC 1 
GTSDE NOP 
      LDA AGSDR     GET RETURN ADDR 
      STA SRCDR     STORE RETURN ADDR 
      CCA           NO COMPARE SWITCH 
      STA NOPAS     STORE SWITCH
      JMP EBIAS     GET NEXT DIRECTORY ENTRY
GTSDR EQU * 
      JMP GTSDE,I   END OF DIRECTORY
      ISZ GTSDE     P+2 
      JMP GTSDE,I   RETURN P+2
AGSDR DEF GTSDR 
      SPC 1 
NXSID OCT 0         NEXT SECT.(IN TRBUF)
NXLID OCT 0         NEXT AVAIL. LOC. IN TRBUF 
E2BP1 OCT 0         START OF 2ND SECT. IN TRBUF 
SVAEN BSS 1         SAVE FOR ENTRY ADDR 
ADPNE DEF DPNE      ADDR OF DUMMY PACK NO. ENTRY
DPNE  BSS 4         DUMMY PACK NO. ENTRY
STSEC BSS 1         STARTING SECTOR 
NXSEC BSS 1         NEW SECTOR FOR REPACKED DIRECTORY ENTRY 
NXTRK BSS 1         NEW TRACK FOR REPACKED DIRECTORY ENTRY
RPFPO OCT 0         FILE POSITION 
RPNTS OCT 0         REPACKED NEW T/S
      HED COPY FUNCTION 
* 
*         COPY FUNCTION 
* 
FUN12 EQU * 
      JSB CKVSU     CHECK IF VALID SETUP
      JSB POST      POST ALL TRB'S
      LDA ARG3      POINTER TO FILE NAME
      JSB NAM0?     NAME =0?
      LDB ARG3      POINTER TO FILE NAME
      JSB CKOPN     CHECK IF FILE OPEN
      JSB ER11      FILE NOT OPEN 
      STB CPFPO     COPY-FILE POSITION
      ADB D3
      LDA B,I       T/S OF DATA 
      JSB T.STS     CONV TO SECT. 
      STA CPCTS     CURRENT DATA "T/S"
      STA CPCTS+1 
      ADB D7
      LDA B,I       CURRENT P.N.
      STA CPCPN 
      ADB D2
      LDA B,I       SUB CH. 
      STA CPCSC     CURRENT SUB CH. 
      CLA 
      CPA CPCPN     PN000 ? 
      JMP NSCOD     NO SECURITY CODE
      ADB MD10
      LDA B,I       GET OFFSET
      AND L8BT      CLEAR LEFT BYTE 
      LDB D4
      JSB MPY 
      ADA OPNTB     CALCUALTE ADDR
      STA PNEAD     STORE ADDR
      LDA CPFPO     SET UP SUB CHAN FOR BFMP FILE SEARCH
      ADA D12 
      LDA A,I 
      STA PAKSC 
      JSB SETD1     SET UP FOR EFMP DIR.
      JSB SRCD1     SEARCH DIRECTORY
      JSB ER3       FILE NOT IN DIR.
      ADB D6
      LDA B,I       SECURITY CODE 
      RSS 
NSCOD EQU * 
      CLA 
      STA SCODE     SAVE IT FOR LATER COPY
      LDA ARG4,I    PACK NO.
      SSA,RSS 
      CMA,INA 
      ADA D999
      SSA           TOO BIG?
      JSB ER15      YES 
      LDA ARG4,I    PACK NO.
      SSA 
      CMA,INA 
      STA DPNO      STORE PACK NO 
      LDA ARG4,I    PACK NO.
      SZA,RSS 
      JMP CPTOS     COPY FROM PACK TO SYST. 
      SSA 
      JMP CPSTD     COPY SYST. TO PACK
* COPY PACK TO PACK 
* COPY TO SYST. PACK FIRST
      JSB GETPN     GET SPECIAL PACK NO.
      RSS           DESIRED DEST. PACK NOT AVAIL. 
      JMP DPAVL     DESIRED DESTINATION PACK AVAIL. 
      JSB GPN00 
      JSB CLSTM     CALC. NO. SECTORS TO MOVE 
      LDA AGETD     GET RETURN ADDR 
      STA CPMOV     PACK RETURN ADDR
      LDA MTRBS     MAX. SECT. TO MOVE/READ-WRITE 
      JMP CPYMR     COPY MORE SECTORS 
AGETD DEF GETD
* COPY SYST. PACK TO DEST. PACK 
GETD  JSB GETDP     GET DESTINATION PACK
      JSB ER22
* CREATE FILE ON DEST. PACK 
DPAVL EQU *         DEST. PACK AVAILABLE
      LDA PAKSC     GET SUBCHANNEL
      STA CPDSC     SAVE SUBCHANNEL 
      ADB D3        INCREMENT TO STARTING T/S FIELD 
      LDA ADPNE     ADDR OF DUMMY PACK NO. ENTRY
      STA PNEAD     STORE ADDR
      LDB B,I       GET STARTING T/S
      STB A,I       STORE STARTING T/S IN PACK NO. ENTRY
      JSB SETD1     SET UP FOR EFMP FILES 
      LDB CPFPO     FILE POSITION 
      JSB SRCD1     SEARCH DIRECTORY
      RSS           NO DUPLICATES 
      JSB ER2       DUPLICATE FILE NAME 
      STB NXTFP     SAVE NEXT FILE LOC. 
      LDB CPFPO     OPEN-FILE POSITION
      JSB CALFS     CALC. FILE SIZE(IN SECTORS) 
      STA NOSEC     SAVE SECTORS REQUIRED 
      STA CPNSF     SAVE SECTORS REQUIRED 
      JSB CKSPC     SPACE AVAILABLE ? 
      JSB ER4       NO
      LDB CPFPO     SET UP SECURITY CODE IN OPEN TABLE
      ADB D6
      LDA SCODE 
      STA B,I 
      LDA MXWPE     SIZE OF ENTRY TO CREATE 
      LDB CPFPO     ADDR OF ENTRY TO COPY 
      JSB CKDSP     DIRECTORY ENTRY CREATED ? 
      RSS           NO
      JMP CLRSC     YES 
      LDB CPFPO     CLEAR SECURITY CODE IN OPEN TABLE 
      ADB D6
      STB CPFPO 
      CLB 
      STB CPFPO,I 
      STB SCODE     CLEAR SECURITY CODE 
      SZA           NO FILE SPACE ? 
      JSB ER24      NO
      JSB ER4       YES 
CLRSC EQU * 
      LDB PNEAD     GET ADDR OF DUMMY PACK NO. ENTRY
      STB PNSAV     SAVE ADDR 
      CLA,INA       SEARCH FOR EXISTING ENTRY 
      LDB DPNO      GET PACK NO.
      JSB CKPNT     IS PACK NO. ACTIVE ?
      JMP NOCPN     NO
      LDA PNEAD     GET ADDR OF ACTIVE ENTRY
      ADA D3        INCREMENT TO LSA FIELD
      LDB PNSAV     GET ADDR OF DUMMY ENTRY 
      ADB D3        INCREMENT TO LSA FIELD
      LDB B,I       GET UPDATED LSA 
      STB A,I       UPDATE ACTIVE ENTRY WITH NEW LSA
NOCPN EQU * 
      LDB PNSAV     GET ADDR OF DUMMY ENTRY 
      STB PNEAD     RESTORE ADDR
      LDB CPFPO     CLEAR SECURITY CODE IN OPEN TABLE 
      ADB D6
      CLA 
      STA B,I 
      STA SCODE     CLEAR SECURITY CODE 
      LDB PNEAD     GET ADDR OF PACK NO. ENTRY
      LDA B,I       GET STARTING T/S
      JSB T.STS     CONVERT TO SECTORS
      ADB D3        INCREMENT TO LSA FIELD
      ADA B,I       ADD LSA TO REL. STARTING SECTOR 
      LDB NOSEC     GET SIZE OF LAST FILE CREATED 
      CMB,INB       COMPUTE STARTING RELATIVE SECTOR
      ADA B 
      STA CPNXS     STORE STARTING T/S
      STA CPNXS+1   STORE STARTING T/S
      LDA ARG4,I    PAKNO 
      SSA,RSS 
      JMP CPTOD     COPY TO DESTINATION PACK
* COPY FROM SYSTEM PACK TO DEST. PACK 
* (FOR SYST. TO DEST. PACK COPY)
      LDB SYSSC     GET SYSTEM SUBCHANNEL 
      STB PAKSC     STORE SUBCHANNEL
      JSB SETD2     SET UP FOR DOS-M SEARCH 
      LDB APN00     GET ADDR OF NAME
      JSB SRCD1     SEARCH DIRECTORY
      JSB ER23      NOT FOUND 
      JSB CLWAP     CALC. WORK AREA PARAMETERS
      LDA CPNXS+1   NEXT "T/S" FOR DEST. PACK 
      STA CPNXS 
      JSB CPMOV     COPY-MOVE SYST. TO DEST.
      JMP EFCON     RETURN TO MAIN
      SPC 1 
CPSTD EQU *         COPY SYST. TO DEST. PACK
      LDB CPFPO     FILE POSITION 
      ADB D10       INCREMENT TO PACK NO. FIELD 
      CLA 
      CPA B,I       PN000 ? 
      JMP GETD      GET DEST. PACK
      JSB ER3 
* COPY FROM SYST. PACK TO DEST. 
* (FOR PACK TO PACK COPY) 
CPTOD EQU *         COPY TO DESTINATION 
      LDA CPCPN     CURRENT P.N.
      JSB GETPN     GET PACK NO.
      RSS           PACK NOT AVAILABLE
      JMP GOCPY     SOURCE AND DEST AVAIL.,GO COPY
      JSB GPN00 
      JMP *+3 
MRTOD EQU *         MORE TO MOVE
      LDB PAKSC 
      STB CPDSC     DEST. PACK SUB CH.
      LDA SYSSC     SYSTEM SUB CH.
      STA CPCSC     CURRENT SUB CH. 
      LDA BWATS     BEGINNING OF FREE W/A T/S 
      STA CPCTS     CURRENT "T/S" FOR W/A 
      LDA CPNXS+1   NEXT "T/S" FOR DEST. PACK 
      STA CPNXS     NEXT "T/S" TO MOVE
      LDA NOSTM+1   NO. OF SECT. MOVED LAST TIME
      STA NOSTM     NO. OF SECT. TO MOVE THIS TIME
      JSB CPMOV     MOVE W/A TO DESTINATION 
      LDA CPALF     ALL SECT. XFERED FLAG 
      SSA           FINISHED? 
      JMP EFCON     YES, RETURN TO MAIN 
      INA 
      STA CPNSF     NO. SECT. LEFT TO MOVE
      STA NOSTM     NO. OF SECT. TO MOVE
      JSB GETSP     GET SOURCE PACK 
      JMP CPYT      TERMINATE 
      LDB PAKSC 
      STB CPCSC     CURRENT SUB CH. 
      LDA CPNSF     NO. SECT. LEFT IN FILE
      STA NOSTM     NO. SECT. TO MOVE THIS TIME 
      JSB CLSTM     CAL. IF NO. SECT. DIFFERENT 
      LDA CPNXS+1   NEXT "T/S" OF DEST. PACK
      ADA NOSTM+1   NO. SECT. MOVED LAST TIME 
      STA CPNXS+1 
      LDA CPCTS+1   CURRENT SOURCE PACT "T/S" 
      ADA NOSTM+1   NO. OF SECT. MOVED LAST TIME
      STA CPCTS+1 
      STA CPCTS     CURRENT "T/S" TO MOVE 
      LDA BWATS     BEGINNING FREE W/A T/S
      STA CPNXS     NEXT "T/S" TO MOVE
      LDA *+4 
      STA CPMOV     PACK RETURN ADDR. 
      LDA MTRBS     MAX. TRB SECT.
      JMP CPYMR     MOVE FROM SOURCE TO W/A 
      DEF *+1       RETURN ADDR.
      JSB GETDP     GET DESTINATION PACK
      JSB ER22
      JMP MRTOD     COPY W/A TO DEST. PACK
      SPC 1 
CPTOS EQU *         COPY TO SYST. PACK
      JMP SPN00     GO SEARCH FOR PN000 
CKPN0 EQU * 
      CLA           CLEAR PACK NO. USED SWITCH
      STA PNESW     STORE SWITCH
      CLA,INA       SEARCH FOR EXISTING ENTRY 
      CLB           PN000 
                                                                                                                                                                                                                                                              