+ support for (formal/untyped) constants (ordinal, floating point,

nil-pointers typecasted to a class type, strings)
   o escape ", \, #10 and #13 in string constants as required by Java

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

compiler/agjasmin.pas

@@ -53,11 +53,15 @@ interface
 
         function VisibilityToStr(vis: tvisibility): string;
         function MethodDefinition(pd: tprocdef): string;
+        function ConstValue(csym: tconstsym): ansistring;
+        function ConstAssignmentValue(csym: tconstsym): ansistring;
+        function ConstDefinition(sym: tconstsym): string;
         function FieldDefinition(sym: tabstractvarsym): string;
         function InnerObjDef(obj: tobjectdef): string;
 
         procedure WriteProcDef(pd: tprocdef);
         procedure WriteFieldSym(sym: tabstractvarsym);
+        procedure WriteConstSym(sym: tconstsym);
         procedure WriteSymtableVarSyms(st: TSymtable);
         procedure WriteSymtableProcdefs(st: TSymtable);
         procedure WriteSymtableObjectDefs(st: TSymtable);
@@ -96,7 +100,7 @@ implementation
       cutils,cfileutl,systems,script,
       fmodule,finput,verbose,
       symtype,symtable,jvmdef,
-      itcpujas,cpubase,cgutils,
+      itcpujas,cpubase,cpuinfo,cgutils,
       widestr
       ;
 
@@ -130,6 +134,114 @@ implementation
        fixline:=Copy(s,j,i-j+1);
      end;
 
+
+   function constastr(p: pchar; len: longint): ansistring;
+     var
+       i,runstart,runlen: longint;
+
+       procedure flush;
+         begin
+           if runlen>0 then
+             begin
+               setlength(result,length(result)+runlen);
+               move(p[runstart],result[length(result)-runlen+1],runlen);
+               runlen:=0;
+             end;
+         end;
+
+     begin
+       result:='"';
+       runlen:=0;
+       runstart:=0;
+       for i:=0 to len-1 do
+         begin
+           { escape control codes }
+           case p[i] of
+             { LF and CR must be escaped specially, because \uXXXX parsing
+               happens in the pre-processor, so it's the same as actually
+               inserting a newline in the middle of a string constant }
+             #10:
+               begin
+                 flush;
+                 result:=result+'\n';
+               end;
+             #13:
+               begin
+                 flush;
+                 result:=result+'\r';
+               end;
+             '"','\':
+               begin
+                 flush;
+                 result:=result+'\'+p[i];
+               end
+             else if p[i]<#32 then
+               begin
+                 flush;
+                 result:=result+'\u'+hexstr(ord(p[i]),4);
+               end
+             else if p[i]<#127 then
+               begin
+                 if runlen=0 then
+                   runstart:=i;
+                 inc(runlen);
+               end
+             else
+               // since Jasmin expects an UTF-16 string, we can't safely
+               // have high ASCII characters since they'll be
+               // re-interpreted as utf-16 anyway
+               internalerror(2010122808);
+           end;
+         end;
+       flush;
+       result:=result+'"';
+     end;
+
+
+   function constwstr(w: pcompilerwidechar; len: longint): ansistring;
+     var
+       i: longint;
+     begin
+       result:='"';
+       for i:=0 to len-1 do
+         begin
+           { escape control codes }
+           case w[i] of
+             10:
+               result:=result+'\n';
+             13:
+               result:=result+'\r';
+             ord('"'),ord('\'):
+               result:=result+'\'+chr(w[i]);
+             else if (w[i]<32) or
+                (w[i]>127) then
+               result:=result+'\u'+hexstr(w[i],4)
+             else
+               result:=result+char(w[i]);
+           end;
+         end;
+       result:=result+'"';
+     end;
+
+
+   function constsingle(s: single): string;
+     begin
+       result:='0fx'+hexstr(longint(t32bitarray(s)),8);
+     end;
+
+
+   function constdouble(d: double): string;
+      begin
+        // force interpretation as double (since we write it out as an
+        // integer, we never have to swap the endianess). We have to
+        // include the sign separately because of the way Java parses
+        // hex numbers (0x8000000000000000 is not a valid long)
+       result:=hexstr(abs(int64(t64bitarray(d))),16);
+       if int64(t64bitarray(d))<0 then
+         result:='-'+result;
+       result:='0dx'+result;
+      end;
+
 {****************************************************************************}
 {                       Jasmin Assembler writer                              }
 {****************************************************************************}
@@ -569,6 +681,72 @@ implementation
       end;
 
 
+    function TJasminAssembler.ConstValue(csym: tconstsym): ansistring;
+      begin
+        case csym.consttyp of
+          constord:
+            { always interpret as signed value, because the JVM does not
+              support unsigned 64 bit values }
+            result:=tostr(csym.value.valueord.svalue);
+          conststring:
+            result:=constastr(pchar(csym.value.valueptr),csym.value.len);
+          constreal:
+            case tfloatdef(csym.constdef).floattype of
+              s32real:
+                result:=constsingle(pbestreal(csym.value.valueptr)^);
+              s64real:
+                result:=constdouble(pbestreal(csym.value.valueptr)^);
+              else
+                internalerror(2011021204);
+              end;
+          constset:
+            result:='TODO: add support for constant sets';
+          constpointer:
+            { can only be null, but that's the default value and should not
+              be written; there's no primitive type that can hold nill }
+            internalerror(2011021201);
+          constnil:
+            internalerror(2011021202);
+          constresourcestring:
+            result:='TODO: add support for constant resource strings';
+          constwstring:
+            result:=constwstr(pcompilerwidestring(csym.value.valueptr)^.data,pcompilerwidestring(csym.value.valueptr)^.len);
+          constguid:
+            result:='TODO: add support for constant guids';
+          else
+            internalerror(2011021205);
+        end;
+      end;
+
+
+    function TJasminAssembler.ConstAssignmentValue(csym: tconstsym): ansistring;
+      begin
+        { nil is the default value -> don't write explicitly }
+        case csym.consttyp of
+          constpointer:
+            begin
+              if csym.value.valueordptr<>0 then
+                internalerror(2011021206);
+              result:='';
+            end;
+          constnil:
+            result:='';
+        else
+          result:=' = '+ConstValue(csym)
+        end;
+      end;
+
+
+    function TJasminAssembler.ConstDefinition(sym: tconstsym): string;
+      begin
+        result:=VisibilityToStr(sym.visibility);
+        { formal constants are always class-level, not instance-level }
+        result:=result+'static final ';
+        result:=result+jvmmangledbasename(sym);
+        result:=result+ConstAssignmentValue(tconstsym(sym));
+      end;
+
+
     function TJasminAssembler.FieldDefinition(sym: tabstractvarsym): string;
       var
         vissym: tabstractvarsym;
@@ -596,7 +774,7 @@ implementation
                 result:='';
             end;
           fieldvarsym:
-            result:=VisibilityToStr(tfieldvarsym(vissym).visibility);
+            result:=VisibilityToStr(tstoredsym(vissym).visibility);
           else
             internalerror(2011011204);
         end;
@@ -661,6 +839,13 @@ implementation
       end;
 
 
+    procedure TJasminAssembler.WriteConstSym(sym: tconstsym);
+      begin
+        AsmWrite('.field ');
+        AsmWriteln(ConstDefinition(sym));
+      end;
+
+
     procedure TJasminAssembler.WriteSymtableVarSyms(st: TSymtable);
       var
         sym : tsym;
@@ -677,6 +862,10 @@ implementation
                begin
                  WriteFieldSym(tabstractvarsym(sym));
                end;
+             constsym:
+               begin
+                 WriteConstSym(tconstsym(sym));
+               end;
            end;
          end;
       end;
@@ -822,7 +1011,6 @@ implementation
 
     function getopstr(const o:toper) : ansistring;
       var
-        i,runstart,runlen: longint;
         d: double;
         s: single;
       begin
@@ -840,69 +1028,19 @@ implementation
             getopstr:=getreferencestring(o.ref^);
           top_single:
             begin
-              s:=o.sval;
+              result:=constsingle(o.sval);
-              // force interpretation as single (since we write it out as an
-              // integer, we never have to swap the endianess).
-              result:='0fx'+hexstr(longint(t32bitarray(s)),8);
             end;
           top_double:
             begin
-              d:=o.dval;
+              result:=constdouble(o.dval);
-              // force interpretation as double (since we write it out as an
-              // integer, we never have to swap the endianess). We have to
-              // include the sign separately because of the way Java parses
-              // hex numbers (0x8000000000000000 is not a valid long)
-              result:=hexstr(abs(int64(t64bitarray(d))),16);
-              if int64(t64bitarray(d))<0 then
-                result:='-'+result;
-              result:='0dx'+result;
             end;
           top_string:
             begin
-              { escape control codes }
+              result:=constastr(o.pcval,o.pcvallen);
-              runlen:=0;
-              runstart:=0;
-              for i:=1 to o.pcvallen do
-                begin
-                  if o.pcval[i]<#32 then
-                    begin
-                      if runlen>0 then
-                        begin
-                          setlength(result,length(result)+runlen);
-                          move(result[length(result)-runlen],o.pcval[runstart],runlen);
-                          runlen:=0;
-                        end;
-                      result:=result+'\u'+hexstr(ord(o.pcval[i]),4);
-                    end
-                  else if o.pcval[i]<#127 then
-                    begin
-                      if runlen=0 then
-                        runstart:=i;
-                      inc(runlen);
-                    end
-                  else
-                    // since Jasmin expects an UTF-16 string, we can't safely
-                    // have high ASCII characters since they'll be
-                    // re-interpreted as utf-16 anyway
-                    internalerror(2010122808);
-                end;
-              if runlen>0 then
-                begin
-                  setlength(result,length(result)+runlen);
-                  move(result[length(result)-runlen],o.pcval[runstart],runlen);
-                end;
             end;
           top_wstring:
             begin
-              { escape control codes }
+              result:=constwstr(o.pwstrval^.data,getlengthwidestring(o.pwstrval));
-              for i:=1 to getlengthwidestring(o.pwstrval) do
-                begin
-                  if (o.pwstrval^.data[i]<32) or
-                     (o.pwstrval^.data[i]>127) then
-                    result:=result+'\u'+hexstr(o.pwstrval^.data[i],4)
-                  else
-                    result:=result+char(o.pwstrval^.data[i]);
-                end;
             end
           else
             internalerror(2010122802);

compiler/jvm/aasmcpu.pas

@@ -201,7 +201,7 @@ implementation
            clearop(opidx);
            pcvallen:=vallen;
            getmem(pcval,vallen);
-           move(pcval^,pc^,vallen);
+           move(pc^,pcval^,vallen);
            typ:=top_string;
          end;
       end;