!    S D O S D I S K V A L I D A T E   P A S S   4
!
!    Revision History:
!    EDITED 7/25/79:
!        ADDED    ESCAPE DURING FILE FIX-UP GOES RIGHT TO "DELETE?"
!        ADDED    PRINTS DATES OF FILES WHO OVERLAP
!        FIXED    NO MESSAGE # ON INVALID DATE
!
!    EDITED 03/06/80
!        FIXED    ENTRY OF BAD DATE FORMAT TO NOT BLOW UP
!        CONVERTED TO 14
!    EDITED 7/21/80    MOD FOR BASIC14G
!    EDITED 1/30/81    MODS FOR BASIC14H
!        FIXED    ACCEPTS LOWER CASE FILE NAME INTO DIRECTORY
!        FIXED    CAN'T DEALLOCATE A HEADER
!        CHANGED    ORGANIZATION FOR EASIER UNDERSTANDING
!
!    12/27/82 V1.1g Modified to match SDOS v1.1g
!                   Speeded up main loop by reading 1 record/directory entry
!                   Handle DISK READ error in directory sector.
!                   Increase size of DISKMAP.SYS to handle 40Mb of disk
!                   Fix minor hiccups
!
!    11/29/83 V1.1h Fixed bug which caused string subcript errror if
!                   when updating bad filename.  Changed various message
!                   numbers (nnn) to match documentation.


    PROGRAM ORIGIN :4000
    DATA ORIGIN :2E00
!
    COMMON Q$[34],DEVICE$[20],FNAME$[16],FNAME2$[16],OP$[12],DIR$[32]
    COMMON DIR2$[32],DEVDIR$[30]
    COMMON BYTE$[1],TWOB$[2],MINUS1$[2]
    COMMON NBPS,NLSN,NLCN,NSPC,HEADERBYTE,HCN,HCN2,HCSIC,HCSIC2
    COMMON MODF,MOD2F,DISMOUNT$[4],UNPROT$[4]
    COMMON NSPT,NTPC,NCYL,NOTBADS,NLCNS,NLCNS2,STAT$[23]
    COMMON SETMAP$[8],BUFFER$[20],BUFAD$[2]
    COMMON UNPROT2$[3]
    COMMON MAXFSIZE,GETPOS$[14],HCN$[2],HCSIC$[1],LCNS$[2],FSIZE$[4]
    COMMON PROT$[1],EMPTY$[6],PROT,FSIZE,CKSUM,BYTES,BAD,KILL,POS
    COMMON AZ$[27]
    COMMON PER09$[11]
    COMMON OPTIONS

    COMMON DMAP$[2048]

REM    LOCAL VARIABLES:

    DIM CCSETFILEPROT$/:E,8,0,:11/,WBPROTECT$/:41/,NOPROTECT$/0/,UNPROTECTED/0/
    DIM BADHCN/-1/,UNPROT1$/14,4,1,:10/
    DIM FFFFFF$/:FF,:FF,:FF/,FFFF$/:FF,:FF/
    DIM GETFILEPOSITION$/:F,:E,0,0/
    DIM HEADER$[128]
    DIM FFS$[128]

!^L
!    SDOSVALIDATE 4 -- COMPILE PSUEDO-DISK MAP
!                      AND CHECK VALIDITY OF EACH DIRECTORY ENTRY
!
    DEF MSB(X1)=INT(X1/256)
    DEF LSB(X2)=INT(X2-256*MSB(X2))

DEF FILEPOSITION(CHANNEL)
    SYSCALL #CHANNEL,GETFILEPOSITION$,"",BUFFER$
    RETURN (BUFFER$[1]**8+BUFFER$[2])*256*256+BUFFER$[3]**8+BUFFER$[4]
END

    PRINT "(400) SDOSDISKVALIDATE Pass 4 V1.1h"
    FOR I=1 TO MAXLEN(FFS$) DO FFS$[I]=:FF
    LEN(FFS$)=MAXLEN(FFS$)
    LEN(HEADER$)=MAXLEN(HEADER$)
    DEVDIR$=DEVICE$ CAT "DIRECTORY.SYS"
    OPEN #1,DEVDIR$
    LET DIRECTORYSLOT=0
    OPEN #2,DEVICE$
    SYSCALL #2,UNPROT$

COMPUTEMAPPARAMETERS:
    NLCN=INT(NLSN/NSPC)
    REALMAPBYTES=INT((NLCN+7)/8) \ ! MAP BYTES THAT CONTAIN REAL INFORMATION
    MAPSIZEINBYTES=INT((REALMAPBYTES+NBPS-1)/NBPS)*NBPS
    !D! PRINT "NLCN";NLCN;"REALMAPBYTES";HEX$(REALMAPBYTES);...
    !D! &     "MAPSIZEINBYTES";MAPSIZEINBYTES

    IF MAPSIZEINBYTES>MAXLEN(DMAP$)
    THEN
        PRINT "*** DISKMAP.SYS TOO BIG TO HANDLE ***"
        ERROR 104
    FI
    REM ZERO MAP BYTES THAT COULD CONTAIN USEFUL INFORMATION
    LEN(DMAP$)=MAPSIZEINBYTES
    FOR I=1 TO REALMAPBYTES DO DMAP$[I]=0

    ! MARK ILLEGAL LCNS IN LAST REAL BYTE
    FOR BIT=NLCN TO 8*REALMAPBYTES-1 DO GOSUB 400

    REM MARK ILLEGAL LCN'S IN LAST SECTOR OF MAP AS ALLOCATED
    FOR I=REALMAPBYTES+1 TO MAPSIZEINBYTES DO DMAP$[I]=:FF
!^L
20  REM MAIN LOOP: SCAN THRU DIRECTORY.SYS VALIDATING EACH FILE ENTRY FOUND
    REM READ NEXT DIRECTORY ENTRY
    IF ERROR WHEN
       READ #1@DIRECTORYSLOT,DIR$ \ ! Read next directory entry
    THEN
        IF ERR<>1045 THEN ERROR
        PRINT "(437) Disk Read Error occurred while reading DIRECTORY.SYS"
        PRINT "      (Directory entry offset ";hex$(DIRECTORYSLOT);")"
        PRINT "      Try reading it again (default=YES)? ";\ GOSUB 10000
        IF NO
        THEN
            ! Prepare to advance past sector.
            LET DIRECTORYSLOT=DIRECTORYSLOT&COM(NBPS-1) \ ! Find sector start
            PRINT "(434) WRITE ON DIRECTORY SECTOR (DEFAULT=NO)? ";\GOSUB 10000
            IF YES
            THEN
                ! Simon sez, "Stomp on Directory sector". Yessah, boss!
                GOSUB ALLOWDIRECTORYUPDATE \ ! take protection off the file
                ! Assert: NBPS<=LEN(DMAP$)
                WRITE #1@DIRECTORYSLOT,DMAP$[1,NBPS] \ ! write trash on sector
                ! now fill sector with dummy directory entries
                LEN(DIR$)=32\DIR$[19]=0 \ ! HCSIC=0 --> free slot
                FOR I=0 TO NBPS-1 STEP 32 DO WRITE #1@DIRECTORYSLOT+I,DIR$
            FI
            ! Now advance to next directory sector.
            LET DIRECTORYSLOT=DIRECTORYSLOT+NBPS
        FI
        GOTO 20
    FI
    IF EOF(1)
    THEN
        IF UNPROTECTED
        THEN
            ! WE REMOVED THE PROTECTION FROM DIRECTORY.SYS. PUT IT BACK ON.
            SYSCALL #1,CCSETFILEPROT$,WBPROTECT$
        FI
        PRINT "(412) Chaining to SDOSDISKVAL.PAS5"
        CHAIN "SDOSDISKVAL.PAS5"
    FI

!^L
201 ! IF HCSIC=0 OR NLCNS=0 THEN 22
    IF DIR$[19]=0 OR DIR$[20]=0 AND DIR$[21]=0 THEN 22 \ ! empty directory slot

    MOD2F=0 \ ! Remember, no changes made to this directory entry yet.

    ! the following code is really tacky. I'll bet we can avoid it...
    FNAME$=DIR$[1,16]
    HCN$=DIR$[17,2]
    HCSIC$=DIR$[19,1]
    LCNS$=DIR$[20,2]
    FSIZE$=DIR$[22,4]
    PROT$=DIR$[26,1]
    EMPTY$=DIR$[27,6]


    LET LEN(FNAME$)=FIND(FNAME$," ")
    IF LEN(FNAME$)=0 THEN LEN(FNAME$)=16 ELSE LEN(FNAME$)=LEN(FNAME$)-1
    GOSUB 700\ ! Is file name valid ?
    IF BAD
    THEN
        PRINT "(401) Directory entry contains invalid DIR:FILENAME: ";
        FOR I=1 TO LEN(FNAME$)
            IF FNAME$(I)&:7F>=:20 THEN PRINT FNAME$[I,1]; ELSE PRINT ".";
        NEXT I
        PRINT
        INPUT "(402) New file name (default is no change)? " Q$
        KILL=1
        IF Q$=""
        THEN
            ! User sez, leave the name alone...
29          GOSUB 3000\GOSUB 4000
            GOTO 22
        FI
        LET Q$=UPPERCASE$(Q$)
        LET X = LEN(FNAME$)
        LET LEN(FNAME$) = 16
        FNAME$[1,16]=Q$ \ ! force blank padding to 16 bytes
        LET LEN(FNAME$) = X
        MOD2F=1
    FI
!^L
23  GOSUB 800\ ! Check content of directory entry for sanity.
    IF BAD=0 THEN IF MOD2F=0 THEN 24 ELSE 235
    PRINT "(403) The directory entry for ";FNAME$;" is in error."
    KILL=1\GOSUB 900
235 GOSUB 3000\! KILL IT MAC?
    IF YES THEN GOSUB 4000\GOTO 22 ELSE GOSUB 4000
24  IF KILL=-1 THEN GOSUB 3000\IF YES THEN GOSUB 4000\GOTO 22

2405 ! Inspect file header
     IF ERROR WHEN READ #2@HCN*NBPS*NSPC,TWOB$
     THEN
241      IF ERR<>1045 AND ERR<>1046 THEN ERROR
         PRINT "(404) Unable to read header for ";FNAME$
         PRINT "(432) Retry? ";\GOSUB 10000
         IF NOT NO THEN 2405
         GOSUB 3000
         IF NOT YES THEN 22
243      HCSIC$[1]=0
         GOSUB 4000
         GOTO 22
    FI
242 IF HCN=TWOB$[1]*256+TWOB$[2] THEN 27
    PRINT "(405) ";FNAME$;"'s header is bad."
    PRINT "      DIR:HLCN in the directory entry shows it is at ";HEX$(HCN);"."
    PRINT "(406) Is DIR:HLCN correct (default = yes) ? ";\GOSUB 10000
    IF NOT NO THEN 28
    PRINT "(407) Do you know what it should be? ";\GOSUB 10000
    IF NOT YES THEN 29
    INPUT "(408) New value for DIR:HLCN: " HCN
    HCN$[1]=MSB(HCN)\HCN$[2]=LSB(HCN)
    GOTO 235

28  INPUT "(409) Fix it, leave it, or delete it (F, L, or D)? " Q$
    LET Q$=UPPERCASE$(Q$)
    IF Q$="D" THEN GOTO 243
    IF Q$="L" THEN 22
    IF Q$<>"F" THEN 28
    RESTORE #2,HCN*NBPS*NSPC
    WRITE #2,HCN$
!^L
27  REM DIRECTORY ENTRY IS RATIONAL, VALIDATE THE HEADER CLUSTER
    REM FIRST, MARK THE HEADER CLUSTER OF THE FILE AS OWNED IN THE MAP
    HEADERBYTE=0
    BIT=HCN\GOSUB 400
271 ACTUALNLCNS=1
    REM READ IN CHUNKS OF HEADER AND MARK LCNS IN DMAP$
    REM LOOP OPTIMIZED TO SCAN OVER :FFFF LCNS, SPEEDS PROCESSING SMALL FILES
    FOR HEADERLOOP=1 TO (HCSIC*NBPS)/MAXLEN(HEADER$)
25      READ #2@HCN*NSPC*NBPS+HEADERBYTE,HEADER$
        IF HEADERBYTE=0 THEN HEADER$(1,2)=FFFF$
21      FOR I=1 TO MAXLEN(HEADER$)-1 STEP 2
            IF RIGHT$(HEADER$,I)=RIGHT$(FFS$,I)
            THEN
                HEADERBYTE=HEADERBYTE+LEN(HEADER$)-I+1
                CYCLE HEADERLOOP
            FI
            BIT=HEADER$(I)*256+HEADER$(I+1)
            IF BIT<>:FFFF THEN
                IF BIT>NLCN-1 THEN
                    PRINT "(410) ";FNAME$;" Contains an illegal "; ...
&                         "LCN (";HEX$(BIT);")."\GOSUB 2000
                ELSE GOSUB 400\ACTUALNLCNS=ACTUALNLCNS+1
            FI
            HEADERBYTE=HEADERBYTE+2
        NEXT I
    NEXT HEADERLOOP
    IF NLCNS<>ACTUALNLCNS THEN
        PRINT "(411) DIR:NCLUSTERS of ";FNAME$;" shows the file owns";NLCNS;"LCNs"
        PRINT "      but scanning the Header cluster shows the file actually owns";ACTUALNLCNS
        LCNS$[1]=MSB(ACTUALNLCNS)\LCNS$[2]=LSB(ACTUALNLCNS)
        GOSUB 4000
    FI
22  LET DIRECTORYSLOT=DIRECTORYSLOT+32
    GOTO 20
!^L
400 REM MARK MAP BIT, AND RESOLVE CLUSTER OWNERSHIP IF CONFLICT.
    IF DMAP$[INT(BIT/8)+1]&(1**(BIT&7))=0
    THEN
        REM CLUSTER "BIT" IS NOT CURRENTLY MARKED, SO NO OVERLAP CONFLICT.
        REM MARK THE CLUSTER AS BUSY.
        DMAP$[INT(BIT/8)+1]=DMAP$[INT(BIT/8)+1]!(1**(BIT&7))
        RETURN
    FI
    REM OOOPS... THE CLUSTER "BIT" IS ALREADY OWNED BY A FILE!
    REM GO FIND THE CONFLICTING FILE
    GOSUB 500
403 IF DIRECTORYSLOT=NCYL THEN
        REM FILE OVERLAPS ITSELF
        PRINT "(436) ";FNAME$;" contains LCN ";HEX$(BIT);" twice (at ";...
&             HEX$(OVERLAPPEDCLUSTERINDEX*2);" and ";HEX$(HEADERBYTE);")"
        PRINT "      Remove which occurrence ('First', 'Second' or 'Neither')? ";
        INPUT "" Q$
        LET Q$=UPPERCASE$(Q$)
        IF Q$="" OR Q$[1,1]="N" THEN RETURN
        IF Q$[1,1]="F" THEN 405
        IF Q$[1,1]="S" THEN 404
        GOTO 403
    ELSEIF HCN=HCN2 THEN
        REM DIFFERENT DIRECTORY SLOTS POINT TO SAME FILE
        PRINT "(435) ";FNAME2$;...
&             "[";HEX$(DIR2$[:1C])[4,2];"/";HEX$(DIR2$[:1B])[4,2];"/";HEX$(DIR2$[:1D])[4,2];"]";...
&             " and ";FNAME$;...
&             "[";HEX$(EMPTY$[2])[4,2];"/";HEX$(EMPTY$[1])[4,2];"/";HEX$(EMPTY$[3])[4,2];"]"
        PRINT "      have the same Header Cluster (value for DIR:HLCN ";HEX$(BIT);")."
        PRINT "      Delete which file ('First', 'Second' or 'Neither')? ";
        INPUT "" Q$
        LET Q$=UPPERCASE$(Q$)
        IF Q$="" OR Q$[1,1]="N"
        THEN
            REM DON'T DELETE EITHER; QUIT PROCESSING FNAME$
            GOSUB POP 1
            GOTO 22
        FI
        IF Q$[1,1]="F" THEN 430
        ELSEIF Q$[1,1]="S" THEN 420
        ELSE 403 FI
    ELSE
        REM FNAME$ AND FNAME2$ ARE DISTINCT FILES
        PRINT "(413) ";FNAME2$;...
&             "[";HEX$(DIR2$[:1C])[4,2];"/";HEX$(DIR2$[:1B])[4,2];"/";HEX$(DIR2$[:1D])[4,2];"]";...
&             " overlaps ";FNAME$;...
&             "[";HEX$(EMPTY$[2])[4,2];"/";HEX$(EMPTY$[1])[4,2];"/";HEX$(EMPTY$[3])[4,2];"]";...
&             " at LCN ";HEX$(BIT);"."
        PRINT "(414) Deallocate LCN from which file ('First','Second' or 'Neither')? ";
        INPUT "" Q$
        LET Q$=UPPERCASE$(Q$)
        IF Q$="" OR Q$[1,1]="N" THEN RETURN
        IF Q$[1,1]="F" THEN 402
        ELSEIF Q$[1,1]="S" THEN 404
        ELSE 403 FI
    FI

404 REM USER SEZ "REMOVE CLUSTER FROM FNAME$"
    IF HEADERBYTE=0 THEN
        PRINT "(415) That will delete ";FNAME$;"; are you sure? ";
        GOSUB 10000
        IF YES THEN 420 ELSE 403 FI
    ELSE
        REM REMOVE CLUSTER FROM FNAME$
        RESTORE #2,HEADERBYTE+HCN*NBPS*NSPC
        WRITE #2,FFFF$
        NLCNS=IF NLCNS=1 THEN 1 ELSE NLCNS-1 FI
        ACTUALNLCNS=ACTUALNLCNS-1
        LCNS$[1]=MSB(NLCNS)
        LCNS$[2]=LSB(NLCNS)
        GOTO 4010
    FI

405 REM USER SEZ "REMOVE FIRST OCCURRENCE OF CLUSTER FROM FNAME$"
    IF OVERLAPPEDCLUSTERINDEX=0 THEN
        PRINT "(415) That will delete ";FNAME$;"; are you sure? ";
        GOSUB 10000
        IF YES THEN 420 ELSE 403 FI
    ELSE
        REM REMOVE CLUSTER FROM FNAME$
        RESTORE #2,OVERLAPPEDCLUSTERINDEX*2+HCN*NBPS*NSPC
        WRITE #2,FFFF$
        NLCNS=IF NLCNS=1 THEN 1 ELSE NLCNS-1 FI
        ACTUALNLCNS=ACTUALNLCNS-1
        LCNS$[1]=MSB(NLCNS)
        LCNS$[2]=LSB(NLCNS)
        GOTO 4010
    FI

402 REM USER SEZ "REMOVE CLUSTER FROM FNAME2$"
    REM ASSERT: FNAME2$ MUST BE IN DIRECTORY.SYS PRECEDING FNAME$
    REM THEREFORE FNAME2$'S CLUSTERS ARE ALREADY MARKED IN DMAP$ AS OWNED
    IF OVERLAPPEDCLUSTERINDEX=0 THEN
        PRINT "(416) That will delete ";FNAME2$;"; are you sure? ";
        GOSUB 10000
        IF YES THEN 430 ELSE 403 FI
    ELSE
        REM REMOVE OVERLAPPED CLUSTER FROM FNAME2$
        WRITE #2@HCN2*NSPC*NBPS+OVERLAPPEDCLUSTERINDEX*2,FFFF$
        REM ADJUST FNAME2$'S CLUSTER COUNT (ASSERT: CANNOT BECOME ZERO)
        DIR2$[20]=MSB(NLCNS2-1)
        DIR2$[21]=LSB(NLCNS2-1)
        GOSUB ALLOWDIRECTORYUPDATE
        WRITE #1@NCYL,DIR2$
        RETURN
    FI

420 REM USER SEZ TO DELETE FNAME$ ALTOGETHER
    IF HEADERBYTE>0 THEN
        REM SOME OF THE CLUSTERS IN THE HEADER ARE MARKED IN THE MAP
        REM UNMARK THEM
        IF HCN=BIT THEN OVERLAPPEDCLUSTERINDEX=0 ELSE OVERLAPPEDCLUSTERINDEX=2 FI
        RESTORE #2,HCN*NSPC*NBPS+OVERLAPPEDCLUSTERINDEX
        FOR OVERLAPPEDCLUSTERINDEX=OVERLAPPEDCLUSTERINDEX TO HEADERBYTE-2 STEP 2
            READ #2,TWOB$
            LET OVERLAPPEDCLUSTER=TWOB$[1]**8+TWOB$[2]
            IF OVERLAPPEDCLUSTER<>:FFFF
            THEN
                REM RESET BIT IN BIT MAP
                DMAP$[INT(OVERLAPPEDCLUSTER/8)+1]=...
&                    DMAP$[INT(OVERLAPPEDCLUSTER/8)+1]&...
&                    COM(1**(OVERLAPPEDCLUSTER&7))
            FI
        NEXT OVERLAPPEDCLUSTERINDEX
    FI
    REM NOW MARK DIRECTORY ENTRY AS INVALID
    HCSIC$[1]=0
    LCNS$[1]=0
    LCNS$[2]=0
    GOSUB 4010
    REM NOW ABORT THE LOOP THAT INVOKED THIS SUBROUTINE
    GOSUB POP 1
    GOTO 22

430 REM USER SEZ TO DELETE FNAME2$ ALTOGETHER
    REM SO WE MUST MARK FNAME2$'S CLUSTERS AS FREE
    REM (WITH THE EXCEPTION OF THE HEADER CLUSTER)
    RESTORE #2,HCN2*NSPC*NBPS+2
    FOR OVERLAPPEDCLUSTERINDEX=1 TO HCSIC2*NBPS/2-1
        READ #2,TWOB$
        LET OVERLAPPEDCLUSTER=TWOB$[1]**8+TWOB$[2]
        IF OVERLAPPEDCLUSTER<>:FFFF
        THEN
            REM RESET BIT IN BIT MAP
            DMAP$[INT(OVERLAPPEDCLUSTER/8)+1]=...
&                DMAP$[INT(OVERLAPPEDCLUSTER/8)+1]&...
&                COM(1**(OVERLAPPEDCLUSTER&7))
        FI
    NEXT OVERLAPPEDCLUSTERINDEX
    REM NOW MAKE THE DIRECTORY ENTRY GO AWAY
    LET DIR2$[19]=0
    LET DIR2$[20]=0
    LET DIR2$[21]=0
    GOSUB ALLOWDIRECTORYUPDATE
    WRITE #1@NCYL,DIR2$
    RETURN
!^L
500 REM SEARCH DIRECTORY FOR FILE WHICH OWNS CLUSTER NUMBER "BIT"
    REM RETURN WITH NCYL=POINTER INTO DIRECTORY TO FILE FOUND
    ON ERROR GOTO 0
    RESTORE #1,0
501 READ #1,DIR2$
    IF EOF(1) THEN 502
    HCSIC2=DIR2$[19]
    NLCNS2=DIR2$[20]**8+DIR2$[21]
    IF HCSIC2=0 OR NLCNS2=0 THEN 501
    HCN2=DIR2$[17]*256+DIR2$[18]
    RESTORE #2,NSPC*NBPS*HCN2
    FOR OVERLAPPEDCLUSTERINDEX=0 TO HCSIC2*NBPS/2-1
        READ #2,TWOB$
        IF BIT=TWOB$[1]*256+TWOB$[2] THEN 504
    NEXT OVERLAPPEDCLUSTERINDEX
    GOTO 501
502 DIR2$="-VALIDATE-ERROR-"
504 FNAME2$=DIR2$[1,16]
    LEN(FNAME2$)=FIND(FNAME2$," ")
    LET LEN(FNAME2$)=IF LEN(FNAME2$)>0 THEN LEN(FNAME2$)-1 ELSE 16 FI
    NCYL=FILEPOSITION(1)-32
    RETURN
!^L
700 ! IS FILE NAME VALID???
    IF LEN(FNAME$)=0 OR 0=FIND(AZ$,FNAME$[1,1]) THEN LET BAD=1\RETURN
    FOR I=2 TO LEN(FNAME$)
        IF NOT FIND(AZ$,FNAME$[I,1]) AND...
&            NOT FIND(PER09$,FNAME$[I,1])
        THEN BAD=1\RETURN
    NEXT I
    BAD=0
    RETURN

800 ! CHECKS VALIDITY OF DATA IN DIRECTORY ENTRY
    HCN=HCN$[1]**8+HCN$[2]
    HCSIC=HCSIC$[1]
    NLCNS=LCNS$[1]*256+LCNS$[2]
    FSIZE=FSIZE$[1]*256^3+FSIZE$[2]*256^2+FSIZE$[3]*256+FSIZE$[4]
    PROT=PROT$[1]
    DTE=EMPTY$[1]*EMPTY$[2]*EMPTY$[3]
    BAD=0
    IF HCN=0 AND HCSIC>0 OR HCN>=NLCN THEN LET BAD=BAD+1
    IF HCSIC>NSPC THEN LET BAD=BAD+2
    IF NLCNS>=NLCN THEN LET BAD=BAD+4
    IF FSIZE>(HCSIC*NBPS/2-1)*NSPC*NBPS THEN LET BAD=BAD+8
    IF PROT&COM(:41)<>0 THEN LET BAD=BAD+16
    IF DTE=0 THEN LET BAD=BAD+32
    RETURN
!^L
900 ! CORRECTS FILE DIRECTORY DATA
    ON ERROR GOTO 910
    IF NOT(BAD&32) THEN 997
    PRINT "(433) Invalid date...";
    FNAME2$=HEX$(EMPTY$[2])
    BUFFER$=FNAME2$[4,2]CAT "/"
    FNAME2$=HEX$(EMPTY$[1])
    BUFFER$=BUFFER$ CAT FNAME2$[4,2] CAT "/"
    FNAME2$=HEX$(EMPTY$[3])
    PRINT BUFFER$;FNAME2$[4,2]
    INPUT    "      New date: (default is no change) " BUFFER$
    IF BUFFER$="" THEN 997
    ON ERROR GOTO 920
    GOTO    921
920 ON ERROR GOTO 0
    IF    ERR=1 THEN RETURN
    PRINT "      That is not a valid date!"
    GOTO    900
921 EMPTY$[2]=VAL(":" CAT BUFFER$(1,FIND(BUFFER$,"/")-1))
    BUFFER$=RIGHT$(BUFFER$,FIND(BUFFER$,"/")+1)
    EMPTY$[1]=VAL(":" CAT BUFFER$(1,FIND(BUFFER$,"/")-1))
    BUFFER$=RIGHT$(BUFFER$,FIND(BUFFER$,"/")+1)
    EMPTY$[3]=VAL(":" CAT BUFFER$)
    ON ERROR GOTO 910
997 IF 0=BAD&1 THEN 901
    PRINT "(417) The header cluster pointer, DIR:HLCN, is bad."
903 INPUT "(418) Enter a new value for DIR:HLCN (default is no change)? " Q$
    IF Q$="" THEN 901
    ON ERROR GOTO 902
    HCN=VAL(Q$)
    HCN$[1]=MSB(HCN)\HCN$[2]=LSB(HCN)
    ON ERROR GOTO 910\GOTO 901
902 ON ERROR GOTO 910
    IF ERR<>7 THEN 910
    PRINT "(419) What?"
    GOTO 903
901 IF 0=BAD&2 THEN 904
    PRINT "(420) DIR:HCSIC (";HCSIC;") is illegal."
906 INPUT "(421) Enter new value for DIR:HCSIC (default is no change)? " Q$
    IF Q$="" THEN 904
    ON ERROR GOTO 905
    HCSIC=VAL(Q$)
    HCSIC$[1]=HCSIC
    IF HCSIC>NSPC OR HCSIC<=0 THEN 911
    GOTO 904
905 ON ERROR GOTO 910
    IF ERR<>7 THEN 910
911 PRINT "(422) Huh?"
    GOTO 906
904 ON ERROR GOTO 910
    IF 0=BAD&8 THEN 907
    PRINT "(423) DIR:FILESIZE says file has";FSIZE;"bytes, which is impossible."
    FSIZE=(HCSIC*NBPS/2-1)*NSPC*NBPS
    PRINT "(424) Size reduced to";FSIZE;"bytes."
    FSIZE$[1]=MSB(MSB(MSB(FSIZE)))
    FSIZE$[2]=LSB(MSB(MSB(FSIZE)))
    FSIZE$[3]=LSB(MSB(FSIZE))
    FSIZE$[4]=LSB(FSIZE)
907 IF 0=BAD&16 THEN 909
    PRINT "(425) File has invalid DIR:PROTECTION."
    PRINT "      Enter 'W' for Write protect and/or 'B' for Backup protect"
    INPUT "(426) (Default is no protection): " Q$
    LET Q$=UPPERCASE$(Q$)
    PROT=(:40*SGN(FIND(Q$,"W")))!(:1*SGN(FIND(Q$,"B")))
    PROT$[1]=PROT
909 RETURN

910 ON ERROR GOTO 0
    IF ERR=1 AND ELN=10000
    THEN NO=0 \ YES=0\ RETURN \ ! ESCAPE AT 10000 IS SAME AS HITTING RETURN
    IF ERR=1 THEN RETURN ELSE ERROR
!^L
2000 IF BADHCN<>-1 THEN 2100
    PRINT "(427) Remove all bad cluster pointers? ";
    GOSUB 10000
    IF NOT NO THEN LET BADHCN=1 ELSE LET BADHCN=0
2100 IF BADHCN=1 THEN 2200
    PRINT "(428) Remove the cluster pointer? ";
    GOSUB 10000\IF NO THEN RETURN
2200 RESTORE #2,NBPS*NSPC*HCN+HEADERBYTE
2201 WRITE #2,FFFF$
    RETURN

10000 INPUT "" Q$
    NO=0\YES=0
    IF Q$="" THEN RETURN
    LET Q$=UPPERCASE$(Q$[1,1])
    IF Q$="Y" THEN LET YES=1\RETURN
    IF Q$="N" THEN LET NO=1\RETURN
    PRINT "(429) Answer 'YES', 'NO', or <cr> only, please: ";
    GOTO 10000

3000 PRINT "(430) Delete the file (Default=NO)? ";\GOSUB 10000
    HCSIC$[1]=HCSIC$[1]*NOT YES
    RETURN

4000 IF HCSIC$[1]=0 THEN 4010\! THE GUY SAID DELETE AWAY, SO SKIP ASKING HIM
    PRINT "(431) Update the directory entry (Default=YES)? ";\GOSUB 10000
    IF NO THEN RETURN
4010 ! We must update the directory entry.
    GOSUB ALLOWDIRECTORYUPDATE \ ! Prevent SDOS from getting excited.
    X=LEN(FNAME$)
    LEN(FNAME$)=16
    WRITE #1@DIRECTORYSLOT,FNAME$,HCN$,HCSIC$,LCNS$,FSIZE$,PROT$,EMPTY$
    LEN(FNAME$)=X
    RETURN

ALLOWDIRECTORYUPDATE: ! ALLOW US TO MODIFY THE DIRECTORY
    SYSCALL #1,CCSETFILEPROT$,NOPROTECT$
    UNPROTECTED=TRUE \ ! REMEMBER WE MUST RE-PROTECT THE FILE
    RETURN

END
