From 8e6c0f149ad55bf103b20a5a1a7e8bf42ca787f5 Mon Sep 17 00:00:00 2001
From: karoly <karoly@3ad0048d-3df7-0310-abae-a5850022a9f2>
Date: Mon, 19 Apr 2021 19:09:34 +0000
Subject: sinclairql: support the upcoming QL binary linking feature of vlink
 (still in development). it's behind an undocumented -WL switch now. also,
 reduce the amount of used dataspace by the size of the relocation table in
 the current linking mode

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@49234 3ad0048d-3df7-0310-abae-a5850022a9f2
---
 compiler/globals.pas              |  1 +
 compiler/options.pas              |  7 +++++++
 compiler/systems/t_sinclairql.pas | 19 ++++++++++++++++---
 3 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/compiler/globals.pas b/compiler/globals.pas
index f26979d83b..ab570352a6 100644
--- a/compiler/globals.pas
+++ b/compiler/globals.pas
@@ -416,6 +416,7 @@ interface
 {$if defined(m68k)}
        { Sinclair QL specific }
        sinclairql_metadata_format: string[4] = 'QHDR';
+       sinclairql_vlink_experimental: boolean = false; { temporary }
 {$endif defined(m68k)}
 
        { default name of the C-style "main" procedure of the library/program }
diff --git a/compiler/options.pas b/compiler/options.pas
index ba299ca140..990e92dda8 100644
--- a/compiler/options.pas
+++ b/compiler/options.pas
@@ -2761,6 +2761,13 @@ begin
                           IllegalPara(opt);
                       end;
 {$if defined(m68k)}
+                    'L':
+                      begin
+                        if (target_info.system in [system_m68k_sinclairql]) then
+                          sinclairql_vlink_experimental:=true
+                        else
+                          IllegalPara(opt);
+                      end;
                     'Q':
                       begin
                         if (target_info.system in [system_m68k_sinclairql]) then
diff --git a/compiler/systems/t_sinclairql.pas b/compiler/systems/t_sinclairql.pas
index 1e16e4ebab..444fd3aa5b 100644
--- a/compiler/systems/t_sinclairql.pas
+++ b/compiler/systems/t_sinclairql.pas
@@ -115,7 +115,7 @@ begin
      end
     else
      begin
-      ExeCmd[1]:='vlink -b rawseg -q $FLAGS $GCSECTIONS $OPT $STRIP $MAP -o $EXE -T $RES';
+      ExeCmd[1]:='vlink $QLFLAGS $FLAGS $GCSECTIONS $OPT $STRIP $MAP -o $EXE -T $RES';
      end;
    end;
 end;
@@ -245,6 +245,7 @@ var
   DynLinkStr : string;
   GCSectionsStr : string;
   FlagsStr : string;
+  QLFlagsStr: string;
   MapStr : string;
   ExeName: string;
   fd,fs: file;
@@ -258,6 +259,7 @@ var
   QLHeader: TQLHeader;
   XTccData: TXTccData;
   BinSize: longint;
+  RelocSize: longint;
   DataSpace: DWord;
 begin
   StripStr:='';
@@ -276,6 +278,10 @@ begin
     begin
       if create_smartlink_sections then
         GCSectionsStr:='-gc-all';
+      if sinclairql_vlink_experimental then
+        QLFlagsStr:='-b sinclairql -q -'+lower(sinclairql_metadata_format)+' -stack='+tostr(StackSize)
+      else
+        QLFlagsStr:='-b rawseg -q';
     end;
 
   ExeName:=current_module.exefilename;
@@ -292,18 +298,20 @@ begin
   Replace(cmdstr,'$STRIP',StripStr);
   Replace(cmdstr,'$GCSECTIONS',GCSectionsStr);
   Replace(cmdstr,'$DYNLINK',DynLinkStr);
+  Replace(cmdstr,'$QLFLAGS',QLFlagsStr);
 
   MakeSinclairQLExe:=DoExec(BinStr,CmdStr,true,false);
 
   { Kludge:
       With the above linker script, vlink will produce two files. The main binary 
       and the relocation info. Here we copy the two together. (KB) }
-  if MakeSinclairQLExe then
+  if MakeSinclairQLExe and not sinclairql_vlink_experimental then
     begin
       QLHeader:=DefaultQLHeader;
       XTccData:=DefaultXTccData;
 
       BinSize:=0;
+      RelocSize:=0;
       bufsize:=16384;
 {$push}
 {$i-}
@@ -321,13 +329,18 @@ begin
       assign(fd,ExeName);
       rewrite(fd,1);
 
+      assign(fs,ExeName+'.'+ProgramHeaderName+'.rel'+ProgramHeaderName);
+      reset(fs,1);
+      RelocSize := FileSize(fs);
+      close(fs);
+
       assign(fs,ExeName+'.'+ProgramHeaderName);
       reset(fs,1);
       BinSize := FileSize(fs);
 
       { We assume .bss size is total size indicated by linker minus emmited binary.
         DataSpace size is .bss + stack space }
-      DataSpace := NToBE(DWord(HeaderSize - BinSize + StackSize));
+      DataSpace := NToBE(DWord(max((HeaderSize - BinSize) - RelocSize + StackSize,0)));
 
       { Option: prepend QEmuLator and QPC2 v5 compatible header to EXE }
       if sinclairql_metadata_format='QHDR' then
-- 
cgit v1.2.1