m68k-palmos: skeleton for a recent system unit

git-svn-id: trunk@36862 -

.gitattributes

@@ -9908,11 +9908,15 @@ rtl/palmos/m68k/crt0.o -text
 rtl/palmos/m68k/gdbstub.o -text
 rtl/palmos/m68k/libcrt.a -text
 rtl/palmos/m68k/prt0.as svneol=native#text/plain
-rtl/palmos/os.inc svneol=native#text/plain
 rtl/palmos/pilot.pp svneol=native#text/plain
 rtl/palmos/readme -text
 rtl/palmos/rtldefs.inc svneol=native#text/plain
-rtl/palmos/syspalm.pp svneol=native#text/plain
+rtl/palmos/sysdir.inc svneol=native#text/plain
+rtl/palmos/sysfile.inc svneol=native#text/plain
+rtl/palmos/sysheap.inc svneol=native#text/plain
+rtl/palmos/sysos.inc svneol=native#text/plain
+rtl/palmos/sysosh.inc svneol=native#text/plain
+rtl/palmos/syspara.inc svneol=native#text/plain
 rtl/palmos/system.pp svneol=native#text/plain
 rtl/palmos/systraps.pp svneol=native#text/plain
 rtl/powerpc/int64p.inc svneol=native#text/plain

rtl/palmos/m68k/prt0.as

@@ -1,81 +1,16 @@
-This file isn't ready yet, we use the C startup code in crt0.o instead.
+#
+#   This file is part of the Free Pascal run time library.
+#   Copyright (c) 2017 by Karoly Balogh
+#   member of 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.
+#
+#**********************************************************************}
+#
 
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x46):crt0.c: undefined reference to `_GccR
-elocateData'
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x46):crt0.c: relocation truncated to fit:
-DISP16 _GccRelocateData
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x50):crt0.c: undefined reference to `__do_
-bhook'
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x50):crt0.c: relocation truncated to fit:
-DISP16 __do_bhook
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x5a):crt0.c: undefined reference to `__do_
-ctors'
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x5a):crt0.c: relocation truncated to fit:
-DISP16 __do_ctors
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x70):crt0.c: undefined reference to `__do_
-dtors'
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x70):crt0.c: relocation truncated to fit:
-DISP16 __do_dtors
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x7a):crt0.c: undefined reference to `__do_
-ehook'
-c:\FPC\FIXES\RTL\PALMOS\CRT0.O(.text+0x7a):crt0.c: relocation truncated to fit:
-DISP16 __do_ehook
-TEST.O(.text+0x6):test.pas: undefined reference to `FPC_INITIALIZEUNITS'
-TEST.O(.text+0x10):test.pas: undefined reference to `FPC_DO_EXIT'
-
-Disassembly of section .text:
-
-00000000 <start>:
-   0:	4e56 fff4      	linkw %fp,#-12
-   4:	48e7 1f00      	moveml %d3-%d7,%sp@-
-   8:	486e fffc      	pea %fp@(-4)
-   c:	486e fff8      	pea %fp@(-8)
-  10:	486e fff4      	pea %fp@(-12)
-  14:	4e4f           	trap #15
-  16:	a08f           	0120217
-  18:	4fef 000c      	lea %sp@(12),%sp
-  1c:	4a40           	tstw %d0
-  1e:	670e           	beqs 2e <start+0x2e>
-  20:	1f3c 0003      	moveb #3,%sp@-
-  24:	4e4f           	trap #15
-  26:	a234           	0121064
-  28:	70ff           	moveq #-1,%d0
-  2a:	6000 0062      	braw 8e <start+0x8e>
-  2e:	206e fff4      	moveal %fp@(-12),%a0
-  32:	3c10           	movew %a0@,%d6
-  34:	2a28 0002      	movel %a0@(2),%d5
-  38:	3828 0006      	movew %a0@(6),%d4
-  3c:	3604           	movew %d4,%d3
-  3e:	0243 0004      	andiw #4,%d3
-  42:	6704           	beqs 48 <start+0x48>
-  44:	6100 ffba      	bsrw 0 <start>
-  48:	3f04           	movew %d4,%sp@-
-  4a:	2f05           	movel %d5,%sp@-
-  4c:	3f06           	movew %d6,%sp@-
-  4e:	6100 ffb0      	bsrw 0 <start>
-  52:	508f           	addql #8,%sp
-  54:	4a43           	tstw %d3
-  56:	6704           	beqs 5c <start+0x5c>
-  58:	6100 ffa6      	bsrw 0 <start>
-  5c:	3f04           	movew %d4,%sp@-
-  5e:	2f05           	movel %d5,%sp@-
-  60:	3f06           	movew %d6,%sp@-
-  62:	6100 ff9c      	bsrw 0 <start>
-  66:	2e00           	movel %d0,%d7
-  68:	508f           	addql #8,%sp
-  6a:	4a43           	tstw %d3
-  6c:	6704           	beqs 72 <start+0x72>
-  6e:	6100 ff90      	bsrw 0 <start>
-  72:	3f04           	movew %d4,%sp@-
-  74:	2f05           	movel %d5,%sp@-
-  76:	3f06           	movew %d6,%sp@-
-  78:	6100 ff86      	bsrw 0 <start>
-  7c:	2f2e fffc      	movel %fp@(-4),%sp@-
-  80:	2f2e fff8      	movel %fp@(-8),%sp@-
-  84:	2f2e fff4      	movel %fp@(-12),%sp@-
-  88:	4e4f           	trap #15
-  8a:	a090           	0120220
-  8c:	2007           	movel %d7,%d0
-  8e:	4cee 00f8 ffe0 	moveml %fp@(-32),%d3-%d7
-  94:	4e5e           	unlk %fp
-  96:	4e75           	rts
+# FIX ME: dummy file, required for the build to pass, implement! (KB)

rtl/palmos/sysdir.inc

@@ -0,0 +1,62 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2017 by Free Pascal development team
+
+    Low level directory 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.
+
+ **********************************************************************}
+
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+{$if defined(FPC_HAS_FEATURE_ANSISTRINGS)}
+procedure do_mkdir(const s: rawbytestring);
+begin
+  InOutRes:=3;
+end;
+
+procedure do_rmdir(const s: rawbytestring);
+begin
+  InOutRes:=3;
+end;
+
+procedure do_chdir(const s: rawbytestring);
+begin
+  InOutRes:=3;
+end;
+
+procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
+begin
+  InOutRes:=3;
+end;
+
+{$else FPC_HAS_FEATURE_ANSISTRINGS}
+
+procedure mkdir(const s: shortstring);
+begin
+  InOutRes:=3;
+end;
+
+procedure rmdir(const s: shortstring);
+begin
+  InOutRes:=3;
+end;
+
+procedure chdir(const s: shortstring);
+begin
+  InOutRes:=3;
+end;
+
+procedure GetDir (DriveNr: byte; var Dir: ShortString);
+begin
+  InOutRes:=3;
+end;
+{$endif FPC_HAS_FEATURE_ANSISTRINGS}

rtl/palmos/sysfile.inc

@@ -0,0 +1,86 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2017 by Free Pascal development team
+
+    Low level file 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.
+
+ **********************************************************************}
+
+
+{****************************************************************************
+                        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
+  result := -1;
+end;
+
+
+function do_read(h: longint; addr: pointer; len: longint) : longint;
+begin
+  result := -1;
+end;
+
+
+function do_filepos(handle: longint) : longint;
+begin
+  result := -1;
+end;
+
+
+procedure do_seek(handle, pos: longint);
+begin
+end;
+
+
+function do_seekend(handle: longint):longint;
+begin
+  result := -1;
+end;
+
+
+function do_filesize(handle : longint) : longint;
+begin
+  result := -1;
+end;
+
+
+procedure do_truncate(handle, pos: longint);
+begin
+end;
+
+
+procedure do_open(var f;p:PFileTextRecChar;flags:longint; pchangeable: boolean);
+begin
+end;
+
+
+function do_isdevice(handle: longint): boolean;
+begin
+  result := false;
+end;

rtl/palmos/sysheap.inc

@@ -0,0 +1,29 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2017 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/palmos/os.inc → rtl/palmos/sysos.inc

@@ -1,6 +1,8 @@
 {
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team.
+    Copyright (c) 2017 by Free Pascal development team
+
+    OS specific code
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -10,12 +12,4 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-{$define palmos}
-{$undef atari}
-{$undef go32v2}
-{$undef os2}
-{$undef linux}
-{$undef win32}
-{$undef amiga}
-{$undef macos}
 

rtl/palmos/sysosh.inc

@@ -0,0 +1,28 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2017 by Free Pascal development team
+
+    OS specific headers
+
+    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;
+
+  PRTLCriticalSection = ^TRTLCriticalSection;
+  TRTLCriticalSection = record
+   Locked: boolean
+  end;

rtl/palmos/syspalm.pp

@@ -1 +0,0 @@
-{$i system.pp}

rtl/palmos/syspara.inc

@@ -0,0 +1,42 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2017 by Karoly Balogh
+    members of the Free Pascal development team.
+
+    Command line parameter handling
+
+    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.
+
+ **********************************************************************}
+
+
+{ Generates correct argument array on startup }
+procedure GenerateArgs;
+begin
+end;
+
+
+{*****************************************************************************
+                             ParamStr
+*****************************************************************************}
+
+{ number of args }
+function ParamCount: LongInt;
+begin
+  ParamCount := argc - 1;
+end;
+
+{ argument number l }
+function ParamStr(l: LongInt): string;
+var
+  s1: string;
+begin
+  ParamStr := '';
+  if (l > 0) and (l + 1 <= argc) then
+    ParamStr := StrPas(argv[l]);
+end;

rtl/palmos/system.pp

@@ -1,5 +1,4 @@
 {
-
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2000 by Florian Klaempfl
     member of the Free Pascal development team
@@ -13,90 +12,115 @@
 
  **********************************************************************}
 
-{$define PALMOS}
-{$ASMMODE DIRECT}
 unit System;
 
-{$I os.inc}
+interface
+
+{$DEFINE FPC_ANSI_TEXTFILEREC}
 
-  Interface
+{$i systemh.inc}
 
 {Platform specific information}
 const
- LineEnding = #10;
- LFNSupport = false;
- DirectorySeparator = '/';
- DriveSeparator = ':';
- ExtensionSeparator = '.';
- PathSeparator = ';';
- AllowDirectorySeparators : set of char = ['\','/'];
- AllowDriveSeparators : set of char = [':'];
- FileNameCaseSensitive = false;
- FileNameCasePreserving = true;
- CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
- maxExitCode = 255; {$ERROR TODO: CONFIRM THIS}
- MaxPathLen = 256;
- AllFilesMask = '*';
-
-    Type
-       { type and constant declartions doesn't hurt }
-       LongInt  = $80000000..$7fffffff;
-       Integer  = -32768..32767;
-       ShortInt = -128..127;
-       Byte     = 0..255;
-       Word     = 0..65535;
-
-       { !!!!
-       DWord    = Cardinal;
-       LongWord = Cardinal;
-       }
-
-       { The Cardinal data type isn't currently implemented for the m68k }
-       DWord    = LongInt;
-       LongWord = LongInt;
-
-       { Zero - terminated strings }
-       PChar    = ^Char;
-       PPChar   = ^PChar;
-
-       { procedure type }
-       TProcedure = Procedure;
-
-    const
-       { max. values for longint and int }
-       MaxLongint = High(LongInt);
-       MaxInt = High(Integer);
-
-       { Must be determined at startup for both }
-       Test68000 : byte = 0;
-       Test68881 : byte = 0;
-
-    { Palm specific data types }
-    type
-       Ptr    = ^Char;
+    LineEnding = #10;
+    LFNSupport = false;
+    DirectorySeparator = '/';
+    DriveSeparator = ':';
+    ExtensionSeparator = '.';
+    PathSeparator = ';';
+    AllowDirectorySeparators : set of char = ['\','/'];
+    AllowDriveSeparators : set of char = [':'];
+    FileNameCaseSensitive = false;
+    FileNameCasePreserving = true;
+    CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
+    maxExitCode = 255; {.$ERROR TODO: CONFIRM THIS}
+    MaxPathLen = 256;
+    AllFilesMask = '*';
+
+    sLineBreak = LineEnding;
+    DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
+
+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)}
+
 
     var
-       ExitCode : DWord;
        { this variables are passed to PilotMain by the PalmOS }
        cmd : Word;
-       cmdPBP : Ptr;
+       cmdPBP : PChar; // Ptr;
        launchFlags : Word;
 
   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}
+{$i syspara.inc}
+
     { mimic the C start code }
-    function PilotMain(_cmd : Word;_cmdPBP : Ptr;_launchFlags : Word) : DWord;cdecl;public;
+    function PilotMain(_cmd : Word;_cmdPBP : PChar;{Ptr;}_launchFlags : Word) : DWord;cdecl;public;
 
       begin
          cmd:=_cmd;
          cmdPBP:=_cmdPBP;
          launchFlags:=_launchFlags;
-         asm
-            bsr PASCALMAIN
-         end;
+//         asm
+//            bsr PASCALMAIN
+//         end;
          PilotMain:=ExitCode;
       end;
 
+  procedure SysInitParamsAndEnv;
+  begin
+    {$WARNING: make sure argv/argc will be correct here}
+    GenerateArgs;
+  end;
+
+  procedure randomize;
+  begin
+    {$WARNING: randseed initial value is zero!}
+    randseed:=0;
+  end;
+
+
 {*****************************************************************************
                          System Dependent Exit code
 *****************************************************************************}
@@ -106,7 +130,21 @@ end;
 
 function GetProcessID: SizeUInt;
 begin
- GetProcessID := 1;
+  GetProcessID := 1;
+end;
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+procedure SysInitStdIO;
+begin
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
 end;
 
 function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
@@ -115,6 +153,17 @@ begin
 end;
 
 begin
-   StackLength := CheckInitialStkLen (InitialStkLen);
-   ExitCode:=0;
+  StackLength := CheckInitialStkLen (InitialStkLen);
+{ Initialize ExitProc }
+  ExitProc:=Nil;
+{ Setup heap }
+  InitHeap;
+  SysInitExceptions;
+  InitUnicodeStringManager;
+{ Setup stdin, stdout and stderr }
+  SysInitStdIO;
+{ Reset IO Error }
+  InOutRes:=0;
+{ Setup command line arguments }
+  SysInitParamsAndEnv;
 end.

rtl/palmos/systraps.pp

@@ -1,3 +1,4 @@
+{
   adapted for use with Free Pascal by Florian Klaempfl
 }
 { -------------------------------------------------- }