mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 21:49:43 +02:00
Amicommon: Unified parameterhandling for Amiga, AROS, MorphOS
git-svn-id: trunk@33528 -
This commit is contained in:
marcus
parent
a742df9035
commit
e38e051425
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -8169,6 +8169,7 @@ rtl/amicommon/classes.pp svneol=native#text/plain
|
||||
rtl/amicommon/dos.pp svneol=native#text/plain
|
||||
rtl/amicommon/osdebug.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/sysdir.inc svneol=native#text/plain
|
||||
rtl/amicommon/sysfile.inc svneol=native#text/plain
|
||||
|
||||
254
rtl/amicommon/paramhandling.inc
Normal file
254
rtl/amicommon/paramhandling.inc
Normal 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;
|
||||
@ -132,6 +132,27 @@ implementation
|
||||
{$WARNING Compiling with memory debug enabled!}
|
||||
{$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
|
||||
@ -185,146 +206,16 @@ begin
|
||||
haltproc(ExitCode);
|
||||
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 }
|
||||
function paramcount : longint;
|
||||
begin
|
||||
if AOS_wbMsg<>nil then
|
||||
paramcount:=0
|
||||
else
|
||||
paramcount:=argc-1;
|
||||
end;
|
||||
{$I paramhandling.inc}
|
||||
|
||||
{ argument number l }
|
||||
function paramstr(l : longint) : string;
|
||||
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;
|
||||
{*****************************************************************************
|
||||
Randomize
|
||||
*****************************************************************************}
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize;
|
||||
|
||||
@ -94,7 +94,7 @@ type
|
||||
wa_Name : PChar; { a string relative to that lock }
|
||||
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;
|
||||
|
||||
|
||||
@ -163,234 +163,16 @@ begin
|
||||
HaltProc(ExitCode);
|
||||
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 }
|
||||
function paramcount : longint;
|
||||
begin
|
||||
if AOS_wbMsg<>nil then
|
||||
paramcount:=GetWBArgsNum
|
||||
else
|
||||
paramcount:=argc-1;
|
||||
end;
|
||||
{$I paramhandling.inc}
|
||||
|
||||
{ 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;
|
||||
{*****************************************************************************
|
||||
Randomize
|
||||
*****************************************************************************}
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure Randomize;
|
||||
|
||||
@ -69,6 +69,7 @@ var
|
||||
MOS_ambMsg : Pointer;
|
||||
MOS_ConName : PChar ='CON:10/30/620/100/FPC Console Output/AUTO/CLOSE/WAIT';
|
||||
MOS_ConHandle: LongInt;
|
||||
AOS_wbMsg: Pointer absolute MOS_ambMsg; { common Amiga code compatibility kludge }
|
||||
|
||||
argc: LongInt;
|
||||
argv: PPChar;
|
||||
@ -89,6 +90,26 @@ implementation
|
||||
{$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
|
||||
*****************************************************************************}
|
||||
@ -138,211 +159,16 @@ begin
|
||||
haltproc(ExitCode);
|
||||
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 }
|
||||
function paramcount : longint;
|
||||
begin
|
||||
if MOS_ambMsg<>nil then
|
||||
paramcount:=0
|
||||
else
|
||||
paramcount:=argc-1;
|
||||
end;
|
||||
{$I paramhandling.inc}
|
||||
|
||||
{ argument number l }
|
||||
function paramstr(l : longint) : string;
|
||||
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;
|
||||
{*****************************************************************************
|
||||
Randomize
|
||||
*****************************************************************************}
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize;
|
||||
@ -372,7 +198,7 @@ begin
|
||||
{ Creating the memory pool for growing heap }
|
||||
ASYS_heapPool:=CreatePool(MEMF_FAST or MEMF_SEM_PROTECTED,growheapsize2,growheapsize1);
|
||||
if ASYS_heapPool=nil then Halt(1);
|
||||
|
||||
|
||||
{ Initialize semaphore for filelist access arbitration }
|
||||
ASYS_fileSemaphore:=AllocPooled(ASYS_heapPool,sizeof(TSignalSemaphore));
|
||||
if ASYS_fileSemaphore = nil then Halt(1);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user