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

* pas2jni: Basic support for arrays.

Browse Source 
git-svn-id: trunk@32578 -
This commit is contained in:
yury 2015-12-04 14:50:15 +00:00
parent 03067f240c
commit 0e056ece03
3 changed files with 120 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
utils/pas2jni/def.pas
View File

@ -30,7 +30,7 @@ uses
type
TDefType = (dtNone, dtUnit, dtClass, dtProc, dtField, dtProp, dtParam, dtVar,
dtType, dtConst, dtProcType, dtEnum, dtSet, dtPointer);
dtType, dtConst, dtProcType, dtEnum, dtSet, dtPointer, dtArray);
TDefClass = class of TDef;
{ TDef }
@ -205,6 +205,20 @@ type
ElType: TTypeDef;
end;
{ TArrayDef }
TArrayDef = class(TDef)
private
FHasElTypeRef: boolean;
FHasRTypeRef: boolean;
protected
procedure SetIsUsed(const AValue: boolean); override;
public
ElType: TDef;
RangeType: TDef;
RangeLow, RangeHigh: integer;
end;
const
ReplDefs = [dtField, dtProp, dtProc];
@ -222,6 +236,15 @@ begin
Result:=TTypeDef(t1).BasicType = TTypeDef(t2).BasicType;
end;
{ TArrayDef }
procedure TArrayDef.SetIsUsed(const AValue: boolean);
begin
inherited SetIsUsed(AValue);
SetExtUsed(ElType, AValue, FHasElTypeRef);
SetExtUsed(RangeType, AValue, FHasRTypeRef);
end;
{ TPointerDef }
procedure TPointerDef.SetIsUsed(const AValue: boolean);

13
utils/pas2jni/ppuparser.pas
View File

@ -382,10 +382,13 @@ var
else
if jt = 'const' then
d:=TConstDef.Create(CurDef, dtConst)
else
if jt = 'array' then
d:=TArrayDef.Create(CurDef, dtArray)
else
continue;
if (CurObjName = '') and (d.DefType <> dtEnum) then begin
if (CurObjName = '') and not (d.DefType in [dtEnum, dtArray]) then begin
d.Free;
continue;
end;
@ -520,6 +523,14 @@ var
with TPointerDef(d) do begin
PtrType:=_GetRef(it.Get('Ptr', TJSONObject(nil)));;
end;
dtArray:
with TArrayDef(d) do begin
_ReadDefs(d, it, 'Types');
RangeLow:=it.Get('Low', -1);
RangeHigh:=it.Get('High', -1);
RangeType:=_GetRef(it.Get('RangeType', TJSONObject(nil)));
ElType:=_GetRef(it.Get('ElType', TJSONObject(nil)));
end;
end;
end;
end;

118
utils/pas2jni/writer.pas
View File

@ -63,6 +63,7 @@ type
FPkgDir: string;
FUniqueCnt: integer;
FThisUnit: TUnitDef;
FIntegerType: TDef;
function DoCheckItem(const ItemName: string): TCheckItemResult;
@ -844,11 +845,13 @@ begin
s:='__objvar.';
end;
s:=s + Variable.Name;
if Variable.Count > 0 then begin
ASSERT(Count >= 1);
i:=Variable.Count;
j:=Count;
if ProcType = ptProcedure then
Dec(j);
if j > 0 then begin
i:=j;
ss:='';
for j:=0 to Variable.Count - 1 do begin
for j:=0 to j - 1 do begin
if ss <> '' then
ss:=ss + ', ';
ss:=ss + JniToPasType(TVarDef(Items[j]).VarType, Items[j].Name, False);
@ -968,11 +971,36 @@ begin
end;
procedure TWriter.WriteVar(d: TVarDef; AParent: TDef);
function _WriteArrayIndex(pd: TProcDef): TDef;
var
ad: TArrayDef;
i: integer;
begin
ad:=TArrayDef(d.VarType);
i:=1;
repeat
with TVarDef.Create(pd, dtParam) do begin
Name:='Index';
if i > 1 then
Name:=Name + IntToStr(i);
VarType:=ad.RangeType;
if (VarType.DefType = dtType) and (TTypeDef(VarType).BasicType in [btByte, btShortInt, btSmallInt]) then
VarType:=FIntegerType;
VarOpt:=[voRead];
end;
Result:=ad.ElType;
ad:=TArrayDef(Result);
Inc(i);
until Result.DefType <> dtArray;
end;
var
pd: TProcDef;
vd: TVarDef;
t: TTypeDef;
s: string;
vt: TDef;
s, ss: string;
i: integer;
begin
if not d.IsUsed then
@ -989,7 +1017,11 @@ begin
s:=Trim(s + ' ' + d.Name);
if d.Count > 0 then
s:=s + '[]';
Fjs.WriteLn(Format('// %s: %s', [s, d.VarType.Name]));
ss:=d.VarType.Name;
if ss = '' then
if d.VarType.DefType = dtArray then
ss:='array';
Fjs.WriteLn(Format('// %s: %s', [s, ss]));
end;
if voRead in d.VarOpt then begin
@ -999,14 +1031,19 @@ begin
pd.Parent:=d.Parent;
pd.ProcType:=ptFunction;
pd.Name:='get' + d.Name;
pd.ReturnType:=d.VarType;
if d.DefType = dtProp then begin
for i:=0 to d.Count - 1 do begin
vd:=TVarDef(d.Items[i]);
with TVarDef.Create(pd, dtParam) do begin
Name:=vd.Name;
VarType:=vd.VarType;
VarOpt:=[voRead];
if (d.VarType <> nil) and (d.VarType.DefType = dtArray) then
// Array var
pd.ReturnType:=_WriteArrayIndex(pd)
else begin
pd.ReturnType:=d.VarType;
if d.DefType = dtProp then begin
for i:=0 to d.Count - 1 do begin
vd:=TVarDef(d.Items[i]);
with TVarDef.Create(pd, dtParam) do begin
Name:=vd.Name;
VarType:=vd.VarType;
VarOpt:=[voRead];
end;
end;
end;
end;
@ -1023,34 +1060,38 @@ begin
pd.Parent:=d.Parent;
pd.ProcType:=ptProcedure;
pd.Name:='set' + d.Name;
vt:=d.VarType;;
if (d.VarType <> nil) and (d.VarType.DefType = dtArray) then
// Array var
vt:=_WriteArrayIndex(pd)
else
if d.DefType = dtProp then begin
for i:=0 to d.Count - 1 do begin
vd:=TVarDef(d.Items[i]);
with TVarDef.Create(pd, dtParam) do begin
Name:=vd.Name;
VarType:=vd.VarType;
VarOpt:=[voRead];
end;
end;
end;
s:='Value';
if d.DefType = dtProp then begin
for i:=0 to d.Count - 1 do begin
vd:=TVarDef(d.Items[i]);
with TVarDef.Create(pd, dtParam) do begin
Name:=vd.Name;
VarType:=vd.VarType;
VarOpt:=[voRead];
end;
end;
// Check if the name of value parameter is unique
i:=0;
while i < d.Count do begin
if AnsiCompareText(s, d.Items[i].Name) = 0 then begin
i:=0;
s:='_' + s;
continue;
end;
Inc(i);
// Check if the name of value parameter is unique
i:=0;
while i < d.Count do begin
if AnsiCompareText(s, d.Items[i].Name) = 0 then begin
i:=0;
s:='_' + s;
continue;
end;
Inc(i);
end;
with TVarDef.Create(pd, dtParam) do begin
Name:='_' + s;
AliasName:=s;
VarType:=d.VarType;
VarType:=vt;
VarOpt:=[voRead];
end;
t:=TTypeDef.Create(nil, dtType);
@ -1391,6 +1432,15 @@ begin
Fjs.WriteLn('public class ' + u.Name + ' {');
Fjs.IncI;
if u.Name = 'system' then begin
for i:=0 to u.Count - 1 do begin
d:=u[i];
if (d.DefType = dtType) and (TTypeDef(d).BasicType = btLongInt) then begin
FIntegerType:=d;
break;
end;
end;
Fjs.WriteLn('static private boolean _JniLibLoaded = false;');
Fjs.WriteLn('public static void InitJni() {');
Fjs.WriteLn('if (!_JniLibLoaded) {', 1);