home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
cpm
/
utils
/
dskutl
/
swp-ms10.ark
/
TRAMDF.IF0
< prev
next >
Wrap
Text File
|
1989-09-27
|
18KB
|
414 lines
{* -------------------------------------------------------------------------
* G L O B A L D E F I N I T I O N S
* ------------------------------------------------------------------------- *}
const
Version = '1.9110' ; { Version number of TraMDF }
DefaultDate= '19911101' ; { Compilation date of TraMDF }
{*
* Sizes of buffers and tables.
*}
SectorSize = 511 ; { Size of a sector - 1 }
ClusterSize = 1023 ; { Size of a cluster - 1 }
FatSize = 1535 ; { Size of a FAT - 1 }
BytesPerFcb = 32 ; { Size of an MS-DOS FCB }
BytesPerRecord= 128 ; { Size of a CP/M record }
ErrorStackSize= 3 ; { Size of stack of errormessages - 1 }
MsdosPathSize = 7 ; { Maximum subdirectory nesting level }
{*
* BDOS function codes.
*}
SetCurrentDrive = 14 ; { Login disk }
GetCurrentDrive = 25 ; { Retrieve current default drive }
GetAllocationMap = 27 ; { Retrieve address of allocation bitmap }
SetFileAttributes= 30 ; { (Re)set file attributes }
{*
* BIOS function codes. These codes are off by one because TP assigns
* function code zero to the WarmBoot entry.
*}
SelectDrive = 8 ; { Select a drive }
SelectTrack = 9 ; { Select LOGICAL track }
SelectRecord= 10 ; { Select ordinal of record to transfer }
SelectBuffer= 11 ; { Select record buffer address }
ReadRecord = 12 ; { Read one record }
WriteRecord = 13 ; { Write one record }
type
OSs = ( Cpm, Msdos ) ; { Supported Operating (file) systems }
FileNames= array[01..11] of Char ; { CP/M and MS-DOS file name }
FileSizes= array[00..03] of Byte ; { MS-DOS file size }
FileAttributes= ( ReadOnly , Hidden , System , Volume ,
SubDirectory, Archive, Unused6, Unused7 ) ;
FileClasses = ( TextFile, BinaryFile, AskUser ) ;
EntryTypes= ( VolumeNameEntry, SubdirectoryNameEntry, FileNameEntry,
FreeEntry , UnusedEntry , EndOfDirectory ) ;
SearchPositions= ( BeforeFirstEntry, InSubDirectory, AfterLastEntry ) ;
DateStrings = string[ 8] ; { Numeric date string }
ErrorMessages= string[48] ; { Error message string }
{*
* Define the structure of the (XLT and) DPB within BIOS. The XLT is
* used to map sector numbers (see procedure ReadSector). The DPB, and
* especially its extension, is used to hold the characteristics of the
* disk. It is assumed that modification of the DPB together with some
* address mapping is sufficient to read and write MS-DOS disks.
*
* CAUTION : The definition of the DPB is system dependent, except for the
* fields SPT through OFF which are standard for CP/M.
*}
DPBs = record
XLT: array[0..25] of Byte ; { sector translate table }
SPT: Integer ; { Number of logical sectors per track }
BSH: Byte ; { Data allocation block shift factor }
BLM: Byte ; { Data allocation block mask }
EXM: Byte ; { Extent mask }
DSM: Integer ; { Maximum data block number }
DRM: Integer ; { Maximum directory entry number }
ALM: Integer ; { Directory allocation mask }
CKS: Integer ; { Directory check vector size }
OFF: Integer ; { Number of reserved tracks }
FNO: Byte ; { Flags & Numbering scheme Ordinal }
DDS: Byte ; { Density & Drive Select }
PDA: Byte ; { Physical Drive Address }
TFC: Byte ; { Track # on First Cylinder }
PSS: Byte ; { Physical Sector Size }
PCD: Byte ; { Number of cylinders per disk }
PST: Byte ; { Number of sectors per track }
end ;
{*
* Define the File_Control_Block (FCB) of both CP/M and MS-DOS, that is
* the structure of the directory entries. Thus, the CP/M FCB can only
* be used for directory search operations, while for actual CP/M file
* actions an untyped pascal file is used.
*}
CpmFCBs= record
Drive : Byte ; { Drive code }
FileName: FileNames ; { Name including type }
Extent : Byte ; { Extent number }
S1, S2 : Byte ; { Reserved for CP/M internal use }
RecCnt : Byte ; { Records in current extent }
Blocks : array[16..31] of Byte ; { Allocated blocks }
{ RecPntr : Byte ; { Current record ordinal }
{ R0,R1,R2: Byte ; { Random record number }
end ;
MsdosFCBs= record
FileName : FileNames ; { Name including type }
Attribute: set of FileAttributes ; { File attributes }
Rsrvd : array[12..21] of Byte ;
Time : Integer ; { Time of last mod }
Date : Integer ; { Date of last mod }
Cluster : Integer ; { First cluster in file }
Size : FileSizes ; { Size of file }
end ;
{*
* Define the structure of the Turbo Pascal File Information Block (FIB).
* It is used in BDOS file calls: the above defined CpmFcbs cannot be used
* for this purpose!
*}
CpmFibs= record
Filler: array[0..11] of Byte ; { TP information }
Fcb : array[0..35] of Byte ; { BDOS information }
end ; { of record }
{*
* Define a record to hold the disk drive configuration information. This
* information is partly derived from the current system configuration and
* it is partly hardcoded in procedure DetermineDriveAttributes.
*
* The device address is included because the Aster BIOS allows one to
* assign more than one logical drive to one physical drive, while at
* the same time it does not care about the associated problems. Using
* DevAddress, TraMDF avoids using one physical drive for CP/M and MS-DOS
* simultaneously.
*}
DriveNames = 'A'..'P' ; { Legal drive names }
DriveAttributes= record
DpbAddress: ^DPBs ; { Address of it's (XLT &) DPB }
DevAddress: Integer ; { Physical device address }
Cylinders : Integer ; { Number of cylinders }
Heads : Integer ; { Number of heads }
end ;
{*
* Define the record to hold one entry of the list of files.
*}
FileEntryPtr= ^FileEntries ;
FileEntries = record
Next: FileEntryPtr ; { Next one in list }
Prev: FileEntryPtr ; { Previous one in the list }
Name: FileNames ; { Name of file }
Attr: Set of FileAttributes ;
Size: Integer ; { Size of file [kB] }
Mark: Boolean ; { File is marked }
end ;
var
{*
* Disk drive configuration.
*}
ConfiguredDrives: set of DriveNames ; { Configured drives in CP/M }
FloppyDrives : set of DriveNames ; { Configured floppy drives }
DriveAttribute : array[DriveNames] of DriveAttributes ;
{*
* Attributes of the default CP/M drive.
*}
CpmCurrentDrive: Byte ; { BDOS default drive }
CpmDrive : Integer ; { Target CP/M drive }
CpmDriveName : FileDescriptors ; { CP/M drive and user area }
CpmDriveAddress: Integer ; { Physical drive address }
{*
* Attributes of the MS-DOS drive.
*}
MsdosDrive : Integer ; { Drive with MS-DOS diskette }
MsdosDriveName : Char ; { Drive with MS-DOS diskette }
MsdosDriveAddress: Integer ; { Physical address of MS-DOS drive }
MsdosDpb : ^DPBs ; { DPB in use for MS-DOS disk }
MsdosFcb :^MsdosFcbs ; { FCB in use for MS-DOS file }
{*
* Parameters of the currently active MS-DOS floppy disk. These parameters
* are determined from the information in the bootsector at the time the
* MS-DOS drive is 'logged in'.
*}
SystemIdent : String[8] ; { Name if MS-DOS system }
FormatIdent : Byte ; { Media descriptor }
BytesPerSector : Integer ; { Size of physical sector [bytes] }
FcbsPerSector : Integer ; { Size of physical sector [FCB's] }
RecordsPerSector : Integer ; { Size of physical sector [CP/M records] }
SectorsPerFat : Integer ; { Size of FAT [sectors] }
RecordsPerCluster: Integer ; { Size of cluster [records] }
SectorsPerCluster: Integer ; { Size of cluster [sectors] }
SectorsPerTrack : Integer ; { Size of track [sectors] }
SectorsPerDisk : Integer ; { Size of disk [sectors] }
ClustersPerDisk : Integer ; { Size of disk [clusters] }
FatsPerDisk : Integer ; { Number of FATs }
SidesPerDisk : Integer ; { Number of heads }
CylindersPerDisk : Integer ; { Number of cylinders }
FirstFatSector : Integer ; { Ordinal of 1th sector of FAT }
FirstDataSector : Integer ; { Ordinal of 1th sector with user data }
RootDirectoryStart: Integer ; { First sector of root directory }
RootDirectorySize : Integer ; { Number of sectors in root directory }
{*
* Directory search variables.
*}
DirectorySearchPos: SearchPositions ; { Indication of search position }
DirectoryStartCls : Integer ; { First cluster in dir chain }
DirectoryCluster : Integer ; { Current cluster in dir chain }
DirectoryStartSct : Integer ; { First sector in current dir (cluster) }
DirectorySize : Integer ; { Number of sectors in current dir }
DirectorySector : Integer ; { Sector currently in dir buffer }
DirectoryOrdinal : Integer ; { Ordinal of FCB in dir sector }
DirectoryNesting : Integer ; { Current directory nesting level }
MsdosPath: array[0..MsdosPathSize] of string[12] ; { Full path name }
{*
* File manager variables.
*}
DestinationOS : OSs ; { Current destination OS }
SourceOS : OSs ; { Current source OS }
HeadFileList : FileEntryPtr ; { Head of filelist }
TailFileList : FileEntryPtr ; { Tail of filelist }
SizeFileList : Integer ; { Number of files in list }
FileEntry : FileEntryPtr ; { Current file in list }
FileIndex : Integer ; { Ordinal of current file }
FileClass : FileClasses ; { Type of file }
SizeTaggedFiles: Integer ; { Sum of sizes of tagged files }
ACpmFile : File ; { Some CP/M file }
ACpmFileName : FileDescriptors ; { Name of 'some' CP/M file }
AMsdosFileName: FileDescriptors ; { Name of 'some' MS-DOS file }
CpmBinFillChar : Byte ; { Character to fill up CP/M record }
CpmTxtFillChar : Byte ; { Character to fill up CP/M record }
MsdosFillChar : Byte ; { Character to fill up MS-DOS cluster }
CopyCpmFileAttr : Boolean ; { Copy CP/M file attributes to MS-DOS file }
CopyMsdosFileAttr: Boolean ; { Copy MS-DOS file attributes to CP/M file }
MsdosDate : Integer ; { Current date, MS-DOS formatted }
TodaysDate: DateStrings ; { Current date, numeric string }
{*
* Error handling.
*}
ErrorDetected: Boolean ; { Some error has been detected }
ErrorIndex : Integer ; { Current stacking level of errors }
ErrorMessage : array[0..ErrorStackSize] of ErrorMessages ;
{*
* Buffer areas.
*}
ClusterBuffer: array[0..ClusterSize] of Byte ; { Buffer for one cluster }
DirBuffer : array[0.. SectorSize] of Byte ; { Directory buffer }
FatBuffer : array[0.. FatSize] of Byte ; { File Assignment Table }
SavedDpb : DPBs ; { Save area for CP/M DPB }
{*
* Define the limits of the memory area allocated to the global variables.
* These limits are used to preset all the global variables in a fast way.
*}
FirstGlobalVariable: Byte ; { Lowest address ! }
LastGlobalVariable : Byte absolute ConfiguredDrives; { Highest address ! }
const
{*
* Define a skeletal MS-DOS DPB, which is enough to read the boot sector.
* The fields SPT, BLM as well as all the extension fields need to be set
* lateron according to the actual MS-DOS disk format.
*}
SkeletDpb: DPBs =
( XLT:(01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,
21,22,23,24,25,26) ;
SPT: 72 ; BSH:$02 ; BLM:$03 ; EXM:$01 ; DSM:180 ; DRM: 64 ;
ALM:128 ; CKS:$00 ; OFF: 00 ; FNO:$07 ; DDS:$A0 ; PDA:$00 ;
TFC: 00 ; PSS: 04 ; PCD: 40 ; PST: 09 ) ;
{* -------------------------------------------------------------------------
* E L E M E N T A R Y C O N S O L E I / O
* ------------------------------------------------------------------------- *}
procedure Continue ;
{*
* Ask the attention of the user and the permission to go ahead.
*}
var
SomeChar: Char ; { Character read from keyboard }
begin
Write( ^G'Press <Return> to continue.' ) ;
repeat
Read( Kbd, SomeChar ) ;
until SomeChar=Cr ;
end ; { of Continue }
function ReadYesNoAnswer( Question: ErrorMessages ) : Char ;
{*
* Read a Y(es) or N(o) answer on the given question.
*}
var
Answer: Char ; { Answer read }
begin
Write( Question, '? ' ) ;
repeat
Read ( Kbd, Answer ) ;
Answer:= UpCase( Answer ) ;
until Answer in ['N','Y'] ;
Write( Answer, ' ' ) ;
ReadYesNoAnswer:= Answer ;
end ; { of ReadYesNoAnswer }
{* -------------------------------------------------------------------------
* E R R O R H A N D L I N G
* ------------------------------------------------------------------------- *}
{*
* The following ideas with respect to error handling are incorporated
* in this program:
*
* Each basic procedure, that is each procedure that does not invoke another
* pascal procedure, that handles disk I/O, flags an error when detected and
* it returns immediatly to the calling procedure. A basic function will
* pass some sort of end indication after an error has been detected.
*
* Each non-basic procedure checks a global errorflag to see if an error has
* been detected by a basic procedure. It will prepend its name to the error-
* message and return immediatly.
*
* At the top level procedure, errors, if any, are reported to the user. Once
* reported the error condition is cleared. Thus after an error is detected,
* the operation is terminated immediatly and the error is reported.
* However, it may be necessary to clean up the remnants of the partially
* completed operation in an error-free state. For this purpose a stack of
* errors is introduced. During the clean-up the error status is saved and it
* is restored once the cleaning-up is done. In this way, the errors detected
* during clean-up can be handled in the normal fashion.
*}
procedure BuildErrorTrace( Name: ErrorMessages ) ;
{*
* Add the name of a procedure in front of the current errormessage.
* In this way an elementary trace mechanism is implemented.
*}
begin
ErrorMessage[ErrorIndex]:= Name + ErrorMessage[ErrorIndex] ;
end ; { of BuildErrorTrace }
procedure ClearError ;
{*
* Clear the current error message. This procedure will be called if there
* is a possibility to recover the error.
*}
begin
ErrorDetected := False ;
ErrorMessage[ErrorIndex]:= '' ;
end ; { of ClearError }
procedure FlagError( Details: ErrorMessages ) ;
{*
* Signal the detection of an error in the global error variables. However,
* do NOT overwrite a pending errormessage: The first one is probably the
* most descriptive/meaningfull one.
*}
begin
if not ErrorDetected then
begin
ErrorDetected:= True ;
ErrorMessage[ErrorIndex]:= Details ;
end ;
end ; { of FlagError }
procedure PopErrorMessage ;
{*
* 'Pop' the previous error message, if any, from the error message stack
* and continue in that errorstate.
*}
begin
if ErrorIndex>0 then
begin
ErrorIndex := 0 ;
ErrorDetected:= Length(ErrorMessage[0])<>0 ;
end ;
end ; { of PopErrorMessage }
procedure PushErrorMessage ;
{*
* 'Push' the current error message onto the error message stack. Search
* for and activate an unused entry in the stack. This procedure should be
* invoked whenever another basic MS-DOS function is to be executed.
*}
begin
repeat
ErrorIndex := Succ( ErrorIndex ) ;
ErrorDetected:= Length(ErrorMessage[ErrorIndex])<>0 ;
until (ErrorIndex=ErrorStackSize) or (not ErrorDetected) ;
end ; { of PushErrorMessage }
procedure ReportError ;
{*
* Display the stack of errormessages and remove them from the stack. The
* errorstatus is cleared.
*}
var
I: Integer ; { Loop control variable }
begin
ErrorDetected:= False ; { No error(s) found yet in the stack }
for I:= 0 to ErrorStackSize do
if Length(ErrorMessage[I])>0 then
begin
if not ErrorDetected then
Write( ^M^J^J ) ;
WriteLn( 'Error in ', ErrorMessage[I], '. ' ) ;
ErrorMessage[I]:= '' ;
ErrorDetected := True ; { An error has been found in the stack }
end ; { of if/for }
if ErrorDetected then
begin
ErrorDetected:= False ;
Continue ;
end ; { of if }
ErrorIndex:= 0 ;
end ; { of ReportError }