Browse Source

* synchronized with trunk

git-svn-id: branches/unicodekvm@49004 -
nickysn 4 years ago
parent
commit
a2df653db1

+ 2 - 0
compiler/aoptobj.pas

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

+ 10 - 7
compiler/pdecvar.pas

@@ -360,8 +360,8 @@ implementation
          { Generate temp procdefs to search for matching read/write
          { Generate temp procdefs to search for matching read/write
            procedures. the readprocdef will store all definitions }
            procedures. the readprocdef will store all definitions }
          paranr:=0;
          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;
          readprocdef.struct:=astruct;
          writeprocdef.struct:=astruct;
          writeprocdef.struct:=astruct;
@@ -857,11 +857,14 @@ implementation
                message1(parser_e_implements_uses_non_implemented_interface,def.typename);
                message1(parser_e_implements_uses_non_implemented_interface,def.typename);
            until not try_to_consume(_COMMA);
            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;
          result:=p;
       end;
       end;

+ 38 - 0
compiler/riscv/aoptcpurv.pas

@@ -47,6 +47,7 @@ type
     procedure DebugMsg(const s: string; p: tai);
     procedure DebugMsg(const s: string; p: tai);
 
 
     function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
     function PeepHoleOptPass1Cpu(var p: tai): boolean; override;
+    function OptPass1OP(var p: tai): boolean;
   end;
   end;
 
 
 implementation
 implementation
@@ -175,6 +176,40 @@ implementation
     end;
     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;
   function TRVCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean;
 
 
     procedure RemoveInstr(var orig: tai; moveback: boolean = true);
     procedure RemoveInstr(var orig: tai; moveback: boolean = true);
@@ -440,6 +475,9 @@ implementation
                       result:=true;
                       result:=true;
                     end;
                     end;
                 end;
                 end;
+              A_SRLI,
+              A_SLLI:
+                result:=OptPass1OP(p);
               A_SLTI:
               A_SLTI:
                 begin
                 begin
                   {
                   {

+ 218 - 0
compiler/wasm32/hlcgcpu.pas

@@ -102,6 +102,8 @@ uses
       procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
       procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
       procedure g_proc_exit(list : TAsmList;parasize: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(list: TAsmList; const Loc: tlocation; def: tdef); override;
       procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;var ovloc : tlocation); 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));
       list.concat(taicpu.op_none(a_end_function));
     end;
     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);
   procedure thlcgwasm.g_overflowcheck(list: TAsmList; const Loc: tlocation; def: tdef);
     begin
     begin
       { not possible, need the original operands }
       { not possible, need the original operands }

+ 71 - 1
compiler/x86/aoptx86.pas

@@ -5867,7 +5867,7 @@ unit aoptx86;
       var
       var
         hp1,hp2: tai;
         hp1,hp2: tai;
 {$ifndef i8086}
 {$ifndef i8086}
-        hp3,hp4,hpmov2: tai;
+        hp3,hp4,hpmov2, hp5: tai;
         l : Longint;
         l : Longint;
         condition : TAsmCond;
         condition : TAsmCond;
 {$endif i8086}
 {$endif i8086}
@@ -6084,6 +6084,76 @@ unit aoptx86;
                     end;
                     end;
 {$ifndef i8086}
 {$ifndef i8086}
                 end
                 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
               else if CPUX86_HAS_CMOV in cpu_capabilities[current_settings.cputype] then
                 begin
                 begin
                  { check for
                  { check for

+ 2 - 1
packages/amunits/src/coreunits/exec.pas

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

+ 3 - 0
packages/arosunits/src/exec.pas

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

+ 1 - 1
packages/fcl-json/src/jsonscanner.pp

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

+ 3 - 1
packages/fcl-passrc/src/pasresolver.pp

@@ -5487,7 +5487,9 @@ begin
             if (Proc.Visibility=visStrictPrivate)
             if (Proc.Visibility=visStrictPrivate)
                 or ((Proc.Visibility=visPrivate)
                 or ((Proc.Visibility=visPrivate)
                   and (Proc.GetModule<>Data^.Proc.GetModule)) then
                   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
             else if (ProcScope.ImplProc<>nil)  // not abstract, external
                 and (not ProcHasImplElements(ProcScope.ImplProc)) then
                 and (not ProcHasImplElements(ProcScope.ImplProc)) then
               // hidden method has implementation, but no statements -> useless
               // hidden method has implementation, but no statements -> useless

+ 108 - 0
packages/fcl-web/src/base/fphttpclient.pp

@@ -231,6 +231,17 @@ Type
     Class Procedure SimpleDelete(const URL: string; Response : TStrings);
     Class Procedure SimpleDelete(const URL: string; Response : TStrings);
     Class Procedure SimpleDelete(const URL: string; const LocalFileName: String);
     Class Procedure SimpleDelete(const URL: string; const LocalFileName: String);
     Class function SimpleDelete(const URL: string) : RawByteString;
     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
     // Simple Options
     // Options from URL, and Requestbody. Return response in Stream, File, TstringList or String;
     // Options from URL, and Requestbody. Return response in Stream, File, TstringList or String;
     Procedure Options(const URL: string; const Response: TStream);
     Procedure Options(const URL: string; const Response: TStream);
@@ -1846,6 +1857,103 @@ begin
     end;
     end;
 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
 procedure TFPCustomHTTPClient.Options(const URL: string; const Response: TStream
   );
   );
 begin
 begin

+ 3 - 4
packages/morphunits/src/exec.pas

@@ -20,10 +20,6 @@ unit exec;
 
 
 interface
 interface
 
 
-var
-  ExecBase: Pointer;
-
-
 { Some types for classic Amiga and AROS compatibility }
 { Some types for classic Amiga and AROS compatibility }
 type
 type
   STRPTR    = PChar;
   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_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.
   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;
 function Supervisor(userFunction: Pointer location 'a5'): Cardinal;
 SysCall MOS_ExecBase 030;
 SysCall MOS_ExecBase 030;
 
 

+ 3 - 0
packages/os4units/src/exec.pas

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

+ 1 - 0
packages/pastojs/src/fppas2js.pp

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

+ 54 - 0
packages/pastojs/tests/tcmodules.pas

@@ -816,6 +816,7 @@ type
     Procedure TestRTTI_DynArray;
     Procedure TestRTTI_DynArray;
     Procedure TestRTTI_ArrayNestedAnonymous;
     Procedure TestRTTI_ArrayNestedAnonymous;
     Procedure TestRTTI_PublishedMethodOverloadFail;
     Procedure TestRTTI_PublishedMethodOverloadFail;
+    Procedure TestRTTI_PublishedMethodHideNoHint;
     Procedure TestRTTI_PublishedMethodExternalFail;
     Procedure TestRTTI_PublishedMethodExternalFail;
     Procedure TestRTTI_PublishedClassPropertyFail;
     Procedure TestRTTI_PublishedClassPropertyFail;
     Procedure TestRTTI_PublishedClassFieldFail;
     Procedure TestRTTI_PublishedClassFieldFail;
@@ -29497,6 +29498,59 @@ begin
   ConvertProgram;
   ConvertProgram;
 end;
 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;
 procedure TTestModule.TestRTTI_PublishedMethodExternalFail;
 begin
 begin
   WithTypeInfo:=true;
   WithTypeInfo:=true;

+ 5 - 10
rtl/inc/generic.inc

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

+ 3 - 5
rtl/macos/Makefile

@@ -3261,12 +3261,10 @@ strings$(PPUEXT) : $(INC)/strings.pp system$(PPUEXT)
 uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
 uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
 	$(COMPILER) $(INC)/uuchar.pp
 	$(COMPILER) $(INC)/uuchar.pp
 objpas$(PPUEXT) : $(OBJPASDIR)/objpas.pp system$(PPUEXT)
 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)
 sysutils$(PPUEXT) : sysutils.pp objpas$(PPUEXT) system$(PPUEXT) sysconst$(PPUEXT) macostp$(PPUEXT) macutils$(PPUEXT)
 	$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
 	$(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
 	$(COMPILER) $(OBJPASDIR)/sysconst.pp
 rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) $(OBJPASDIR)/rtlconsts.pp
 	$(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)
 macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
 	$(COMPILER) $(INC)/macpas.pp $(REDIR)
 	$(COMPILER) $(INC)/macpas.pp $(REDIR)
 dos$(PPUEXT) : $(DOSDEPS) unixutil$(PPUEXT) system$(PPUEXT)
 dos$(PPUEXT) : $(DOSDEPS) unixutil$(PPUEXT) system$(PPUEXT)
-	$(COMPILER) dos $(REDIR)
+	$(COMPILER) dos.pp $(REDIR)
 iso7185$(PPUEXT) : $(INC)/iso7185.pp heaptrc$(PPUEXT)
 iso7185$(PPUEXT) : $(INC)/iso7185.pp heaptrc$(PPUEXT)
 	$(COMPILER) $(INC)/iso7185.pp
 	$(COMPILER) $(INC)/iso7185.pp
 extpas$(PPUEXT) : $(INC)/extpas.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 extpas$(PPUEXT) : $(INC)/extpas.pp dos$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

+ 6 - 8
rtl/macos/Makefile.fpc

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

+ 1 - 1
rtl/unix/timezone.inc

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

+ 1 - 1
utils/ihxutil/fpmake.pp

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