From f3a19aaf5976d5356a4def9355bf2866ff2aa675 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?K=C3=A1roly=20Balogh?= <karoly@freepascal.org>
Date: Sat, 10 Apr 2021 15:12:45 +0000
Subject: [PATCH] sinclairql: first version of working argc/argv generation.
 implemented ParamCount and ParamStr()

git-svn-id: trunk@49168 -
---
 rtl/sinclairql/si_prc.pp |  17 ++----
 rtl/sinclairql/system.pp | 115 +++++++++++++++++++++++++++------------
 2 files changed, 85 insertions(+), 47 deletions(-)

diff --git a/rtl/sinclairql/si_prc.pp b/rtl/sinclairql/si_prc.pp
index 27c271ec10..7b308ac7df 100644
--- a/rtl/sinclairql/si_prc.pp
+++ b/rtl/sinclairql/si_prc.pp
@@ -26,13 +26,10 @@ var
   binend: byte; external name '_etext';
   bssstart: byte; external name '_sbss';
   bssend: byte; external name '_ebss';
-  nb_ChannelIds : word;
-  pChannelIds : pdword;
-  CmdLine_len : word; public name '__CmdLine_len';
-  pCmdLine : pchar; public name '__pCmdLine';
+  jobStackDataPtr: pointer; public name '__job_stack_data_ptr';
 
 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 }
 procedure _FPC_proc_start; cdecl; assembler; nostackframe; noreturn; public name '_start';
@@ -79,8 +76,7 @@ asm
     bne @relocloop
 
 @noreloc:
-    pea (a7)
-    pea (a6,a5)
+    move.l a7,a0
 
     bra PascalStart
 end;
@@ -90,15 +86,12 @@ begin
   mt_frjob(-1, _ExitCode);
 end;
 
-procedure PascalStart(commandLine: pword; channelData: pword); cdecl; noreturn;
+procedure PascalStart(a7_on_entry: pointer); noreturn;
 begin
   { initialize .bss }
   FillChar(bssstart,PtrUInt(@bssend)-PtrUInt(@bssstart),#0);
 
-  nb_ChannelIDs:=channelData[0];
-  pChannelIDs:=@channelData[1];
-  CmdLine_Len:=commandLine[0];
-  pCmdLine:=@commandLine[1];
+  jobStackDataPtr:=a7_on_entry;
 
   PascalMain;
 end;
diff --git a/rtl/sinclairql/system.pp b/rtl/sinclairql/system.pp
index 0dccad2673..5d0c83126f 100644
--- a/rtl/sinclairql/system.pp
+++ b/rtl/sinclairql/system.pp
@@ -54,13 +54,13 @@ const
     StdErrorHandle: longint = UnusedHandle;
 
 var
-    args: PChar;
-    argc: LongInt;
+    QL_ChannelIDNum : word;
+    QL_ChannelIDs: pdword;
+    QL_CommandLineLen : word;
+    QL_CommandLine : pchar;
+
     argv: PPChar;
-    envp: PPChar;
-
-    heapStart: pointer;
-
+    argc: Longint;
 
     {$if defined(FPUSOFT)}
 
@@ -106,50 +106,82 @@ begin
   GetProcessID := mt_inf(nil, nil);
 end;
 
+{*****************************************************************************
+                             ParamStr
+*****************************************************************************}
+
 var
-  CmdLine_len : word; external name '__CmdLine_len';
-  pCmdLine : pchar; external name '__pCmdLine';
+  args: PChar;
+
+{ 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;
 var
-  str_len, i : word;
+  i,j : longint;
   c : char;
-  in_word : boolean;
+  argv_size : longint;
 const
   word_separators=[' ',#0];
 begin
-  str_len:=CmdLine_len;
   argc:=0;
   argv:=nil;
-  args:=pCmdLine;
+  args:=GetMem(QL_CommandLineLen+1);
   if not assigned(args) then
     exit;
-  { Parse command line }
-  { Compute argc imply replace spaces by #0 }
+
+  Move(QL_CommandLine^,args^,QL_CommandLineLen);
+  args[QL_CommandLineLen]:=#0;
+
   i:=0;
-  in_word:=false;
-  while (i < str_len) do
+  c:=' ';
+  while args[i]<>#0 do
     begin
+      if (c in word_separators) and not (args[i] in word_separators) then
+        inc(argc);
       c:=args[i];
-      if (not in_word) then
+      inc(i);
+    end;
+
+  { +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
+      argc:=0;
+      exit;
+    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
-          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;
+          argv[j]:=@args[i];
+          inc(j);
+        end;
+      c:=args[i];
+      if (c in word_separators) then
+        args[i]:=#0;
+      inc(i);
+    end;
 end;
 
 procedure randomize;
@@ -175,11 +207,19 @@ end;
 {*****************************************************************************
                         System Dependent Entry code
 *****************************************************************************}
+var
+  jobStackDataPtr: pointer; external name '__job_stack_data_ptr';
+
 { QL/QDOS specific startup }
 procedure SysInitQDOS;
 var
   r: TQLRect;
 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);
   stdOutputHandle:=stdInputHandle;
   stdErrorHandle:=stdInputHandle;
@@ -203,6 +243,11 @@ procedure system_exit;
 const
   anyKey: string = 'Press any key to exit';
 begin
+  if assigned(args) then
+    FreeMem(args);
+  if assigned(argv) then
+    FreeMem(argv);
+
   io_sstrg(stdOutputHandle, -1, @anyKey[1], ord(anyKey[0]));
   io_fbyte(stdInputHandle, -1);