Add basic support for setting argc and argv for sinclairql OS

git-svn-id: trunk@49134 -
This commit is contained in:
pierre 2021-04-07 15:58:42 +00:00
parent 3ac0522f70
commit 44e39f454a
2 changed files with 75 additions and 0 deletions

View File

@ -26,6 +26,15 @@ var
binend: byte; external name '_etext';
bssstart: byte; external name '_sbss';
bssend: byte; external name '_ebss';
a4_at_entry : dword;
a5_at_entry : dword;
a6_at_entry : dword;
a7_at_entry : dword;
nb_ChannelIds : word;
pChannelIds : pdword;
pData : pointer;
CmdLine_len : word; public name '__CmdLine_len';
pCmdLine : pchar; public name '__pCmdLine';
procedure PascalMain; external name 'PASCALMAIN';
procedure PascalStart; forward;
@ -41,6 +50,30 @@ asm
dc.l $46504300 { Job name, just FPC for now }
@start:
{ According to QDOS:SMS reference manual }
{ Section 3.2 v 4.4 (10/06/2018) }
move.l a4,d0
move.l d0,a4_at_entry
move.l a5,d0
move.l d0,a5_at_entry
move.l a6,d0
move.l d0,a6_at_entry
move.l a7,d0
move.l d0,a7_at_entry
move.w (a7),d0
move.w d0,nb_ChannelIds
add.l #2,d0
move.l d0,pChannelIds
move.l a6,d0
add.l a4,d0
move.l d0,pData
move.l a6,d0
add.l a5,d0
move.l d0,a0
move.w (a0),CmdLine_Len
add.l #2,d0
move.l d0,pCmdLine
{ relocation code }
{ get our actual position in RAM }

View File

@ -109,8 +109,50 @@ begin
GetProcessID := mt_inf(nil, nil);
end;
var
CmdLine_len : word; external name '__CmdLine_len';
pCmdLine : pchar; external name '__pCmdLine';
procedure SysInitParamsAndEnv;
var
str_len, i : word;
c : char;
in_word : boolean;
const
word_separators=[' ',#0];
begin
str_len:=CmdLine_len;
argc:=0;
argv:=nil;
args:=pCmdLine;
if not assigned(args) then
exit;
{ Parse command line }
{ Compute argc imply replace spaces by #0 }
i:=0;
in_word:=false;
while (i < str_len) do
begin
c:=args[i];
if (not in_word) then
begin
if not(c in word_separators) then
begin
inc(argc);
argv[argc]:=@args[i];
in_word:=true;
end
else
begin
args[i]:=#0;
end;
end
else if (c in word_separators) then
begin
in_word:=false;
args[i]:=#0;
end;
inc(i);
end;
end;
procedure randomize;