From 44e39f454a38bb3cfc8a61b8587fa225c3ebec61 Mon Sep 17 00:00:00 2001
From: pierre <pierre@freepascal.org>
Date: Wed, 7 Apr 2021 15:58:42 +0000
Subject: [PATCH]  Add basic support for setting argc and argv for sinclairql
 OS

git-svn-id: trunk@49134 -
---
 rtl/sinclairql/si_prc.pp | 33 +++++++++++++++++++++++++++++++
 rtl/sinclairql/system.pp | 42 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 75 insertions(+)

diff --git a/rtl/sinclairql/si_prc.pp b/rtl/sinclairql/si_prc.pp
index 90e49c1b2c..1b611c9e73 100644
--- a/rtl/sinclairql/si_prc.pp
+++ b/rtl/sinclairql/si_prc.pp
@@ -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 }
diff --git a/rtl/sinclairql/system.pp b/rtl/sinclairql/system.pp
index 45d8d82548..97cc15fc51 100644
--- a/rtl/sinclairql/system.pp
+++ b/rtl/sinclairql/system.pp
@@ -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;