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

m68k-palmos: skeleton for a recent system unit

Browse Source 
git-svn-id: trunk@36862 -
This commit is contained in:
Károly Balogh 2017-08-08 19:09:23 +00:00
parent 4c7b73d48d
commit 5f2dce07d3
11 changed files with 378 additions and 149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
.gitattributes vendored
View File

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

95
rtl/palmos/m68k/prt0.as
View File

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

62
rtl/palmos/sysdir.inc Normal file
View File

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

86
rtl/palmos/sysfile.inc Normal file
View File

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

29
rtl/palmos/sysheap.inc Normal file
View File

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

12
rtl/palmos/os.inc → rtl/palmos/sysos.inc
View File

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

28
rtl/palmos/sysosh.inc Normal file
View File

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

1
rtl/palmos/syspalm.pp
View File

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

42
rtl/palmos/syspara.inc Normal file
View File

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

163
rtl/palmos/system.pp
View File

@ -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
Interface
{$DEFINE FPC_ANSI_TEXTFILEREC}
{$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 = '*';
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;
sLineBreak = LineEnding;
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
{ !!!!
DWord = Cardinal;
LongWord = Cardinal;
}
const
UnusedHandle = $ffff;
StdInputHandle = 0;
StdOutputHandle = 1;
StdErrorHandle = $ffff;
{ The Cardinal data type isn't currently implemented for the m68k }
DWord = LongInt;
LongWord = LongInt;
var
args: PChar;
argc: LongInt;
argv: PPChar;
envp: PPChar;
{ Zero - terminated strings }
PChar = ^Char;
PPChar = ^PChar;
{ procedure type }
TProcedure = Procedure;
{$if defined(FPUSOFT)}
const
{ max. values for longint and int }
MaxLongint = High(LongInt);
MaxInt = High(Integer);
{$define fpc_softfpu_interface}
{$i softfpu.pp}
{$undef fpc_softfpu_interface}
{ Must be determined at startup for both }
Test68000 : byte = 0;
Test68881 : byte = 0;
{$endif defined(FPUSOFT)}
{ Palm specific data types }
type
Ptr = ^Char;
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.

1
rtl/palmos/systraps.pp
View File

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