paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 18:49:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/unicodekvm@49004 -
This commit is contained in:
nickysn 2021-03-18 22:41:30 +00:00
commit a2df653db1
19 changed files with 533 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/aoptobj.pas
View File

@ -1400,6 +1400,8 @@ Unit AoptObj;
reg:=newreg(R_FPUREGISTER,getsupreg(reg),R_SUBWHOLE);
R_ADDRESSREGISTER:
reg:=newreg(R_ADDRESSREGISTER,getsupreg(reg),R_SUBWHOLE);
R_SPECIALREGISTER:
reg:=newreg(R_SPECIALREGISTER,getsupreg(reg),R_SUBWHOLE);
else
Internalerror(2018030701);
end;

17
compiler/pdecvar.pas
View File

@ -360,8 +360,8 @@ implementation
{ Generate temp procdefs to search for matching read/write
procedures. the readprocdef will store all definitions }
paranr:=0;
readprocdef:=cprocdef.create(normal_function_level,true);
writeprocdef:=cprocdef.create(normal_function_level,true);
readprocdef:=cprocdef.create(normal_function_level,false);
writeprocdef:=cprocdef.create(normal_function_level,false);
readprocdef.struct:=astruct;
writeprocdef.struct:=astruct;
@ -857,11 +857,14 @@ implementation
message1(parser_e_implements_uses_non_implemented_interface,def.typename);
until not try_to_consume(_COMMA);
{ remove unneeded procdefs }
if readprocdef.proctypeoption<>potype_propgetter then
readprocdef.owner.deletedef(readprocdef);
if writeprocdef.proctypeoption<>potype_propsetter then
writeprocdef.owner.deletedef(writeprocdef);
{ register propgetter and propsetter procdefs }
if assigned(current_module) and current_module.in_interface then
begin
if readprocdef.proctypeoption=potype_propgetter then
readprocdef.register_def;
if writeprocdef.proctypeoption=potype_propsetter then
writeprocdef.register_def;
end;
result:=p;
end;

38
compiler/riscv/aoptcpurv.pas
View File

@ -47,6 +47,7 @@ type
procedure DebugMsg(const s: string; p: tai);
function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
function OptPass1OP(var p: tai): boolean;
end;
implementation
@ -175,6 +176,40 @@ implementation
end;
function TRVCpuAsmOptimizer.OptPass1OP(var p : tai) : boolean;
var
hp1 : tai;
begin
result:=false;
{ replace
<Op> %reg3,%mreg2,%mreg1
addi %reg4,%reg3,0
dealloc %reg3
by
<Op> %reg4,%reg2,%reg1
?
}
if GetNextInstruction(p,hp1) and
{ we mix single and double operations here because we assume that the compiler
generates vmovapd only after double operations and vmovaps only after single operations }
MatchInstruction(hp1,A_ADDI) and
(taicpu(hp1).oper[2]^.val=0) and
MatchOperand(taicpu(p).oper[0]^,taicpu(hp1).oper[1]^) then
begin
TransferUsedRegs(TmpUsedRegs);
UpdateUsedRegs(TmpUsedRegs, tai(p.next));
if not(RegUsedAfterInstruction(taicpu(hp1).oper[1]^.reg,hp1,TmpUsedRegs)) then
begin
taicpu(p).loadoper(0,taicpu(hp1).oper[0]^);
DebugMsg('Peephole OpAddi02Op done',p);
RemoveInstruction(hp1);
result:=true;
end;
end;
end;
function TRVCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
procedure RemoveInstr(var orig: tai; moveback: boolean = true);
@ -440,6 +475,9 @@ implementation
result:=true;
end;
end;
A_SRLI,
A_SLLI:
result:=OptPass1OP(p);
A_SLTI:
begin
{

218
compiler/wasm32/hlcgcpu.pas
View File

@ -102,6 +102,8 @@ uses
procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
procedure g_rangecheck(list: TAsmList; const l:tlocation; fromdef,todef: tdef); override;
procedure g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef); override;
procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); override;
@ -1471,6 +1473,222 @@ implementation
list.concat(taicpu.op_none(a_end_function));
end;
procedure thlcgwasm.g_rangecheck(list: TAsmList; const l: tlocation; fromdef, todef: tdef);
var
{$if defined(cpuhighleveltarget)}
aintmax: tcgint;
{$elseif defined(cpu64bitalu) or defined(cpu32bitalu)}
aintmax: aint;
{$else}
aintmax: longint;
{$endif}
//neglabel : tasmlabel;
//hreg : tregister;
lto,hto,
lfrom,hfrom : TConstExprInt;
fromsize, tosize: cardinal;
maxdef: tdef;
from_signed, to_signed: boolean;
begin
{ range checking on and range checkable value? }
if not(cs_check_range in current_settings.localswitches) or
not(fromdef.typ in [orddef,enumdef]) or
{ C-style booleans can't really fail range checks, }
{ all values are always valid }
is_cbool(todef) then
exit;
{$if not defined(cpuhighleveltarget) and not defined(cpu64bitalu)}
{ handle 64bit rangechecks separate for 32bit processors }
if is_64bit(fromdef) or is_64bit(todef) then
begin
cg64.g_rangecheck64(list,l,fromdef,todef);
exit;
end;
{$endif ndef cpuhighleveltarget and ndef cpu64bitalu}
{ only check when assigning to scalar, subranges are different, }
{ when todef=fromdef then the check is always generated }
getrange(fromdef,lfrom,hfrom);
getrange(todef,lto,hto);
from_signed := is_signed(fromdef);
to_signed := is_signed(todef);
{ check the rangedef of the array, not the array itself }
{ (only change now, since getrange needs the arraydef) }
if (todef.typ = arraydef) then
todef := tarraydef(todef).rangedef;
{ no range check if from and to are equal and are both longint/dword }
{ (if we have a 32bit processor) or int64/qword, since such }
{ operations can at most cause overflows (JM) }
{ Note that these checks are mostly processor independent, they only }
{ have to be changed once we introduce 64bit subrange types }
{$if defined(cpuhighleveltarget) or defined(cpu64bitalu)}
if (fromdef=todef) and
(fromdef.typ=orddef) and
(((((torddef(fromdef).ordtype=s64bit) and
(lfrom = low(int64)) and
(hfrom = high(int64))) or
((torddef(fromdef).ordtype=u64bit) and
(lfrom = low(qword)) and
(hfrom = high(qword))) or
((torddef(fromdef).ordtype=scurrency) and
(lfrom = low(int64)) and
(hfrom = high(int64)))))) then
exit;
{$endif cpuhighleveltarget or cpu64bitalu}
{ 32 bit operations are automatically widened to 64 bit on 64 bit addr
targets }
{$ifdef cpu32bitaddr}
if (fromdef = todef) and
(fromdef.typ=orddef) and
(((((torddef(fromdef).ordtype = s32bit) and
(lfrom = int64(low(longint))) and
(hfrom = int64(high(longint)))) or
((torddef(fromdef).ordtype = u32bit) and
(lfrom = low(cardinal)) and
(hfrom = high(cardinal)))))) then
exit;
{$endif cpu32bitaddr}
{ optimize some range checks away in safe cases }
fromsize := fromdef.size;
tosize := todef.size;
if ((from_signed = to_signed) or
(not from_signed)) and
(lto<=lfrom) and (hto>=hfrom) and
(fromsize <= tosize) then
begin
{ if fromsize < tosize, and both have the same signed-ness or }
{ fromdef is unsigned, then all bit patterns from fromdef are }
{ valid for todef as well }
if (fromsize < tosize) then
exit;
if (fromsize = tosize) and
(from_signed = to_signed) then
{ only optimize away if all bit patterns which fit in fromsize }
{ are valid for the todef }
begin
{$ifopt Q+}
{$define overflowon}
{$Q-}
{$endif}
{$ifopt R+}
{$define rangeon}
{$R-}
{$endif}
if to_signed then
begin
{ calculation of the low/high ranges must not overflow 64 bit
otherwise we end up comparing with zero for 64 bit data types on
64 bit processors }
if (lto = (int64(-1) << (tosize * 8 - 1))) and
(hto = (-((int64(-1) << (tosize * 8 - 1))+1))) then
exit
end
else
begin
{ calculation of the low/high ranges must not overflow 64 bit
otherwise we end up having all zeros for 64 bit data types on
64 bit processors }
if (lto = 0) and
(qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then
exit
end;
{$ifdef overflowon}
{$Q+}
{$undef overflowon}
{$endif}
{$ifdef rangeon}
{$R+}
{$undef rangeon}
{$endif}
end
end;
{ depending on the types involved, we perform the range check for 64 or
for 32 bit }
if fromsize=8 then
maxdef:=fromdef
else
maxdef:=todef;
{$if sizeof(aintmax) = 8}
if maxdef.size=8 then
aintmax:=high(int64)
else
{$endif}
begin
aintmax:=high(longint);
maxdef:=u32inttype;
end;
{ generate the rangecheck code for the def where we are going to }
{ store the result }
{ use the trick that }
{ a <= x <= b <=> 0 <= x-a <= b-a <=> unsigned(x-a) <= unsigned(b-a) }
{ To be able to do that, we have to make sure however that either }
{ fromdef and todef are both signed or unsigned, or that we leave }
{ the parts < 0 and > maxlongint out }
if from_signed xor to_signed then
begin
if from_signed then
{ from is signed, to is unsigned }
begin
{ if high(from) < 0 -> always range error }
if (hfrom < 0) or
{ if low(to) > maxlongint also range error }
(lto > aintmax) then
begin
g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
exit
end;
{ from is signed and to is unsigned -> when looking at to }
{ as an signed value, it must be < maxaint (otherwise }
{ it will become negative, which is invalid since "to" is unsigned) }
if hto > aintmax then
hto := aintmax;
end
else
{ from is unsigned, to is signed }
begin
if (lfrom > aintmax) or
(hto < 0) then
begin
g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
exit
end;
{ from is unsigned and to is signed -> when looking at to }
{ as an unsigned value, it must be >= 0 (since negative }
{ values are the same as values > maxlongint) }
if lto < 0 then
lto := 0;
end;
end;
a_load_loc_stack(list,fromdef,l);
resize_stack_int_val(list,fromdef,maxdef,false);
a_load_const_stack(list,maxdef,tcgint(int64(lto)),R_INTREGISTER);
a_op_stack(list,OP_SUB,maxdef);
{
if from_signed then
a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel)
else
}
if qword(hto-lto)>qword(aintmax) then
a_load_const_stack(list,maxdef,aintmax,R_INTREGISTER)
else
a_load_const_stack(list,maxdef,tcgint(int64(hto-lto)),R_INTREGISTER);
a_cmp_stack_stack(list,maxdef,OC_A);
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_if));
thlcgwasm(hlcg).incblock;
thlcgwasm(hlcg).decstack(current_asmdata.CurrAsmList,1);
g_call_system_proc(list,'fpc_rangeerror',[],nil).resetiftemp;
current_asmdata.CurrAsmList.concat(taicpu.op_none(a_end_if));
thlcgwasm(hlcg).decblock;
end;
procedure thlcgwasm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
begin
{ not possible, need the original operands }

72
compiler/x86/aoptx86.pas
View File

@ -5867,7 +5867,7 @@ unit aoptx86;
var
hp1,hp2: tai;
{$ifndef i8086}
hp3,hp4,hpmov2: tai;
hp3,hp4,hpmov2, hp5: tai;
l : Longint;
condition : TAsmCond;
{$endif i8086}
@ -6084,6 +6084,76 @@ unit aoptx86;
end;
{$ifndef i8086}
end
{
convert
j<c> .L1
mov 1,reg
jmp .L2
.L1
mov 0,reg
.L2
into
mov 0,reg
set<not(c)> reg
take care of alignment and that the mov 0,reg is not converted into a xor as this
would destroy the flag contents
}
else if MatchInstruction(hp1,A_MOV,[]) and
MatchOpType(taicpu(hp1),top_const,top_reg) and
{$ifdef i386}
(
{ Under i386, ESI, EDI, EBP and ESP
don't have an 8-bit representation }
not (getsupreg(taicpu(hp1).oper[1]^.reg) in [RS_ESI, RS_EDI, RS_EBP, RS_ESP])
) and
{$endif i386}
(taicpu(hp1).oper[0]^.val=1) and
GetNextInstruction(hp1,hp2) and
MatchInstruction(hp2,A_JMP,[]) and (taicpu(hp2).oper[0]^.ref^.refaddr=addr_full) and
GetNextInstruction(hp2,hp3) and
{ skip align }
((hp3.typ<>ait_align) or GetNextInstruction(hp3,hp3)) and
(hp3.typ=ait_label) and
(tasmlabel(taicpu(p).oper[0]^.ref^.symbol)=tai_label(hp3).labsym) and
(tai_label(hp3).labsym.getrefs=1) and
GetNextInstruction(hp3,hp4) and
MatchInstruction(hp4,A_MOV,[]) and
MatchOpType(taicpu(hp4),top_const,top_reg) and
(taicpu(hp4).oper[0]^.val=0) and
MatchOperand(taicpu(hp1).oper[1]^,taicpu(hp4).oper[1]^) and
GetNextInstruction(hp4,hp5) and
(hp5.typ=ait_label) and
(tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol)=tai_label(hp5).labsym) and
(tai_label(hp5).labsym.getrefs=1) then
begin
AllocRegBetween(NR_FLAGS,p,hp4,UsedRegs);
DebugMsg(SPeepholeOptimization+'JccMovJmpMov2MovSetcc',p);
{ remove last label }
RemoveInstruction(hp5);
{ remove second albel }
RemoveInstruction(hp3);
{ if align is present remove it }
if GetNextInstruction(hp2,hp3) and (hp3.typ=ait_align) then
RemoveInstruction(hp3);
{ remove jmp }
RemoveInstruction(hp2);
if taicpu(hp1).opsize=S_B then
RemoveInstruction(hp1)
else
taicpu(hp1).loadconst(0,0);
taicpu(hp4).opcode:=A_SETcc;
taicpu(hp4).opsize:=S_B;
taicpu(hp4).condition:=inverse_cond(taicpu(p).condition);
taicpu(hp4).loadreg(0,newreg(R_INTREGISTER,getsupreg(taicpu(hp4).oper[1]^.reg),R_SUBL));
taicpu(hp4).opercnt:=1;
taicpu(hp4).ops:=1;
taicpu(hp4).freeop(1);
RemoveCurrentP(p);
Result:=true;
exit;
end
else if CPUX86_HAS_CMOV in cpu_capabilities[current_settings.cputype] then
begin
{ check for

3
packages/amunits/src/coreunits/exec.pas
View File

@ -1173,7 +1173,8 @@ CONST
PAVLKEYCOMP = ^AVLKEYCOMP;
AVLKEYCOMP = APTR;
var
ExecBase: PExecBase absolute _ExecBase;
PROCEDURE AbortIO(ioRequest : pIORequest location 'a1'); syscall _ExecBase 480;
PROCEDURE AddDevice(device : pDevice location 'a1'); syscall _ExecBase 432;

3
packages/arosunits/src/exec.pas
View File

@ -1213,6 +1213,9 @@ const
RAWFMTFUNC_SERIAL = 1; // Output to debug log (usually serial port)
RAWFMTFUNC_COUNT = 2; // Just count characters, PutChData is a pointer to the counter (ULONG *)
var
ExecBase: PExecBase absolute AOS_ExecBase;
// function headers
function Supervisor(UserFunction: TProcedure): ULONG; syscall AOS_ExecBase 5;
procedure Reschedule(Task: PTask); syscall AOS_ExecBase 8;

2
packages/fcl-json/src/jsonscanner.pp
View File

@ -147,7 +147,7 @@ constructor TJSONScanner.Create(Source: TStream; AOptions: TJSONOptions);
Header : array[0..3] of byte;
begin
OldPos := Source.Position;
FillChar(Header, SizeOf(Header), 0);
FillChar(Header{%H-}, SizeOf(Header), 0);
if Source.Read(Header, 3) = 3 then
if (Header[0]=$EF) and (Header[1]=$BB) and (Header[2]=$BF) then
exit;

4
packages/fcl-passrc/src/pasresolver.pp
View File

@ -5487,7 +5487,9 @@ begin
if (Proc.Visibility=visStrictPrivate)
or ((Proc.Visibility=visPrivate)
and (Proc.GetModule<>Data^.Proc.GetModule)) then
// a private private is hidden by definition -> no hint
// a private method is hidden by definition -> no hint
else if (Proc.Visibility=visPublished) then
// a published can hide (used for overloading rtti) -> no hint
else if (ProcScope.ImplProc<>nil) // not abstract, external
and (not ProcHasImplElements(ProcScope.ImplProc)) then
// hidden method has implementation, but no statements -> useless

108
packages/fcl-web/src/base/fphttpclient.pp
View File

@ -231,6 +231,17 @@ Type
Class Procedure SimpleDelete(const URL: string; Response : TStrings);
Class Procedure SimpleDelete(const URL: string; const LocalFileName: String);
Class function SimpleDelete(const URL: string) : RawByteString;
// Simple Patch
// Put URL, and Requestbody. Return response in Stream, File, TstringList or String;
Procedure Patch(const URL: string; const Response: TStream);
Procedure Patch(const URL: string; Response : TStrings);
Procedure Patch(const URL: string; const LocalFileName: String);
function Patch(const URL: string) : RawByteString;
// Simple class methods.
Class Procedure SimplePatch(const URL: string; const Response: TStream);
Class Procedure SimplePatch(const URL: string; Response : TStrings);
Class Procedure SimplePatch(const URL: string; const LocalFileName: String);
Class function SimplePatch(const URL: string) : RawByteString;
// Simple Options
// Options from URL, and Requestbody. Return response in Stream, File, TstringList or String;
Procedure Options(const URL: string; const Response: TStream);
@ -1846,6 +1857,103 @@ begin
end;
end;
procedure TFPCustomHTTPClient.Patch(const URL: string; const Response: TStream);
begin
HTTPMethod('PATCH',URL,Response,[]);
end;
procedure TFPCustomHTTPClient.Patch(const URL: string; Response: TStrings);
begin
Response.Text:=Patch(URL);
end;
procedure TFPCustomHTTPClient.Patch(const URL: string; const LocalFileName: String
);
Var
F : TFileStream;
begin
F:=TFileStream.Create(LocalFileName,fmCreate);
try
Patch(URL,F);
finally
F.Free;
end;
end;
function TFPCustomHTTPClient.Patch(const URL: string): RawByteString;
Var
SS : TRawByteStringStream;
begin
SS:=TRawByteStringStream.Create();
try
Patch(URL,SS);
Result:=SS.Datastring;
finally
SS.Free;
end;
end;
class procedure TFPCustomHTTPClient.SimplePatch(const URL: string;
const Response: TStream);
begin
With Self.Create(nil) do
try
KeepConnection := False;
Patch(URL,Response);
finally
Free;
end;
end;
class procedure TFPCustomHTTPClient.SimplePatch(const URL: string;
Response: TStrings);
begin
With Self.Create(nil) do
try
KeepConnection := False;
Patch(URL,Response);
finally
Free;
end;
end;
class procedure TFPCustomHTTPClient.SimplePatch(const URL: string;
const LocalFileName: String);
begin
With Self.Create(nil) do
try
KeepConnection := False;
Patch(URL,LocalFileName);
finally
Free;
end;
end;
class function TFPCustomHTTPClient.SimplePatch(const URL: string): RawByteString;
begin
With Self.Create(nil) do
try
KeepConnection := False;
Result:=Patch(URL);
finally
Free;
end;
end;
procedure TFPCustomHTTPClient.Options(const URL: string; const Response: TStream
);
begin

7
packages/morphunits/src/exec.pas
View File

@ -20,10 +20,6 @@ unit exec;
interface
var
ExecBase: Pointer;
{ Some types for classic Amiga and AROS compatibility }
type
STRPTR = PChar;
@ -1760,6 +1756,9 @@ const
TLSTAG_DESTRUCTOR = TLSTAG_DUMMY + $0; // Destructor function to call on task termination if the TLS value is non-nil. The function is called with as: procedure(value: APTR; userdata: APTR);
TLSTAG_USERDATA = TLSTAG_DUMMY + $1; // Userdata for the destructor function. Defaults to nil.
var
ExecBase: PExecBase absolute MOS_ExecBase;
function Supervisor(userFunction: Pointer location 'a5'): Cardinal;
SysCall MOS_ExecBase 030;

3
packages/os4units/src/exec.pas
View File

@ -1736,6 +1736,9 @@ const
//**********************************************************************
var
ExecBase: PExecBase absolute AOS_ExecBase;
function ExecObtain(): LongWord; syscall IExec 60;
function ExecRelease(): LongWord; syscall IExec 64;
procedure ExecExpunge(); syscall IExec 68;

1
packages/pastojs/src/fppas2js.pp
View File

@ -15586,6 +15586,7 @@ begin
else if El.IsExternal then
exit(ConvertExtClassType(El,AContext));
IsTObject:=false;
if El.CustomData is TPas2JSClassScope then
begin
Scope:=TPas2JSClassScope(El.CustomData);

54
packages/pastojs/tests/tcmodules.pas
View File

@ -816,6 +816,7 @@ type
Procedure TestRTTI_DynArray;
Procedure TestRTTI_ArrayNestedAnonymous;
Procedure TestRTTI_PublishedMethodOverloadFail;
Procedure TestRTTI_PublishedMethodHideNoHint;
Procedure TestRTTI_PublishedMethodExternalFail;
Procedure TestRTTI_PublishedClassPropertyFail;
Procedure TestRTTI_PublishedClassFieldFail;
@ -29497,6 +29498,59 @@ begin
ConvertProgram;
end;
procedure TTestModule.TestRTTI_PublishedMethodHideNoHint;
begin
WithTypeInfo:=true;
StartUnit(false);
Add([
'interface',
'type',
' TObject = class',
' end;',
' {$M+}',
' TBird = class',
' procedure Fly;',
' end;',
' {$M-}',
'type',
' TEagle = class(TBird)',
' procedure Fly;',
' end;',
'implementation',
'procedure TBird.Fly;',
'begin',
'end;',
'procedure TEagle.Fly;',
'begin',
'end;',
'']);
ConvertUnit;
CheckSource('TestRTTI_PublishedMethodHideNoHint',
LinesToStr([ // statements
'rtl.createClass(this, "TObject", null, function () {',
' this.$init = function () {',
' };',
' this.$final = function () {',
' };',
'});',
'rtl.createClass(this, "TBird", this.TObject, function () {',
' this.Fly = function () {',
' };',
' var $r = this.$rtti;',
' $r.addMethod("Fly", 0, null);',
'});',
'rtl.createClass(this, "TEagle", this.TBird, function () {',
' this.Fly = function () {',
' };',
' var $r = this.$rtti;',
' $r.addMethod("Fly", 0, null);',
'});',
'']),
LinesToStr([ // $mod.$main
]));
CheckResolverUnexpectedHints(true);
end;
procedure TTestModule.TestRTTI_PublishedMethodExternalFail;
begin
WithTypeInfo:=true;

15
rtl/inc/generic.inc
View File

@ -1401,14 +1401,13 @@ end;
function fpc_mul_word(f1,f2 : word;checkoverflow : boolean) : word;[public,alias: 'FPC_MUL_WORD']; compilerproc;
var
_f1,bitpos : word;
b : byte;
f1overflowed : boolean;
begin
fpc_mul_word:=0;
bitpos:=1;
f1overflowed:=false;
for b:=0 to 15 do
while f1<>0 do
begin
if (f2 and bitpos)<>0 then
begin
@ -1487,14 +1486,13 @@ end;
function fpc_mul_dword(f1,f2 : dword;checkoverflow : boolean) : dword;[public,alias: 'FPC_MUL_DWORD']; compilerproc;
var
_f1,bitpos : dword;
b : byte;
f1overflowed : boolean;
begin
fpc_mul_dword:=0;
bitpos:=1;
f1overflowed:=false;
for b:=0 to 31 do
while f1<>0 do
begin
if (f2 and bitpos)<>0 then
begin
@ -1598,14 +1596,13 @@ end;
function fpc_mul_byte_checkoverflow(f1,f2 : byte) : byte;[public,alias: 'FPC_MUL_BYTE_CHECKOVERFLOW']; compilerproc;
var
_f1, bitpos : byte;
b : byte;
f1overflowed : boolean;
begin
fpc_mul_byte_checkoverflow := 0;
bitpos := 1;
f1overflowed := false;
for b := 0 to 7 do
while f1<>0 do
begin
if (f2 and bitpos) <> 0 then
begin
@ -1708,14 +1705,13 @@ end;
function fpc_mul_word_checkoverflow(f1,f2 : word) : word;[public,alias: 'FPC_MUL_WORD_CHECKOVERFLOW']; compilerproc;
var
_f1,bitpos : word;
b : byte;
f1overflowed : boolean;
begin
fpc_mul_word_checkoverflow:=0;
bitpos:=1;
f1overflowed:=false;
for b:=0 to 15 do
while f1<>0 do
begin
if (f2 and bitpos)<>0 then
begin
@ -1819,14 +1815,13 @@ end;
function fpc_mul_dword_checkoverflow(f1,f2 : dword) : dword;[public,alias: 'FPC_MUL_DWORD_CHECKOVERFLOW']; compilerproc;
var
_f1,bitpos : dword;
b : byte;
f1overflowed : boolean;
begin
fpc_mul_dword_checkoverflow:=0;
bitpos:=1;
f1overflowed:=false;
for b:=0 to 31 do
while f1<>0 do
begin
if (f2 and bitpos)<>0 then
begin

8
rtl/macos/Makefile
View File

@ -3261,12 +3261,10 @@ strings$(PPUEXT) : $(INC)/strings.pp system$(PPUEXT)
uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
$(COMPILER) $(INC)/uuchar.pp
objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp system$(PPUEXT)
$(COPY) $(OBJPASDIR)/objpas.pp .
$(COMPILER) objpas $(REDIR)
$(DEL) objpas.pp
$(COMPILER) $(OBJPASDIR)/objpas.pp $(REDIR)
sysutils$(PPUEXT) : sysutils.pp objpas$(PPUEXT) system$(PPUEXT) sysconst$(PPUEXT) macostp$(PPUEXT) macutils$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) softfpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) softfpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/sysconst.pp
rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
@ -3285,7 +3283,7 @@ types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) math$(PPUEXT) $(SYSTEMUNI
macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
$(COMPILER) $(INC)/macpas.pp $(REDIR)
dos$(PPUEXT) : $(DOSDEPS) unixutil$(PPUEXT) system$(PPUEXT)
$(COMPILER) dos $(REDIR)
$(COMPILER) dos.pp $(REDIR)
iso7185$(PPUEXT) : $(INC)/iso7185.pp heaptrc$(PPUEXT)
$(COMPILER) $(INC)/iso7185.pp
extpas$(PPUEXT) : $(INC)/extpas.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

14
rtl/macos/Makefile.fpc
View File

@ -24,7 +24,7 @@ implicitunits=cp1250 cp1251 cp1252 cp1253 cp1254 cp1255 cp1256 cp1257 cp1258 \
rsts=sysconst
# math typinfo sysconst rtlconsts
[require]
nortl=y
@ -114,14 +114,12 @@ uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
$(COMPILER) $(INC)/uuchar.pp
objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp system$(PPUEXT)
$(COPY) $(OBJPASDIR)/objpas.pp .
$(COMPILER) objpas $(REDIR)
$(DEL) objpas.pp
$(COMPILER) $(OBJPASDIR)/objpas.pp $(REDIR)
sysutils$(PPUEXT) : sysutils.pp objpas$(PPUEXT) system$(PPUEXT) sysconst$(PPUEXT) macostp$(PPUEXT) macutils$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) softfpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) softfpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/sysconst.pp
rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
@ -160,13 +158,13 @@ macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
#
dos$(PPUEXT) : $(DOSDEPS) unixutil$(PPUEXT) system$(PPUEXT)
$(COMPILER) dos $(REDIR)
$(COMPILER) dos.pp $(REDIR)
#crt$(PPUEXT) : crt.pp $(INC)/textrec.inc system$(PPUEXT)
# $(COMPILER) crt $(REDIR)
# $(COMPILER) crt.pp $(REDIR)
#printer$(PPUEXT) : printer.pp system$(PPUEXT)
# $(COMPILER) printer $(REDIR)
# $(COMPILER) printer.pp $(REDIR)
#
# Other system-independent RTL Units

2
rtl/unix/timezone.inc
View File

@ -210,7 +210,7 @@ var
NewTZInfoEx: TTZInfoEx;
begin
LockTZInfo;
if GetLocalTimezone(fptime,false,NewTZInfo,NewTZInfoEx) then
if GetLocalTimezone(fptime,true,NewTZInfo,NewTZInfoEx) then
SetTZInfo(NewTZInfo,NewTZInfoEx);
UnlockTZInfo;
end;

2
utils/ihxutil/fpmake.pp
View File

@ -15,7 +15,7 @@ begin
With Installer do
begin
P:=AddPackage('utils-ihxutil');
P.ShortName:='ihxutil';
P.ShortName:='ihxu';
P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc];
if Defaults.CPU=jvm then
P.OSes := P.OSes - [java,android];