+ RTL skeleton for the Sinclair QL

git-svn-id: trunk@47310 -

.gitattributes

@@ -11900,6 +11900,18 @@ rtl/riscv64/setjump.inc svneol=native#text/plain
 rtl/riscv64/setjumph.inc svneol=native#text/plain
 rtl/riscv64/strings.inc svneol=native#text/plain
 rtl/riscv64/stringss.inc svneol=native#text/plain
+rtl/sinclairql/Makefile.fpc svneol=native#text/plain
+rtl/sinclairql/buildrtl.pp svneol=native#text/plain
+rtl/sinclairql/rtl.cfg svneol=native#text/plain
+rtl/sinclairql/rtldefs.inc svneol=native#text/plain
+rtl/sinclairql/si_prc.pp svneol=native#text/plain
+rtl/sinclairql/sysdir.inc svneol=native#text/plain
+rtl/sinclairql/sysfile.inc svneol=native#text/plain
+rtl/sinclairql/sysheap.inc svneol=native#text/plain
+rtl/sinclairql/sysos.inc svneol=native#text/plain
+rtl/sinclairql/sysosh.inc svneol=native#text/plain
+rtl/sinclairql/system.pp svneol=native#text/plain
+rtl/sinclairql/tthread.inc svneol=native#text/plain
 rtl/solaris/Makefile svneol=native#text/plain
 rtl/solaris/Makefile.fpc svneol=native#text/plain
 rtl/solaris/errno.inc svneol=native#text/plain

rtl/sinclairql/Makefile.fpc

@@ -0,0 +1,109 @@
+#
+#   Makefile.fpc for Free Pascal Sinclair QL RTL
+#
+
+[package]
+main=rtl
+
+[target]
+loaders=$(LOADERS)
+units=$(SYSTEMUNIT) fpextres uuchar objpas macpas iso7185 buildrtl cpall
+# extpas
+implicitunits=si_prc \
+      ctypes strings rtlconsts sysconst math types \
+      typinfo sortbase fgl classes charset character getopts fpwidestring \
+      cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
+      cp437 cp646 cp737 cp775 cp850 cp852 cp855 cp856 cp857 cp860 cp861 cp862 \
+      cp863 cp864 cp865 cp866 cp869 cp874 cp3021 cp8859_1 cp8859_2 cp8859_3 cp8859_4 \
+      cp8859_5 cp8859_6 cp8859_7 cp8859_8 cp8859_9 cp8859_10 cp8859_11 \
+      cp8859_13 cp8859_14 cp8859_15 cp8859_16 cpkoi8_r cpkoi8_u \
+      unicodedata unicodenumtable
+
+rsts=math rtlconsts typinfo classes sysconst
+
+[require]
+nortl=y
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../..
+target=ql
+cpu=m68k
+
+[compiler]
+includedir=$(INC) $(PROCINC) $(CPU_TARGET)
+sourcedir=$(INC) $(PROCINC) $(CPU_TARGET) $(COMMON)
+
+
+[prerules]
+RTL=..
+INC=$(RTL)/inc
+COMMON=$(RTL)/common
+PROCINC=$(RTL)/$(CPU_TARGET)
+UNITPREFIX=rtl
+LOADERS=
+SYSTEMUNIT=system
+
+# Use new feature from 1.0.5 version
+# that generates release PPU files
+# which will not be recompiled
+ifdef RELEASE
+override FPCOPT+=-Ur
+endif
+
+# Paths
+OBJPASDIR=$(RTL)/objpas
+
+[rules]
+.NOTPARALLEL:
+# Get the system independent include file names.
+# This will set the following variables :
+# SYSINCNAMES
+include $(INC)/makefile.inc
+SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
+
+# Get the processor dependent include file names.
+# This will set the following variables :
+# CPUINCNAMES
+include $(PROCINC)/makefile.cpu
+SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
+
+# Put system unit dependencies together.
+SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
+
+
+#
+# Base Units (System, strings, os-dependent-base-unit)
+#
+
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp $(SYSDEPS)
+        $(COMPILER) $(FPC_SYSTEM_OPT) -Us -Sg @rtl.cfg $(SYSTEMUNIT).pp $(REDIR)
+
+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)
+
+macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) buildrtl$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/macpas.pp
+
+iso7185$(PPUEXT) : $(INC)/iso7185.pp buildrtl$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/iso7185.pp
+
+extpas$(PPUEXT) : $(INC)/extpas.pp buildrtl$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) $(INC)/extpas.pp
+
+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
+
+fpextres$(PPUEXT) : $(INC)/fpextres.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Sg $(INC)/fpextres.pp
+
+cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) objpas$(PPUEXT) heaptrc$(PPUEXT)
+        $(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas

rtl/sinclairql/buildrtl.pp

@@ -0,0 +1,16 @@
+unit buildrtl;
+
+  interface
+
+    uses
+      si_prc,
+
+      ctypes, strings,
+      rtlconsts, sysconst, math, types,
+      typinfo, sortbase, fgl, classes,
+      charset, character, getopts,
+      fpwidestring;
+
+  implementation
+
+end.

rtl/sinclairql/rtl.cfg

@@ -0,0 +1,4 @@
+# Some optional features for the Sinclair QL
+
+# Can be disabled to reduce binary sizes.
+#-SfNOUNICODESTRINGS

rtl/sinclairql/rtldefs.inc

@@ -0,0 +1,24 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2012 by Free Pascal development team
+
+    This file contains platform-specific defines that are used in
+    multiple RTL units.
+
+    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.
+
+ **********************************************************************}
+
+{ the single byte OS APIs always use UTF-8 }
+{ define FPCRTL_FILESYSTEM_UTF8}
+
+{ The OS supports a single byte file system operations API that we use }
+{$define FPCRTL_FILESYSTEM_SINGLE_BYTE_API}
+
+{ The OS supports a two byte file system operations API that we use }
+{ define FPCRTL_FILESYSTEM_TWO_BYTE_API}

rtl/sinclairql/si_prc.pp

@@ -0,0 +1,42 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Karoly Balogh
+
+    System Entry point for the Sinclair QL
+
+    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
+
+var
+  procdesc: PPD; public name '__base';
+  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
+end;
+
+procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc';
+begin
+end;
+
+
+end.

rtl/sinclairql/sysdir.inc

@@ -0,0 +1,37 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Free Pascal development team
+
+    Low level directory functions for the Sinclair QL
+
+    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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+procedure do_mkdir(const s : rawbytestring);
+begin
+end;
+
+
+procedure do_rmdir(const s : rawbytestring);
+begin
+end;
+
+
+procedure do_ChDir(const s: rawbytestring);
+begin
+end;
+
+
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
+begin
+end;

rtl/sinclairql/sysfile.inc

@@ -0,0 +1,94 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Free Pascal development team
+
+    Low level file functions for the Sinclair QL
+
+    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.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+                        Low level File Routines
+               All these functions can set InOutRes on errors
+****************************************************************************}
+
+{ close a file from the handle value }
+procedure do_close(handle : longint);
+begin
+end;
+
+
+procedure do_erase(p : pchar; pchangeable: boolean);
+begin
+end;
+
+
+procedure do_rename(p1,p2 : pchar; p1changeable, p2changeable: boolean);
+begin
+end;
+
+
+function do_write(h: longint; addr: pointer; len: longint) : longint;
+begin
+  do_write:=-1;
+end;
+
+
+function do_read(h: longint; addr: pointer; len: longint) : longint;
+begin
+  do_read:=-1;
+end;
+
+
+function do_filepos(handle: longint) : longint;
+begin
+  do_filepos:=-1;
+end;
+
+
+procedure do_seek(handle, pos: longint);
+begin
+end;
+
+
+function do_seekend(handle: longint):longint;
+begin
+  do_seekend:=-1;
+end;
+
+
+function do_filesize(handle : THandle) : longint;
+begin
+  do_filesize:=-1;
+end;
+
+
+{ truncate at a given position }
+procedure do_truncate(handle, pos: longint);
+begin
+end;
+
+
+procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+begin
+end;
+
+
+function do_isdevice(handle: thandle): boolean;
+begin
+  do_isdevice:=false;
+end;

rtl/sinclairql/sysheap.inc

@@ -0,0 +1,29 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2005 by Free Pascal development team
+
+    Low level memory functions
+
+    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.
+
+ **********************************************************************}
+
+{*****************************************************************************
+      OS Memory allocation / deallocation
+ ****************************************************************************}
+
+
+function SysOSAlloc(size: ptruint): pointer;
+begin
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptruint);
+begin
+end;

rtl/sinclairql/sysos.inc

@@ -0,0 +1,20 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+procedure Error2InOutRes(errno: longint);
+begin
+end;

rtl/sinclairql/sysosh.inc

@@ -0,0 +1,34 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+{$ifdef CPU64}
+  THandle = Int64;
+{$else CPU64}
+  THandle = Longint;
+{$endif CPU64}
+  TThreadID = THandle;
+  TOSTimestamp = Longint;
+
+  PRTLCriticalSection = ^TRTLCriticalSection;
+  TRTLCriticalSection = record
+   Locked: boolean
+  end;
+
+
+

rtl/sinclairql/system.pp

@@ -0,0 +1,171 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2020 by Karoly Balogh
+
+    System unit for the Sinclair QL
+
+    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 System;
+
+interface
+
+{$define FPC_IS_SYSTEM}
+{$define FPC_STDOUT_TRUE_ALIAS}
+{$define FPC_ANSI_TEXTFILEREC}
+{$define FPC_QL_USE_TINYHEAP}
+
+{$ifdef FPC_QL_USE_TINYHEAP}
+{$define HAS_MEMORYMANAGER}
+{$endif FPC_QL_USE_TINYHEAP}
+
+{$i systemh.inc}
+{$ifdef FPC_QL_USE_TINYHEAP}
+{$i tnyheaph.inc}
+{$endif FPC_QL_USE_TINYHEAP}
+
+{Platform specific information}
+const
+    LineEnding = #13#10;
+    LFNSupport = false;
+    CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+    DirectorySeparator = '\';
+    DriveSeparator = ':';
+    ExtensionSeparator = '.';
+    PathSeparator = ';';
+    AllowDirectorySeparators : set of char = ['\','/'];
+    AllowDriveSeparators : set of char = [':'];
+    FileNameCaseSensitive = false;
+    FileNameCasePreserving = false;
+    maxExitCode = 255;
+    MaxPathLen = 255;
+    AllFilesMask = '*.*';
+
+    sLineBreak = LineEnding;
+    DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
+
+const
+    UnusedHandle    = $ffff;
+    StdInputHandle  = 0;
+    StdOutputHandle = 1;
+    StdErrorHandle  = $ffff;
+
+var
+    args: PChar;
+    argc: LongInt;
+    argv: PPChar;
+    envp: PPChar;
+
+
+    {$if defined(FPUSOFT)}
+
+    {$define fpc_softfpu_interface}
+    {$i softfpu.pp}
+    {$undef fpc_softfpu_interface}
+
+    {$endif defined(FPUSOFT)}
+
+
+  implementation
+
+    {$if defined(FPUSOFT)}
+
+    {$define fpc_softfpu_implementation}
+    {$define softfpu_compiler_mul32to64}
+    {$define softfpu_inline}
+    {$i softfpu.pp}
+    {$undef fpc_softfpu_implementation}
+
+    { we get these functions and types from the softfpu code }
+    {$define FPC_SYSTEM_HAS_float64}
+    {$define FPC_SYSTEM_HAS_float32}
+    {$define FPC_SYSTEM_HAS_flag}
+    {$define FPC_SYSTEM_HAS_extractFloat64Frac0}
+    {$define FPC_SYSTEM_HAS_extractFloat64Frac1}
+    {$define FPC_SYSTEM_HAS_extractFloat64Exp}
+    {$define FPC_SYSTEM_HAS_extractFloat64Sign}
+    {$define FPC_SYSTEM_HAS_ExtractFloat32Frac}
+    {$define FPC_SYSTEM_HAS_extractFloat32Exp}
+    {$define FPC_SYSTEM_HAS_extractFloat32Sign}
+
+    {$endif defined(FPUSOFT)}
+
+    {$i system.inc}
+    {$ifdef FPC_QL_USE_TINYHEAP}
+    {$i tinyheap.inc}
+    {$endif FPC_QL_USE_TINYHEAP}
+
+
+  function GetProcessID:SizeUInt;
+  begin
+    GetProcessID := 1;
+  end;
+
+
+  procedure SysInitParamsAndEnv;
+  begin
+  end;
+
+
+  procedure randomize;
+  begin
+    {$WARNING: randseed is uninitialized}
+    randseed:=0;
+  end;
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+procedure system_exit;
+begin
+end;
+
+{*****************************************************************************
+                         System Unit Initialization
+*****************************************************************************}
+
+procedure SysInitStdIO;
+begin
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
+{$ifndef FPC_STDOUT_TRUE_ALIAS}
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{$endif FPC_STDOUT_TRUE_ALIAS}
+end;
+
+function CheckInitialStkLen (StkLen: SizeUInt): SizeUInt;
+begin
+  CheckInitialStkLen := StkLen;
+end;
+
+
+begin
+  StackLength := CheckInitialStkLen (InitialStkLen);
+{ Initialize ExitProc }
+  ExitProc:=Nil;
+{$ifndef FPC_QL_USE_TINYHEAP}
+{ Setup heap }
+  InitHeap;
+{$endif FPC_QL_USE_TINYHEAP}
+  SysInitExceptions;
+{$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+  InitUnicodeStringManager;
+{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+{ Setup stdin, stdout and stderr }
+  SysInitStdIO;
+{ Reset IO Error }
+  InOutRes:=0;
+{ Setup command line arguments }
+  SysInitParamsAndEnv;
+{$ifdef FPC_HAS_FEATURE_THREADING}
+  InitSystemThreads;
+{$endif FPC_HAS_FEATURE_THREADING}
+end.

rtl/sinclairql/tthread.inc

@@ -0,0 +1,80 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by the Free Pascal development team
+
+    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.
+
+ **********************************************************************}
+{****************************************************************************}
+{*                             TThread                                      *}
+{****************************************************************************}
+
+
+procedure TThread.CallOnTerminate;
+
+begin
+end;
+
+
+function TThread.GetPriority: TThreadPriority;
+
+begin
+  GetPriority:=tpNormal;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+
+begin
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+
+begin
+end;
+
+
+procedure TThread.DoTerminate;
+
+begin
+end;
+
+
+procedure TThread.SysCreate(CreateSuspended: Boolean; const StackSize: SizeUInt);
+
+begin
+ {IsMultiThread := TRUE; }
+end;
+
+
+procedure TThread.SysDestroy;
+
+begin
+end;
+
+
+procedure TThread.Resume;
+
+begin
+end;
+
+
+procedure TThread.Suspend;
+
+begin
+end;
+
+
+function TThread.WaitFor: Integer;
+
+begin
+  WaitFor:=0;
+end;
+
+