paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 00:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
+ 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 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:37:33 +00:00
parent 742f4ee12e
commit 1e2c70796e
10 changed files with 1056 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitattributes vendored
View File

@ -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

625
compiler/agjasmin.pas Normal file
View File

@ -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.

39
compiler/jvm/cpunode.pas Normal file
View File

@ -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.

66
compiler/jvm/cputarg.pas Normal file
View File

@ -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.

99
compiler/jvm/itcpujas.pas Normal file
View File

@ -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.

6
compiler/ppu.pas
View File

@ -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}

7
compiler/systems.inc
View File

@ -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

13
compiler/systems.pas
View File

@ -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;

102
compiler/systems/i_jvm.pas Normal file
View File

@ -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.

101
compiler/systems/t_jvm.pas Normal file
View File

@ -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.