mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 00:47:52 +02:00
* gba and nds work with new heap manager now (no need for a custom heap manager that allocates a single big block anymore)
git-svn-id: trunk@8200 -
This commit is contained in:
Legolas
parent
fc70aa545c
commit
87d67dcad6
2
.gitignore
vendored
2
.gitignore
vendored
@ -1735,6 +1735,7 @@ rtl/freebsd/x86_64/*.ppu
|
||||
rtl/freebsd/x86_64/*.s
|
||||
rtl/freebsd/x86_64/fpcmade.*
|
||||
rtl/freebsd/x86_64/units
|
||||
rtl/gba/Copia[!!-~]di[!!-~]system.pp
|
||||
rtl/gba/backup
|
||||
rtl/gba/build_rtl.bat
|
||||
rtl/gba/build_rtl_EABI.bat
|
||||
@ -1829,6 +1830,7 @@ rtl/morphos/*.ppu
|
||||
rtl/morphos/*.s
|
||||
rtl/morphos/fpcmade.*
|
||||
rtl/morphos/units
|
||||
rtl/nds/backup
|
||||
rtl/nds/parcheggio
|
||||
rtl/netbsd/*.bak
|
||||
rtl/netbsd/*.exe
|
||||
|
||||
@ -19,11 +19,10 @@ interface
|
||||
|
||||
{$define __ARM__} (* For future usage! *)
|
||||
{$define FPC_IS_SYSTEM}
|
||||
{$define USE_NOTHREADMANAGER}
|
||||
|
||||
{$i gbabiosh.inc}
|
||||
|
||||
{$I systemh.inc}
|
||||
{$i systemh.inc}
|
||||
|
||||
{$define fpc_softfpu_interface}
|
||||
{$i softfpu.pp}
|
||||
@ -57,8 +56,7 @@ var
|
||||
argv: PPChar;
|
||||
envp: PPChar;
|
||||
errno: integer;
|
||||
fake_heap_start: pchar; cvar;
|
||||
fake_heap_end: pchar; cvar;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
@ -78,7 +76,7 @@ implementation
|
||||
{$define FPC_SYSTEM_HAS_extractFloat32Exp}
|
||||
{$define FPC_SYSTEM_HAS_extractFloat32Sign}
|
||||
|
||||
{$I system.inc}
|
||||
{$i system.inc}
|
||||
|
||||
{$i gbabios.inc}
|
||||
|
||||
@ -135,34 +133,11 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure InitHeap;
|
||||
begin
|
||||
FillChar(freelists_fixed,sizeof(tfreelists),0);
|
||||
FillChar(freelists_free_chunk,sizeof(freelists_free_chunk),0);
|
||||
|
||||
freelist_var:=nil;
|
||||
{The GBA has no operating system from which we ask memory, so we
|
||||
initialize the heap with a single block of memory.}
|
||||
freeoslistcount:=1;
|
||||
freeoslist:=pointer($2040000);
|
||||
fillchar(freeoslist^,sizeof(freeoslist^),0);
|
||||
freeoslist^.size:=$40000; {GBA heap is $40000 bytes.}
|
||||
fillchar(internal_status,sizeof(internal_status),0);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
begin
|
||||
StackLength := CheckInitialStkLen(InitialStkLen);
|
||||
///StackBottom := Sptr - StackLength;
|
||||
StackBottom := StackTop - StackLength;
|
||||
{ OS specific startup }
|
||||
fake_heap_start := pchar(0);
|
||||
fake_heap_end := pchar(0);
|
||||
{ Set up signals handlers }
|
||||
|
||||
fpc_cpucodeinit;
|
||||
{ Setup heap }
|
||||
InitHeap;
|
||||
SysInitExceptions;
|
||||
@ -171,7 +146,6 @@ begin
|
||||
{ Reset IO Error }
|
||||
InOutRes:=0;
|
||||
{ Arguments }
|
||||
|
||||
InitSystemThreads;
|
||||
initvariantmanager;
|
||||
end.
|
||||
|
||||
@ -1409,7 +1409,6 @@ end;
|
||||
InitHeap
|
||||
*****************************************************************************}
|
||||
|
||||
{$if not(defined(gba)) and not(defined(nds))}
|
||||
{ This function will initialize the Heap manager and need to be called from
|
||||
the initialization of the system unit }
|
||||
procedure InitHeapThread;
|
||||
@ -1436,7 +1435,6 @@ begin
|
||||
{ main freelist will be copied in memory }
|
||||
main_orig_freelists := loc_freelists;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
procedure RelocateHeap;
|
||||
var
|
||||
|
||||
@ -20,10 +20,12 @@
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
|
||||
|
||||
var
|
||||
heap_start: longint; external name '_end';
|
||||
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
result := pointer($02000000);
|
||||
result := @heap_start;
|
||||
end;
|
||||
|
||||
{ $define HAS_SYSOSFREE}
|
||||
|
||||
@ -18,37 +18,30 @@ unit System;
|
||||
interface
|
||||
|
||||
{$define FPC_IS_SYSTEM}
|
||||
{ $define USE_NOTHREADMANAGER}
|
||||
{ $define HAS_MEMORYMANAGER}
|
||||
{ $undef FPC_HAS_FEATURE_TEXTIO}
|
||||
|
||||
{$i ndsbiosh.inc}
|
||||
|
||||
{$I systemh.inc}
|
||||
{$i systemh.inc}
|
||||
|
||||
{$define fpc_softfpu_interface}
|
||||
{$i softfpu.pp}
|
||||
{$undef fpc_softfpu_interface}
|
||||
|
||||
function IsARM9(): boolean;
|
||||
procedure InitHeapThread;
|
||||
|
||||
const
|
||||
LineEnding = #10;
|
||||
LFNSupport = true;
|
||||
CtrlZMarksEOF: boolean = false;
|
||||
DirectorySeparator = '/';
|
||||
DriveSeparator = ':';
|
||||
PathSeparator = ';';
|
||||
FileNameCaseSensitive = false;
|
||||
maxExitCode = 255;
|
||||
MaxPathLen = 255;
|
||||
LineEnding = #10;
|
||||
LFNSupport = true;
|
||||
CtrlZMarksEOF: boolean = false;
|
||||
DirectorySeparator = '/';
|
||||
DriveSeparator = ':';
|
||||
PathSeparator = ';';
|
||||
FileNameCaseSensitive = false;
|
||||
maxExitCode = 255;
|
||||
MaxPathLen = 255;
|
||||
|
||||
sLineBreak: string[1] = LineEnding;
|
||||
DefaultTextLineBreakStyle: TTextLineBreakStyle = tlbsCRLF;
|
||||
|
||||
sLineBreak : string[1] = LineEnding;
|
||||
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCRLF;
|
||||
|
||||
const
|
||||
UnusedHandle = $ffff;
|
||||
StdInputHandle = 0;
|
||||
StdOutputHandle = 1;
|
||||
@ -60,18 +53,7 @@ var
|
||||
argv: PPChar;
|
||||
envp: PPChar;
|
||||
errno: integer;
|
||||
// fake_heap_start: ^byte; cvar;
|
||||
fake_heap_end: ^byte; cvar;
|
||||
// heap_start: longint; external name 'end';
|
||||
// heap_end: longint; external name '__eheap_end';
|
||||
heap_start: longint; external name 'end';
|
||||
heap_end: longint; external name 'fake_heap_end';
|
||||
// __eheap_start: longint; cvar; external;
|
||||
// fake_heap_end: longint; cvar; external;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
@ -91,15 +73,22 @@ implementation
|
||||
{$define FPC_SYSTEM_HAS_extractFloat32Exp}
|
||||
{$define FPC_SYSTEM_HAS_extractFloat32Sign}
|
||||
|
||||
{$I system.inc}
|
||||
|
||||
{$i system.inc}
|
||||
{$i ndsbios.inc}
|
||||
|
||||
{ NDS CPU detecting function (thanks to 21o6):
|
||||
|
||||
{
|
||||
NDS CPU detecting function (thanks to 21o6):
|
||||
--------------------------------------------
|
||||
"You see, the ARM7 can't write to bank A of VRAM, but it doesn't give any
|
||||
error ... it just doesn't write there... so it's easily determinable what
|
||||
CPU is running the code"}
|
||||
CPU is running the code"
|
||||
|
||||
ARM946E-S processor can handle dsp extensions extensions, but ARM7TDMI does
|
||||
not. FPC can't retrieve the CPU target at compiling time, so this small
|
||||
function takes care to check if the code is running on an ARM9 or on an ARM7
|
||||
CPU. It works on Nintendo DS only, I guess :)
|
||||
}
|
||||
function IsARM9(): boolean;
|
||||
var
|
||||
Dummy : pword absolute $06800000;
|
||||
@ -114,6 +103,7 @@ end;
|
||||
{$ifdef FPC_HAS_FEATURE_PROCESSES}
|
||||
function GetProcessID: SizeUInt;
|
||||
begin
|
||||
GetProcessID := 0;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
@ -123,6 +113,7 @@ end;
|
||||
*****************************************************************************}
|
||||
procedure System_exit;
|
||||
begin
|
||||
// Boo!
|
||||
end;
|
||||
|
||||
|
||||
@ -134,18 +125,19 @@ end;
|
||||
{ number of args }
|
||||
function paramcount : longint;
|
||||
begin
|
||||
paramcount:=0;
|
||||
paramcount := 0;
|
||||
end;
|
||||
|
||||
{ argument number l }
|
||||
function paramstr(l : longint) : string;
|
||||
begin
|
||||
paramstr:='';
|
||||
paramstr := '';
|
||||
end;
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize;
|
||||
begin
|
||||
// Boo!
|
||||
end;
|
||||
|
||||
{$ifdef FPC_HAS_FEATURE_TEXTIO}
|
||||
@ -164,69 +156,12 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
(*
|
||||
procedure InitHeap;
|
||||
begin
|
||||
FillChar(freelists_fixed,sizeof(tfreelists),0);
|
||||
FillChar(freelists_free_chunk,sizeof(freelists_free_chunk),0);
|
||||
|
||||
freelist_var:=nil;
|
||||
{The GBA has no operating system from which we ask memory, so we
|
||||
initialize the heap with a single block of memory.}
|
||||
freeoslistcount:=1;
|
||||
//freeoslist:=pointer($023FF000);
|
||||
freeoslist:=pointer(heap_start);
|
||||
fillchar(freeoslist^,sizeof(freeoslist^),0);
|
||||
//freeoslist^.size:=$00040000;//$003FF000;
|
||||
freeoslist^.size:=heap_end-heap_start;
|
||||
fillchar(internal_status,sizeof(internal_status),0);
|
||||
end;
|
||||
*)
|
||||
|
||||
procedure InitHeap;
|
||||
var
|
||||
loc_freelists: pfreelists;
|
||||
begin
|
||||
{ we cannot initialize the locks here yet, thread support is
|
||||
not loaded yet }
|
||||
loc_freelists := @freelists;
|
||||
|
||||
// PROVA -->
|
||||
loc_freelists^.varlist := nil;
|
||||
loc_freelists^.oscount := 1;
|
||||
loc_freelists := pointer(heap_start);
|
||||
|
||||
fillchar(loc_freelists^, sizeof(tfreelists), 0);
|
||||
fillchar(orphaned_freelists, sizeof(orphaned_freelists), 0);
|
||||
|
||||
loc_freelists^.oslist^.size := heap_end - heap_start;
|
||||
fillchar(loc_freelists^.internal_status, sizeof(TFPCHeapStatus), 0);
|
||||
// <-- PROVA
|
||||
|
||||
end;
|
||||
|
||||
|
||||
procedure InitHeapThread;
|
||||
var
|
||||
loc_freelists: pfreelists;
|
||||
begin
|
||||
loc_freelists := @freelists;
|
||||
fillchar(loc_freelists^,sizeof(tfreelists),0);
|
||||
{$ifdef DUMP_MEM_USAGE}
|
||||
fillchar(sizeusage,sizeof(sizeusage),0);
|
||||
fillchar(maxsizeusage,sizeof(sizeusage),0);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
begin
|
||||
StackLength := CheckInitialStkLen(InitialStkLen);
|
||||
///StackBottom := Sptr - StackLength;
|
||||
StackBottom := StackTop - StackLength;
|
||||
{ OS specific startup }
|
||||
// fake_heap_start := pchar(0);
|
||||
// fake_heap_end := pchar(0);
|
||||
{ Set up signals handlers }
|
||||
|
||||
{ Set up signals handlers }
|
||||
if IsARM9 then
|
||||
fpc_cpucodeinit;
|
||||
|
||||
@ -238,7 +173,6 @@ begin
|
||||
{ Reset IO Error }
|
||||
InOutRes:=0;
|
||||
{ Arguments }
|
||||
|
||||
InitSystemThreads;
|
||||
initvariantmanager;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user