!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                                                                             !
!      MDOS utility program...                                                !
!      supports 7 commands;
!
!                DIR
!                COPY (with "," to MDOS)  ( new as of version 2.0 )
!                COPY (with " TO " to SDOS)
!                DELETE (delete sdos file)
!                DEL  (delete mdos file)
!                DISMOUNT (dismounts and reselects MDOS disk)
!                EXIT
!                                                                             !
!      EXIT and DIR are simple...                                             !
!      COPY from mdos performs conversion and translation for the following
!      file types;
!                                                                             !
!      ASCII  -Uncompresses spaces                                            !
!      LOAD   -Produces SDOS load records                                     !
!      OTHER  -Just does an exact copy                                        !
!
!      COPY "," to MDOS assumes ASCII with uncompressed spaces
!                                                                             !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!       1/27/81  1.0c Recompiled for Basic14h

!       3/19/84  2.0 version containing code to write MDOS files
!                    from SDOS (fast) by Ron Whites

!       12/18/85 2.1 version containing code delete files and dismount/remount
!                    by Ron Whites

!       4/9/86   2.2 fixed multiple of 128 byte filesize SDW logical sector
!                    fixed delete so deletes with :ff,:ff instead of 0
!                    over first bytes of directory name
!                    fixed deleting 1 to few allocation bits
!                    SDW contains contigious clusters - 1 !!!

!       DIMS FOR ASCII OUTPUT ROUTINE
        DIM     SPACES,SPACE$/" "/


        DIM     SPACES$/"                  "/,MDOSNAME$[10]
        DIM     DIRECTORYENTRY$[16],I,DISK$[100],defaultdisk$[20]
        DIM     FIRSTTIME/128/
        DIM     FROM$[100], DEST$[100]
        DIM     SDW$[2], JUNKTWO$[2], RIB, CURRIB
        DIM     NUMBERBYTESLEFT, NUMBERBYTES$[1]
        DIM     LOADAD$/0,0/, STARTAD$/0,0/, LOADGOREC$/3/, STARTREC$/1/
        DIM     BYTE$/0/, X
        DIM     FILELEN
        dim     ff$(2)/:ff,:ff/

!       FILE TYPES

        DIM     TYPELOAD/1/, TYPEBINARY/2/, TYPEASCII/3/, TYPEOTHER/4/
        DIM     LOAD/0/, BINARY/0/, ASCII/0/, OTHER/0/
        DIM     FILETYPE/0/

!       VARIABLES FOR RLOAD OUTPUT ACCESS ROUTINE
        DIM     BINARYSTATE, BINARYI, BINARYJ

   Dim Directory$[2560],ClusterAllocationSector$[128]
   Dim ClusterHeader$[128],Cluster$[512],SDOSFilename$(20),MDOSFilename$(20)
   Dim Temp$(16),newspaces$(8),bigspaces$(10),type$(1)
   Dim GetFileSize$/:f,:e,0,3/,unlock$/:e,4,0,:10/,getdevicetype$/:f,:e,:0,:4/
   Dim Dismount$/:e,4,0,:11/

        DEF     MSB(XX)=INT(XX/256)
        DEF     LSB(XXX)=INT(XXX-MSB(XXX)**8)

   len(clusterheader$) = 128
   len(ff$) = 2

   defaultdisk$ = "SD1:"

999     PRINT   "MDOS Utility 2.2-6800 Copyright Software Dynamics 1986"
   rem note: -6800 is because STARTREC$ = 1 instead of 2
        print

5000  print "What disk is the MDOS disk <";defaultdisk$;"> ? ";
      input "" disk$
      if disk$="" then disk$ = defaultdisk$
   Open #1, disk$

   syscall #1,getdevicetype$,"",type$

   if type$(1) > 1
   then
       close #1
       print disk$;" is not a disk or filename, try again!"
       goto 5000
   fi

!  type 0 is a file, 1 is a disk device
   if type$(1) = 1
   then
       syscall #1,dismount$
       syscall #1,unlock$
   fi

   defaultdisk$ = disk$
   read #1@0,temp$
   print "volume name >";temp$;"<"
   if temp$(1,4) <> "MDOS"
   then
!       if type$(1) = 1
!       then
!          syscall #1,dismount$
!       fi
!       close #1
!       print disk$;" is not a MDOS disk try again!"
!       print "note: first data on disk not 'MDOS'"
!       print "      you must DOSGEN with disk i.d. = 'MDOS...'"
!       goto 5000
   fi

!  Load directory and set free directory slot search to start at 0
   Read #1@128*3,Directory$

1      print
       INPUT   "= " DISK$
        IF      DISK$="" THEN 1
        LET DISK$=UPPERCASE$(DISK$)

        IF      FIND(DISK$,"DIR")=1
        THEN    GOSUB 3141 \
                GOTO 1

        IF      FIND(DISK$,"COPY")=1
        THEN    GOSUB 3000 \
                GOTO 1
        IF      FIND(DISK$,"EXIT")=1
        THEN
!  type 0 is a file, 1 is a disk device
          if type$(1) = 1
          then
              syscall #1,dismount$
              print "MDOS disk dismounted"
          fi
        EXIT
        FI

        if      find(disk$,"DELETE")=1
        then
           gosub deletesdosfile
           goto 1
        fi
        if      find(disk$,"DEL")=1
        then
           gosub delmdosfile
           goto 1
        fi
        if      find(disk$,"DISMOUNT")=1
        then
           gosub dismountmdosdisk
           goto 5000
        fi

        PRINT
        Print   Disk$;" is an illegal command, try the following;"
        print
        PRINT   "COPY <sdos>,<mdos>     copy from SDOS ascii file to MDOS"
        print   "DEL <mdos>             deletes MDOS file"
        PRINT   "DIR                    directory listing of mdos disk"
        PRINT   "COPY <mdos> TO <sdos>  copy from mdos to sdos disks"
        print   "DELETE <sdos>          deletes sdos file"
        print   "DISMOUNT               releases MDOS diskette"
        PRINT   "EXIT                   EXIT utility"
        PRINT
        GOTO    1

3141    FOR     I=1 TO 160
        DIRECTORYENTRY$  =DIRECTORY$[(I-1)*16+1,16]
        IF DIRECTORYENTRY$[1]<>:FF AND DIRECTORYENTRY$[1]<>0
        THEN    PRINT DIRECTORYENTRY$[1,8];".";DIRECTORYENTRY$[9,2];"    ";
        IF      COL(0)>80-15 THEN PRINT
        NEXT    I
        IF COL(0)>5 THEN PRINT
        RETURN

3000    FIRSTTIME=128
        BINARY=0 \ LOAD=0 \ ASCII=0 \ OTHER=0 \ FILETYPE=0
        DISK$   =RIGHT$(DISK$,6)
        I       =FIND(DISK$," TO ")
        IF      I=0 THEN goto SDOS2MDOSWRITE
        FROM$   =left$(DISK$,I-1)
        DEST$   =right$(DISK$,I+4)

!D!     print i
!D!     print "from$ ";from$
!D!     print "dest$ ";dest$

        I       =FIND(FROM$,".")
        IF      I=0 THEN I=LEN(FROM$)
        MDOSNAME$       =LEFT$(FROM$,I-1)
        MDOSNAME$       =MDOSNAME$ CAT SPACES$[1,9-I]
        MDOSNAME$       =MDOSNAME$ CAT RIGHT$(FROM$,I+1)
        MDOSNAME$       =MDOSNAME$ CAT ...
&               SPACES$[1,10-LEN(MDOSNAME$)]


        FOR     I=1 TO 160
        DIRECTORYENTRY$  =DIRECTORY$[(I-1)*16+1,16]
        IF DIRECTORYENTRY$[1]<>:FF AND DIRECTORYENTRY$[1]<>0
        THEN    IF DIRECTORYENTRY$[1,10]=MDOSNAME$ THEN 100
        NEXT    I
        PRINT   "File not found"
        RETURN


!       FIRST, DETERMINE FILE TYPE...
100     ! IF DIRECTORYENTRY$[:D]&7=3
!       THEN    BINARY=1 \
!               FILETYPE=TYPEBINARY \
!               !       FILE IS RELOCATABLE
!       NO CONVERSIONS ANY MORE!

        IF DIRECTORYENTRY$[:D]&:17=:12
        THEN    LOAD=1 \
                FILETYPE=TYPELOAD \
                !       FILE IS  A LOAD FILE

        IF DIRECTORYENTRY$[:D]&7=5
        THEN    ASCII=1 \
                FILETYPE=TYPEASCII \
                !       FILE IS AN ASCII TEXT FILE

        IF FILETYPE=0
        THEN    OTHER=1 \
                FILETYPE=TYPEOTHER \
                !       FILE TYPE IS UNKNOWN

!       NEXT, DETERMINE RIB DATA
!D!        PRINT HEX$(DIRECTORYENTRY$[11]);HEX$(DIRECTORYENTRY$[12])
        RIB     =DIRECTORYENTRY$[11]**8+DIRECTORYENTRY$[12]


        if error when open #2,dest$
        then
           if err = 1011
           then
               CREATE  #2, DEST$
           else
               print err;"error encountered, file not copied!"
               return
           fi
        else
           close #2
           print "filename already present, you must use DELETE first"
           return
        fi

!D!        PRINT "LOCATION OF HEADER ";HEX$(RIB);RIB
!D!        PRINT "FILETYPE ";FILETYPE
        RIB     =RIB*128

!       BYTE OFFSET

        POSITION        #1, RIB
110     READ    #1, SDW$
!D!        PRINT HEX$(SDW$[1]);HEX$(SDW$[2])
        IF SDW$[1]&:80=0 THEN 110

        FILELEN =(SDW$[1]&:7F)**8+SDW$[2]+1
        FILELEN =FILELEN*128
!D!        print "FILELEN " ;FILELEN

        IF NOT(LOAD) THEN 120

        POSITION        #1, RIB+117
        READ    #1, NUMBERBYTES$
        READ    #1, JUNKTWO$
        READ    #1, LOADAD$
        READ    #1, STARTAD$

        WRITE   #2, STARTREC$
        WRITE   #2, STARTAD$
        STARTAD$[1]=STARTAD$[1] XOR :FF
        STARTAD$[2]=STARTAD$[2] XOR :FF
        WRITE   #2, STARTAD$
        WRITE   #2, LOADGOREC$
        WRITE   #2, LOADAD$
        FILELEN =FILELEN-128+NUMBERBYTES$[1]
!D!     PRINT "LEN OF FILE ";HEX$(FILELEN);FILELEN

        JUNKTWO$[1]=MSB(FILELEN)
        JUNKTWO$[2]=LSB(FILELEN)
        WRITE   #2, JUNKTWO$

120     ! PLAIN VANILLA COPY

        NUMBERBYTESLEFT =0
        CURRIB  =RIB

        FOR     I=1 TO FILELEN
        GOSUB   1000
        GOSUB   2000
        NEXT    I

        CLOSE   #2
        RETURN

1000    IF      NUMBERBYTESLEFT=0 THEN 1100
        READ    #1, BYTE$
        NUMBERBYTESLEFT=NUMBERBYTESLEFT-1
        RETURN

1100    POSITION        #1, CURRIB
        CURRIB=CURRIB+2
        READ    #1, SDW$
        NUMBERBYTESLEFT=(SDW$[1]&:7C)*128-FIRSTTIME+128*4
        POSITION        #1, 128*(SDW$[2]+(SDW$[1]&:3)**8)*4+FIRSTTIME
!D!        PRINT "NUMBER OF BYTES LEFT ";NUMBERBYTESLEFT
!D!        PRINT "AT ";128*(SDW$(2)+(SDW$(1)&:3)**8)*4+FIRSTTIME
        FIRSTTIME=0
        GOTO    1000

2000    ! GET RID OF BYTE
        ON FILETYPE GOTO 2100,2200,2300,2400
        STOP

2100    ! LOAD FILE OUTPUT ROUTINE
        WRITE   #2, BYTE$
        RETURN

2200    ! BINARY FILE OUTPUT
        ON BINARYSTATE GOTO 2210, 2220, 2230

2210    IF BYTE$(1)<>:44 THEN RETURN

        BINARYSTATE=2
        RETURN
2220    BYTE$(1)=BYTE$(1)-1
        WRITE   #2, BYTE$
        BINARYJ =BYTE$(1)
        FOR     BINARYI=1 TO BINARYJ
        BINARYSTATE=3
        RETURN
2230    WRITE   #2, BYTE$
        NEXT    BINARYI
        BINARYSTATE=1
        RETURN


2300    ! ASCII FILE OUTPUT ROUTINE

        IF BYTE$(1)=0 THEN RETURN
        IF BYTE$(1)&:80<>0
        THEN    FOR SPACES=1 TO BYTE$(1)&:7F \
                        PRINT #2,SPACE$;\
                NEXT SPACES
        ELSE    PRINT #2,BYTE$;
        RETURN

2400    ! OTHER TYPE OUTPUT ROUTINE
        WRITE   #2, BYTE$
        RETURN


! code added for version 2.0 follows

SDOS2MDOSWRITE:
       i = find(disk$,",")
       if i < 2
       then
           print "WHAT??"
           return
       fi
       sdosfilename$= left$(disk$,i-1)
       mdosfilename$= right$(disk$,i+1)
!D!    print i
!D!    print "sdosfilename$= ";sdosfilename$
!D!    print "mdosfilename$= ";mdosfilename$

!  Open sdos file and get its byte size

   Open #2,SDOSFilename$
   Syscall #2,GetFileSize$,"",Temp$
   sdosfilesize = Temp$(4)+Temp$(3)*256+Temp$(2)*65536+Temp$(1)*16777216

!  Set simulated column count to zero (this is used to convert TABs
!  to MDOS compressed blanks by TABCONVERT subroutine)
   ColumnCount=0

!  Determine if enough free clusters to hold file are available
!  Also build clusterheader and set bits in allocation array

!  Load cluster allocation sector each time before write
!  so in case previous copy abort (not enough space?) do not
!  reuse dirty map

   Read #1@128*1,ClusterAllocationSector$

   clusterheaderlocation = 1
   clusternumber = -1
   bitnumber = 0
   bitmask = 128
   FreeBytes = 0
   j = 1
   numberofclustergroups = 0
   newclustergroup = true
   For byte = j to 128
       While Bitmask >= 1 Do
          if ClusterAllocationSector$(byte)&Bitmask = 0
          Then
! when cluster bit not allocated
           if newclustergroup = true
           then
! when have not allocated from this cluster group yet
! set group size to 1 for start, determine starting cluster number
! set up for storing in clusterheader
               let clustergroupsize = 1
               let clusternumber = (byte-1) * 8 + bitnumber
               numberofclustergroups = numberofclustergroups + 1
               newclustergroup = false
               if numberofclustergroups > 57
               then
                   print "Disk too fragmented to transfer file that large"
                   close #2
                   return
               fi
           else
! when allocating from cluster group
! update number of clusters in group
               let clustergroupsize = clustergroupsize + 1
!*
               if clustergroupsize = 32
               then
! When cluster allocated and have just finished allocating clustergroup
! because max size SDW group size of 32 reached build sdw

               ClusterHeader$(clusterheaderlocation+1) = clusternumber & :FF
               Clustergroupsize = (Clustergroupsize - 1) ** 10
               Clusternumber = Clusternumber & :0300
               Clustergroupsize = Clustergroupsize + clusternumber
               ClusterHeader$(clusterheaderlocation) = Clustergroupsize ** -8
               clusterheaderlocation = clusterheaderlocation + 2
               clusternumber = -1
               newclustergroup = true
               fi
!*
           fi
           FreeBytes = FreeBytes + 512
 let ClusterAllocationSector$(byte) = ClusterallocationSector$(byte) XOR bitmask
           if FreeBytes-128 >= sdosfilesize then goto foundspace fi
          ElseIf clusternumber > -1
          Then
! When cluster allocated and have just finished allocating clustergroup
! Save in cluster header
           ClusterHeader$(clusterheaderlocation+1) = clusternumber & :FF
           Clustergroupsize = (Clustergroupsize - 1) ** 10
           Clusternumber = Clusternumber & :0300
           Clustergroupsize = Clustergroupsize + clusternumber
           ClusterHeader$(clusterheaderlocation) = Clustergroupsize ** -8
           clusterheaderlocation = clusterheaderlocation + 2
           clusternumber = -1
           newclustergroup = true
          Fi
! Shift bit mask and bit number
          BitMask = BitMask/2
          bitnumber = bitnumber + 1
       End
! new byte in allocation sector reset
      bitnumber = 0
      let bitmask = 128
   Next byte
   print "Not enough space"
   close #2
   return

foundspace:
   if newclustergroup = false
   then
! when have found all space needed and didnot just build sdw
! because hit max group size of 32 (newclustergroup forced to true) then
! build last sdw
       ClusterHeader$(clusterheaderlocation+1) = clusternumber & :FF
       Clustergroupsize = (Clustergroupsize - 1) ** 10
       Clusternumber = Clusternumber & :0300
       Clustergroupsize = Clustergroupsize + clusternumber
       ClusterHeader$(clusterheaderlocation) = Clustergroupsize ** -8
       clusterheaderlocation = clusterheaderlocation + 2
   fi

   i = int(sdosfilesize/128)
rem rcw fix for illegal SDW terminator when file copied a even mult of 128
   if i = sdosfilesize/128 then let i = i - 1

! put terminator on SDW with logical EOF

   ClusterHeader$(clusterheaderlocation) = (i ** -8) xor :80
   ClusterHeader$(clusterheaderlocation+1) = i & :FF
   clusterheaderlocation = clusterheaderlocation + 2

!D!   print "sdos filesize " ;sdosfilesize
!D!   print "cluster groups " ;numberofclustergroups
!D!   print "bytes in clusters allocated " ;freebytes

! determine if free slot
! search full directory to determine if same name
   bigspaces$ = "          "
   newspaces$ =    "        "
   i = find(mdosfilename$,".")
   if i > 0
   then
temp$=left$(mdosfilename$,i-1) cat right$(newspaces$,i) cat right$(mdosfilename$,i+1)
   else
temp$=mdosfilename$ cat left$(bigspaces$,10-len(mdosfilename$))
   fi
   freedirectory = 0
   madedeleted = 0
   freeslots = 0
   for i = 1 to len(directory$) step 16
     if directory$(i) = :00 or directory$(i) = :ff
     then
       freeslots = freeslots + 1
       if freedirectory =0 then freedirectory = i fi
! if not ever used, or not fully deleted according to version 2.2 repair
! then make it so
       if directory$(i) = :00 or directory$(i+1) <> :ff
       then
!  will mark deleted entries as never used, to trick mdos
!  hashing to continue sequential search for filenames we place
!  if madedeleted true and will write file, then we update
! entired directory area
           madedeleted = madedeleted + 1
           directory$(i) = :ff
           directory$(i+1) = :ff
       fi
     else
       if temp$ = directory$(i,10) then
          print "filename already present, you must use DEL first"
          close #2
          return
       fi
     fi
   next i

   if freedirectory = 0
   then
       print "no available directory space"
       close #2
       return
   fi

!D!   print "directory slots free " ;freeslots
!D!   print "slots marked deleted " ;madedeleted

! zero pad rest of header
   i = clusterheaderlocation
   while i < 129 do
     let clusterheader$(i) = :00
     let i = i + 1
   end

! put bytes in last sector
! note: this is only for binary files
!   clusterheader$(118) = sdosfilesize - ((int(sdosfilesize/128)) * 128)
!   print "bytes in last sector " ;clusterheader$(118)

   let cluster$ = clusterheader$

! write sdos file over mdos disk using clusterheader info

   cluster$ = clusterheader$
!D!   print "clusterheaderlocation ";clusterheaderlocation
   for i = 1 to clusterheaderlocation-4 step 2
       clusternumber = clusterheader$(i)*256 + clusterheader$(i+1)
! clustergroupsize in bytes
       clustergroupsize = ((clusternumber & :7C00)** - 10)*512 + 512
       clusternumber = clusternumber & :03FF
!D!       print
!D!       print "clusternumber ";clusternumber
!D!       print "bytes in cluster ";clustergroupsize

       for bytes = 0 to clustergroupsize-512 step 512
!         append to cluster$ filling up with 512 bytes
          if len(cluster$) = 128
          then
              len(cluster$) = 512
              read #2,cluster$(129,512-128)
           ! if subcripted read would not result in 512 byte cluster
           ! set down to real size so padding below will work
        if sdosfilesize < 512-128 then let len(cluster$) = sdosfilesize+128 fi
          else
              read #2,cluster$
          fi
!D!          print "write location ";clusternumber*512+bytes
          if len(cluster$) < 512
          then
!D!          print "padding with ";512-len(cluster$);" null bytes to finish file"
             for j = len(cluster$)+1 to 512
               cluster$(j) = :00
             next j
             let len(cluster$)=512
          fi
          call TabConvert(Cluster$) \ ! convert tabs to MDOS compressed blank
          write #1@clusternumber*512+bytes,cluster$
       next bytes
   next i
   clusternumber = (clusterheader$(i)*256 + clusterheader$(i+1)) &:7ff
!D!   print "last logical sector ";clusternumber

! flush written sectors

! if no write errors;
!      update map
          write #1@128*1,ClusterAllocationSector$

!      build directory entry
       directory$(freedirectory,10)=temp$
temp=( ( (Clusterheader$(1) & :03) ** 8) + Clusterheader$(2)) ** 2
!D!print "sector address of first cluster ";temp
       directory$(freedirectory+10) = temp ** -8
       directory$(freedirectory+11) = temp & :ff
       directory$(freedirectory+12) = 5
       for i = freedirectory+13 to freedirectory+14
          directory$(i) = 0
       next i

!      write directory entry from directory array
       if madedeleted = 0
       then
          write #1@128*3+freedirectory-1,directory$(freedirectory,16)
       else
          write #1@128*3,directory$
!D!       print "updated with deleted directory slots"
       fi
!D!       print "directory slot= ";freedirectory
       close #2
       return

Subroutine TabConvert(TabConvert$)
   ! This subroutine converts TAB characters into MDOS compressed blanks.
   ! It modifies the argument string, replacing the TABs.
   ! At entry, ColumnCount holds the column number that the 1st character
   ! of the argument string belongs in.

   For TabScan=1 to len(TabConvert$)
       If TabConvert$(TabScan) >= :20
       then
           ! Printing character, advance the column count
           ColumnCount=ColumnCount+1
           if columncount = 1 and tabconvert$(tabscan) = :3b
           then
               tabconvert$(tabscan) = :2a
!              print "; to *"
           fi
       elseif TabConvert$(TabScan) = :0D
       then
           ! End of line, zero the column count
           ColumnCount=0
       elseif TabConvert$(TabScan) = :09
       then
           ! Aha! a TAB character we must replace
           ! Replace by MDOS compressed blank with enough spaces...
           ! to get us to next multiple-of-8 tab column
           TabConvert$(TabScan)=:80+(8-(ColumnCount&7))
           ColumnCount=(ColumnCount!7)+1 \ ! advance to multiple of 8
       Else
           ! Unprintable character, MDOS prints as "%"
           ColumnCount=ColumnCount+1
       Fi
   Next TabScan
   Return Subroutine
End


dismountmdosdisk:

!  type 0 is a file, 1 is a disk device
          if type$(1) = 1
          then
              syscall #1,dismount$
              print "MDOS disk dismounted"
          fi
          close #1
          return


deletesdosfile:
        FROM$   =RIGHT$(DISK$,8)
        if error when delete from$
        then
           print "no such file, not deleted"
        fi
        return

delmdosfile:

        FROM$   =RIGHT$(DISK$,5)
        I       =FIND(FROM$,".")
        IF      I=0 THEN I=LEN(FROM$)
        MDOSNAME$       =LEFT$(FROM$,I-1)
        MDOSNAME$       =MDOSNAME$ CAT SPACES$[1,9-I]
        MDOSNAME$       =MDOSNAME$ CAT RIGHT$(FROM$,I+1)
        MDOSNAME$       =MDOSNAME$ CAT ...
&               SPACES$[1,10-LEN(MDOSNAME$)]

        FOR     I=1 TO 160
        directorylocation = i
        DIRECTORYENTRY$  =DIRECTORY$[(I-1)*16+1,16]
        IF DIRECTORYENTRY$[1]<>:FF AND DIRECTORYENTRY$[1]<>0
        THEN    IF DIRECTORYENTRY$[1,10]=MDOSNAME$ THEN foundmdosfile
        NEXT    I
        PRINT   "File not found"
        RETURN

foundmdosfile:

!       NEXT, DETERMINE RIB DATA

!D!        PRINT HEX$(DIRECTORYENTRY$[11]);HEX$(DIRECTORYENTRY$[12])
        RIB     =DIRECTORYENTRY$[11]**8+DIRECTORYENTRY$[12]

!D!        PRINT "LOCATION OF HEADER ";HEX$(RIB);RIB
!D!        PRINT "FILETYPE ";FILETYPE
        RIB     =RIB*128

!       BYTE OFFSET

        Read #1@128*1,ClusterAllocationSector$

        POSITION        #1, RIB
delmdosloop:
        READ    #1, SDW$
!        PRINT HEX$(SDW$[1]);HEX$(SDW$[2]);
  IF SDW$[1]&:80=0
  THEN
        startingcluster = (sdw$(1)*256+sdw$(2))&:3ff
        contclusters =  ((sdw$(1)&:7C)/4)+1

  for i = startingcluster to (startingcluster + contclusters - 1)
       i1=(int(i/8))+1
! i1= relative byte in allocation sector
       i2=(128**(-(i&7)))
! i2= starting relative bit
       i3 = clusterallocationsector$(i1)
! i3= allocation byte
       i4 = (i3 & i2)
! i4= equals bit
       if i4 <> 0
       then
!        print "match"
        clusterallocationsector$(i1) = i3 - i2
       else
        print "file not deleted because mdos disk needs REPAIR"
        return
       fi
  next i
        goto delmdosloop
  fi

       i = directorylocation
         DIRECTORY$[(directorylocation-1)*16+1] = :ff
         DIRECTORY$[(directorylocation-1)*16+2] = :ff
        write #1@(128*3)+((directorylocation-1)*16),ff$(1,2)
        write #1@128*1,ClusterAllocationSector$

        return

        END
