* unless compiled with -dnounsupported, the compiler will now accept not

only JVM constructs that are already implemented, but also ones that
    will be supported in the future but that aren't implemented yet (to
    make it easier to already adapt code to the future changes)

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

compiler/jvm/njvmadd.pas

@@ -85,6 +85,14 @@ interface
         case nodetype of
           addn:
             begin
+{$ifndef nounsupported}
+               if not is_wide_or_unicode_string(resultdef) then
+                 begin
+                   result:=left;
+                   left:=nil;
+                   exit;
+                 end;
+{$endif nounsupported}
               if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then
                 begin
                   result:=right;
@@ -113,6 +121,9 @@ interface
             end;
           ltn,lten,gtn,gten,equaln,unequaln :
             begin
+{$ifndef nounsupported}
+             left.resultdef:=cunicodestringtype;
+{$endif nounsupported}
               { call compare routine }
               cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare';
               { for equality checks use optimized version }

compiler/jvm/njvmcnv.pas

@@ -550,6 +550,20 @@ implementation
             result:=true;
             exit;
           end;
+
+{$ifndef nounsupported}
+        if ((left.resultdef.typ=procvardef) and
+            ((resultdef=methodpointertype) or
+             (resultdef=search_system_type('TMETHOD').typedef))) or
+           ((resultdef.typ=procvardef) and
+            ((left.resultdef=methodpointertype)  or
+             (left.resultdef=search_system_type('TMETHOD').typedef))) then
+          begin
+            convtype:=tc_equal;
+            result:=true;
+            exit;
+          end;
+{$endif}
       end;
 
 

compiler/jvm/njvmmem.pas

@@ -31,6 +31,10 @@ interface
       node,nmem,ncgmem;
 
     type
+       tjvmloadparentfpnode = class(tcgloadparentfpnode)
+         procedure pass_generate_code;override;
+       end;
+
        tjvmvecnode = class(tcgvecnode)
          function pass_1: tnode; override;
          procedure pass_generate_code;override;
@@ -46,6 +50,19 @@ implementation
       aasmdata,pass_2,
       cgutils,hlcgobj,hlcgcpu;
 
+    { tjvmloadparentfpnode }
+
+    procedure tjvmloadparentfpnode.pass_generate_code;
+      begin
+{$ifndef nounsupported}
+        location_reset(location,LOC_REGISTER,OS_ADDR);
+        location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
+        hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
+{$else}
+       internalerror(2011041301);
+{$endif}
+      end;
+
 {*****************************************************************************
                              TJVMVECNODE
 *****************************************************************************}
@@ -77,6 +94,14 @@ implementation
       var
         newsize: tcgsize;
       begin
+{$ifndef nounsupported}
+        if left.resultdef.typ=stringdef then
+          begin
+            location:=left.location;
+            exit;
+          end;
+{$endif}
+
         { This routine is not used for Strings, as they are a class type and
           you have to use charAt() there to load a character (and you cannot
           change characters; you have to create a new string in that case)

compiler/jvm/tgcpu.pas

@@ -120,6 +120,15 @@ unit tgcpu;
               thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
               result:=true;
             end;
+          setdef:
+            begin
+              if is_smallset(def) then
+                exit;
+{$ifndef nounsupported}
+              gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+              result:=true;
+{$endif}
+            end;
         end;
       end;
 

compiler/jvmdef.pas

@@ -91,8 +91,12 @@ implementation
                 st_unicodestring:
                   encodedstr:=encodedstr+'Ljava/lang/String;';
                 else
+{$ifndef nounsupported}
+                  result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror);
+{$else}
                   { May be handled via wrapping later  }
                   result:=false;
+{$endif}
               end;
             end;
           enumdef,
@@ -127,6 +131,11 @@ implementation
             end;
           pointerdef :
             begin
+{$ifndef nounsupported}
+              if def=voidpointertype then
+                result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror)
+              else
+{$endif}
               { some may be handled via wrapping later }
               result:=false;
             end;
@@ -156,17 +165,25 @@ implementation
             end;
           classrefdef :
             begin
+{$ifndef nounsupported}
+              result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror);
+{$else}
               { may be handled via wrapping later }
               result:=false;
+{$endif}
             end;
           setdef :
             begin
               if is_smallset(def) then
                 encodedstr:=encodedstr+'I'
               else
-              { will be hanlded via wrapping later, although wrapping may
+{$ifndef nounsupported}
-                happen at higher level }
+                result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror);
-              result:=false;
+{$else}
+                { will be hanlded via wrapping later, although wrapping may
+                  happen at higher level }
+                result:=false;
+{$endif}
             end;
           formaldef :
             begin
@@ -175,8 +192,13 @@ implementation
             end;
           arraydef :
             begin
-              if is_array_of_const(def) or
+              if is_array_of_const(def) then
-                 is_packed_array(def) then
+{$ifndef nounsupported}
+                result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror)
+{$else}
+                result:=false
+{$endif}
+              else if is_packed_array(def) then
                 result:=false
               else
                 begin
@@ -191,9 +213,13 @@ implementation
             end;
           procvardef :
             begin
+{$ifndef nounsupported}
+              result:=jvmaddencodedtype(java_jlobject,false,encodedstr,founderror);
+{$else}
               { will be hanlded via wrapping later, although wrapping may
                 happen at higher level }
               result:=false;
+{$endif}
             end;
           objectdef :
             case tobjectdef(def).objecttype of

compiler/nadd.pas

@@ -2112,6 +2112,12 @@ implementation
         newstatement : tstatementnode;
         temp    : ttempcreatenode;
       begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+        result:=cnothingnode.create;
+        exit;
+{$endif nounsupported}
+{$endif}
         result:=nil;
         case nodetype of
           equaln,unequaln,lten,gten:

compiler/ncal.pas

@@ -1628,6 +1628,12 @@ implementation
 
     function tcallnode.gen_procvar_context_tree:tnode;
       begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+        result:=cnilnode.create;
+        exit;
+{$endif}
+{$endif}
         { Load tmehodpointer(right).self (either self or parentfp) }
         result:=genloadfield(ctypeconvnode.create_internal(
           right.getcopy,methodpointertype),

compiler/ncgcal.pas

@@ -839,6 +839,7 @@ implementation
          else
            { now procedure variable case }
            begin
+{$if defined(nounsupported) or not defined(jvm)}
               secondpass(right);
 
               pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR);
@@ -848,6 +849,7 @@ implementation
               else
                 cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_ADDR,right.location,pvreg);
               location_freetemp(current_asmdata.CurrAsmList,right.location);
+{$endif defined(nounsupported) or not defined(jvm)}
 
               { Load parameters that are in temporary registers in the
                 correct parameter register }
@@ -858,6 +860,7 @@ implementation
                   freeparas;
                 end;
 
+{$if defined(nounsupported) or not defined(jvm)}
               cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int);
               if cg.uses_registers(R_FPUREGISTER) then
                 cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu);
@@ -870,6 +873,7 @@ implementation
                 extra_interrupt_code;
               extra_call_code;
               cg.a_call_reg(current_asmdata.CurrAsmList,pvreg);
+{$endif defined(nounsupported) or not defined(jvm)}
               extra_post_call_code;
            end;
 

compiler/ncgcnv.pas

@@ -360,6 +360,13 @@ interface
 
     procedure tcgtypeconvnode.second_char_to_string;
       begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+         location_reset_ref(location,LOC_REFERENCE,OS_NO,1);
+         tg.gethltemp(current_asmdata.CurrAsmList,cshortstringtype,256,tt_normal,location.reference);
+         exit;
+{$endif nounsupported}
+{$endif jvm}
          location_reset_ref(location,LOC_REFERENCE,OS_NO,2);
          case tstringdef(resultdef).stringtype of
            st_shortstring :
@@ -479,6 +486,14 @@ interface
       var
         tmpreg: tregister;
       begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+         location_reset(location,LOC_REGISTER,OS_ADDR);
+         location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
+         hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
+         exit;
+{$endif nounsupported}
+{$endif jvm}
         if tabstractprocdef(resultdef).is_addressonly then
           begin
             location_reset(location,LOC_REGISTER,OS_ADDR);
@@ -513,6 +528,14 @@ interface
     var r:Treference;
 
     begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+      tg.gethltemp(current_asmdata.currasmlist,java_jlobject,java_jlobject.size,tt_normal,r);
+      location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),0);
+      location.reference:=r;
+      exit;
+{$endif}
+{$endif}
       tg.gethltemp(current_asmdata.currasmlist,methodpointertype,methodpointertype.size,tt_normal,r);
       location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),0);
       location.reference:=r;

compiler/ncgcon.pas

@@ -71,7 +71,7 @@ implementation
       symconst,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil,
       cpuinfo,cpubase,
       cgbase,cgobj,cgutils,
-      ncgutil, cclasses,asmutils
+      ncgutil, cclasses,asmutils,tgobj
       ;
 
 
@@ -409,6 +409,13 @@ implementation
            i           : longint;
            entry       : PHashSetItem;
         begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+          location_reset_ref(location,LOC_REFERENCE,OS_ADDR,1);
+          tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_persistent,location.reference);
+          exit;
+{$endif nounsupported}
+{$endif jvm}
           location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(8));
           lastlabel:=nil;
           { const already used ? }

compiler/ncginl.pas

@@ -528,6 +528,9 @@ implementation
         var
           setpara, elepara: tnode;
         begin
+{$if defined(jvm) and not defined(nounsupported)}
+          exit;
+{$endif}
           { the set }
           secondpass(tcallparanode(left).left);
           { the element to set }

compiler/ncgld.pas

@@ -412,6 +412,7 @@ implementation
             localvarsym :
               begin
                 vs:=tabstractnormalvarsym(symtableentry);
+{$if not defined(jvm) or not defined(nounsupported)}
                 { Nested variable }
                 if assigned(left) then
                   begin
@@ -423,6 +424,7 @@ implementation
                     reference_reset_base(location.reference,left.location.register,vs.localloc.reference.offset,vs.localloc.reference.alignment);
                   end
                 else
+{$endif}
                   location:=vs.localloc;
 
                 { handle call by reference variables when they are not
@@ -455,6 +457,14 @@ implementation
              end;
            procsym:
               begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+                 location_reset(location,LOC_REGISTER,OS_ADDR);
+                 location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
+                 hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
+                 exit;
+{$endif nounsupported}
+{$endif jvm}
                  if not assigned(procdef) then
                    internalerror(200312011);
                  if assigned(left) then
@@ -1095,6 +1105,7 @@ implementation
 
               if dovariant then
                begin
+{$if not defined(jvm) or defined(nounsupported)}
                  { find the correct vtype value }
                  vtype:=$ff;
                  vaddr:=false;
@@ -1214,6 +1225,7 @@ implementation
                  cg.a_load_const_ref(current_asmdata.CurrAsmList, OS_INT,vtype,href);
                  { goto next array element }
                  advancearrayoffset(href,sizeof(pint)*2);
+{$endif not jvm or nounsupported}
                end
               else
               { normal array constructor of the same type }

compiler/ncgmem.pas

@@ -101,6 +101,14 @@ implementation
         entry   : PHashSetItem;
 
       begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+         location_reset(location,LOC_REGISTER,OS_ADDR);
+         location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
+         hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
+         exit;
+{$endif nounsupported}
+{$endif jvm}
          location_reset(location,LOC_REGISTER,OS_ADDR);
          if (left.nodetype=typen) then
            begin
@@ -151,6 +159,14 @@ implementation
         hsym   : tparavarsym;
         href   : treference;
       begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+         location_reset(location,LOC_REGISTER,OS_ADDR);
+         location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
+         hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
+         exit;
+{$endif nounsupported}
+{$endif jvm}
         if (current_procinfo.procdef.parast.symtablelevel=parentpd.parast.symtablelevel) then
           begin
             location_reset(location,LOC_REGISTER,OS_ADDR);
@@ -192,6 +208,14 @@ implementation
 
     procedure tcgaddrnode.pass_generate_code;
       begin
+{$ifdef jvm}
+{$ifndef nounsupported}
+         location_reset(location,LOC_REGISTER,OS_ADDR);
+         location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,java_jlobject);
+         hlcg.a_load_const_reg(current_asmdata.CurrAsmList,java_jlobject,0,location.register);
+         exit;
+{$endif nounsupported}
+{$endif jvm}
          secondpass(left);
 
          location_reset(location,LOC_REGISTER,OS_ADDR);

compiler/ncgset.pas

@@ -276,6 +276,17 @@ implementation
          if nf_swapped in flags then
           swapleftright;
 
+{$if defined(jvm) and not defined(nounsupported)}
+          if not is_smallset(left.resultdef) then
+            begin
+              location_reset(location, LOC_REGISTER, uopsize{def_cgsize(resultdef)});
+              { allocate a register for the result }
+              location.register:=cg.getintregister(current_asmdata.CurrAsmList, uopsize);
+              hlcg.a_load_const_reg(current_asmdata.CurrAsmList,s32inttype,0,location.register);
+              exit;
+            end;
+{$endif}
+
          setbase:=tsetdef(right.resultdef).setbase;
          if genjumps then
           begin

compiler/psystem.pas

@@ -401,6 +401,15 @@ implementation
             addfield(hrecst,tfieldvarsym.create('$self',vs_value,voidpointertype,[]));
             methodpointertype:=trecorddef.create('',hrecst);
             addtype('$methodpointer',methodpointertype);
+          end
+        else
+          begin
+{$if defined(jvm) and not defined(nounsupported)}
+            hrecst:=trecordsymtable.create('',1);
+            addfield(hrecst,tfieldvarsym.create('$proc',vs_value,voidpointertype,[]));
+            methodpointertype:=trecorddef.create('',hrecst);
+            addtype('$methodpointer',methodpointertype);
+{$endif}
           end;
         symtablestack.pop(systemunit);
       end;
@@ -477,7 +486,9 @@ implementation
           end;
         loadtype('variant',cvarianttype);
         loadtype('olevariant',colevarianttype);
+{$if defined(nounsupported) or not defined(jvm)}
         if not(target_info.system in systems_managed_vm) then
+{$endif}
           loadtype('methodpointer',methodpointertype);
         loadtype('HRESULT',hresultdef);
 {$ifdef cpu64bitaddr}

rtl/java/system.pp

@@ -124,6 +124,67 @@ type
 {$i jrech.inc}
 {$i jdynarrh.inc}
 
+{$ifndef nounsupported}
+type
+  tmethod = record
+    code: jlobject;
+  end;
+
+const
+   vtInteger       = 0;
+   vtBoolean       = 1;
+   vtChar          = 2;
+{$ifndef FPUNONE}
+   vtExtended      = 3;
+{$endif}
+   vtString        = 4;
+   vtPointer       = 5;
+   vtPChar         = 6;
+   vtObject        = 7;
+   vtClass         = 8;
+   vtWideChar      = 9;
+   vtPWideChar     = 10;
+   vtAnsiString    = 11;
+   vtCurrency      = 12;
+   vtVariant       = 13;
+   vtInterface     = 14;
+   vtWideString    = 15;
+   vtInt64         = 16;
+   vtQWord         = 17;
+   vtUnicodeString = 18;
+
+type
+  TVarRec = record
+     case VType : sizeint of
+{$ifdef ENDIAN_BIG}
+       vtInteger       : ({$IFDEF CPU64}integerdummy1 : Longint;{$ENDIF CPU64}VInteger: Longint);
+       vtBoolean       : ({$IFDEF CPU64}booldummy : Longint;{$ENDIF CPU64}booldummy1,booldummy2,booldummy3: byte; VBoolean: Boolean);
+       vtChar          : ({$IFDEF CPU64}chardummy : Longint;{$ENDIF CPU64}chardummy1,chardummy2,chardummy3: byte; VChar: Char);
+       vtWideChar      : ({$IFDEF CPU64}widechardummy : Longint;{$ENDIF CPU64}wchardummy1,VWideChar: WideChar);
+{$else ENDIAN_BIG}
+       vtInteger       : (VInteger: Longint);
+       vtBoolean       : (VBoolean: Boolean);
+       vtChar          : (VChar: Char);
+       vtWideChar      : (VWideChar: WideChar);
+{$endif ENDIAN_BIG}
+//       vtString        : (VString: PShortString);
+//       vtPointer       : (VPointer: Pointer);
+///       vtPChar         : (VPChar: PChar);
+       vtObject        : (VObject: TObject);
+//       vtClass         : (VClass: TClass);
+//       vtPWideChar     : (VPWideChar: PWideChar);
+       vtAnsiString    : (VAnsiString: JLString);
+       vtCurrency      : (VCurrency: Currency);
+//       vtVariant       : (VVariant: PVariant);
+       vtInterface     : (VInterface: JLObject);
+       vtWideString    : (VWideString: JLString);
+       vtInt64         : (VInt64: Int64);
+       vtUnicodeString : (VUnicodeString: JLString);
+       vtQWord         : (VQWord: QWord);
+   end;
+
+{$endif}
+
 Function  lo(i : Integer) : byte;  [INTERNPROC: fpc_in_lo_Word];
 Function  lo(w : Word) : byte;     [INTERNPROC: fpc_in_lo_Word];
 Function  lo(l : Longint) : Word;  [INTERNPROC: fpc_in_lo_long];