* implemented declaring and calling constructors for Java classes

o handle them like for regular classes (return a class instance,
     although this is technically not true since they don't return
     anything; will be changed in the future)
   o because of the previous point, make sure that we handle the
     "function result" properly and don't pop too many values from
     the evaluation stack when calling one constructor from another
   o added "extra_pre_call_code" method used by njvmcal to insert
     the "new" opcode to create the new class instance before
     calling a constructor
   o when a constructor does not call any other constructor (inherited
     or otherwise), automatically insert a call to the inherited
     parameterless constructor as required by the jvm standard)
   TODO: check that *if* an inherited or other constructor is called
     from another constructor, that it does so as the first statement/
     call

git-svn-id: branches/jvmbackend@18328 -

compiler/jvm/hlcgcpu.pas

@@ -81,6 +81,7 @@ uses
       procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); override;
       procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); override;
 
+      procedure gen_load_return_value(list:TAsmList);override;
       procedure record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList); override;
 
       { JVM-specific routines }
@@ -788,11 +789,16 @@ implementation
 
   procedure thlcgjvm.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: boolean);
     var
+      retdef: tdef;
       opc: tasmop;
     begin
-      case current_procinfo.procdef.returndef.typ of
+      if current_procinfo.procdef.proctypeoption=potype_constructor then
+        retdef:=voidtype
+      else
+        retdef:=current_procinfo.procdef.returndef;
+      case retdef.typ of
         orddef:
-          case torddef(current_procinfo.procdef.returndef).ordtype of
+          case torddef(retdef).ordtype of
             uvoid:
               opc:=a_return;
             s64bit,
@@ -803,7 +809,7 @@ implementation
               opc:=a_ireturn;
           end;
         floatdef:
-          case tfloatdef(current_procinfo.procdef.returndef).floattype of
+          case tfloatdef(retdef).floattype of
             s32real:
               opc:=a_freturn;
             s64real:
@@ -817,6 +823,14 @@ implementation
       list.concat(taicpu.op_none(opc));
     end;
 
+  procedure thlcgjvm.gen_load_return_value(list: TAsmList);
+    begin
+      { constructors don't return anything in the jvm }
+      if current_procinfo.procdef.proctypeoption=potype_constructor then
+        exit;
+      inherited gen_load_return_value(list);
+    end;
+
   procedure thlcgjvm.record_generated_code_for_procdef(pd: tprocdef; code, data: TAsmList);
     begin
       { add something to the al_procedures list as well, because if all al_*

compiler/jvm/njvmcal.pas

@@ -35,6 +35,7 @@ interface
 
        tjvmcallnode = class(tcgcallnode)
         protected
+         procedure extra_pre_call_code; override;
          procedure set_result_location(realresdef: tstoreddef); override;
          procedure do_release_unused_return_value;override;
          procedure extra_post_call_code; override;
@@ -45,16 +46,37 @@ implementation
 
     uses
       verbose,globtype,
-      symtype,defutil,ncal,
+      symconst,symtype,defutil,ncal,
-      cgbase,cgutils,tgobj,
+      cgbase,cgutils,tgobj,procinfo,
       cpubase,aasmdata,aasmcpu,
-      hlcgobj,hlcgcpu;
+      hlcgobj,hlcgcpu,
+      jvmdef;
 
 
 {*****************************************************************************
                              TJVMCALLNODE
 *****************************************************************************}
 
+    procedure tjvmcallnode.extra_pre_call_code;
+      begin
+        { when calling a constructor, first create a new instance, except
+          when calling it from another constructor (because then this has
+          already been done before calling the current constructor) }
+        if procdefinition.typ<>procdef then
+          exit;
+        if tprocdef(procdefinition).proctypeoption<>potype_constructor then
+          exit;
+        if (methodpointer.resultdef.typ<>classrefdef) then
+          exit;
+        current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(tobjectdef(tprocdef(procdefinition).owner.defowner).jvm_full_typename)));
+        { the constructor doesn't return anything, so put a duplicate of the
+          self pointer on the evaluation stack for use as function result
+          after the constructor has run }
+        current_asmdata.CurrAsmList.concat(taicpu.op_none(a_dup));
+        thlcgjvm(hlcg).incstack(2);
+      end;
+
+
     procedure tjvmcallnode.set_result_location(realresdef: tstoreddef);
       begin
         location_reset_ref(location,LOC_REFERENCE,def_cgsize(realresdef),1);
@@ -64,6 +86,9 @@ implementation
 
     procedure tjvmcallnode.do_release_unused_return_value;
       begin
+        if (tprocdef(procdefinition).proctypeoption=potype_constructor) and
+           (current_procinfo.procdef.proctypeoption=potype_constructor) then
+          exit;
         case resultdef.size of
           0:
             ;
@@ -92,7 +117,11 @@ implementation
           realresdef:=tstoreddef(resultdef)
         else
           realresdef:=tstoreddef(typedef);
-        totalremovesize:=pushedparasize-realresdef.size;
+        { a constructor doesn't actually return a value in the jvm }
+        if (tprocdef(procdefinition).proctypeoption=potype_constructor) then
+          totalremovesize:=pushedparasize
+        else
+          totalremovesize:=pushedparasize-realresdef.size;
         { remove parameters from internal evaluation stack counter (in case of
           e.g. no parameters and a result, it can also increase) }
         if totalremovesize>0 then

compiler/ncal.pas

@@ -1670,7 +1670,12 @@ implementation
               { push 0 as self when allocation is needed }
               if (methodpointer.resultdef.typ=classrefdef) or
                  (cnf_new_call in callnodeflags) then
-                selftree:=cpointerconstnode.create(0,voidpointertype)
+                if not is_javaclass(tdef(procdefinition.owner.defowner)) then
+                  selftree:=cpointerconstnode.create(0,voidpointertype)
+                else
+                 { special handling for Java constructors, handled in
+                   tjvmcallnode.extra_pre_call_code }
+                  selftree:=cnothingnode.create
               else
                 begin
                   if methodpointer.nodetype=typen then
@@ -3340,6 +3345,15 @@ implementation
              doinlinesimplify(tnode(callcleanupblock));
            end;
 
+         { If a constructor calls another constructor of the same or of an
+           inherited class, some targets (jvm) have to generate different
+           entry code for the constructor. }
+         if (current_procinfo.procdef.proctypeoption=potype_constructor) and
+            (procdefinition.typ=procdef) and
+            (tprocdef(procdefinition).proctypeoption=potype_constructor) and
+            ([cnf_member_call,cnf_inherited] * callnodeflags <> []) then
+           current_procinfo.ConstructorCallingConstructor:=true;
+
          { Continue with checking a normal call or generate the inlined code }
          if cnf_do_inline in callnodeflags then
            result:=pass1_inline

compiler/ncgcal.pas

@@ -68,6 +68,7 @@ interface
           }
           procedure pop_parasize(pop_size:longint);virtual;
           procedure extra_interrupt_code;virtual;
+          procedure extra_pre_call_code;virtual;
           procedure extra_call_code;virtual;
           procedure extra_post_call_code;virtual;
           procedure do_syscall;virtual;abstract;
@@ -285,6 +286,11 @@ implementation
       end;
 
 
+    procedure tcgcallnode.extra_pre_call_code;
+      begin
+      end;
+
+
     procedure tcgcallnode.extra_call_code;
       begin
       end;
@@ -650,6 +656,8 @@ implementation
             not(procdefinition.has_paraloc_info in [callerside,callbothsides]) then
            internalerror(200305264);
 
+         extra_pre_call_code;
+
          if assigned(callinitblock) then
            secondpass(tnode(callinitblock));
 

compiler/pdecobj.pas

@@ -102,7 +102,9 @@ implementation
         include(current_structdef.objectoptions,oo_has_constructor);
         { Set return type, class and record constructors return the
           created instance, object constructors return boolean }
-        if is_class(pd.struct) or is_record(pd.struct) then
+        if is_class(pd.struct) or
+           is_record(pd.struct) or
+           is_javaclass(pd.struct) then
           pd.returndef:=pd.struct
         else
 {$ifdef CPU64bitaddr}

compiler/pdecsub.pas

@@ -1402,7 +1402,9 @@ implementation
                 begin
                   { Set return type, class constructors return the
                     created instance, object constructors return boolean }
-                  if is_class(pd.struct) or is_record(pd.struct) then
+                  if is_class(pd.struct) or
+                     is_record(pd.struct) or
+                     is_javaclass(pd.struct) then
                     pd.returndef:=pd.struct
                   else
 {$ifdef CPU64bitaddr}
@@ -2377,7 +2379,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_OVERLOAD;
-      pd_flags : [pd_implemen,pd_interface,pd_body];
+      pd_flags : [pd_implemen,pd_interface,pd_body,pd_javaclass,pd_intfjava];
       handler  : @pd_overload;
       pocall   : pocall_none;
       pooption : [po_overload];
@@ -2386,7 +2388,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_OVERRIDE;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_javaclass,pd_notrecord];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_javaclass,pd_intfjava,pd_notrecord];
       handler  : @pd_override;
       pocall   : pocall_none;
       pooption : [po_overridingmethod,po_virtualmethod];

compiler/pexpr.pas

@@ -1257,7 +1257,9 @@ implementation
                      else
                        begin
                          p1:=ctypenode.create(ttypesym(sym).typedef);
-                         if (is_class(ttypesym(sym).typedef) or is_objcclass(ttypesym(sym).typedef)) and
+                         if (is_class(ttypesym(sym).typedef) or
+                             is_objcclass(ttypesym(sym).typedef) or
+                             is_javaclass(ttypesym(sym).typedef)) and
                             not(block_type in [bt_type,bt_const_type,bt_var_type]) then
                            p1:=cloadvmtaddrnode.create(p1);
                        end;
@@ -1553,7 +1555,8 @@ implementation
                             (for "TClassHelper.Something") }
                           { class reference ? }
                           if is_class(hdef) or
-                             is_objcclass(hdef) then
+                             is_objcclass(hdef) or
+                             is_javaclass(hdef) then
                            begin
                              if getaddr and (token=_POINT) then
                               begin

compiler/procinfo.pas

@@ -114,6 +114,11 @@ unit procinfo;
           { max. of space need for parameters }
           maxpushedparasize : aint;
 
+          { is this a constructor that calls another constructor on itself
+            (either inherited, or another constructor of the same class)?
+            Requires different entry code for some targets. }
+          ConstructorCallingConstructor: boolean;
+
           constructor create(aparent:tprocinfo);virtual;
           destructor destroy;override;
 

compiler/psub.pas

@@ -292,6 +292,7 @@ implementation
       var
         srsym        : tsym;
         para         : tcallparanode;
+        call         : tcallnode;
         newstatement : tstatementnode;
       begin
         result:=internalstatements(newstatement);
@@ -350,6 +351,25 @@ implementation
                               voidpointertype),
                           ccallnode.createintern('fpc_help_constructor',para)));
                     end
+                else
+                  if is_javaclass(current_structdef) then
+                    begin
+                      if (current_procinfo.procdef.proctypeoption=potype_constructor) and
+                         not current_procinfo.ConstructorCallingConstructor then
+                       begin
+                         { call inherited constructor }
+                         srsym:=search_struct_member(tobjectdef(current_structdef).childof,'CREATE');
+                         if assigned(srsym) and
+                            (srsym.typ=procsym) then
+                           begin
+                             call:=ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[cnf_inherited]);
+                             exclude(tcallnode(call).callnodeflags,cnf_return_value_used);
+                             addstatement(newstatement,call);
+                           end
+                         else
+                           internalerror(2011010312);
+                       end;
+                    end
                 else
                   if not is_record(current_structdef) then
                   internalerror(200305103);