*DECK DAIO
          IDENT  DAIO 
          TITLE  DAIO - CDCS DIRECTORY ACCESS ROUTINE I-O 
          COMMENT  CDCS DIRECTORY ACCESS I-O
*CALL COBIOM
 CDCS1    IFNE   OP.DCS,OP.NO 
          IFEQ   OP.DCS,OP.DCS1,1 
 EPT      MICRO  1,,/DA/     CHANGE TO APPROPRIATE ENTRY SUFFIX 
          IFEQ   OP.DCS,OP.DCS2,1 
 EPT      MICRO  1,,/DE/     CHANGE TO APPROPRIATE ENTRY SUFFIX 
          ENTRY  "EPT"$OPEN 
          IFEQ   OP.DCS,OP.DCS1,1 
          ENTRY  DAOPEN 
 "EPT"$OPEN DATA 0           OPEN THE FILE
          IFEQ   OP.DCS,OP.DCS1,1 
 DAOPEN   EQU    DA$OPEN     CDCS1 HAS BOTH 
          SB1    1
          SX6    A1 
          SA6    =SPARAM
          SA2    A1+B1       GET FWA OF BUFFER
          SA3    A2+B1       GET ADDR OF BFS
          STORE  FET1,FIRST=X2     SET FWA OF BUFF
          STORE  FET1,IN=X2  SET IN 
          STORE  FET1,OUT=X2
          SA4    X3          GET BFS
          IX6    X4+X2       BFS+FWA = LIMIT
          STORE  FET1,LIMIT=X6
          SA1    X1          GET FILE NAME
          BX6    X1 
          SA6    NAMSTOR     SAVE FOR STS CALL
          SX7       3 
          BX7    X6+X7       SET COMPLETE AND BINARY BIT
          SA7    FET1        PUT IN FET 
          SA2    STSPARM
          BX6    X2 
          SA6    STSPAR 
          SX2    FET1 
          STORE  X2,R=B0     CLEAR RANDOM OPS 
          RJ     =XC.REWND   REWIND THE FILE
          SYSTEM STS,RECALL,STSPAR,3S6  CALL STS, FUNCTION 3
          SA1    STSPAR+2    GET PRU COUNT
          LX1    6           *64
          BX6    X1 
          SA6    "EPT"$EOI   SET EOI WORD ADDRESS 
          SA6    EOIAD
          EQ     "EPT"$OPEN 
          SPACE  3
          ENTRY  "EPT"$CLSB 
 "EPT"$CLSB  DATA            0     CLOSE THE FILE 
          SA1    GETPARS
          RJ     =XCLOSE
          EQ     "EPT"$CLSB 
          SPACE  3
          ENTRY  "EPT"$GET
          IFEQ   OP.DCS,OP.DCS1,1 
          ENTRY  DAGET
 "EPT"$GET  DATA 0           GET A RECORD 
          IFEQ   OP.DCS,OP.DCS1,1 
 DAGET    EQU    DA$GET 
          SB1    1
          SA5    X1          GET ADDR OF WSA
          SA2    A1+B1       GET ADDR OF LENGTH 
          BX6    X5 
          SA6    WSAAD
          SA5    X2          GET LENGTH 
          SA3    A2+B1
          ZR     X5,"EPT"$GET      EXIT IF ZERO LENGTH READ 
          BX6    X5 
          SA6    LEN
          SA4    X3 
          BX7    X4          WA 
          SA7    WA 
          SA1    GETPARS     PARAMETER LIST 
          RJ     =XGETWA     READ THE STUFF 
          STORE  FTSB,ES=0
          SA1    FET1 
          LX1    59 
          NG     X1,GET1     JP IF COMPLETE 
          RECALL FET1        WAIT FOR IO
 GET1     SA1    FET1 
          LX1    59-3 
          PL     X1,"EPT"$GET      EXIT IF NO EOR 
          FETCH  FET1,CWA,X2  GET LAST WORD READ
          SA3    EOIAD
          IX2    X3-X2
          PL     X2,"EPT"$GET  JP IF NOT READ PAST END OF FILE
          STORE  FTSB,ES=143B       SET INSUFFICIENT DATA 
          EQ     "EPT"$GET
          SPACE  3
 FET1     RFILEB  FET1,1,(RTP=U)
 GETPARS  VFD    42/0,18/FETADD 
          VFD    42/0,18/WSAAD
          VFD    42/0,18/LEN
          VFD    42/0,18/WA 
          DATA   0
 FETADD   VFD    42/,18/FET1
 WSAAD    DATA   0
 LEN      DATA   0
 WA       DATA   0
          ENTRY  "EPT"$EOI
          IFEQ   OP.DCS,OP.DCS1,1 
          ENTRY  EOIADR 
 "EPT"$EOI  DATA 0
          IFEQ   OP.DCS,OP.DCS1,1 
 EOIADR   EQU    DA$EOI 
 EOIAD    DATA   0
 STSPARM  VFD    24/2,36/0
 STSPAR   BSS    1
 NAMSTOR  DATA   0
          DATA   0
          ENTRY  "EPT"$FTSB 
 "EPT"$FTSB  BSS   0
 FTSB     BSSZ   14 
 CDCS1    ENDIF 
          END 
