* synchronized with trunk

git-svn-id: branches/wasm@46290 -
This commit is contained in:
nickysn 2020-08-06 14:34:20 +00:00
commit b66aa056f1
84 changed files with 435 additions and 251 deletions

2
.gitattributes vendored
View File

@ -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
View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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;

View File

@ -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);

View File

@ -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;

View File

@ -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

View File

@ -257,7 +257,6 @@ implementation
if is_array_constructor(right.resultdef) then
begin
arrayconstructor_to_set(right);
firstpass(right);
if codegenerror then
exit;
end;

View File

@ -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);

View File

@ -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;

View File

@ -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);

View File

@ -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;

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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;

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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;

View File

@ -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;

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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

View File

@ -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];

View File

@ -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}

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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);

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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;

View File

@ -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}

View File

@ -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
View 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
View File

@ -0,0 +1,5 @@
{ %OPT=-O3 }
var a : integer;
begin
write(not((1 in[a]) and (a > a) and (a in[1])))
end.

View File

@ -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

View File

@ -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];

View File

@ -1 +1 @@
'2020-08-04 rev 46226'
'2020-08-05 rev 46241'

View File

@ -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];

View File

@ -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

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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>';

View File

@ -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>';

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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];

View File

@ -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);
},

View File

@ -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];

View File

@ -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>';

View File

@ -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;