CP/M/CPM_CDROM.iso/cpm/utils/dskutl/swp-ms10.ark/TRAMDF.IF3

Text File | 1989-09-27 | 22KB | 573 lines

{* -------------------------------------------------------------------------
 *                    M S - D O S   F I L E   S Y S T E M
 * ------------------------------------------------------------------------- *}

{*
 * The MS-DOS 'file system' contains the basic directory manipulations, that
 * is searching through the directory, and the basic file manipulation, such
 * as writing, reading and deleting an MS-DOS file.
 *}

function GetMsdosFileName : FullFileNames ;
{*
 * Build the file name with the '.' separator before the extension field.
 *}
begin
   GetMsdosFileName:= Copy( MsdosFcb^.FileName, 1, 8 ) + '.' +
                      Copy( MsdosFcb^.FileName, 9, 3 ) ;
end ;  { of GetMsdosFileName }

procedure GetNextDirEntry( var Status: EntryTypes ) ;
{*
 * Locate the next file entry in the (sub)directory of an MS-DOS file
 * system.  The entry of the directory is made accessible via MsdosFcb.
 * In case of an error, an EndOfDirectory status will be returned.
 *}
begin
   Status:= EndOfDirectory ;  { Set default status }
   if DirectorySearchPos=AfterLastEntry then  Exit ;
{*
 * If at the beginning of a search through the (sub)directory, preset the
 * variables such that the first sector of the (sub)directory will be read.
 *}
   if DirectorySearchPos=BeforeFirstEntry then
    begin
     DirectoryCluster:= DirectoryStartCls ;
     if DirectoryStartCls=0 then  { search the root directory }
      begin
       DirectoryCluster :=               $FFF ;  { For EndOfDirectory test }
       DirectoryStartSct:= RootDirectoryStart ;
       DirectorySize    := RootDirectorySize  ;
      end
     else { if not in root directory then }
      begin
       DirectoryStartSct:= FirstDataSector +
                           (DirectoryCluster-2)*SectorsPerCluster ;
       DirectorySize    := SectorsPerCluster ;
      end ;  { of else }
     DirectoryOrdinal  := FcbsPerSector ;
     DirectorySector   := Pred( DirectoryStartSct ) ;
     DirectorySearchPos:= InSubDirectory ;
    end ;  { of if }
{*
 * Fetch the next entry from the (sub) directory.  First of all, determine
 * the ordinal, the sector and the cluster of the next directory entry.
 *}
   DirectoryOrdinal:= Succ( DirectoryOrdinal ) ;
   if DirectoryOrdinal>=FcbsPerSector then
    begin
     DirectorySector:= Succ( DirectorySector ) ;
     if DirectorySector>=(DirectoryStartSct+DirectorySize) then
{*
 * The end of a set of directory sectors has been reached. If in the root
 * directory, this means that the end of the (root)directory is reached.
 * However, if in a subdirectory, there might be another cluster with
 * directory information. The availability of additional information is
 * set in variable DirectoryCluster.
 *}
      begin
       if DirectoryStartCls<>0 then
         DirectoryCluster:= GetFatEntry( DirectoryCluster ) ;
       if DirectoryCluster>ClustersPerDisk then
        begin
         DirectorySearchPos:= AfterLastEntry ;
         Exit ;
        end
       else  { there is another cluster in the subdirectory }
        begin
         DirectoryStartSct:= FirstDataSector +
                             (DirectoryCluster-2)*SectorsPerCluster ;
         DirectorySize    := SectorsPerCluster ;
        end ;  { of else }
      end ;  { of if }
{*
 * The address of the next (sub)directory sector is determined.  Go read it.
 *}
     ReadSector( DirectorySector, Addr(DirBuffer) ) ;
     if ErrorDetected then
      begin
       BuildErrorTrace( 'GetNDE_' ) ;
       Exit ;
      end ;  { of if }
     DirectoryOrdinal:= 0 ;
    end ;  { of if }
{*
 * The sector with the next directory entry is in the directory buffer.
 * Determine its address and its attributes (status).
 *}
   MsdosFcb:= Ptr( Addr(DirBuffer) + BytesPerFcb*DirectoryOrdinal ) ;
   case MsdosFcb^.FileName[1] of
     #$00 : Status:= UnusedEntry ;
     #$E5 ,
     #$F6 : Status:= FreeEntry ;
   else
     Status:= FileNameEntry ;
     if SubDirectory in MsdosFcb^.Attribute then
       Status:= SubDirectoryNameEntry ;
     if Volume in MsdosFcb^.Attribute then
       Status:= VolumeNameEntry ;
   end ;  { of cases}
end ;  { of GetNextDirEntry }

function LocateMsdosDirectory: Boolean ;
{*
 * Search the current MS-DOS (sub)directory for a subdirectory. The name of
 * the subdirectory is supplied in the current file entry.  If found,
 * the returned value is True and the global variable MsdosFcb is set.  In
 * case of an error, a False value will be returned.
 *}
var
   EntryType: EntryTypes ;  { Type of located file-entry }
   Found    :    Boolean ;  { Result of this function so far }
begin
   DirectorySearchPos:= BeforeFirstEntry ;
   Found:= False ;  { Preset result of search }
   repeat
     GetNextDirEntry( EntryType ) ;
     if EntryType=SubDirectoryNameEntry then
       Found:= ( FileEntry^.Name = MsdosFcb^.FileName ) ;
   until Found or (EntryType in [UnusedEntry,EndOfDirectory]) ;
   if ErrorDetected then
     BuildErrorTrace( 'LocMD_' ) ;
   LocateMsdosDirectory:= Found ;
end ;  { of LocateMsdosDirectory }

function LocateMsdosFile: Boolean ;
{*
 * Search the current MS-DOS (sub)directory for a file; The name of the
 * file is supplied in the current file entry.  If found,
 * the returned value is True and the global variable MsdosFcb is set.  In
 * case of an error, a False value will be returned.
 *}
var
   EntryType: EntryTypes ;  { Type of located file-entry }
   Found    :    Boolean ;  { Result of this function so far }
begin
   DirectorySearchPos:= BeforeFirstEntry ;
   Found:= False ;  { Preset result of search }
   repeat
     GetNextDirEntry( EntryType ) ;
     if EntryType=FileNameEntry then
       Found:= ( FileEntry^.Name = MsdosFcb^.FileName ) ;
   until Found or (EntryType in [UnusedEntry,EndOfDirectory]) ;
   if ErrorDetected then
     BuildErrorTrace( 'LocMF_' ) ;
   LocateMsdosFile:= Found ;
end ;  { of LocateMsdosFile }

procedure DeleteMsdosFile ;
{*
 * Delete the file, associated with the current filelist entry, from the
 * MS-DOS directory.  The directory and the FAT('s) on the disk are updated.
 *}
var
   NextName : FileDescriptors ;  { File name from directory entry }
   ThisEntry:         Integer ;  { Ordinal of cluster to be released }
   NextEntry:         Integer ;  { Ordinal of next cluster in chain }
begin
   SplitFileName( AMsdosFileName, GetFileEntryName ) ;
{*
 * Check the current MS-DOS file entry for a match.  This could save some
 * searching through the MS-DOS directory.
 *}
   SplitFileName( NextName, GetMsdosFileName ) ;
   if not SameName( NextName, AMsdosFileName, NE_Format ) then
{*
 * Search the current directory for the given file name.  If it is not
 * found, raise an error condition: according to the calling procedure
 * it should be there!
 *}
     if not LocateMsdosFile then
      begin
       if ErrorDetected then
         BuildErrorTrace( 'DelMF_' )
       else
         FlagError( 'DelMF: File not found : ' +
                    ExpandFileName(AMsdosFileName,NE_Format) ) ;
       Exit ;
      end ;  { of if/if }
{*
 * Free the entry in the directory and rewrite the directory.
 *}
   MsdosFcb^.FileName[1]:= #$E5 ;  { Indicate deleted file }
{*
 * Free the clusters allocated to the deleted file.
 *}
   ThisEntry:= MsdosFcb^.Cluster ;  { First cluster allocated to deleted file }
   while (ThisEntry>1) and (ThisEntry<=ClustersPerDisk) do
    begin
     NextEntry:= GetFatEntry( ThisEntry ) ;  { Next cluster in chain }
     PutFatEntry( ThisEntry, 0 ) ;           { Free cluster in FAT }
     ThisEntry:= NextEntry ;
    end ;  { of while }

   WriteSector( DirectorySector, Addr(DirBuffer) ) ;
   if not ErrorDetected then
     for ThisEntry:= 0 to Pred(FatsPerDisk) do
       WriteFat( ThisEntry ) ;
   if ErrorDetected then
     BuildErrorTrace( 'DelMF_' ) ;
   FlushCache ;
end ;  { of DeleteMsdosFile }

function GetMsdosFileSize : Integer ;
{*
 * Return the length of an MS-DOS file, expressed as the number of CP/M
 * records of 128 bytes.  Note that the size of the CP/M record size is
 * hardcoded into this function.  Moreover, it is assumed (again) that
 * the maximum file size is 4 Megabytes, giving a 15-bit result.
 *}
var
   Result: Integer ;  { Intermediate result of function }
begin
   with MsdosFcb^ do
    begin
     Result:= (Size[0] shr 7) + (Size[1] shl 1) + ((Size[2] and $3F) shl 9) ;
     if (Size[0] and $7F)>0 then
       Result:= Succ( Result ) ;
    end ;  { of with }
   GetMsdosFileSize:= Result ;
end ;  { of GetMsdosFileSize }

procedure ReadMsdosFile ;
{*
 * Read the contents of the MS-DOS file associated with the current filelist
 * entry and write it to a new CP/M file with the same name.  The CP/M file
 * will inherit the attributes READONLY and SYSTEM.
 *}
var
   CurrentCluster: Integer ;  { Cluster to be read }
   RecordsToDo   : Integer ;  { Number of CP/M records (still) to copy }
   FirstFreeByte : Integer ;  { Ordinal of first unused byte in last recprd }
   TransferCount : Integer ;  { Number of records to write in BlockWrite }
   RecordsWritten: Integer ;  { Number of records written in BlockWrite }
   PaddingChar   :    Byte ;  { Padding character }

   CpmFib: CpmFibs absolute ACpmFile ;  { Type casting: file -> FIB }
begin
{*
 * Create a new CP/M file with the same name as the MS-DOS file.
 *}
   SplitFileName( ACpmFileName, GetFileEntryName ) ;
   ACpmFileName.Drive:= CpmDriveName.Drive ;
   ACpmFileName.User := CpmDriveName.User  ;
   RegisterFile( ACpmFileName, ACpmFile ) ;
   Assign ( ACpmFile, ExpandFileName(ACpmFileName,DNE_Format) ) ;
   ReWrite( ACpmFile ) ;
{*
 * Open the MS-DOS file and setup the copy control variables.  If the file
 * is not found, the value of the variables will be unpredictable, but they
 * will not be used in that case.
 *}
   if not LocateMsdosFile then
     FlagError( ^H': File not found : ' +
                ExpandFileName(ACpmFileName,NE_Format) ) ;
   CurrentCluster:= MsdosFcb^.Cluster ;  { First cluster of MS-DOS file }
   RecordsToDo   := GetMsdosFileSize  ;  { File size in CP/M records }
   FirstFreeByte := MsdosFcb^.Size[0] and $7F ;  { EOF pos. in last record }

   while (CurrentCluster<ClustersPerDisk) and (not ErrorDetected) do
    begin
     ReadCluster( CurrentCluster ) ;
     if not ErrorDetected then
{*
 * Copy the cluster to the CP/M file.  However, some extra care is needed in
 * case of the last cluster:
 * - The number of records to write may be smaller than RecordsPerCluster,
 * - The unused part of the last record should be filled up.
 *}
      begin
       TransferCount:= RecordsPerCluster ;  { Default number of records }
       if RecordsToDo<=RecordsPerCluster then
        begin
         TransferCount:= RecordsToDo ;
         if FirstFreeByte>0 then
          begin
           if FileClass=TextFile then  PaddingChar:= CpmTxtFillChar
                                 else  PaddingChar:= CpmBinFillChar ;
           FillChar( ClusterBuffer[Pred(TransferCount)*128+FirstFreeByte],
                     128-FirstFreeByte, PaddingChar ) ;
          end ;  { of if }
        end ;  { of if }

       BlockWrite( ACpmFile, ClusterBuffer, TransferCount, RecordsWritten ) ;
       if TransferCount=RecordsWritten then
        begin
         RecordsToDo   := RecordsToDo - TransferCount ;
         CurrentCluster:= GetFatEntry( CurrentCluster ) ;
        end
       else  { there is an error detected }
         FlagError( ^H': CP/M disk write error' ) ;
      end ;  { of if }
    end ;  { of while }
   Close( ACpmFile ) ;
{*
 * The file is copied to the CP/M file system.  If an error is encountered,
 * the CP/M file is destroyed.  If no errors are found, copy some of the
 * MS-DOS file attributes to the CP/M file.
 *}
   if ErrorDetected then
    begin
     BuildErrorTrace( 'ReaMF_' ) ;
     Erase( ACpmFile ) ;
    end
   else
     if CopyMsdosFileAttr then
      begin
       if ReadOnly in MsdosFcb^.Attribute then
         CpmFib.Fcb[09]:= CpmFib.Fcb[09] + $80 ;
       if [Hidden,System]*MsdosFcb^.Attribute <> [] then
         CpmFib.Fcb[10]:= CpmFib.Fcb[10] + $80 ;
       Bdos( SetFileAttributes, Addr(CpmFib.Fcb) ) ;
      end ;  { of if/else }
end ;  { of ReadMsdosFile }

procedure SetTodaysDate( NewDate: DateStrings ) ;
{*
 * Save the current date, both in text format and in the compressed MS-DOS
 * format.  If an obvious error is found in the supplied date, which must
 * be of the form 'yyyymmdd', the date is not changed and the global error
 * flag is set.
 *}
var
   Year  : Integer ;  { Year number from NewDate }
   Month : Integer ;  { Month number from NewDate }
   Day   : Integer ;  { Day number from NewDate }
   Status: Integer ;  { Status of string to number conversion }
begin
   FlagError( 'SetTD: Illegal date : ' + NewDate ) ;  { Assume an error }

   Val( Copy(NewDate,1,4), Year , Status ) ;  { Convert year number }
   if Status<>0 then  Exit ;
   Val( Copy(NewDate,5,2), Month, Status ) ;  { Convert month number }
   if Status<>0 then  Exit ;
   Val( Copy(NewDate,7,2), Day  , Status ) ;  { Convert day number }
   if Status<>0 then  Exit ;

   Year:= Year - 1980 ;
   if (Year <0) or (Year >32) then  Exit ;
   if (Month=0) or (Month>12) then  Exit ;
   if (Day  =0) or (Day  >31) then  Exit ;

   ClearError ;  { There is no error after all }
   TodaysDate:= NewDate ;
   MsdosDate := (Year shl 9) + (Month shl 5) + Day ;
end ;  { of SetTodaysDate }

procedure WriteMsdosFile ;
{*
 * Copy (write) the contents of a CP/M file into a new MS-DOS file.
 * The MS-DOS file will inherit both the name and the status flags
 * from the CP/M file.
 *
 * Note that it is assumed in this procedure that the maximum file size
 * is less than 4 Megabytes, thus the CP/M file size is always a
 * non-negative number.
 *}
var
   CpmFileSize     : Integer ;  { Size of file to copy [records] }
   LengthLastRecord: Integer ;  { Length of last, partial record }
   RecordsToDo     : Integer ;  { Loop control variable }
   TransferCount   : Integer ;  { Number of records read }
   CurrentCluster  : Integer ;  { Cluster currently being written }
   NextCluster     : Integer ;  { Next cluster in chain }

 procedure CreateMsdosFile ;
 {*
  * Find a free entry in the directory and enter the name of the file in it.
  *}
 var
    Found    :    Boolean ;  { Result of search for a free directory entry }
    EntryType: EntryTypes ;  { Type of directory entry }
 begin
    Found:= False ;  { Preset result of search }
    DirectorySearchPos:= BeforeFirstEntry ;
    repeat
      GetNextDirEntry( EntryType ) ;
      Found:= EntryType in [FreeEntry,UnusedEntry] ;
    until Found or (EntryType=EndOfDirectory) ;

    if Found then
{*
 * Initialise the FCB for this file.
 *}
     begin
      FillChar( MsdosFcb^, SizeOf(MsdosFcbs), 0 ) ;
      MsdosFcb^.FileName:= FileEntry^.Name ;
      if CopyCpmFileAttr then
        MsdosFcb^.Attribute:= FileEntry^.Attr + [Archive] ;
      MsdosFcb^.Date:= MsdosDate ;
     end
    else
{*
 * The end of the directory is hit, thus the directory is full.  However,
 * if GetNextDirEntry encounters an error it will fake EndOfDirectory and
 * set the flobal error flag.
 *}
      if ErrorDetected then
        BuildErrorTrace( 'CreMF_' )
      else
        FlagError( 'CreMF: Directory is full' ) ;
 end ;  { of CreateMsdosFile }

 procedure CloseMsdosFile ;
 {*
  * Write the directory entry of a new MS-DOS file onto the disk as well as
  * the updated FAT.
  *}
 var
    I: Integer ;  { Loop control variable }
 begin
    PushErrorMessage ;  { Save current errormessage, clear error status }

    if CpmFileSize<>0 then
     begin
{*
 * The file is not empty: register the length of the file in the directory
 * entry and write it together with the modified FAT's to disk.
 *}
      with MsdosFcb^ do
       begin
        Size[0]:= Lo( CpmFileSize shl 7 ) + LengthLastRecord ;
        Size[1]:= Lo( CpmFileSize shr 1 ) ;
        Size[2]:= Lo( CpmFileSize shr 9 ) ;
       end ;  { of with }
      for I:= 0 to Pred(FatsPerDisk) do
        WriteFat( I ) ;
     end ;  { of if }
{*
 * Write the modified directory entry to disk.  Even if during writing the
 * FAT an error is found, the directory should be rewritten to keep the
 * file system as consistent as possible.
 *}
    WriteSector( DirectorySector, Addr(DirBuffer) ) ;
    if ErrorDetected then
      BuildErrorTrace( 'CloMF_' ) ;
    FlushCache ;

    PopErrorMessage ;  { Restore original error status }
 end ;  { of CloseMsdosFile }

 procedure LocateEofPosition ;
 {*
  * Determine the precise length of the CP/M file: for text files, a Ctrl-Z
  * in the last record of the file indicates the actual EndOfFile.  For
  * other types of files it is not possible to give a full-proof, better
  * length.
  *
  * Given the precise length, CpmFileSize and LengthLastRecord are adjusted
  * and the unused part of the cluster is preset.
  *}
 var
    LastRecordPtr: ^Char ;  { Pointer somewhere in last record }
 begin
    if FileClass=TextFile then
     begin
      LastRecordPtr:= Ptr( Addr(ClusterBuffer) +
                           Pred(TransferCount)*BytesPerRecord ) ;
      while (LastRecordPtr^<>^Z) and (LengthLastRecord<BytesPerRecord) do
       begin
        LastRecordPtr   := Ptr( Succ(Ord(LastRecordPtr)) ) ;
        LengthLastRecord:= Succ( LengthLastRecord ) ;
       end ;  { of while }
{*
 * If an EndOfFile marker has been found, at least one byte and at most
 * BytesPerRecord bytes still need to be preset.  Moreover, the number of
 * complete CP/M records needs to be adjusted.
 *}
      if LastRecordPtr^=^Z then
       begin
        CpmFileSize:= Pred( CpmFileSize ) ;
        FillChar( LastRecordPtr^, BytesPerRecord-LengthLastRecord,
                  MsdosFillChar ) ;
       end  { of if }
 {*
  * No EndOfFile Marker is found.  Restore the length of the last record.
  *}
      else
        LengthLastRecord:= 0 ;
     end ;  { of if }
 end ;  { of LocateEofPosition }

begin  { of WriteMsdosFile }
{*
 * Build the CP/M (and MS-DOS) file name.  The drive and user area are set
 * to their 'current' values.
 *}
   SplitFileName( ACpmFileName, GetFileEntryName ) ;
   ACpmFileName.Drive:= CpmDriveName.Drive ;
   ACpmFileName.User := CpmDriveName.User  ;

   CpmFileSize     := 0 ;  { For CloseMsdosFile in order to handle empty }
   LengthLastRecord:= 0 ;  {  files and error cases correctly }
   CreateMsdosFile ;  { Allocate an entry in the MS-DOS file system }
   if not ErrorDetected then
{*
 * If the file to be copied is empty, the file needs to be closed only: the
 * input file is not read at all in such a case.
 *}
    begin
     if FileEntry^.Size>0 then
      begin
{*
 * Allocate the first cluster of the new MS-DOS file and open the CP/M file
 * for read access.
 *}
       CurrentCluster   := GetFreeFatEntry( 1 ) ;
       MsdosFcb^.Cluster:= CurrentCluster ;

       RegisterFile( ACpmFileName, ACpmFile ) ;
       Assign( ACpmFile, ExpandFileName(ACpmFileName,DNE_Format) ) ;
       Reset ( ACpmFile ) ;
       CpmFileSize:= FileSize( ACpmFile ) ;
       RecordsToDo:= CpmFileSize ;
{*
 * Copy the CP/M file to the MS-DOS file, one cluster per pass through
 * this loop.  Note that CP/M supplies a file size, which is a multiple
 * of the record size.  Therefore, the precise location of the EndOfFile
 * must be determined in another way.
 *}
       while (RecordsToDo>0) and (not ErrorDetected) do
        begin
         if RecordsToDo<RecordsPerCluster then
           FillChar( ClusterBuffer, SizeOf(ClusterBuffer), MsdosFillChar ) ;
         BlockRead( ACpmFile, ClusterBuffer, RecordsPerCluster, TransferCount ) ;
         RecordsToDo:= RecordsToDo - TransferCount ;
         if RecordsToDo<=0 then  { the last record of the file is read }
           LocateEofPosition ;   { For text files only! }
         WriteCluster( CurrentCluster ) ;
{*
 * Determine the ordinal of the next cluster in the chain and update the
 * FileAssignmentTable.
 *}
         if RecordsToDo<=0 then
           NextCluster:= $0FFF
         else
           NextCluster:= GetFreeFatEntry( CurrentCluster ) ;
         PutFatEntry( CurrentCluster, NextCluster ) ;
         CurrentCluster:= NextCluster ;

         if ErrorDetected then  { by WriteCluster or GetFreeFatEntry }
           BuildErrorTrace( 'WriMF_' ) ;
        end ;  { of while }
       Close( ACpmFile ) ;
       UnregisterFile( ACpmFile ) ;
      end ;  { of if }
    end ;  { of if }
{*
 * Perform unconditionally a close of the MS-DOS file: it causes the directory
 * to reflect the actual status.  In case of an error, DeleteMsdosFile then
 * will be able to locate the file!
 *}
   CloseMsdosFile ;  { Rewrite the MS-DOS directory and FAT(s) }

   if ErrorDetected then
    begin
     PushErrorMessage ;  { Save error status and clear it }
     DeleteMsdosFile  ;  { Remove file with error }
     PopErrorMessage  ;  { Restore error status }
    end ;  { of if }
end ;  { of WriteMsdosFile }