mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-13 08:59:27 +02:00
* synchronized with trunk
git-svn-id: branches/wasm@46290 -
This commit is contained in:
commit
b66aa056f1
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -14412,6 +14412,7 @@ tests/test/tarrconstr4.pp svneol=native#text/pascal
|
||||
tests/test/tarrconstr5.pp svneol=native#text/pascal
|
||||
tests/test/tarrconstr6.pp svneol=native#text/pascal
|
||||
tests/test/tarrconstr7.pp svneol=native#text/pascal
|
||||
tests/test/tarrconstr8.pp svneol=native#text/pascal
|
||||
tests/test/tasm1.pp svneol=native#text/plain
|
||||
tests/test/tasm10.pp svneol=native#text/plain
|
||||
tests/test/tasm10a.pp svneol=native#text/plain
|
||||
@ -18444,6 +18445,7 @@ tests/webtbs/tw3742.pp svneol=native#text/plain
|
||||
tests/webtbs/tw37427.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw37449.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw37468.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw37493.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw3751.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3758.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3764.pp svneol=native#text/plain
|
||||
|
2
.gitignore
vendored
2
.gitignore
vendored
@ -7732,6 +7732,8 @@ utils/fpcm/fpcmade.*
|
||||
utils/fpcm/fpcmake
|
||||
utils/fpcm/units
|
||||
utils/fpcmade.*
|
||||
utils/fpcmkcfg/bin
|
||||
utils/fpcmkcfg/units
|
||||
utils/fpcres/*.bak
|
||||
utils/fpcres/*.exe
|
||||
utils/fpcres/*.o
|
||||
|
@ -214,9 +214,9 @@ implementation
|
||||
|
||||
procedure taarch64notnode.second_boolean;
|
||||
begin
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
case left.location.loc of
|
||||
LOC_FLAGS :
|
||||
begin
|
||||
|
@ -315,12 +315,9 @@ implementation
|
||||
var
|
||||
tmpreg : TRegister;
|
||||
begin
|
||||
{ if the location is LOC_JUMP, we do the secondpass after the
|
||||
labels are allocated
|
||||
}
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
case left.location.loc of
|
||||
LOC_FLAGS :
|
||||
begin
|
||||
|
@ -63,9 +63,9 @@ implementation
|
||||
i : longint;
|
||||
falselabel,truelabel,skiplabel: TAsmLabel;
|
||||
begin
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
{ short code? }
|
||||
if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG]) and
|
||||
(left.location.sreg.bitlen=1) then
|
||||
|
@ -76,9 +76,9 @@ implementation
|
||||
hreg: tregister;
|
||||
opsize : tcgsize;
|
||||
begin
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
opsize:=def_cgsize(resultdef);
|
||||
|
||||
if ((left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(left.location.reference.alignment,opsize)) then
|
||||
|
@ -241,31 +241,31 @@ procedure tMIPSELnotnode.second_boolean;
|
||||
var
|
||||
tmpreg : TRegister;
|
||||
begin
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
case left.location.loc of
|
||||
LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE,
|
||||
LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF:
|
||||
begin
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList, left.location, left.resultdef, left.resultdef, True);
|
||||
location_reset(location,LOC_FLAGS,OS_NO);
|
||||
location.resflags.reg2:=NR_R0;
|
||||
location.resflags.cond:=OC_EQ;
|
||||
if is_64bit(resultdef) then
|
||||
begin
|
||||
tmpreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT);
|
||||
{ OR low and high parts together }
|
||||
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR,tmpreg,left.location.register64.reglo,left.location.register64.reghi));
|
||||
location.resflags.reg1:=tmpreg;
|
||||
end
|
||||
begin
|
||||
case left.location.loc of
|
||||
LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE,
|
||||
LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF:
|
||||
begin
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList, left.location, left.resultdef, left.resultdef, True);
|
||||
location_reset(location,LOC_FLAGS,OS_NO);
|
||||
location.resflags.reg2:=NR_R0;
|
||||
location.resflags.cond:=OC_EQ;
|
||||
if is_64bit(resultdef) then
|
||||
begin
|
||||
tmpreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT);
|
||||
{ OR low and high parts together }
|
||||
current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR,tmpreg,left.location.register64.reglo,left.location.register64.reghi));
|
||||
location.resflags.reg1:=tmpreg;
|
||||
end
|
||||
else
|
||||
location.resflags.reg1:=left.location.register;
|
||||
end;
|
||||
else
|
||||
location.resflags.reg1:=left.location.register;
|
||||
internalerror(2003042401);
|
||||
end;
|
||||
else
|
||||
internalerror(2003042401);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
@ -1440,10 +1440,10 @@ implementation
|
||||
case nodetype of
|
||||
andn,orn:
|
||||
begin
|
||||
{ full boolean evaluation is only useful if the nodes are not too complex and if no flags/jumps must be converted,
|
||||
{ full boolean evaluation is only useful if the nodes are not too complex and if no jumps must be converted,
|
||||
further, we need to know the expectloc }
|
||||
if (node_complexity(right)<=2) and
|
||||
not(left.expectloc in [LOC_FLAGS,LOC_JUMP,LOC_INVALID]) and not(right.expectloc in [LOC_FLAGS,LOC_JUMP,LOC_INVALID]) then
|
||||
not(left.expectloc in [LOC_JUMP,LOC_INVALID]) and not(right.expectloc in [LOC_JUMP,LOC_INVALID]) then
|
||||
begin
|
||||
{ we need to copy the whole tree to force another pass_1 }
|
||||
include(localswitches,cs_full_boolean_eval);
|
||||
|
@ -190,7 +190,7 @@ interface
|
||||
ttempinfoflags = set of ttempinfoflag;
|
||||
|
||||
const
|
||||
tempinfostoreflags = [ti_may_be_in_reg,ti_addr_taken,ti_reference,ti_readonly,ti_no_final_regsync,ti_nofini];
|
||||
tempinfostoreflags = [ti_may_be_in_reg,ti_addr_taken,ti_reference,ti_readonly,ti_no_final_regsync,ti_nofini,ti_const];
|
||||
|
||||
type
|
||||
{ to allow access to the location by temp references even after the temp has }
|
||||
@ -1409,10 +1409,23 @@ implementation
|
||||
|
||||
|
||||
procedure ttempcreatenode.printnodedata(var t:text);
|
||||
var
|
||||
f: ttempinfoflag;
|
||||
first: Boolean;
|
||||
begin
|
||||
inherited printnodedata(t);
|
||||
writeln(t,printnodeindention,'size = ',size,', temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "',
|
||||
tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2));
|
||||
write(t,printnodeindention,'[');
|
||||
first:=true;
|
||||
for f in tempflags do
|
||||
begin
|
||||
if not(first) then
|
||||
write(t,',');
|
||||
write(t,f);
|
||||
first:=false;
|
||||
end;
|
||||
writeln(t,']');
|
||||
writeln(t,printnodeindention,'tempinit =');
|
||||
printnode(t,tempinfo^.tempinitcode);
|
||||
end;
|
||||
|
@ -656,11 +656,9 @@ implementation
|
||||
|
||||
function tcgnotnode.handle_locjump: boolean;
|
||||
begin
|
||||
result:=(left.expectloc=LOC_JUMP);
|
||||
result:=left.location.loc=LOC_JUMP;
|
||||
if result then
|
||||
begin
|
||||
secondpass(left);
|
||||
|
||||
if is_constboolnode(left) then
|
||||
internalerror(2014010101);
|
||||
if left.location.loc<>LOC_JUMP then
|
||||
|
@ -257,7 +257,6 @@ implementation
|
||||
if is_array_constructor(right.resultdef) then
|
||||
begin
|
||||
arrayconstructor_to_set(right);
|
||||
firstpass(right);
|
||||
if codegenerror then
|
||||
exit;
|
||||
end;
|
||||
|
@ -2485,16 +2485,26 @@ implementation
|
||||
begin
|
||||
if not try_type_helper(p1,nil) then
|
||||
begin
|
||||
if pattern='CREATE' then
|
||||
if p1.nodetype=typen then
|
||||
begin
|
||||
consume(_ID);
|
||||
p2:=parse_array_constructor(tarraydef(p1.resultdef));
|
||||
p1.destroy;
|
||||
p1:=p2;
|
||||
if pattern='CREATE' then
|
||||
begin
|
||||
consume(_ID);
|
||||
p2:=parse_array_constructor(tarraydef(p1.resultdef));
|
||||
p1.destroy;
|
||||
p1:=p2;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Message2(scan_f_syn_expected,'CREATE',pattern);
|
||||
p1.destroy;
|
||||
p1:=cerrornode.create;
|
||||
consume(_ID);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Message2(scan_f_syn_expected,'CREATE',pattern);
|
||||
Message(parser_e_invalid_qualifier);
|
||||
p1.destroy;
|
||||
p1:=cerrornode.create;
|
||||
consume(_ID);
|
||||
|
@ -515,11 +515,12 @@ implementation
|
||||
var
|
||||
tmpreg: tregister;
|
||||
begin
|
||||
if is_boolean(resultdef) then
|
||||
secondpass(left);
|
||||
if is_boolean(resultdef) then
|
||||
begin
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
{ handle_locjump does call secondpass }
|
||||
case left.location.loc of
|
||||
LOC_FLAGS :
|
||||
begin
|
||||
@ -555,7 +556,6 @@ implementation
|
||||
end
|
||||
else if is_64bitint(left.resultdef) then
|
||||
begin
|
||||
secondpass(left);
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false);
|
||||
location_copy(location,left.location);
|
||||
{ perform the NOT operation }
|
||||
@ -566,7 +566,6 @@ implementation
|
||||
end
|
||||
else
|
||||
begin
|
||||
secondpass(left);
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
|
||||
location_copy(location,left.location);
|
||||
location.loc := LOC_REGISTER;
|
||||
|
@ -377,11 +377,12 @@ end;
|
||||
procedure tppcnotnode.pass_generate_code;
|
||||
|
||||
begin
|
||||
secondpass(left);
|
||||
if is_boolean(resultdef) then
|
||||
begin
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
{ handle_locjump does call secondpass }
|
||||
case left.location.loc of
|
||||
LOC_FLAGS:
|
||||
begin
|
||||
@ -408,7 +409,6 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
secondpass(left);
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList, left.location,
|
||||
left.resultdef, left.resultdef, true);
|
||||
location_copy(location, left.location);
|
||||
|
@ -38,9 +38,9 @@ uses
|
||||
function tripletcpustr(tripletstyle: ttripletstyle): ansistring;
|
||||
begin
|
||||
if target_info.endian=endian_little then
|
||||
result:='ppc64le'
|
||||
result:='powerpc64le'
|
||||
else
|
||||
result:='ppc64'
|
||||
result:='powerpc64'
|
||||
end;
|
||||
|
||||
|
||||
|
@ -63,9 +63,9 @@ implementation
|
||||
var
|
||||
tlabel, flabel: tasmlabel;
|
||||
begin
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
case left.location.loc of
|
||||
LOC_FLAGS :
|
||||
begin
|
||||
|
@ -67,9 +67,9 @@ implementation
|
||||
var
|
||||
tlabel, flabel: tasmlabel;
|
||||
begin
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
case left.location.loc of
|
||||
LOC_FLAGS :
|
||||
begin
|
||||
|
@ -449,9 +449,9 @@ implementation
|
||||
|
||||
procedure tsparcnotnode.second_boolean;
|
||||
begin
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
secondpass(left);
|
||||
case left.location.loc of
|
||||
LOC_FLAGS :
|
||||
begin
|
||||
|
@ -247,12 +247,9 @@ interface
|
||||
begin
|
||||
opsize:=def_cgsize(resultdef);
|
||||
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
{ the second pass could change the location of left }
|
||||
{ if it is a register variable, so we've to do }
|
||||
{ this before the case statement }
|
||||
secondpass(left);
|
||||
case left.location.loc of
|
||||
LOC_FLAGS :
|
||||
begin
|
||||
|
@ -59,13 +59,9 @@ implementation
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
secondpass(left);
|
||||
if not handle_locjump then
|
||||
begin
|
||||
{ the second pass could change the location of left }
|
||||
{ if it is a register variable, so we've to do }
|
||||
{ this before the case statement }
|
||||
secondpass(left);
|
||||
|
||||
if left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,false);
|
||||
case left.location.loc of
|
||||
|
@ -28,7 +28,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'BZip2 decompression unit.';
|
||||
P.NeedLibC:= true;
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,zxspectrum,msxdos];
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -25,7 +25,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Standalone CHM reader and writer library';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,atari,zxspectrum];
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,atari,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -27,7 +27,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Base library of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -99,12 +99,15 @@ begin
|
||||
begin
|
||||
InOutFunc:=@StreamWrite;
|
||||
FlushFunc:=@StreamWrite;
|
||||
if mode=fmAppend then
|
||||
Try
|
||||
GetStream(F).Seek(0,soFromEnd);
|
||||
except
|
||||
InOutRes:=156;
|
||||
end;
|
||||
if Mode=fmAppend then
|
||||
begin
|
||||
Mode:=fmOutput; // see comments in text.inc
|
||||
Try
|
||||
GetStream(F).Seek(0,soFromEnd);
|
||||
except
|
||||
InOutRes:=156;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
@ -32,7 +32,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Database library of Free Component Libraries(FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -30,7 +30,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Unit testing system inspired by JUnit of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,symbian,zxspectrum];
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,symbian,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -28,7 +28,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Image loading and conversion parts of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -23,7 +23,7 @@ begin
|
||||
P.HomepageURL := 'www.freepascal.org';
|
||||
P.Email := 'michael@freepascal.org';
|
||||
P.Description := 'Javascript scanner/parser/syntax tree units';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -26,7 +26,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Json interfacing, part of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -30,7 +30,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Network related parts of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=P.OSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=P.OSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -25,7 +25,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Pascal parsing parts of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -166,12 +166,15 @@ type
|
||||
{$ENDIF}
|
||||
constructor Create(const AName: string; AParent: TPasElement); virtual;
|
||||
destructor Destroy; override;
|
||||
Class Function IsKeyWord(Const S : String) : Boolean;
|
||||
Class Function EscapeKeyWord(Const S : String) : String;
|
||||
procedure AddRef{$IFDEF CheckPasTreeRefCount}(const aId: string){$ENDIF};
|
||||
procedure Release{$IFDEF CheckPasTreeRefCount}(const aId: string){$ENDIF};
|
||||
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer); virtual;
|
||||
procedure ForEachChildCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer; Child: TPasElement; CheckParent: boolean); virtual;
|
||||
Function SafeName : String; // Name but with & prepended if name is a keyword.
|
||||
function FullPath: string; // parent's names, until parent is not TPasDeclarations
|
||||
function ParentPath: string; // parent's names
|
||||
function FullName: string; virtual; // FullPath + Name
|
||||
@ -2584,7 +2587,7 @@ function TPasType.FixTypeDecl(aDecl: String): String;
|
||||
begin
|
||||
Result:=aDecl;
|
||||
if (Name<>'') then
|
||||
Result:=Name+' = '+Result;
|
||||
Result:=SafeName+' = '+Result;
|
||||
ProcessHints(false,Result);
|
||||
end;
|
||||
|
||||
@ -2862,6 +2865,30 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
class function TPasElement.IsKeyWord(const S: String): Boolean;
|
||||
|
||||
Const
|
||||
KW=';absolute;and;array;asm;begin;case;const;constructor;destructor;div;do;'+
|
||||
'downto;else;end;file;for;function;goto;if;implementation;in;inherited;'+
|
||||
'inline;interface;label;mod;nil;not;object;of;on;operator;or;packed;'+
|
||||
'procedure;program;record;reintroduce;repeat;self;set;shl;shr;string;then;'+
|
||||
'to;type;unit;until;uses;var;while;with;xor;dispose;exit;false;new;true;'+
|
||||
'as;class;dispinterface;except;exports;finalization;finally;initialization;'+
|
||||
'inline;is;library;on;out;packed;property;raise;resourcestring;threadvar;try;'+
|
||||
'private;published;length;setlength;';
|
||||
|
||||
begin
|
||||
Result:=Pos(';'+lowercase(S)+';',KW)<>0;
|
||||
end;
|
||||
|
||||
class function TPasElement.EscapeKeyWord(const S: String): String;
|
||||
begin
|
||||
Result:=S;
|
||||
If IsKeyWord(Result) then
|
||||
Result:='&'+Result
|
||||
|
||||
end;
|
||||
|
||||
procedure TPasElement.AddRef{$IFDEF CheckPasTreeRefCount}(const aId: string){$ENDIF};
|
||||
begin
|
||||
{$ifdef EnablePasTreeGlobalRefCount}
|
||||
@ -2951,6 +2978,13 @@ begin
|
||||
Child.ForEachCall(aMethodCall,Arg);
|
||||
end;
|
||||
|
||||
function TPasElement.SafeName: String;
|
||||
begin
|
||||
Result:=Name;
|
||||
if IsKeyWord(Result) then
|
||||
Result:='&'+Result;
|
||||
end;
|
||||
|
||||
function TPasElement.FullPath: string;
|
||||
|
||||
var
|
||||
@ -3029,7 +3063,7 @@ function TPasElement.GetDeclaration(full: Boolean): string;
|
||||
|
||||
begin
|
||||
if Full then
|
||||
Result := Name
|
||||
Result := SafeName
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
@ -4074,7 +4108,7 @@ end;
|
||||
|
||||
function TPasModule.GetDeclaration(full : boolean): string;
|
||||
begin
|
||||
Result := 'Unit ' + Name;
|
||||
Result := 'Unit ' + SafeName;
|
||||
if full then ;
|
||||
end;
|
||||
|
||||
@ -4101,7 +4135,7 @@ begin
|
||||
Result:=Expr.GetDeclaration(true);
|
||||
If Full Then
|
||||
begin
|
||||
Result:=Name+' = '+Result;
|
||||
Result:=SafeName+' = '+Result;
|
||||
ProcessHints(False,Result);
|
||||
end;
|
||||
end;
|
||||
@ -4121,10 +4155,10 @@ end;
|
||||
|
||||
function TPasPointerType.GetDeclaration(full: Boolean): string;
|
||||
begin
|
||||
Result:='^'+DestType.Name;
|
||||
Result:='^'+DestType.SafeName;
|
||||
If Full then
|
||||
begin
|
||||
Result:=Name+' = '+Result;
|
||||
Result:=SafeName+' = '+Result;
|
||||
ProcessHints(False,Result);
|
||||
end;
|
||||
end;
|
||||
@ -4144,7 +4178,7 @@ end;
|
||||
|
||||
function TPasAliasType.GetDeclaration(full: Boolean): string;
|
||||
begin
|
||||
Result:=DestType.Name;
|
||||
Result:=DestType.SafeName;
|
||||
If Full then
|
||||
Result:=FixTypeDecl(Result);
|
||||
end;
|
||||
@ -4165,7 +4199,7 @@ end;
|
||||
|
||||
function TPasClassOfType.GetDeclaration (full : boolean) : string;
|
||||
begin
|
||||
Result:='Class of '+DestType.Name;
|
||||
Result:='Class of '+DestType.SafeName;
|
||||
If Full then
|
||||
Result:=FixTypeDecl(Result);
|
||||
end;
|
||||
@ -4208,7 +4242,7 @@ begin
|
||||
if GenericTemplateTypes<>nil then
|
||||
Result:=Result+GenericTemplateTypesAsString(GenericTemplateTypes)+' = '+Result
|
||||
else
|
||||
Result:=Result+' = '+Result;
|
||||
Result:=SafeName+' = '+Result;
|
||||
end;
|
||||
If (IndexRange<>'') then
|
||||
Result:=Result+'['+IndexRange+']';
|
||||
@ -4216,7 +4250,7 @@ begin
|
||||
If IsPacked then
|
||||
Result := 'packed '+Result; // 12/04/04 Dave - Added
|
||||
If Assigned(Eltype) then
|
||||
Result:=Result+ElType.Name
|
||||
Result:=Result+ElType.SafeName
|
||||
else
|
||||
Result:=Result+'const';
|
||||
end;
|
||||
@ -4244,7 +4278,7 @@ function TPasFileType.GetDeclaration (full : boolean) : string;
|
||||
begin
|
||||
Result:='File';
|
||||
If Assigned(Eltype) then
|
||||
Result:=Result+' of '+ElType.Name;
|
||||
Result:=Result+' of '+ElType.SafeName;
|
||||
If Full Then
|
||||
Result:=FixTypeDecl(Result);
|
||||
end;
|
||||
@ -4265,13 +4299,13 @@ begin
|
||||
S:=TStringList.Create;
|
||||
Try
|
||||
If Full and (Name<>'') then
|
||||
S.Add(Name+' = (')
|
||||
S.Add(SafeName+' = (')
|
||||
else
|
||||
S.Add('(');
|
||||
GetEnumNames(S);
|
||||
S[S.Count-1]:=S[S.Count-1]+')';
|
||||
If Full then
|
||||
Result:=IndentStrings(S,Length(Name)+4)
|
||||
Result:=IndentStrings(S,Length(SafeName)+4)
|
||||
else
|
||||
Result:=IndentStrings(S,1);
|
||||
if Full then
|
||||
@ -4299,7 +4333,7 @@ begin
|
||||
S:=TStringList.Create;
|
||||
Try
|
||||
If Full and (Name<>'') then
|
||||
S.Add(Name+'= Set of (')
|
||||
S.Add(SafeName+'= Set of (')
|
||||
else
|
||||
S.Add('Set of (');
|
||||
TPasEnumType(EnumType).GetEnumNames(S);
|
||||
@ -4312,9 +4346,9 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result:='Set of '+EnumType.Name;
|
||||
Result:='Set of '+EnumType.SafeName;
|
||||
If Full then
|
||||
Result:=Name+' = '+Result;
|
||||
Result:=SafeName+' = '+Result;
|
||||
end;
|
||||
If Full then
|
||||
ProcessHints(False,Result);
|
||||
@ -4451,9 +4485,9 @@ begin
|
||||
If Full and (Name<>'') then
|
||||
begin
|
||||
if GenericTemplateTypes.Count>0 then
|
||||
Temp:=Name+GenericTemplateTypesAsString(GenericTemplateTypes)+' = '+Temp
|
||||
Temp:=SafeName+GenericTemplateTypesAsString(GenericTemplateTypes)+' = '+Temp
|
||||
else
|
||||
Temp:=Name+' = '+Temp;
|
||||
Temp:=SafeName+' = '+Temp;
|
||||
end;
|
||||
S.Add(Temp);
|
||||
GetMembers(S);
|
||||
@ -4525,7 +4559,7 @@ begin
|
||||
S:=TStringList.Create;
|
||||
Try
|
||||
If Full then
|
||||
S.Add(Format('%s = ',[Name]));
|
||||
S.Add(Format('%s = ',[SafeName]));
|
||||
S.Add(TypeName);
|
||||
GetArguments(S);
|
||||
If IsOfObject then
|
||||
@ -4551,14 +4585,14 @@ begin
|
||||
S:=TStringList.Create;
|
||||
Try
|
||||
If Full then
|
||||
S.Add(Format('%s = ',[Name]));
|
||||
S.Add(Format('%s = ',[SafeName]));
|
||||
S.Add(TypeName);
|
||||
GetArguments(S);
|
||||
If Assigned(ResultEl) then
|
||||
begin
|
||||
T:=' : ';
|
||||
If (ResultEl.ResultType.Name<>'') then
|
||||
T:=T+ResultEl.ResultType.Name
|
||||
T:=T+ResultEl.ResultType.SafeName
|
||||
else
|
||||
T:=T+ResultEl.ResultType.GetDeclaration(False);
|
||||
S.Add(T);
|
||||
@ -4592,7 +4626,7 @@ begin
|
||||
If VarType.Name='' then
|
||||
Result:=VarType.GetDeclaration(False)
|
||||
else
|
||||
Result:=VarType.Name;
|
||||
Result:=VarType.SafeName;
|
||||
Result:=Result+Modifiers;
|
||||
if (Value<>'') then
|
||||
Result:=Result+' = '+Value;
|
||||
@ -4601,7 +4635,7 @@ begin
|
||||
Result:=Value;
|
||||
If Full then
|
||||
begin
|
||||
Result:=Name+' '+Seps[Assigned(VarType)]+' '+Result;
|
||||
Result:=SafeName+' '+Seps[Assigned(VarType)]+' '+Result;
|
||||
Result:=Result+HintsString;
|
||||
end;
|
||||
end;
|
||||
@ -4645,7 +4679,7 @@ begin
|
||||
If VarType.Name='' then
|
||||
Result:=VarType.GetDeclaration(False)
|
||||
else
|
||||
Result:=VarType.Name;
|
||||
Result:=VarType.SafeName;
|
||||
end
|
||||
else if Assigned(Expr) then
|
||||
Result:=Expr.GetDeclaration(True);
|
||||
@ -4665,9 +4699,9 @@ begin
|
||||
S:=' ';
|
||||
If Full then
|
||||
begin
|
||||
Result:=Name+S+': '+Result;
|
||||
Result:=SafeName+S+': '+Result;
|
||||
If (ImplementsName<>'') then
|
||||
Result:=Result+' implements '+ImplementsName;
|
||||
Result:=Result+' implements '+EscapeKeyWord(ImplementsName);
|
||||
end;
|
||||
If IsDefault then
|
||||
Result:=Result+'; default';
|
||||
@ -4907,7 +4941,7 @@ begin
|
||||
end;
|
||||
end
|
||||
else if Name<>'' then
|
||||
T:=T+' '+Name;
|
||||
T:=T+' '+SafeName;
|
||||
S.Add(T);
|
||||
end;
|
||||
ProcType.GetArguments(S);
|
||||
@ -4917,7 +4951,7 @@ begin
|
||||
begin
|
||||
T:=' : ';
|
||||
If (Name<>'') then
|
||||
T:=T+Name
|
||||
T:=T+SafeName
|
||||
else
|
||||
T:=T+GetDeclaration(False);
|
||||
S.Add(T);
|
||||
@ -4973,7 +5007,7 @@ begin
|
||||
begin
|
||||
T:=' : ';
|
||||
If (Name<>'') then
|
||||
T:=T+Name
|
||||
T:=T+SafeName
|
||||
else
|
||||
T:=T+GetDeclaration(False);
|
||||
S.Add(T);
|
||||
@ -5041,14 +5075,14 @@ begin
|
||||
If Assigned(ArgType) then
|
||||
begin
|
||||
If ArgType.Name<>'' then
|
||||
Result:=ArgType.Name
|
||||
Result:=ArgType.SafeName
|
||||
else
|
||||
Result:=ArgType.GetDeclaration(False);
|
||||
If Full and (Name<>'') then
|
||||
Result:=Name+': '+Result;
|
||||
Result:=SafeName+': '+Result;
|
||||
end
|
||||
else If Full then
|
||||
Result:=Name
|
||||
Result:=SafeName
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
@ -5710,7 +5744,7 @@ begin
|
||||
begin
|
||||
If Result<>'' then
|
||||
Result:=Result+'; ';
|
||||
Result:=Result+Fields[I].Name+': '+Fields[i].ValueExp.getDeclaration(Full);
|
||||
Result:=Result+EscapeKeyWord(Fields[I].Name)+': '+Fields[i].ValueExp.getDeclaration(Full);
|
||||
end;
|
||||
Result:='('+Result+')';
|
||||
end;
|
||||
|
@ -83,6 +83,7 @@ type
|
||||
constructor Create(AStream: TStream); virtual;
|
||||
destructor Destroy; override;
|
||||
procedure AddForwardClasses(aSection: TPasSection); virtual;
|
||||
procedure WriteResourceString(aStr: TPasResString); virtual;
|
||||
procedure WriteEnumType(AType: TPasEnumType); virtual;
|
||||
procedure WriteElement(AElement: TPasElement);virtual;
|
||||
procedure WriteType(AType: TPasType; Full : Boolean = True);virtual;
|
||||
@ -247,10 +248,19 @@ begin
|
||||
WriteProcImpl(TProcedureBody(AElement))
|
||||
else if AElement.InheritsFrom(TPasImplCommand) or AElement.InheritsFrom(TPasImplCommands) then
|
||||
WriteImplElement(TPasImplElement(AElement),false)
|
||||
else
|
||||
else if AElement.InheritsFrom(TPasResString) then
|
||||
WriteResourceString(TPasResString(AElement))
|
||||
else
|
||||
raise EPasWriter.CreateFmt('Writing not implemented for %s nodes',[AElement.ElementTypeName]);
|
||||
end;
|
||||
|
||||
procedure TPasWriter.WriteResourceString(aStr : TPasResString);
|
||||
|
||||
begin
|
||||
PrepareDeclSection('resourcestring');
|
||||
AddLn(Astr.GetDeclaration(True)+';');
|
||||
end;
|
||||
|
||||
procedure TPasWriter.WriteEnumType(AType: TPasEnumType);
|
||||
|
||||
begin
|
||||
@ -279,9 +289,10 @@ begin
|
||||
WriteAliasType(TPasAliasType(AType))
|
||||
else if AType is TPasPointerType then
|
||||
Add(AType.GetDeclaration(true))
|
||||
else if AType is TPasSetType then
|
||||
Add(AType.GetDeclaration(true))
|
||||
else
|
||||
raise EPasWriter.Create('Writing not implemented for ' +
|
||||
AType.ElementTypeName + ' nodes');
|
||||
raise EPasWriter.CreateFmt('Writing not implemented for %s type nodes',[aType.ElementTypeName]);
|
||||
if Full then
|
||||
AddLn(';');
|
||||
end;
|
||||
@ -294,7 +305,7 @@ Var
|
||||
begin
|
||||
S:='';
|
||||
if aModule.Name<>'' then
|
||||
S:=Format('program %s',[aModule.Name]);
|
||||
S:=Format('program %s',[aModule.SafeName]);
|
||||
if (S<>'') then
|
||||
begin
|
||||
If AModule.InputFile<>'' then
|
||||
@ -311,7 +322,9 @@ begin
|
||||
begin
|
||||
Addln('{$HINTS OFF}');
|
||||
Addln('{$WARNINGS OFF}');
|
||||
Addln('{$IFDEF FPC}');
|
||||
Addln('{$NOTES OFF}');
|
||||
Addln('{$ENDIF FPC}');
|
||||
end;
|
||||
if Assigned(aModule.ProgramSection) then
|
||||
WriteSection(aModule.ProgramSection);
|
||||
@ -335,7 +348,7 @@ Var
|
||||
begin
|
||||
S:='';
|
||||
if aModule.Name<>'' then
|
||||
S:=Format('library %s',[aModule.Name]);
|
||||
S:=Format('library %s',[aModule.SafeName]);
|
||||
if (S<>'') then
|
||||
begin
|
||||
If AModule.InputFile<>'' then
|
||||
@ -423,7 +436,7 @@ begin
|
||||
For J:=0 to C.Members.Count-1 do
|
||||
begin
|
||||
M:=TPasElement(C.members[J]);
|
||||
DoCheckElement(M,True,C.Name+'.');
|
||||
DoCheckElement(M,True,C.SafeName+'.');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -444,7 +457,7 @@ begin
|
||||
PrepareDeclSection('type');
|
||||
For I:=0 to aSection.Classes.Count-1 do
|
||||
begin
|
||||
CN:=TPasElement(aSection.Classes[i]).Name;
|
||||
CN:=TPasElement(aSection.Classes[i]).SafeName;
|
||||
if (FForwardClasses.Count=0) or (ForwardClasses.IndexOf(CN)<>-1) then
|
||||
Addln('%s = class;',[CN]);
|
||||
end;
|
||||
@ -453,7 +466,7 @@ end;
|
||||
procedure TPasWriter.WriteUnit(aModule: TPasModule);
|
||||
|
||||
begin
|
||||
AddLn('unit ' + AModule.Name + ';');
|
||||
AddLn('unit ' + AModule.SafeName + ';');
|
||||
if Assigned(AModule.GlobalDirectivesSection) then
|
||||
begin
|
||||
AddLn;
|
||||
@ -610,7 +623,7 @@ begin
|
||||
PrepareDeclSection('type');
|
||||
Addln;
|
||||
MaybeSetLineElement(AClass);
|
||||
Add(AClass.Name + ' = ');
|
||||
Add(AClass.SafeName + ' = ');
|
||||
if AClass.IsPacked then
|
||||
Add('packed '); // 12/04/04 - Dave - Added
|
||||
case AClass.ObjKind of
|
||||
@ -625,16 +638,16 @@ begin
|
||||
if (AClass.ObjKind=okClass) and (ACLass.ExternalName<>'') and NotOption(woNoExternalClass) then
|
||||
Add(' external name ''%s'' ',[AClass.ExternalName]);
|
||||
if Assigned(AClass.AncestorType) then
|
||||
Add('(' + AClass.AncestorType.Name);
|
||||
Add('(' + AClass.AncestorType.SafeName);
|
||||
if AClass.Interfaces.Count > 0 then
|
||||
begin
|
||||
if Assigned(AClass.AncestorType) then
|
||||
InterfacesListPrefix:=', '
|
||||
else
|
||||
InterfacesListPrefix:='(';
|
||||
Add(InterfacesListPrefix + TPasType(AClass.Interfaces[0]).Name);
|
||||
Add(InterfacesListPrefix + TPasType(AClass.Interfaces[0]).SafeName);
|
||||
for i := 1 to AClass.Interfaces.Count - 1 do
|
||||
Add(', ' + TPasType(AClass.Interfaces[i]).Name);
|
||||
Add(', ' + TPasType(AClass.Interfaces[i]).SafeName);
|
||||
end;
|
||||
if Assigned(AClass.AncestorType) or (AClass.Interfaces.Count > 0) then
|
||||
AddLn(')')
|
||||
@ -695,9 +708,9 @@ begin
|
||||
PrepareDeclSectionInStruct('class var')
|
||||
else if CurDeclSection<>'' then
|
||||
PrepareDeclSectionInStruct('var');
|
||||
Add(aVar.Name + ': ');
|
||||
Add(aVar.SafeName + ': ');
|
||||
if Not Assigned(aVar.VarType) then
|
||||
Raise EWriteError.CreateFmt('No type for variable %s',[aVar.Name]);
|
||||
Raise EWriteError.CreateFmt('No type for variable %s',[aVar.SafeName]);
|
||||
WriteType(aVar.VarType,False);
|
||||
if (aVar.AbsoluteExpr<>nil) then
|
||||
Add(' absolute %s',[aVar.AbsoluteExpr.ClassName])
|
||||
@ -727,7 +740,7 @@ procedure TPasWriter.WriteArgument(aArg: TPasArgument);
|
||||
begin
|
||||
if (aArg.Access<>argDefault) then
|
||||
Add(AccessNames[aArg.Access]+' ');
|
||||
Add(aArg.Name+' : ');
|
||||
Add(aArg.SafeName+' : ');
|
||||
WriteType(aArg.ArgType,False);
|
||||
end;
|
||||
|
||||
@ -798,7 +811,7 @@ begin
|
||||
PrepareDeclSection('');
|
||||
if Not IsImpl then
|
||||
IsImpl:=FInImplementation;
|
||||
Add(AProc.TypeName + ' ' + NamePrefix+AProc.Name);
|
||||
Add(AProc.TypeName + ' ' + NamePrefix+AProc.SafeName);
|
||||
if Assigned(AProc.ProcType) and (AProc.ProcType.Args.Count > 0) then
|
||||
AddProcArgs(AProc.ProcType.Args) ;
|
||||
if Assigned(AProc.ProcType) and
|
||||
@ -901,8 +914,8 @@ begin
|
||||
Add('class ');
|
||||
Add(AProc.TypeName + ' ');
|
||||
if AProc.Parent.ClassType = TPasClassType then
|
||||
Add(AProc.Parent.Name + '.');
|
||||
Add(AProc.Name);
|
||||
Add(AProc.Parent.SafeName + '.');
|
||||
Add(AProc.SafeName);
|
||||
if Assigned(AProc.ProcType) and (AProc.ProcType.Args.Count > 0) then
|
||||
AddProcArgs(AProc.ProcType.Args);
|
||||
if Assigned(AProc.ProcType) and
|
||||
@ -986,7 +999,7 @@ var
|
||||
begin
|
||||
if AProp.IsClass then
|
||||
Add('class ');
|
||||
Add('property ' + AProp.Name);
|
||||
Add('property ' + AProp.SafeName);
|
||||
if AProp.Args.Count > 0 then
|
||||
begin
|
||||
Add('[');
|
||||
@ -1227,7 +1240,7 @@ end;
|
||||
|
||||
procedure TPasWriter.WriteImplExceptOn(aOn: TPasImplExceptOn);
|
||||
begin
|
||||
Addln('On %s : %s do',[aOn.VarEl.Name,aOn.TypeEl.Name]);
|
||||
Addln('On %s : %s do',[aOn.VarEl.SafeName,aOn.TypeEl.SafeName]);
|
||||
if Assigned(aOn.Body) then
|
||||
WriteImplElement(aOn.Body,True);
|
||||
end;
|
||||
|
@ -24,7 +24,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'PDF generating and TTF file info library';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=P.OSes-[embedded,win16,msdos,nativent,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=P.OSes-[embedded,win16,msdos,nativent,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -25,7 +25,7 @@ begin
|
||||
P.Description := 'Process (execution) related parts of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.Options.Add('-S2h');
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,go32v2,nativent,macosclassic,palmos,atari,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,go32v2,nativent,macosclassic,palmos,atari,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -27,7 +27,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Windows registry + emulation parts of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -24,7 +24,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Resource handling of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -25,7 +25,7 @@ begin
|
||||
P.HomepageURL := 'www.freepascal.org';
|
||||
P.Email := 'inoussa12@gmail.com';
|
||||
P.Description := 'Free Pascal implementation of Service Data Objects';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -26,7 +26,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Sound loading, storing and conversion parts for the Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -25,7 +25,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Generic container library of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -29,7 +29,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'XML and DOM parts of Free Component Libraries (FCL), FPC''s OOP library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -25,7 +25,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Basic library of the fpmake/fppkg build system.';
|
||||
P.NeedLibC:= false; // true for headers that indirectly link to libc?
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,atari,macosclassic,palmos,zxspectrum];
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,atari,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -122,7 +122,7 @@ Type
|
||||
palmos,macosclassic,darwin,emx,watcom,morphos,netwlibc,
|
||||
win64,wince,gba,nds,embedded,symbian,haiku,iphonesim,
|
||||
aix,java,android,nativent,msdos,wii,aros,dragonfly,
|
||||
win16,wasm,freertos,zxspectrum,msxdos,ios
|
||||
win16,wasm,freertos,zxspectrum,msxdos,ios,amstradcpc
|
||||
);
|
||||
TOSes = Set of TOS;
|
||||
|
||||
@ -230,7 +230,8 @@ Const
|
||||
{ freertos }( false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, true , false),
|
||||
{zxspectrum}( false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, true ),
|
||||
{ msxdos } ( false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, true ),
|
||||
{ ios } ( false, false, false, false, false, false, true, false, false, false, false, false, false, false, false, false, true , false, false, false, false, false, false)
|
||||
{ ios } ( false, false, false, false, false, false, true, false, false, false, false, false, false, false, false, false, true , false, false, false, false, false, false),
|
||||
{amstradcpc}( false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, true )
|
||||
);
|
||||
|
||||
// Useful
|
||||
@ -1257,7 +1258,7 @@ Type
|
||||
Procedure Clean(APackage : TPackage; ACPU:TCPU; AOS : TOS);
|
||||
Procedure CompileDependencies(APackage : TPackage);
|
||||
function CheckDependencies(APackage : TPackage; ErrorOnFailure: boolean): TCheckDependencyResult;
|
||||
Function CheckExternalPackage(Const APackageName : String; ErrorOnFailure: boolean):TPackage;
|
||||
Function CheckExternalPackage(Const APackageName, ForPackageName : String; ErrorOnFailure: boolean):TPackage;
|
||||
procedure CreateOutputDir(APackage: TPackage);
|
||||
// Packages commands
|
||||
Procedure Compile(Packages : TPackages);
|
||||
@ -1666,7 +1667,7 @@ ResourceString
|
||||
SErrNoDictionaryValue = 'The item "%s" in the dictionary is not a value';
|
||||
SErrNoDictionaryFunc = 'The item "%s" in the dictionary is not a function';
|
||||
SErrInvalidFPCInfo = 'Compiler returns invalid information, check if fpc -iV works';
|
||||
SErrDependencyNotFound = 'Could not find unit directory for dependency package "%s"';
|
||||
SErrDependencyNotFound = 'Could not find unit directory for dependency package "%s" required for package "%s"';
|
||||
SErrAlreadyInitialized = 'Installer can only be initialized once';
|
||||
SErrInvalidState = 'Invalid state for target %s';
|
||||
SErrCouldNotCompile = 'Could not compile target %s from package %s';
|
||||
@ -7260,7 +7261,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TBuildEngine.CheckExternalPackage(Const APackageName : String; ErrorOnFailure: boolean):TPackage;
|
||||
function TBuildEngine.CheckExternalPackage(Const APackageName, ForPackageName : String; ErrorOnFailure: boolean):TPackage;
|
||||
var
|
||||
S : String;
|
||||
F : String;
|
||||
@ -7294,7 +7295,7 @@ begin
|
||||
CompileDependencies(Result);
|
||||
end
|
||||
else if ErrorOnFailure then
|
||||
Error(SErrDependencyNotFound,[APackageName]);
|
||||
Error(SErrDependencyNotFound,[APackageName,ForPackageName]);
|
||||
end;
|
||||
|
||||
|
||||
@ -7327,7 +7328,7 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
D.Target:=CheckExternalPackage(D.Value, true);
|
||||
D.Target:=CheckExternalPackage(D.Value, APackage.Name, true);
|
||||
P:=TPackage(D.Target);
|
||||
end;
|
||||
if (D.RequireChecksum<>$ffffffff) and (D.RequireChecksum<>0) and
|
||||
@ -7369,7 +7370,7 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
D.Target:=CheckExternalPackage(D.Value, ErrorOnFailure);
|
||||
D.Target:=CheckExternalPackage(D.Value, APackage.Name, ErrorOnFailure);
|
||||
P:=TPackage(D.Target);
|
||||
end;
|
||||
if (D.RequireChecksum<>$ffffffff) and
|
||||
|
@ -44,7 +44,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Libraries to create fppkg package managers.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,atari,macosclassic,palmos,symbian,zxspectrum];
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,atari,macosclassic,palmos,symbian,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -41,7 +41,16 @@ uses ctypes;
|
||||
}
|
||||
|
||||
const
|
||||
LibGnuTLS ='libgnutls.so'; {Setup as you need}
|
||||
{$IFDEF WINDOWS}
|
||||
LibGnuTLSExt = 'dll';
|
||||
{$ELSE}
|
||||
{$ifDEF DARWIN}
|
||||
LibGnuTLSExt = 'dylib';
|
||||
{$ELSE}
|
||||
LibGnuTLSExt = 'so';
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
LibGnuTLS ='libgnutls.'+LibGnuTLSExt; {Setup as you need}
|
||||
|
||||
|
||||
{ Converted enums}
|
||||
|
@ -23,7 +23,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Several hash and cryptography algorithms (MD5,CRC,Linux crypt and NTLM1).';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=P.OSes-[embedded,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=P.OSes-[embedded,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -25,7 +25,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Library for pixel graphics conversion';
|
||||
P.NeedLibC := false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -20,7 +20,7 @@ begin
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.3.1';
|
||||
P.SourcePath.Add('src');
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,wii,win16,atari,macosclassic,palmos,symbian,freertos,zxspectrum];
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,wii,win16,atari,macosclassic,palmos,symbian,freertos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -24,7 +24,7 @@ begin
|
||||
P.HomepageURL := 'http://www.destructor.de/';
|
||||
P.Description := 'Library for handling tar-files.';
|
||||
|
||||
P.OSes:=AllOSes-[embedded,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -19,7 +19,7 @@ begin
|
||||
P.Directory:=ADirectory;
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.3.1';
|
||||
P.OSes:=P.OSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=P.OSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -83,7 +83,7 @@ begin
|
||||
aName:=Options.Values['name'];
|
||||
if aName='' then
|
||||
aName:=ChangeFileExt(ExtractFileName(aFileName),'');
|
||||
Result:=Format(SAddResource,[aName,LowerCase(CurrentUnitName),aFormat,aData]);
|
||||
Result:=Format(SAddResource,[LowerCase(aName),LowerCase(CurrentUnitName),aFormat,aData]);
|
||||
end;
|
||||
|
||||
procedure TJSResourceHandler.HandleResource(aFileName: string; Options: TStrings);
|
||||
|
@ -20,7 +20,7 @@ begin
|
||||
P.Directory:=ADirectory;
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.3.1';
|
||||
P.OSes := P.OSes - [embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes := P.OSes - [embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -19,7 +19,7 @@ begin
|
||||
P.Directory:=ADirectory;
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.3.1';
|
||||
P.OSes:=P.OSes-[embedded,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=P.OSes-[embedded,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -23,7 +23,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Generic collection library.';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes := AllOSes-[embedded,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes := AllOSes-[embedded,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -24,7 +24,9 @@ begin
|
||||
P.Dependencies.Add('morphunits',[morphos]);
|
||||
if Defaults.CPU=arm then
|
||||
P.OSes := P.OSes - [darwin];
|
||||
P.OSes := P.OSes - [iphonesim,ios,java,os2,emx,go32v2,watcom,netware,netwlibc,nativent,embedded,android,amiga,aros,msdos,gba,nds,win16,atari,macosclassic,palmos,symbian,wii,freertos,zxspectrum];
|
||||
P.OSes := P.OSes - [iphonesim,ios,java,os2,emx,go32v2,watcom,netware,netwlibc,nativent,embedded,
|
||||
android,amiga,aros,msdos,gba,nds,win16,atari,macosclassic,palmos,symbian,wii,
|
||||
freertos,zxspectrum,msxdos,amstradcpc];
|
||||
|
||||
T:=P.Targets.AddUnit('logger.pas');
|
||||
with T.Dependencies do
|
||||
|
@ -23,7 +23,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'Expression parser with support for fast evaluation';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=P.OSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=P.OSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -20,7 +20,7 @@ begin
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.3.1';
|
||||
P.SourcePath.Add('src');
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -25,7 +25,7 @@ begin
|
||||
P.Email := '';
|
||||
P.Description := 'WEB IDL parser and converter to Object Pascal classes';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -1572,19 +1572,27 @@ end;
|
||||
{$ifndef FPC_SYSTEM_HAS_MUL_BYTE}
|
||||
function fpc_mul_byte(f1,f2 : byte) : byte;[public,alias: 'FPC_MUL_BYTE']; compilerproc;
|
||||
var
|
||||
bitpos : byte;
|
||||
b : byte;
|
||||
v1,v2,res: byte;
|
||||
begin
|
||||
fpc_mul_byte := 0;
|
||||
bitpos := 1;
|
||||
|
||||
for b := 0 to 7 do
|
||||
if f1<f2 then
|
||||
begin
|
||||
if (f2 and bitpos) <> 0 then
|
||||
fpc_mul_byte := fpc_mul_byte + f1;
|
||||
f1 := f1 shl 1;
|
||||
bitpos := bitpos shl 1;
|
||||
v1:=f1;
|
||||
v2:=f2;
|
||||
end
|
||||
else
|
||||
begin
|
||||
v1:=f2;
|
||||
v2:=f1;
|
||||
end;
|
||||
res:=0;
|
||||
while v1<>0 do
|
||||
begin
|
||||
if v1 and 1<>0 then
|
||||
inc(res,v2);
|
||||
v2:=v2 shl 1;
|
||||
v1:=v1 shr 1;
|
||||
end;
|
||||
fpc_mul_byte:=res;
|
||||
end;
|
||||
|
||||
function fpc_mul_byte_checkoverflow(f1,f2 : byte) : byte;[public,alias: 'FPC_MUL_BYTE_CHECKOVERFLOW']; compilerproc;
|
||||
@ -1674,19 +1682,27 @@ end;
|
||||
{$ifndef FPC_SYSTEM_HAS_MUL_WORD}
|
||||
function fpc_mul_word(f1,f2 : word) : word;[public,alias: 'FPC_MUL_WORD']; compilerproc;
|
||||
var
|
||||
bitpos : word;
|
||||
b : byte;
|
||||
v1,v2,res: word;
|
||||
begin
|
||||
fpc_mul_word:=0;
|
||||
bitpos:=1;
|
||||
|
||||
for b:=0 to 15 do
|
||||
if f1<f2 then
|
||||
begin
|
||||
if (f2 and bitpos)<>0 then
|
||||
fpc_mul_word:=fpc_mul_word+f1;
|
||||
f1:=f1 shl 1;
|
||||
bitpos:=bitpos shl 1;
|
||||
v1:=f1;
|
||||
v2:=f2;
|
||||
end
|
||||
else
|
||||
begin
|
||||
v1:=f2;
|
||||
v2:=f1;
|
||||
end;
|
||||
res:=0;
|
||||
while v1<>0 do
|
||||
begin
|
||||
if ALUUInt(v1) and 1<>0 then
|
||||
inc(res,v2);
|
||||
v2:=v2 shl 1;
|
||||
v1:=v1 shr 1;
|
||||
end;
|
||||
fpc_mul_word:=res;
|
||||
end;
|
||||
|
||||
function fpc_mul_word_checkoverflow(f1,f2 : word) : word;[public,alias: 'FPC_MUL_WORD_CHECKOVERFLOW']; compilerproc;
|
||||
@ -1777,19 +1793,27 @@ end;
|
||||
{$ifndef FPC_SYSTEM_HAS_MUL_DWORD}
|
||||
function fpc_mul_dword(f1,f2 : dword) : dword;[public,alias: 'FPC_MUL_DWORD']; compilerproc;
|
||||
var
|
||||
bitpos : dword;
|
||||
b : byte;
|
||||
v1,v2,res: dword;
|
||||
begin
|
||||
fpc_mul_dword:=0;
|
||||
bitpos:=1;
|
||||
|
||||
for b:=0 to 31 do
|
||||
if f1<f2 then
|
||||
begin
|
||||
if (f2 and bitpos)<>0 then
|
||||
fpc_mul_dword:=fpc_mul_dword+f1;
|
||||
f1:=f1 shl 1;
|
||||
bitpos:=bitpos shl 1;
|
||||
v1:=f1;
|
||||
v2:=f2;
|
||||
end
|
||||
else
|
||||
begin
|
||||
v1:=f2;
|
||||
v2:=f1;
|
||||
end;
|
||||
res:=0;
|
||||
while v1<>0 do
|
||||
begin
|
||||
if ALUUInt(v1) and 1<>0 then
|
||||
inc(res,v2);
|
||||
v2:=v2 shl 1;
|
||||
v1:=v1 shr 1;
|
||||
end;
|
||||
fpc_mul_dword:=res;
|
||||
end;
|
||||
|
||||
function fpc_mul_dword_checkoverflow(f1,f2 : dword) : dword;[public,alias: 'FPC_MUL_DWORD_CHECKOVERFLOW']; compilerproc;
|
||||
|
@ -565,6 +565,7 @@ type
|
||||
{$endif FPC_HAS_FEATURE_RTTI}
|
||||
|
||||
{$if defined(FPC_HAS_FEATURE_RANDOM)}
|
||||
{$ifndef FPC_USE_SIMPLE_RANDOM}
|
||||
|
||||
{ Pascal translation of https://github.com/dajobe/libmtwist }
|
||||
|
||||
@ -749,6 +750,55 @@ begin
|
||||
random := mtwist_u32rand * (extended(1.0)/(int64(1) shl 32));
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{$else FPC_USE_SIMPLE_RANDOM}
|
||||
|
||||
{ A simple implementation of random. TP/Delphi compatible. }
|
||||
|
||||
const
|
||||
QRAN_A = 134775813;
|
||||
QRAN_C = 1;
|
||||
|
||||
function rand_next: cardinal;
|
||||
var
|
||||
s: cardinal;
|
||||
begin
|
||||
s:=RandSeed*QRAN_A+QRAN_C;
|
||||
RandSeed:=s;
|
||||
rand_next:=s;
|
||||
end;
|
||||
|
||||
function random(l: word): word;
|
||||
var
|
||||
s,ss: cardinal;
|
||||
begin
|
||||
s:=rand_next;
|
||||
{ use 32-bit multiplications here }
|
||||
ss:=(s shr 16)*l;
|
||||
s:=(s and $FFFF)*l shr 16;
|
||||
random:=(ss + s) shr 16;
|
||||
end;
|
||||
|
||||
function random(l: longint): longint;
|
||||
begin
|
||||
random:=int64(rand_next)*l shr 32;
|
||||
end;
|
||||
|
||||
function random(l:int64):int64;
|
||||
begin
|
||||
random:=random(longint(l));
|
||||
end;
|
||||
|
||||
{$ifndef FPUNONE}
|
||||
function random: extended;
|
||||
const
|
||||
c = 1.0/$10000/$10000;
|
||||
begin
|
||||
random:=rand_next*c;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{$endif FPC_USE_SIMPLE_RANDOM}
|
||||
{$endif FPC_HAS_FEATURE_RANDOM}
|
||||
|
||||
|
||||
|
@ -382,6 +382,12 @@ Type
|
||||
{$endif CPUZ80}
|
||||
|
||||
|
||||
{ By default enable a simple implementation of Random for 8/16 bit CPUs }
|
||||
{$if (defined(CPU16) or defined(CPU8)) and not defined(FPC_NO_SIMPLE_RANDOM)}
|
||||
{$define FPC_USE_SIMPLE_RANDOM}
|
||||
{$endif}
|
||||
|
||||
|
||||
{$if not declared(FarPointer)}
|
||||
FarPointer = Pointer;
|
||||
{$endif}
|
||||
@ -906,6 +912,9 @@ Function Align (Addr : PtrUInt; Alignment : PtrUInt) : PtrUInt;{$ifdef SYSTEMINL
|
||||
Function Align (Addr : Pointer; Alignment : PtrUInt) : Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
|
||||
|
||||
{$ifdef FPC_HAS_FEATURE_RANDOM}
|
||||
{$ifdef FPC_USE_SIMPLE_RANDOM}
|
||||
Function Random(l:word):word;
|
||||
{$endif FPC_USE_SIMPLE_RANDOM}
|
||||
Function Random(l:longint):longint;
|
||||
Function Random(l:int64):int64;
|
||||
{$ifndef FPUNONE}
|
||||
|
13
tests/test/tarrconstr8.pp
Normal file
13
tests/test/tarrconstr8.pp
Normal file
@ -0,0 +1,13 @@
|
||||
{ %FAIL }
|
||||
|
||||
program tarrconstr8;
|
||||
|
||||
type
|
||||
TLongIntArray = array of LongInt;
|
||||
|
||||
var
|
||||
arr: TLongIntArray;
|
||||
begin
|
||||
// Create *must* be used on a type
|
||||
arr := arr.Create(1, 2);
|
||||
end.
|
5
tests/webtbs/tw37493.pp
Normal file
5
tests/webtbs/tw37493.pp
Normal file
@ -0,0 +1,5 @@
|
||||
{ %OPT=-O3 }
|
||||
var a : integer;
|
||||
begin
|
||||
write(not((1 in[a]) and (a > a) and (a in[1])))
|
||||
end.
|
@ -78,7 +78,7 @@ interface
|
||||
o_palmos,o_macosclassic,o_darwin,o_emx,o_watcom,o_morphos,o_netwlibc,
|
||||
o_win64,o_wince,o_gba,o_nds,o_embedded,o_symbian,o_nativent,o_iphonesim,
|
||||
o_wii,o_aix,o_java,o_android,o_msdos,o_aros,o_dragonfly,o_win16,o_wasm,o_freertos,
|
||||
o_zxspectrum,o_msxdos,o_ios
|
||||
o_zxspectrum,o_msxdos,o_ios,o_amstradcpc
|
||||
);
|
||||
|
||||
TTargetSet=array[tcpu,tos] of boolean;
|
||||
@ -103,7 +103,7 @@ interface
|
||||
'win64','wince','gba','nds','embedded','symbian','nativent',
|
||||
'iphonesim', 'wii', 'aix', 'java', 'android', 'msdos', 'aros',
|
||||
'dragonfly', 'win16', 'wasm', 'freertos', 'zxspectrum', 'msxdos',
|
||||
'ios'
|
||||
'ios','amstradcpc'
|
||||
);
|
||||
|
||||
OSSuffix : array[TOS] of string=(
|
||||
@ -113,7 +113,7 @@ interface
|
||||
'_win64','_wince','_gba','_nds','_embedded','_symbian','_nativent',
|
||||
'_iphonesim','_wii','_aix','_java','_android','_msdos','_aros',
|
||||
'_dragonfly','_win16','_wasm','_freertos','_zxspectrum','_msxdos',
|
||||
'_ios'
|
||||
'_ios','_amstradcpc'
|
||||
);
|
||||
|
||||
{ This table is kept OS,Cpu because it is easier to maintain (PFV) }
|
||||
@ -161,7 +161,8 @@ interface
|
||||
{ freertos }( false, false, false, false, false, true, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, true, false),
|
||||
{zxspectrum}( false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, true),
|
||||
{ msxdos} ( false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, true),
|
||||
{ ios } ( false, false, false, false, false, true, false, false, false, false, false, false, false, false, false, false, true , false, false, false, false, false, false)
|
||||
{ ios } ( false, false, false, false, false, true, false, false, false, false, false, false, false, false, false, false, true , false, false, false, false, false, false),
|
||||
{amstradcpc}( false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, false, true)
|
||||
);
|
||||
|
||||
type
|
||||
|
@ -205,7 +205,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils-fpcm');
|
||||
P.ShortName:='fpcm';
|
||||
P.OSes:=AllOSes-[embedded,msdos,nativent,win16,macosclassic,atari,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,nativent,win16,macosclassic,atari,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -1 +1 @@
|
||||
'2020-08-04 rev 46226'
|
||||
'2020-08-05 rev 46241'
|
||||
|
@ -18,7 +18,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils-fpcmkcfg');
|
||||
P.ShortName:='fcmk';
|
||||
P.OSes:=AllOSes-[embedded,msdos,nativent,win16,atari,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,nativent,win16,atari,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -16,7 +16,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils-fpcres');
|
||||
P.ShortName:='fprs';
|
||||
P.OSes:=AllOSes-[atari,embedded,msdos,win16,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[atari,embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
//P.OSes:=[win32,win64,wince,haiku,linux,freebsd,openbsd,netbsd,darwin,iphonesim,ios,solaris,os2,emx,aix,aros,amiga,morphos];
|
||||
|
||||
if Defaults.CPU=jvm then
|
||||
|
@ -17,7 +17,7 @@ begin
|
||||
P:=AddPackage('utils-fpcreslipo');
|
||||
P.ShortName:='fprl';
|
||||
P.Description:='Free Pascal External Resource Thinner';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -25,7 +25,7 @@ begin
|
||||
P.Description := 'Free Pascal documentation generation utility.';
|
||||
P.NeedLibC:= false;
|
||||
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,go32v2,nativent,macosclassic,palmos,atari];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,go32v2,nativent,macosclassic,palmos,atari,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -51,7 +51,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils');
|
||||
P.ShortName := 'tils';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -31,7 +31,7 @@ begin
|
||||
P.Directory:=ADirectory;
|
||||
P.Version:='3.3.1';
|
||||
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,go32v2,win16,atari,macosclassic,palmos,symbian];
|
||||
P.OSes := P.OSes - [embedded,nativent,msdos,go32v2,win16,atari,macosclassic,palmos,symbian,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -24,9 +24,9 @@ begin
|
||||
{ palmos does not have classes }
|
||||
P.OSes := P.OSes - [palmos];
|
||||
{ Program does not fit in 16-bit memory constraints }
|
||||
P.OSes := P.OSes - [msdos,win16];
|
||||
P.OSes := P.OSes - [msdos,win16,zxspectrum,msxdos,amstradcpc];
|
||||
{ avr-embedded and i8086-embedded have not floating point support by default }
|
||||
if Defaults.CPU in [avr,i8086] then
|
||||
if Defaults.CPU in [avr,i8086,z80] then
|
||||
P.OSes := P.OSes - [embedded];
|
||||
|
||||
P.Author := '<various>';
|
||||
|
@ -23,9 +23,9 @@ begin
|
||||
{ palmos does not support command line parameters }
|
||||
P.OSes := P.OSes - [palmos];
|
||||
{ Program does not fit in 16-bit memory constraints }
|
||||
P.OSes := P.OSes - [msdos,win16];
|
||||
P.OSes := P.OSes - [msdos,win16,zxspectrum,msxdos,amstradcpc];
|
||||
{ avr-embedded and i8086-embedded do not support all needed features by default }
|
||||
if Defaults.CPU in [avr,i8086] then
|
||||
if Defaults.CPU in [avr,i8086,z80] then
|
||||
P.OSes := P.OSes - [embedded];
|
||||
|
||||
P.Author := '<various>';
|
||||
|
@ -16,7 +16,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils-ihxutil');
|
||||
P.ShortName:='ihxutil';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -16,7 +16,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils-importtl');
|
||||
P.ShortName:='impt';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -16,7 +16,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils-instantfpc');
|
||||
P.ShortName:='ifpc';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -18,7 +18,7 @@ begin
|
||||
P.Dependencies.Add('fcl-json');
|
||||
|
||||
P.ShortName:='js2p';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -16,7 +16,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils-pas2fpm');
|
||||
p.ShortName:='p2fm';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -24,7 +24,7 @@ begin
|
||||
P.Email := '';
|
||||
P.NeedLibC:= false;
|
||||
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,go32v2,nativent,macosclassic,palmos,atari];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,go32v2,nativent,macosclassic,palmos,atari,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
71
utils/pas2js/dist/rtl.js
vendored
71
utils/pas2js/dist/rtl.js
vendored
@ -893,7 +893,7 @@ var rtl = {
|
||||
}
|
||||
var dimmax = stack.length-1;
|
||||
var depth = 0;
|
||||
var lastlen = stack[dimmax].dim;
|
||||
var lastlen = 0;
|
||||
var item = null;
|
||||
var a = null;
|
||||
var src = arr;
|
||||
@ -916,44 +916,51 @@ var rtl = {
|
||||
srclen = 0;
|
||||
oldlen = a.length;
|
||||
}
|
||||
a.length = stack[depth].dim;
|
||||
lastlen = stack[depth].dim;
|
||||
a.length = lastlen;
|
||||
if (depth>0){
|
||||
item.a[item.i]=a;
|
||||
item.i++;
|
||||
if ((lastlen===0) && (item.i<item.a.length)) continue;
|
||||
}
|
||||
if (depth<dimmax){
|
||||
item = stack[depth];
|
||||
item.a = a;
|
||||
item.i = 0;
|
||||
item.src = src;
|
||||
depth++;
|
||||
} else {
|
||||
if (rtl.isArray(defaultvalue)){
|
||||
// array of dyn array
|
||||
for (var i=0; i<srclen; i++) a[i]=src[i];
|
||||
for (var i=oldlen; i<lastlen; i++) a[i]=[];
|
||||
} else if (rtl.isObject(defaultvalue)) {
|
||||
if (rtl.isTRecord(defaultvalue)){
|
||||
// array of record
|
||||
for (var i=0; i<srclen; i++) a[i]=defaultvalue.$clone(src[i]);
|
||||
for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue.$new();
|
||||
} else {
|
||||
// array of set
|
||||
for (var i=0; i<srclen; i++) a[i]=rtl.refSet(src[i]);
|
||||
for (var i=oldlen; i<lastlen; i++) a[i]={};
|
||||
}
|
||||
if (lastlen>0){
|
||||
if (depth<dimmax){
|
||||
item = stack[depth];
|
||||
item.a = a;
|
||||
item.i = 0;
|
||||
item.src = src;
|
||||
depth++;
|
||||
continue;
|
||||
} else {
|
||||
for (var i=0; i<srclen; i++) a[i]=src[i];
|
||||
for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue;
|
||||
}
|
||||
while ((depth>0) && (stack[depth-1].i>=stack[depth-1].dim)){
|
||||
depth--;
|
||||
};
|
||||
if (depth===0){
|
||||
if (dimmax===0) return a;
|
||||
return stack[0].a;
|
||||
if (srclen>lastlen) srclen=lastlen;
|
||||
if (rtl.isArray(defaultvalue)){
|
||||
// array of dyn array
|
||||
for (var i=0; i<srclen; i++) a[i]=src[i];
|
||||
for (var i=oldlen; i<lastlen; i++) a[i]=[];
|
||||
} else if (rtl.isObject(defaultvalue)) {
|
||||
if (rtl.isTRecord(defaultvalue)){
|
||||
// array of record
|
||||
for (var i=0; i<srclen; i++) a[i]=defaultvalue.$clone(src[i]);
|
||||
for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue.$new();
|
||||
} else {
|
||||
// array of set
|
||||
for (var i=0; i<srclen; i++) a[i]=rtl.refSet(src[i]);
|
||||
for (var i=oldlen; i<lastlen; i++) a[i]={};
|
||||
}
|
||||
} else {
|
||||
for (var i=0; i<srclen; i++) a[i]=src[i];
|
||||
for (var i=oldlen; i<lastlen; i++) a[i]=defaultvalue;
|
||||
}
|
||||
}
|
||||
}
|
||||
// backtrack
|
||||
while ((depth>0) && (stack[depth-1].i>=stack[depth-1].dim)){
|
||||
depth--;
|
||||
};
|
||||
if (depth===0){
|
||||
if (dimmax===0) return a;
|
||||
return stack[0].a;
|
||||
}
|
||||
}while (true);
|
||||
},
|
||||
|
||||
|
@ -16,7 +16,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils-pas2ut');
|
||||
P.ShortName:='p2ut';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
|
@ -24,9 +24,9 @@ begin
|
||||
{ palmos does not support command line parameters }
|
||||
P.OSes := P.OSes - [palmos];
|
||||
{ Program does not fit in 16-bit memory constraints }
|
||||
P.OSes := P.OSes - [msdos,win16];
|
||||
P.OSes := P.OSes - [msdos,win16,zxspectrum,msxdos,amstradcpc];
|
||||
{ avr-embedded and i8086-embedded do not meet needed requirements }
|
||||
if Defaults.CPU in [avr,i8086] then
|
||||
if Defaults.CPU in [avr,i8086,z80] then
|
||||
P.OSes := P.OSes - [embedded];
|
||||
|
||||
P.Author := '<various>';
|
||||
|
@ -16,7 +16,7 @@ begin
|
||||
begin
|
||||
P:=AddPackage('utils-unicode');
|
||||
P.ShortName:='ucd';
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos];
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
|
||||
if Defaults.CPU=jvm then
|
||||
P.OSes := P.OSes - [java,android];
|
||||
|
||||
@ -34,7 +34,7 @@ begin
|
||||
P.Dependencies.Add('fcl-base');
|
||||
P.Dependencies.Add('fcl-xml');
|
||||
|
||||
P.OSes:=[win32, win64, linux, darwin, os2, emx];
|
||||
// P.OSes:=[win32, win64, linux, darwin, os2, emx];
|
||||
|
||||
T := P.Targets.AddImplicitUnit('helper.pas');
|
||||
T.ResourceStrings := true;
|
||||
|
Loading…
Reference in New Issue
Block a user