paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 20:50:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

Amicommon: Unified parameterhandling for Amiga, AROS, MorphOS

Browse Source 
git-svn-id: trunk@33528 -
This commit is contained in:
marcus 2016-04-17 15:31:18 +00:00
parent a742df9035
commit e38e051425
5 changed files with 317 additions and 563 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8169,6 +8169,7 @@ rtl/amicommon/classes.pp svneol=native#text/plain
rtl/amicommon/dos.pp svneol=native#text/plain rtl/amicommon/dos.pp svneol=native#text/plain
rtl/amicommon/osdebug.inc svneol=native#text/plain rtl/amicommon/osdebug.inc svneol=native#text/plain
rtl/amicommon/osdebugh.inc svneol=native#text/plain rtl/amicommon/osdebugh.inc svneol=native#text/plain
rtl/amicommon/paramhandling.inc svneol=native#text/plain
rtl/amicommon/rtldefs.inc svneol=native#text/plain rtl/amicommon/rtldefs.inc svneol=native#text/plain
rtl/amicommon/sysdir.inc svneol=native#text/plain rtl/amicommon/sysdir.inc svneol=native#text/plain
rtl/amicommon/sysfile.inc svneol=native#text/plain rtl/amicommon/sysfile.inc svneol=native#text/plain

254
rtl/amicommon/paramhandling.inc Normal file
View File

@ -0,0 +1,254 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2016 by Marcus Sackrow,
member of the Free Pascal development team.
Parameter handling for Amiga-like systems
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
function GetWBArgsNum: Integer;
var
Startup: PWBStartup;
begin
GetWBArgsNum := 0;
Startup := nil;
Startup := PWBStartup(AOS_wbMsg);
if Startup <> nil then
begin
Result := Startup^.sm_NumArgs - 1;
end;
end;
function GetWBArg(Idx: Integer): string;
var
startup: PWBStartup;
wbarg: PWBArgList;
Path: array[0..254] of Char;
strPath: string;
Len: Integer;
begin
GetWBArg := '';
FillChar(Path[0],255,#0);
Startup := PWBStartup(AOS_wbMsg);
if Startup <> nil then
begin
//if (Idx >= 0) and (Idx < Startup^.sm_NumArgs) then
begin
wbarg := Startup^.sm_ArgList;
if NameFromLock(wbarg^[Idx + 1].wa_Lock,@Path[0],255) then
begin
Len := 0;
while (Path[Len] <> #0) and (Len < 254) do
Inc(Len);
if Len > 0 then
if (Path[Len - 1] <> ':') and (Path[Len - 1] <> '/') then
Path[Len] := '/';
strPath := Path;
end;
Result := strPath + wbarg^[Idx + 1].wa_Name;
end;
end;
end;
{ Generates correct argument array on startup }
procedure GenerateArgs;
var
ArgVLen: LongInt;
procedure AllocArg(Idx, Len: LongInt);
var
i, OldArgVLen : LongInt;
begin
if Idx >= ArgVLen then
begin
OldArgVLen := ArgVLen;
ArgVLen := (Idx + 8) and (not 7);
SysReAllocMem(Argv, Argvlen * SizeOf(Pointer));
for i := OldArgVLen to ArgVLen - 1 do
ArgV[i]:=nil;
end;
ArgV[Idx] := SysAllocMem(Succ(Len));
end;
var
Count: Word;
Start: Word;
Ende: Word;
LocalIndex: Word;
i: Integer;
P : PChar;
Temp : AnsiString;
InQuotes: boolean;
begin
P := GetArgStr;
ArgVLen := 0;
{ Set argv[0] }
Temp := ParamStr(0);
AllocArg(0, Length(Temp));
Move(Temp[1], Argv[0]^, Length(Temp));
Argv[0][Length(Temp)] := #0;
{ check if we're started from Workbench }
if AOS_wbMsg <> nil then
begin
ArgC := GetWBArgsNum + 1;
for i := 1 to ArgC - 1 do
begin
Temp := GetWBArg(i);
AllocArg(i, Length(Temp));
Move(Temp[1], Argv[i]^, Length(Temp));
Argv[i][Length(Temp)] := #0;
end;
Exit;
end;
InQuotes := False;
{ Handle the other args }
Count := 0;
{ first index is one }
LocalIndex := 1;
while (P[Count] <> #0) do
begin
while (p[count]=' ') or (p[count]=#9) or (p[count]=LineEnding) do
Inc(count);
if p[count] = '"' then
begin
inQuotes := True;
Inc(Count);
end;
start := count;
if inQuotes then
begin
while (p[count]<>#0) and (p[count]<>'"') and (p[count]<>LineEnding) do
begin
Inc(Count)
end;
end else
begin
while (p[count]<>#0) and (p[count]<>' ') and (p[count]<>#9) and (p[count]<>LineEnding) do
inc(count);
end;
ende := count;
if not inQuotes then
begin
while (p[start]=' ') and (Start < Ende) do
Inc(Start)
end;
if (ende-start>0) then
begin
allocarg(localindex,ende-start);
move(p[start],argv[localindex]^,ende-start);
argv[localindex][ende-start]:=#0;
if inQuotes and (argv[localindex][(ende-start) - 1] = '"') then
argv[localindex][(ende-start)-1] := #0;
inc(localindex);
end;
if inQuotes and (p[count] = '"') then
Inc(Count);
inQuotes := False;
end;
argc:=localindex;
end;
function GetProgDir: string;
var
s1: string;
alock: LongInt;
counter: Byte;
begin
GetProgDir := '';
FillChar(s1, 255, #0);
{ GetLock of program directory }
alock := GetProgramDir;
if alock <> 0 then
begin
if NameFromLock(alock, @s1[1], 255) then
begin
Counter := 1;
while (s1[Counter] <> #0) and (Counter <> 0) do
Inc(Counter);
s1[0] := char(Counter - 1);
GetProgDir := s1;
end;
end;
end;
function GetProgramName: string;
{ Returns ONLY the program name }
var
s1: string;
Counter: Byte;
begin
GetProgramName := '';
FillChar(s1, 255, #0);
if GetProgramName(@s1[1], 255) then
begin
{ now check out and assign the length of the string }
Counter := 1;
while (s1[Counter] <> #0) and (Counter <> 0) do
Inc(Counter);
s1[0] := char(Counter - 1);
{ now remove any component path which should not be there }
for Counter := Length(s1) downto 1 do
if (s1[Counter] = '/') or (s1[Counter] = ':') then
break;
{ readjust counterv to point to character }
if Counter <> 1 then
Inc(Counter);
GetProgramName := Copy(s1, Counter, Length(s1));
end;
end;
{*****************************************************************************
ParamStr
*****************************************************************************}
{ number of args }
function ParamCount: LongInt;
begin
if AOS_wbMsg <> nil then
ParamCount := GetWBArgsNum
else
ParamCount := argc - 1;
end;
{ argument number l }
function ParamStr(l: LongInt): string;
var
s1: string;
begin
ParamStr := '';
if AOS_wbMsg <> nil then
begin
ParamStr := GetWBArg(l);
end
else
begin
if l = 0 then
begin
s1 := GetProgDir;
if s1[Length(s1)] = ':' then
paramstr := s1 + GetProgramName
else
paramstr:=s1+'/'+GetProgramName;
end
else
begin
if (l > 0) and (l + 1 <= argc) then
ParamStr := StrPas(argv[l]);
end;
end;
end;

163
rtl/amiga/system.pp
View File

@ -132,6 +132,27 @@ implementation
{$WARNING Compiling with memory debug enabled!} {$WARNING Compiling with memory debug enabled!}
{$ENDIF} {$ENDIF}
type
PWBArg = ^TWBArg;
TWBArg = record
wa_Lock : LongInt; { a lock descriptor }
wa_Name : PChar; { a string relative to that lock }
end;
WBArgList = array[1..MaxInt] of TWBArg; { Only 1..smNumArgs are valid }
PWBArgList = ^WBArgList;
PWBStartup = ^TWBStartup;
TWBStartup = record
sm_Message : TMessage; { a standard message structure }
sm_Process : Pointer; { the process descriptor for you }
sm_Segment : Pointer; { a descriptor for your code }
sm_NumArgs : Longint; { the number of elements in ArgList }
sm_ToolWindow : Pointer; { description of window }
sm_ArgList : PWBArgList; { the arguments themselves }
end;
{***************************************************************************** {*****************************************************************************
Misc. System Dependent Functions Misc. System Dependent Functions
@ -185,146 +206,16 @@ begin
haltproc(ExitCode); haltproc(ExitCode);
end; end;
{ Generates correct argument array on startup }
procedure GenerateArgs;
var
argvlen : longint;
procedure allocarg(idx,len:longint);
var
i,oldargvlen : longint;
begin
if idx>=argvlen then
begin
oldargvlen:=argvlen;
argvlen:=(idx+8) and (not 7);
sysreallocmem(argv,argvlen*sizeof(pointer));
for i:=oldargvlen to argvlen-1 do
argv[i]:=nil;
end;
ArgV [Idx] := SysAllocMem (Succ (Len));
end;
var
count: word;
start: word;
localindex: word;
p : pchar;
temp : string;
begin
p:=GetArgStr;
argvlen:=0;
{ Set argv[0] }
temp:=paramstr(0);
allocarg(0,length(temp));
move(temp[1],argv[0]^,length(temp));
argv[0][length(temp)]:=#0;
{ check if we're started from Ambient }
if AOS_wbMsg<>nil then
begin
argc:=0;
exit;
end;
{ Handle the other args }
count:=0;
{ first index is one }
localindex:=1;
while (p[count]<>#0) do
begin
while (p[count]=' ') or (p[count]=#9) or (p[count]=LineEnding) do inc(count);
start:=count;
while (p[count]<>#0) and (p[count]<>' ') and (p[count]<>#9) and (p[count]<>LineEnding) do inc(count);
if (count-start>0) then
begin
allocarg(localindex,count-start);
move(p[start],argv[localindex]^,count-start);
argv[localindex][count-start]:=#0;
inc(localindex);
end;
end;
argc:=localindex;
end;
function GetProgDir: String;
var
s1 : String;
alock : LongInt;
counter: Byte;
begin
GetProgDir:='';
FillChar(s1,255,#0);
{ GetLock of program directory }
alock:=GetProgramDir;
if alock<>0 then begin
if NameFromLock(alock,@s1[1],255) then begin
counter:=1;
while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
s1[0]:=Char(counter-1);
GetProgDir:=s1;
end;
end;
end;
function GetProgramName: String;
{ Returns ONLY the program name }
var
s1 : String;
counter: Byte;
begin
GetProgramName:='';
FillChar(s1,255,#0);
if GetProgramName(@s1[1],255) then begin
{ now check out and assign the length of the string }
counter := 1;
while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
s1[0]:=Char(counter-1);
{ now remove any component path which should not be there }
for counter:=length(s1) downto 1 do
if (s1[counter] = '/') or (s1[counter] = ':') then break;
{ readjust counterv to point to character }
if counter<>1 then Inc(counter);
GetProgramName:=copy(s1,counter,length(s1));
end;
end;
{***************************************************************************** {*****************************************************************************
ParamStr/Randomize Parameterhandling
as include in amicommon
*****************************************************************************} *****************************************************************************}
{ number of args } {$I paramhandling.inc}
function paramcount : longint;
begin
if AOS_wbMsg<>nil then
paramcount:=0
else
paramcount:=argc-1;
end;
{ argument number l } {*****************************************************************************
function paramstr(l : longint) : string; Randomize
var *****************************************************************************}
s1: String;
begin
paramstr:='';
if AOS_wbMsg<>nil then exit;
if l=0 then begin
s1:=GetProgDir;
if s1[length(s1)]=':' then paramstr:=s1+GetProgramName
else paramstr:=s1+'/'+GetProgramName;
end else begin
if (l>0) and (l+1<=argc) then paramstr:=strpas(argv[l]);
end;
end;
{ set randseed to a new pseudo random value } { set randseed to a new pseudo random value }
procedure randomize; procedure randomize;

232
rtl/aros/system.pp
View File

@ -94,7 +94,7 @@ type
wa_Name : PChar; { a string relative to that lock } wa_Name : PChar; { a string relative to that lock }
end; end;
WBArgList = array[1..100] of TWBArg; { Only 1..smNumArgs are valid } WBArgList = array[1..MaxInt] of TWBArg; { Only 1..smNumArgs are valid }
PWBArgList = ^WBArgList; PWBArgList = ^WBArgList;
@ -163,234 +163,16 @@ begin
HaltProc(ExitCode); HaltProc(ExitCode);
end; end;
function GetWBArgsNum: Integer;
var
startup: PWBStartup;
begin
GetWBArgsNum := 0;
Startup := nil;
Startup := PWBStartup(AOS_wbMsg);
if Startup <> nil then
begin
Result := Startup^.sm_NumArgs - 1;
end;
end;
function GetWBArg(Idx: Integer): string;
var
startup: PWBStartup;
wbarg: PWBArgList;
Path: array[0..254] of Char;
strPath: string;
Len: Integer;
begin
GetWBArg := '';
FillChar(Path[0],255,#0);
Startup := PWBStartup(AOS_wbMsg);
if Startup <> nil then
begin
//if (Idx >= 0) and (Idx < Startup^.sm_NumArgs) then
begin
wbarg := Startup^.sm_ArgList;
if NameFromLock(wbarg^[Idx + 1].wa_Lock,@Path[0],255) then
begin
Len := 0;
while (Path[Len] <> #0) and (Len < 254) do
Inc(Len);
if Len > 0 then
if (Path[Len - 1] <> ':') and (Path[Len - 1] <> '/') then
Path[Len] := '/';
strPath := Path;
end;
Result := strPath + wbarg^[Idx + 1].wa_Name;
end;
end;
end;
{ Generates correct argument array on startup }
procedure GenerateArgs;
var
ArgVLen: LongInt;
procedure AllocArg(Idx, Len: LongInt);
var
i, OldArgVLen : LongInt;
begin
if Idx >= ArgVLen then
begin
OldArgVLen := ArgVLen;
ArgVLen := (Idx + 8) and (not 7);
SysReAllocMem(Argv, Argvlen * SizeOf(Pointer));
for i := OldArgVLen to ArgVLen - 1 do
ArgV[i]:=nil;
end;
ArgV[Idx] := SysAllocMem(Succ(Len));
end;
var
Count: Word;
Start: Word;
Ende: Word;
LocalIndex: Word;
i: Integer;
P : PChar;
{$H+}
Temp : string;
InQuotes: boolean;
begin
P := GetArgStr;
ArgVLen := 0;
{ Set argv[0] }
Temp := ParamStr(0);
AllocArg(0, Length(Temp));
Move(Temp[1], Argv[0]^, Length(Temp));
Argv[0][Length(Temp)] := #0;
{ check if we're started from Workbench }
if AOS_wbMsg <> nil then
begin
ArgC := GetWBArgsNum + 1;
for i := 1 to ArgC - 1 do
begin
Temp := GetWBArg(i);
AllocArg(i, Length(Temp));
Move(Temp[1], Argv[i]^, Length(Temp));
Argv[i][Length(Temp)] := #0;
end;
Exit;
end;
InQuotes := False;
{ Handle the other args }
Count := 0;
{ first index is one }
LocalIndex := 1;
while (P[Count] <> #0) do
begin
while (p[count]=' ') or (p[count]=#9) or (p[count]=LineEnding) do
Inc(count);
if p[count] = '"' then
begin
inQuotes := True;
Inc(Count);
end;
start := count;
if inQuotes then
begin
while (p[count]<>#0) and (p[count]<>'"') and (p[count]<>LineEnding) do
begin
Inc(Count)
end;
end else
begin
while (p[count]<>#0) and (p[count]<>' ') and (p[count]<>#9) and (p[count]<>LineEnding) do
inc(count);
end;
ende := count;
if not inQuotes then
begin
while (p[start]=' ') and (Start < Ende) do
Inc(Start)
end;
if (ende-start>0) then
begin
allocarg(localindex,ende-start);
move(p[start],argv[localindex]^,ende-start);
argv[localindex][ende-start]:=#0;
if inQuotes and (argv[localindex][(ende-start) - 1] = '"') then
argv[localindex][(ende-start)-1] := #0;
inc(localindex);
end;
if inQuotes and (p[count] = '"') then
Inc(Count);
inQuotes := False;
end;
argc:=localindex;
end;
function GetProgDir: String;
var
s1 : String;
alock : LongInt;
counter: Byte;
begin
GetProgDir:='';
SetLength(s1, 256);
FillChar(s1,255,#0);
{ GetLock of program directory }
alock:=GetProgramDir;
if alock<>0 then begin
if NameFromLock(alock,@s1[1],255) then begin
counter:=1;
while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
SetLength(s1, counter-1);
GetProgDir:=s1;
end;
end;
end;
function GetProgramName: String;
{ Returns ONLY the program name }
var
s1 : String;
counter: Byte;
begin
GetProgramName:='';
SetLength(s1, 256);
FillChar(s1,255,#0);
if GetProgramName(@s1[1],255) then begin
{ now check out and assign the length of the string }
counter := 1;
while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
SetLength(s1, counter-1);
{ now remove any component path which should not be there }
for counter:=length(s1) downto 1 do
if (s1[counter] = '/') or (s1[counter] = ':') then break;
{ readjust counterv to point to character }
if counter<>1 then Inc(counter);
GetProgramName:=copy(s1,counter,length(s1));
end;
end;
{***************************************************************************** {*****************************************************************************
ParamStr/Randomize Parameterhandling
as include in amicommon
*****************************************************************************} *****************************************************************************}
{ number of args } {$I paramhandling.inc}
function paramcount : longint;
begin
if AOS_wbMsg<>nil then
paramcount:=GetWBArgsNum
else
paramcount:=argc-1;
end;
{ argument number l } {*****************************************************************************
function paramstr(l : longint) : string; Randomize
var *****************************************************************************}
s1: String;
begin
paramstr:='';
if AOS_wbMsg<>nil then
begin
paramstr := GetWBArg(l);
end else
begin
if l=0 then begin
s1:=GetProgDir;
if s1[length(s1)]=':' then paramstr:=s1+GetProgramName
else paramstr:=s1+'/'+GetProgramName;
end else begin
if (l>0) and (l+1<=argc) then paramstr:=strpas(argv[l]);
end;
end;
end;
{ set randseed to a new pseudo random value } { set randseed to a new pseudo random value }
procedure Randomize; procedure Randomize;

230
rtl/morphos/system.pp
View File

@ -69,6 +69,7 @@ var
MOS_ambMsg : Pointer; MOS_ambMsg : Pointer;
MOS_ConName : PChar ='CON:10/30/620/100/FPC Console Output/AUTO/CLOSE/WAIT'; MOS_ConName : PChar ='CON:10/30/620/100/FPC Console Output/AUTO/CLOSE/WAIT';
MOS_ConHandle: LongInt; MOS_ConHandle: LongInt;
AOS_wbMsg: Pointer absolute MOS_ambMsg; { common Amiga code compatibility kludge }
argc: LongInt; argc: LongInt;
argv: PPChar; argv: PPChar;
@ -89,6 +90,26 @@ implementation
{$ENDIF} {$ENDIF}
type
pWBArg = ^tWBArg;
tWBArg = record
wa_Lock: longint;
wa_Name: PChar;
end;
WBArgList = array[1..MaxInt] of TWBArg; { Only 1..smNumArgs are valid }
PWBArgList = ^WBArgList;
pWBStartup = ^tWBStartup;
tWBStartup = packed record
sm_Message : tMessage;
sm_Process : pMsgPort;
sm_Segment : longint;
sm_NumArgs : longint;
sm_ToolWindow: PChar;
sm_ArgList : PWBArgList;
end;
{***************************************************************************** {*****************************************************************************
Misc. System Dependent Functions Misc. System Dependent Functions
*****************************************************************************} *****************************************************************************}
@ -138,211 +159,16 @@ begin
haltproc(ExitCode); haltproc(ExitCode);
end; end;
{ Generates correct argument array on startup }
procedure GenerateArgs;
var
argvlen : longint;
procedure allocarg(idx,len:longint);
var
i,oldargvlen : longint;
begin
if idx>=argvlen then
begin
oldargvlen:=argvlen;
argvlen:=(idx+8) and (not 7);
sysreallocmem(argv,argvlen*sizeof(pointer));
for i:=oldargvlen to argvlen-1 do
argv[i]:=nil;
end;
ArgV [Idx] := SysAllocMem (Succ (Len));
end;
var
count: word;
start: word;
localindex: word;
p : pchar;
temp : string;
begin
p:=GetArgStr;
argvlen:=0;
{ Set argv[0] }
temp:=paramstr(0);
allocarg(0,length(temp));
move(temp[1],argv[0]^,length(temp));
argv[0][length(temp)]:=#0;
{ check if we're started from Ambient }
if MOS_ambMsg<>nil then begin
argc:=0;
exit;
end;
{ Handle the other args }
count:=0;
{ first index is one }
localindex:=1;
while (p[count]<>#0) do
begin
while (p[count]=' ') or (p[count]=#9) or (p[count]=LineEnding) do inc(count);
start:=count;
while (p[count]<>#0) and (p[count]<>' ') and (p[count]<>#9) and (p[count]<>LineEnding) do inc(count);
if (count-start>0) then
begin
allocarg(localindex,count-start);
move(p[start],argv[localindex]^,count-start);
argv[localindex][count-start]:=#0;
inc(localindex);
end;
end;
argc:=localindex;
end;
function GetProgDir: String;
var
s1 : String;
alock : LongInt;
counter: Byte;
begin
GetProgDir:='';
FillChar(s1,255,#0);
{ GetLock of program directory }
alock:=GetProgramDir;
if alock<>0 then begin
if NameFromLock(alock,@s1[1],255) then begin
counter:=1;
while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
s1[0]:=Char(counter-1);
GetProgDir:=s1;
end;
end;
end;
function GetProgramName: String;
{ Returns ONLY the program name }
var
s1 : String;
counter: Byte;
begin
GetProgramName:='';
FillChar(s1,255,#0);
if GetProgramName(@s1[1],255) then begin
{ now check out and assign the length of the string }
counter := 1;
while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
s1[0]:=Char(counter-1);
{ now remove any component path which should not be there }
for counter:=length(s1) downto 1 do
if (s1[counter] = '/') or (s1[counter] = ':') then break;
{ readjust counterv to point to character }
if counter<>1 then Inc(counter);
GetProgramName:=copy(s1,counter,length(s1));
end;
end;
function GetArgv0Ambient: String;
{ Returns program full path+name, when in Ambient mode }
{ Required for paramstr(0) support in Ambient mode }
type
pWBArg = ^tWBArg;
tWBArg = record
wa_Lock: longint;
wa_Name: PChar;
end;
pWBStartup = ^tWBStartup;
tWBStartup = packed record
sm_Message : tMessage;
sm_Process : pMsgPort;
sm_Segment : longint;
sm_NumArgs : longint;
sm_ToolWindow: PChar;
sm_ArgList : pWBArg;
end;
var
tmpbuf : String;
counter : longint;
progname: PChar;
dlock : longint;
begin
GetArgv0Ambient:='';
if MOS_ambMsg<>nil then begin
dlock:=pWBStartup(MOS_ambMsg)^.sm_argList^.wa_Lock;
if dlock<>0 then begin
FillDWord(tmpbuf,256 div 4,0);
if NameFromLock(dlock,@tmpbuf[1],255) then begin
counter:=1;
while tmpbuf[counter]<>#0 do
inc(counter);
tmpbuf[0]:=Char(counter-1);
GetArgv0Ambient:=tmpbuf;
{ Append slash,if we're not in root directory of a volume }
if tmpbuf[counter-1]<>':' then
GetArgv0Ambient:=GetArgv0Ambient+'/';
end;
end;
{ Fetch the progname, and copy it to the buffer }
progname:=pWBStartup(MOS_ambMsg)^.sm_argList^.wa_Name;
if progname<>nil then begin
FillDWord(tmpbuf,256 div 4,0);
counter:=0;
while (progname[counter]<>#0) do begin
tmpbuf[counter+1]:=progname[counter];
inc(counter);
end;
tmpbuf[0]:=Char(counter);
GetArgv0Ambient:=GetArgv0Ambient+tmpbuf;
end;
end;
end;
{***************************************************************************** {*****************************************************************************
ParamStr/Randomize Parameterhandling
as include in amicommon
*****************************************************************************} *****************************************************************************}
{ number of args } {$I paramhandling.inc}
function paramcount : longint;
begin
if MOS_ambMsg<>nil then
paramcount:=0
else
paramcount:=argc-1;
end;
{ argument number l } {*****************************************************************************
function paramstr(l : longint) : string; Randomize
var *****************************************************************************}
s1: String;
begin
paramstr:='';
if MOS_ambMsg<>nil then begin
if l=0 then begin
paramstr:=GetArgv0Ambient;
exit;
end else
exit;
end;
if l=0 then begin
s1:=GetProgDir;
if s1[length(s1)]=':' then paramstr:=s1+GetProgramName
else paramstr:=s1+'/'+GetProgramName;
end else begin
if (l>0) and (l+1<=argc) then paramstr:=strpas(argv[l]);
end;
end;
{ set randseed to a new pseudo random value } { set randseed to a new pseudo random value }
procedure randomize; procedure randomize;
@ -372,7 +198,7 @@ begin
{ Creating the memory pool for growing heap } { Creating the memory pool for growing heap }
ASYS_heapPool:=CreatePool(MEMF_FAST or MEMF_SEM_PROTECTED,growheapsize2,growheapsize1); ASYS_heapPool:=CreatePool(MEMF_FAST or MEMF_SEM_PROTECTED,growheapsize2,growheapsize1);
if ASYS_heapPool=nil then Halt(1); if ASYS_heapPool=nil then Halt(1);
{ Initialize semaphore for filelist access arbitration } { Initialize semaphore for filelist access arbitration }
ASYS_fileSemaphore:=AllocPooled(ASYS_heapPool,sizeof(TSignalSemaphore)); ASYS_fileSemaphore:=AllocPooled(ASYS_heapPool,sizeof(TSignalSemaphore));
if ASYS_fileSemaphore = nil then Halt(1); if ASYS_fileSemaphore = nil then Halt(1);