mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 23:59:10 +02:00
* Environment and arguments initialization now native
This commit is contained in:
yuri
parent
97d677c8c8
commit
ff7b561fc9
@ -1,16 +1,17 @@
|
|||||||
/ prt1.s (emx+fpk) -- Made from crt2.s and dos.s,
|
/ prt1.s (emx+fpk) -- Made from crt2.s and dos.s,
|
||||||
/ Copyright (c) 1990-1999-2000 by Eberhard Mattes.
|
/ Copyright (c) 1990-1999-2000 by Eberhard Mattes.
|
||||||
/ Changed for Free Pascal in 1997 Daniel Mantione.
|
/ Changed for Free Pascal in 1997 Daniel Mantione.
|
||||||
/ This code is _not_ under the Library GNU Public
|
/ This code is _not_ under the Library GNU Public
|
||||||
/ License, because the original is not. See copying.emx
|
/ License, because the original is not. See copying.emx
|
||||||
/ for details. You should have received it with this
|
/ for details. You should have received it with this
|
||||||
/ product, write the author if you haven't.
|
/ product, write the author if you haven't.
|
||||||
|
|
||||||
.globl __entry1
|
.globl __entry1
|
||||||
.globl _environ
|
/ Heh. Not needed anymore.
|
||||||
.globl _envc
|
/ .globl _environ
|
||||||
.globl _argv
|
/ .globl _envc
|
||||||
.globl _argc
|
/ .globl _argv
|
||||||
|
/ .globl _argc
|
||||||
|
|
||||||
.text
|
.text
|
||||||
|
|
||||||
|
|||||||
@ -29,7 +29,9 @@ interface
|
|||||||
|
|
||||||
{$ifdef SYSTEMDEBUG}
|
{$ifdef SYSTEMDEBUG}
|
||||||
{$define SYSTEMEXCEPTIONDEBUG}
|
{$define SYSTEMEXCEPTIONDEBUG}
|
||||||
{$define IODEBUG}
|
{.$define IODEBUG}
|
||||||
|
{.$define DEBUGENVIRONMENT}
|
||||||
|
{$define DEBUGARGUMENTS}
|
||||||
{$endif SYSTEMDEBUG}
|
{$endif SYSTEMDEBUG}
|
||||||
|
|
||||||
{ $DEFINE OS2EXCEPTIONS}
|
{ $DEFINE OS2EXCEPTIONS}
|
||||||
@ -118,10 +120,10 @@ const UnusedHandle=-1;
|
|||||||
|
|
||||||
var
|
var
|
||||||
{ C-compatible arguments and environment }
|
{ C-compatible arguments and environment }
|
||||||
argc : longint;external name '_argc';
|
argc : longint; //external name '_argc';
|
||||||
argv : ppchar;external name '_argv';
|
argv : ppchar; //external name '_argv';
|
||||||
envp : ppchar;external name '_environ';
|
envp : ppchar; //external name '_environ';
|
||||||
EnvC: cardinal; external name '_envc';
|
EnvC: cardinal; //external name '_envc';
|
||||||
|
|
||||||
(* Pointer to the block of environment variables - used e.g. in unit Dos. *)
|
(* Pointer to the block of environment variables - used e.g. in unit Dos. *)
|
||||||
Environment: PChar;
|
Environment: PChar;
|
||||||
@ -1067,6 +1069,267 @@ begin
|
|||||||
*)
|
*)
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function strcopy(dest,source : pchar) : pchar;assembler;
|
||||||
|
asm
|
||||||
|
pushl %esi
|
||||||
|
pushl %edi
|
||||||
|
cld
|
||||||
|
movl 12(%ebp),%edi
|
||||||
|
movl $0xffffffff,%ecx
|
||||||
|
xorb %al,%al
|
||||||
|
repne
|
||||||
|
scasb
|
||||||
|
not %ecx
|
||||||
|
movl 8(%ebp),%edi
|
||||||
|
movl 12(%ebp),%esi
|
||||||
|
movl %ecx,%eax
|
||||||
|
shrl $2,%ecx
|
||||||
|
rep
|
||||||
|
movsl
|
||||||
|
movl %eax,%ecx
|
||||||
|
andl $3,%ecx
|
||||||
|
rep
|
||||||
|
movsb
|
||||||
|
movl 8(%ebp),%eax
|
||||||
|
popl %edi
|
||||||
|
popl %esi
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure InitEnvironment;
|
||||||
|
var env_count : longint;
|
||||||
|
dos_env,cp : pchar;
|
||||||
|
begin
|
||||||
|
env_count:=0;
|
||||||
|
cp:=environment;
|
||||||
|
while cp ^ <> #0 do
|
||||||
|
begin
|
||||||
|
inc(env_count);
|
||||||
|
while (cp^ <> #0) do inc(longint(cp)); { skip to NUL }
|
||||||
|
inc(longint(cp)); { skip to next character }
|
||||||
|
end;
|
||||||
|
envp := getmem((env_count+1) * sizeof(pchar));
|
||||||
|
envc := env_count;
|
||||||
|
if (envp = nil) then exit;
|
||||||
|
cp:=environment;
|
||||||
|
env_count:=0;
|
||||||
|
while cp^ <> #0 do
|
||||||
|
begin
|
||||||
|
envp[env_count] := getmem(strlen(cp)+1);
|
||||||
|
strcopy(envp[env_count], cp);
|
||||||
|
{$IfDef DEBUGENVIRONMENT}
|
||||||
|
Writeln(stderr,'env ',env_count,' = "',envp[env_count],'"');
|
||||||
|
{$EndIf}
|
||||||
|
inc(env_count);
|
||||||
|
while (cp^ <> #0) do
|
||||||
|
inc(longint(cp)); { skip to NUL }
|
||||||
|
inc(longint(cp)); { skip to next character }
|
||||||
|
end;
|
||||||
|
envp[env_count]:=nil;
|
||||||
|
// longint(cp):=longint(cp)+3;
|
||||||
|
// dos_argv0 := sysgetmem(strlen(cp)+1);
|
||||||
|
// if (dos_argv0 = nil) then halt;
|
||||||
|
// strcopy(dos_argv0, cp);
|
||||||
|
{ update ___dos_argv0 also }
|
||||||
|
// ___dos_argv0:=dos_argv0
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure InitArguments;
|
||||||
|
var
|
||||||
|
arglen,
|
||||||
|
count : longint;
|
||||||
|
argstart,
|
||||||
|
pc,arg : pchar;
|
||||||
|
quote : char;
|
||||||
|
argvlen : longint;
|
||||||
|
|
||||||
|
procedure allocarg(idx,len:longint);
|
||||||
|
begin
|
||||||
|
if idx>=argvlen then
|
||||||
|
begin
|
||||||
|
argvlen:=(idx+8) and (not 7);
|
||||||
|
sysreallocmem(argv,argvlen*sizeof(pointer));
|
||||||
|
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
|
||||||
|
count:=0;
|
||||||
|
argv:=nil;
|
||||||
|
argvlen:=0;
|
||||||
|
|
||||||
|
// Get argv[0]
|
||||||
|
pc:=cmdline;
|
||||||
|
Arglen:=0;
|
||||||
|
repeat
|
||||||
|
Inc(Arglen);
|
||||||
|
until (pc[Arglen]=#0);
|
||||||
|
allocarg(count,arglen);
|
||||||
|
move(pc^,argv[count]^,arglen);
|
||||||
|
|
||||||
|
{ ReSetup cmdline variable }
|
||||||
|
repeat
|
||||||
|
Inc(Arglen);
|
||||||
|
until (pc[Arglen]=#0);
|
||||||
|
pc:=GetMem(ArgLen);
|
||||||
|
move(cmdline^, pc^, arglen);
|
||||||
|
Arglen:=0;
|
||||||
|
repeat
|
||||||
|
Inc(Arglen);
|
||||||
|
until (pc[Arglen]=#0);
|
||||||
|
pc[Arglen]:=' '; // combine argv[0] and command line
|
||||||
|
CmdLine:=pc;
|
||||||
|
|
||||||
|
{ process arguments }
|
||||||
|
pc:=cmdline;
|
||||||
|
{$IfDef DEBUGARGUMENTS}
|
||||||
|
Writeln(stderr,'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 DEBUGARGUMENTS}
|
||||||
|
Writeln(stderr,'dos arg ',count,' #',arglen,'#',argv[count],'#');
|
||||||
|
{$EndIf}
|
||||||
|
inc(count);
|
||||||
|
end;
|
||||||
|
{ get argc and create an nil entry }
|
||||||
|
argc:=count;
|
||||||
|
allocarg(argc,0);
|
||||||
|
{ free unused memory }
|
||||||
|
sysreallocmem(argv,(argc+1)*sizeof(pointer));
|
||||||
|
end;
|
||||||
|
|
||||||
function GetFileHandleCount: longint;
|
function GetFileHandleCount: longint;
|
||||||
var L1: longint;
|
var L1: longint;
|
||||||
@ -1116,13 +1379,15 @@ begin
|
|||||||
FileHandleCount := GetFileHandleCount;
|
FileHandleCount := GetFileHandleCount;
|
||||||
DosGetInfoBlocks (@TIB, @PIB);
|
DosGetInfoBlocks (@TIB, @PIB);
|
||||||
StackBottom := TIB^.Stack;
|
StackBottom := TIB^.Stack;
|
||||||
Environment := pointer (PIB^.Env);
|
|
||||||
|
{Set type of application}
|
||||||
ApplicationType := PIB^.ProcType;
|
ApplicationType := PIB^.ProcType;
|
||||||
IsConsole := ApplicationType <> 3;
|
IsConsole := ApplicationType <> 3;
|
||||||
|
|
||||||
exitproc:=nil;
|
exitproc:=nil;
|
||||||
|
|
||||||
{Initialize the heap.}
|
{Initialize the heap.}
|
||||||
initheap;
|
InitHeap;
|
||||||
|
|
||||||
{ ... and exceptions }
|
{ ... and exceptions }
|
||||||
SysInitExceptions;
|
SysInitExceptions;
|
||||||
@ -1133,6 +1398,13 @@ begin
|
|||||||
{ no I/O-Error }
|
{ no I/O-Error }
|
||||||
inoutres:=0;
|
inoutres:=0;
|
||||||
|
|
||||||
|
{Initialize environment (must be after InitHeap because allocates memory)}
|
||||||
|
Environment := pointer (PIB^.Env);
|
||||||
|
InitEnvironment;
|
||||||
|
|
||||||
|
CmdLine := pointer (PIB^.Cmd);
|
||||||
|
InitArguments;
|
||||||
|
|
||||||
{$ifdef HASVARIANT}
|
{$ifdef HASVARIANT}
|
||||||
initvariantmanager;
|
initvariantmanager;
|
||||||
{$endif HASVARIANT}
|
{$endif HASVARIANT}
|
||||||
@ -1146,7 +1418,10 @@ begin
|
|||||||
end.
|
end.
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.57 2003-11-06 17:20:44 yuri
|
Revision 1.58 2003-11-19 16:50:21 yuri
|
||||||
|
* Environment and arguments initialization now native
|
||||||
|
|
||||||
|
Revision 1.57 2003/11/06 17:20:44 yuri
|
||||||
* Unused constants removed
|
* Unused constants removed
|
||||||
|
|
||||||
Revision 1.56 2003/11/03 09:42:28 marco
|
Revision 1.56 2003/11/03 09:42:28 marco
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user