+ jvm (cpu architecure) and java ("OS"/target) identifiers

  + basic target information for jvm target (assembling/linking
    helpers are still dummies for now)
  + basic jasmin assembler writer
  + cpunode and cputarg units to include the target units in the
    compiler

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

.gitattributes

@@ -11,6 +11,7 @@ compiler/aasmdata.pas svneol=native#text/plain
 compiler/aasmsym.pas svneol=native#text/plain
 compiler/aasmtai.pas svneol=native#text/plain
 compiler/aggas.pas svneol=native#text/plain
+compiler/agjasmin.pas svneol=native#text/plain
 compiler/alpha/aasmcpu.pas svneol=native#text/plain
 compiler/alpha/agaxpgas.pas svneol=native#text/plain
 compiler/alpha/aoptcpu.pas svneol=native#text/plain
@@ -210,9 +211,12 @@ compiler/jvm/aasmcpu.pas svneol=native#text/plain
 compiler/jvm/cgcpu.pas svneol=native#text/plain
 compiler/jvm/cpubase.pas svneol=native#text/plain
 compiler/jvm/cpuinfo.pas svneol=native#text/plain
+compiler/jvm/cpunode.pas svneol=native#text/plain
 compiler/jvm/cpupara.pas svneol=native#text/plain
 compiler/jvm/cpupi.pas svneol=native#text/plain
+compiler/jvm/cputarg.pas svneol=native#text/plain
 compiler/jvm/hlcgcpu.pas svneol=native#text/plain
+compiler/jvm/itcpujas.pas svneol=native#text/plain
 compiler/jvm/jvmreg.dat svneol=native#text/plain
 compiler/jvm/rjvmcon.inc svneol=native#text/plain
 compiler/jvm/rjvmnor.inc svneol=native#text/plain
@@ -553,6 +557,7 @@ compiler/systems/i_emx.pas svneol=native#text/plain
 compiler/systems/i_gba.pas svneol=native#text/plain
 compiler/systems/i_go32v2.pas svneol=native#text/plain
 compiler/systems/i_haiku.pas svneol=native#text/plain
+compiler/systems/i_jvm.pas svneol=native#text/plain
 compiler/systems/i_linux.pas svneol=native#text/plain
 compiler/systems/i_macos.pas svneol=native#text/plain
 compiler/systems/i_morph.pas svneol=native#text/plain
@@ -578,6 +583,7 @@ compiler/systems/t_emx.pas svneol=native#text/plain
 compiler/systems/t_gba.pas svneol=native#text/plain
 compiler/systems/t_go32v2.pas svneol=native#text/plain
 compiler/systems/t_haiku.pas svneol=native#text/plain
+compiler/systems/t_jvm.pas svneol=native#text/plain
 compiler/systems/t_linux.pas svneol=native#text/plain
 compiler/systems/t_macos.pas svneol=native#text/plain
 compiler/systems/t_morph.pas svneol=native#text/plain

compiler/agjasmin.pas

@@ -0,0 +1,625 @@
+{
+    Copyright (c) 1998-2010 by the Free Pascal team
+
+    This unit implements the Jasmin assembler writer
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{ Unit for writing Jasmin assembler (JVM bytecode) output.
+}
+unit agjasmin;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      cclasses,
+      globtype,globals,
+      symbase,symdef,
+      aasmbase,aasmtai,aasmdata,aasmcpu,
+      assemble;
+
+    type
+      TJasminInstrWriter = class;
+      {# This is a derived class which is used to write
+         Jasmin-styled assembler.
+      }
+
+      { TJasminAssembler }
+
+      TJasminAssembler=class(texternalassembler)
+       protected
+        procedure WriteExtraHeader;virtual;
+        procedure WriteInstruction(hp: tai);
+        procedure WriteProcDef(pd: tprocdef);
+        procedure WriteSymtableProcdefs(st: TSymtable);
+       public
+        constructor Create(smart: boolean); override;
+        procedure WriteTree(p:TAsmList);override;
+        procedure WriteAsmList;override;
+        destructor destroy; override;
+       protected
+        InstrWriter: TJasminInstrWriter;
+      end;
+
+
+      {# This is the base class for writing instructions.
+
+         The WriteInstruction() method must be overridden
+         to write a single instruction to the assembler
+         file.
+      }
+
+      { TJasminInstrWriter }
+
+      TJasminInstrWriter = class
+        constructor create(_owner: TJasminAssembler);
+        procedure WriteInstruction(hp : tai); virtual;
+       protected
+        owner: TJasminAssembler;
+      end;
+
+
+implementation
+
+    uses
+      SysUtils,
+      cutils,cfileutl,systems,
+      fmodule,finput,verbose,
+      symconst,symtype,
+      itcpujas,cpubase,cgutils,
+      widestr
+      ;
+
+    const
+      line_length = 70;
+
+    type
+      t64bitarray = array[0..7] of byte;
+      t32bitarray = array[0..3] of byte;
+
+{****************************************************************************}
+{                          Support routines                                  }
+{****************************************************************************}
+
+   function fixline(s:string):string;
+   {
+     return s with all leading and ending spaces and tabs removed
+   }
+     var
+       i,j,k : integer;
+     begin
+       i:=length(s);
+       while (i>0) and (s[i] in [#9,' ']) do
+        dec(i);
+       j:=1;
+       while (j<i) and (s[j] in [#9,' ']) do
+        inc(j);
+       for k:=j to i do
+        if s[k] in [#0..#31,#127..#255] then
+         s[k]:='.';
+       fixline:=Copy(s,j,i-j+1);
+     end;
+
+{****************************************************************************}
+{                       Jasmin Assembler writer                              }
+{****************************************************************************}
+
+    destructor TJasminAssembler.Destroy;
+      begin
+        InstrWriter.free;
+        inherited destroy;
+      end;
+
+
+    procedure TJasminAssembler.WriteTree(p:TAsmList);
+      var
+        ch       : char;
+        hp       : tai;
+        hp1      : tailineinfo;
+        constdef : taiconst_type;
+        s,t      : string;
+        i,pos,l  : longint;
+        InlineLevel : longint;
+        last_align : longint;
+        co       : comp;
+        sin      : single;
+        d        : double;
+        do_line  : boolean;
+
+        sepChar : char;
+      begin
+        if not assigned(p) then
+         exit;
+
+        last_align := 2;
+        InlineLevel:=0;
+        { lineinfo is only needed for al_procedures (PFV) }
+        do_line:=(cs_asm_source in current_settings.globalswitches) or
+                 ((cs_lineinfo in current_settings.moduleswitches)
+                   and (p=current_asmdata.asmlists[al_procedures]));
+        hp:=tai(p.first);
+        while assigned(hp) do
+         begin
+           prefetch(pointer(hp.next)^);
+           if not(hp.typ in SkipLineInfo) then
+            begin
+              hp1 := hp as tailineinfo;
+              current_filepos:=hp1.fileinfo;
+               { no line info for inlined code }
+               if do_line and (inlinelevel=0) then
+                begin
+                  { load infile }
+                  if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
+                   begin
+                     infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
+                     if assigned(infile) then
+                      begin
+                        { open only if needed !! }
+                        if (cs_asm_source in current_settings.globalswitches) then
+                         infile.open;
+                      end;
+                     { avoid unnecessary reopens of the same file !! }
+                     lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
+                     { be sure to change line !! }
+                     lastfileinfo.line:=-1;
+                   end;
+                { write source }
+                  if (cs_asm_source in current_settings.globalswitches) and
+                     assigned(infile) then
+                   begin
+                     if (infile<>lastinfile) then
+                       begin
+                         AsmWriteLn(target_asm.comment+'['+infile.name^+']');
+                         if assigned(lastinfile) then
+                           lastinfile.close;
+                       end;
+                     if (hp1.fileinfo.line<>lastfileinfo.line) and
+                        ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
+                       begin
+                         if (hp1.fileinfo.line<>0) and
+                            ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
+                           AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
+                             fixline(infile.GetLineStr(hp1.fileinfo.line)));
+                         { set it to a negative value !
+                         to make that is has been read already !! PM }
+                         if (infile.linebuf^[hp1.fileinfo.line]>=0) then
+                           infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
+                       end;
+                   end;
+                  lastfileinfo:=hp1.fileinfo;
+                  lastinfile:=infile;
+                end;
+            end;
+
+           case hp.typ of
+
+             ait_comment :
+               Begin
+                 AsmWrite(target_asm.comment);
+                 AsmWritePChar(tai_comment(hp).str);
+                 AsmLn;
+               End;
+
+             ait_regalloc :
+               begin
+                 if (cs_asm_regalloc in current_settings.globalswitches) then
+                   begin
+                     AsmWrite(#9+target_asm.comment+'Register ');
+                     repeat
+                       AsmWrite(std_regname(Tai_regalloc(hp).reg));
+                       if (hp.next=nil) or
+                          (tai(hp.next).typ<>ait_regalloc) or
+                          (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
+                         break;
+                       hp:=tai(hp.next);
+                       AsmWrite(',');
+                     until false;
+                     AsmWrite(' ');
+                     AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
+                   end;
+               end;
+
+             ait_tempalloc :
+               begin
+                 if (cs_asm_tempalloc in current_settings.globalswitches) then
+                   begin
+  {$ifdef EXTDEBUG}
+                     if assigned(tai_tempalloc(hp).problem) then
+                       AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
+                         tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^)
+                     else
+  {$endif EXTDEBUG}
+                       AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
+                         tostr(tai_tempalloc(hp).tempsize)+' '+tempallocstr[tai_tempalloc(hp).allocation]);
+                   end;
+               end;
+
+             ait_align :
+               begin
+
+               end;
+
+             ait_section :
+               begin
+
+               end;
+
+             ait_datablock :
+               begin
+                 internalerror(2010122701);
+               end;
+
+             ait_const:
+               begin
+                 AsmWriteln('constant');
+//                 internalerror(2010122702);
+               end;
+
+             ait_real_64bit :
+               begin
+                 internalerror(2010122703);
+               end;
+
+             ait_real_32bit :
+               begin
+                 internalerror(2010122703);
+               end;
+
+             ait_comp_64bit :
+               begin
+                 internalerror(2010122704);
+               end;
+
+             ait_string :
+               begin
+                 pos:=0;
+                  for i:=1 to tai_string(hp).len do
+                   begin
+                     if pos=0 then
+                      begin
+                        AsmWrite(#9'strconst: '#9'"');
+                        pos:=20;
+                      end;
+                     ch:=tai_string(hp).str[i-1];
+                     case ch of
+                        #0, {This can't be done by range, because a bug in FPC}
+                   #1..#31,
+                #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
+                       '"' : s:='\"';
+                       '\' : s:='\\';
+                     else
+                      s:=ch;
+                     end;
+                     AsmWrite(s);
+                     inc(pos,length(s));
+                     if (pos>line_length) or (i=tai_string(hp).len) then
+                      begin
+                        AsmWriteLn('"');
+                        pos:=0;
+                      end;
+                   end;
+               end;
+
+             ait_label :
+               begin
+                 if (tai_label(hp).labsym.is_used) then
+                  begin
+                    AsmWrite(tai_label(hp).labsym.name);
+                    AsmWriteLn(':');
+                  end;
+               end;
+
+             ait_symbol :
+               begin
+                  if (tai_symbol(hp).sym.typ = AT_FUNCTION) then
+                    begin
+                      AsmWrite('.method ');
+                      AsmWriteLn(tai_symbol(hp).sym.name);
+                    end
+                  else
+                   begin
+                     AsmWrite('data symbol: ');
+                     AsmWriteln(tai_symbol(hp).sym.name);
+//                     internalerror(2010122706);
+                   end;
+               end;
+             ait_symbol_end :
+               begin
+                 AsmWriteLn('.end method');
+                 AsmLn;
+               end;
+
+             ait_instruction :
+               begin
+                 WriteInstruction(hp);
+               end;
+
+             ait_force_line,
+             ait_function_name : ;
+
+             ait_cutobject :
+               begin
+               end;
+
+             ait_marker :
+               if tai_marker(hp).kind=mark_NoLineInfoStart then
+                 inc(InlineLevel)
+               else if tai_marker(hp).kind=mark_NoLineInfoEnd then
+                 dec(InlineLevel);
+
+             ait_directive :
+               begin
+                 AsmWrite('.'+directivestr[tai_directive(hp).directive]+' ');
+                 if assigned(tai_directive(hp).name) then
+                   AsmWrite(tai_directive(hp).name^);
+                 AsmLn;
+               end;
+
+             else
+               internalerror(2010122707);
+           end;
+           hp:=tai(hp.next);
+         end;
+      end;
+
+
+    procedure TJasminAssembler.WriteExtraHeader;
+      begin
+      end;
+
+
+    procedure TJasminAssembler.WriteInstruction(hp: tai);
+      begin
+        InstrWriter.WriteInstruction(hp);
+      end;
+
+
+    procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
+      begin
+        WriteTree(pd.exprasmlist);
+      end;
+
+    procedure TJasminAssembler.WriteSymtableProcdefs(st: TSymtable);
+      var
+        i   : longint;
+        def : tdef;
+      begin
+        if not assigned(st) then
+          exit;
+        for i:=0 to st.DefList.Count-1 do
+          begin
+            def:=tdef(st.DefList[i]);
+            case def.typ of
+              procdef :
+                begin
+                  WriteProcDef(tprocdef(def));
+                  if assigned(tprocdef(def).localst) then
+                    WriteSymtableProcdefs(tprocdef(def).localst);
+                end;
+            end;
+          end;
+      end;
+
+
+    constructor TJasminAssembler.Create(smart: boolean);
+      begin
+        inherited create(smart);
+        InstrWriter:=TJasminInstrWriter.Create(self);
+      end;
+
+
+    procedure TJasminAssembler.WriteAsmList;
+    var
+      n : string;
+      hal : tasmlisttype;
+      i: longint;
+    begin
+{$ifdef EXTDEBUG}
+      if assigned(current_module.mainsource) then
+       Comment(V_Debug,'Start writing Jasmin-styled assembler output for '+current_module.mainsource^);
+{$endif}
+
+      if assigned(current_module.mainsource) then
+        n:=ExtractFileName(current_module.mainsource^)
+      else
+        n:=InputFileName;
+
+      { JVM 1.5+ }
+      AsmWriteLn('.bytecode 49.0');
+      // include files are not support by Java, and the directory of the main
+      // source file must not be specified
+      AsmWriteLn('.source '+ExtractFileName(n));
+      // TODO: actual class
+      AsmWriteLn('.class '+ChangeFileExt(ExtractFileName(n),''));
+      // TODO: real superclass
+      AsmWriteLn('.super java/lang/Object');
+      AsmLn;
+
+      WriteExtraHeader;
+      AsmStartSize:=AsmSize;
+(*
+      for hal:=low(TasmlistType) to high(TasmlistType) do
+        begin
+          AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]);
+          writetree(current_asmdata.asmlists[hal]);
+          AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]);
+        end;
+*)
+      { print all global procedures/functions }
+      WriteSymtableProcdefs(current_module.globalsymtable);
+      WriteSymtableProcdefs(current_module.localsymtable);
+
+      AsmLn;
+{$ifdef EXTDEBUG}
+      if assigned(current_module.mainsource) then
+       Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource^);
+{$endif EXTDEBUG}
+    end;
+
+{****************************************************************************}
+{                         Jasmin Instruction Writer                          }
+{****************************************************************************}
+
+     constructor TJasminInstrWriter.create(_owner: TJasminAssembler);
+       begin
+         inherited create;
+         owner := _owner;
+       end;
+
+    function getreferencestring(var ref : treference) : string;
+      begin
+        if (ref.arrayreftype<>art_none) or
+           (ref.index<>NR_NO) then
+          internalerror(2010122809);
+        if assigned(ref.symbol) then
+          begin
+            // global symbol -> full type/name
+            if (ref.base<>NR_NO) or
+               (ref.offset<>0) then
+              internalerror(2010122811);
+            result:=ref.symbol.name;
+          end
+        else
+          begin
+            // local symbol -> stack slot, stored in offset
+            if ref.base<>NR_STACK_POINTER_REG then
+              internalerror(2010122810);
+            result:=tostr(ref.offset);
+          end;
+      end;
+
+
+    function getopstr(const o:toper) : ansistring;
+      var
+        i,runstart,runlen: longint;
+        num: string[4];
+      begin
+        case o.typ of
+          top_reg:
+            // should have been translated into a memory location by the
+            // register allocator)
+            if (cs_no_regalloc in current_settings.globalswitches) then
+              getopstr:=std_regname(o.reg)
+            else
+              internalerror(2010122803);
+          top_const:
+            str(o.val,result);
+          top_ref:
+            getopstr:=getreferencestring(o.ref^);
+          top_single:
+            str(o.sval:0:20,result);
+          top_double:
+            begin
+              str(o.dval:0:20,result);
+              // force interpretation as double
+              result:=result+'d';
+            end;
+          top_string:
+            begin
+              { escape control codes }
+              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 }
+              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);
+        end;
+      end;
+
+
+    procedure TJasminInstrWriter.WriteInstruction(hp: tai);
+      var
+        s: ansistring;
+        i: byte;
+        sep: string[3];
+      begin
+        s:=#9+jas_op2str[taicpu(hp).opcode];
+        if taicpu(hp).ops<>0 then
+          begin
+            sep:=#9;
+            for i:=0 to taicpu(hp).ops-1 do
+              begin
+                 s:=s+sep+getopstr(taicpu(hp).oper[i]^);
+                 sep:=',';
+              end;
+          end;
+        owner.AsmWriteLn(s);
+      end;
+
+{****************************************************************************}
+{                         Jasmin Instruction Writer                          }
+{****************************************************************************}
+
+  const
+    as_jvm_jasmin_info : tasminfo =
+       (
+         id     : as_jvm_jasmin;
+         idtxt  : 'Jasmin';
+         asmbin : 'java';
+         asmcmd : '-jar jasmin.jar $ASM';
+         supported_targets : [system_jvm_java32];
+         flags : [];
+         labelprefix : 'L';
+         comment : ' ; ';
+       );
+
+
+begin
+  RegisterAssembler(as_jvm_jasmin_info,TJasminAssembler);
+end.

compiler/jvm/cpunode.pas

@@ -0,0 +1,39 @@
+{******************************************************************************
+    Copyright (c) 2000-2010 by Florian Klaempfl and Jonas Maebe
+
+    Includes the JVM code generator
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ *****************************************************************************}
+unit cpunode;
+
+{$I fpcdefs.inc}
+
+interface
+{ This unit is used to define the specific CPU implementations. All needed
+actions are included in the INITALIZATION part of these units. This explains
+the behaviour of such a unit having just a USES clause! }
+
+implementation
+
+  uses
+    ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset,
+    ncgadd, ncgcal,ncgmat,ncginl
+{    ncpuadd,ncpucall,ncpumat,ncpuinln,ncpucnv,ncpuset, }
+    { this not really a node }
+{    rgcpu},tgcpu;
+
+end.

compiler/jvm/cputarg.pas

@@ -0,0 +1,66 @@
+{
+    Copyright (c) 2001-2010 by Peter Vreman and Jonas Maebe
+
+    Includes the JVM dependent target units
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit cputarg;
+
+{$i fpcdefs.inc}
+
+interface
+
+
+implementation
+
+    uses
+      systems { prevent a syntax error when nothing is included }
+
+{$ifndef NOOPT}
+//      ,aoptcpu
+{$endif NOOPT}
+
+{**************************************
+             Targets
+**************************************}
+
+    {$ifndef NOTARGETSUNOS}
+      ,t_jvm
+    {$endif}
+
+{**************************************
+             Assemblers
+**************************************}
+
+      ,agjasmin
+
+{**************************************
+        Assembler Readers
+**************************************}
+
+{**************************************
+             Debuginfo
+**************************************}
+
+  {$ifdef Dbgjvm}
+      ,dbgjvm
+  {$endif Dbgjvm}
+
+      ;
+
+end.

compiler/jvm/itcpujas.pas

@@ -0,0 +1,99 @@
+{
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit contains the JVM Jasmin instruction tables
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit itcpujas;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      cpubase,cgbase;
+
+    const
+      jas_op2str : array[tasmop] of string[15] = ('<none>',
+        'aaload', 'aastore', 'aconst_null',
+        'aload', 'aload_0', 'aload_1', 'aload_2', 'aload_3',
+        'anewarray', 'areturn', 'arraylength',
+        'astore', 'astore_0', 'astore_1', 'astore_2', 'astore_3',
+        'athrow', 'baload', 'bastore', 'bipush', 'breakpoint',
+        'caload', 'castore', 'checkcast',
+        'd2f', 'd2i', 'd2l', 'dadd', 'daload', 'dastore', 'dcmpg', 'dcmpl',
+        'dconst_0', 'dconst_1', 'ddiv',
+        'dload', 'dload_0', 'dload_1', 'dload_2', 'dload_3',
+        'dmul', 'dneg', 'drem', 'dreturn',
+        'dstore', 'dstore_0', 'dstore_1', 'dstore_2', 'dstore_3',
+        'dsub',
+        'dup', 'dup2', 'dup2_x1', 'dup2_x2', 'dup_x1', 'dup_x2',
+        'f2d', 'f2i', 'f2l', 'fadd', 'faload', 'fastore', 'fcmpg', 'fcmpl',
+        'fconst_0', 'fconst_1', 'fconst_2', 'fdiv',
+        'fload', 'fload_0', 'fload_1', 'fload_2', 'fload_3',
+        'fmul', 'fneg', 'frem', 'freturn',
+        'fstore', 'fstore_0', 'fstore_1', 'fstore_2', 'fstore_3',
+        'fsub',
+        'getfield', 'getstatic',
+        'goto', 'goto_w',
+        'i2b', 'i2c', 'i2d', 'i2f', 'i2l', 'i2s',
+        'iadd', 'iaload', 'iand', 'iastore',
+        'iconst_m1', 'iconst_0', 'iconst_1', 'iconst_2', 'iconst_3',
+        'iconst_4', 'iconst_5',
+        'idiv',
+        'if_acmpeq', 'if_acmpne', 'if_icmpeq', 'if_icmpge', 'if_icmpgt',
+        'if_icmple', 'if_icmplt', 'if_icmpne',
+        'ifeq', 'ifge', 'ifgt', 'ifle', 'iflt', 'ifne', 'ifnonnull', 'ifnull',
+        'iinc',
+        'iload', 'iload_0', 'iload_1', 'iload_2', 'iload_3',
+        'imul', 'ineg',
+        'instanceof',
+        'invokeinterface', 'invokespecial', 'invokestatic', 'invokevirtual',
+        'ior', 'irem', 'ireturn', 'ishl', 'ishr',
+        'istore', 'istore_0', 'istore_1', 'istore_2', 'istore_3',
+        'isub', 'iushr', 'ixor',
+        'jsr', 'jsr_w',
+        'l2d', 'l2f', 'l2i', 'ladd', 'laload', 'land', 'lastore', 'lcmp',
+        'lconst_0', 'lconst_1',
+        'ldc', 'ldc2_w', 'ldc_w', 'ldiv',
+        'lload', 'lload_0', 'lload_1', 'lload_2', 'lload_3',
+        'lmul', 'lneg',
+        'lookupswitch',
+        'lor', 'lrem',
+        'lreturn',
+        'lshl', 'lshr',
+        'lstore', 'lstore_0', 'lstore_1', 'lstore_2', 'lstore_3',
+        'lsub', 'lushr', 'lxor',
+        'monitorenter',
+        'monitorexit',
+        'multianewarray',
+        'new',
+        'newarray',
+        'nop',
+        'pop', 'pop2',
+        'putfield', 'putstatic',
+        'ret', 'return',
+        'saload', 'sastore', 'sipush',
+        'swap',
+        'tableswitch',
+        'wide'
+      );
+
+implementation
+
+end.

compiler/ppu.pas

@@ -327,7 +327,8 @@ const
     { 10 } 32 {'arm'},
     { 11 } 64 {'powerpc64'},
     { 12 } 16 {'avr'},
-    { 13 } 32 {'mipsel'}
+    { 13 } 32 {'mipsel'},
+    { 14 } 32 {'jvm'}
     );
   CpuAluBitSize : array[tsystemcpu] of longint =
     (
@@ -344,7 +345,8 @@ const
     { 10 } 32 {'arm'},
     { 11 } 64 {'powerpc64'},
     { 12 }  8 {'avr'},
-    { 13 } 32 {'mipsel'}
+    { 13 } 32 {'mipsel'},
+    { 14 } 64 {'jvm'}
     );
 {$endif generic_cpu}
 

compiler/systems.inc

@@ -47,7 +47,8 @@
              cpu_arm,                      { 10 }
              cpu_powerpc64,                { 11 }
              cpu_avr,                      { 12 }
-             cpu_mipsel                    { 13 }
+             cpu_mipsel,                   { 13 }
+             cpu_jvm                       { 14 }
        );
 
        tasmmode= (asmmode_none
@@ -146,7 +147,8 @@
              system_mipsel_linux,       { 67 }
              system_i386_nativent,      { 68 }
              system_i386_iphonesim,     { 69 }
-             system_powerpc_wii         { 70 }
+             system_powerpc_wii,        { 70 }
+             system_jvm_java32          { 71 }
        );
 
      type
@@ -180,6 +182,7 @@
              ,as_i386_nasmhaiku
              ,as_powerpc_vasm
              ,as_i386_nlmcoff
+             ,as_jvm_jasmin
        );
 
        tar = (ar_none

compiler/systems.pas

@@ -168,8 +168,8 @@ interface
           smartext,
           unitext,
           unitlibext,
-          asmext,
-          objext,
+          asmext       : string[4];
+          objext       : string[6];
           resext       : string[4];
           resobjext    : string[7];
           sharedlibext : string[10];
@@ -237,7 +237,8 @@ interface
                            system_sparc_embedded,system_vm_embedded,
                            system_iA64_embedded,system_x86_64_embedded,
                            system_mips_embedded,system_arm_embedded,
-                           system_powerpc64_embedded,system_avr_embedded];
+                           system_powerpc64_embedded,system_avr_embedded,
+                           system_jvm_java32];
 
        { all systems that allow section directive }
        systems_allow_section = systems_embedded;
@@ -302,7 +303,7 @@ interface
 
        cpu2str : array[TSystemCpu] of string[10] =
             ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64',
-             'mips','arm', 'powerpc64', 'avr', 'mipsel');
+             'mips','arm', 'powerpc64', 'avr', 'mipsel','jvm');
 
        abi2str : array[tabi] of string[10] =
          ('DEFAULT','SYSV','AIX','EABI','ARMEB');
@@ -849,6 +850,10 @@ begin
   default_target(system_mips_linux);
 {$endif mipsel}
 {$endif mips}
+
+{$ifdef jvm}
+  default_target(system_jvm_java32);
+{$endif jvm}
 end;
 
 

compiler/systems/i_jvm.pas

@@ -0,0 +1,102 @@
+{
+    Copyright (c) 2010 by Jonas Maebe
+
+    This unit implements support information structures for FreeBSD/NetBSD,
+    OpenBSD and Darwin (Mac OS X)
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+
+unit i_jvm;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       systems;
+
+    const
+       { The 32 only means that code written for this target behaves
+         semantically as if it were written for a 32 bit target (default
+         integer evaluation width = 32 bit). It will work equally well on 32
+         bit and 64 bit JVM implementations. }
+       system_jvm_java32_info : tsysteminfo =
+          (
+            system       : system_jvm_java32;
+            name         : 'Java Virtual Machine';
+            shortname    : 'Java';
+            flags        : [tf_files_case_sensitive,
+                            { avoid the creation of threadvar tables }
+                            tf_section_threadvars];
+            cpu          : cpu_jvm;
+            unit_env     : '';
+            extradefines : '';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.j';
+            objext       : '.class';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.jar';
+            staticlibext : '.jar';
+            staticlibprefix : '';
+            sharedlibprefix : '';
+            sharedClibext : '.jar';
+            staticClibext : '.jar';
+            staticClibprefix : '';
+            sharedClibprefix : '';
+            importlibprefix : '';
+            importlibext : '.jar';
+            Cprefix      : '';
+            newline      : #10;
+            dirsep       : '/';
+            assem        : as_jvm_jasmin;
+            assemextern  : as_jvm_jasmin;
+            link         : nil;
+            linkextern   : nil;
+            ar           : ar_none;
+            res          : res_none;
+            dbg          : dbg_none;
+            script       : script_unix;
+            endian       : endian_big;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 4;
+                jumpalign       : 0;
+                constalignmin   : 0;
+                constalignmax   : 4;
+                varalignmin     : 4;
+                varalignmax     : 4;
+                localalignmin   : 4;
+                localalignmax   : 4;
+                recordalignmin  : 0;
+                recordalignmax  : 2;
+                maxCrecordalign : 4
+              );
+            first_parm_offset : 0;
+            stacksize   : 262144;
+            abi          : abi_default;
+          );
+
+  implementation
+
+end.

compiler/systems/t_jvm.pas

@@ -0,0 +1,101 @@
+{
+    Copyright (c) 2010 by Jonas Maebe
+
+    This unit implements support import,export,link routines
+    for the JVM target
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit t_jvm;
+
+{$i fpcdefs.inc}
+
+interface
+
+
+implementation
+
+  uses
+    sysutils,
+    cutils,cfileutl,cclasses,
+    verbose,systems,globtype,globals,
+    symconst,script,
+    fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,
+    import,export,link,comprsrc,rescmn,i_jvm,
+    cgutils,cgbase,cgobj,cpuinfo,ogbase;
+
+  type
+    timportlibjvm=class(timportlib)
+      procedure generatelib;override;
+    end;
+
+    texportlibjvm=class(texportlib)
+    end;
+
+    tlinkerjvm=class(texternallinker)
+      constructor Create;override;
+      function  MakeExecutable:boolean;override;
+      function  MakeSharedLibrary:boolean;override;
+    end;
+
+
+
+{*****************************************************************************
+                             TIMPORTLIBJVM
+*****************************************************************************}
+
+    procedure timportlibjvm.generatelib;
+      begin
+      end;
+
+
+{*****************************************************************************
+                             TEXPORTLIBJVM
+*****************************************************************************}
+
+{*****************************************************************************
+                              TLINKERJVM
+*****************************************************************************}
+
+Constructor  tlinkerjvm.Create;
+begin
+  Inherited Create;
+end;
+
+
+function  tlinkerjvm.MakeExecutable:boolean;
+begin
+  result:=true;
+end;
+
+
+Function  tlinkerjvm.MakeSharedLibrary:boolean;
+begin
+  result:=false;
+end;
+
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+initialization
+  RegisterExternalLinker(system_jvm_java32_info, tlinkerjvm);
+  RegisterImport(system_jvm_java32,timportlibjvm);
+  RegisterExport(system_jvm_java32,texportlibjvm);
+  RegisterTarget(system_jvm_java32_info);
+end.