JSB STAPN     SEARCH FOR PACK NO. 
      JSB ER6 
      JSB SRCD2     FILE FOUND ?
      JSB TNXTP     GET NEXT PACK NO. 
      LDA DPNO      GET THE DECIMAL VALUE OF PACK NO. 
      STA ARG7,I    PACK STATB
      ADB D8
      LDA B,I       HIGHEST RECORD ACCESSED ON DISC 
      ADB MD4 
      JMP STA4A 
      SPC 1 
CKSLM NOP           CHECK STATUS LIMITS 
      LDA ARG7      ADDR. OF STATB
      JSB CKCLM     CHECK CORE LIMITS 
      JSB ER9       OUT-OF-LIMITS 
      JMP CKSLM,I 
      SPC 3 
STAT5 EQU *         SECTORS LEFT ON PACK
      LDB D2        NO. WDS. TO CHECK 
      JSB CKSLM 
      LDA ARG5,I    PAKNO 
      SSA 
      JSB ER15
      JSB ST6PN     STATUS SEARCH FOR P.N.
      JMP S5PAK     SYSTEM PACK 
      ADB D3       INCREMENT TO STARTING T/S FIELD
      LDA B,I       GET STARTING T/S
      JSB PRETS     PREPARE T/S FOR I/O 
      CLA           READ
      LDB PAKSC     GET SUBCHANNEL
      JSB PRWIO     READ FIRST SECTOR OF EFMP PACK NO.
      LDB A$BUF     GET ADDR OF DIRECTORY ENTRY 
      ADB D4        INCREMENT TO SIZE FIELD 
      LDA B,I       GET SIZE
      ADB D4        INCREMENT TO LSA FIELD
      LDB B,I       GET LSA 
      CMB,INB       CALCULATE SECTORS UNUSED
      ADA B 
STA5A EQU * 
      LDB ARG7      ADDR. OF STATB
      INB 
      STA B,I       PACK NO. SECT. LEFT INTO STATB+1
      JMP EFCON     RETURN TO MAIN
S5PAK EQU * 
      LDB SYSSC     GET SYSTEM SUBCHANNEL 
      STB PAKSC     STORE SUBCHANNEL
      JSB SETD2     SET UP FOR DOS-M DIR. 
      LDB APN00     GET ADDR OF NAME
      JSB SRCD3      SEARCH DIRECTORY 
      JMP STA5B     NO PN000
      ADB D4
      LDA B,I       FILE LENGTH (IN SECTORS)
      LDB NSUWA     NO. SECT. USED IN W/A 
      CMB,INB 
      ADA B         CALC. NO. SECT. LEFT IN W/A 
      JMP STA5A 
STA5B EQU * 
      CLA 
      JMP STA5A 
      SPC 3 
STAT6 EQU *         NAME OF NTH. FILE 
      LDA ARG4      POINTER TO NAME BUFFER
      LDB D3
      JSB CKCLM     CHECK CORE LIMITS 
      JSB ER9       OUT-OF-LIMITS 
      LDA ARG5,I    PAKNO 
      SZA,RSS 
      JSB ER15
      SSA 
      JSB ER15
      LDA MD3       NO. OF WDS TO CLEAR 
      LDB ARG4      POINTER TO NAME BUFFER
      JSB STZ 
      JSB ST6PN     SEARCH FOR P.N. 
      JSB ER15      BRANCH DOES NOT OCCUR 
      LDA ARG7,I    DESIRED FILE NO. "N"
      SZA,RSS 
      JSB ER23
      SSA 
      JSB ER23
      CLA,INA 
      STA ENTNO     ENTRY NO. IN DIRECTORY
      LDA ADPNE     GET ADDR OF DUMMY PACK NO. ENTRY
      STA PNEAD     STORE ADDR
      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
      JSB SETD1     SET UP FOR EFMP SEARCH
      CCB           NO COMPARE SWITCH 
      STB NOPAS     STORE SWITCH
      JSB SRCD3     SEARCH DIRECTORY
      JSB ER21      END-OF-FILE 
      STB ADRFL     ADDR. OF FILE 
      LDA AINVC     POINTER TO INVALID CHAR.
      JSB CMPAR     COMPARE NAMES 
      JMP *+2 
      JMP STA6A 
      LDA ENTNO     CURRENT DIR. ENTRY NO.
      CPA ARG7,I    DESIRED FILE POSITION?
      JMP *+3 
      ISZ ENTNO     BUMP DIR. ENTRY NO. 
      JMP STA6A 
      LDA MD3 
      STA MOVCT     NO. WDS. TO MOVE
      LDA ADRFL     ADDR. OF FILE IN $BUF 
      LDB ARG4      DESTINATION BUFFER
      JSB MOVE      INSERT FILE NAME OF NTH FILE
      ADB MD1 
      LDA B,I       5TH CHAR, LO 8 BITS 
      AND H8BT      SAVE ONLY 5TH CHAR
      STA B,I       RESTORE IT
      JMP EFCON     RETURN TO MAIN
ADRFL OCT 0,0       ADDR. OF FILE 
STA6A EQU * 
      LDA SRCDR     GET RETURN ADDR 
      ADA MD1       SET TO ORIGINAL ADDR
      STA SRCDR     STORE UPDATED RETURN ADDR 
      JMP EBIAS     GET NEXT ENTRY
      SPC 3 
STAT7 EQU * 
      LDA ARG4,I    GET SUBCHANNEL
      SSA           NEGATIVE ?
      JSB ER23      YES 
      CMA,INA 
      ADA SCCNT 
      SSA           LEGAL VALUE FOR SUBCHANNEL
      JSB ER23      NO
      LDA ARG4,I    GET THE SUBCHANNEL
      STA PAKSC     STORE SUBCHANNEL
      LDA ARG7,I    GET ENTRY NUMBER
      SZA,RSS       ZERO ?
      JSB ER23      YES 
      SSA           NEGATIVE
      JSB ER23      YES 
      CLA,INA 
      STA ENTNO     INITIALIZE COUNTER
      JSB SETD2     SET UP FOR DOS-M SEARCH 
      CCB 
      STB NOPAS     NO COMPARE SWITCH 
      JSB SRCD3     SEARCH DIRECTORY
      JSB ER21      END OF DIRECTORY
      LDA PN
      CPA B,I       1ST TWO CHARS OF NAME EQUAL 'PN' ?
      RSS           YES 
      JMP GTNX1     NO
      ADB D2        INCREMENT TO 3RD WORD OF NAME 
      LDA B,I       GET TYPE FILED
      AND L7BT      CLEAR MEANINGLESS BITS
      CPA B13       ASCII ? 
      JMP AINIT     YES 
      CPA B12       BINARY ?
      JMP NINIT     YES 
      JMP GTNX1     NO
AINIT EQU * 
      CLA           INITIALIZED INDICATOR 
      RSS 
NINIT EQU * 
      CLA,INA       UNINITIALIZED INDICATOR 
      STB SVDEA     SAVE ENTRY ADDR 
      LDB ARG4      GET ADDR OF RETURN BUFFER 
      STA B,I       STORE INDICATOR 
      LDA SVDEA     RESTORE ADDR
      ADA MD1       BACK UP TO 3RD CHAR 
      JSB CNPND     IS IT DECIMAL ? 
      JMP GTNX1     NO
      LDB ENTNO     GET ENTRY NO. 
      CPB ARG7,I    EQUAL TO REQUESTED NO. ?
      JMP SRET1     YES 
      INB           INCREMENT COUNTER 
      STB ENTNO 
GTNX1 EQU * 
      LDA SRCDR     GET RETURN ADDR 
      ADA MD1       SET TO ORIGINAL ADDR
      STA SRCDR     STORE UPDATED RETURN ADDR 
      JMP GTNXE     GET NEXT ENTRY
SRET1 EQU * 
      LDB ARG5      GET ADDR OF RETURN BUFFER 
      STA B,I       STORE PACK NO.
      JMP EFCON     RETURN
SVDEA BSS 1         SAVE ADDR OF ENTRY
ENTNO BSS 1         ENTRY NO. 
      SPC 3 
STAPN NOP 
      LDA ARG4      GET ADDR OF FILE NAME 
      JSB NAM0?     CHECK NAME
GARG5 EQU * 
      LDA ARG5,I    GET PACK NO 
      JSB CKPN      CHECK PACK NO 
      SZA,RSS       PN000 ? 
      JMP STAPN,I   YES 
      LDA ARG5,I    GET PACK NO.
      JSB GETPN     PACK NO. AVAILABLE ?
      JSB ER6       NO
      STB SVDEA     SAVE DIRECTORY ENTRY ADDR 
      JSB SVPNS     SAVE PACK NO. SEARCH ENVIRONMENT
      LDB SVDEA     RESTORE DIRECTORY ENTRY ADDR
      ISZ STAPN     P+2 
      JMP STAPN,I   RETURN
ST6PN NOP 
      LDA ST6PN     GET RETURN ADDR 
      STA STAPN     STORE RETURN ADDR 
      JMP GARG5     CHECK PACK NO.
SRCD2 NOP 
      LDA ADPNE     GET ADDR OF DUMMY PACK NO. ENTRY
      STA PNEAD     STORE ADDR
SNXTD EQU * 
      ADB D3        INCREMENT TO STARTING T/S FIELD 
      LDA B,I       GET STARTING T/S
      LDB PNEAD     STORE ITIN PACK NO. ENTRY 
      STA B,I 
      JSB SETD1     SET UP FOR EFMP SEARCH
      LDB ARG4      GET ADDR OF FILE NAME 
      JSB SRCD3     FILE NAME FOUND ? 
      JMP SRCD2,I   NO, RETURN P+1
      ISZ SRCD2     P+2 
      JMP SRCD2,I   RETURN
TNXTP NOP 
      LDA ARG5,I    GET PACK NO.
      SSA,RSS       TRY ALL PACKS ? 
      JSB ER3       NO
      JSB REPNS     RESTORE PACK NO. SEARCH ENVIRONMENT 
      JSB GTNPN     PACK NO. AVAILABLE ?
      JSB ER6       NO
      JMP SNXTD     YES 
      HED CHANGE FILE NAME
* 
*         CHANGE FILE NAME
* 
FUN13 EQU * 
      JSB CKVSU     CHECK IF VALID DEFINE PREVIOUSLY
      JSB CKNAP     CHECK NAME AND PACK NO. 
      LDA ARG3      GET ADDR OF CURRENT FILE NAME 
      ADA D3        GET ADDR OF NEW FILE NAME 
      JSB NAM0?     CHECK NEW NAME
      LDA ARG4,I    GET PACK NO.
      SSA           TRY ALL PACKS ? 
      JMP SANPN     YES 
      SZA,RSS       PN000 ? 
      JMP CNINC     YES 
      LDB ARG3      GET CURRENT FILE NAME 
      JSB CKOPN     IS IT OPEN ?
      JMP CKPN1     NO
      STB CFNEN     SAVE OPEN TABLE FILE ENTRY ADDR 
      LDA ARG4,I    GET PACK NO.
      ADB D10       INCREMENT TO PACK NO. FIELD 
      CPA B,I       PACK NO.'S EQUAL ?
      RSS           YES 
      JMP CKPN1     NO
      LDB ARG3      GET ADDR OF NEW FILE NAME 
      ADB D3
      JSB CKOPN     DUPLICATE ENTRY ? 
      RSS           NO
      JSB ER2       YES 
      JSB SETD1     SET UP FOR EFMP 
      LDB CFNEN     GET OPEN TABLE ENTRY ADDR 
      ADB D12       INCREMENT TO SUBCHANNEL FIELD 
      LDA B,I       GET SUBCHANNEL
      STA PAKSC     STORE SUBCHANNEL
      ADB MD10      BACK UP TO PACK NO. OFFSET FIELD
      LDA B,I       GET PACK NO. OFFSET 
      AND L8BT      CLEAR THE LEFT BYTE 
      LDB D4
      JSB MPY       CALC. THE DISPLACEMENT
      ADA OPNTB     CALCULATE ADDR OF PACK NO. ENTRY
      STA PNEAD     STORE THE PACK NO. ENTRY ADDR 
      LDB ARG3      GET ADDR OF NAME
      ADB D3
      JSB SRCD3     SEARCH FOR DUPLICATE
      RSS           NO DUPLICATE
      JSB ER2       DUPLICATE 
      LDB CFNEN     GET ADDR OF OPEN TABLE ENTRY
      JSB GETDE     GET DIRECTORY ENTRY 
      LDB CNAME     GET ADDR OF DIRECTORY ENTRY 
CINAD EQU * 
      JSB CNGNM     CHANGE NAME IN DIRECTORY ENTRY
      CLA,INA       WRITE 
      LDB PAKSC     SUBCHANNEL
      JSB PRWIO     WRITE NEW NAME
      LDB CFNEN     GET OPEN TABLE ENTRY ADDR 
      JSB CNGNM     CHANGE NAME IN OPEN TABLE 
      JMP EFCON     RETURN
CKPN1 EQU * 
      CLA,INA       CHECK FOR PACK NO.
      LDB ARG4,I    GET PACK NO.
      JSB CKPNT     PACK NO. IN TABLE ? 
      RSS           NO
      JMP SRCD1     YES 
SANPN EQU * 
      LDA ARG4,I    GET PACK NO.
      JSB GETPN     PACK NO. AVAILABLE ?
      JSB ER6       NO
SVPNN EQU * 
      STB SVDEA     SAVE DIRECTORY ENTRY ADDR 
      JSB SVPNS     SAVE PACK NO. SEARCH ENVIRONMENT
      LDB SVDEA     RESTORE DIRECTORY ENTRY ADDR
      ADB D1        GET ADDR OF 3RD AND 4TH CHARS OF NAME 
      STB APNSV     SAVE ADDR OF 3RD CHAR OF PACK NO. 
      LDA ADPNE     GET ADDR OF DUMMY PACK NO. ENTRY
      STA PNEAD     STORE ADDR OF DUMMY PACK NO. ENTRY
      ADB D2        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
SRCD1 EQU * 
      JSB SETD1     SET UP FOR EFMP 
      LDB ARG3      GET ADDR OF NEW NAME
      ADB D3
      JSB SRCD3     SEARCH FOR DUPLICATE
      RSS           NO DUPLICATE
      JSB ER2       DUPLICATE 
      LDB ARG3      GET CURRENT FILE NAME 
      JSB SRCD3     NAME FOUND ?
      RSS           NO
      JMP CTCOP     YES 
      LDA ARG4,I    GET PACK NO.
      SSA,RSS       TRY ALL PACKS ? 
      JSB ER3       NO
      JSB REPNS     RESTORE PACK NO. SEARCH ENVIRONMENT 
      JSB GTNPN     PACK NO. AVAILABLE ?
      JSB ER6       NO
      JMP SVPNN     YES 
CTCOP EQU * 
      STB DEAD1     SAVE DIRECTORY ENTRY ADDR 
      ADB D6       INCREMENT TO SECURITY FIELD
      LDA ARG5,I   GET SECURITY IN PARM LIST
      CPA B,I       EQUAL ? 
      RSS           YES 
      JSB ER7       NO
      LDA ARG4,I    GET PACK NO.
      SSA,RSS       ALL PACKS ? 
      JMP CNOD      NO
      LDB ARG3      GET CURRENT NAME
      JSB CKOPN     FILE OPEN ? 
      JMP CNOD      NO
      LDA DPNO      GET PACK NO.
      ADB D10       INCREMENT TO PACK NO. FIELD 
      CPA B,I       PACK NO.'S EQUAL ?
      RSS           YES 
      JMP CNOD      NO
      LDB ARG3      GET ADDR OF NEW NAME
      ADB D3
      JSB CKOPN     CHECK FOR DUPLICATE IN OPEN TABLE 
      RSS           NO DUPLICATE
      JSB ER2       DUPLICATE 
      LDB DEAD1     GET DIRECTORY ENTRY ADDR
      JMP CINAD 
CNOD  EQU * 
      LDB DEAD1     GET DIRECTORY ENTRY ADDR
      JSB CNGNM     CHANGE NAME 
      CLA,INA       WRITE 
      LDB PAKSC     SUBCHANNEL
      JSB PRWIO     WRITE NEW NAME
      JMP EFCON     RETURN
CNINC EQU *         CHANGE NAME IN CORE 
      LDB ARG3      ADDR. OF FILI NAME
      JSB CKOPN     CHECK IF FILE OPEN
      JSB ER3       NOT OPEN
      STB DEAD1     SAVE OPEN TABLE ENTRY ADDR
      ADB D10 
      LDA B,I       PACK NO.
      SZA           TEMP FILE?
      JSB ER3       NO
      LDB ARG3      GET ADDR OF NEW NAME
      ADB D3
      JSB CKOPN     DUPLICATE OPEN
      RSS           NO
      JSB ER2       YES 
      LDB DEAD1     GET DIRECTORY ENTRY ADDR
      JSB CNGNM     CHANGE NAME 
      JMP EFCON     RETURN TO MAIN
      SPC 1 
      SPC 1 
CNGNM NOP           CHANGE NAME 
      LDA MD2 
      STA MOVCT     NO. WDS. TO MOVE
      LDA ARG3      ADDR. OF SOURCE 
      ADA D3
      JSB MOVE      MOVE NAME 
      LDA A,I       3RD WD. OF NAME (SOURCE)
      AND H8BT      STRIP 5TH. CHAR.
      STA TCSTR 
      LDA B,I       3RD WD. OF DESTINATION
      AND L8BT      STRIP LO 8 BITS 
      IOR TCSTR 
      STA B,I       REPACK 3RD. WD. OF ENTRY
      JMP CNGNM,I   RETURN
TCSTR BSS 1         TEMP. STORAGE 
DEAD1 BSS 1         ADDR OF DIRECTORY ENTRY 
ADPNE DEF DPNE      ADDR OF DUMMY PACK NO. ENTRY
DPNE  BSS 4         DUMMY PACK NO. ENTRY
CFNEN BSS 1         ADDR OF OPEN TABLE ENTRY
APNSV BSS 1        ADDR OF PACK NO. 
      HED MISCEL. 
MOVE  NOP 
      JSB MASUB 
      DEC 1 
POST  NOP 
      JSB MASUB 
      DEC 2 
POSTW NOP 
      JSB MASUB 
      DEC 3 
CKVSU NOP 
      JSB MASUB 
      DEC 4 
NAM0? NOP 
      JSB MASUB 
      DEC 5 
CKPN  NOP 
      JSB MASUB 
      DEC 7 
SVPNS NOP 
      JSB MASUB 
      DEC 8 
CKNAP NOP 
      JSB MASUB 
      DEC 9 
SETD1 NOP 
      JSB MASUB 
      DEC 10
SETD2 NOP 
      JSB MASUB 
      DEC 11
GETDE NOP 
      JSB MASUB 
      DEC 12
REPNS NOP 
      JSB MASUB 
      DEC 13
CNPND NOP 
      JSB MASUB 
      DEC 15
GETPN NOP 
      JSB MASUB 
      DEC 17
CKOPN NOP 
      JSB MASUB 
      DEC 18
SRCD3 NOP 
      JSB MASUB 
      DEC 19
GTNPN NOP 
      JSB MASUB 
      DEC 20
CKCLM NOP 
      JSB MASUB 
      DEC 22
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
STZ   NOP 
      JSB MASUB 
      DEC 28
GRTXX NOP 
      JSB MASUB 
      DEC 29
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 
ER6   EQU * 
      OCT 0 
      LDA D6
      JSB ERR 
ER7   EQU * 
      OCT 0 
      LDA D7
      JSB ERR 
ER9   EQU * 
      OCT 0 
      LDA D9
      JSB ERR 
ER10  EQU * 
      OCT 0 
      LDA D10 
      JSB ERR 
ER11  EQU * 
      OCT 0 
      LDA D11 
      JSB ERR 
ER13  EQU * 
      OCT 0 
      LDA D13 
      JSB ERR 
ER15  EQU * 
      OCT 0 
      LDA D15 
      JSB ERR 
ER21  EQU * 
      OCT 0 
      LDA D21 
      JSB ERR 
ER23  EQU * 
      OCT 0 
      LDA D23 
      JSB ERR 
ER26  EQU * 
      OCT 0 
      LDA D26 
      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 
L7BT  EQU 73B 
L8BT  EQU 74B 
H8BT  EQU 75B 
SCCNT EQU 156B
SYSSC EQU 155B
MXWPE DEC 9         WORDS/DIRECTORY ENTRY 
MD11  DEC -11 
MD10  EQU .-10
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 
D5    EQU .+5 
D6    EQU .+6 
D7    EQU .+7 
D8    EQU .+8 
D9    EQU .+9 
D10   EQU .+10
D11   DEC 11
D12   DEC 12
D13   DEC 13
D14   DEC 14
D15   DEC 15
D21   DEC 21
D23   DEC 23
D26   DEC 26
D128  DEC 128 
B12   EQU D10       BINARY
B13   EQU D11       ASCII 
MAXRC DEC 32767     MAX. RECORD NO. 
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