atari: new pascal startup code, reworked build, also ParamStr/ParamCount works now

git-svn-id: trunk@35201 -

.gitattributes

@@ -8401,10 +8401,12 @@ rtl/aros/timerd.inc svneol=native#text/plain
 rtl/aros/x86_64/prt0.as svneol=native#text/plain
 rtl/atari/Makefile svneol=native#text/plain
 rtl/atari/Makefile.fpc svneol=native#text/plain
+rtl/atari/buildrtl.pp svneol=native#text/plain
 rtl/atari/classes.pp svneol=native#text/plain
 rtl/atari/gemdos.inc svneol=native#text/plain
 rtl/atari/prt0.as svneol=native#text/plain
 rtl/atari/rtldefs.inc svneol=native#text/plain
+rtl/atari/si_prc.pp svneol=native#text/plain
 rtl/atari/sysdir.inc svneol=native#text/plain
 rtl/atari/sysfile.inc svneol=native#text/plain
 rtl/atari/sysheap.inc svneol=native#text/plain

compiler/systems.pas

@@ -326,7 +326,8 @@ interface
        systems_weak_linking = systems_darwin + systems_solaris + systems_linux + systems_android;
 
        systems_internal_sysinit = [system_i386_linux,system_i386_win32,system_x86_64_win64,
-                                   system_powerpc64_linux,system_powerpc_morphos,system_m68k_amiga]+systems_darwin;
+                                   system_powerpc64_linux,system_powerpc_morphos,system_m68k_amiga,
+                                   system_m68k_atari]+systems_darwin;
 
        { all systems that use garbage collection for reference-counted types }
        systems_garbage_collected_managed_types = [

compiler/systems/i_atari.pas

@@ -34,7 +34,7 @@ unit i_atari;
             system       : system_m68k_Atari;
             name         : 'Atari ST/STE';
             shortname    : 'atari';
-            flags        : [tf_use_8_3,tf_requires_proper_alignment,tf_smartlink_sections];
+            flags        : [tf_use_8_3,tf_requires_proper_alignment,tf_has_winlike_resources,tf_smartlink_sections];
             cpu          : cpu_m68k;
             unit_env     : '';
             extradefines : '';
@@ -66,7 +66,7 @@ unit i_atari;
             link         : ld_atari;
             linkextern   : ld_atari;
             ar           : ar_gnu_ar;
-            res          : res_none;
+            res          : res_ext;
             dbg          : dbg_stabs;
             script       : script_unix;
             endian       : endian_big;

compiler/systems/t_atari.pas

@@ -40,6 +40,7 @@ type
     public
       constructor Create; override;
       procedure SetDefaultInfo; override;
+      procedure InitSysInitUnitName; override;
       function  MakeExecutable: boolean; override;
   end;
 
@@ -86,6 +87,12 @@ begin
 end;
 
 
+procedure TLinkerAtari.InitSysInitUnitName;
+begin
+  sysinitunit:='si_prc';
+end;
+
+
 function TLinkerAtari.WriteResponseFile(isdll: boolean): boolean;
 var
   linkres  : TLinkRes;
@@ -120,8 +127,11 @@ begin
 
   LinkRes.Add('INPUT (');
   { add objectfiles, start with prt0 always }
-  s:=FindObjectFile('prt0','',false);
-  LinkRes.AddFileName(s);
+  if not (target_info.system in systems_internal_sysinit) then
+    begin
+      s:=FindObjectFile('prt0','',false);
+      LinkRes.AddFileName(maybequoted(s));
+    end;
   while not ObjectFiles.Empty do
    begin
     s:=ObjectFiles.GetFirst;

rtl/atari/Makefile.fpc

@@ -6,22 +6,18 @@
 main=rtl
 
 [target]
-loaders=prt0
-units=$(SYSTEMUNIT) uuchar objpas macpas iso7185 strings \
-      heaptrc lineinfo ctypes \
-      sysutils fgl classes math typinfo \
-      charset cpall getopts  \
-      types rtlconsts sysconst
-# dos extpas
-implicitunits=cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
-      cp437 cp646 cp850 cp856 cp866 cp874 cp8859_1 cp8859_5 cp8859_2 cp852
-# \
-#      exec timer doslib utility hardware inputevent graphics layers \
-#      intuition aboxlib mui \
-# these can be moved to packages later
-#      clipboard datatypes asl ahi tinygl get9 muihelper \
+loaders=$(LOADERS)
+units=$(SYSTEMUNIT) fpextres uuchar objpas macpas iso7185 buildrtl cpall
+# extpas
+implicitunits=si_prc sysutils \
+      ctypes strings rtlconsts sysconst math types \
+      typinfo fgl classes charset character getopts \
+      cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
+      cp437 cp646 cp850 cp856 cp866 cp874 cp8859_1 cp8859_5 cp8859_2 cp852 \
+      unicodedata unicodenumtable
+# dos
+
 rsts=math rtlconsts typinfo classes sysconst
-#implicitunits=exeinfo
 
 [require]
 nortl=y
@@ -45,6 +41,7 @@ INC=$(RTL)/inc
 COMMON=$(RTL)/common
 PROCINC=$(RTL)/$(CPU_TARGET)
 UNITPREFIX=rtl
+LOADERS=prt0
 SYSTEMUNIT=system
 
 # Use new feature from 1.0.5 version
@@ -56,7 +53,6 @@ endif
 
 # Paths
 OBJPASDIR=$(RTL)/objpas
-GRAPHDIR=$(INC)/graph
 
 [rules]
 .NOTPARALLEL:
@@ -90,117 +86,29 @@ prt0$(OEXT) : prt0.as
 $(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
         $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
 
-uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
-	$(COMPILER) $(INC)/uuchar.pp
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
+
+uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/uuchar.pp
 
 objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
-strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
-                   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
-                   $(SYSTEMUNIT)$(PPUEXT)
-	$(COMPILER) $(INC)/strings.pp
+macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) buildrtl$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/macpas.pp
 
-iso7185$(PPUEXT) : $(INC)/iso7185.pp $(SYSTEMUNIT)$(PPUEXT)
+iso7185$(PPUEXT) : $(INC)/iso7185.pp buildrtl$(PPUEXT) heaptrc$(PPUEXT)
         $(COMPILER) $(INC)/iso7185.pp
 
-#extpas$(PPUEXT) : $(INC)/extpas.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-#        $(COMPILER) $(INC)/extpas.pp
-
-#
-# System Dependent Units
-#
-
-#ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-
-#doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-
-#
-# TP7 Compatible RTL Units
-#
-
-#dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-#               $(SYSTEMUNIT)$(PPUEXT)
-#	$(COMPILER) dos.pp
-
-#crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
-
-#objects$(PPUEXT) : $(INC)/objects.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-
-#printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
-
-#graph$(PPUEXT) : graph.pp
-
-#
-# Delphi Compatible Units
-#
-
-sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
-                    objpas$(PPUEXT) sysconst$(PPUEXT)
-        $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
-
-classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
-                   sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) types$(PPUEXT) fgl$(PPUEXT)
-        $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
-
-strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
-                    sysutils$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/strutils.pp
+extpas$(PPUEXT) : $(INC)/extpas.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/extpas.pp
 
-typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
-        $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)
+buildrtl$(PPUEXT): buildrtl.pp system$(PPUEXT) objpas$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR)/sysutils -Fi$(OBJPASDIR)/classes -Fu$(CPU_TARGET) -Fu$(PROCINC) -Fu$(AMIINC) -I$(INC) -Fu$(INC) -Fu$(OBJPASDIR) buildrtl
 
-math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
+fpextres$(PPUEXT) : $(INC)/fpextres.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Sg $(INC)/fpextres.pp
 
-varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
-                    $(OBJPASDIR)/varutilh.inc varutils.pp
-        $(COMPILER) -I$(OBJPASDIR) varutils.pp $(REDIR)
-
-fmtbcd$(PPUEXT) : $(OBJPASDIR)/fmtbcd.pp objpas$(PPUEXT) sysutils$(PPUEXT) variants$(PPUEXT) classes$(PPUEXT) system$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/fmtbcd.pp
-
-fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/fgl.pp
-
-types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/types.pp
-
-rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp
-        $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
-
-sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/sysconst.pp
-
-dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp
-        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
-
-#
-# Mac Pascal Model
-#
-
-macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
-        $(COMPILER) $(INC)/macpas.pp $(REDIR)
-
-#
-# Other system-independent RTL Units
-#
-
-ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-	$(COMPILER) $(INC)/ucomplex.pp
-
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
-	$(COMPILER) $(INC)/getopts.pp
-
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
-        $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
-
-#lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
-#        $(COMPILER) $(INC)/lineinfo.pp
-
-charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT)
-	$(COMPILER) $(INC)/charset.pp
-
-cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
+cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) objpas$(PPUEXT) heaptrc$(PPUEXT)
         $(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas
-

rtl/atari/buildrtl.pp

@@ -0,0 +1,18 @@
+unit buildrtl;
+
+  interface
+
+    uses
+{$ifdef cpum68k}
+      si_prc,
+{$endif}
+      sysutils,
+
+      ctypes, strings,
+      rtlconsts, sysconst, math, types,
+      typinfo, fgl, classes,
+      charset, character, getopts;
+
+  implementation
+
+end.

rtl/atari/gemdos.inc

@@ -96,6 +96,33 @@ type
         date: word;           {* Date like Tgetdate *}
     end;
 
+type
+  PPD = ^TPD;
+  TPD = record
+      p_lowtpa: pointer;      {* Start address of the TPA            *}
+      p_hitpa: pointer;       {* First byte after the end of the TPA *}
+      p_tbase: pointer;       {* Start address of the program code   *}
+      p_tlen: longint;        {* Length of the program code          *}
+      p_dbase: pointer;       {* Start address of the DATA segment   *}
+      p_dlen: longint;        {* Length of the DATA section          *}
+      p_bbase: pointer;       {* Start address of the BSS segment    *}
+      p_blen: longint;        {* Length of the BSS section           *}
+      p_dta: PDTA;            {* Pointer to the default DTA          *}
+                              {* Warning: Points first to the        *}
+                              {* command line !                      *}
+      p_parent: PPD;          {* Pointer to the basepage of the      *}
+                              {* calling processes                   *}
+      p_resrvd0: longint;     {* Reserved                            *}
+      p_env: pchar;           {* Address of the environment string   *}
+      p_resrvd1: array[0..79] of char;   {* Reserved                            *}
+      p_cmdlin: array[0..127] of char;   {* Command line                        *}
+  end;
+  TBASEPAGE = TPD; {* alias types... *}
+  PBASEPAGE = ^TBASEPAGE;
+
+
+procedure gemdos_cconws(p: pchar); syscall 1 9;
+
 function gemdos_dsetdrv(drv: smallint): longint; syscall 1 14;
 
 function gemdos_dgetdrv: smallint; syscall 1 25;
@@ -121,6 +148,7 @@ function gemdos_fattrib(filename: pchar; wflag: smallint; attrib: smallint): sma
 function gemdos_dgetpath(path: pchar; driveno: smallint): smallint; syscall 1 71;
 function gemdos_malloc(number: dword): pointer; syscall 1 72;
 function gemdos_free(block: pointer): dword; syscall 1 73;
+function gemdos_mshrink(zero: word; block: pointer; newsiz: longint): longint; syscall 1 74;
 
 procedure gemdos_pterm(returncode: smallint); syscall 1 76;
 

rtl/atari/si_prc.pp

@@ -0,0 +1,65 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2016 by the Free Pascal development team
+
+    System Entry point for Atari/TOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+unit si_prc;
+
+interface
+
+implementation
+
+{$i gemdos.inc}
+
+var
+  procdesc: PPD; public name '__base';
+  tpasize: longint;
+  stacktop: pointer;
+  stklen: longint; external name '__stklen';
+
+
+procedure PascalMain; external name 'PASCALMAIN';
+
+
+{ this function must be the first in this unit which contains code }
+{$OPTIMIZATION OFF}
+procedure _FPC_proc_start(pd: PPD); cdecl; public name '_start';
+begin
+  procdesc:=pd;
+  tpasize:=sizeof(pd^) + pd^.p_tlen + pd^.p_dlen + pd^.p_blen + stklen;
+
+  if gemdos_mshrink(0, pd, tpasize) < 0 then
+    begin
+      gemdos_cconws('Not enough memory.'#13#10);
+      gemdos_pterm(-39);
+    end
+  else
+    begin
+      stacktop:=pd^.p_lowtpa + tpasize;
+      asm
+        move.l stacktop, sp
+      end;
+      PascalMain;
+
+      { this should be unreachable... }
+      gemdos_pterm(-1);
+    end;
+end;
+
+procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc';
+begin
+  gemdos_pterm(_ExitCode);
+end;
+
+
+end.

rtl/atari/system.pp

@@ -56,7 +56,7 @@ const
     StdErrorHandle  = $ffff;
 
 var
-    args: Pointer; external name '__ARGS'; { Defined in the startup code }
+    args: PChar;
     argc: LongInt;
     argv: PPChar;
     envp: PPChar;
@@ -95,6 +95,9 @@ var
 
     {$I system.inc}
 
+  var
+    basepage: PPD; external name '__base';
+
 function GetProcessID:SizeUInt;
 begin
   {$WARNING To be checked by platform maintainer}
@@ -190,19 +193,16 @@ end;
     function paramstr(l : longint) : string;
       var
        p : pchar;
-       s1 : string;
       begin
-         if l = 0 then
-         Begin
-           s1 := '';
-         end
-         else
+         {$WARNING Implement query of current command name}
+         { ... as ParamStr(0) }
          if (l>0) and (l<=paramcount) then
            begin
              p:=args;
              paramstr:=GetParam(word(l),p);
            end
-         else paramstr:='';
+         else
+           paramstr:='';
       end;
 
       function paramcount : longint;
@@ -210,6 +210,11 @@ end;
         paramcount := argc;
       end;
 
+  procedure SysInitParamsAndEnv;
+  begin
+    args:=@basepage^.p_cmdlin;
+    argc:=GetParamCount(args);
+  end;
 
   { This routine is used to grow the heap.  }
   { But here we do a trick, we say that the }
@@ -268,7 +273,7 @@ begin
 { Reset IO Error }
   InOutRes:=0;
 { Setup command line arguments }
-//  argc:=GetParamCount(args);
+  SysInitParamsAndEnv;
 {$ifdef FPC_HAS_FEATURE_THREADING}
   InitSystemThreads;
 {$endif}