sinclairql: have a max. 48 char buffer for job name. set the job name to the program name by default on system unit init

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@49190 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 65 insertions, 2 deletions

diff --git a/rtl/sinclairql/si_prc.pp b/rtl/sinclairql/si_prc.pp
index 7b308ac7df..23154ae8b0 100644
--- a/rtl/sinclairql/si_prc.pp
+++ b/rtl/sinclairql/si_prc.pp
@@ -37,8 +37,19 @@ asm
     bra   @start
     dc.l  $0
     dc.w  $4afb
-    dc.w  3
-    dc.l  $46504300   { Job name, just FPC for now }
+    dc.w  8
+    dc.l  $4650435f   { Job name buffer. FPC_PROG by default, can be overridden }
+    dc.l  $50524f47   { the startup code will inject the main program name here }
+    dc.l  $00000000   { user codes is free to use the SetQLJobName() function   }
+    dc.l  $00000000   { max. length: 48 characters }
+    dc.l  $00000000
+    dc.l  $00000000
+    dc.l  $00000000
+    dc.l  $00000000
+    dc.l  $00000000
+    dc.l  $00000000
+    dc.l  $00000000
+    dc.l  $00000000
 
 @start:
     { relocation code }
diff --git a/rtl/sinclairql/system.pp b/rtl/sinclairql/system.pp
index 5d0c83126f..43e488ad45 100644
--- a/rtl/sinclairql/system.pp
+++ b/rtl/sinclairql/system.pp
@@ -70,6 +70,9 @@ var
 
     {$endif defined(FPUSOFT)}
 
+function SetQLJobName(const s: string): longint;
+function GetQLJobName: string;
+
 
 implementation
 
@@ -190,6 +193,11 @@ begin
   randseed:=mt_rclck;
 end;
 
+
+{*****************************************************************************
+                      Platform specific custom calls
+*****************************************************************************}
+
 procedure PrintStr(ch: longint; const s: shortstring);
 begin
   io_sstrg(ch,-1,@s[1],ord(s[0]));
@@ -204,11 +212,53 @@ begin
 end;
 
 
+var
+  start_proc: byte; external name '_start'; 
+
+  { WARNING! if you change this value, make sure there's enough
+    buffer space for the job name in the startup code! }
+const
+  JOB_NAME_MAX_LEN = 48;
+
+function SetQLJobName(const s: string): longint;
+var
+  len: longint;
+begin
+  SetQLJobName:=-1;
+  if pword(@start_proc)[3] = $4afb then
+    begin
+      len:=length(s);
+      if len > JOB_NAME_MAX_LEN then
+        len:=JOB_NAME_MAX_LEN;
+      Move(s[1],pword(@start_proc)[5],len);
+      pword(@start_proc)[4]:=len;
+      SetQLJobName:=len;
+    end;
+end;
+
+function GetQLJobName: string;
+var
+  len: longint;
+begin
+  GetQLJobName:='';
+  if pword(@start_proc)[3] = $4afb then
+    begin
+      len:=pword(@start_proc)[4];
+      if len <= JOB_NAME_MAX_LEN then
+        begin
+          SetLength(GetQLJobName,len);
+          Move(pword(@start_proc)[5],GetQLJobName[1],len);
+        end;
+    end;
+end;
+
+
 {*****************************************************************************
                         System Dependent Entry code
 *****************************************************************************}
 var
   jobStackDataPtr: pointer; external name '__job_stack_data_ptr';
+  program_name: shortstring; external name '__fpc_program_name';
 
 { QL/QDOS specific startup }
 procedure SysInitQDOS;
@@ -220,6 +270,8 @@ begin
   QL_CommandLineLen:=pword(@QL_ChannelIDs[QL_ChannelIDNum])[0];
   QL_CommandLine:=@pword(@QL_ChannelIDs[QL_ChannelIDNum])[1];
 
+  SetQLJobName(program_name);
+
   stdInputHandle:=io_open('con_',Q_OPEN);
   stdOutputHandle:=stdInputHandle;
   stdErrorHandle:=stdInputHandle;