* moved g_test_self() from cgobj to hlcgobj

git-svn-id: trunk@21861 -

compiler/cgobj.pas

@@ -368,7 +368,6 @@ unit cgobj;
           }
          procedure g_exception_reason_load(list : TAsmList; const href : treference);virtual;
 
-          procedure g_maybe_testself(list : TAsmList;reg:tregister);
           procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
              to destination.
@@ -2070,27 +2069,6 @@ implementation
 {$endif cpuflags}
 
 
-    procedure tcg.g_maybe_testself(list : TAsmList;reg:tregister);
-      var
-        OKLabel : tasmlabel;
-        cgpara1 : TCGPara;
-      begin
-        if (cs_check_object in current_settings.localswitches) or
-           (cs_check_range in current_settings.localswitches) then
-         begin
-           current_asmdata.getjumplabel(oklabel);
-           a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel);
-           cgpara1.init;
-           paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara1);
-           a_load_const_cgpara(list,OS_S32,tcgint(210),cgpara1);
-           paramanager.freecgpara(list,cgpara1);
-           a_call_name(list,'FPC_HANDLEERROR',false);
-           a_label(list,oklabel);
-           cgpara1.done;
-         end;
-      end;
-
-
     procedure tcg.g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
       var
         hrefvmt : treference;

compiler/hlcg2ll.pas

@@ -256,7 +256,6 @@ unit hlcg2ll;
           procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref:TReference); override;
 {$endif cpuflags}
 
-//          procedure g_maybe_testself(list : TAsmList;reg:tregister);
 //          procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
              to destination.

compiler/hlcgobj.pas

@@ -366,7 +366,7 @@ unit hlcgobj;
           procedure g_flags2ref(list: TAsmList; size: tdef; const f: tresflags; const ref:TReference); virtual; abstract;
 {$endif cpuflags}
 
-//          procedure g_maybe_testself(list : TAsmList;reg:tregister);
+          procedure g_maybe_testself(list : TAsmList; selftype: tdef; reg:tregister);
 //          procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
              to destination.
@@ -2756,6 +2756,26 @@ implementation
       end;
     end;
 
+  procedure thlcgobj.g_maybe_testself(list: TAsmList; selftype: tdef; reg: tregister);
+    var
+      OKLabel : tasmlabel;
+      cgpara1 : TCGPara;
+    begin
+      if (cs_check_object in current_settings.localswitches) or
+         (cs_check_range in current_settings.localswitches) then
+       begin
+         current_asmdata.getjumplabel(oklabel);
+         a_cmp_const_reg_label(list,selftype,OC_NE,0,reg,oklabel);
+         cgpara1.init;
+         paramanager.getintparaloc(pocall_default,1,s32inttype,cgpara1);
+         a_load_const_cgpara(list,s32inttype,aint(210),cgpara1);
+         paramanager.freecgpara(list,cgpara1);
+         g_call_system_proc(list,'fpc_handleerror');
+         cgpara1.done;
+         a_label(list,oklabel);
+       end;
+    end;
+
   procedure thlcgobj.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
     begin
 {

compiler/ncginl.pas

@@ -304,7 +304,7 @@ implementation
                    begin
                      { deref class }
                      cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,hregister);
-                     cg.g_maybe_testself(current_asmdata.CurrAsmList,hregister);
+                     hlcg.g_maybe_testself(current_asmdata.CurrAsmList,left.resultdef,hregister);
                      { load VMT pointer }
                      reference_reset_base(hrefvmt,hregister,tobjectdef(left.resultdef).vmt_offset,sizeof(pint));
                      cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hrefvmt,hregister);

compiler/ncgutil.pas

@@ -1895,6 +1895,7 @@ implementation
     procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister);
       var
         href : treference;
+        selfdef: tdef;
       begin
         if is_object(objdef) then
           begin
@@ -1904,6 +1905,7 @@ implementation
                 begin
                   reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset,sizeof(pint));
                   cg.a_loadaddr_ref_reg(list,selfloc.reference,href.base);
+                  selfdef:=getpointerdef(objdef);
                 end;
               else
                 internalerror(200305056);
@@ -1914,6 +1916,7 @@ implementation
             and the first "field" of an Objective-C class instance is a pointer
             to its "meta-class".  }
           begin
+            selfdef:=objdef;
             case selfloc.loc of
               LOC_REGISTER:
                 begin
@@ -1941,7 +1944,7 @@ implementation
             end;
           end;
         vmtreg:=cg.getaddressregister(list);
-        cg.g_maybe_testself(list,href.base);
+        hlcg.g_maybe_testself(list,selfdef,href.base);
         cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,vmtreg);
 
         { test validity of VMT }

rtl/inc/compproc.inc

@@ -626,8 +626,8 @@ procedure fpc_InitializeUnits; compilerproc;
 Procedure fpc_do_exit; compilerproc;
 Procedure fpc_lib_exit; compilerproc;
 Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : pointer); compilerproc;
-Procedure fpc_HandleError (Errno : longint); compilerproc;
 }
+Procedure fpc_HandleError (Errno : longint); compilerproc;
 
 procedure fpc_AbstractErrorIntern;compilerproc;
 procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer); compilerproc;

rtl/inc/system.inc

@@ -76,7 +76,7 @@ Const
   {$endif FPC_OBJFPC_EXTENDED_IF}
 {$endif FPC_HAS_FEATURE_EXITCODE}
 
-Procedure HandleError (Errno : Longint); forward;
+Procedure HandleError (Errno : Longint); external name 'FPC_HANDLEERROR';
 Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward;
 Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : Pointer); forward;
 
@@ -1046,7 +1046,7 @@ begin
 end;
 
 
-Procedure HandleError (Errno : longint);[public,alias : 'FPC_HANDLEERROR'];
+procedure fpc_handleerror (Errno : longint); compilerproc; [public,alias : 'FPC_HANDLEERROR'];
 {
   Procedure to handle internal errors, i.e. not user-invoked errors
   Internal function should ALWAYS call HandleError instead of RunError.

rtl/java/jcompproc.inc

@@ -635,8 +635,8 @@ procedure fpc_InitializeUnits; compilerproc;
 Procedure fpc_do_exit; compilerproc;
 Procedure fpc_lib_exit; compilerproc;
 Procedure fpc_HandleErrorAddrFrame (Errno : longint;addr,frame : pointer); compilerproc;
-Procedure fpc_HandleError (Errno : longint); compilerproc;
 }
+Procedure fpc_HandleError (Errno : longint); compilerproc;
 
 procedure fpc_AbstractErrorIntern;compilerproc;
 *)

rtl/java/jsystem.inc

@@ -78,7 +78,7 @@ Const
   {$endif FPC_OBJFPC_EXTENDED_IF}
 {$endif FPC_HAS_FEATURE_EXITCODE}
 
-Procedure HandleError (Errno : Longint); forward;
+Procedure HandleError (Errno : Longint); external name 'FPC_HANDLEERROR';
 Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward;
 
 {$ifdef FPC_HAS_FEATURE_TEXTIO}
@@ -1046,7 +1046,7 @@ begin
 end;
 
 
-Procedure HandleError (Errno : longint);[public,alias : 'FPC_HANDLEERROR'];
+Procedure fpc_handleerror (Errno : longint); compilerproc; [public,alias : 'FPC_HANDLEERROR'];
 {
   Procedure to handle internal errors, i.e. not user-invoked errors
   Internal function should ALWAYS call HandleError instead of RunError.