1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
|
{
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:Pchar; value:Pchar):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: string;
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: pchar): 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 char;
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: string);
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: string;
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;
|