+ "reference" temps that sort of implement pointer-style functionality for

platforms that don't support pointers (by make a copy of all registers
    part of a reference)

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

compiler/hlcgobj.pas

@@ -412,6 +412,15 @@ unit hlcgobj;
           The default implementation issues a jump instruction to the external name. }
 //          procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual;
 
+          { create "safe copy" of a tlocation that can be used later: all
+            registers used in the tlocation are copied to new ones, so that
+            even if the original ones change, things stay the same (except if
+            the original location was already a register, then the register is
+            kept). Must only be used on lvalue locations.
+            It's intended as some kind of replacement for a_loadaddr_ref_reg()
+            for targets without pointers. }
+          procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); virtual; abstract;
+
 
           { routines migrated from ncgutil }
 

compiler/htypechk.pas

@@ -1181,7 +1181,7 @@ implementation
            case hp.nodetype of
              temprefn :
                begin
-                 valid_for_assign := true;
+                 valid_for_assign := not(ti_readonly in ttemprefnode(hp).tempinfo^.flags);
                  exit;
                end;
              derefn :

compiler/jvm/hlcgcpu.pas

@@ -111,6 +111,8 @@ uses
       procedure a_op_ref_stack(list : TAsmList;op: topcg; size: tdef;const ref: treference);
       procedure a_op_loc_stack(list : TAsmList;op: topcg; size: tdef;const loc: tlocation);
 
+      procedure g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation); override;
+
       { this routine expects that all values are already massaged into the
         required form (sign bits xor'ed for gt/lt comparisons for OS_32/OS_64,
         see http://stackoverflow.com/questions/4068973/c-performing-signed-comparison-in-unsigned-variables-without-casting ) }
@@ -461,6 +463,64 @@ implementation
       end;
     end;
 
+
+  procedure thlcgjvm.g_reference_loc(list: TAsmList; def: tdef; const fromloc: tlocation; out toloc: tlocation);
+
+    procedure handle_reg_move(regsize: tdef; const fromreg: tregister; out toreg: tregister; regtyp: tregistertype);
+      begin
+        case regtyp of
+          R_INTREGISTER:
+            toreg:=getintregister(list,regsize);
+          R_ADDRESSREGISTER:
+            toreg:=getaddressregister(list,regsize);
+          R_FPUREGISTER:
+            toreg:=getfpuregister(list,regsize);
+        end;
+        a_load_reg_reg(list,regsize,regsize,fromreg,toreg);
+      end;
+
+    begin
+      toloc:=fromloc;
+      case fromloc.loc of
+        { volatile location, can't get a permanent reference }
+        LOC_REGISTER,
+        LOC_FPUREGISTER:
+          internalerror(2011031406);
+        LOC_CONSTANT:
+          { finished }
+          ;
+        LOC_CREGISTER:
+          handle_reg_move(def,fromloc.reference.index,toloc.reference.index,R_INTREGISTER);
+        LOC_CFPUREGISTER:
+          handle_reg_move(def,fromloc.reference.index,toloc.reference.index,R_FPUREGISTER);
+        { although LOC_CREFERENCE cannot be an lvalue, we may want to take a
+          reference to such a location for multiple reading }
+        LOC_CREFERENCE,
+        LOC_REFERENCE:
+          begin
+            if (fromloc.reference.base<>NR_NO) and
+               (fromloc.reference.base<>current_procinfo.framepointer) and
+               (fromloc.reference.base<>NR_STACK_POINTER_REG) then
+              handle_reg_move(java_jlobject,fromloc.reference.base,toloc.reference.base,R_ADDRESSREGISTER);
+            case fromloc.reference.arrayreftype of
+              art_indexreg:
+                begin
+                  { all array indices in Java are 32 bit ints }
+                  handle_reg_move(s32inttype,fromloc.reference.index,toloc.reference.index,R_INTREGISTER);
+                end;
+              art_indexref:
+                begin
+                  if (fromloc.reference.indexbase<>NR_NO) and
+                     (fromloc.reference.indexbase<>NR_STACK_POINTER_REG) then
+                    handle_reg_move(s32inttype,fromloc.reference.indexbase,toloc.reference.indexbase,R_ADDRESSREGISTER);
+                end;
+            end;
+          end;
+        else
+          internalerror(2011031407);
+      end;
+    end;
+
     procedure thlcgjvm.a_cmp_stack_label(list: TAsmlist; size: tdef; cmp_op: topcmp; lab: tasmlabel);
       const
         opcmp2icmp: array[topcmp] of tasmop = (A_None,

compiler/nbas.pas

@@ -94,12 +94,57 @@ interface
 
        ttempcreatenode = class;
 
-       ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil,
+       ttempinfoflag = (
-                        ti_addr_taken,ti_executeinitialisation);
+         { temp can be kept in a register as far as the original creator is
+          concerned }
+         ti_may_be_in_reg,
+         { the ttempcreatenode has been process and the temp's location is
+           valid (-> the ttempdeletenode has not yet been processed, or
+           in case it's a "create_to_normal()" one, the final ttemprefnode
+           has not yet been processed) }
+         ti_valid,
+         { when performing a getcopy of a nodetree, we have to hook up the
+           copies of ttemprefnodes and ttempdestroynode to the copied
+           ttempinfo. this is done by setting hookoncopy in the original
+           ttempinfo to point to the new one. if the temp is deleted via a
+           regular ttempdeletenode, the hookoncopy is simply set to nil once
+           it's processed. otherwise, it sets the ti_nextref_set_hookoncopy_nil
+           and after processing the final ttemprefnode, hookoncopy is set to nil
+         }
+         ti_nextref_set_hookoncopy_nil,
+         { the address of this temp is taken (-> cannot be kept in a register,
+           even if the creator didn't mind)
+         }
+         ti_addr_taken,
+         { temps can get an extra node tree that contains the value to which
+           they should be initialised when they are created. this initialisation
+           has to be performed right before the first reference to the temp.
+           this flag indicates that the ttempcreatenode has been
+           processed by pass_generate_code, but that the first ttemprefnode
+           hasn't yet and hence will have to perform the initialisation
+         }
+         ti_executeinitialisation,
+         { in case an expression like "inc(x[func()],1)" is translated into
+           a regular addition, you have to create a temp to hold the address
+           representing x[func()], since otherwise func() will be called twice
+           and that can spell trouble in case it has side effects. on platforms
+           without pointers, we cannot just take the address though. this flag
+           has to be combined with ti_executeinitialisation above and will,
+           rather than loading the value at the calculated location and store
+           it in the temp, keep a copy of the calculated location if possible
+           and required (not possible for regvars, because SSA may change their
+           register, but not required for them either since calculating their
+           location has no side-effects
+         }
+         ti_reference,
+         { this temp only allows reading (makes it possible to safely use as
+           reference under more circumstances)
+         }
+         ti_readonly);
        ttempinfoflags = set of ttempinfoflag;
 
      const
-       tempinfostoreflags = [ti_may_be_in_reg,ti_addr_taken];
+       tempinfostoreflags = [ti_may_be_in_reg,ti_addr_taken,ti_reference,ti_readonly];
 
      type
        { to allow access to the location by temp references even after the temp has }
@@ -136,6 +181,7 @@ interface
           constructor create(_typedef: tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean); virtual;
           constructor create_withnode(_typedef: tdef; _size: tcgint; _temptype: ttemptype; allowreg:boolean; withnode: tnode); virtual;
           constructor create_value(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean; templvalue: tnode);
+          constructor create_reference(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean; templvalue: tnode; readonly: boolean);
           constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderefimpl;override;
@@ -209,6 +255,9 @@ interface
        function  laststatement(block:tblocknode):tstatementnode;
        procedure addstatement(var laststatement:tstatementnode;n:tnode);
 
+       { if the complexity of n is "high", creates a reference temp to n's
+         location and replace n with a ttemprefnode referring to that location }
+       function maybereplacewithtempref(var n: tnode; size: ASizeInt; readonly: boolean): ttempcreatenode;
 
 implementation
 
@@ -251,6 +300,20 @@ implementation
       end;
 
 
+    function maybereplacewithtempref(var n: tnode; size: ASizeInt; readonly: boolean): ttempcreatenode;
+      begin
+        result:=nil;
+        if node_complexity(n) > 4 then
+          begin
+            result:=ctempcreatenode.create_reference(n.resultdef,size,tt_persistent,true,n,readonly);
+            typecheckpass(tnode(result));
+            n:=ctemprefnode.create(result);
+            typecheckpass(n);
+          end;
+      end;
+
+
+
 {*****************************************************************************
                              TFIRSTNOTHING
 *****************************************************************************}
@@ -734,6 +797,19 @@ implementation
       end;
 
 
+     constructor ttempcreatenode.create_reference(_typedef: tdef; _size: tcgint; _temptype: ttemptype; allowreg: boolean; templvalue: tnode; readonly: boolean);
+      begin
+        // store in ppuwrite
+        self.create(_typedef,_size,_temptype,allowreg);
+        ftemplvalue:=templvalue;
+        // no assignment node, just the tempvalue
+        tempinfo^.tempinitcode:=ftemplvalue;
+        include(tempinfo^.flags,ti_reference);
+        if readonly then
+          include(tempinfo^.flags,ti_readonly);
+      end;
+
+
     function ttempcreatenode.dogetcopy: tnode;
       var
         n: ttempcreatenode;

compiler/ncgbas.pas

@@ -395,6 +395,10 @@ interface
         if (ti_valid in tempinfo^.flags) then
           internalerror(200108222);
 
+        { in case of ti_reference, the location will be initialised using the
+          location of the tempinitnode once the first temprefnode is processed }
+        if not(ti_reference in tempinfo^.flags) then
+          begin
             { get a (persistent) temp }
             if is_managed_type(tempinfo^.typedef) then
               begin
@@ -413,6 +417,7 @@ interface
                 location_reset_ref(tempinfo^.location,LOC_REFERENCE,def_cgsize(tempinfo^.typedef),0);
                 tg.gethltemp(current_asmdata.CurrAsmList,tempinfo^.typedef,size,tempinfo^.temptype,tempinfo^.location.reference);
               end;
+          end;
         include(tempinfo^.flags,ti_valid);
         if assigned(tempinfo^.tempinitcode) then
           include(tempinfo^.flags,ti_executeinitialisation);
@@ -430,6 +435,27 @@ interface
             { avoid recursion }
             exclude(tempinfo^.flags, ti_executeinitialisation);
             secondpass(tempinfo^.tempinitcode);
+            if (ti_reference in tempinfo^.flags) then
+              begin
+                case tempinfo^.tempinitcode.location.loc of
+                  LOC_CREGISTER,
+                  LOC_CFPUREGISTER,
+                  LOC_CMMREGISTER,
+                  LOC_CSUBSETREG:
+                    begin
+                      { although it's ok if we need this value multiple times
+                        for reading, it's not in case of writing (because the
+                        register could change due to SSA -> storing to the saved
+                        register afterwards would be wrong). }
+                      if not(ti_readonly in tempinfo^.flags) then
+                        internalerror(2011031407);
+                    end;
+                  { in case reference contains CREGISTERS, that doesn't matter:
+                    we want to write to the location indicated by the current
+                    value of those registers, and we can save those values }
+                end;
+                hlcg.g_reference_loc(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.tempinitcode.location,tempinfo^.location);
+              end;
           end;
         { check if the temp is valid }
         if not(ti_valid in tempinfo^.flags) then