mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 12:07:58 +02:00
350 lines
8.8 KiB
PHP
350 lines
8.8 KiB
PHP
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 2015-2018 by Yuriy Sydorov,
|
|
member of the Free Pascal development team.
|
|
|
|
Android-specific part of the System unit.
|
|
|
|
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.
|
|
**********************************************************************}
|
|
|
|
var
|
|
__stkptr : Pointer; public name '__stkptr';
|
|
operatingsystem_parameter_envp : Pointer; public name 'operatingsystem_parameter_envp';
|
|
operatingsystem_parameter_argc : LongInt; public name 'operatingsystem_parameter_argc';
|
|
operatingsystem_parameter_argv : Pointer; public name 'operatingsystem_parameter_argv';
|
|
|
|
_environ: pointer external name 'environ';
|
|
|
|
GetIcuProc: pointer; public name 'ANDROID_GET_ICU_PROC';
|
|
|
|
procedure CommonMainAndroid;
|
|
const
|
|
EmptyEnv: array[0..2] of PAnsiChar = (nil, nil, nil);
|
|
EmptyCmdLine: array[0..0] of PAnsiChar = ( '' );
|
|
var
|
|
i: cardinal;
|
|
p: PPAnsiChar;
|
|
begin
|
|
// Get the current stack pointer, adjust and save it
|
|
__stkptr:=pointer(ptruint(Sptr) or $FFFF);
|
|
// Get the environment from the environ variable of libc
|
|
p:=_environ;
|
|
if p = nil then
|
|
operatingsystem_parameter_envp:=@EmptyEnv
|
|
else
|
|
begin
|
|
operatingsystem_parameter_envp:=p;
|
|
// Finding argc and argv. They are placed before envp
|
|
Dec(p);
|
|
if p^ = nil then
|
|
begin
|
|
i:=0;
|
|
while i < 200 do
|
|
begin
|
|
Dec(p);
|
|
if ptruint(p^) = i then
|
|
begin
|
|
// argc found
|
|
operatingsystem_parameter_argc:=i;
|
|
operatingsystem_parameter_argv:=p + 1;
|
|
break;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
if operatingsystem_parameter_argc = 0 then
|
|
begin
|
|
// argc and argv are not available
|
|
operatingsystem_parameter_argc:=1;
|
|
operatingsystem_parameter_argv:=@EmptyCmdLine;
|
|
end;
|
|
end;
|
|
|
|
// ************* Program startup code
|
|
|
|
procedure ProgMainAndroid; cdecl; [public, alias:'FPC_PROG_START_ANDROID'];
|
|
begin
|
|
CommonMainAndroid;
|
|
end;
|
|
|
|
// ************* Shared library startup code
|
|
|
|
procedure LibMainAndroid; external name 'FPC_LIB_MAIN_ANDROID';
|
|
|
|
procedure fpc_lib_exit_intern; external name 'FPC_LIB_EXIT';
|
|
|
|
procedure atexit(p: pointer); cdecl; external;
|
|
|
|
var
|
|
_SaveStdOut: THandle;
|
|
_SaveStdErr: THandle;
|
|
|
|
procedure SysAndroidLibExit; cdecl;
|
|
var
|
|
ioclosed: boolean;
|
|
begin
|
|
// Check if stdio is closed now
|
|
ioclosed:=do_syscall(syscall_nr_fcntl, TSysParam(1), 1 {F_GETFD}) = -1;
|
|
// If stdio is closed, restore stdout and stderr
|
|
if ioclosed then
|
|
begin
|
|
FpDup2(_SaveStdOut, 1);
|
|
FpDup2(_SaveStdErr, 2);
|
|
end;
|
|
// Close saved handles
|
|
FpClose(_SaveStdOut);
|
|
FpClose(_SaveStdErr);
|
|
// Finalize the library
|
|
fpc_lib_exit_intern;
|
|
// Close stdout and stderr if stdio has been closed
|
|
if ioclosed then
|
|
begin
|
|
FpClose(1);
|
|
FpClose(2);
|
|
end;
|
|
end;
|
|
|
|
// This procedure is called first when a shared library is loaded
|
|
|
|
procedure AndroidLibStart; cdecl; [public, alias:'FPC_LIB_START_ANDROID'];
|
|
begin
|
|
CommonMainAndroid;
|
|
// Call main code FPC_LIB_MAIN_ANDROID of the library.
|
|
// It points either to a standard PASCALMAIN or FPC_JNI_LIB_MAIN_ANDROID if JNI_OnLoad is exported by the library
|
|
// The linker makes all the magic.
|
|
LibMainAndroid;
|
|
{ Starting from Android 4.4 stdio handles are closed by libc prior to calling
|
|
finalization routines of shared libraries. This causes a error while trying to
|
|
writeln during library finalization and finally a crash because the error can
|
|
not be printed too.
|
|
It is needed to save stdout and stderr handles by duplicating them and restore
|
|
them before library finalization.
|
|
}
|
|
_SaveStdOut:=FpDup(1);
|
|
_SaveStdErr:=FpDup(2);
|
|
// Register the finalization routine
|
|
atexit(@SysAndroidLibExit);
|
|
end;
|
|
|
|
// ************* JNI init
|
|
|
|
function JNI_OnLoad_Real(vm: pointer; reserved: pointer): longint;{$ifdef windows} stdcall {$else} cdecl {$endif}; external name 'FPC_JNI_ON_LOAD';
|
|
procedure PascalMain; external name 'PASCALMAIN';
|
|
|
|
// This proxy function is called when JVM calls the JNI_OnLoad() exported function
|
|
function JNI_OnLoad_Proxy(vm: pointer; reserved: pointer): longint;{$ifdef windows} stdcall {$else} cdecl {$endif}; [public, alias:'FPC_JNI_ON_LOAD_PROXY'];
|
|
begin
|
|
IsJniLibrary:=True;
|
|
// Call library initialization
|
|
PascalMain;
|
|
// Call user's JNI_OnLoad().
|
|
Result:=JNI_OnLoad_Real(vm, reserved);
|
|
end;
|
|
|
|
// This procedure is called instead of library initialization when JNI_OnLoad is exported
|
|
procedure JniLibMain; [public, alias:'FPC_JNI_LIB_MAIN_ANDROID'];
|
|
begin
|
|
// Must be empty.
|
|
end;
|
|
|
|
// ************* haltproc
|
|
|
|
procedure _exit(e:longint); cdecl; external name 'exit';
|
|
|
|
procedure _haltproc(e:longint);cdecl; [public, alias: {$if defined(CPUARM) and defined(FPC_ABI_EABI)} '_haltproc_eabi' {$else} '_haltproc' {$endif}];
|
|
begin
|
|
_exit(e);
|
|
end;
|
|
|
|
// ************* Misc functions
|
|
|
|
function __system_property_get(name:PAnsiChar; value:PAnsiChar):longint;cdecl;external 'c' name '__system_property_get';
|
|
|
|
function GetSystemProperty(Name: PAnsiChar): shortstring;
|
|
begin
|
|
SetLength(Result, __system_property_get(Name, @Result[1]));
|
|
end;
|
|
|
|
var
|
|
_ApiLevel: shortint = -1;
|
|
|
|
function SystemApiLevel: shortint;
|
|
var
|
|
s: shortstring;
|
|
c: integer;
|
|
begin
|
|
if _ApiLevel < 0 then
|
|
begin
|
|
s:=GetSystemProperty('ro.build.version.sdk');
|
|
Val(s, _ApiLevel, c);
|
|
if c <> 0 then
|
|
_ApiLevel:=0;
|
|
end;
|
|
Result:=_ApiLevel;
|
|
end;
|
|
|
|
// ************* Android log
|
|
|
|
var
|
|
DefaultLogTag: string[20];
|
|
|
|
function __android_log_write(prio: longint; tag, text: PAnsiChar): longint; cdecl; external 'log' name '__android_log_write';
|
|
|
|
procedure SysLogWrite(Priority: longint; Tag, Msg: PAnsiChar);
|
|
begin
|
|
__android_log_write(Priority, Tag, Msg);
|
|
end;
|
|
|
|
procedure SysLogWrite(Priority: longint; Msg: PAnsiChar);
|
|
begin
|
|
SysLogWrite(Priority, @DefaultLogTag[1], Msg);
|
|
end;
|
|
|
|
procedure SysLogWrite(Msg: PAnsiChar);
|
|
begin
|
|
SysLogWrite(DefaultSysLogPriority, @DefaultLogTag[1], Msg);
|
|
end;
|
|
|
|
// ************* STDIO redirection to Android log
|
|
|
|
const
|
|
IOBufferLength = 512;
|
|
threadvar
|
|
IOBuf : array[0..IOBufferLength] of AnsiChar;
|
|
IOLen : SizeInt;
|
|
var
|
|
IORedirected: boolean;
|
|
|
|
procedure OutputIOBuffer(Var F: TextRec);
|
|
var
|
|
p: longint;
|
|
begin
|
|
if (@F = @ErrOutput) or (@F = @StdErr) then
|
|
p:=ANDROID_LOG_ERROR
|
|
else
|
|
p:=DefaultSysLogPriority;
|
|
SysLogWrite(p, IOBuf);
|
|
IOLen:=0;
|
|
end;
|
|
|
|
procedure IOWrite(Var F: TextRec);
|
|
var
|
|
i, len : SizeInt;
|
|
pIOBuf: PAnsiChar;
|
|
pIOLen: ^SizeInt;
|
|
Begin
|
|
pIOBuf:=@IOBuf;
|
|
pIOLen:=@IOLen;
|
|
while F.BufPos>0 do
|
|
begin
|
|
begin
|
|
if F.BufPos + pIOLen^ > IOBufferLength then
|
|
len:=IOBufferLength - pIOLen^
|
|
else
|
|
len:=F.BufPos;
|
|
i:=0;
|
|
while i < len do
|
|
begin
|
|
if F.bufptr^[i] in [#10, #13] then
|
|
begin
|
|
pIOBuf[pIOLen^]:=#0;
|
|
OutputIOBuffer(F);
|
|
Inc(i);
|
|
if (i < len) and (F.bufptr^[i - 1] = #13) and (F.bufptr^[i] = #10) then
|
|
Inc(i);
|
|
end
|
|
else
|
|
begin
|
|
pIOBuf[pIOLen^]:=F.bufptr^[i];
|
|
Inc(pIOLen^);
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
pIOBuf[pIOLen^]:=#0;
|
|
end;
|
|
if pIOLen^ = IOBufferLength then
|
|
OutputIOBuffer(F);
|
|
Dec(F.BufPos, len);
|
|
end;
|
|
End;
|
|
|
|
procedure IOClose(Var F: TextRec);
|
|
begin
|
|
if IOLen > 0 then
|
|
OutputIOBuffer(F);
|
|
end;
|
|
|
|
procedure IOOpen(Var F: TextRec);
|
|
Begin
|
|
TextRec(F).InOutFunc:=@IOWrite;
|
|
TextRec(F).FlushFunc:=@IOWrite;
|
|
TextRec(F).CloseFunc:=@IOClose;
|
|
IOLen:=0;
|
|
End;
|
|
|
|
procedure RedirectFile(Var T: Text);
|
|
begin
|
|
Assign(T,'');
|
|
TextRec(T).OpenFunc:=@IOOpen;
|
|
Rewrite(T);
|
|
end;
|
|
|
|
procedure RedirectOutputToSysLog;
|
|
begin
|
|
if IORedirected then exit;
|
|
IORedirected:=True;
|
|
RedirectFile(Output);
|
|
RedirectFile(StdOut);
|
|
RedirectFile(ErrOutput);
|
|
RedirectFile(StdErr);
|
|
end;
|
|
|
|
procedure SetDefaultSysLogTag(const Tag: shortstring);
|
|
var
|
|
len: longint;
|
|
begin
|
|
DefaultLogTag:=Tag;
|
|
len:=Length(DefaultLogTag);
|
|
if len = High(DefaultLogTag) then
|
|
Dec(len);
|
|
DefaultLogTag[len + 1]:=#0;
|
|
end;
|
|
|
|
procedure InitStdIOAndroid;
|
|
begin
|
|
if not IORedirected then exit;
|
|
IORedirected:=False;
|
|
RedirectOutputToSysLog;
|
|
end;
|
|
|
|
// ************* System init
|
|
|
|
procedure InitAndroid;
|
|
var
|
|
i: integer;
|
|
s: shortstring;
|
|
begin
|
|
if IsJniLibrary then
|
|
begin
|
|
// The library is loaded by a Java app. The proper tag will be set by SysUtils.
|
|
SetDefaultSysLogTag('FPC');
|
|
RedirectOutputToSysLog;
|
|
end
|
|
else
|
|
begin
|
|
s:=ParamStr(0);
|
|
i:=Length(s);
|
|
while (i > 0) and (s[i] <> '/') do
|
|
Dec(i);
|
|
SetDefaultSysLogTag(Copy(s, i + 1, MaxInt));
|
|
end;
|
|
end;
|