|
@@ -12,7 +12,7 @@
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
|
|
**********************************************************************}
|
|
**********************************************************************}
|
|
-
|
|
|
|
|
|
+{$SMARTLINK OFF}
|
|
unit si_prc;
|
|
unit si_prc;
|
|
|
|
|
|
interface
|
|
interface
|
|
@@ -27,27 +27,39 @@ var
|
|
sysinit_jmpbuf: jmp_buf;
|
|
sysinit_jmpbuf: jmp_buf;
|
|
ExitCode: LongInt;
|
|
ExitCode: LongInt;
|
|
|
|
|
|
|
|
+var
|
|
|
|
+ { this is declared by the PalmOS linker script }
|
|
|
|
+ data_start: pbyte; external name 'data_start';
|
|
|
|
+
|
|
|
|
|
|
procedure PascalMain; external name 'PASCALMAIN';
|
|
procedure PascalMain; external name 'PASCALMAIN';
|
|
|
|
+procedure FPCRelocateData; forward;
|
|
|
|
|
|
|
|
|
|
{ this function must be the first in this unit which contains code }
|
|
{ this function must be the first in this unit which contains code }
|
|
function _FPC_proc_start: longint; cdecl; public name '_start';
|
|
function _FPC_proc_start: longint; cdecl; public name '_start';
|
|
var
|
|
var
|
|
|
|
+ locAppInfo: SysAppInfoPtr;
|
|
prevGlobals: Pointer;
|
|
prevGlobals: Pointer;
|
|
globalsPtr: Pointer;
|
|
globalsPtr: Pointer;
|
|
begin
|
|
begin
|
|
- if SysAppStartup(appInfo, prevGlobals, globalsPtr) <> 0 then
|
|
|
|
|
|
+ if SysAppStartup(locAppInfo, prevGlobals, globalsPtr) <> 0 then
|
|
begin
|
|
begin
|
|
SndPlaySystemSound(sndError);
|
|
SndPlaySystemSound(sndError);
|
|
exit(-1);
|
|
exit(-1);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+ if (locAppInfo^.launchFlags and sysAppLaunchFlagNewGlobals) > 0 then
|
|
|
|
+ FPCRelocateData;
|
|
|
|
+
|
|
if setjmp(sysinit_jmpbuf) = 0 then
|
|
if setjmp(sysinit_jmpbuf) = 0 then
|
|
- PascalMain;
|
|
|
|
|
|
+ begin
|
|
|
|
+ appInfo:=locAppInfo;
|
|
|
|
+ PascalMain;
|
|
|
|
+ end;
|
|
|
|
|
|
- SysAppExit(appInfo, prevGlobals, globalsPtr);
|
|
|
|
_FPC_proc_start:=ExitCode;
|
|
_FPC_proc_start:=ExitCode;
|
|
|
|
+ SysAppExit(locAppInfo, prevGlobals, globalsPtr);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc';
|
|
procedure _FPC_proc_halt(_ExitCode: longint); cdecl; public name '_haltproc';
|
|
@@ -56,4 +68,49 @@ begin
|
|
longjmp(sysinit_jmpbuf,1);
|
|
longjmp(sysinit_jmpbuf,1);
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+{ data segment relocation magic, ported to Pascal from prc-tools C version }
|
|
|
|
+type
|
|
|
|
+ PReloc = ^TReloc;
|
|
|
|
+ TReloc = record
|
|
|
|
+ case boolean of
|
|
|
|
+ true: ( next: smallint; addend: word );
|
|
|
|
+ false: ( value: dword );
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+procedure RelocateChain(offset: smallint; base: pointer);
|
|
|
|
+var
|
|
|
|
+ data_res: pbyte;
|
|
|
|
+ site: PReloc;
|
|
|
|
+begin
|
|
|
|
+ data_res:=@data_start;
|
|
|
|
+
|
|
|
|
+ while offset >= 0 do
|
|
|
|
+ begin
|
|
|
|
+ site:=PReloc(data_res + offset);
|
|
|
|
+ offset:=site^.next;
|
|
|
|
+ site^.next:=0;
|
|
|
|
+ site^.value:=site^.value + PtrUInt(base);
|
|
|
|
+ end;
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure FPCRelocateData;
|
|
|
|
+var
|
|
|
|
+ relocH: MemHandle;
|
|
|
|
+ chain: psmallint;
|
|
|
|
+const
|
|
|
|
+ rloc_id = $726c6f63; // 'rloc'
|
|
|
|
+begin
|
|
|
|
+ relocH:=DmGet1Resource(rloc_id, 0);
|
|
|
|
+ if relocH <> nil then
|
|
|
|
+ begin
|
|
|
|
+ chain:=MemHandleLock(relocH);
|
|
|
|
+ RelocateChain(chain^, @data_start);
|
|
|
|
+ Inc(chain);
|
|
|
|
+ RelocateChain(chain^, @_FPC_proc_start);
|
|
|
|
+ Inc(chain);
|
|
|
|
+ MemHandleUnlock(relocH);
|
|
|
|
+ DmReleaseResource(relocH);
|
|
|
|
+ end;
|
|
|
|
+end;
|
|
|
|
+
|
|
end.
|
|
end.
|