Selaa lähdekoodia

m68k: on the Sinclair QL insert the main program's name into the object, so the RTL later can set it as default job name

git-svn-id: trunk@49189 -
Károly Balogh 4 vuotta sitten
vanhempi
commit
b5216a1990
3 muutettua tiedostoa jossa 77 lisäystä ja 1 poistoa
  1. 1 0
      .gitattributes
  2. 2 1
      compiler/m68k/cpunode.pas
  3. 74 0
      compiler/m68k/n68kutil.pas

+ 1 - 0
.gitattributes

@@ -409,6 +409,7 @@ compiler/m68k/n68kinl.pas svneol=native#text/plain
 compiler/m68k/n68kmat.pas svneol=native#text/plain
 compiler/m68k/n68kmem.pas svneol=native#text/plain
 compiler/m68k/n68kset.pas svneol=native#text/plain
+compiler/m68k/n68kutil.pas svneol=native#text/plain
 compiler/m68k/r68kbss.inc svneol=native#text/plain
 compiler/m68k/r68kcon.inc svneol=native#text/plain
 compiler/m68k/r68kgas.inc svneol=native#text/plain

+ 2 - 1
compiler/m68k/cpunode.pas

@@ -43,7 +43,8 @@ unit cpunode;
        n68kset,
        n68kinl,
        n68kmat,
-       n68kcnv
+       n68kcnv,
+       n68kutil
        ;
 
 end.

+ 74 - 0
compiler/m68k/n68kutil.pas

@@ -0,0 +1,74 @@
+{
+    Copyright (c) 2021 by Karoly Balogh
+
+    m68k version of some node tree helper routines
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit n68kutil;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      cclasses,ngenutil;
+
+    type
+      t68knodeutils = class(tnodeutils)
+        class procedure InsertObjectInfo; override;
+      end;
+
+implementation
+
+    uses
+      verbose,
+      systems,
+      globals,
+      fmodule,
+      aasmbase,aasmdata,aasmtai,aasmcpu,aasmcnst,
+      symdef,symtype;
+
+
+    class procedure t68knodeutils.InsertObjectInfo;
+      var
+        tcb: ttai_typedconstbuilder;
+        s: shortstring;
+        sym: tasmsymbol;
+        def: tdef;
+      begin
+        inherited InsertObjectInfo;
+        if (not current_module.is_unit) and (target_info.system in [system_m68k_sinclairql]) then 
+          begin
+            { insert the main program name into the object. this will be set as default job name by the system unit }
+            tcb:=ctai_typedconstbuilder.create([tcalo_new_section]);
+            s:=char(length(current_module.realmodulename^))+current_module.realmodulename^+#0;
+            def:=carraydef.getreusable(cansichartype,length(s));
+            tcb.maybe_begin_aggregate(def);
+            tcb.emit_tai(Tai_string.Create(s),def);
+            tcb.maybe_end_aggregate(def);
+            sym:=current_asmdata.DefineAsmSymbol('__fpc_program_name',AB_GLOBAL,AT_DATA,def);
+            current_asmdata.asmlists[al_globals].concatlist(
+              tcb.get_final_asmlist(sym,def,sec_rodata,'__fpc_program_name',const_align(current_settings.alignment.constalignmax))
+            );
+            tcb.free;
+          end;
+      end;
+
+begin
+  cnodeutils:=t68knodeutils;
+end.