      INB 
      LDA B,I       POINTER TO O.T. ENTRY 
      SZA,RSS       FILE FOR THIS BUFFER? 
      JMP POSTW,I   NO, RETURN
      LDB B,I       PICK UP POINTER TO O.T. ENTRY 
      ADB D12 
      LDA B,I       SUB CH. 
      STA GSC       SUB CH. FOR GENERAL R/W 
      INB 
      LDA B,I       PICK UP T/S CUR. IN TRB 
      SZA,RSS       ANY SECT. IN CORE 
      JMP POSTW,I   NO, RETURN
      LDA POSTP+2,I "MUST BE WRITTEN" FLAG
      SZA           WRITE THIS TRB? 
      JMP *+3       YES 
      STA B,I       CLEAR T/S CUR. IN CORE
      JMP POSTW,I   RETURN
      STB POSTP+1   SAVE POINTER
      ADB MD10
      STB POSTP+3   SAVE ADDR. TO START T/S 
      INB 
      LDA B,I       FILE LENGTH 
      INB 
      LDB B,I 
      JSB MPY 
      JSB DIV 
      DEF D128
      SZB 
      INA 
      STA B 
      LDA POSTP+3,I START T/S 
      JSB T.STS 
      ADB A         CALC. END "T/S" IN B
      LDA POSTP+1,I CURRENT T/S 
      JSB T.STS 
      CMB,INB 
      ADB A         CALC. NO. SECT. TO END
      STB A 
      CMA,INA       A = NO. SECT. TO END
      ADB TRBSZ     CALC. ANY OVERFLOW
      SSB           MORE SECT. THAN BUFFERS?
      LDA TRBSZ     YES, USE TRB SIZE 
      STA GNS       NO. SEC. FOR GENERAL R/W
      LDA POSTP+1,I T/S CUR. IN CORE
      LDB POSTP,I   ADDR. OF TRB
      JSB GWTXX     GENERAL WRITE 
      CLA 
      STA POSTP+1,I CLEAR T/S NO. CUR. IN TRB 
      STA POSTP+2,I CLEAR "MBW" FLAG
      ISZ POSTP+2   POINT TO POINTER TO O.T.
      LDB POSTP+2,I PICK UP POINTER TO O.T. 
      STB POSTP+1 
      STA POSTP+2,I CLEAR POINTER TO O.T. 
      ADB D8
      LDA B,I       HIGHEST RECORD ACCESSED ON DISC 
      STB POSTP+3   SAVE POINTER TO "HRW" ON DISC 
      ADB D7
      CMA 
      ADA B,I       HIGHEST RECORD WRITTEN IN CORE
      SSA           UPDATE HIGHEST RECORD ACCESSED? 
      JMP POSTW,I   NO, NO UPDATE 
      ADB MD5       BACK UP TO PACK NO. FIELD 
      LDA B,I       PN000 ? 
      SZA,RSS       YES 
      JMP PSTSC     POST FOR SYST. SUB CH.
      LDB POSTP+1   GET OPEN TABLE ENTRY ADDR 
      ADB D12       INCREMENT TO SUBCHANNEL FIELD 
      LDA B,I       GET THE SUBCHANNEL
      STA PAKSC     STORE THE SUBCHANNEL
      LDB POSTP+1   GET OPEN TABLE ENTRY ADDR 
      JSB GETDE     GET DIRECTORY ENTRY 
      LDB CNAME     GET DIRECTORY ENTRY ADDR
      ADB D8
      STB POSTP+2   FILE POSITION FOR HIGH RCD. ACC.
      LDB POSTP+1   START OF THIS OT ENTRY
      ADB D15 
      LDB B,I       HIGHEST RECORD ACCESSED IN CORE 
      STB POSTP+2,I UPDATE HI RCD.ACC. IN DISC-DIR. 
      STB POSTP+3,I UPDATE HI RCD.ACC. IN CORE-DIR. 
      CLA,INA       WRITE SWITCH
      LDB PAKSC     GET THE SUBCHANNEL
      JSB PRWIO     WRITE BACK DIRECTORY ENTRY
      JMP POSTW,I   RETURN
PSTSC EQU * 
      ADB D5                                    7905                            
      LDA B,I       HIGHEST RECORD WRITTEN IN CORE
      STA POSTP+3,I HIGHEST RECD. WRITTEN ON DISC 
      JMP POSTW,I   RETURN
POSTP OCT 0,0,0,0   POST POSITION 
POSTI OCT 0         POST INDEX
      HED GENERAL ROUTINES
* MOVE - MOVE ARRAYS OF WORDS 
* ENTER:
*         A = SOURCE ADDRESS
*         B = DESTINATION ADDRESS 
*         MOVCT = (-) NO. WORDS TO MOVE 
* EXIT: 
*         NO. OF WORDS MOVED
*         A = END OF SOURCE ADDR.+1 
*         B = END OF DESTINATION ADDR.+1
* 
MOVE  NOP           MOVE ARRAYS OF WORDS
      STA MOVAD     SAVE ADDR. OF SOURCE ARRAY
MOVMR LDA MOVAD,I   PICK UP WORD FORM SOURCE ARRAY
      STA B,I       PUT IT IN DESTINATION ARRAY 
      ISZ MOVAD     BUMP POINTERS 
      INB 
      ISZ MOVCT     FINISHED? 
      JMP MOVMR     NO, MOVE MORE 
      LDA MOVAD     RET. W/ A AND B AT END OF ARRAYS+1
      JMP MOVE,I    RETURN
MOVAD OCT 0 
MOVCT OCT 0 
      SPC 3 
* NAM0? - CHECK IF 1ST WD. OF NAME = 0 OR INVALID CHAR. 
* ENTER:
*         A = ADDR. OF NAME 
* EXIT: 
*         A IS SAVED
*         NAME NOT EQUAL TO 0 OR INVALID CHAR 
* 
NAM0? NOP           NAME = 0? 
      LDB A,I       PICK UP 1ST TWO CHAR. 
      SZB,RSS 
      JSB ER23
      CPB INVCH     INVALID CHAR.?
      JSB ER23      YES 
      JMP NAM0?,I   RETURN
      SPC 1 
* CRPN0 - CREATE PN000 IN WORK AREA 
* ENTER:
*         VALUES FROM SRCDR 
* EXIT: 
*         PN000 CREATED 
*         B IS SAVED
* 
CRPN0 NOP           CREATE PN000
      STB NXTFP     SAVE NEXT FILE POSITION 
      JSB GTLTS     GET LAST T/S FOR SYST. DISC 
      JSB T.STS     T/S TO SECTORS
      STA TMPTS     TEMP. STORAGE FOR NO. SECTORS 
      LDA SYNTS     NEXT T/S FOR SYST. DISC.
      LDB PNEAD     GET ADDR OF PACK NO. ENTRY
      STA B,I       STORE STARTING T/S IN PACK NO. ENTRY
      STA STSWA     STORE STARTING T/S
      JSB T.STS     T/S TO SECTORS
      CMA,INA 
      ADA TMPTS     CALC. NO. SECTORS IN WORK AREA
      SZA,RSS       ANY WORK AREA?
      JSB ER17      NO, NO WORK AREA
      SSA           ANY WORK AREA?
      LDA MAXPN     GET MAX PN SIZE AS GT 32767 AV. 
      STA TMPTS     SAVE LENGTH OF WORK AREA
      STA NOSEC     FILE LENGTH FOR 'CKDSP' 
      LDB PNEAD     GET ADDR OF PACK NO. ENTRY
      ADB D1        INCREMENT TO SIZE FIELD 
      STA B,I       STORE SIZE OF PN000 IN PACK NO. ENTRY 
      INB           INCREMENT TO DIRECTORY SIZE FIELD 
      LDA SECTR     GET DIRECTORY SIZE
      ADA MD1 
      STA B,I       STORE DIRECTORY SIZE IN PACK NO. ENTRY
      INB           INCREMENT TO LSA FIELD
      CLA 
      STA B,I       STORE LSA IN PACK NO. ENTRY 
      STA NSUWA     STORE LSA 
      LDA D5        NO. OF WDS./ENTRY 
      JSB CKDSP     CHECK DIRECTORY SPACE 
      JSB ER24
      LDA SYSBF     GET T/S OF SYSTEM BUFFER
      JSB PRETS 
      CLA 
      LDB SYSSC 
      JSB PRWIO     READ SYS. BUFFER INTO $BUF
      LDA SYNTS     GET LAST ALLOCATED T/S
      JSB T.STS     CONVERT TO SECTORS
      ADA TMPTS     ADD LENGTH OF 'PN000' (IN SECTORS)
      JSB STT.S     GET NEW LAST ALLOCATED T/S
      STA SYNTS     UPDATE SYST. NEXT T/S 
      LDB A$BUF     UPDATE DOS DIREC. WITH LAST 
      ADB D64            SECTOR ALLOCATED 
      STA B,I 
      CLA,INA 
      LDB SYSSC 
      JSB PRWIO     WRITE BACK UPDATED ENTRY
      LDB SYNTS     GET NEXT SYSTEM T/S 
      LDA .CUDS 
      CPA SYSSC     USER SUB CHAN = SYSTEM SUB CHAN?
      STB .UDNT     YES, UPDATE USER DISC NEXT T/S
      JMP CRPN0,I   RETURN
TMPTS OCT 0         TEMP. T/S 
MAXPN DEC 32767     MAX PN000 SIZE
      SPC 3 
* GTLTS - GET LAST T/S (FROM CORE)
* ENTER:
*         NO PARAMETERS 
* EXIT: 
*         A = LAST T/S
* 
GTLTS NOP           GET LAST T/S FOR SYST. DISC 
      LDA JBINS     JOB BINARY START
      CPA MD1       JOB BINARY PRESENT? 
      JMP USELT     NO, USE LAST TRACK
      SZA,RSS       JOB BINARY PRESENT? 
      JMP USELT     NO, USE LAST TRACK
      LDA JBINC     CURRENT JOB BINARY TRACK
      AND INVCH     SAVE ONLY TRACK 
      JMP GTLTS,I   RETURN
USELT EQU *         USE LAST TRACK
      LDA DISCO 
      AND L8BT      SAVE ONLY TRACK NO. 
      INA 
      ALF,ALF       PUT T/S INTO POSITION 
      JMP GTLTS,I   RETURN
      SPC 3 
* CKPN  - CHECK PACK NO. FOR GREATER THAN 999.
* ENTER:
*         A= PACK NO. TO BE CHECKED 
* EXIT: 
*         B IS SAVED
*         P+1 = VALID P.N.
*               DPNO = PACK NO. 
*         JMP ER15 IF INVALID P.N.
* 
CKPN  NOP           CHECK PACK NO.
      STA DPNO      SAVE PACK NO. 
      SSA,RSS 
      JMP CKPN1 
      CPA MD1 
      RSS 
      JSB ER15
CKPN1 EQU * 
      LDA DPNO      GET PACK NO.
      SSA           MAKE SURE P.N. IS (+) 
      CLA 
      CMA,INA 
      ADA D999
      SSA           TOO LARGE?
      JSB ER15      YES 
      LDA DPNO      GET PACK NO.
      JMP CKPN,I    RETURN
      SPC 3 
* CKNAP - CHECK NAME AND PACK NO. 
* ENTER:
*         ARG3 = ADDR. OF FILE NAME 
*         ARG4,I = PACK NO. 
* EXIT: 
*         A = PACK NO.
* 
CKNAP NOP           CHECK NAME AND PACK NO. 
      LDA ARG3      FNAME 
      JSB NAM0?     CHECK IF NAME = 0 
      LDA ARG4,I    PAKNO 
      JSB CKPN      CHECK PACK NO.
      JMP CKNAP,I   RETURN
      SPC 3 
* SETD1 - SET UP FOR EFMP SEARCH
* EXIT: 
*         B = ADDR OF NAME
*         TYPDR = 1(EFMP) 
*         NOPAS = 0(COMPARE)
* 
SETD1 NOP 
      CLA 
      STA NOPAS     COMPARE 
      INA 
      STA TYPDR     EFMP SEARCH 
      LDB ARG3      FILE NAME ADDR
      JMP SETD1,I   RETURN
      SPC 3 
* SETD2 - SET UP FOR DOSM SEARCH
* ENTER:
*         PAKSC = SUBCHANNEL
* EXIT: 
*         A = TRK/SEC TO START SEARCH 
*         TYPDR = 0(DOSM) 
*         NOPAS = 0(COMPARE)
* 
SETD2 NOP 
      CLA 
      STA TYPDR     DOSM SEARCH 
      STA NOPAS     COMPARE NAMES 
      LDB PAKSC     GET SUBCHANNEL
      CPB SYSSC     SYSTEM SUBCHANNEL ? 
      RSS           YES 
      JMP CKSYS     NO
      LDA SYSBF     CALCULATE STARTING T/S FOR SYSTEM DISC
      INA 
      JMP SETD2,I   RETURN
CKSYS EQU * 
      CLA 
      STA TRKIO 
      STA SECIO 
      JSB PRWIO     READ DISC LABEL INFORMATION 
      LDA A$BUF     GET LABEL ADDR
      ADA D3
      LDB ALABL 
      JSB CMPAR     1ST FIVE CHAR'S = 'SYSTE' ? 
      JMP TR0S1     NO
      LDB A$BUF     GET 6TH CHAR
      ADB D5
      LDA B,I 
      CPA EM        6TH CHAR = 'M' ?
      RSS           YES 
      JMP TR0S1     NO
      LDB A$BUF     GET DIRECTORY T/S 
      ADB D64 
      LDA B,I 
      INA 
      RSS 
TR0S1 EQU * 
      LDA TK0S1     DIRECTORY T/S IS 0/1
      JMP SETD2,I   RETURN P+1
ALABL DEF LABEL     LABEL ADDR
LABEL ASC 1,SY      'SYSTEM'
      ASC 1,ST
EM    ASC 1,EM
D64   EQU 67B 
TK0S1 OCT 00001 
      SKP 
* GETPN - GET PACK NUMBER 
* ENTER:
*        A = DESIRED PACK NUMBER
* EXIT: 
*        P+1 = PACK NO. NOT AVAILABLE 
*        P+2 = PACK NO  AVAILABLE 
*              B = ADDR OF DIRECTORY ENTRY
*              PAKSC = SUBCHANNEL 
*              TRKIO = TRACK OF DIRECTORY ENTRY 
*              SECIO = SECTOR OF DIRECTORY ENTRY
GETPN NOP 
      STA DESPN     SAVE DESIRED PACK NO. 
      CLA 
      STA CHNCT     INITIALIZE CHANNEL COUNT TO 0 
      LDA ASUBC     ZERO SUBCHANNEL TABLE 
      LDB MD24                                  79A5                            
      STB PAKSC 
      CLB 
ZLOOP EQU * 
      STB A,I 
      INA 
      ISZ PAKSC 
      JMP ZLOOP 
      LDB CUDSC     START SEARCH AT CURRENT 
      STB PAKSC          USER DISC
SRCH  EQU * 
      LDA ANOTP     RETURN ADDR FOR INACTIVE
      STA XFLG           SUBCHANNEL 
      LDB PAKSC     CALC. ADDR OF CURRENT ENTRY 
      ADB ASUBC          IN SUBCHANNEL
      STB CSUBC 
      JSB SETD2     SET UP FOR DOSM DIRECTORY SEARCH
      STA STSDS     SAVE DIRECTORY STARTING T/S 
      LDA DESPN     GET DESIRED PACK NUMBER 
      SSA           IS IT A GENERAL PACK NUMBER(-1) 
      JMP SPNXX     YES 
      LDA DESPN     GET REQUESTED PACK NO.
      LDB APNDE     CONVERSION OUTPUT FIELD 
      JSB CNVDA     CONVERT DECIMAL TO ASCII
      LDB APNNO     GET ADDR OF SPECIFIC PACK NO
      RSS 
SPNXX EQU * 
      LDB APNXX     GET ADDR OF GENERAL SEARCH NAME 
      LDA STSDS     GET DIRECTORY STARTING T/S
      JSB SRCDR     SEARCH DIRECTORY
SRCRT EQU * 
      JMP NXCHN     PACK NOT FOUND, CONTINUE
      ISZ GETPN     INCREMENT P+2 
      JMP GETPN,I   RETURN P+2
NXCHN EQU * 
      LDB SCCNT 
      CPB CHNCT     ALL CHANNELS SEARCHED ? 
      JMP GETPN,I   YES, RETURN P+1 
      ISZ CHNCT     INCREMENT CHANNEL COUNT ? 
      ISZ CSUBC,I   MARK CHANNEL AS SEARCHED
TANCH EQU * 
      LDB SCCNT 
      LDA PAKSC     GET NEXT SUBCH TO SEARCH
      INA 
      CPB PAKSC     HIGHEST CHAN JUST SEARCHED ?
      CLA           YES, RESET TO 0 
      STA PAKSC     STORE NEXT SUBCHANNEL 
      ADA ASUBC     GET SUBCH TBL ENTRY ADDR
      CLB,INB 
      CPB A,I       HAS SUBCH BEEN SEARCHED ? 
      JMP TANCH     YES 
      LDA PAKSC 
      CPA SYSSC     IS THIS SYSTEM SUBCHANNEL?
      RSS           YES 
      JMP SRCH      NO
      LDB SCCNT 
      CPB CHNCT     ALL OTHER SUBCH'S SEARCHED ?
      JMP SRCH      YES 
      JMP TANCH     NO
GTNPN NOP 
      LDA ASRCR     GET SEARCH RETURN ADDR
      STA SRCDR     STORE RETURN ADDR 
      LDA GTNPN     GET RETURN ADDRESS
      STA GETPN     STORE RETURN ADDRESS
      JMP GTNXE     CONTINUE SEARCH 
ASRCR DEF SRCRT     RETURN ADDR FOR CONTINUED SEARCH
ANOTP DEF NXCHN     RETURN ADDR FOR SUBCHANNEL INACTIVE 
ASUBC DEF SUBC      ADDR OF SUBCH TABLE START 
CSUBC BSS 1         ADDR OF CURR SUBCH TBL ENTRY
SUBC  BSS 24        SUBCHANNEL TABLE            79A5                            
CHNCT BSS 1         CHANNEL COUNT 
DESPN BSS 1         DESIRED PACK NO.
STSDS BSS 1         DIRECTORY STARTING T/S
APNNO DEF PNNO      ADDR. OF SPECIFIC PACK NAME 
APNXX DEF PNXXX     ADDR. OF GENERAL PACK NAME
APNDE DEF PNDEC     ADDR OF DEC. PART OF SPECIFIC NAME
PNNO  ASC 1,PN      SPECIFIC PACK NAME
PNDEC BSS 1 
      BSS 1 
PNXXX ASC 1,PN      GENERAL PACK NAME 
      ASC 1,XX
      ASC 1,XX
      SKP 
* SRCDR - SEARCH EITHER DOSM OR EFMP DIRECTORY
* ENTER:
*         A = STARTING T/S(DOSM ONLY) 
*         B = ADDR OF FILE NAME 
*         TYPDR   DIRECTORY TYPE(0=DOSM,1=EFMP) 
*         NOPAS = COMPARE TYPE('-' = NO COMPARE,'+' = COMPARE)
*         PAKSC = PACK SUBCHANNEL 
*         PNEAD = ADDR OF PACK NO. ENTRY(EFMP ONLY
*                 WITH STARTING T/S IN FIRST WORD)
* EXIT: 
*         P+1 = FILE NOT FOUND
*               A = SECTOR NO. OF NEXT FILE 
*               B = POINTER TO NEXT FILE NAME 
*         P+2 = FILE FOUND/NO COMPARE PERFORMED 
*               A = SECTOR NO. OF FILE
*               B = POINTER TO START OF DIRECTORY ENTRY 
*               SECIO = SECTOR NO. OF DIRECTORY ENTRY 
*               TRKIO = TRACK NO. OF DIRECTORY ENTRY
*               PACK NO. ENTRY INITIALIZED WITH DIRECTORY SIZE, 
*               FILE SIZE, AND LAST SECTOR ALLOCATED
* 
SRCDR NOP 
      STB AFNAM     SAVE FILE NAME ADDRESS
      CLB 
      CPB TYPDR     DOSM SEARCH ? 
      RSS           YES 
      LDA PNEAD,I   GET STARTING T/S
      JSB PRETS     PREPARE T/S FOR I/O 
      LDA D1        SECTOR COUNT OF 1 
      STA SECCT     INITIALIZE SECTOR COUNT 
SRCNS EQU * 
      CLA           READ OPERATION
      LDB PAKSC     GET SUBCHANNEL
      JSB PRWIO     READ NEXT DIRECTORY SECTOR
      LDB A$BUF     START OF NEW SECTOR 
      STB $BUFP     INITIALIZE CURRENT ENTRY ADDRESS
      LDA TYPDR     GET DIRECTORY TYPE
      SZA,RSS       EFMP ?
      JMP CKEOD     NO
      LDA SECCT     GET SECTOR COUNT
      CPA D1        FIRST SECTOR ?
      RSS           YES 
      JMP SRCNF     NO
      LDB $BUFP     GET START OF EFMP'S DIRECTORY ENTRY 
      ADB D3        INCREMENT TO DIRECTORY SIZE FIELD 
      LDB B,I       GET DIRECTORY SIZE
      LDA PNEAD     GET PACK NO. ENTRY ADDR 
      ADA D2        INCREMENT TO DIRECTORY SIZE FIELD 
      STB A,I       STORE DIRECTORY SIZE IN PACK NO. ENTRY
      LDB $BUFP     GET START OF EFMP'S DIRECTORY ENTRY 
      ADB D4        INCREMENT TO EFMP FILE SIZE FIELD 
      LDB B,I       GET EFMP FILE SIZE
      ADA MD1       BACK UP TO PACK NO. ENTRY FILE SIZE FIELD 
      STB A,I       STORE FILE SIZE IN PACK NO. ENTRY 
      LDB $BUFP     GET START OF EFMP'S DIRECTORY ENTRY 
      ADB D8        INCREMENT TO LAST SECTOR ALLOCATED FIELD
      LDB B,I       GET LAST SECTOR ALLOCATED 
      ADA D2        INCREMENT TO PACK NO. ENTRY LSA FIELD 
      STB A,I       STORE LSA IN PACK NO. ENTRY 
      LDB $BUFP     GET ADDR OF CURRENT ENTRY 
      ADB D9        SIZE FO ENTRY 
      STB $BUFP     STORE NEW CURRENT ADDR
CKEOD EQU * 
      LDA END$B     GET ADDR OF END OF $BUF 
      INA 
      CPA $BUFP     IS $BUF FULL ?
      RSS           YES 
      JMP SRCNF     NO
      LDA SECCT     GET SECTOR COUNT
      INA 
      CPA SECTR     PHYSICAL END OF DIRECTORY ? 
      RSS           YES 
      JMP GETNS     NO
      LDA SECCT     CURRENT SECTOR
      LDB $BUFP     CURRENT BUFFER ADDR 
      JMP SRCDR,I   RETURN &+1
SRCNF EQU * 
      LDA $BUFP,I   GET NEXT DIRECTORY ENTRY
      SZA           END-OF-DIRECTORY ?
      JMP CKEOS     NO
      LDA SECCT     GET FILE SECTOR 
      LDB $BUFP     GET NEXT ENTRY ADDR 
      JMP SRCDR,I   RETURN P+1
CKEOS EQU * 
      CPA MD1       END OF SECTOR ? 
      JMP GETNS     YES, GET NEXT SECTOR
      LDA NOPAS     GET COMPARE SWITCH
      SSA           NO COMPARE
      JMP SRET1     YES 
      LDA TYPDR     GET DIRECTORY TYPE
      SZA           EFMP ?
      JMP CKEQN     YES, GO CHECK NAME
      LDA AFNAM     GET REQUESTED FILE NAME ADDRESS 
      LDB APNXX     GET ADDRESS OF 'PNXXX' NAME 
      JSB CMPAR     REQUESTED FILE 'PNXXX' ?
      JMP SETPK     NO
      CLA           GENERAL SEARCH INDICATOR
      STA SPKSR     STORE INDICATOR 
      JMP CKNMT 
SETPK EQU * 
      CLA,INA       SPECIFIC SEARCH INDICATOR 
      STA SPKSR     STORE INDICATOR 
      LDA AFNAM     GET REQUESTED FILE NAME ADDRESS 
      LDB $BUFP     GET ADDRESS OF CURRENT DIRECTORY ENTRY NAME 
      JSB CMPAR     NAMES EQUAL ? 
      JMP GTNXE     NO
      JMP CKINI     YES 
CKNMT EQU * 
      LDB $BUFP     GET CURRENT DIRECTORY ADDR
      LDA B,I       GET FIRST TWO CHARS. OF FILE NAME 
      CPA PN        IS IT 'PN' ?
      RSS           YES 
      JMP GTNXE     NO,GET NEXT ENTRY 
      ADB D1        INCREMENT TO THIRD CHAR OF PACK NO. 
      LDA B         GET ADDR IN A 
      JSB CNPND     CONVERT PACK NO. TO DECIMAL 
      JMP GTNXE     NOT A DECIMAL VALUE 
      SZA           IS IT ZERO ?
      JMP CKINI     NO
GTNXE EQU * 
      LDB $BUFP     GET CURRENT ENTRY ADDR. 
      ADB D2        INCREMENT TO 'TYPE' 
      LDA B,I       GET 'TYPE'
      ADB D3        INCREMENT TO NEXT ENTRY FOR SHORT TYPE
      AND L7BT      SAVE TYPE 
      CMA 
      ADA D6
      SSA,RSS       SHORT TYPE ?
      ADB D6        NO
      STB $BUFP     SAVE NEW ENTRY POINTER
      JMP CKEOD     SEARCH NEXT FILE
CKINI EQU * 
      LDB $BUFP     GET CURRENT ENTRY POINTER 
      ADB D1        INCREMENT TO 2ND WORD OF NAME 
      LDA B,I       GET 2ND WORD OF NAME
      CPA PN+1      SECOND WORD OF NAME = ASCII ZEROS 
      RSS           YES 
      JMP NPN00     NO
      ADB D1        INCREMENT TO LAST CHAR OF NAME
      LDA B,I       GET LAST CHARACTER
      AND H8BT      CLEAR RIGHT BYTE
      IOR ZMASK     INSERT ASCII ZERO IN RIGHT BYTE 
      CPA PN+1      PN000 ? 
      RSS           YES 
      JMP NPN00     NO
      LDA B,I       GET TYPE FIELD
      AND L7BT      CLEAR MEANINGLESS BITS
      CPA B12       BINARY ?
      JMP SRET1     YES 
      JMP GTNXE     NO
NPN00 EQU * 
      LDB $BUFP     GET ADDR OF ENTRY 
      ADB D2        INCREMENT TO 'TYPE' 
      LDA B,I       GET 'TYPE'
      AND L7BT      CLEAR MEANINGLESS BITS
      CPA B12       'BINARY' ?
      JMP CKINF     YES 
                  