mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-20 10:49:20 +02:00
sinclairql: first version of working argc/argv generation. implemented ParamCount and ParamStr()
git-svn-id: trunk@49168 -
This commit is contained in:
parent
b2afecdae5
commit
f3a19aaf59
@ -26,13 +26,10 @@ var
|
|||||||
binend: byte; external name '_etext';
|
binend: byte; external name '_etext';
|
||||||
bssstart: byte; external name '_sbss';
|
bssstart: byte; external name '_sbss';
|
||||||
bssend: byte; external name '_ebss';
|
bssend: byte; external name '_ebss';
|
||||||
nb_ChannelIds : word;
|
jobStackDataPtr: pointer; public name '__job_stack_data_ptr';
|
||||||
pChannelIds : pdword;
|
|
||||||
CmdLine_len : word; public name '__CmdLine_len';
|
|
||||||
pCmdLine : pchar; public name '__pCmdLine';
|
|
||||||
|
|
||||||
procedure PascalMain; external name 'PASCALMAIN';
|
procedure PascalMain; external name 'PASCALMAIN';
|
||||||
procedure PascalStart(commandLine: pword; channelData: pword); cdecl; noreturn; forward;
|
procedure PascalStart(a7_on_entry: pointer); noreturn; forward;
|
||||||
|
|
||||||
{ this function must be the first in this unit which contains code }
|
{ this function must be the first in this unit which contains code }
|
||||||
procedure _FPC_proc_start; cdecl; assembler; nostackframe; noreturn; public name '_start';
|
procedure _FPC_proc_start; cdecl; assembler; nostackframe; noreturn; public name '_start';
|
||||||
@ -79,8 +76,7 @@ asm
|
|||||||
bne @relocloop
|
bne @relocloop
|
||||||
|
|
||||||
@noreloc:
|
@noreloc:
|
||||||
pea (a7)
|
move.l a7,a0
|
||||||
pea (a6,a5)
|
|
||||||
|
|
||||||
bra PascalStart
|
bra PascalStart
|
||||||
end;
|
end;
|
||||||
@ -90,15 +86,12 @@ begin
|
|||||||
mt_frjob(-1, _ExitCode);
|
mt_frjob(-1, _ExitCode);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure PascalStart(commandLine: pword; channelData: pword); cdecl; noreturn;
|
procedure PascalStart(a7_on_entry: pointer); noreturn;
|
||||||
begin
|
begin
|
||||||
{ initialize .bss }
|
{ initialize .bss }
|
||||||
FillChar(bssstart,PtrUInt(@bssend)-PtrUInt(@bssstart),#0);
|
FillChar(bssstart,PtrUInt(@bssend)-PtrUInt(@bssstart),#0);
|
||||||
|
|
||||||
nb_ChannelIDs:=channelData[0];
|
jobStackDataPtr:=a7_on_entry;
|
||||||
pChannelIDs:=@channelData[1];
|
|
||||||
CmdLine_Len:=commandLine[0];
|
|
||||||
pCmdLine:=@commandLine[1];
|
|
||||||
|
|
||||||
PascalMain;
|
PascalMain;
|
||||||
end;
|
end;
|
||||||
|
@ -54,13 +54,13 @@ const
|
|||||||
StdErrorHandle: longint = UnusedHandle;
|
StdErrorHandle: longint = UnusedHandle;
|
||||||
|
|
||||||
var
|
var
|
||||||
args: PChar;
|
QL_ChannelIDNum : word;
|
||||||
argc: LongInt;
|
QL_ChannelIDs: pdword;
|
||||||
|
QL_CommandLineLen : word;
|
||||||
|
QL_CommandLine : pchar;
|
||||||
|
|
||||||
argv: PPChar;
|
argv: PPChar;
|
||||||
envp: PPChar;
|
argc: Longint;
|
||||||
|
|
||||||
heapStart: pointer;
|
|
||||||
|
|
||||||
|
|
||||||
{$if defined(FPUSOFT)}
|
{$if defined(FPUSOFT)}
|
||||||
|
|
||||||
@ -106,48 +106,80 @@ begin
|
|||||||
GetProcessID := mt_inf(nil, nil);
|
GetProcessID := mt_inf(nil, nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{*****************************************************************************
|
||||||
|
ParamStr
|
||||||
|
*****************************************************************************}
|
||||||
|
|
||||||
var
|
var
|
||||||
CmdLine_len : word; external name '__CmdLine_len';
|
args: PChar;
|
||||||
pCmdLine : pchar; external name '__pCmdLine';
|
|
||||||
|
{ number of args }
|
||||||
|
function ParamCount: LongInt;
|
||||||
|
begin
|
||||||
|
ParamCount:=argc;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ argument number l }
|
||||||
|
function ParamStr(l: LongInt): string;
|
||||||
|
begin
|
||||||
|
if (l >= 0) and (l <= argc) then
|
||||||
|
ParamStr:=argv[l]
|
||||||
|
else
|
||||||
|
ParamStr:='';
|
||||||
|
end;
|
||||||
|
|
||||||
procedure SysInitParamsAndEnv;
|
procedure SysInitParamsAndEnv;
|
||||||
var
|
var
|
||||||
str_len, i : word;
|
i,j : longint;
|
||||||
c : char;
|
c : char;
|
||||||
in_word : boolean;
|
argv_size : longint;
|
||||||
const
|
const
|
||||||
word_separators=[' ',#0];
|
word_separators=[' ',#0];
|
||||||
begin
|
begin
|
||||||
str_len:=CmdLine_len;
|
|
||||||
argc:=0;
|
argc:=0;
|
||||||
argv:=nil;
|
argv:=nil;
|
||||||
args:=pCmdLine;
|
args:=GetMem(QL_CommandLineLen+1);
|
||||||
if not assigned(args) then
|
if not assigned(args) then
|
||||||
exit;
|
exit;
|
||||||
{ Parse command line }
|
|
||||||
{ Compute argc imply replace spaces by #0 }
|
Move(QL_CommandLine^,args^,QL_CommandLineLen);
|
||||||
|
args[QL_CommandLineLen]:=#0;
|
||||||
|
|
||||||
i:=0;
|
i:=0;
|
||||||
in_word:=false;
|
c:=' ';
|
||||||
while (i < str_len) do
|
while args[i]<>#0 do
|
||||||
begin
|
|
||||||
c:=args[i];
|
|
||||||
if (not in_word) then
|
|
||||||
begin
|
|
||||||
if not(c in word_separators) then
|
|
||||||
begin
|
begin
|
||||||
|
if (c in word_separators) and not (args[i] in word_separators) then
|
||||||
inc(argc);
|
inc(argc);
|
||||||
argv[argc]:=@args[i];
|
c:=args[i];
|
||||||
in_word:=true;
|
inc(i);
|
||||||
end
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
args[i]:=#0;
|
|
||||||
end;
|
end;
|
||||||
end
|
|
||||||
else if (c in word_separators) then
|
{ +2 is because argv[0] should be program name,
|
||||||
|
and argv[argc+1] is argv array terminator }
|
||||||
|
argv:=GetMem((argc+2)*sizeof(pointer));
|
||||||
|
if not assigned(argv) then
|
||||||
begin
|
begin
|
||||||
in_word:=false;
|
argc:=0;
|
||||||
args[i]:=#0;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
argv[argc+1]:=nil;
|
||||||
|
{ FIX ME: for now the 0th argument (program name) is just always empty }
|
||||||
|
argv[0]:=#0;
|
||||||
|
|
||||||
|
i:=0;
|
||||||
|
j:=1;
|
||||||
|
c:=' ';
|
||||||
|
while args[i]<>#0 do
|
||||||
|
begin
|
||||||
|
if (c in word_separators) and not (args[i] in word_separators) then
|
||||||
|
begin
|
||||||
|
argv[j]:=@args[i];
|
||||||
|
inc(j);
|
||||||
|
end;
|
||||||
|
c:=args[i];
|
||||||
|
if (c in word_separators) then
|
||||||
|
args[i]:=#0;
|
||||||
inc(i);
|
inc(i);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -175,11 +207,19 @@ end;
|
|||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
System Dependent Entry code
|
System Dependent Entry code
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
|
var
|
||||||
|
jobStackDataPtr: pointer; external name '__job_stack_data_ptr';
|
||||||
|
|
||||||
{ QL/QDOS specific startup }
|
{ QL/QDOS specific startup }
|
||||||
procedure SysInitQDOS;
|
procedure SysInitQDOS;
|
||||||
var
|
var
|
||||||
r: TQLRect;
|
r: TQLRect;
|
||||||
begin
|
begin
|
||||||
|
QL_ChannelIDNum:=pword(jobStackDataPtr)[0];
|
||||||
|
QL_ChannelIDs:=@pword(jobStackDataPtr)[1];
|
||||||
|
QL_CommandLineLen:=pword(@QL_ChannelIDs[QL_ChannelIDNum])[0];
|
||||||
|
QL_CommandLine:=@pword(@QL_ChannelIDs[QL_ChannelIDNum])[1];
|
||||||
|
|
||||||
stdInputHandle:=io_open('con_',Q_OPEN);
|
stdInputHandle:=io_open('con_',Q_OPEN);
|
||||||
stdOutputHandle:=stdInputHandle;
|
stdOutputHandle:=stdInputHandle;
|
||||||
stdErrorHandle:=stdInputHandle;
|
stdErrorHandle:=stdInputHandle;
|
||||||
@ -203,6 +243,11 @@ procedure system_exit;
|
|||||||
const
|
const
|
||||||
anyKey: string = 'Press any key to exit';
|
anyKey: string = 'Press any key to exit';
|
||||||
begin
|
begin
|
||||||
|
if assigned(args) then
|
||||||
|
FreeMem(args);
|
||||||
|
if assigned(argv) then
|
||||||
|
FreeMem(argv);
|
||||||
|
|
||||||
io_sstrg(stdOutputHandle, -1, @anyKey[1], ord(anyKey[0]));
|
io_sstrg(stdOutputHandle, -1, @anyKey[1], ord(anyKey[0]));
|
||||||
io_fbyte(stdInputHandle, -1);
|
io_fbyte(stdInputHandle, -1);
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user