ORG 100H
 XEQ 100H
*
 COPY NPTDEFS
*
 LXI  SP,STACK
*
 LHLD SYSGLO  SET LEVEL 0 AND 1 ERRORS TO ME
 LXI D,GLERM
 DAD D
 MVI M,-1
 INX H
 MVI M,-1
 INX H
 MVI M,-1
 INX H
 MVI M,-1
*
 LHLD SYSGLO  GET THE CURRENT DEFAULT UNIT NUMBER
 LXI D,GLUNI
 DAD D
 MOV A,M
 ADI '0'  MAKE IT ASCII
 STA DUNIT
*
 LXI D,BUFF  GET UNIT TO CHECK (IF ANY)
 MVI A,PSOPT  SCAN TO DELIMITER
 CALL PSCAN
 JZ DCHK2  NO NEW UNIT
 LXI H,BUFF  GET NEW UNIT
 MOV  A,M
 CPI '/'
 JNZ DCHK1
 INX H  WE DON'T REALLY NEED A '/'
 MOV A,M
DCHK1 STA DUNIT
*
DCHK2 LXI H,0  SYSTEM MANAGED BUFFERING
 LXI D,DIRCT  OPEN DIRECTRY
 CALL SYS
 DB OPEOP
 CALL ERR1  THIS SHOULD NEVER HAPPEN (I HOPE)
 STA DNUM  SAVE FILE NUMBER OF DIRECTRY
*
DCHK4 LXI D,BUFF  READ THE NEXT BLOCK
 LXI B,100H  READ THIS MANY BYTES
 LDA DNUM  ..FROM DIRECTRY
 CALL SYS
 DB RBLOP
 CALL RERR  GOT AN ERROR CHECK FOR EREOF
 LDA BUFF  GET NUMBER OF FILES IN THIS BLOCK
 ORA A
 JZ DCHK4  IF NONE THEN READ NEXT BLOCK
 LXI H,BUFF+2  POINT TO FIRST NAME
 SHLD EPNTR  SAVE POINTER
*
DCHK5 LHLD EPNTR  DELIMIT NAME OF FILE
 XCHG
 LXI H,8  MAXIMUN LENGTH OF NAME+1
 DAD D
 MOV A,M  GET FILE TYPE
 MVI M,0  DELIMITER IN CASE NAME IS 8 CHARACTERS LONG
 INR A  CHECK FOR DEVICE FILE
 JZ DCHK8  IF SO THEN IGNORE'EM
 MOV L,E
 MOV H,D
DCHK6 INX H  FIND THE END OF THE NAME
 MOV A,M
 ORA A
 JNZ DCHK6
*
 MVI M,'/'  NOW PUT THE SLASH-UNIT
 INX H
 LDA DUNIT
 MOV M,A
 INX H
 MVI M,0
*
 LXI H,0  STATIC BUFFERING
 CALL SYS  OPEN THE FILE
 DB OPEOP
 CALL SERR  REPORT ERROR
 STA FNUM  SAVE FILE NUMBER
 MVI D,-1  SPACE TO THE END OF FILE
 CALL SYS
 DB SPAOP
 CALL SERR
*
 LHLD EPNTR  POINTER TO START OF THIS FILES ENTRY IN DIRECTRY
 LXI D,14  CHECK IF THERE IS AN INDEX BLOCK
 DAD D
 MOV A,M
 INX H
 ORA M
 JZ DCHKA  JUMP IF NO
 LDA FNUM  LOAD THE INDEX BLOCK
 MVI B,4
 LXI H,INDXBL  LOAD THE INDEX BLOCK HERE
 CALL SYS
 DB CTLOP
 CALL SERR
DCHKA LDA FNUM  CLOSE THE FILE
 CALL SYS
 DB CLOOP
 CALL SERR
*
DCHK8 CALL CONTST  CHECK FOR ABORT
 JZ DCHK9
 CALL CONIN  GET THE CHARACTER
 ORA A
 JZ UABRT  USER TYPED MODE, SO ABORT
*
DCHK9 LXI H,BUFF  CHECK FOR ANY MORE ENTRIES IN THIS BLOCK
 DCR M
 JZ DCHK4  NO MORE SO GET NEXT BLOCK
 LHLD EPNTR  OTHERWISE INCREMENT POINTER TO NEXT ENTRY
 LXI D,15H  LENGTH OF AN ENTRY IN DIRECTORY
 DAD D
 SHLD EPNTR  SAVE POINTER TO NEXT NAME
 JMP DCHK5
*
SERR STA ECODE  SET ERROR CODE
 POP H  GET COMMAND CODE
 DCX H
 DCX H
 DCX H
 DCX H
 MOV A,M
 STA CCODE
*
 LHLD EPNTR  PRINT THE NAME OF THE FILE
 XCHG
 MVI A,1  DELIMITED WRITE TO THIS FILE
 LXI B,15  MAXIMUM COUNT
 MVI L,0  UNTIL THIS CHARACTER
 CALL SYS  PRINT THE NAME
 DB DWROP
 CALL ERR1
*
*
 LXI D,BLANK  PRINT ENOUGH BLANKS TO TAB TO COLUMN 12
 MVI A,1  ...TO THIS FILE ( 'B' IS SET FROM ABOVE )
 CALL SYS
 DB WBLOP
 CALL ERR1
*
 MVI A,84H  USER RETURN, NO CRLF AFTER 'ERROR'
 LXI H,-1  NO MESSAGE
 CALL UTIL
 DB UXOP
 CALL ERROR
*
CCODE DB -1  COMMAND CODE FOR UXOP
ECODE DB -1  ERROR MESSAGE CODE
*
 LDA  FNUM  GOOD, BAD OR INDIFFERENT
 CALL SYS  ...CLOSE THE FILE
 DB CLOOP
 JMP DCHK8  ERROR RETURN TO HERE IS OK
 JMP DCHK8  GET NEXT NAME
*
RERR CPI EREOF  CHECK FOR END OF FILE IN DIRECTRY
 JNZ ERR1  NOPE SOMETHING BAD HAPPENED
UABRT LDA DNUM  CLOSE THE DIRECTRY
 CALL SYS
 DB CLOOP
 CALL ERR1
*
 MVI A,1
 MVI B,0DH
 CALL WB
 CALL ERR1
 CALL SYS  ...AND GO HOME.
 DB RETOP
*
ERR1 STA ECOD1  SET ERROR CODE
 POP H  GET OPERATION CODE
 DCX H
 DCX H
 DCX H
 DCX H
 MOV A,M
 STA CCOD1
 MVI A,2
 LXI H,DCHK
 CALL UTIL
 DB UXOP
 CALL ERROR
CCOD1 DB -1
ECOD1 DB -1
*
ERROR POP H
 CALL SYS
 DB ABTOP
*
BLANK ASC "               "  MUST BE AT LEAST 15 SPACES
 DB 0
DCHK ASC 'DCHECK'  A NAME FOR UTIL
 DB 0
DIRCT ASC "DIRECTRY/
DUNIT DB 0,0
*
DNUM DB 0  FILE NUMBER FOR DIRECTRY
FNUM DW 0  FILE NUMBER OF THE FILE WE ARE WORKING WITH NOW
EPNTR DW 0  POINTER TO THE CURRENT DIRECTORY ENTRY
*
BUFF DS 100H  USED AS BUFFER FOR PSCAN AND DIRECTRY
*
INDXBL DS 100H  INDEX BLOCKS ARE LOADED HERE
*
 DS 50
STACK EQU $
*
FINI EQU $
*