paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 21:59:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@35201 -
This commit is contained in:
Károly Balogh 2016-12-27 08:14:34 +00:00
parent 2199f2a65e
commit 8760ff96e1
10 changed files with 453 additions and 430 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -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

3
compiler/systems.pas
View File

@ -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 = [

4
compiler/systems/i_atari.pas
View File

@ -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;

14
compiler/systems/t_atari.pas
View File

@ -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;

580
rtl/atari/Makefile
View File

File diff suppressed because it is too large Load Diff

146
rtl/atari/Makefile.fpc
View File

@ -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
extpas$(PPUEXT) : $(INC)/extpas.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) heaptrc$(PPUEXT)
$(COMPILER) $(INC)/extpas.pp
#
# System Dependent Units
#
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
#ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
fpextres$(PPUEXT) : $(INC)/fpextres.pp $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) -Sg $(INC)/fpextres.pp
#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
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp $(REDIR)
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

18
rtl/atari/buildrtl.pp Normal file
View File

@ -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.

28
rtl/atari/gemdos.inc
View File

@ -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;

65
rtl/atari/si_prc.pp Normal file
View File

@ -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.

23
rtl/atari/system.pp
View File

@ -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}