* synchronized with trunk

git-svn-id: branches/wasm@46665 -

.gitattributes

@@ -18464,6 +18464,7 @@ tests/webtbs/tw37423.pp svneol=native#text/plain
 tests/webtbs/tw37427.pp svneol=native#text/pascal
 tests/webtbs/tw37428.pp svneol=native#text/pascal
 tests/webtbs/tw37449.pp svneol=native#text/pascal
+tests/webtbs/tw37465.pp svneol=native#text/plain
 tests/webtbs/tw37468.pp svneol=native#text/pascal
 tests/webtbs/tw37477.pp svneol=native#text/pascal
 tests/webtbs/tw37493.pp svneol=native#text/pascal

compiler/aggas.pas

@@ -837,38 +837,6 @@ implementation
 
          case hp.typ of
 
-           ait_comment :
-             Begin
-               writer.AsmWrite(asminfo^.comment);
-               writer.AsmWritePChar(tai_comment(hp).str);
-               writer.AsmLn;
-             End;
-
-           ait_regalloc :
-             begin
-               if (cs_asm_regalloc in current_settings.globalswitches) then
-                 begin
-                   writer.AsmWrite(#9+asminfo^.comment+'Register ');
-                   repeat
-                     writer.AsmWrite(std_regname(Tai_regalloc(hp).reg));
-                     if (hp.next=nil) or
-                        (tai(hp.next).typ<>ait_regalloc) or
-                        (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
-                       break;
-                     hp:=tai(hp.next);
-                     writer.AsmWrite(',');
-                   until false;
-                   writer.AsmWrite(' ');
-                   writer.AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
-                 end;
-             end;
-
-           ait_tempalloc :
-             begin
-               if (cs_asm_tempalloc in current_settings.globalswitches) then
-                 WriteTempalloc(tai_tempalloc(hp));
-             end;
-
            ait_align :
              begin
                doalign(tai_align_abstract(hp).aligntype,tai_align_abstract(hp).use_op,tai_align_abstract(hp).fillop,tai_align_abstract(hp).maxbytes,last_align,lasthp);
@@ -1564,16 +1532,6 @@ implementation
 {$endif DISABLE_WIN64_SEH}
              end;
 
-           ait_varloc:
-             begin
-               if tai_varloc(hp).newlocationhi<>NR_NO then
-                 writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
-                   std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation)))
-               else
-                 writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
-                   std_regname(tai_varloc(hp).newlocation)));
-               writer.AsmLn;
-             end;
            ait_cfi:
              begin
                WriteCFI(tai_cfi_base(hp));
@@ -1591,7 +1549,8 @@ implementation
                writer.AsmLn;
              end;
            else
-             internalerror(2006012201);
+             if not WriteComments(hp) then
+               internalerror(2006012201);
          end;
          lasthp:=hp;
          hp:=tai(hp.next);

compiler/assemble.pas

@@ -153,6 +153,7 @@ interface
         procedure WriteSourceLine(hp: tailineinfo);
         procedure WriteTempalloc(hp: tai_tempalloc);
         procedure WriteRealConstAsBytes(hp: tai_realconst; const dbdir: string; do_line: boolean);
+        function WriteComments(var hp: tai): boolean;
         function single2str(d : single) : string; virtual;
         function double2str(d : double) : string; virtual;
         function extended2str(e : extended) : string; virtual;
@@ -264,7 +265,7 @@ Implementation
 {$endif FPC_SOFT_FPUX80}
 {$endif}
       cscript,fmodule,verbose,
-      cpuinfo,triplet,
+      cpubase,cpuinfo,triplet,
       aasmcpu;
 
     var
@@ -1195,6 +1196,58 @@ Implementation
       end;
 
 
+    function TExternalAssembler.WriteComments(var hp: tai): boolean;
+      begin
+        result:=true;
+        case hp.typ of
+          ait_comment :
+            Begin
+              writer.AsmWrite(asminfo^.comment);
+              writer.AsmWritePChar(tai_comment(hp).str);
+              writer.AsmLn;
+            End;
+
+          ait_regalloc :
+            begin
+              if (cs_asm_regalloc in current_settings.globalswitches) then
+                begin
+                  writer.AsmWrite(#9+asminfo^.comment+'Register ');
+                  repeat
+                    writer.AsmWrite(std_regname(Tai_regalloc(hp).reg));
+                    if (hp.next=nil) or
+                       (tai(hp.next).typ<>ait_regalloc) or
+                       (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
+                      break;
+                    hp:=tai(hp.next);
+                    writer.AsmWrite(',');
+                  until false;
+                  writer.AsmWrite(' ');
+                  writer.AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
+                end;
+            end;
+
+          ait_tempalloc :
+            begin
+              if (cs_asm_tempalloc in current_settings.globalswitches) then
+                WriteTempalloc(tai_tempalloc(hp));
+            end;
+
+          ait_varloc:
+            begin
+              { ait_varloc is present here only when register allocation is not done ( -sr option ) }
+              if tai_varloc(hp).newlocationhi<>NR_NO then
+                writer.AsmWriteLn(asminfo^.comment+'Var '+tai_varloc(hp).varsym.realname+' located in register '+
+                  std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation))
+              else
+                writer.AsmWriteLn(asminfo^.comment+'Var '+tai_varloc(hp).varsym.realname+' located in register '+
+                  std_regname(tai_varloc(hp).newlocation));
+            end;
+          else
+            result:=false;
+        end;
+      end;
+
+
     procedure TExternalAssembler.WriteTree(p:TAsmList);
       begin
       end;

compiler/fpcdefs.inc

@@ -338,7 +338,6 @@
   {$define cpufpemu}
   {$define cpuflags} { xtensa has a boolean extension }
   {$define cputargethasfixedstack}
-  {$define cpuneedsmulhelper}
   {$define cpuneedsdivhelper}
   {$define cpucapabilities}
   {$define cpurequiresproperalignment}

compiler/i8086/cgcpu.pas

@@ -45,8 +45,6 @@ unit cgcpu;
         procedure a_call_name_far(list : TAsmList;const s : string; weak: boolean);
         procedure a_call_name_static(list : TAsmList;const s : string);override;
         procedure a_call_name_static_far(list : TAsmList;const s : string);
-        procedure a_call_reg(list : TAsmList;reg : tregister);override;
-        procedure a_call_reg_far(list : TAsmList;reg : tregister);
 
         procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override;
         procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
@@ -200,38 +198,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcg8086.a_call_reg(list: TAsmList; reg: tregister);
-      begin
-        if current_settings.x86memorymodel in x86_far_code_models then
-          a_call_reg_far(list,reg)
-        else
-          a_call_reg_near(list,reg);
-      end;
-
-
-    procedure tcg8086.a_call_reg_far(list: TAsmList; reg: tregister);
-      var
-        href: treference;
-      begin
-        { unfortunately, x86 doesn't have a 'call far reg:reg' instruction, so }
-        { we have to use a temp }
-        tg.gettemp(list,4,2,tt_normal,href);
-        { HACK!!! at this point all registers are allocated, due to the fact that
-          in the pascal calling convention, all registers are caller saved. This
-          causes the register allocator to fail on the next move instruction, so we
-          temporarily deallocate 2 registers.
-          TODO: figure out a better way to do this. }
-        cg.ungetcpuregister(list,NR_BX);
-        cg.ungetcpuregister(list,NR_SI);
-        a_load_reg_ref(list,OS_32,OS_32,reg,href);
-        cg.getcpuregister(list,NR_BX);
-        cg.getcpuregister(list,NR_SI);
-        href.segment:=NR_NO;
-        list.concat(taicpu.op_ref(A_CALL,S_FAR,href));
-        tg.ungettemp(list,href);
-      end;
-
-
     procedure tcg8086.a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize;
       a: tcgint; reg: TRegister);
       type

compiler/i8086/hlcgcpu.pas

@@ -71,6 +71,7 @@ interface
 
       function a_call_name(list : TAsmList;pd : tprocdef;const s : TSymStr; const paras: array of pcgpara; forceresdef: tdef; weak: boolean): tcgpara;override;
       function a_call_name_static(list: TAsmList; pd: tprocdef; const s: TSymStr; const paras: array of pcgpara; forceresdef: tdef): tcgpara; override;
+      function a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara; override;
 
       procedure a_load_loc_ref(list : TAsmList;fromsize, tosize: tdef; const loc: tlocation; const ref : treference);override;
       procedure a_loadaddr_ref_reg(list : TAsmList;fromsize, tosize : tdef;const ref : treference;r : tregister);override;
@@ -248,14 +249,16 @@ implementation
          (size.typ=classrefdef) then
         size:=voidpointertype;
 
-      { procvars follow the default code pointer size for the current memory model }
       if size.typ=procvardef then
         if ((po_methodpointer in tprocvardef(size).procoptions) or
             is_nested_pd(tprocvardef(size))) and
            not(po_addressonly in tprocvardef(size).procoptions) then
           internalerror(2015120101)
         else
-          size:=voidcodepointertype;
+          if is_proc_far(tabstractprocdef(size)) then
+            size:=voidfarpointertype
+          else
+            size:=voidnearpointertype;
 
       if is_farpointer(size) or is_hugepointer(size) then
         Result:=cg.getintregister(list,OS_32)
@@ -332,6 +335,14 @@ implementation
     end;
 
 
+  function thlcgcpu.a_call_reg(list: TAsmList; pd: tabstractprocdef; reg: tregister; const paras: array of pcgpara): tcgpara;
+    begin
+      if is_proc_far(pd) then
+        Internalerror(2020082201);
+      Result:=inherited a_call_reg(list, pd, reg, paras);
+    end;
+
+
   procedure thlcgcpu.a_load_loc_ref(list: TAsmList; fromsize, tosize: tdef; const loc: tlocation; const ref: treference);
     var
       tmpref: treference;

compiler/i8086/n8086cal.pas

@@ -28,6 +28,7 @@ interface
 { $define AnsiStrRef}
 
     uses
+      node,
       parabase,
       nx86cal,cgutils;
 
@@ -38,6 +39,9 @@ interface
           procedure extra_interrupt_code;override;
           procedure extra_call_ref_code(var ref: treference);override;
           function do_call_ref(ref: treference): tcgpara;override;
+          function can_call_ref(var ref: treference): boolean; override;
+        public
+          function pass_1: tnode; override;
        end;
 
 
@@ -46,6 +50,7 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
+      htypechk,pass_1,
       cgbase,
       cpubase,paramgr,
       aasmtai,aasmdata,aasmcpu,
@@ -98,16 +103,41 @@ implementation
       end;
 
 
+    function ti8086callnode.do_call_ref(ref: treference): tcgpara;
+      begin
+        if is_proc_far(procdefinition) then
+          current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_FAR,ref))
+        else
+          current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,ref));
+        result:=hlcg.get_call_result_cgpara(procdefinition,typedef)
+      end;
+
+
     procedure ti8086callnode.extra_call_ref_code(var ref: treference);
       begin
-        if (ref.base<>NR_NO) and (ref.base<>NR_BP) then
+        { Preload ref base and index to BX and SI to help the register allocator }
+        if getsupreg(ref.base)>=first_int_imreg then
           begin
-            cg.getcpuregister(current_asmdata.CurrAsmList,NR_BX);
-            cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,ref.base,NR_BX);
-            ref.base:=NR_BX;
-            cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_BX);
+            if procdefinition.proccalloption=pocall_register then
+              begin
+                { BX can't be used as ref base in case of the register calling convention }
+                cg.getcpuregister(current_asmdata.CurrAsmList,NR_SI);
+                cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,ref.base,NR_SI);
+                if ref.index<>NR_NO then
+                  cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_16,ref.index,NR_SI);
+                ref.base:=NR_NO;
+                ref.index:=NR_SI;
+                cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_SI);
+              end
+            else
+              begin
+                cg.getcpuregister(current_asmdata.CurrAsmList,NR_BX);
+                cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,ref.base,NR_BX);
+                ref.base:=NR_BX;
+                cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_BX);
+              end;
           end;
-        if ref.index<>NR_NO then
+        if getsupreg(ref.index)>=first_int_imreg then
           begin
             cg.getcpuregister(current_asmdata.CurrAsmList,NR_SI);
             cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_16,OS_16,ref.index,NR_SI);
@@ -117,16 +147,33 @@ implementation
       end;
 
 
-    function ti8086callnode.do_call_ref(ref: treference): tcgpara;
+    function ti8086callnode.can_call_ref(var ref: treference): boolean;
       begin
-        if is_proc_far(procdefinition) then
-          current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_FAR,ref))
-        else
-          current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_CALL,S_NO,ref));
-        result:=hlcg.get_call_result_cgpara(procdefinition,typedef)
+        tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,ref);
+        result:=true;
       end;
 
 
+    function ti8086callnode.pass_1: tnode;
+      begin
+        { If a far procvar is called, it must be in a memory location.
+          There is no CALL reg1:reg2 instruction. }
+        if (right<>nil) then
+          if is_proc_far(procdefinition) then
+            begin
+              make_not_regable(right,[]);
+              firstpass(right);
+              if not (right.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+                begin
+                  { Use a temp if the procvar still not a reference }
+                  load_in_temp(right);
+                  make_not_regable(right,[]);
+                end;
+            end;
+
+        Result:=inherited pass_1;
+      end;
+
 begin
    ccallnode:=ti8086callnode;
 end.

compiler/jvm/agjasmin.pas

@@ -362,47 +362,6 @@ implementation
 
            case hp.typ of
 
-             ait_comment :
-               Begin
-                 writer.AsmWrite(asminfo^.comment);
-                 writer.AsmWritePChar(tai_comment(hp).str);
-                 writer.AsmLn;
-               End;
-
-             ait_regalloc :
-               begin
-                 if (cs_asm_regalloc in current_settings.globalswitches) then
-                   begin
-                     writer.AsmWrite(#9+asminfo^.comment+'Register ');
-                     repeat
-                       writer.AsmWrite(std_regname(Tai_regalloc(hp).reg));
-                       if (hp.next=nil) or
-                          (tai(hp.next).typ<>ait_regalloc) or
-                          (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
-                         break;
-                       hp:=tai(hp.next);
-                       writer.AsmWrite(',');
-                     until false;
-                     writer.AsmWrite(' ');
-                     writer.AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
-                   end;
-               end;
-
-             ait_tempalloc :
-               begin
-                 if (cs_asm_tempalloc in current_settings.globalswitches) then
-                   begin
-  {$ifdef EXTDEBUG}
-                     if assigned(tai_tempalloc(hp).problem) then
-                       writer.AsmWriteLn(asminfo^.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
-                         tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^)
-                     else
-  {$endif EXTDEBUG}
-                       writer.AsmWriteLn(asminfo^.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
-                         tostr(tai_tempalloc(hp).tempsize)+' '+tempallocstr[tai_tempalloc(hp).allocation]);
-                   end;
-               end;
-
              ait_align :
                begin
 
@@ -538,7 +497,8 @@ implementation
                  writer.AsmWriteLn(tai_jcatch(hp).handlerlab.name);
                end;
              else
-               internalerror(2010122707);
+               if not WriteComments(hp) then
+                 internalerror(2010122707);
            end;
            hp:=tai(hp.next);
          end;

compiler/llvm/agllvm.pas

@@ -1166,40 +1166,6 @@ implementation
         ch: ansichar;
       begin
         case hp.typ of
-          ait_comment :
-            begin
-              writer.AsmWrite(asminfo^.comment);
-              writer.AsmWritePChar(tai_comment(hp).str);
-              if fdecllevel<>0 then
-                internalerror(2015090601);
-              writer.AsmLn;
-            end;
-
-          ait_regalloc :
-            begin
-              if (cs_asm_regalloc in current_settings.globalswitches) then
-                begin
-                  writer.AsmWrite(#9+asminfo^.comment+'Register ');
-                  repeat
-                    writer.AsmWrite(std_regname(Tai_regalloc(hp).reg));
-                     if (hp.next=nil) or
-                       (tai(hp.next).typ<>ait_regalloc) or
-                       (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
-                      break;
-                    hp:=tai(hp.next);
-                    writer.AsmWrite(',');
-                  until false;
-                  writer.AsmWrite(' ');
-                  writer.AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
-                end;
-            end;
-
-          ait_tempalloc :
-            begin
-              if (cs_asm_tempalloc in current_settings.globalswitches) then
-                WriteTempalloc(tai_tempalloc(hp));
-            end;
-
           ait_align,
           ait_section :
             begin
@@ -1489,24 +1455,13 @@ implementation
             begin
               internalerror(2013010713);
             end;
-          ait_varloc:
+          ait_typedconst:
             begin
-              if tai_varloc(hp).newlocationhi<>NR_NO then
-                writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
-                  std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation)))
-              else
-                writer.AsmWrite(strpnew('Var '+tai_varloc(hp).varsym.realname+' located in register '+
-                  std_regname(tai_varloc(hp).newlocation)));
-              if fdecllevel<>0 then
-                internalerror(2015090603);
-              writer.AsmLn;
-            end;
-           ait_typedconst:
-             begin
-               WriteTypedConstData(tai_abstracttypedconst(hp),false);
-             end
+              WriteTypedConstData(tai_abstracttypedconst(hp),false);
+            end
           else
-            internalerror(2019012010);
+            if not WriteComments(hp) then
+              internalerror(2019012010);
         end;
       end;
 

compiler/ncal.pas

@@ -92,6 +92,7 @@ interface
           function get_expect_loc: tcgloc;
        protected
           function safe_call_self_node: tnode;
+          procedure load_in_temp(var p:tnode);
           procedure gen_vmt_entry_load; virtual;
           procedure gen_syscall_para(para: tcallparanode); virtual;
           procedure objc_convert_to_message_send;virtual;
@@ -2109,6 +2110,16 @@ implementation
       end;
 
     procedure tcallnode.maybe_load_in_temp(var p:tnode);
+      begin
+        { Load all complex loads into a temp to prevent
+          double calls to a function. We can't simply check for a hp.nodetype=calln }
+        if assigned(p) and
+           foreachnodestatic(p,@look_for_call,nil) then
+          load_in_temp(p);
+      end;
+
+
+    procedure tcallnode.load_in_temp(var p:tnode);
       var
         loadp,
         refp  : tnode;
@@ -2116,10 +2127,7 @@ implementation
         ptemp : ttempcreatenode;
         usederef : boolean;
       begin
-        { Load all complex loads into a temp to prevent
-          double calls to a function. We can't simply check for a hp.nodetype=calln }
-        if assigned(p) and
-           foreachnodestatic(p,@look_for_call,nil) then
+        if assigned(p) then
           begin
             { temp create }
             usederef:=(p.resultdef.typ in [arraydef,recorddef]) or
@@ -4734,6 +4742,11 @@ implementation
 
     function tcallnode.paraneedsinlinetemp(para: tcallparanode; const pushconstaddr, complexpara: boolean): boolean;
       begin
+        { if it's an assignable call-by-reference parameter, we cannot pass a
+          temp since then the modified valua will be lost }
+        if para.parasym.varspez in [vs_var,vs_out] then
+          exit(false);
+
         { We don't need temps for parameters that are already temps, except if
           the passed temp could be put in a regvar while the parameter inside
           the routine cannot be (e.g., because its address is taken in the

compiler/psub.pas

@@ -2329,7 +2329,7 @@ implementation
         if not assigned(rec_tguid) then
           Message1(cg_f_internal_type_not_found,'TGUID');
         if not assigned(rec_jmp_buf) then
-          Message1(cg_f_internal_type_not_found,'TJMPBUF');
+          Message1(cg_f_internal_type_not_found,'JMP_BUF');
 {$endif}
 
          { if the procdef is truly a generic (thus takes parameters itself) then

compiler/x86/agx86int.pas

@@ -541,26 +541,6 @@ implementation
          DoNotSplitLine:=false;
 
          case hp.typ of
-           ait_comment :
-             Begin
-               writer.AsmWrite(asminfo^.comment);
-               writer.AsmWritePChar(tai_comment(hp).str);
-               writer.AsmLn;
-             End;
-
-           ait_regalloc :
-             begin
-               if (cs_asm_regalloc in current_settings.globalswitches) then
-                 writer.AsmWriteLn(asminfo^.comment+'Register '+masm_regname(tai_regalloc(hp).reg)+
-                   regallocstr[tai_regalloc(hp).ratype]);
-             end;
-
-           ait_tempalloc :
-             begin
-               if (cs_asm_tempalloc in current_settings.globalswitches) then
-                 WriteTempalloc(tai_tempalloc(hp));
-             end;
-
            ait_section :
              begin
                if tai_section(hp).sectype<>sec_none then
@@ -1032,7 +1012,8 @@ implementation
            ait_seh_directive :
              { Ignore for now };
            else
-            internalerror(10000);
+             if not WriteComments(hp) then
+               internalerror(10000);
          end;
          hp:=tai(hp.next);
        end;

compiler/x86/agx86nsm.pas

@@ -751,26 +751,6 @@ interface
           end;
 
          case hp.typ of
-           ait_comment :
-             Begin
-               writer.AsmWrite(asminfo^.comment);
-               writer.AsmWritePChar(tai_comment(hp).str);
-               writer.AsmLn;
-             End;
-
-           ait_regalloc :
-             begin
-               if (cs_asm_regalloc in current_settings.globalswitches) then
-                 writer.AsmWriteLn(#9#9+asminfo^.comment+'Register '+nasm_regname(tai_regalloc(hp).reg)+' '+
-                   regallocstr[tai_regalloc(hp).ratype]);
-             end;
-
-           ait_tempalloc :
-             begin
-               if (cs_asm_tempalloc in current_settings.globalswitches) then
-                 WriteTempalloc(tai_tempalloc(hp));
-             end;
-
            ait_section :
              begin
                if tai_section(hp).sectype<>sec_none then
@@ -1318,17 +1298,9 @@ interface
              end;
            ait_seh_directive :
              { Ignore for now };
-           ait_varloc:
-             begin
-               if tai_varloc(hp).newlocationhi<>NR_NO then
-                 writer.AsmWriteLn(asminfo^.comment+'Var '+tai_varloc(hp).varsym.realname+' located in register '+
-                   std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation))
-               else
-                 writer.AsmWriteLn(asminfo^.comment+'Var '+tai_varloc(hp).varsym.realname+' located in register '+
-                   std_regname(tai_varloc(hp).newlocation));
-             end;
            else
-             internalerror(10000);
+             if not WriteComments(hp) then
+               internalerror(10000);
          end;
          hp:=tai(hp.next);
        end;

compiler/x86/cgx86.pas

@@ -3502,10 +3502,10 @@ unit cgx86;
                   fardataseg.refaddr:=addr_fardataseg;
                   if current_procinfo.procdef.proccalloption=pocall_register then
                     begin
-                      { Use BX register if using register convention
+                      { Use CX register if using register convention
                         as it is not a register used to store parameters }
-                      list.concat(Taicpu.Op_ref_reg(A_MOV,S_W,fardataseg,NR_BX));
-                      list.concat(Taicpu.Op_reg_reg(A_MOV,S_W,NR_BX,NR_DS));
+                      list.concat(Taicpu.Op_ref_reg(A_MOV,S_W,fardataseg,NR_CX));
+                      list.concat(Taicpu.Op_reg_reg(A_MOV,S_W,NR_CX,NR_DS));
                     end
                   else
                     begin

compiler/x86/nx86cal.pas

@@ -87,11 +87,9 @@ implementation
 
   function tx86callnode.can_call_ref(var ref: treference): boolean;
     const
-{$if defined(i8086)}
-      save_all_regs=[pocall_pascal];
-{$elseif defined(i386)}
+{$if defined(i386)}
       save_all_regs=[pocall_far16,pocall_oldfpccall];
-{$elseif defined(x86_64)}
+{$else}
       save_all_regs=[];
 {$endif}
     begin

compiler/xtensa/cgcpu.pas

@@ -527,6 +527,8 @@ implementation
           list.concat(taicpu.op_reg_reg_const(A_SRLI,dst,src,a))
         else if (op=OP_SHR) and (a>15) and (a<=31) then
           list.concat(taicpu.op_reg_reg_const_const(A_EXTUI,dst,src,a,32-a))
+        else if (op=OP_AND) and (63-BsrQWord(a)+PopCnt(QWord(a))=64) and (PopCnt(QWord(a))<=16) then
+          list.concat(taicpu.op_reg_reg_const_const(A_EXTUI,dst,src,0,PopCnt(QWord(a))))
         else
           begin
             tmpreg:=getintregister(list,size);
@@ -1178,10 +1180,9 @@ implementation
 
     procedure tcg64fxtensa.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
       var
-        signed: Boolean;
-        tmplo, carry, tmphi, hreg: TRegister;
         instr: taicpu;
         no_carry: TAsmLabel;
+        tmpreg: TRegister;
       begin
         case op of
           OP_NEG,
@@ -1198,95 +1199,32 @@ implementation
             end;
           OP_ADD:
             begin
-              signed:=(size in [OS_S64]);
-                                                       
-              tmplo := cg.GetIntRegister(list,OS_S32);
-              carry := cg.GetIntRegister(list,OS_S32);
-
-              list.concat(taicpu.op_reg_reg_reg(A_ADD, tmplo, regsrc2.reglo, regsrc1.reglo));
-              if signed then
-                begin
-                  list.concat(taicpu.op_reg_reg_reg(A_ADD, regdst.reghi, regsrc2.reghi, regsrc1.reghi));
-
-                  current_asmdata.getjumplabel(no_carry);
-                  instr:=taicpu.op_reg_reg_sym(A_B,tmplo, regsrc2.reglo, no_carry);
-                  instr.condition:=C_GEU;
-                  list.concat(instr);
-                  list.concat(taicpu.op_reg_reg_const(A_ADDI, regdst.reghi, regdst.reghi, 1));
-                  cg.a_label(list,no_carry);
-                end
-              else
-                begin
-                  cg.a_load_const_reg(list,OS_INT,1,carry);
-                  current_asmdata.getjumplabel(no_carry);
-                  cg.a_cmp_reg_reg_label(list,OS_INT,OC_B,tmplo, regsrc2.reglo,no_carry);
-                  cg.a_load_const_reg(list,OS_INT,0,carry);
-                  cg.a_label(list,no_carry);
-
-                  cg.a_load_reg_reg(list,OS_INT,OS_INT,tmplo,regdst.reglo);
-
-                  tmphi:=cg.GetIntRegister(list,OS_INT);
-                  hreg:=cg.GetIntRegister(list,OS_INT);
-                  cg.a_load_const_reg(list,OS_INT,$80000000,hreg);
-                  // first add carry to one of the addends
-                  list.concat(taicpu.op_reg_reg_reg(A_ADD, tmphi, regsrc2.reghi, carry));
-
-                  cg.a_load_const_reg(list,OS_INT,1,carry);
-                  current_asmdata.getjumplabel(no_carry);
-                  cg.a_cmp_reg_reg_label(list,OS_INT,OC_B,tmphi, regsrc2.reghi,no_carry);
-                  cg.a_load_const_reg(list,OS_INT,0,carry);
-                  cg.a_label(list,no_carry);
-
-                  list.concat(taicpu.op_reg_reg_reg(A_SUB, carry, hreg, carry));
-                  // then add another addend
-                  list.concat(taicpu.op_reg_reg_reg(A_ADD, regdst.reghi, tmphi, regsrc1.reghi));
-                end;
+              if (regsrc1.reglo=regdst.reglo) or (regsrc1.reghi=regdst.reghi) then
+                Internalerror(2020082205);
+              list.concat(taicpu.op_reg_reg_reg(A_ADD, regdst.reglo, regsrc2.reglo, regsrc1.reglo));
+              list.concat(taicpu.op_reg_reg_reg(A_ADD, regdst.reghi, regsrc2.reghi, regsrc1.reghi));
+              current_asmdata.getjumplabel(no_carry);
+              cg.a_cmp_reg_reg_label(list,OS_INT,OC_AE, regsrc1.reglo, regdst.reglo, no_carry);
+              list.concat(taicpu.op_reg_reg_const(A_ADDI, regdst.reghi, regdst.reghi, 1));
+              cg.a_label(list,no_carry);
             end;
           OP_SUB:
             begin
-              signed:=(size in [OS_S64]);
-
-              tmplo := cg.GetIntRegister(list,OS_S32);
-              carry := cg.GetIntRegister(list,OS_S32);
-
-              list.concat(taicpu.op_reg_reg_reg(A_SUB, tmplo, regsrc2.reglo, regsrc1.reglo));
-              if signed then
-                begin
-                  list.concat(taicpu.op_reg_reg_reg(A_SUB, regdst.reghi, regsrc2.reghi, regsrc1.reghi));
-
-                  current_asmdata.getjumplabel(no_carry);
-                  instr:=taicpu.op_reg_reg_sym(A_B, regsrc2.reglo, tmplo, no_carry);
-                  instr.condition:=C_GEU;
-                  list.concat(instr);
-                  list.concat(taicpu.op_reg_reg_const(A_ADDI, regdst.reghi, regdst.reghi, -1));
-                  cg.a_label(list,no_carry);
-                end
-              else
+              if (regsrc1.reglo=regdst.reglo) or (regsrc1.reghi=regdst.reghi) then
+                Internalerror(2020082206);
+              { we need the original src2 value for the comparison, do not overwrite it }
+              if regsrc2.reglo=regdst.reglo then
                 begin
-                  cg.a_load_const_reg(list,OS_INT,1,carry);
-                  current_asmdata.getjumplabel(no_carry);
-                  cg.a_cmp_reg_reg_label(list,OS_INT,OC_B, regsrc2.reglo, tmplo, no_carry);
-                  cg.a_load_const_reg(list,OS_INT,0,carry);
-                  cg.a_label(list,no_carry);
-
-                  cg.a_load_reg_reg(list,OS_INT,OS_INT,tmplo,regdst.reglo);
-
-                  tmphi:=cg.GetIntRegister(list,OS_INT);
-                  hreg:=cg.GetIntRegister(list,OS_INT);
-                  cg.a_load_const_reg(list,OS_INT,$80000000,hreg);
-                  // first add carry to one of the addends
-                  list.concat(taicpu.op_reg_reg_reg(A_SUB, regsrc2.reghi, tmplo, carry));
-
-                  cg.a_load_const_reg(list,OS_INT,1,carry);
-                  current_asmdata.getjumplabel(no_carry);
-                  cg.a_cmp_reg_reg_label(list,OS_INT,OC_B,tmphi, regsrc2.reghi,no_carry);
-                  cg.a_load_const_reg(list,OS_INT,0,carry);
-                  cg.a_label(list,no_carry);
-
-                  list.concat(taicpu.op_reg_reg_reg(A_SUB, carry, hreg, carry));
-                  // then add another addend
-                  list.concat(taicpu.op_reg_reg_reg(A_SUB, regdst.reghi, tmphi, regsrc1.reghi));
+                  tmpreg:=cg.GetIntRegister(list,OS_S32);
+                  cg.a_load_reg_reg(list,OS_INT,OS_INT,regsrc2.reglo,tmpreg);
+                  regsrc2.reglo:=tmpreg;
                 end;
+              list.concat(taicpu.op_reg_reg_reg(A_SUB, regdst.reglo, regsrc2.reglo, regsrc1.reglo));
+              list.concat(taicpu.op_reg_reg_reg(A_SUB, regdst.reghi, regsrc2.reghi, regsrc1.reghi));
+              current_asmdata.getjumplabel(no_carry);
+              cg.a_cmp_reg_reg_label(list,OS_INT,OC_AE, regsrc1.reglo, regsrc2.reglo, no_carry);
+              list.concat(taicpu.op_reg_reg_const(A_ADDI, regdst.reghi, regdst.reghi, -1));
+              cg.a_label(list,no_carry);
             end;
           else
             internalerror(2020030813);
@@ -1323,12 +1261,9 @@ implementation
 
     procedure tcg64fxtensa.a_op64_const_reg_reg(list : TAsmList; op : TOpCG; size : tcgsize; value : int64; regsrc,regdst : tregister64);
       var
-        tmpreg,tmplo,carry,tmphi,hreg: tregister;
         tmpreg64 : tregister64;
-        b : byte;
-        signed : Boolean;
         no_carry : TAsmLabel;
-        instr : taicpu;
+        tmpreg: tregister;
       begin
         case op of
           OP_NEG,
@@ -1348,49 +1283,20 @@ implementation
               { could do better here (hi(value) in 248..2047), for now we support only the simple cases }
               if (value>=-2048) and (value<=2047) then
                 begin
-                  signed:=(size in [OS_S64]);
-
-                  tmplo := cg.GetIntRegister(list,OS_S32);
-                  carry := cg.GetIntRegister(list,OS_S32);
-
-                  list.concat(taicpu.op_reg_reg_const(A_ADDI, tmplo, regsrc.reglo, value));
-                  if signed then
-                    begin
-                      list.concat(taicpu.op_reg_reg_const(A_ADDI, regdst.reghi, regsrc.reghi, 0));
-
-                      current_asmdata.getjumplabel(no_carry);
-                      instr:=taicpu.op_reg_reg_sym(A_B,tmplo, regsrc.reglo, no_carry);
-                      instr.condition:=C_GEU;
-                      list.concat(instr);
-                      list.concat(taicpu.op_reg_reg_const(A_ADDI, regdst.reghi, regdst.reghi, 1));
-                      cg.a_label(list,no_carry);
-                    end
-                  else
+                  { we need the original src value for the comparison, do not overwrite it }
+                  if regsrc.reglo=regdst.reglo then
                     begin
-                      cg.a_load_const_reg(list,OS_INT,1,carry);
-                      current_asmdata.getjumplabel(no_carry);
-                      cg.a_cmp_reg_reg_label(list,OS_INT,OC_B,tmplo, regsrc.reglo,no_carry);
-                      cg.a_load_const_reg(list,OS_INT,0,carry);
-                      cg.a_label(list,no_carry);
-
-                      cg.a_load_reg_reg(list,OS_INT,OS_INT,tmplo,regdst.reglo);
-
-                      tmphi:=cg.GetIntRegister(list,OS_INT);
-                      hreg:=cg.GetIntRegister(list,OS_INT);
-                      cg.a_load_const_reg(list,OS_INT,$80000000,hreg);
-                      // first add carry to one of the addends
-                      list.concat(taicpu.op_reg_reg_reg(A_ADD, tmphi, regsrc.reghi, carry));
-
-                      cg.a_load_const_reg(list,OS_INT,1,carry);
-                      current_asmdata.getjumplabel(no_carry);
-                      cg.a_cmp_reg_reg_label(list,OS_INT,OC_B,tmphi, regsrc.reghi,no_carry);
-                      cg.a_load_const_reg(list,OS_INT,0,carry);
-                      cg.a_label(list,no_carry);
-
-                      list.concat(taicpu.op_reg_reg_reg(A_SUB, carry, hreg, carry));
-                      // then add another addend
-                      list.concat(taicpu.op_reg_reg_const(A_ADDI, regdst.reghi, tmphi, 0));
-                    end
+                      tmpreg:=cg.GetIntRegister(list,OS_S32);
+                      cg.a_load_reg_reg(list,OS_INT,OS_INT,regsrc.reglo,tmpreg);
+                      regsrc.reglo:=tmpreg;
+                    end;
+
+                  list.concat(taicpu.op_reg_reg_const(A_ADDI, regdst.reglo, regsrc.reglo, value));
+                  list.concat(taicpu.op_reg_reg(A_MOV, regdst.reghi, regsrc.reghi));
+                  current_asmdata.getjumplabel(no_carry);
+                  cg.a_cmp_reg_reg_label(list,OS_INT,OC_AE, regsrc.reglo, regdst.reglo, no_carry);
+                  list.concat(taicpu.op_reg_reg_const(A_ADDI, regdst.reghi, regdst.reghi, 1));
+                  cg.a_label(list,no_carry);
                   end
                 else
                   begin
@@ -1400,6 +1306,42 @@ implementation
                     a_op64_reg_reg_reg(list,op,size,tmpreg64,regsrc,regdst);
                   end;
             end;
+          OP_SHL:
+            begin
+              if (value>0) and (value<=16) then
+                begin
+                  tmpreg:=cg.GetIntRegister(list,OS_32);
+                  list.concat(taicpu.op_reg_reg_const_const(A_EXTUI, tmpreg, regsrc.reglo, 32-value, value));
+                  list.concat(taicpu.op_reg_reg_const(A_SLLI, regdst.reglo, regsrc.reglo, value));
+                  list.concat(taicpu.op_reg_reg_const(A_SLLI, regdst.reghi, regsrc.reghi, value));
+                  list.concat(taicpu.op_reg_reg_reg(A_OR, regdst.reghi, tmpreg, regdst.reghi));
+                end
+              else if value=32 then
+                begin
+                  cg.a_load_reg_reg(list,OS_INT,OS_INT,regsrc.reglo,regdst.reghi);
+                  cg.a_load_const_reg(list,OS_INT,0,regdst.reglo);
+                end
+              else
+                Internalerror(2020082209);
+            end;
+          OP_SHR:
+            begin
+              if (value>0) and (value<=15) then
+                begin
+                  tmpreg:=cg.GetIntRegister(list,OS_32);
+                  list.concat(taicpu.op_reg_reg_const(A_SLLI, tmpreg, regsrc.reghi, 32-value));
+                  list.concat(taicpu.op_reg_reg_const(A_SRLI, regdst.reglo, regsrc.reglo, value));
+                  list.concat(taicpu.op_reg_reg_reg(A_OR, regdst.reglo, tmpreg, regdst.reglo));
+                  list.concat(taicpu.op_reg_reg_const(A_SRLI, regdst.reghi, regsrc.reghi, value));
+                end
+              else if value=32 then
+                begin
+                  cg.a_load_reg_reg(list,OS_INT,OS_INT,regsrc.reghi,regdst.reglo);
+                  cg.a_load_const_reg(list,OS_INT,0,regdst.reghi);
+                end
+              else
+                Internalerror(2020082210);
+            end;
           OP_SUB:
             begin
               { for now, we take the simple approach }

compiler/xtensa/cpuinfo.pas

@@ -137,7 +137,9 @@ Const
       (
         CPUXTENSA_REGWINDOW,
         CPUXTENSA_HAS_SEXT,
-        CPUXTENSA_HAS_BOOLEAN_OPTION
+        CPUXTENSA_HAS_BOOLEAN_OPTION,
+        CPUXTENSA_HAS_MUL32HIGH,
+        CPUXTENSA_HAS_DIV
       );
 
    tfpuflags =
@@ -151,7 +153,7 @@ Const
      (
        { cpu_none     } [],
        { cpu_lx106    } [],
-       { cpu_lx6      } [CPUXTENSA_REGWINDOW, CPUXTENSA_HAS_SEXT, CPUXTENSA_HAS_BOOLEAN_OPTION]
+       { cpu_lx6      } [CPUXTENSA_REGWINDOW, CPUXTENSA_HAS_SEXT, CPUXTENSA_HAS_BOOLEAN_OPTION, CPUXTENSA_HAS_MUL32HIGH, CPUXTENSA_HAS_DIV]
      );
 
    fpu_capabilities : array[tfputype] of set of tfpuflags =

compiler/xtensa/cpupara.pas

@@ -250,7 +250,7 @@ unit cpupara;
             if side=callerside then
               case target_info.abi of
                 abi_xtensa_call0:
-              paraloc^.register:=NR_A3;
+                  paraloc^.register:=NR_A3;
                 abi_xtensa_windowed:
                   { only call8 used/supported so far }
                   paraloc^.register:=newreg(R_INTREGISTER,RS_A11,cgsize2subreg(R_INTREGISTER,retcgsize));

compiler/xtensa/ncpuadd.pas

@@ -26,18 +26,24 @@ unit ncpuadd;
 interface
 
     uses
-       node,ncgadd,cpubase;
+       cgbase,node,ncgadd,cpubase;
 
     type
        TCPUAddNode = class(tcgaddnode)
        private
          procedure pass_left_and_right;
+         procedure cmp64_le(left_reg, right_reg: TRegister64; unsigned: boolean);
+         procedure cmp64_lt(left_reg, right_reg: TRegister64; unsigned: boolean);
        protected
          function pass_1 : tnode;override;
          function first_addfloat: tnode;override;
+         function use_generic_mul32to64: boolean;override;
+         function use_generic_mul64bit: boolean;override;
+         procedure second_addordinal;override;
          procedure second_cmpordinal;override;
          procedure second_cmpsmallset;override;
          procedure second_cmp64bit;override;
+         procedure second_add64bit;override;
          procedure second_cmpfloat;override;
          procedure second_addfloat;override;
          procedure second_cmp;
@@ -50,7 +56,7 @@ interface
       cutils,verbose,globals,
       symconst,symdef,paramgr,
       aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk,
-      cgbase,cgutils,cgcpu,
+      cgutils,cgcpu,
       cpuinfo,pass_1,pass_2,procinfo,
       cpupara,
       ncon,nset,nadd,
@@ -61,6 +67,40 @@ interface
                                TCPUAddNode
 *****************************************************************************}
 
+    procedure TCPUAddNode.second_addordinal;
+      var
+        ophigh: tasmop;
+      begin
+        { this is only true, if the CPU supports 32x32 -> 64 bit MUL, see the relevant method }
+        if (nodetype=muln) and is_64bit(resultdef) then
+          begin
+            if not(is_signed(left.resultdef)) or
+               not(is_signed(right.resultdef)) then
+              ophigh:=A_MULUH
+            else
+              ophigh:=A_MULSH;
+
+            pass_left_right;
+
+            if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) then
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+            if not(right.location.loc in [LOC_CREGISTER,LOC_REGISTER]) then
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
+
+            { initialize the result }
+            location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+
+            location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+            location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULL,location.register64.reglo,left.location.register,right.location.register));
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(ophigh,location.register64.reghi,left.location.register,right.location.register));
+          end
+        else
+          Inherited;
+      end;
+
+
    procedure TCPUAddNode.second_cmpsmallset;
       var
         tmpreg : tregister;
@@ -143,9 +183,91 @@ interface
       end;
 
 
+    const
+      cmpops: array[boolean] of TOpCmp = (OC_LT,OC_B);
+
+    procedure TCPUAddNode.cmp64_lt(left_reg, right_reg: TRegister64;unsigned: boolean);
+      begin
+        cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,cmpops[unsigned],right_reg.reghi,left_reg.reghi,location.truelabel);
+        cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,left_reg.reghi,right_reg.reghi,location.falselabel);
+        cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_B,right_reg.reglo,left_reg.reglo,location.truelabel);
+        cg.a_jmp_always(current_asmdata.CurrAsmList,location.falselabel);
+      end;
+
+
+    procedure TCPUAddNode.cmp64_le(left_reg, right_reg: TRegister64;unsigned: boolean);
+      begin
+        cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,cmpops[unsigned],left_reg.reghi,right_reg.reghi,location.falselabel);
+        cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,left_reg.reghi,right_reg.reghi,location.truelabel);
+        cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_B,left_reg.reglo,right_reg.reglo,location.falselabel);
+        cg.a_jmp_always(current_asmdata.CurrAsmList,location.truelabel);
+      end;
+
+
     procedure TCPUAddNode.second_cmp64bit;
+      var
+        truelabel,
+        falselabel: tasmlabel;
+        unsigned: boolean;
+        left_reg,right_reg: TRegister64;
       begin
-        second_cmp;
+        current_asmdata.getjumplabel(truelabel);
+        current_asmdata.getjumplabel(falselabel);
+        location_reset_jump(location,truelabel,falselabel);
+
+        pass_left_right;
+        force_reg_left_right(true,true);
+
+        unsigned:=not(is_signed(left.resultdef)) or
+                  not(is_signed(right.resultdef));
+
+        left_reg:=left.location.register64;
+        { force_reg_left_right might leave right as LOC_CONSTANT, however, we cannot take advantage of this yet }
+        if right.location.loc=LOC_CONSTANT then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,false);
+        right_reg:=right.location.register64;
+
+        case NodeType of
+          equaln:
+            begin
+              cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,left_reg.reghi,right_reg.reghi,location.falselabel);
+              cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,left_reg.reglo,right_reg.reglo,location.falselabel);
+              cg.a_jmp_always(current_asmdata.CurrAsmList,location.truelabel);
+            end;
+          unequaln:
+            begin
+              cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,left_reg.reghi,right_reg.reghi,location.truelabel);
+              cg.a_cmp_reg_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,left_reg.reglo,right_reg.reglo,location.truelabel);
+              cg.a_jmp_always(current_asmdata.CurrAsmList,location.falselabel);
+            end;
+        else
+          if nf_swapped in flags then
+            case NodeType of
+              ltn:
+                cmp64_lt(right_reg, left_reg,unsigned);
+              lten:
+                cmp64_le(right_reg, left_reg,unsigned);
+              gtn:
+                cmp64_lt(left_reg, right_reg,unsigned);
+              gten:
+                cmp64_le(left_reg, right_reg,unsigned);
+              else
+                internalerror(2020082202);
+            end
+          else
+            case NodeType of
+              ltn:
+                cmp64_lt(left_reg, right_reg,unsigned);
+              lten:
+                cmp64_le(left_reg, right_reg,unsigned);
+              gtn:
+                cmp64_lt(right_reg, left_reg,unsigned);
+              gten:
+                cmp64_le(right_reg, left_reg,unsigned);
+              else
+                internalerror(2020082203);
+            end;
+        end;
       end;
 
 
@@ -217,6 +339,20 @@ interface
       end;
 
 
+    function TCPUAddNode.use_generic_mul32to64: boolean;
+      begin
+        result:=not(CPUXTENSA_HAS_MUL32HIGH in cpu_capabilities[current_settings.cputype]) or needoverflowcheck;
+      end;
+
+
+    function TCPUAddNode.use_generic_mul64bit: boolean;
+      begin
+        result:=needoverflowcheck or
+          (cs_opt_size in current_settings.optimizerswitches) or
+          not(CPUXTENSA_HAS_MUL32HIGH in cpu_capabilities[current_settings.cputype]);
+      end;
+
+
     procedure TCPUAddNode.second_addfloat;
       var
         op    : TAsmOp;
@@ -317,6 +453,41 @@ interface
         second_addfloat;
       end;
 
+
+    procedure TCPUAddNode.second_add64bit;
+      var
+        unsigned: Boolean;
+        tmpreg: tregister;
+      begin
+        if nodetype=muln then
+          begin
+            pass_left_right;
+            unsigned:=((left.resultdef.typ=orddef) and
+                       (torddef(left.resultdef).ordtype=u64bit)) or
+                      ((right.resultdef.typ=orddef) and
+                       (torddef(right.resultdef).ordtype=u64bit));
+            force_reg_left_right(true,true);
+
+            { force_reg_left_right might leave right as LOC_CONSTANT, however, we cannot take advantage of this yet }
+            if right.location.loc=LOC_CONSTANT then
+              hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,false);
+
+            location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
+            location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+            location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+            tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULL,location.register64.reglo,left.location.register64.reglo,right.location.register64.reglo));
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULUH,location.register64.reghi,left.location.register64.reglo,right.location.register64.reglo));
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULL,tmpreg,left.location.register64.reglo,right.location.register64.reghi));
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD,location.register64.reghi,location.register64.reghi,tmpreg));
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULL,tmpreg,left.location.register64.reghi,right.location.register64.reglo));
+            current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD,location.register64.reghi,location.register64.reghi,tmpreg));
+          end
+        else
+          Inherited;
+      end;
+
+
 begin
   caddnode:=tcpuaddnode;
 end.

compiler/xtensa/ncpumat.pas

@@ -26,11 +26,13 @@ unit ncpumat;
 interface
 
     uses
-      node,nmat,ncgmat;
+      cgbase,node,nmat,ncgmat;
 
     type
-      tcpumoddivnode = class(tmoddivnode)
-        procedure pass_generate_code;override;
+      tcpumoddivnode = class(tcgmoddivnode)
+        function first_moddivint: tnode; override;
+        procedure emit_div_reg_reg(signed: boolean; denum, num: tregister); override;
+        procedure emit_mod_reg_reg(signed: boolean; denum, num: tregister); override;
       end;
 
       tcpunotnode = class(tcgnotnode)
@@ -44,6 +46,7 @@ interface
 
       tcpushlshrnode = class(tcgshlshrnode)
         procedure second_64bit;override;
+        function pass_1: tnode;override;
       end;
 
 implementation
@@ -54,7 +57,7 @@ implementation
       aasmbase,aasmcpu,aasmtai,aasmdata,
       defutil,
       symtype,symconst,symtable,
-      cgbase,cgobj,hlcgobj,cgutils,
+      cgobj,hlcgobj,cgutils,
       pass_2,procinfo,
       ncon,ncnv,ncal,ninl,
       cpubase,cpuinfo,
@@ -65,11 +68,42 @@ implementation
                              TCPUMODDIVNODE
 *****************************************************************************}
 
-    procedure tcpumoddivnode.pass_generate_code;
+    procedure tcpumoddivnode.emit_div_reg_reg(signed: boolean; denum, num: tregister);
+      var
+        op: TAsmOp;
+      begin
+        if signed then
+          op:=A_QUOS
+        else
+          op:=A_QUOU;
+
+        current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(op,num,num,denum));
+      end;
+
+
+    procedure tcpumoddivnode.emit_mod_reg_reg(signed: boolean; denum, num: tregister);
+      var
+        op: TAsmOp;
+      begin
+        if signed then
+          op:=A_REMS
+        else
+          op:=A_REMU;
+
+        current_asmdata.CurrAsmList.Concat(taicpu.op_reg_reg_reg(op,num,num,denum));
+      end;
+
+
+    function tcpumoddivnode.first_moddivint: tnode;
       begin
-        location.loc:=LOC_REGISTER;
+        if (not is_64bitint(resultdef)) and
+           (CPUXTENSA_HAS_DIV in cpu_capabilities[current_settings.cputype]) then
+          Result:=nil
+        else
+          result:=inherited;
       end;
 
+
 {*****************************************************************************
                                TCPUNOTNODE
 *****************************************************************************}
@@ -92,7 +126,7 @@ implementation
       end;
 
 {*****************************************************************************
-                               TARMUNARYMINUSNODE
+                               TXTENSAUNARYMINUSNODE
 *****************************************************************************}
 
     function tcpuunaryminusnode.pass_1: tnode;
@@ -159,146 +193,86 @@ implementation
       end;
 
 
-    procedure tcpushlshrnode.second_64bit;
-      var
-        v : TConstExprInt;
-        lreg, resreg: TRegister64;
+    function tcpushlshrnode.pass_1 : tnode;
+      begin
+        { the xtensa code generator can handle 64 bit shifts by constants directly }
+        if is_constintnode(right) and is_64bit(resultdef) and
+          (((nodetype=shln) and (tordconstnode(right).value>=0) and (tordconstnode(right).value<=16)) or
+           ((nodetype=shrn) and (tordconstnode(right).value>0) and (tordconstnode(right).value<16)) or
+           (tordconstnode(right).value=32)) then
+          begin
+            result:=nil;
+            firstpass(left);
+            firstpass(right);
+            if codegenerror then
+              exit;
 
-      procedure emit_instr(p: tai);
-        begin
-          current_asmdata.CurrAsmList.concat(p);
-        end;
+            expectloc:=LOC_REGISTER;
+          end
+        else
+          Result:=inherited pass_1;
+      end;
 
-      {This code is build like it gets called with sm=SM_LSR all the time, for SM_LSL dst* and src* have to be reversed
-       This will generate
-         mov   shiftval1, shiftval
-         cmp   shiftval1, #64
-         movcs shiftval1, #64
-         rsb   shiftval2, shiftval1, #32
-         mov   dstlo, srclo, lsr shiftval1
-         mov   dsthi, srchi, lsr shiftval1
-         orr   dstlo, srchi, lsl shiftval2
-         subs  shiftval2, shiftval1, #32
-         movpl dstlo, srchi, lsr shiftval2
-      }
-      procedure shift_by_variable(srchi, srclo, dsthi, dstlo, shiftval: TRegister);
-        var
-          shiftval1,shiftval2:TRegister;
-        begin
-          //shifterop_reset(so);
-          //shiftval1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-          //shiftval2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-          //
-          //cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, shiftval, shiftval1);
-          //
-          //{The ARM barrel shifter only considers the lower 8 bits of a register for the shift}
-          //cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-          //emit_instr(taicpu.op_reg_const(A_CMP, shiftval1, 64));
-          //emit_instr(setcondition(taicpu.op_reg_const(A_MOV, shiftval1, 64), C_CS));
-          //cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-          //
-          //{Calculate how much the upper register needs to be shifted left}
-          //emit_instr(taicpu.op_reg_reg_const(A_RSB, shiftval2, shiftval1, 32));
-          //
-          //so.shiftmode:=sm;
-          //so.rs:=shiftval1;
-          //
-          //{Shift and zerofill the hi+lo register}
-          //emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, dstlo, srclo, so));
-          //emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, dsthi, srchi, so));
-          //
-          //{Fold in the lower 32-shiftval bits}
-          //if sm = SM_LSR then so.shiftmode:=SM_LSL else so.shiftmode:=SM_LSR;
-          //so.rs:=shiftval2;
-          //emit_instr(taicpu.op_reg_reg_reg_shifterop(A_ORR, dstlo, dstlo, srchi, so));
-          //
-          //cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-          //emit_instr(setoppostfix(taicpu.op_reg_reg_const(A_SUB, shiftval2, shiftval1, 32), PF_S));
-          //
-          //so.shiftmode:=sm;
-          //emit_instr(setcondition(taicpu.op_reg_reg_shifterop(A_MOV, dstlo, srchi, so), C_PL));
-          //cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-        end;
 
-      begin         
-        inherited;
-        //if GenerateThumbCode or GenerateThumb2Code then
-        //begin
-        //  inherited;
-        //  exit;
-        //end;
-        //
-        //location_reset(location,LOC_REGISTER,def_cgsize(resultdef));
-        //location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-        //location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
-        //
-        //{ load left operator in a register }
-        //if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) or
-        //   (left.location.size<>OS_64) then
-        //  hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,true);
-        //
-        //lreg := left.location.register64;
-        //resreg := location.register64;
-        //shifterop_reset(so);
-        //
-        //{ shifting by a constant directly coded: }
-        //if (right.nodetype=ordconstn) then
-        //  begin
-        //    v:=Tordconstnode(right).value and 63;
-        //    {Single bit shift}
-        //    if v = 1 then
-        //      if nodetype=shln then
-        //        begin
-        //          {Shift left by one by 2 simple 32bit additions}
-        //          cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-        //          emit_instr(setoppostfix(taicpu.op_reg_reg_reg(A_ADD, resreg.reglo, lreg.reglo, lreg.reglo), PF_S));
-        //          emit_instr(taicpu.op_reg_reg_reg(A_ADC, resreg.reghi, lreg.reghi, lreg.reghi));
-        //          cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-        //        end
-        //      else
-        //        begin
-        //          {Shift right by first shifting hi by one and then using RRX (rotate right extended), which rotates through the carry}
-        //          shifterop_reset(so); so.shiftmode:=SM_LSR; so.shiftimm:=1;
-        //          cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-        //          emit_instr(setoppostfix(taicpu.op_reg_reg_shifterop(A_MOV, resreg.reghi, lreg.reghi, so), PF_S));
-        //          so.shiftmode:=SM_RRX; so.shiftimm:=0; {RRX does NOT have a shift amount}
-        //          emit_instr(taicpu.op_reg_reg_shifterop(A_MOV, resreg.reglo, lreg.reglo, so));
-        //          cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS);
-        //        end
-        //    {Clear one register and use the cg to generate a normal 32-bit shift}
-        //    else if v >= 32 then
-        //      if nodetype=shln then
-        //      begin
-        //        emit_instr(taicpu.op_reg_const(A_MOV, resreg.reglo, 0));
-        //        cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,v.uvalue-32,lreg.reglo,resreg.reghi);
-        //      end
-        //      else
-        //      begin
-        //        emit_instr(taicpu.op_reg_const(A_MOV, resreg.reghi, 0));
-        //        cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,v.uvalue-32,lreg.reghi,resreg.reglo);
-        //      end
-        //    {Shift LESS than 32, thats the tricky one}
-        //    else if (v < 32) and (v > 1) then
-        //      if nodetype=shln then
-        //        shift_less_than_32(lreg.reglo, lreg.reghi, resreg.reglo, resreg.reghi, v.uvalue, SM_LSL)
-        //      else
-        //        shift_less_than_32(lreg.reghi, lreg.reglo, resreg.reghi, resreg.reglo, v.uvalue, SM_LSR);
-        //  end
-        //else
-        //  begin
-        //    { force right operator into a register }
-        //    if not(right.location.loc in [LOC_CREGISTER,LOC_REGISTER]) or
-        //       (right.location.size<>OS_32) then
-        //      hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,u32inttype,true);
-        //
-        //    if nodetype = shln then
-        //      shift_by_variable(lreg.reglo, lreg.reghi, resreg.reglo, resreg.reghi, right.location.register, SM_LSL)
-        //    else
-        //      shift_by_variable(lreg.reghi, lreg.reglo, resreg.reghi, resreg.reglo, right.location.register, SM_LSR);
-        //  end;
+    procedure tcpushlshrnode.second_64bit;
+      var
+        op: topcg;
+        opsize: TCgSize;
+        opdef: tdef;
+        shiftval: longint;
+        hcountreg: TRegister;
+      begin
+        { determine operator }
+        case nodetype of
+          shln: op:=OP_SHL;
+          shrn: op:=OP_SHR;
+          else
+            internalerror(2020082208);
+        end;
+        opsize:=left.location.size;
+        opdef:=left.resultdef;
+
+        if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) or
+          { location_force_reg can be also used to change the size of a register }
+          (left.location.size<>opsize) then
+          hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,opdef,true);
+        location_reset(location,LOC_REGISTER,opsize);
+        location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+        location.registerhi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32);
+
+        { shifting by a constant directly coded: }
+        if right.nodetype=ordconstn then
+          begin
+             { shl/shr must "wrap around", so use ... and 31 }
+             { In TP, "byte/word shl 16 = 0", so no "and 15" in case of
+               a 16 bit ALU }
+             if tcgsize2size[opsize]<=4 then
+               shiftval:=tordconstnode(right).value.uvalue and 31
+             else
+               shiftval:=tordconstnode(right).value.uvalue and 63;
+             cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,op,location.size,
+               shiftval,left.location.register64,location.register64)
+          end
+        else
+          begin
+            internalerror(2020082209);
+            { load right operators in a register - this
+               is done since most target cpu which will use this
+               node do not support a shift count in a mem. location (cec)
+             }
+             hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,sinttype,true);
+             hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,opdef,right.location.register,left.location.register,location.register);
+          end;
+        { shl/shr nodes return the same type as left, which can be different
+          from opdef }
+        if opdef<>resultdef then
+          begin
+            hcountreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef);
+            hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,opdef,resultdef,location.register,hcountreg);
+            location.register:=hcountreg;
+          end;
       end;
 
-
 begin
   cmoddivnode:=tcpumoddivnode;
   cnotnode:=tcpunotnode;

compiler/z80/agsdasz80.pas

@@ -587,23 +587,6 @@ unit agsdasz80;
                 end;*)
             end;
           case hp.typ of
-            ait_comment :
-              begin
-                writer.AsmWrite(asminfo^.comment);
-                writer.AsmWritePChar(tai_comment(hp).str);
-                writer.AsmLn;
-              end;
-            ait_regalloc :
-              begin
-                if (cs_asm_regalloc in current_settings.globalswitches) then
-                  writer.AsmWriteLn(#9#9+asminfo^.comment+'Register '+std_regname(tai_regalloc(hp).reg)+' '+
-                    regallocstr[tai_regalloc(hp).ratype]);
-              end;
-            ait_tempalloc :
-              begin
-                if (cs_asm_tempalloc in current_settings.globalswitches) then
-                  WriteTempalloc(tai_tempalloc(hp));
-              end;
             ait_section :
               begin
                 if tai_section(hp).sectype<>sec_none then
@@ -862,12 +845,13 @@ unit agsdasz80;
             ait_force_line,
             ait_function_name : ;
             else
-              begin
-                writer.AsmWrite(asminfo^.comment);
-                writer.AsmWrite('WARNING: not yet implemented in assembler output: ');
-                Str(hp.typ,s);
-                writer.AsmWriteLn(s);
-              end;
+              if not WriteComments(hp) then
+                begin
+                  writer.AsmWrite(asminfo^.comment);
+                  writer.AsmWrite('WARNING: not yet implemented in assembler output: ');
+                  Str(hp.typ,s);
+                  writer.AsmWriteLn(s);
+                end;
           end;
           lasthp:=hp;
           hp:=tai(hp.next);

compiler/z80/agz80vasm.pas

@@ -621,23 +621,6 @@ unit agz80vasm;
                 end;*)
             end;
           case hp.typ of
-            ait_comment :
-              begin
-                writer.AsmWrite(asminfo^.comment);
-                writer.AsmWritePChar(tai_comment(hp).str);
-                writer.AsmLn;
-              end;
-            ait_regalloc :
-              begin
-                if (cs_asm_regalloc in current_settings.globalswitches) then
-                  writer.AsmWriteLn(#9#9+asminfo^.comment+'Register '+std_regname(tai_regalloc(hp).reg)+' '+
-                    regallocstr[tai_regalloc(hp).ratype]);
-              end;
-            ait_tempalloc :
-              begin
-                if (cs_asm_tempalloc in current_settings.globalswitches) then
-                  WriteTempalloc(tai_tempalloc(hp));
-              end;
             ait_section :
               begin
                 if tai_section(hp).sectype<>sec_none then
@@ -893,12 +876,13 @@ unit agz80vasm;
             ait_force_line,
             ait_function_name : ;
             else
-              begin
-                writer.AsmWrite(asminfo^.comment);
-                writer.AsmWrite('WARNING: not yet implemented in assembler output: ');
-                Str(hp.typ,s);
-                writer.AsmWriteLn(s);
-              end;
+              if not WriteComments(hp) then
+                begin
+                  writer.AsmWrite(asminfo^.comment);
+                  writer.AsmWrite('WARNING: not yet implemented in assembler output: ');
+                  Str(hp.typ,s);
+                  writer.AsmWriteLn(s);
+                end;
           end;
           lasthp:=hp;
           hp:=tai(hp.next);

packages/fcl-net/src/sslsockets.pp

@@ -27,7 +27,7 @@ Const
 Type
   ESSLSocketError = Class(ESocketError);
   TSSLSocketHandler = class;
-  TVerifyCertificateEvent = Procedure(Sender : TObject; Allow : Boolean) of object;
+  TVerifyCertificateEvent = Procedure(Sender : TObject; var Allow : Boolean) of object;
   TSSLSocketHandlerClass = class of TSSLSocketHandler;
 
   { TSSLSocketHandler }
@@ -50,7 +50,7 @@ Type
     Class Var FDefaultHandlerClass : TSSLSocketHandlerClass;
   protected
     Procedure SetSSLActive(aValue : Boolean);
-    function DoVerifyCert: boolean;
+    function DoVerifyCert: boolean; virtual;  // if event define's change not accceptable, suggest to set virtual
   public
     constructor Create; override;
     Destructor Destroy; override;

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -20,6 +20,7 @@ type
     procedure TestGen_GenericNotFoundFail;
     procedure TestGen_SameNameSameParamCountFail;
     procedure TestGen_TypeAliasWithoutSpecializeFail;
+    procedure TestGen_TemplNameEqTypeNameFail; // type T<T>
 
     // constraints
     procedure TestGen_ConstraintStringFail;
@@ -29,14 +30,14 @@ type
     procedure TestGen_ConstraintRecordClassFail;
     procedure TestGen_ConstraintArrayFail;
     procedure TestGen_ConstraintConstructor;
+    procedure TestGen_ConstraintUnit;
     // ToDo: constraint T:Unit2.TBird
     // ToDo: constraint T:Unit2.TGen<word>
     procedure TestGen_ConstraintSpecialize;
     procedure TestGen_ConstraintTSpecializeWithT;
-    procedure TestGen_ConstraintTSpecializeAsTFail;
-    procedure TestGen_ConstraintTcolonTFail; // A<T:T>
-    // ToDo: A<T:B<T>> fail
-    procedure TestGen_TemplNameEqTypeNameFail;
+    procedure TestGen_ConstraintTSpecializeAsTFail; // TBird<T; U: T<word>>  and no T<>
+    procedure TestGen_ConstraintTSpecializeWithTFail; // TBird<T: TAnt<T>>
+    procedure TestGen_ConstraintSameNameFail; // TAnt<T:T>
     procedure TestGen_ConstraintInheritedMissingRecordFail;
     procedure TestGen_ConstraintInheritedMissingClassTypeFail;
     procedure TestGen_ConstraintMultiParam;
@@ -259,6 +260,20 @@ begin
     nXExpectedButYFound);
 end;
 
+procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<TBird> = record v: T; end;',
+  'var r: specialize TBird<word>;',
+  'begin',
+  '']);
+  CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,16)',
+    nDuplicateIdentifier);
+end;
+
 procedure TTestResolveGenerics.TestGen_ConstraintStringFail;
 begin
   StartProgram(false);
@@ -365,6 +380,36 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintUnit;
+begin
+  AddModuleWithIntfImplSrc('unit1.pas',
+    LinesToStr([
+    'type',
+    '  TBird = class b1: word; end;',
+    '  generic TAnt<T> = class a1: T; end;',
+    '']),
+    LinesToStr([
+    '']));
+  StartProgram(true,[supTObject]);
+  Add([
+  'uses unit1;',
+  'type',
+  '  generic TCat<T: unit1.TBird> = class v: T; end;',
+  '  generic TFish<T: specialize TAnt<word>> = class v: T; end;',
+  '  TEagle = class(unit1.TBird);',
+  '  TRedAnt = specialize TAnt<word>;',
+  'var',
+  '  eagle: TEagle;',
+  '  redant: TRedAnt;',
+  '  cat: specialize TCat<TEagle>;',
+  '  fish: specialize TFish<TRedAnt>;',
+  'begin',
+  '  cat.v:=eagle;',
+  '  fish.v:=redant;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_ConstraintSpecialize;
 begin
   StartProgram(false);
@@ -422,39 +467,41 @@ begin
   Add([
   '{$mode objfpc}',
   'type',
-  '  generic TAnt<S> = record v: S; end;',
+  '  TObject = class end;',
+  // Note: would work if  generic T<S>  exists
   '  generic TBird<T; U: specialize T<word>> = record v: T; end;',
   'begin',
   '']);
   CheckResolverException('identifier not found "T<>"',nIdentifierNotFound);
 end;
 
-procedure TTestResolveGenerics.TestGen_ConstraintTcolonTFail;
+procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeWithTFail;
 begin
   StartProgram(false);
   Add([
   '{$mode objfpc}',
   'type',
   '  TObject = class end;',
-  '  T = TObject;',
-  '  generic TAnt<T:T> = record v: word; end;',
+  '  generic TAnt<S> = class v: S; end;',
+  '  generic TBird<T: specialize TAnt<T>> = class v: T; end;',
+  '  TEagle = specialize TBird<specialize TAnt<word>>;',
   'begin',
   '']);
-  CheckResolverException(sTypeCycleFound,nTypeCycleFound);
+  CheckResolverException('identifier not found "T"',nIdentifierNotFound);
 end;
 
-procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
+procedure TTestResolveGenerics.TestGen_ConstraintSameNameFail;
 begin
   StartProgram(false);
   Add([
   '{$mode objfpc}',
   'type',
-  '  generic TBird<TBird> = record v: T; end;',
-  'var r: specialize TBird<word>;',
+  '  TObject = class end;',
+  '  T = TObject;',
+  '  generic TAnt<T:T> = record v: word; end;',
   'begin',
   '']);
-  CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,16)',
-    nDuplicateIdentifier);
+  CheckResolverException(sTypeCycleFound,nTypeCycleFound);
 end;
 
 procedure TTestResolveGenerics.TestGen_ConstraintInheritedMissingRecordFail;

packages/openssl/src/fpopenssl.pp

@@ -102,7 +102,7 @@ Type
     function PeerSubject : String;
     Function PeerIssuer : String;
     Function PeerSerialNo : Integer;
-    Function PeerFingerprint : String;
+    Function PeerFingerprint(const name: string = 'MD5') : String;
     Function CertInfo : String;
     function CipherName: string;
     function CipherBits: integer;
@@ -737,7 +737,7 @@ begin
   end;
 end;
 
-Function TSSL.PeerFingerprint: String;
+Function TSSL.PeerFingerprint(const name: string): String;
 var
   C : PX509;
   L : integer;
@@ -750,7 +750,7 @@ begin
   try
     Result:=StringOfChar(#0,EVP_MAX_MD_SIZE);
     L:=0;
-    X509Digest(C,EvpGetDigestByName('MD5'),Result,L);
+    X509Digest(C,EvpGetDigestByName(name),Result,L);
     SetLength(Result,L);
   finally
     X509Free(C);

packages/openssl/src/opensslsockets.pp

@@ -39,6 +39,7 @@ Type
     // Result of last CheckSSL call.
     Function SSLLastError: integer;
     property SSLLastErrorString: string read FSSLLastErrorString write SetSSLLastErrorString;
+    property SSL: TSSL read FSSL; // allow more lower level info and control
   end;
 
 implementation
@@ -78,8 +79,10 @@ begin
      if SendHostAsSNI  and (Socket is TInetSocket) then
        FSSL.Ctrl(SSL_CTRL_SET_TLSEXT_HOSTNAME,TLSEXT_NAMETYPE_host_name,PAnsiChar(AnsiString((Socket as TInetSocket).Host)));
      Result:=CheckSSL(FSSL.Connect);
-     if Result and VerifyPeerCert then
-       Result:=(FSSL.VerifyResult<>0) or (not DoVerifyCert);
+     //if Result and VerifyPeerCert then
+     //  Result:=(FSSL.VerifyResult<>0) or (not DoVerifyCert);
+     if Result then
+       Result:= DoVerifyCert;
      if Result then
        SetSSLActive(True);
      end;

rtl/amicommon/tthread.inc

@@ -113,12 +113,6 @@ begin
   if ResumeThread(FHandle) = 1 then FSuspended := False;
 end;
 
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-  TerminatedSet;
-end;
-
 function TThread.WaitFor: Integer;
 begin
   if MainThreadID=GetCurrentThreadID then

rtl/atari/tthread.inc

@@ -71,13 +71,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-
-begin
-  TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 
 begin

rtl/beos/tthread.inc

@@ -271,12 +271,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-  TerminatedSet;
-end;
-
 function TThread.WaitFor: Integer;
 var
   status : longint;
@@ -558,12 +552,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-  TerminatedSet;
-end;
-
 function TThread.WaitFor: Integer;
 begin
   WRITE_DEBUG('waiting for thread ',FHandle);

rtl/embedded/tthread.inc

@@ -97,13 +97,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
- FTerminated := true;
- TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 begin
   result := -1;

rtl/freertos/tthread.inc

@@ -97,13 +97,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := true;
-  TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 begin
   result := -1;

rtl/gba/tthread.inc

@@ -97,13 +97,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := true;
-  TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 begin
   result := -1;

rtl/go32v2/tthread.inc

@@ -71,13 +71,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-
-begin
-  TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 
 begin

rtl/macos/tthread.inc

@@ -71,13 +71,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-
-begin
-  TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 
 begin

rtl/msdos/tthread.inc

@@ -71,13 +71,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-
-begin
-  TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 
 begin

rtl/nativent/tthread.inc

@@ -45,12 +45,6 @@ procedure TThread.Resume;
 begin
 end;
 
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-  TerminatedSet;
-end;
-
 function TThread.WaitFor: Integer;
 begin
   Result := -1;

rtl/nds/tthread.inc

@@ -97,13 +97,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := true;
-  TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 begin
   result := -1;

rtl/netware/tthread.inc

@@ -216,14 +216,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-  TerminatedSet;
-  ThreadSwitch;
-end;
-
-
 function TThread.WaitFor: Integer;
 begin
   Result := WaitForThreadTerminate (FHandle,0);

rtl/netwlibc/tthread.inc

@@ -361,12 +361,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-  TerminatedSet;
-end;
-
 function TThread.WaitFor: Integer;
 begin
   WRITE_DEBUG('waiting for thread ',FHandle);

rtl/objpas/classes/classes.inc

@@ -274,6 +274,12 @@ begin
   GetSuspended:=FSuspended;
 end;
 
+procedure TThread.Terminate;
+begin
+  FTerminated := True;
+  TerminatedSet;
+end;
+
 Procedure TThread.TerminatedSet;
 
 begin

rtl/os2/tthread.inc

@@ -210,13 +210,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := true;
-  TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 var
  FH: cardinal;

rtl/symbian/tthread.inc

@@ -97,13 +97,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := true;
-  TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 begin
   result := -1;

rtl/unix/tthread.inc

@@ -250,12 +250,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-  TerminatedSet;
-end;
-
 function TThread.WaitFor: Integer;
 begin
   WRITE_DEBUG('waiting for thread ',ptruint(FHandle));

rtl/wii/tthread.inc

@@ -97,13 +97,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-begin
- FTerminated := true;
- TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 begin
   result := -1;

rtl/win/tthread.inc

@@ -92,12 +92,6 @@ begin
   if ResumeThread(FHandle) = 1 then FSuspended := False;
 end;
 
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-  TerminatedSet;
-end;
-
 function TThread.WaitFor: Integer;
 var
   Msg: TMsg;

rtl/win16/tthread.inc

@@ -71,13 +71,6 @@ begin
 end;
 
 
-procedure TThread.Terminate;
-
-begin
-TerminatedSet;
-end;
-
-
 function TThread.WaitFor: Integer;
 
 begin

tests/test/tint641.pp

@@ -37,28 +37,36 @@ begin
    q3:=1;
    q4:=1;
    if not((q4 div q3) div (q2 div q1)<>(q2 div q1) div (q4 div q3)) then
-     writeln('Error :(');
+     begin
+       writeln('Error :(');
+       halt(1);
+     end;
    q:=q-q;
    q:=q-(q*q);
    q:=(q*q)-(q*q);
    { first test the comparisation }
+   i:=f2;
    if q<>q then
      begin
-        writeln('Error :(');
+       writeln('Error :(');
+       halt(2);
      end;
 
    if q>q then
      begin
-        writeln('Error :(');
+       writeln('Error :(');
+       halt(3);
      end;
 
    if i>f2 then
      begin
-        writeln('Error :(');
+       writeln('Error :(');
+       halt(4);
      end;
    if l1>l2 then
      begin
-        writeln('Error :(');
+       writeln('Error :(');
+       halt(5);
      end;
    p1(q,i);
    q:=f1;

tests/webtbs/tw37465.pp

@@ -0,0 +1,18 @@
+program example;
+
+{$mode objfpc}{$H+}
+
+procedure foo(out c: char); inline;
+begin
+  c := #32;
+end;
+
+var s: String;
+
+begin
+  s:=#42;
+  foo(s[1]);
+  Writeln(ord(s[1]));
+  if ord(s[1])<>32 then
+    halt(1);
+end.