Copy Link
Add to Bookmark
Report
Chapter 16 - Complete example programs
The intent of this chapter is to give several example programs that use nearly every capability of Modula-2 as illustrations of large usable programs. The programs are usable utilities, but primarily they are intended to illustrate the method of building up a medium sized program from the various constructs studied in the earlier chapters.
BAKLIST.MOD
MODULE BakList;
(* This program is used to generate a list of all files in all *)
(* subdirectories except for the DOS files and the list file which *)
(* this program generates. The file FULLDISK.LST is created and *)
(* filled in the root directory of the default drive containing *)
(* the entire tree from the default subdirectory to all end points.*)
(* If this program is called from the root directory, the tree for *)
(* the entire default directory will be listed. The resulting file*)
(* can then be edited with any text editor to allow copying of all *)
(* files or only selected files. *)
(* *)
(* Copywrite (c) 1987 - Coronado Enterprises *)
FROM InOut IMPORT WriteString,WriteCard,Write,WriteLn;
FROM RealInOut IMPORT WriteReal;
FROM Real2Fil IMPORT WriteStringFile,WriteLnFile;
FROM DiskDirectory IMPORT CurrentDrive,CurrentDirectory;
FROM Strings IMPORT Concat,Copy,Length,Insert,CompareStr,
Delete;
FROM FileSystem IMPORT Lookup,Close,File,Response;
FROM SYSTEM IMPORT AX,BX,CX,DX,SI,DI,ES,DS,CS,SS,SIZE,TSIZE,
ADR,ADDRESS,GETREG,SETREG,SWI;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
FROM DirHelps IMPORT ReadFileStats,FileDataPointer,FileData;
VAR Drive : CHAR;
StartingPath : ARRAY[0..64] OF CHAR;
FileList : File;
DiskTransAdr : ARRAY[1..43] OF CHAR;
(* This procedure selects the current drive and directory and opens*)
(* the file named FULLDISK.LST to be used for recording all sub- *)
(* directories and filenames. *)
PROCEDURE Initialize() : BOOLEAN;
VAR StorageFile : ARRAY[0..20] OF CHAR;
BEGIN
CurrentDrive(Drive); (* This generates the path *)
CurrentDirectory(Drive,StartingPath);(* used for the start of *)
Insert(Drive,StartingPath,0); (* the search. It uses *)
Insert(':',StartingPath,1); (* the current drive and *)
IF StartingPath[2] <> 000C THEN (* path. *)
Insert('\',StartingPath,2);
END;
StorageFile := ":\FULLDISK.LST"; (* This opens the file used*)
Insert(Drive,StorageFile,0); (* to store the file-list. *)
Lookup(FileList,StorageFile,TRUE); (* It is forced into the *)
IF FileList.res = done THEN (* root of the current *)
RETURN(TRUE); (* directory. *)
ELSE
RETURN(FALSE);
END;
END Initialize;
(* This procedure is used to store all of the data found into a *)
(* B-tree structure to be used in sorting the files and subdirec- *)
(* tories alphabetically. *)
PROCEDURE StoreData(NewData : FileDataPointer;
VAR Files : FileDataPointer;
VAR Directories : FileDataPointer);
PROCEDURE AddToTree(VAR RootOfTree : FileDataPointer;
VAR NewNode : FileDataPointer);
VAR Result : INTEGER;
BEGIN
Result := CompareStr(RootOfTree^.Name,NewNode^.Name);
IF Result = 1 THEN
IF RootOfTree^.Left = NIL THEN
RootOfTree^.Left := NewNode;
ELSE
AddToTree(RootOfTree^.Left,NewNode);
END;
ELSE
IF RootOfTree^.Right = NIL THEN
RootOfTree^.Right := NewNode;
ELSE
AddToTree(RootOfTree^.Right,NewNode);
END;
END;
END AddToTree;
PROCEDURE GoodFile(FileName : ARRAY OF CHAR) : BOOLEAN;
BEGIN
IF CompareStr(FileName,"COMMAND.COM ") = 0 THEN
RETURN(FALSE);
ELSIF CompareStr(FileName,"IBMBIO.COM ") = 0 THEN
RETURN(FALSE);
ELSIF CompareStr(FileName,"IBMDOS.COM ") = 0 THEN
RETURN(FALSE);
ELSIF CompareStr(FileName,"FULLDISK.LST") = 0 THEN
RETURN(FALSE);
ELSE
RETURN(TRUE);
END;
END GoodFile;
VAR Index : CARDINAL;
BEGIN
IF NewData^.Attr = 010H THEN (* Attr = 10 for directory *)
IF NewData^.Name[0] <> "." THEN
IF Directories = NIL THEN
Directories := NewData;
ELSE
AddToTree(Directories,NewData);
END;
END;
ELSE (* Otherwise a filename *)
IF GoodFile(NewData^.Name) THEN
IF Files = NIL THEN
Files := NewData;
ELSE
AddToTree(Files,NewData);
END;
ELSE
WriteString("File ignored here --->");
WriteString(NewData^.Name);
WriteLn;
END;
END;
END StoreData;
(* This procedure reads the file statistics from DOS and stores the*)
(* data in a record for further use. *)
PROCEDURE ReadFileStatistics(VAR Files : FileDataPointer;
VAR Directories : FileDataPointer;
PathToFiles : ARRAY OF CHAR);
TYPE MaskStore = ARRAY[0..70] OF CHAR;
VAR SmallMask : MaskStore; (* Used for Directory output to file *)
MaskAndFile : MaskStore; (* Used for file search name *)
MaskAddr : ADDRESS;
Error : BOOLEAN;
Index : CARDINAL;
NewData : FileDataPointer;
FirstFile : BOOLEAN;
BEGIN
WriteString(PathToFiles);
WriteLn;
Copy(PathToFiles,0,SIZE(PathToFiles),SmallMask);
Delete(SmallMask,0,2);
WriteStringFile(FileList,SmallMask);
WriteLnFile(FileList);
ALLOCATE(NewData,TSIZE(FileData));
FirstFile := TRUE;
Concat(PathToFiles,"/*.*",MaskAndFile);
ReadFileStats(MaskAndFile,FirstFile,NewData,Error);
IF NOT Error THEN
StoreData(NewData,Files,Directories);
END;
REPEAT
ALLOCATE(NewData,TSIZE(FileData));
FirstFile := FALSE;
ReadFileStats(MaskAndFile,FirstFile,NewData,Error);
IF NOT Error THEN
StoreData(NewData,Files,Directories);
END;
UNTIL Error;
END ReadFileStatistics;
(* This procedure lists all of the filenames alphabetically by *)
(* recursively tracing the B-tree described above. *)
PROCEDURE ListAllFiles(Files : FileDataPointer);
VAR TempString : ARRAY[0..5] OF CHAR;
BEGIN
IF Files <> NIL THEN
IF Files^.Left <> NIL THEN
ListAllFiles(Files^.Left);
END;
TempString := " ";
WriteStringFile(FileList,TempString);
WriteStringFile(FileList,Files^.Name);
WriteLnFile(FileList);
IF Files^.Right <> NIL THEN
ListAllFiles(Files^.Right);
END;
END;
END ListAllFiles;
(* This procedure searches all Subdirectory names found in a *)
(* search of a subdirectory for additional files and subdirector- *)
(* ies. The search is recursive. *)
PROCEDURE DoAllSubdirectories(StartPath : ARRAY OF CHAR;
Directories : FileDataPointer);
VAR NewPath : ARRAY[0..64] OF CHAR;
Index : CARDINAL;
BEGIN
IF Directories <> NIL THEN
IF Directories^.Left <> NIL THEN
DoAllSubdirectories(StartPath,Directories^.Left);
END;
IF Directories^.Name[0] <> '.' THEN
Copy(StartPath,0,64,NewPath);
Insert('\',NewPath,Length(NewPath));
Concat(NewPath,Directories^.Name,NewPath);
FOR Index := (SIZE(NewPath)-1) TO 1 BY -1 DO
IF NewPath[Index] = ' ' THEN
NewPath[Index] := 000C;
END;
END;
GetAllFilesAndDirectories(NewPath);
END;
IF Directories^.Right <> NIL THEN
DoAllSubdirectories(StartPath,Directories^.Right);
END;
END;
END DoAllSubdirectories;
(* This procedure deletes a tree after it has completed its task *)
(* and is no longer of any use. *)
PROCEDURE DeleteTree(Point : FileDataPointer);
BEGIN
IF Point <> NIL THEN
DeleteTree(Point^.Left);
DeleteTree(Point^.Right);
DEALLOCATE(Point,TSIZE(FileData));
END;
END DeleteTree;
(* This procedure searches a subdirectory for all files names and *)
(* additional subdirectories. *)
PROCEDURE GetAllFilesAndDirectories(ThisPath : ARRAY OF CHAR);
VAR DirExists : BOOLEAN; (* Temporary - use logic later*)
Files : FileDataPointer; (* Point to root of File tree *)
Directories : FileDataPointer; (* Point to root of Dir tree *)
BEGIN
Files := NIL;
Directories := NIL;
ReadFileStatistics(Files,Directories,ThisPath);
ListAllFiles(Files); (* List to a file for later use. *)
DoAllSubdirectories(ThisPath,Directories);
DeleteTree(Files);
DeleteTree(Directories);
END GetAllFilesAndDirectories;
BEGIN (* Main program - BakList, Backup list *)
IF Initialize() THEN
GetAllFilesAndDirectories(StartingPath);
Close(FileList);
ELSE
WriteString("File named FULLDISK.LST cannot be opened");
WriteLn;
END;
END BakList.This program generates a list of all files along with their subdirectories. Some files are excluded from the list, including all three files that comprise the DOS system and the file generated here, FULLDISK.LST. This is an ASCII file that can be edited with any text editor to eliminate any files that you do not wish to back up. It should be noted that the file, FULLDISK.LST, is created and filled in the root directory of the default drive.
Select the desired subdirectory that you wish to back up, and the files, subdirectories, and all of their respective contents will be listed in FULLDISK.LST. The resulting list is then used by BAKCOPY to actually copy the files to a floppy disk.
BAKCOPY.MOD
MODULE BakCopy;
(* This program is used to actually copy the files from the fixed *)
(* disk to the floppy disks. It uses the file FULLDISK.LST as the *)
(* basis for its copying. That file is generated using the sister *)
(* program BAKLIST, and after generation, it can be modified with *)
(* any text editor to allow elimination of any files or directories*)
(* that you do not wish to back up. *)
(* *)
(* Copywrite (c) 1987 - Coronado Enterprises *)
(* Note that this is a preliminary version of this example program *)
(* and as such, it is not completely refined as it would need to *)
(* be for a full production system. Since it was never intended *)
(* to compete with the full production backup systems available, *)
(* but was meant only to illustrate the method of building up a *)
(* significant sized program, it is considered to have attained *)
(* the original goal. It can be used as a backup system if you *)
(* don't mind the following problems. *)
(* *)
(* 1. The date and time of the files on the copy are the date and *)
(* time that the copies are made, not the date and time of the *)
(* original files. The date and time of the original can be *)
(* read and copied to the copy using interrupt 21 - function *)
(* call 57H if you can figure out how to get the file handle. *)
(* *)
(* 2. This system does not copy hidden files. *)
(* *)
(* 3. This system does not copy files that are too big to fit on *)
(* one floppy disk. *)
(* *)
(* 4. The filesize and the room remaining on the disk are handled *)
(* using floating point numbers instead of CARDINAL which would *)
(* be a much needed improvement. The floating point numbers on *)
(* this system use enough significant digits to allow this, *)
(* but changing to CARDINAL would be an improvement. Keep in *)
(* mind if you attempt this, that the upper limit on a CARDINAL *)
(* is 65535 so it would require the use of two CARDINALS for *)
(* filesize and two for room on disk. *)
FROM InOut IMPORT WriteString, WriteCard, WriteLn,
Write, Read;
FROM RealInOut IMPORT WriteReal;
FROM FileSystem IMPORT Lookup, Close, File, Response, ReadByte;
FROM Strings IMPORT Copy, Insert, Delete;
FROM DiskDirectory IMPORT CurrentDrive;
FROM SYSTEM IMPORT ADR;
FROM DirHelps IMPORT GetDiskStatistics, ChangeToDirectory,
CopyFile, FileData, FileDataPointer,
ReadFileStats;
TYPE CharArray = ARRAY[0..100] OF CHAR;
VAR InputFile : File;
SourceDrive : CHAR;
SourceFile : CharArray;
TargetDrive : CHAR;
TargetFile : CharArray;
InputLine : CharArray;
WorkingDirectory : CharArray;
Char : CHAR;
Index : CARDINAL;
SectorsPerCluster : CARDINAL;
FreeClusters : CARDINAL;
BytesPerSector : CARDINAL;
TotalClusters : CARDINAL;
ErrorRet : BOOLEAN;
ErrorCode : CARDINAL;
FileSize : REAL;
RoomOnDisk : REAL;
RoomOnNewDisk : REAL;
DataForFile : FileData;
PointToData : FileDataPointer;
DiskNumber : CARDINAL;
EndOfCopy : BOOLEAN;
(* This procedure is used to read in one full line from the input *)
(* file. *)
PROCEDURE ReadALine;
BEGIN
Index := 0;
REPEAT (* Read one line of input data *)
ReadByte(InputFile,Char);
IF Char <> 15C THEN
InputLine[Index] := Char;
INC(Index);
END;
UNTIL (Index = 100) OR (Char = 12C) OR InputFile.eof;
InputLine[Index - 1] := 000C;
END ReadALine;
(* This procedure calls the actual copying routine after it checks *)
(* to see if there is enough room on the target floppy. If there *)
(* is not, it requests a blank floppy to be loaded. *)
PROCEDURE CopyTheFile;
BEGIN
Delete(InputLine,0,1); (* Remove leading blank *)
SourceFile := InputLine;
Insert(SourceDrive,SourceFile,0);
Insert(':',SourceFile,1);
TargetFile := InputLine;
Insert(TargetDrive,TargetFile,0);
Insert(':',TargetFile,1);
(* See if the file will fit on the disk *)
PointToData := ADR(DataForFile);
ReadFileStats(SourceFile,TRUE,PointToData,ErrorRet);
FileSize := PointToData^.Size;
GetDiskStatistics(TargetDrive,SectorsPerCluster,FreeClusters,
BytesPerSector,TotalClusters);
RoomOnDisk := FLOAT(SectorsPerCluster) *
FLOAT(FreeClusters) *
FLOAT(BytesPerSector);
IF RoomOnDisk >= FileSize THEN
CopyFile(SourceFile,TargetFile,FileSize,ErrorCode);
ELSIF RoomOnNewDisk >= FileSize THEN
WriteString("Install a new disk, hit return to continue");
WriteString(", or hit Q to stop backup");
WriteLn;
Read(Char);
IF Char = 'Q' THEN
EndOfCopy := TRUE;
ELSE
INC(DiskNumber);
WriteString("Beginning disk number ");
WriteCard(DiskNumber,3);
WriteLn;
ChangeToDirectory(WorkingDirectory,TRUE,ErrorRet);
GetDiskStatistics(TargetDrive,SectorsPerCluster,FreeClusters,
BytesPerSector,TotalClusters);
RoomOnDisk := FLOAT(SectorsPerCluster) *
FLOAT(FreeClusters) *
FLOAT(BytesPerSector);
IF RoomOnDisk >= FileSize THEN
CopyFile(SourceFile,TargetFile,FileSize,ErrorCode);
ELSE
WriteString("File too big for this system");
END;
END;
ELSE
WriteString("File too big for this system");
END;
END CopyTheFile;
(* This procedure makes the calls to change the directories of both*)
(* the source and target directories. *)
PROCEDURE ChangeBothDirectories;
BEGIN
Insert(SourceDrive,InputLine,0);
Insert(':',InputLine,1);
ChangeToDirectory(InputLine,FALSE,ErrorRet);
IF ErrorRet THEN
WriteString(InputLine);
WriteString(" Cannot change to source directory");
WriteLn;
END;
InputLine[0] := TargetDrive;
WorkingDirectory := InputLine;
ChangeToDirectory(InputLine,TRUE,ErrorRet);
IF ErrorRet THEN
WriteString(InputLine);
WriteString(" Cannot change to target directory");
WriteLn;
END;
END ChangeBothDirectories;
BEGIN (* Main program *)
DiskNumber := 1;
EndOfCopy := FALSE;
WriteString("Enter the target drive, one letter ---> ");
Read(TargetDrive);
TargetDrive := CAP(TargetDrive);
Write(TargetDrive);
WriteLn;
WriteString("Beginning disk number 1");
WriteLn;
GetDiskStatistics(TargetDrive, SectorsPerCluster, FreeClusters,
BytesPerSector, TotalClusters);
IF BytesPerSector > 0 THEN (* Valid drive found *)
RoomOnNewDisk := FLOAT(SectorsPerCluster) *
FLOAT(TotalClusters) *
FLOAT(BytesPerSector);
Copy("C:\FULLDISK.LST",0,100,SourceFile);
CurrentDrive(SourceDrive); (* Get current drive letter *)
SourceFile[0] := SourceDrive; (* Open FULLDISK.LST for read *)
Lookup(InputFile,SourceFile,FALSE);
IF InputFile.res = done THEN
LOOP
ReadALine;
IF InputFile.eof THEN
EXIT;
ELSE
IF InputLine[0] = ' ' THEN (* Filename *)
CopyTheFile;
IF EndOfCopy THEN EXIT END;
ELSIF InputLine[0] = 000C THEN
(* Empty line, not a directory entry *)
ELSE (* Directory *)
ChangeBothDirectories;
WriteString(" Directory ---> ");
WriteString(InputLine);
WriteLn;
END
END;
END; (* LOOP *)
Close(InputFile);
ELSE
WriteString("FULLDISK.LST not available for reading.");
WriteLn;
WriteString("Program terminated");
WriteLn;
END;
WriteString("End of Backup copy program");
WriteLn;
END; (* Drive test *)
END BakCopy.This program uses FULLDISK.LST to actually copy the files from the source disk to the target and requests a disk change whenever the floppy disk fills up. It will not copy a file larger than that which will fit on one disk, but will give a message of which files are not copied.
BAKRSTR.MOD
MODULE BakRstr;
(* This program is used to restore the files from the floppy disks *)
(* to the hard disk. This program is loaded into the root direc- *)
(* tory of the hard disk and executed from there. The files are *)
(* read from the floppy and copied into the same directory of the *)
(* hard disk as they are in on the floppy, the directories being *)
(* created as needed on the hard disk. To restore additional *)
(* disks, simply rerun this program once for each disk. *)
(* *)
(* Copywrite 1987 - Coronado Enterprises *)
FROM InOut IMPORT WriteString,Read,Write,WriteLn;
FROM DiskDirectory IMPORT CurrentDrive,CurrentDirectory;
FROM Strings IMPORT Concat,Copy,Insert,Delete,Length,
CompareStr;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
FROM FileSystem IMPORT File;
FROM SYSTEM IMPORT ADDRESS,TSIZE,SIZE;
FROM DirHelps IMPORT ReadFileStats,FileDataPointer,FileData,
CopyFile,ChangeToDirectory;
VAR SourceDrive : CHAR;
TargetDrive : CHAR;
StartingPath : ARRAY[0..64] OF CHAR;
FileList : File;
DiskTransAdr : ARRAY[1..43] OF CHAR;
PROCEDURE Initialize();
VAR StorageFile : ARRAY[0..20] OF CHAR;
BEGIN
WriteString("Enter the source drive, one letter ---> ");
Read(SourceDrive);
SourceDrive := CAP(SourceDrive);
Write(SourceDrive);
WriteLn;
CurrentDrive(TargetDrive);
TargetDrive := 'A';
Copy("A:",0,64,StartingPath);
StartingPath[0] := SourceDrive;
END Initialize;
(* This procedure is used to copy the files from the floppy to the *)
(* hard disk while making a list of subdirectories found in order *)
(* to copy each of them also. *)
PROCEDURE StoreData(NewData : FileDataPointer;
VAR Directories : FileDataPointer);
PROCEDURE AddToTree(VAR RootOfTree : FileDataPointer;
VAR NewNode : FileDataPointer);
VAR Result : INTEGER;
BEGIN
Result := CompareStr(RootOfTree^.Name,NewNode^.Name);
IF Result = 1 THEN
IF RootOfTree^.Left = NIL THEN
RootOfTree^.Left := NewNode;
ELSE
AddToTree(RootOfTree^.Left,NewNode);
END;
ELSE
IF RootOfTree^.Right = NIL THEN
RootOfTree^.Right := NewNode;
ELSE
AddToTree(RootOfTree^.Right,NewNode);
END;
END;
END AddToTree;
VAR Error : CARDINAL;
SourceFile : ARRAY[0..20] OF CHAR;
DestFile : ARRAY[0..20] OF CHAR;
BEGIN
IF NewData^.Attr = 010H THEN (* Attr = 10 for directory *)
IF NewData^.Name[0] <> "." THEN
IF Directories = NIL THEN
Directories := NewData;
ELSE
AddToTree(Directories,NewData);
END;
END;
ELSE (* Otherwise a filename *)
WriteString("Copyfile ---> ");
WriteString(NewData^.Name);
WriteLn;
Copy(NewData^.Name,0,20,SourceFile);
Insert(SourceDrive,SourceFile,0);
Insert(':',SourceFile,1);
Copy(NewData^.Name,0,20,DestFile);
Insert(TargetDrive,DestFile,0);
Insert(':',DestFile,1);
CopyFile(SourceFile,DestFile,NewData^.Size,Error);
IF Error <> 0 THEN
WriteString("Error copying file ---> ");
WriteString(SourceFile);
WriteLn;
END;
END;
END StoreData;
(* This procedure reads the file statistics from DOS and stores *)
(* the data in a record for further use. *)
PROCEDURE ReadFileStatistics(VAR Directories : FileDataPointer;
PathToFiles : ARRAY OF CHAR);
TYPE MaskStore = ARRAY[0..70] OF CHAR;
VAR MaskAndFile : MaskStore; (* Used for file search name *)
ModifiedPath : MaskStore;
MaskAddr : ADDRESS;
Error : BOOLEAN;
Index : CARDINAL;
NewData : FileDataPointer;
FirstFile : BOOLEAN;
BEGIN
WriteString("Changepath ---> ");
WriteString(PathToFiles);
WriteLn;
Copy(PathToFiles,0,64,ModifiedPath);
IF ModifiedPath[2] = 000C THEN
ModifiedPath[2] := '\';
ModifiedPath[3] := 000C;
END;
ModifiedPath[0] := TargetDrive;
ChangeToDirectory(ModifiedPath,TRUE,Error);
IF Error THEN
WriteString("Cannot change target directory ---> ");
WriteString(ModifiedPath);
WriteLn;
END;
ModifiedPath[0] := SourceDrive;
ChangeToDirectory(ModifiedPath,FALSE,Error);
IF Error THEN
WriteString("Cannot change source directory ---> ");
WriteString(ModifiedPath);
WriteLn;
END;
ALLOCATE(NewData,TSIZE(FileData));
FirstFile := TRUE;
Concat(PathToFiles,"/*.*",MaskAndFile);
ReadFileStats(MaskAndFile,FirstFile,NewData,Error);
IF NOT Error THEN
StoreData(NewData,Directories);
END;
REPEAT
ALLOCATE(NewData,TSIZE(FileData));
FirstFile := FALSE;
ReadFileStats(MaskAndFile,FirstFile,NewData,Error);
IF NOT Error THEN
StoreData(NewData,Directories);
END;
UNTIL Error;
END ReadFileStatistics;
(* This procedure searches all subdirectory names found in a *)
(* search of a subdirectory for additional files and subdirector- *)
(* ies. The search is recursive. *)
PROCEDURE DoAllSubdirectories(StartPath : ARRAY OF CHAR;
Directories : FileDataPointer);
VAR NewPath : ARRAY[0..64] OF CHAR;
Index : CARDINAL;
BEGIN
IF Directories <> NIL THEN
IF Directories^.Left <> NIL THEN
DoAllSubdirectories(StartPath,Directories^.Left);
END;
IF Directories^.Name[0] <> '.' THEN
Copy(StartPath,0,64,NewPath);
Insert('\',NewPath,Length(NewPath));
Concat(NewPath,Directories^.Name,NewPath);
FOR Index := (SIZE(NewPath)-1) TO 1 BY -1 DO
IF NewPath[Index] = ' ' THEN
NewPath[Index] := 000C;
END;
END;
GetAllFilesAndDirectories(NewPath);
END;
IF Directories^.Right <> NIL THEN
DoAllSubdirectories(StartPath,Directories^.Right);
END;
END;
END DoAllSubdirectories;
(* This procedure deletes a tree after it is no longer needed. *)
PROCEDURE DeleteTree(Point : FileDataPointer);
BEGIN
IF Point <> NIL THEN
DeleteTree(Point^.Left);
DeleteTree(Point^.Right);
DEALLOCATE(Point,TSIZE(FileData));
END;
END DeleteTree;
PROCEDURE GetAllFilesAndDirectories(ThisPath : ARRAY OF CHAR);
VAR DirExists : BOOLEAN; (* Temporary - use logic later*)
Directories : FileDataPointer; (* Point to root of Dir tree *)
BEGIN
Directories := NIL;
ReadFileStatistics(Directories,ThisPath);
DoAllSubdirectories(ThisPath,Directories);
DeleteTree(Directories);
END GetAllFilesAndDirectories;
BEGIN (* Main program - BakRstr, Backup restore *)
Initialize;
GetAllFilesAndDirectories(StartingPath);
END BakRstr.This program will read the files from floppy back to the fixed disk to restore it. It simply copies from whatever directory they are in to the corresponding directory on the fixed disk, creating the directory if necessary.
DIRHELPS.DEF
DEFINITION MODULE DirHelps;
(* Copyright (c) 1987 - Coronado Enterprises *)
EXPORT QUALIFIED ReadFileStats,
GetDiskStatistics,
ChangeToDirectory,
CopyFile,
FileDataPointer,
FileData;
TYPE FileDataPointer = POINTER TO FileData;
FileData = RECORD
Name : ARRAY[0..13] OF CHAR;
Attr : CARDINAL;
Time : CARDINAL;
Date : CARDINAL;
Size : REAL;
Left : FileDataPointer;
Right : FileDataPointer;
END;
(*******************************************************************)
PROCEDURE ReadFileStats(FileName : ARRAY OF CHAR;
FirstFile : BOOLEAN;
VAR FilePt : FileDataPointer;
VAR FileError : BOOLEAN);
(* This procedure is used to read the DOS data concerning a file. *)
(* It returns a pointer to the FileData structure containing all *)
(* of the file data. FirstFile is set to TRUE for the first file *)
(* and to FALSE for the remaining files in the list. FileError *)
(* returns TRUE if the read was successful and FALSE if it was not *)
(* with a FALSE also indicating the end of the files in this dir- *)
(* ectory. *)
(*******************************************************************)
PROCEDURE GetDiskStatistics(Drive : CHAR;
VAR SectorsPerCluster : CARDINAL;
VAR FreeClusters : CARDINAL;
VAR BytesPerSector : CARDINAL;
VAR TotalClusters : CARDINAL);
(* This procedure gets the disk statistics on the selected drive. *)
(*******************************************************************)
PROCEDURE ChangeToDirectory(Directory : ARRAY OF CHAR;
CreateIt : BOOLEAN;
VAR ErrorReturn : BOOLEAN);
(* C:\DIR1\DIR2\DIR3\<000> Example of usage *)
(* This procedure is used to change to a directory on the selected *)
(* drive included in the CHAR array. The directory is a complete *)
(* path and if the CreatIt flag is TRUE, the directory will be *)
(* created, otherwise an error return will be generated as follows.*)
(* ErrorReturn = 0 Directory created as desired. *)
(* ErrorReturn = 1 Directory doesn't exist and CreateIt = FALSE. *)
(* ErrorReturn = 2 Not enough disk room to create Directory. *)
(*******************************************************************)
PROCEDURE CopyFile(SourceFile : ARRAY OF CHAR;
DestinationFile : ARRAY OF CHAR;
FileSize : REAL;
VAR ResultOfCopy : CARDINAL);
(* C:FILENAME.EXT<000> Example of usage *)
(* This procedure copies a file from SourceDrive:SourceFile to *)
(* DestinationDrive:DestinationFile and returns a ResultOfCopy *)
(* indicator to signal the result of the copy. It assumes that *)
(* the proper subdirectory has been selected prior to a call to *)
(* this routine. If a file cannot be opened, it is not copied. *)
(* ResultOfCopy = 0 Good copy made. *)
(* ResultOfCopy = 1 Cannot open source file. *)
(* ResultOfCopy = 2 Cannot open destination file. *)
(* ResultOfCopy = 3 Not enough room on the disk. *)
END DirHelps.and
DIRHELPS.MOD
IMPLEMENTATION MODULE DirHelps;
(* Copyright (c) 1987 - Coronado Enterprises *)
FROM InOut IMPORT WriteString,Write,WriteLn;
FROM FileSystem IMPORT Lookup, Close, File, Response,
ReadNBytes, WriteNBytes;
FROM SYSTEM IMPORT AX,BX,CX,DX,DS,SWI,GETREG,SETREG,
ADDRESS,ADR;
VAR DiskTransAdr : ARRAY[1..43] OF CHAR; (* Must be Global *)
(*******************************************************************)
PROCEDURE ReadFileStats(FileName : ARRAY OF CHAR;
FirstFile : BOOLEAN;
VAR FilePt : FileDataPointer;
VAR FileError : BOOLEAN);
VAR MaskAddr : ADDRESS;
Error : CARDINAL;
Index : CARDINAL;
BEGIN
IF FirstFile THEN
FOR Index := 1 TO 43 DO (* Clear out the DTA *)
DiskTransAdr[Index] := " ";
END;
SETREG(AX,01A00H); (* Set up the Disk Transfer Address *)
MaskAddr := ADR(DiskTransAdr);
SETREG(DS,MaskAddr.SEGMENT);
SETREG(DX,MaskAddr.OFFSET);
SWI(021H);
MaskAddr := ADR(FileName);
SETREG(AX,04E00H); (* Get first file *)
SETREG(DS,MaskAddr.SEGMENT);
SETREG(DX,MaskAddr.OFFSET);
SETREG(CX,017H); (* Attribute for all files *)
SWI(021H);
ELSE
SETREG(AX,04F00H); (* Get additional files *)
SWI(021H);
END;
GETREG(AX, Error);
Error := Error MOD 256; (* Logical AND with 255 *)
IF Error = 0 THEN
FileError := FALSE; (* Good read, put data in the structure *)
FOR Index := 0 TO 13 DO (* Put all blanks in the filename *)
FilePt^.Name[Index] := ' ';
END;
Index := 0;
REPEAT (* Copy filename to record *)
FilePt^.Name[Index] := DiskTransAdr[Index + 31];
Index := Index + 1;
UNTIL (Index > 11) OR (DiskTransAdr[Index + 31] = 000C);
FilePt^.Name[12] := 000C; (* ASCIIZ terminator *)
FilePt^.Attr := ORD(DiskTransAdr[22]);
FilePt^.Time := 0; (* Ignore Time *)
FilePt^.Date := 0; (* Ignore Date *)
FilePt^.Size := 65536.0 * FLOAT(ORD(DiskTransAdr[29]))
+ 256.0 * FLOAT(ORD(DiskTransAdr[28]))
+ FLOAT(ORD(DiskTransAdr[27]));
FilePt^.Left := NIL;
FilePt^.Right := NIL;
ELSE
FileError := TRUE;
END; (* of IF Error = 0 *)
END ReadFileStats;
(*******************************************************************)
PROCEDURE GetDiskStatistics(Drive : CHAR;
VAR SectorsPerCluster : CARDINAL;
VAR FreeClusters : CARDINAL;
VAR BytesPerSector : CARDINAL;
VAR TotalClusters : CARDINAL);
VAR DriveCode : INTEGER;
BEGIN
DriveCode := INTEGER(ORD(Drive)) - 64;
IF (DriveCode > 17) OR (DriveCode < 0) THEN
WriteString("Error - Drive code invalid ---> ");
Write(Drive);
WriteLn;
SectorsPerCluster := 0;
FreeClusters := 0;
BytesPerSector := 0;
TotalClusters := 0;
ELSE
SETREG(AX,03600H);
SETREG(DX,DriveCode);
SWI(021H);
GETREG(BX,FreeClusters);
GETREG(AX,SectorsPerCluster);
GETREG(CX,BytesPerSector);
GETREG(DX,TotalClusters);
IF SectorsPerCluster = 0FFFFH THEN
WriteString("Error - Drive doesn't exist ---> ");
Write(Drive);
WriteLn;
SectorsPerCluster := 0;
FreeClusters := 0;
BytesPerSector := 0;
TotalClusters := 0;
END;
END;
END GetDiskStatistics;
(*******************************************************************)
PROCEDURE ChangeToDirectory(Directory : ARRAY OF CHAR;
CreateIt : BOOLEAN;
VAR ErrorReturn : BOOLEAN);
VAR MaskAddr : ADDRESS;
Good : CARDINAL;
PROCEDURE CHDIR(Path : ARRAY OF CHAR;
VAR Error : CARDINAL);
BEGIN
MaskAddr := ADR(Path);
SETREG(AX,03B00H);
SETREG(DX,MaskAddr.OFFSET);
SETREG(DS,MaskAddr.SEGMENT);
SWI(021H);
GETREG(AX,Error);
Error := Error MOD 256;
END CHDIR;
PROCEDURE MKDIR(Path : ARRAY OF CHAR;
VAR Error : CARDINAL);
BEGIN
MaskAddr := ADR(Path);
SETREG(AX,03900H);
SETREG(DX,MaskAddr.OFFSET);
SETREG(DS,MaskAddr.SEGMENT);
SWI(021H);
GETREG(AX,Error);
Error := Error MOD 256;
END MKDIR;
PROCEDURE CreateAndChangeDirectory(Directory : ARRAY OF CHAR);
VAR SubDir : ARRAY[0..64] OF CHAR;
Index : CARDINAL;
Correct : CARDINAL;
BEGIN
Index := 0;
REPEAT (* Find the terminating zero *)
SubDir[Index] := Directory[Index];
Index := Index + 1;
UNTIL (Directory[Index] = 000C) OR (Index = 64);
SubDir[Index] := 000C;
REPEAT (* Remove a subdirectory *)
SubDir[Index] := 000C;
IF Index > 2 THEN
Index := Index - 1;
END;
UNTIL (Index = 2) OR (SubDir[Index] = '\');
IF Index > 2 THEN
SubDir[Index] := 000C; (* Blank out trailing \ *)
END;
CHDIR(SubDir,Correct);
IF (Correct <> 0) AND (* SubDir Doesn't exist, AND *)
(Index > 2) THEN (* subdirs still in list *)
CreateAndChangeDirectory(SubDir);
MKDIR(SubDir,Correct); (* Make the subdirectory *)
CHDIR(SubDir,Correct); (* Change the subdirectory *)
END;
END CreateAndChangeDirectory;
BEGIN
CHDIR(Directory,Good);
IF Good = 0 THEN (* Change to dir if it exists *)
ErrorReturn := FALSE;
ELSIF CreateIt THEN (* Create and change directory *)
CreateAndChangeDirectory(Directory);
MKDIR(Directory,Good);
CHDIR(Directory,Good);
ErrorReturn := FALSE;
ELSE (* Dir doesn't exist, return an error *)
ErrorReturn := TRUE;
END;
END ChangeToDirectory;
(*******************************************************************)
PROCEDURE CopyFile(SourceFile : ARRAY OF CHAR;
DestinationFile : ARRAY OF CHAR;
FileSize : REAL;
VAR ResultOfCopy : CARDINAL);
TYPE BufferType = ARRAY [1..1024] OF CHAR;
VAR InputFile : File;
OutputFile : File;
Buffer : BufferType;
BufferPtr : POINTER TO BufferType;
BlockSize : CARDINAL;
Number : CARDINAL;
BEGIN
Lookup(InputFile,SourceFile,FALSE);
IF InputFile.res = done THEN
Lookup(OutputFile,DestinationFile,TRUE);
IF OutputFile.res = done THEN
BufferPtr := ADR(Buffer[1]);
WHILE FileSize > 0.0 DO
IF FileSize > 1024.0 THEN
BlockSize := 1024;
FileSize := FileSize - 1024.0;
ELSE
BlockSize := TRUNC(FileSize);
FileSize := 0.0;
END;
ReadNBytes(InputFile,BufferPtr,BlockSize,Number);
WriteNBytes(OutputFile,BufferPtr,BlockSize,Number);
END;
ResultOfCopy := 0; (* Good copy made *)
Close(OutputFile);
ELSE
ResultOfCopy := 2; (* Cannot open destination file *)
WriteString("Unable to open Destination file ---> ");
WriteString(DestinationFile);
WriteLn;
END;
Close(InputFile);
ELSE
ResultOfCopy := 1;
WriteString("Unable to open Source file ---> ");
WriteString(SourceFile);
WriteLn;
END;
END CopyFile;
BEGIN
END DirHelps.This global module contains several useful file handling and directory manipulation procedures. It is called by the above three example programs used for backup and restore of a fixed disk. These routines are available for your use also if you desire to use them for a file manipulation program.
Their main intent however is that they be a guide for the student to observe methods used to write library functions.
BITOPS.DEF
DEFINITION MODULE BitOps;
(* Copyright (c) 1987 - Coronado Enterprises *)
EXPORT QUALIFIED LogicalAND, (* Note; *)
LogicalOR, (* All of these operations are *)
LogicalXOR, (* performed in a bitwise man- *)
LogicalNOT; (* ner with no carry to higher *)
(* level bits. *)
PROCEDURE LogicalAND(In1, In2 : CARDINAL) : CARDINAL;
(* This procedure obtains the logical AND of *)
(* the arguments and returns the value. *)
PROCEDURE LogicalOR(In1, In2 : CARDINAL) : CARDINAL;
(* This procedure obtains the logical OR of *)
(* the arguments and returns the value. *)
PROCEDURE LogicalXOR(In1, In2 : CARDINAL) : CARDINAL;
(* This procedure obtains the logical XOR of *)
(* the argiments and returns the value. *)
PROCEDURE LogicalNOT(In1 : CARDINAL) : CARDINAL;
(* This procedure returns the bitwise comple- *)
(* ment of the argument. *)
END BitOps.and
BITOPS.MOD
IMPLEMENTATION MODULE BitOps;
(* Coptright (c) 1987 - Coronado Enterprises *)
(* The logical operations performed here are done by converting *)
(* the input CARDINAL values into type BITSET and using the *)
(* resulting properties of the BITSET type to perform the required *)
(* operations. *)
PROCEDURE LogicalAND(In1, In2 : CARDINAL) : CARDINAL;
VAR Result : BITSET;
BEGIN
Result := BITSET(In1) * BITSET(In2);
RETURN CARDINAL(Result);
END LogicalAND;
PROCEDURE LogicalOR(In1, In2 : CARDINAL) : CARDINAL;
VAR Result : BITSET;
BEGIN
Result := BITSET(In1) + BITSET(In2);
RETURN CARDINAL(Result);
END LogicalOR;
PROCEDURE LogicalXOR(In1, In2 : CARDINAL) : CARDINAL;
VAR Result : BITSET;
BEGIN
Result := BITSET(In1) / BITSET(In2);
RETURN CARDINAL(Result);
END LogicalXOR;
PROCEDURE LogicalNOT(In1 : CARDINAL) : CARDINAL;
VAR Result : BITSET;
BEGIN
Result := BITSET(In1) / BITSET(0177777B);
RETURN CARDINAL(Result);
END LogicalNOT;
END BitOps.This module has several generic bit operations such as logical AND, OR, etc. and shift operations. These are useful procedures that you can import and use in your programs if you are doing bit manipulations.
REAL2MON.DEF
DEFINITION MODULE Real2Mon;
(* Copyright (c) 1987 - Coronado Enterprises *)
EXPORT QUALIFIED WriteReal;
(* This procedure allows writing to the monitor in a fully *)
(* formatted manner (i.e. XXXXXX.XXX) instead of the scientific *)
(* notation which is available in the Logitech library. *)
PROCEDURE WriteReal(DataOut : REAL;
FieldSize : CARDINAL;
Digits : CARDINAL);
(* Writes a REAL to the monitor with "FieldSize" total *)
(* columns and "Digits" significant places after the *)
(* decimal point. *)
END Real2Mon.and
REAL2MON.MOD
IMPLEMENTATION MODULE Real2Mon;
(* Copyright (c) 1987 - Coronado Enterprises *)
FROM InOut IMPORT Write;
VAR OutString : ARRAY[0..80] OF CHAR;
(* This procedure uses a rather lengthy method for decomposing the *)
(* REAL number and forming it into single characters. There is a *)
(* procedure available in the Logitech library to do this for you *)
(* but this method is kept as an example of how to decompose the *)
(* number to prepare it for output. It could be much more effi- *)
(* cient to use the Logitech library call. The Procedure is named *)
(* RealConversions.RealTOString, see your library reference. *)
PROCEDURE WriteReal(DataOut : REAL;
FieldSize : CARDINAL;
Digits : CARDINAL);
VAR Index : CARDINAL;
Field : CARDINAL;
Count : CARDINAL;
WholeFieldSize : CARDINAL;
ABSDataOut : REAL;
Char : CHAR;
RoundReal : REAL;
BEGIN
IF DataOut >= 0.0 THEN (* Get the absolute value to work with *)
ABSDataOut := DataOut;
ELSE
ABSDataOut := -DataOut;
END;
(* Make sure the Digits field is positive *)
IF Digits < 0 THEN
Digits := 0;
END;
(* Make sure there are 3 or more digits for the whole part *)
IF (FieldSize - Digits) < 3 THEN
FieldSize := Digits + 3;
END;
RoundReal := 0.5; (* This is used for rounding the data *)
IF Digits = 0 THEN
WholeFieldSize := FieldSize;
ELSE
WholeFieldSize := FieldSize - Digits - 1;
FOR Count := 1 TO Digits DO
RoundReal := RoundReal * 0.1; (* Reduce for each digit *)
END;
END;
ABSDataOut := ABSDataOut + RoundReal; (* Add rounding amount *)
Count := 0;
WHILE ABSDataOut >= 1.0 DO
Count := Count + 1; (* Count significant digits *)
ABSDataOut := 0.1 * ABSDataOut;
END;
WHILE WholeFieldSize > (Count + 1) DO (* Output leading blanks *)
Write(" ");
WholeFieldSize := WholeFieldSize - 1;
END;
IF DataOut >= 0.0 THEN (* Output the sign (- or blank) *)
Write(" ");
ELSE
Write("-");
END;
WHILE Count > 0 DO (* Output the whole part of the number *)
ABSDataOut := 10.0 * ABSDataOut;
Index := TRUNC(ABSDataOut);
Char := CHR(Index + 48); (* 48 = ASCII '0' *)
Write(Char);
ABSDataOut := ABSDataOut - FLOAT(Index);
Count := Count - 1;
END;
IF Digits > 0 THEN (* Output the fractional part of the number *)
Write('.');
FOR Count := 1 TO Digits DO
ABSDataOut := 10.0 * ABSDataOut;
Index := TRUNC(ABSDataOut);
Char := CHR(Index + 48); (* 48 = ASCII '0' *)
Write(Char);
ABSDataOut := ABSDataOut - FLOAT(Index);
END;
END;
END WriteReal;
END Real2Mon.This module has a procedure to output REAL data to the monitor in a neat, easy to read format. It is documented in the header of the source files.
REAL2FIL.DEF
DEFINITION MODULE Real2Fil;
(* Copyright (c) 1987 - Coronado Enterprises *)
FROM FileSystem IMPORT File;
EXPORT QUALIFIED WriteLnFile, WriteStringFile, WriteCardFile,
WriteIntFile, WriteOctFile, WriteHexFile,
WriteRealFile;
(* These routines are used to output formatted data to a file. *)
(* They are used much like the standard output procedures that *)
(* are available in the module "InOut". The only real differ- *)
(* ence is in the REAL output procedure which allows inputting *)
(* the total field size, and the number of digits after the *)
(* decimal point. *)
PROCEDURE WriteLnFile(VAR FileName : File);
(* Writes a return/linefeed to the file. *)
PROCEDURE WriteStringFile(VAR FileName : File;
String : ARRAY OF CHAR);
(* Writes the string to the file. *)
PROCEDURE WriteCardFile(VAR FileName : File;
DataOut : CARDINAL;
FieldSize : CARDINAL);
(* Writes a CARDINAL to the file. *)
PROCEDURE WriteIntFile(VAR FileName : File;
DataOut : INTEGER;
FieldSize : CARDINAL);
(* Writes an INTEGER to the file. *)
PROCEDURE WriteOctFile(VAR FileName : File;
DataOut : CARDINAL;
FieldSize : CARDINAL);
(* Writes a CARDINAL to the file in an octal format *)
PROCEDURE WriteHexFile(VAR FileName : File;
DataOut : CARDINAL;
FieldSize : CARDINAL);
(* Writes a CARDINAL to the file in a hex format. *)
PROCEDURE WriteRealFile(VAR FileName : File;
DataOut : REAL;
FieldSize : CARDINAL;
Digits : CARDINAL);
(* Writes a REAL to the file with "FieldSize" total *)
(* columns and "Digits" significant places after *)
(* the decimal point. *)
END Real2Fil.and
REAL2FIL.MOD
IMPLEMENTATION MODULE Real2Fil;
(* Copyright (c) 1987 - Coronado Enterprises *)
FROM ASCII IMPORT EOL;
FROM FileSystem IMPORT File, WriteChar;
FROM Conversions IMPORT ConvertCardinal, ConvertInteger,
ConvertOctal, ConvertHex;
VAR OutString : ARRAY[0..80] OF CHAR;
PROCEDURE WriteLnFile(VAR FileName : File);
BEGIN
WriteChar(FileName,EOL);
END WriteLnFile;
PROCEDURE WriteStringFile(VAR FileName : File;
String : ARRAY OF CHAR);
VAR Index : CARDINAL;
BEGIN
Index := 0;
WHILE String[Index] <> 000C DO
WriteChar(FileName,String[Index]);
Index := Index + 1;
END;
END WriteStringFile;
PROCEDURE WriteCardFile(VAR FileName : File;
DataOut : CARDINAL;
FieldSize : CARDINAL);
VAR Index : CARDINAL;
BEGIN
ConvertCardinal(DataOut,6,OutString);
WHILE FieldSize > 6 DO
WriteChar(FileName," ");
FieldSize := FieldSize - 1;
END;
FOR Index := 0 TO 5 DO
IF (OutString[Index] <> " ") OR ((6 - Index) <= FieldSize) THEN
WriteChar(FileName,OutString[Index]);
END;
END;
END WriteCardFile;
PROCEDURE WriteIntFile(VAR FileName : File;
DataOut : INTEGER;
FieldSize : CARDINAL);
VAR Index : CARDINAL;
BEGIN
ConvertInteger(DataOut,6,OutString);
WHILE FieldSize > 6 DO
WriteChar(FileName," ");
FieldSize := FieldSize - 1;
END;
FOR Index := 0 TO 5 DO
IF (OutString[Index] <> " ") OR ((6 - Index) <= FieldSize) THEN
WriteChar(FileName,OutString[Index]);
END;
END;
END WriteIntFile;
PROCEDURE WriteOctFile(VAR FileName : File;
DataOut : CARDINAL;
FieldSize : CARDINAL);
VAR Index : CARDINAL;
BEGIN
ConvertOctal(DataOut,6,OutString);
WHILE FieldSize > 6 DO
WriteChar(FileName," ");
FieldSize := FieldSize - 1;
END;
FOR Index := (6 - FieldSize) TO 5 DO
WriteChar(FileName,OutString[Index]);
END;
END WriteOctFile;
PROCEDURE WriteHexFile(VAR FileName : File;
DataOut : CARDINAL;
FieldSize : CARDINAL);
VAR Index : CARDINAL;
BEGIN
ConvertHex(DataOut,4,OutString);
WHILE FieldSize > 4 DO
WriteChar(FileName," ");
FieldSize := FieldSize - 1;
END;
FOR Index := (4 - FieldSize) TO 3 DO
WriteChar(FileName,OutString[Index]);
END;
END WriteHexFile;
(* This procedure uses a rather lengthy method for decomposing the *)
(* REAL number and forming it into single characters. There is a *)
(* procedure available in the Logitech library to do this for you *)
(* but this method is kept as an example of how to decompose the *)
(* number to prepare it for output. It could be much more effi- *)
(* cient to use the Logitech library call. The Procedure is named *)
(* RealConversions.RealTOString, see your library reference. *)
PROCEDURE WriteRealFile(VAR FileName : File;
DataOut : REAL;
FieldSize : CARDINAL;
Digits : CARDINAL);
VAR Index : CARDINAL;
Field : CARDINAL;
Count : CARDINAL;
WholeFieldSize : CARDINAL;
ABSDataOut : REAL;
Char : CHAR;
RoundReal : REAL;
BEGIN
IF DataOut >= 0.0 THEN (* Get the absolute value to work with *)
ABSDataOut := DataOut;
ELSE
ABSDataOut := -DataOut;
END;
(* Make sure the Digits field is positive *)
IF Digits < 0 THEN
Digits := 0;
END;
(* Make sure there are 3 or more digits for the whole part *)
IF (FieldSize - Digits) < 3 THEN
FieldSize := Digits + 3;
END;
RoundReal := 0.5; (* This is used for rounding the data *)
IF Digits = 0 THEN
WholeFieldSize := FieldSize;
ELSE
WholeFieldSize := FieldSize - Digits - 1;
FOR Count := 1 TO Digits DO
RoundReal := RoundReal * 0.1; (* Reduce for each digit *)
END;
END;
ABSDataOut := ABSDataOut + RoundReal; (* Add rounding amount *)
Count := 0;
WHILE ABSDataOut >= 1.0 DO
Count := Count + 1; (* Count significant digits *)
ABSDataOut := 0.1 * ABSDataOut;
END;
WHILE WholeFieldSize > (Count + 1) DO (* Output leading blanks *)
WriteChar(FileName," ");
WholeFieldSize := WholeFieldSize - 1;
END;
IF DataOut >= 0.0 THEN (* Output the sign (- or blank) *)
WriteChar(FileName," ");
ELSE
WriteChar(FileName,"-");
END;
WHILE Count > 0 DO (* Output the whole part of the number *)
ABSDataOut := 10.0 * ABSDataOut;
Index := TRUNC(ABSDataOut);
Char := CHR(Index + 48); (* 48 = ASCII '0' *)
WriteChar(FileName,Char);
ABSDataOut := ABSDataOut - FLOAT(Index);
Count := Count - 1;
END;
IF Digits > 0 THEN (* Output the fractional part of the number *)
WriteChar(FileName,'.');
FOR Count := 1 TO Digits DO
ABSDataOut := 10.0 * ABSDataOut;
Index := TRUNC(ABSDataOut);
Char := CHR(Index + 48); (* 48 = ASCII '0' *)
WriteChar(FileName,Char);
ABSDataOut := ABSDataOut - FLOAT(Index);
END;
END;
END WriteRealFile;
END Real2Fil.This module has several procedures to output REAL and other data type to a file using the FileSystem MODULE. The various procedures are documented in their respective headers.
