paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 04:19:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Moved command line handling and randomize() to syswin.inc, so a single copy of code is used for both win32 and win64. This implies that apostrophe is no longer supported as quoting symbol in win64.

Browse Source 
Win64 doesn't support it itself either.

git-svn-id: trunk@19201 -
This commit is contained in:
sergei 2011-09-23 21:45:02 +00:00
parent b997094755
commit ad5d2ccabb
3 changed files with 148 additions and 358 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

148
rtl/win/syswin.inc
View File

@ -99,6 +99,154 @@ const
MAXIMUM_SUPPORTED_EXTENSION = 512;
{*****************************************************************************
Parameter Handling
*****************************************************************************}
procedure setup_arguments;
var
arglen,
count : longint;
argstart,
pc,arg : pchar;
quote : Boolean;
argvlen : longint;
buf: array[0..259] of char; // need MAX_PATH bytes, not 256!
procedure allocarg(idx,len:longint);
var
oldargvlen : longint;
begin
if idx>=argvlen then
begin
oldargvlen:=argvlen;
argvlen:=(idx+8) and (not 7);
sysreallocmem(argv,argvlen*sizeof(pointer));
fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
end;
{ use realloc to reuse already existing memory }
{ always allocate, even if length is zero, since }
{ the arg. is still present! }
sysreallocmem(argv[idx],len+1);
end;
begin
{ create commandline, it starts with the executed filename which is argv[0] }
{ Win32 passes the command NOT via the args, but via getmodulefilename}
count:=0;
argv:=nil;
argvlen:=0;
ArgLen := GetModuleFileName(0, @buf[0], sizeof(buf));
buf[ArgLen] := #0; // be safe
allocarg(0,arglen);
move(buf,argv[0]^,arglen+1);
{ Setup cmdline variable }
cmdline:=GetCommandLine;
{ process arguments }
pc:=cmdline;
{$IfDef SYSTEM_DEBUG_STARTUP}
Writeln(stderr,'Win32 GetCommandLine is #',pc,'#');
{$EndIf }
while pc^<>#0 do
begin
{ skip leading spaces }
while pc^ in [#1..#32] do
inc(pc);
if pc^=#0 then
break;
{ calc argument length }
quote:=False;
argstart:=pc;
arglen:=0;
while (pc^<>#0) do
begin
case pc^ of
#1..#32 :
begin
if quote then
inc(arglen)
else
break;
end;
'"' :
if pc[1]<>'"' then
quote := not quote
else
inc(pc);
else
inc(arglen);
end;
inc(pc);
end;
{ copy argument }
{ Don't copy the first one, it is already there.}
If Count<>0 then
begin
allocarg(count,arglen);
quote:=False;
pc:=argstart;
arg:=argv[count];
while (pc^<>#0) do
begin
case pc^ of
#1..#32 :
begin
if quote then
begin
arg^:=pc^;
inc(arg);
end
else
break;
end;
'"' :
if pc[1]<>'"' then
quote := not quote
else
inc(pc);
else
begin
arg^:=pc^;
inc(arg);
end;
end;
inc(pc);
end;
arg^:=#0;
end;
{$IfDef SYSTEM_DEBUG_STARTUP}
Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
{$EndIf SYSTEM_DEBUG_STARTUP}
inc(count);
end;
{ get argc }
argc:=count;
{ free unused memory, leaving a nil entry at the end }
sysreallocmem(argv,(count+1)*sizeof(pointer));
argv[count] := nil;
end;
function paramcount : longint;
begin
paramcount := argc - 1;
end;
function paramstr(l : longint) : string;
begin
if (l>=0) and (l<argc) then
paramstr:=strpas(argv[l])
else
paramstr:='';
end;
procedure randomize;
begin
randseed:=GetTickCount;
end;
Const
DLL_PROCESS_ATTACH = 1;

146
rtl/win32/system.pp
View File

@ -141,152 +141,6 @@ function SysReAllocStringLen(var bstr:pointer;psz: pointer;
{ include system independent routines }
{$I system.inc}
{*****************************************************************************
Parameter Handling
*****************************************************************************}
procedure setup_arguments;
var
arglen,
count : longint;
argstart,
pc,arg : pchar;
quote : Boolean;
argvlen : longint;
buf: array[0..259] of char; // need MAX_PATH bytes, not 256!
procedure allocarg(idx,len:longint);
var
oldargvlen : longint;
begin
if idx>=argvlen then
begin
oldargvlen:=argvlen;
argvlen:=(idx+8) and (not 7);
sysreallocmem(argv,argvlen*sizeof(pointer));
fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
end;
{ use realloc to reuse already existing memory }
{ always allocate, even if length is zero, since }
{ the arg. is still present! }
sysreallocmem(argv[idx],len+1);
end;
begin
{ create commandline, it starts with the executed filename which is argv[0] }
{ Win32 passes the command NOT via the args, but via getmodulefilename}
count:=0;
argv:=nil;
argvlen:=0;
ArgLen := GetModuleFileName(0, @buf[0], sizeof(buf));
buf[ArgLen] := #0; // be safe
allocarg(0,arglen);
move(buf,argv[0]^,arglen+1);
{ Setup cmdline variable }
cmdline:=GetCommandLine;
{ process arguments }
pc:=cmdline;
{$IfDef SYSTEM_DEBUG_STARTUP}
Writeln(stderr,'Win32 GetCommandLine is #',pc,'#');
{$EndIf }
while pc^<>#0 do
begin
{ skip leading spaces }
while pc^ in [#1..#32] do
inc(pc);
if pc^=#0 then
break;
{ calc argument length }
quote:=False;
argstart:=pc;
arglen:=0;
while (pc^<>#0) do
begin
case pc^ of
#1..#32 :
begin
if quote then
inc(arglen)
else
break;
end;
'"' :
if pc[1]<>'"' then
quote := not quote
else
inc(pc);
else
inc(arglen);
end;
inc(pc);
end;
{ copy argument }
{ Don't copy the first one, it is already there.}
If Count<>0 then
begin
allocarg(count,arglen);
quote:=False;
pc:=argstart;
arg:=argv[count];
while (pc^<>#0) do
begin
case pc^ of
#1..#32 :
begin
if quote then
begin
arg^:=pc^;
inc(arg);
end
else
break;
end;
'"' :
if pc[1]<>'"' then
quote := not quote
else
inc(pc);
else
begin
arg^:=pc^;
inc(arg);
end;
end;
inc(pc);
end;
arg^:=#0;
end;
{$IfDef SYSTEM_DEBUG_STARTUP}
Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
{$EndIf SYSTEM_DEBUG_STARTUP}
inc(count);
end;
{ get argc }
argc:=count;
{ free unused memory, leaving a nil entry at the end }
sysreallocmem(argv,(count+1)*sizeof(pointer));
argv[count] := nil;
end;
function paramcount : longint;
begin
paramcount := argc - 1;
end;
function paramstr(l : longint) : string;
begin
if (l>=0) and (l<argc) then
paramstr:=strpas(argv[l])
else
paramstr:='';
end;
procedure randomize;
begin
randseed:=GetTickCount;
end;
{*****************************************************************************

212
rtl/win64/system.pp
View File

@ -133,218 +133,6 @@ function SysReAllocStringLen(var bstr:pointer;psz: pointer;
{ include system independent routines }
{$I system.inc}
{*****************************************************************************
Parameter Handling
*****************************************************************************}
procedure setup_arguments;
var
arglen,
count : longint;
argstart,
pc,arg : pchar;
quote : char;
argvlen : longint;
buf: array[0..259] of char; // need MAX_PATH bytes, not 256!
procedure allocarg(idx,len:longint);
var
oldargvlen : longint;
begin
if idx>=argvlen then
begin
oldargvlen:=argvlen;
argvlen:=(idx+8) and (not 7);
sysreallocmem(argv,argvlen*sizeof(pointer));
fillchar(argv[oldargvlen],(argvlen-oldargvlen)*sizeof(pointer),0);
end;
{ use realloc to reuse already existing memory }
{ always allocate, even if length is zero, since }
{ the arg. is still present! }
sysreallocmem(argv[idx],len+1);
end;
begin
{ create commandline, it starts with the executed filename which is argv[0] }
{ Win32 passes the command NOT via the args, but via getmodulefilename}
count:=0;
argv:=nil;
argvlen:=0;
ArgLen := GetModuleFileName(0, @buf[0], sizeof(buf));
buf[ArgLen] := #0; // be safe
allocarg(0,arglen);
move(buf,argv[0]^,arglen+1);
{ Setup cmdline variable }
cmdline:=GetCommandLine;
{ process arguments }
pc:=cmdline;
{$IfDef SYSTEM_DEBUG_STARTUP}
Writeln(stderr,'Win32 GetCommandLine is #',pc,'#');
{$EndIf }
while pc^<>#0 do
begin
{ skip leading spaces }
while pc^ in [#1..#32] do
inc(pc);
if pc^=#0 then
break;
{ calc argument length }
quote:=' ';
argstart:=pc;
arglen:=0;
while (pc^<>#0) do
begin
case pc^ of
#1..#32 :
begin
if quote<>' ' then
inc(arglen)
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
inc(arglen);
end;
'''' :
begin
if quote<>'"' then
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;
{ copy argument }
{ Don't copy the first one, it is already there.}
If Count<>0 then
begin
allocarg(count,arglen);
quote:=' ';
pc:=argstart;
arg:=argv[count];
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;
end;
{$IfDef SYSTEM_DEBUG_STARTUP}
Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
{$EndIf SYSTEM_DEBUG_STARTUP}
inc(count);
end;
{ get argc }
argc:=count;
{ free unused memory, leaving a nil entry at the end }
sysreallocmem(argv,(count+1)*sizeof(pointer));
argv[count] := nil;
end;
function paramcount : longint;
begin
paramcount := argc - 1;
end;
function paramstr(l : longint) : string;
begin
if (l>=0) and (l<argc) then
paramstr:=strpas(argv[l])
else
paramstr:='';
end;
procedure randomize;
begin
randseed:=GetTickCount;
end;
{*****************************************************************************
System Dependent Exit code
*****************************************************************************}