* initialize argc and argv on i8086-msdos. This fixes paramcount and paramstr

in objfpc mode on this platform (mantis #28705)
+ support quoted parameters like the go32v2 target

git-svn-id: trunk@32018 -
This commit is contained in:
nickysn 2015-10-11 17:38:45 +00:00
parent 4454332d7a
commit ace95e550b

View File

@ -58,7 +58,7 @@ var
memw : array[0..($7fff div sizeof(word))-1] of word absolute $0:$0; memw : array[0..($7fff div sizeof(word))-1] of word absolute $0:$0;
meml : array[0..($7fff div sizeof(longint))-1] of longint absolute $0:$0; meml : array[0..($7fff div sizeof(longint))-1] of longint absolute $0:$0;
{ C-compatible arguments and environment } { C-compatible arguments and environment }
argc:longint; //!! public name 'operatingsystem_parameter_argc'; argc:smallint; //!! public name 'operatingsystem_parameter_argc';
argv:PPchar; //!! public name 'operatingsystem_parameter_argv'; argv:PPchar; //!! public name 'operatingsystem_parameter_argv';
{ The DOS Program Segment Prefix segment (TP7 compatibility) } { The DOS Program Segment Prefix segment (TP7 compatibility) }
@ -210,75 +210,222 @@ begin
end; end;
function GetProgramName: string; procedure setup_arguments;
var var
cp: PFarChar; I: SmallInt;
pc: PChar;
pfc: PFarChar;
quote: Char;
count: SmallInt;
arglen, argv0len: SmallInt;
argblock: PChar;
arg: PChar;
doscmd : string[129]; { Dos commandline copied from PSP, max is 128 chars +1 for terminating zero }
begin begin
GetProgramName := ''; { load commandline from psp }
cp := dos_argv0; SetLength(doscmd, Mem[PrefixSeg:$80]);
if cp = nil then for I := 1 to length(doscmd) do
exit; doscmd[I] := Chr(Mem[PrefixSeg:$80+I]);
while cp^ <> #0 do doscmd[length(doscmd)+1]:=#0;
{$IfDef SYSTEM_DEBUG_STARTUP}
Writeln(stderr,'Dos command line is #',doscmd,'# size = ',length(doscmd));
{$EndIf }
{ find argv0len }
argv0len:=0;
if dos_argv0<>nil then
begin begin
GetProgramName := GetProgramName + cp^; pfc:=dos_argv0;
Inc(cp); while pfc^<>#0 do
begin
Inc(argv0len);
Inc(pfc);
end; end;
end; end;
{ parse dos commandline }
pc:=@doscmd[1];
function GetCommandLine: string; count:=1;
var { calc total arguments length and count }
len, I: Integer; arglen:=argv0len+1;
while pc^<>#0 do
begin begin
len := PFarByte(Ptr(PrefixSeg, $80))^; { skip leading spaces }
SetLength(GetCommandLine, len); while pc^ in [#1..#32] do
for I := 1 to len do inc(pc);
GetCommandLine[I] := PFarChar(Ptr(PrefixSeg, $80 + I))^; if pc^=#0 then
break;
{ calc argument length }
quote:=' ';
while (pc^<>#0) do
begin
case pc^ of
#1..#32 :
begin
if quote<>' ' then
inc(arglen)
else
break;
end; end;
'"' :
function GetArg(ArgNo: Integer; out ArgResult: string): Integer;
var
cmdln: string;
I: Integer;
InArg: Boolean;
begin begin
cmdln := GetCommandLine; if quote<>'''' then
ArgResult := '';
I := 1;
InArg := False;
GetArg := 0;
for I := 1 to Length(cmdln) do
begin begin
if not InArg and (cmdln[I] <> ' ') then if pchar(pc+1)^<>'"' then
begin begin
InArg := True; if quote='"' then
Inc(GetArg); quote:=' '
else
quote:='"';
end
else
inc(pc);
end
else
inc(arglen);
end; end;
if InArg and (cmdln[I] = ' ') then '''' :
InArg := False; begin
if InArg and (GetArg = ArgNo) then if quote<>'"' then
ArgResult := ArgResult + cmdln[I]; begin
if pchar(pc+1)^<>'''' then
begin
if quote='''' then
quote:=' '
else
quote:='''';
end
else
inc(pc);
end
else
inc(arglen);
end;
else
inc(arglen);
end;
inc(pc);
end;
inc(arglen); { for the null terminator }
inc(count);
end;
{ set argc and allocate argv }
argc:=count;
argv:=AllocMem((count+1)*SizeOf(PChar));
{ allocate a single memory block for all arguments }
argblock:=GetMem(arglen);
{ create argv[0] }
argv[0]:=argblock;
arg:=argblock;
if dos_argv0<>nil then
begin
pfc:=dos_argv0;
while pfc^<>#0 do
begin
arg^:=pfc^;
Inc(arg);
Inc(pfc);
end;
end;
arg^:=#0;
Inc(arg);
pc:=@doscmd[1];
count:=1;
while pc^<>#0 do
begin
{ skip leading spaces }
while pc^ in [#1..#32] do
inc(pc);
if pc^=#0 then
break;
{ copy argument }
argv[count]:=arg;
quote:=' ';
while (pc^<>#0) do
begin
case pc^ of
#1..#32 :
begin
if quote<>' ' then
begin
arg^:=pc^;
inc(arg);
end
else
break;
end;
'"' :
begin
if quote<>'''' then
begin
if pchar(pc+1)^<>'"' then
begin
if quote='"' then
quote:=' '
else
quote:='"';
end
else
inc(pc);
end
else
begin
arg^:=pc^;
inc(arg);
end;
end;
'''' :
begin
if quote<>'"' then
begin
if pchar(pc+1)^<>'''' then
begin
if quote='''' then
quote:=' '
else
quote:='''';
end
else
inc(pc);
end
else
begin
arg^:=pc^;
inc(arg);
end;
end;
else
begin
arg^:=pc^;
inc(arg);
end;
end;
inc(pc);
end;
arg^:=#0;
Inc(arg);
{$IfDef SYSTEM_DEBUG_STARTUP}
Writeln(stderr,'dos arg ',count,' #',strlen(argv[count]),'#',argv[count],'#');
{$EndIf SYSTEM_DEBUG_STARTUP}
inc(count);
end; end;
end; end;
function paramcount : longint; function paramcount : longint;
var
tmpstr: string;
begin begin
paramcount := GetArg(-1, tmpstr); paramcount := argc - 1;
end; end;
function paramstr(l : longint) : string; function paramstr(l : longint) : string;
begin begin
if l = 0 then if (l>=0) and (l+1<=argc) then
paramstr := GetProgramName paramstr:=strpas(argv[l])
else else
GetArg(l, paramstr); paramstr:='';
end; end;
procedure randomize; procedure randomize;
var var
hl : longint; hl : longint;
@ -393,6 +540,7 @@ begin
SysInitStdIO; SysInitStdIO;
{ Setup environment and arguments } { Setup environment and arguments }
Setup_Environment; Setup_Environment;
Setup_Arguments;
{ Use LFNSupport LFN } { Use LFNSupport LFN }
LFNSupport:=CheckLFN; LFNSupport:=CheckLFN;
if LFNSupport then if LFNSupport then