+ support for array-of-const on the JVM target. Even though the

    implementation is a bit different from that on native targets, the
    result is quite compatible

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

compiler/jvm/njvmld.pas

@@ -48,6 +48,7 @@ type
    protected
     procedure makearrayref(var ref: treference; eledef: tdef); override;
     procedure advancearrayoffset(var ref: treference; elesize: asizeint); override;
+    procedure wrapmanagedvarrec(var n: tnode);override;
   end;
 
 implementation
@@ -216,6 +217,30 @@ procedure tjvmarrayconstructornode.advancearrayoffset(var ref: treference; elesi
   end;
 
 
+procedure tjvmarrayconstructornode.wrapmanagedvarrec(var n: tnode);
+  var
+    varrecdef: trecorddef;
+    block: tblocknode;
+    stat: tstatementnode;
+    temp: ttempcreatenode;
+  begin
+    varrecdef:=trecorddef(search_system_type('TVARREC').typedef);
+    block:=internalstatements(stat);
+    temp:=ctempcreatenode.create(varrecdef,varrecdef.size,tt_persistent,false);
+    addstatement(stat,temp);
+    addstatement(stat,
+      ccallnode.createinternmethod(
+        ctemprefnode.create(temp),'INIT',ccallparanode.create(n,nil)));
+    { note: this will not free the record contents, but just let its reference
+      on the stack be reused -- which is ok, because the reference will be
+      stored into the open array parameter }
+    addstatement(stat,ctempdeletenode.create_normal_temp(temp));
+    addstatement(stat,ctemprefnode.create(temp));
+    n:=block;
+    firstpass(n);
+  end;
+
+
 begin
   cloadnode:=tjvmloadnode;
   cassignmentnode:=tjvmassignmentnode;

compiler/jvmdef.pas

@@ -320,11 +320,10 @@ implementation
           arraydef :
             begin
               if is_array_of_const(def) then
-{$ifndef nounsupported}
-                result:=jvmaddencodedtype(java_jlobject,false,encodedstr,forcesignature,founderror)
-{$else}
-                result:=false
-{$endif}
+                begin
+                  encodedstr:=encodedstr+'[';
+                  result:=jvmaddencodedtype(search_system_type('TVARREC').typedef,false,encodedstr,forcesignature,founderror);
+                end
               else if is_packed_array(def) then
                 result:=false
               else

compiler/ncgld.pas

@@ -1055,11 +1055,13 @@ implementation
         tmpreg  : tregister;
         vaddr : boolean;
         freetemp,
-        dovariant : boolean;
+        dovariant: boolean;
       begin
         if is_packed_array(resultdef) then
           internalerror(200608042);
-        dovariant:=(nf_forcevaria in flags) or is_variant_array(resultdef);
+        dovariant:=
+          ((nf_forcevaria in flags) or is_variant_array(resultdef)) and
+          not(target_info.system in systems_managed_vm);
         if dovariant then
           begin
             eledef:=search_system_type('TVARREC').typedef;
@@ -1113,7 +1115,6 @@ implementation
 
               if dovariant then
                begin
-{$if not defined(jvm) or defined(nounsupported)}
                  { find the correct vtype value }
                  vtype:=$ff;
                  vaddr:=false;
@@ -1233,7 +1234,6 @@ 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/nld.pas

@@ -91,6 +91,9 @@ interface
        tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
 
        tarrayconstructornode = class(tbinarynode)
+         protected
+          procedure wrapmanagedvarrec(var n: tnode);virtual;abstract;
+         public
           constructor create(l,r : tnode);virtual;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
@@ -152,7 +155,7 @@ implementation
 
     uses
       cutils,verbose,globtype,globals,systems,constexp,
-      symnot,
+      symnot,symtable,
       defutil,defcmp,
       htypechk,pass_1,procinfo,paramgr,
       cpuinfo,
@@ -1018,9 +1021,13 @@ implementation
     function tarrayconstructornode.pass_1 : tnode;
       var
         hp : tarrayconstructornode;
-        do_variant:boolean;
+        do_variant,
+        do_managed_variant:boolean;
       begin
         do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
+        do_managed_variant:=
+          do_variant and
+          (target_info.system in systems_managed_vm);
         result:=nil;
         { Insert required type convs, this must be
           done in pass 1, because the call must be
@@ -1040,10 +1047,16 @@ implementation
                     if not do_variant then
                       include(current_procinfo.flags,pi_do_call);
                     firstpass(hp.left);
+                    if do_managed_variant then
+                      wrapmanagedvarrec(hp.left);
                   end;
                 hp:=tarrayconstructornode(hp.right);
               end;
           end;
+        { set the elementdef to the correct type in case of a managed
+          variant array }
+        if do_managed_variant then
+          tarraydef(resultdef).elementdef:=search_system_type('TVARREC').typedef;
         expectloc:=LOC_CREFERENCE;
       end;
 

rtl/java/objpas.inc

@@ -36,3 +36,249 @@
     end;
 
 
+
+  procedure tvarrec.init(l: longint);
+    begin
+      VType:=vtInteger;
+      Value:=JLInteger.valueOf(l);
+    end;
+
+
+  procedure tvarrec.init(b: boolean);
+    begin
+      VType:=vtBoolean;
+      Value:=JLBoolean.valueOf(b);
+    end;
+
+
+  procedure tvarrec.init(c: ansichar);
+    begin
+      VType:=vtChar;
+      Value:=JLByte.valueOf(byte(c));
+    end;
+
+
+  procedure tvarrec.init(w: widechar);
+    begin
+      VType:=vtWideChar;
+      Value:=JLCharacter.valueOf(w);
+    end;
+
+
+  procedure tvarrec.init(d: extended);
+    var
+      arr: array[0..0] of extended;
+    begin
+      VType:=vtExtended;
+      { VExtended has to return a PExtended -> return address of array (it
+        doesn't matter that this is a local variable, all arrays are garbage
+        collected pointers underneath!) }
+      arr[0]:=d;
+      Value:=JLObject(@arr);
+    end;
+
+
+  procedure tvarrec.init(const s: shortstring);
+    begin
+      VType:=vtString;
+      Value:=JLObject(@s);
+    end;
+
+
+  procedure tvarrec.init(constref p: pointer);
+    begin
+      // pointer = object
+      VType:=vtPointer;
+      Value:=JLObject(p);
+    end;
+
+
+  procedure tvarrec.init(p: pchar);
+    begin
+      VType:=vtPChar;
+      Value:=JLObject(p);
+    end;
+
+
+  procedure tvarrec.init(p: JLObject);
+    begin
+      VType:=vtObject;
+      Value:=p;
+    end;
+
+
+  procedure tvarrec.init(c: TJClass);
+    begin
+      VType:=vtClass;
+      Value:=JLObject(c);
+    end;
+
+
+  procedure tvarrec.init(p: pwidechar);
+    begin
+      VType:=vtPWideChar;
+      Value:=JLObject(p);
+    end;
+
+
+  procedure tvarrec.init(const a: ansistring);
+    begin
+      VType:=vtAnsiString;
+      Value:=JLObject(a);
+    end;
+
+
+  procedure tvarrec.init(constref c: currency);
+    begin
+      VType:=vtCurrency;
+      { a constref parameter is internally passed as an array -> we can just
+        take its address and return it later as a pcurrency (which is also a
+        pointer internally) }
+      Value:=JLObject(@c);
+    end;
+
+
+  procedure tvarrec.init(const w: widestring);
+    begin
+      VType:=vtUnicodeString;
+      Value:=JLObject(w);
+    end;
+
+
+  procedure tvarrec.init(i: int64);
+    var
+      arr: array[0..0] of int64;
+    begin
+      VType:=vtInt64;
+      arr[0]:=i;
+      Value:=JLObject(@arr);
+    end;
+
+
+  procedure tvarrec.init(q: qword; unsigned: boolean = true);
+    var
+      arr: array[0..0] of qword;
+    begin
+      init(int64(q));
+      { parameter could be false in case it's called from Java code }
+      if unsigned then
+        VType:=vtQWord;
+    end;
+
+
+  function tvarrec.VInteger: longint;
+    begin
+      result:=JLInteger(Value).intValue
+    end;
+
+
+  function tvarrec.VBoolean: boolean;
+    begin
+      result:=JLBoolean(Value).booleanValue;
+    end;
+
+
+  function tvarrec.VChar: ansichar;
+    begin
+      result:=char(JLByte(Value).byteValue);
+    end;
+
+
+  function tvarrec.VWideChar: widechar;
+    begin
+      result:=JLCharacter(Value).charValue;
+    end;
+
+
+  function tvarrec.VExtended: pextended;
+    begin
+      result:=PExtended(Value);
+    end;
+
+
+  function tvarrec.VDouble: double;
+    begin
+      result:=JLDouble(Value).doubleValue;
+    end;
+
+
+  function tvarrec.VString: PShortString;
+    begin
+      result:=PShortString(Value);
+    end;
+
+
+  function tvarrec.VPointer: pointer;
+    begin
+      result:=pointer(Value);
+    end;
+
+
+  function tvarrec.VPChar: PChar;
+    begin
+      result:=PChar(Value);
+    end;
+
+
+  function tvarrec.VObject: JLObject;
+    begin
+      result:=Value;
+    end;
+
+
+  function tvarrec.VClass: TJClass;
+    begin
+      result:=TJClass(Value);
+    end;
+
+
+  function tvarrec.VPWideChar: PWideChar;
+    begin
+      result:=PWideChar(Value);
+    end;
+
+
+  function tvarrec.VAnsiString: Pointer;
+    begin
+      result:=Pointer(Value);
+    end;
+
+
+  function tvarrec.VCurrency: PCurrency;
+    begin
+      result:=PCurrency(Value);
+    end;
+
+
+  // function tvarrec.VVariant: PVariant;
+
+
+  function tvarrec.VInterface: JLObject;
+    begin
+      result:=Value;
+    end;
+
+
+  function tvarrec.VWideString: Pointer;
+    begin
+      result:=Pointer(Value);
+    end;
+
+
+  function tvarrec.VInt64: PInt64;
+    begin
+      result:=PInt64(Value);
+    end;
+
+
+  function tvarrec.VUnicodeString: Pointer;
+     begin
+       result:=Pointer(Value);
+     end;
+
+
+  function tvarrec.VQWord: PQWord;
+    begin
+      result:=PQword(Value);
+    end;
+

rtl/java/objpash.inc

@@ -26,7 +26,9 @@ type
   end;
   TClass = class of TObject;
 
-   {$ifndef nounsupported}
+  TJClass = class of jlobject;
+
+
    const
       vtInteger       = 0;
       vtBoolean       = 1;
@@ -52,32 +54,51 @@ type
 
    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: JLObject);
-          vtPChar         : (VPChar: JLObject);
-          vtObject        : (VObject: TObject);
-          vtClass         : (VClass: TClass);
-          vtPWideChar     : (VPWideChar: JLObject);
-          vtAnsiString    : (VAnsiString: AnsiStringClass);
-          vtCurrency      : (VCurrency: Currency);
-   //       vtVariant       : (VVariant: PVariant);
-          vtInterface     : (VInterface: JLObject);
-          vtWideString    : (VWideString: JLString);
-          vtInt64         : (VInt64: Int64);
-          vtUnicodeString : (VUnicodeString: JLString);
-          vtQWord         : (VQWord: QWord);
+       VType: sizeint;
+       Value: JLObject;
+       procedure init(l: longint);
+       procedure init(b: boolean);
+       procedure init(c: ansichar);
+       procedure init(w: widechar);
+       procedure init(d: extended);
+       procedure init(const s: shortstring);
+       // pointer = object -> use constref to get different signature
+       procedure init(constref p: pointer);
+       procedure init(p: pchar);
+       procedure init(p: JLObject);
+       procedure init(c: TJClass);
+       procedure init(p: pwidechar);
+       procedure init(const a: ansistring);
+       // currency = int64 -> use constref to get different signature
+       procedure init(constref c: currency);
+       // procedure init(const v: variant);
+       // interface = object
+       procedure init(const w: widestring);
+       procedure init(i: int64);
+       // unicodestring = widestring
+
+       // qword = int64 -> extra parameter to solve signature problem
+       procedure init(q: qword; unsigned: boolean = true);
+
+       function VInteger: longint;
+       function VBoolean: boolean;
+       function VChar: ansichar;
+       function VWideChar: widechar;
+       function VExtended: PExtended;
+       function VDouble: double;
+       function VString: PShortString;
+       function VPointer: pointer;
+       function VPChar: PChar;
+       function VObject: JLObject;
+       function VClass: TJClass;
+       function VPWideChar: PWideChar;
+       function VAnsiString: Pointer;
+       function VCurrency: PCurrency;
+       // function VVariant: PVariant;
+       function VInterface: JLObject;
+       function VWideString: Pointer;
+       function VInt64: PInt64;
+       function VUnicodeString: Pointer;
+       function VQWord: PQWord;
       end;
-{$endif}
 

rtl/java/system.pp

@@ -27,6 +27,7 @@ Unit system;
 {$I-,Q-,H-,R-,V-,P+,T+}
 {$implicitexceptions off}
 {$mode objfpc}
+{$modeswitch advancedrecords}
 
 Type
   { Java primitive types }