mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-24 17:04:19 +00:00
Upload
Digital Research
This commit is contained in:
379
CONTRIBUTIONS/z80em86/support/dostocpm.pas
Normal file
379
CONTRIBUTIONS/z80em86/support/dostocpm.pas
Normal file
@@ -0,0 +1,379 @@
|
||||
(*************************************************************************)
|
||||
(* *)
|
||||
(* DOS-TO-CPM v1.00 (c) Copyright S.J.Kay 18th April 1995 *)
|
||||
(* *)
|
||||
(* Copys DOS files to CP/M *)
|
||||
(* *)
|
||||
(*************************************************************************)
|
||||
|
||||
{ WARNING - Make sure the END address is lowered to say about $8000 }
|
||||
{ before compiling to disk otherwise it will crash when used from }
|
||||
{ within a SUBMIT file. This happens to any TURBO v2.00a compiled }
|
||||
{ program because it does not check the TPA size !. }
|
||||
|
||||
{ As TURBO v2.00a compiled programs overwrite part of the command }
|
||||
{ line parameters (only 1st 31 characters are intact) make sure that }
|
||||
{ FIXTURBO.COM is run on this compiled program to allow full access }
|
||||
{ to command line parameters. }
|
||||
|
||||
{$C-} { turn off ^C and ^S checking }
|
||||
|
||||
const
|
||||
ComLne : string[127] = 'PARAMETERS'; { filled in by patch code }
|
||||
|
||||
ENDBUF = $3FFF; { 16 K copy buffer }
|
||||
TMPFLE = 'DOSTOCPM.$$$';
|
||||
|
||||
type
|
||||
String13 = string[13];
|
||||
String127 = string[127];
|
||||
|
||||
registers = record
|
||||
case boolean of
|
||||
true : (AL, AH, BL, BH, CL, CH, DL, DH : byte);
|
||||
false : (AX, BX, CX, DX,
|
||||
BP, SI, DI, DS, ES, FLAGS : integer)
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
R : registers;
|
||||
F : file;
|
||||
Buffer : array [0..ENDBUF] of byte;
|
||||
DTA : array [0..42] of byte;
|
||||
DirSpc : array [0..79] of byte;
|
||||
FleSpc : array [0..79] of byte;
|
||||
DirMsk : String127;
|
||||
DOSPth : String127;
|
||||
CPMPth : String127;
|
||||
|
||||
Quiet : boolean;
|
||||
ChkWrt : boolean;
|
||||
OvrWrt : boolean;
|
||||
FleHnd : integer;
|
||||
Error : integer;
|
||||
|
||||
|
||||
procedure ProcZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer);
|
||||
begin
|
||||
inline
|
||||
(
|
||||
$3A/Fn/ { ld a,(Fn) }
|
||||
$32/* + 17/ { ld (FNCNMB),a }
|
||||
$3A/Ax/ { ld a,(Ax) }
|
||||
$ED/$4B/BCx/ { ld bc,(BCx) }
|
||||
$ED/$5B/DEx/ { ld de,(DEx) }
|
||||
$2A/HLx/ { ld hl,(HLx) }
|
||||
$D3/$FF { out (FNCNMB),a }
|
||||
)
|
||||
end;
|
||||
|
||||
|
||||
procedure Intr (Int : byte; var R : registers);
|
||||
begin
|
||||
ProcZ80($A1, Int, $AA55, $55AA, addr(R))
|
||||
end;
|
||||
|
||||
|
||||
procedure Msdos (var R : registers);
|
||||
begin
|
||||
Intr($21, R)
|
||||
end;
|
||||
|
||||
|
||||
function Seg (var Dummy) : integer;
|
||||
const
|
||||
SegAdr : integer = 0;
|
||||
begin
|
||||
ProcZ80($A0, 0, 0, 0, addr(SegAdr));
|
||||
Seg := SegAdr
|
||||
end;
|
||||
|
||||
|
||||
function Ofs (var VarTyp) : integer;
|
||||
begin
|
||||
Ofs := addr(VarTyp)
|
||||
end;
|
||||
|
||||
|
||||
function FileFound (FstDir : boolean) : boolean;
|
||||
begin
|
||||
R.AH := $1A; { set DTA function }
|
||||
R.DS := seg(DTA);
|
||||
R.DX := ofs(DTA);
|
||||
Msdos(R);
|
||||
if FstDir then
|
||||
R.AH := $4E { search for first function }
|
||||
else
|
||||
R.AH := $4F; { search for next function }
|
||||
R.CX := 0;
|
||||
R.DS := seg(DirSpc);
|
||||
R.DX := ofs(DirSpc);
|
||||
Msdos(R);
|
||||
FileFound := not odd(R.Flags);
|
||||
if FstDir and odd(R.Flags) then
|
||||
writeln('No files found to match: ', DirMsk)
|
||||
end;
|
||||
|
||||
|
||||
procedure OpenFiles (FleNme : String13);
|
||||
var
|
||||
TmpStr : String127;
|
||||
UsrRes : string[1];
|
||||
Result : integer;
|
||||
begin
|
||||
if not Quiet then
|
||||
writeln('Copying: ', FleNme);
|
||||
TmpStr := DOSPth + FleNme;
|
||||
move(TmpStr[1], FleSpc, length(TmpStr));
|
||||
FleSpc[length(TmpStr)] := 0;
|
||||
R.AH := $3D; { open file function }
|
||||
R.AL := $00; { read access }
|
||||
R.DS := seg(FleSpc);
|
||||
R.DX := ofs(FleSpc);
|
||||
Msdos(R); { open DOS file for reading }
|
||||
Error := R.Flags and 1;
|
||||
if Error = 0 then
|
||||
begin
|
||||
FleHnd := R.AX; { file handle }
|
||||
OvrWrt := true;
|
||||
{$I-}
|
||||
if ChkWrt then
|
||||
begin
|
||||
assign(F, CPMPth + FleNme);
|
||||
reset(F); { does file exist ? }
|
||||
if ioresult = 0 then
|
||||
begin
|
||||
close(F);
|
||||
Result := ioresult;
|
||||
write('Overwrite ', CPMPth, FleNme, ' ? (y/n): ');
|
||||
readln(UsrRes);
|
||||
OvrWrt := (UsrRes = 'y') or (UsrRes = 'Y')
|
||||
end
|
||||
end;
|
||||
if OvrWrt then
|
||||
begin
|
||||
assign(F, CPMPth + TMPFLE);
|
||||
rewrite(F); { open temporary CP/M file for writing }
|
||||
Error := ioresult;
|
||||
if Error <> 0 then
|
||||
writeln('Error CP/M disk directory full')
|
||||
end
|
||||
{$I+}
|
||||
end
|
||||
else
|
||||
writeln('Error opening DOS file for reading')
|
||||
end;
|
||||
|
||||
|
||||
procedure CloseFiles (FleNme : String13);
|
||||
var
|
||||
Result : integer;
|
||||
begin
|
||||
R.AH := $3E; { close file function }
|
||||
R.BX := FleHnd; { file handle }
|
||||
Msdos(R); { close DOS file }
|
||||
Error := R.Flags and 1;
|
||||
if Error <> 0 then
|
||||
writeln('Error closing DOS source file');
|
||||
if OvrWrt and (Error = 0) then
|
||||
begin
|
||||
{$I-}
|
||||
close(F); { close temporary CP/M file }
|
||||
Error := ioresult;
|
||||
if Error = 0 then
|
||||
begin
|
||||
assign(F, CPMPth + FleNme);
|
||||
erase(F);
|
||||
Result := ioresult;
|
||||
assign(F, CPMPth + TMPFLE);
|
||||
rename(F, CPMPth + FleNme);
|
||||
Error := ioresult;
|
||||
if Error <> 0 then
|
||||
writeln('Error renaming temporary CP/M file')
|
||||
end
|
||||
else
|
||||
writeln('Error closing temporary CP/M file')
|
||||
end
|
||||
{$I+}
|
||||
end;
|
||||
|
||||
|
||||
procedure CopyFile (FleNme : String13);
|
||||
var
|
||||
EndFle : boolean;
|
||||
Blocks : integer;
|
||||
begin
|
||||
repeat
|
||||
R.AH := $3F; { read file or device function }
|
||||
R.BX := FleHnd; { file handle }
|
||||
R.CX := ENDBUF+1; { bytes to read }
|
||||
R.DS := seg(Buffer);
|
||||
R.DX := ofs(Buffer);
|
||||
Msdos(R); { read data from DOS file }
|
||||
Error := R.Flags and 1;
|
||||
if Error = 0 then
|
||||
begin
|
||||
Blocks := (R.AX + 127) div 128;
|
||||
EndFle := R.AX < (ENDBUF + 1);
|
||||
if EndFle then
|
||||
Buffer[R.AX] := ord(^Z);
|
||||
{$I-}
|
||||
blockwrite(F, Buffer, Blocks); { write to CP/M file }
|
||||
Error := ioresult;
|
||||
if Error <> 0 then
|
||||
writeln('Error CP/M disk full')
|
||||
{$I+}
|
||||
end
|
||||
else
|
||||
writeln('Error reading DOS file')
|
||||
until EndFle or (Error <> 0)
|
||||
end;
|
||||
|
||||
|
||||
procedure TransferFiles;
|
||||
var
|
||||
FstDir, Found : boolean;
|
||||
FleNme : String13;
|
||||
i : integer;
|
||||
begin
|
||||
DOSPth := DirMsk;
|
||||
i := length(DOSPth);
|
||||
while (i > 0) and (not (DOSPth[i] in ['\', ':'])) do
|
||||
i := i - 1;
|
||||
DOSPth[0] := chr(i);
|
||||
move(DirMsk[1], DirSpc, length(DirMsk));
|
||||
DirSpc[length(DirMsk)] := 0;
|
||||
FstDir := true;
|
||||
while FileFound(FstDir) and (Error = 0) do
|
||||
begin
|
||||
FstDir := false;
|
||||
i := 0;
|
||||
FleNme := '';
|
||||
while (i < 13) and (DTA[$1E+i] <> 0) do
|
||||
begin
|
||||
FleNme := FleNme + chr(DTA[$1E+i]);
|
||||
i := i + 1
|
||||
end;
|
||||
OpenFiles(FleNme);
|
||||
if OvrWrt and (Error = 0) then
|
||||
CopyFile(FleNme);
|
||||
if Error = 0 then
|
||||
CloseFiles(FleNme)
|
||||
end
|
||||
end;
|
||||
|
||||
|
||||
function ParmCount : integer;
|
||||
var
|
||||
i, PrmCnt, PrmLen : integer;
|
||||
begin
|
||||
i := 1;
|
||||
PrmCnt := 0;
|
||||
PrmLen := length(ComLne);
|
||||
while i <= PrmLen do
|
||||
begin
|
||||
while (i <= PrmLen) and (ComLne[i] = ' ') do
|
||||
i := i + 1;
|
||||
if i <= PrmLen then
|
||||
PrmCnt := PrmCnt + 1;
|
||||
if ComLne[i] = '/' then
|
||||
i := i + 1;
|
||||
while (i <= PrmLen) and (not(ComLne[i] in [' ', '/'])) do
|
||||
i := i + 1
|
||||
end;
|
||||
ParmCount := PrmCnt
|
||||
end;
|
||||
|
||||
|
||||
function ParamStr (PrmNmb : integer) : String127;
|
||||
var
|
||||
i, PrmCnt, PrmLen : integer;
|
||||
PrmStr : string[127];
|
||||
begin
|
||||
i := 1;
|
||||
PrmCnt := 0;
|
||||
PrmStr := '';
|
||||
PrmLen := length(ComLne);
|
||||
while (i <= PrmLen) and (PrmCnt < PrmNmb) do
|
||||
begin
|
||||
while (i <= PrmLen) AND (ComLne[i] = ' ') do
|
||||
i := i + 1;
|
||||
if i <= PrmLen then
|
||||
PrmCnt := PrmCnt + 1;
|
||||
if ComLne[i] = '/' then
|
||||
begin
|
||||
PrmStr := '/';
|
||||
i := i + 1
|
||||
end
|
||||
else
|
||||
PrmStr := '';
|
||||
while (i <= PrmLen) and (not (ComLne[i] in [' ', '/'])) do
|
||||
begin
|
||||
PrmStr := PrmStr + ComLne[i];
|
||||
i := i + 1
|
||||
end
|
||||
end;
|
||||
ParamStr := PrmStr
|
||||
end;
|
||||
|
||||
|
||||
function ScanForSwitches (PrmNmb : integer) : integer;
|
||||
var
|
||||
SwtStr : String127;
|
||||
SwtPos, i : integer;
|
||||
begin
|
||||
repeat
|
||||
SwtStr := ParamStr(PrmNmb);
|
||||
SwtPos := pos('/', SwtStr);
|
||||
if Swtpos <> 0 then
|
||||
begin
|
||||
PrmNmb := PrmNmb - 1;
|
||||
delete(SwtStr, 1, 1);
|
||||
for i := 1 to length(SwtStr) do
|
||||
SwtStr[i] := upcase(SwtStr[i]);
|
||||
if SwtStr = 'Q' then
|
||||
Quiet := true;
|
||||
if SwtStr = 'F' then
|
||||
ChkWrt := false
|
||||
end
|
||||
until SwtPos = 0;
|
||||
ScanForSwitches := PrmNmb
|
||||
end;
|
||||
|
||||
|
||||
procedure ShowUsage;
|
||||
begin
|
||||
writeln;
|
||||
writeln('DOS-TO-CPM v1.00 (c) Copyright S.J.Kay 18th April 1995');
|
||||
writeln;
|
||||
writeln('Use:- dostocpm (d:\path\files) (d:\path\files)... c: [/f/q]');
|
||||
writeln;
|
||||
writeln('d:\path\files = DOS drive, path and files');
|
||||
writeln(' c: = CP/M drive path');
|
||||
writeln(' /f = force overwriting of existing file(s)');
|
||||
writeln(' /q = quiet, no display of file names')
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
PrmTot, PrmNmb : integer;
|
||||
SwtStr : String127;
|
||||
begin
|
||||
Quiet := false;
|
||||
ChkWrt := true;
|
||||
Error := 0;
|
||||
PrmNmb := 1;
|
||||
PrmTot := ScanForSwitches(ParmCount);
|
||||
CpmPth := ParamStr(PrmTot);
|
||||
if PrmTot > 1 then
|
||||
begin
|
||||
repeat
|
||||
DirMsk := ParamStr(PrmNmb);
|
||||
PrmNmb := PrmNmb + 1;
|
||||
TransferFiles
|
||||
until (PrmNmb >= PrmTot) or (Error <> 0)
|
||||
end
|
||||
else
|
||||
ShowUsage
|
||||
end.
|
||||
Reference in New Issue
Block a user