ASMB,R,L,C
*     NAME:   $DIRD 
*     SOURCE: 92064-18053 
*     RELOC:  92064-16054 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
* 
      NAM $DIRD,6  92064-16054  REV.1650  760806
* 
      ENT $TBLS 
      EXT $LIBR,$LIBX,EXEC
* 
RWCW  NOP 
HIBYT OCT 177400
UBLK  OCT 020000
N29   DEC -29 
FDIR  NOP 
B400  OCT 400 
B200  OCT 200 
ALU   NOP 
ADD1  NOP 
N1    OCT -1
.1    OCT 1 
.3    OCT 3 
.4    OCT 4 
      SUP 
* 
$TBLS NOP           READ DIRECTORY FROM LU IN (B) 
*                   TO ADDRESS IN (A) 
* 
      JSB $LIBR     GO FAKE RE-ENTRANT--LOWER FENCE 
      DEF TDB       ??CAN THIS BE 0 OR 1
      STB ALU       SAVE LU#
      STA ADD1      SET DEST ADDR 
* 
*   DETERMINE END OF DIRECTORY
* 
      ADA N1        BACK UP TO ADDRESS OF END OF DIRECTORY WORD 
      STA FDIR      SAVE IT FOR CHECK 
* 
      ADB B400      CONFIGURE REWIND REQUEST
      STB RWCW      SET INTO EXEC CALL
* 
* 
RD1   JSB EXEC      CALL
      DEF RW1            EXEC 
      DEF .3                  FOR 
      DEF RWCW                    CONTROL 
* 
* 
RW1   CLA 
      STA ADD1,I    ASSURE END OF DIR. FOR NULL TAPE
* 
      JSB EXEC
      DEF RW2 
      DEF .1              READ
      DEF ALU       ASCII FROM SPECIFIED LU 
      DEF ADD1,I    INTO DIRECTORY/TEMP AREA
      DEF .4        REQUEST ENTRY 
* 
RW2   AND B200      END OF FILE?
      SZA 
      JMP DONE
* 
      SZB,RSS       IF NOT EOF-TRANS LOG MUST>0 
      JMP ER29      DIRECTORY/DEVICE ERROR
* 
* 
* 
      CPB .4        MUST HAVE READ 4 WORDS
      RSS           OK
      JMP ER29      NOPE--LESS THAN 4 WORDS READ
* 
      LDB ADD1      FETCH DEST ADDR 
      ADB .3        INC TO NEXT ENTRY POS 
      LDA B,I       FETCH WORD 4 OF ENTRY 
      AND HIBYT     HIGH BYTE MUST BE ASCII BLANK 
      CPA UBLK
      INB,RSS       IT'S GOOD--CONTINUE 
      JMP ER29      INVALID DIRECTORY 
      STB ADD1      SET INTO CALL 
* 
* 
*    CHECK FOR MAX DIR SIZE 
* 
      CPB FDIR,I    END OF DIRECTORY SPACE ?
DONE  CLA,RSS 
      JMP RW1       NOT DONE--CONTINUE
* 
     LDB .1   WANT TO EXIT AT P+2 
DO2  STB RET        GOOD RETURN 
      JSB $LIBX 
      DEF TDB 
RET   NOP 
* 
ER29 LDA N29         DEVICE\DIRECTORY ERROR 
* 
      CLB           INSURE ERROR RETURN 
      JMP DO2 
* 
* 
      SPC 5 
TDB   NOP 
      DEC 3 
      NOP 
A     EQU 0 
B     EQU 1 
      END $TBLS 
      SKP 
                                                                                                                                                                                                                          