mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 10:49:31 +02:00
737f9f5e90
function, so it can be easily also used for constsym without adding
JVM-specific routines to symtype or duplicating the routine without
inheritance
+ added tconstsym support to jvmdef.jvmmangledbasename()
git-svn-id: branches/jvmbackend@18390 -
953 lines
31 KiB
ObjectPascal
953 lines
31 KiB
ObjectPascal
{
|
|
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,
|
|
symconst,symbase,symdef,symsym,
|
|
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
|
|
jasminjar: tcmdstr;
|
|
asmfiles: TCmdStrList;
|
|
|
|
procedure WriteExtraHeader(obj: tobjectdef);
|
|
procedure WriteInstruction(hp: tai);
|
|
procedure NewAsmFileForObjectDef(obj: tobjectdef);
|
|
|
|
function VisibilityToStr(vis: tvisibility): string;
|
|
function MethodDefinition(pd: tprocdef): string;
|
|
function FieldDefinition(sym: tabstractvarsym): string;
|
|
function InnerObjDef(obj: tobjectdef): string;
|
|
|
|
procedure WriteProcDef(pd: tprocdef);
|
|
procedure WriteFieldSym(sym: tabstractvarsym);
|
|
procedure WriteSymtableVarSyms(st: TSymtable);
|
|
procedure WriteSymtableProcdefs(st: TSymtable);
|
|
procedure WriteSymtableObjectDefs(st: TSymtable);
|
|
public
|
|
constructor Create(smart: boolean); override;
|
|
function MakeCmdLine: TCmdStr;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,script,
|
|
fmodule,finput,verbose,
|
|
symtype,symtable,jvmdef,
|
|
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;
|
|
asmfiles.free;
|
|
inherited destroy;
|
|
end;
|
|
|
|
|
|
procedure TJasminAssembler.WriteTree(p:TAsmList);
|
|
var
|
|
ch : char;
|
|
hp : tai;
|
|
hp1 : tailineinfo;
|
|
s : string;
|
|
i,pos : longint;
|
|
InlineLevel : longint;
|
|
do_line : boolean;
|
|
begin
|
|
if not assigned(p) then
|
|
exit;
|
|
|
|
InlineLevel:=0;
|
|
{ lineinfo is only needed for al_procedures (PFV) }
|
|
do_line:=(cs_asm_source in current_settings.globalswitches);
|
|
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
|
|
end
|
|
else
|
|
begin
|
|
AsmWrite('data symbol: ');
|
|
AsmWriteln(tai_symbol(hp).sym.name);
|
|
// internalerror(2010122706);
|
|
end;
|
|
end;
|
|
ait_symbol_end :
|
|
begin
|
|
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;
|
|
|
|
ait_jvar:
|
|
begin
|
|
AsmWrite('.var ');
|
|
AsmWrite(tostr(tai_jvar(hp).stackslot));
|
|
AsmWrite(' is ');
|
|
AsmWrite(tai_jvar(hp).desc^);
|
|
AsmWrite(' from ');
|
|
AsmWrite(tai_jvar(hp).startlab.name);
|
|
AsmWrite(' to ');
|
|
AsmWriteLn(tai_jvar(hp).stoplab.name);
|
|
end;
|
|
|
|
ait_jcatch:
|
|
begin
|
|
AsmWrite('.catch ');
|
|
AsmWrite(tai_jcatch(hp).name^);
|
|
AsmWrite(' from ');
|
|
AsmWrite(tai_jcatch(hp).startlab.name);
|
|
AsmWrite(' to ');
|
|
AsmWrite(tai_jcatch(hp).stoplab.name);
|
|
AsmWrite(' using ');
|
|
AsmWriteLn(tai_jcatch(hp).handlerlab.name);
|
|
end;
|
|
else
|
|
internalerror(2010122707);
|
|
end;
|
|
hp:=tai(hp.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TJasminAssembler.WriteExtraHeader(obj: tobjectdef);
|
|
var
|
|
superclass,
|
|
intf: tobjectdef;
|
|
n: string;
|
|
i: longint;
|
|
begin
|
|
{ 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
|
|
if assigned(current_module.mainsource) then
|
|
n:=ExtractFileName(current_module.mainsource^)
|
|
else
|
|
n:=InputFileName;
|
|
AsmWriteLn('.source '+ExtractFileName(n));
|
|
|
|
{ class/interface name }
|
|
if not assigned(obj) then
|
|
begin
|
|
{ fake class type for unit -> name=unitname and
|
|
superclass=java.lang.object }
|
|
AsmWriteLn('.class '+current_module.realmodulename^);
|
|
AsmWriteLn('.super java/lang/Object');
|
|
end
|
|
else
|
|
begin
|
|
case obj.objecttype of
|
|
odt_javaclass:
|
|
begin
|
|
AsmWriteLn('.class '+obj.jvm_full_typename(false));
|
|
superclass:=obj.childof;
|
|
end;
|
|
odt_interfacejava:
|
|
begin
|
|
AsmWriteLn('.interface abstract '+obj.objextname^);
|
|
{ interfaces must always specify Java.lang.object as
|
|
superclass }
|
|
superclass:=java_jlobject;
|
|
end
|
|
else
|
|
internalerror(2011010906);
|
|
end;
|
|
{ superclass }
|
|
if assigned(superclass) then
|
|
begin
|
|
AsmWrite('.super ');
|
|
if assigned(superclass.import_lib) then
|
|
AsmWrite(superclass.import_lib^+'/');
|
|
AsmWriteln(superclass.objextname^);
|
|
end;
|
|
{ implemented interfaces }
|
|
if assigned(obj.ImplementedInterfaces) then
|
|
begin
|
|
for i:=0 to obj.ImplementedInterfaces.count-1 do
|
|
begin
|
|
intf:=TImplementedInterface(obj.ImplementedInterfaces[i]).IntfDef;
|
|
AsmWrite('.implements ');
|
|
if assigned(intf.import_lib) then
|
|
AsmWrite(intf.import_lib^+'/');
|
|
AsmWriteln(intf.objextname^);
|
|
end;
|
|
end;
|
|
{ in case of nested class: relation to parent class }
|
|
if obj.owner.symtabletype=objectsymtable then
|
|
AsmWriteln(InnerObjDef(obj));
|
|
{ all all nested classes }
|
|
for i:=0 to obj.symtable.deflist.count-1 do
|
|
if is_java_class_or_interface(tdef(obj.symtable.deflist[i])) then
|
|
AsmWriteln(InnerObjDef(tobjectdef(obj.symtable.deflist[i])));
|
|
end;
|
|
AsmLn;
|
|
end;
|
|
|
|
|
|
procedure TJasminAssembler.WriteInstruction(hp: tai);
|
|
begin
|
|
InstrWriter.WriteInstruction(hp);
|
|
end;
|
|
|
|
|
|
function TJasminAssembler.MakeCmdLine: TCmdStr;
|
|
const
|
|
jasminjarname = 'jasmin.jar';
|
|
var
|
|
filenames: tcmdstr;
|
|
jasminjarfound: boolean;
|
|
begin
|
|
if jasminjar='' then
|
|
begin
|
|
jasminjarfound:=false;
|
|
if utilsdirectory<>'' then
|
|
jasminjarfound:=FindFile(jasminjarname,utilsdirectory,false,jasminjar);
|
|
if not jasminjarfound then
|
|
jasminjarfound:=FindFileInExeLocations(jasminjarname,false,jasminjar);
|
|
if (not jasminjarfound) and not(cs_asm_extern in current_settings.globalswitches) then
|
|
begin
|
|
Message1(exec_e_assembler_not_found,jasminjarname);
|
|
current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
|
|
end;
|
|
if jasminjarfound then
|
|
Message1(exec_t_using_assembler,jasminjar);
|
|
end;
|
|
result:=target_asm.asmcmd;
|
|
filenames:=maybequoted(ScriptFixFileName(AsmFileName));
|
|
while not asmfiles.empty do
|
|
filenames:=filenames+' '+asmfiles.GetFirst;
|
|
Replace(result,'$ASM',filenames);
|
|
if (path<>'') then
|
|
Replace(result,'$OBJDIR',maybequoted(ScriptFixFileName(path)))
|
|
else
|
|
Replace(result,'$OBJDIR','.');
|
|
Replace(result,'$JASMINJAR',maybequoted(ScriptFixFileName(jasminjar)));
|
|
end;
|
|
|
|
|
|
procedure TJasminAssembler.NewAsmFileForObjectDef(obj: tobjectdef);
|
|
begin
|
|
if AsmSize<>AsmStartSize then
|
|
begin
|
|
AsmClose;
|
|
asmfiles.Concat(maybequoted(ScriptFixFileName(AsmFileName)));
|
|
end
|
|
else
|
|
AsmClear;
|
|
|
|
AsmFileName:=obj.jvm_full_typename(false);
|
|
AsmFileName:=Path+FixFileName(AsmFileName)+target_info.asmext;
|
|
AsmCreate(cut_normal);
|
|
end;
|
|
|
|
|
|
function TJasminAssembler.VisibilityToStr(vis: tvisibility): string;
|
|
begin
|
|
case vis of
|
|
vis_hidden,
|
|
vis_strictprivate:
|
|
result:='private ';
|
|
vis_strictprotected:
|
|
result:='protected ';
|
|
vis_protected,
|
|
vis_private:
|
|
{ pick default visibility = "package" visibility; required because
|
|
other classes in the same unit can also access these symbols }
|
|
result:='';
|
|
vis_public:
|
|
result:='public '
|
|
else
|
|
internalerror(2010122609);
|
|
end;
|
|
end;
|
|
|
|
|
|
function TJasminAssembler.MethodDefinition(pd: tprocdef): string;
|
|
begin
|
|
result:=VisibilityToStr(pd.visibility);
|
|
if (pd.procsym.owner.symtabletype in [globalsymtable,staticsymtable,localsymtable]) or
|
|
(po_staticmethod in pd.procoptions) then
|
|
result:=result+'static ';
|
|
if is_javainterface(tdef(pd.owner.defowner)) then
|
|
result:=result+'abstract ';
|
|
result:=result+pd.jvmmangledbasename;
|
|
end;
|
|
|
|
|
|
function TJasminAssembler.FieldDefinition(sym: tabstractvarsym): string;
|
|
var
|
|
vissym: tabstractvarsym;
|
|
begin
|
|
vissym:=sym;
|
|
{ static field definition -> get original field definition for
|
|
visibility }
|
|
if (vissym.typ=staticvarsym) and
|
|
(vissym.owner.symtabletype=objectsymtable) then
|
|
begin
|
|
vissym:=tabstractvarsym(search_struct_member(
|
|
tobjectdef(vissym.owner.defowner),
|
|
jvminternalstaticfieldname(vissym.name)));
|
|
if not assigned(vissym) or
|
|
(vissym.typ<>fieldvarsym) then
|
|
internalerror(2011011501);
|
|
end;
|
|
case vissym.typ of
|
|
staticvarsym:
|
|
begin
|
|
if vissym.owner.symtabletype=globalsymtable then
|
|
result:='public '
|
|
else
|
|
{ package visbility }
|
|
result:='';
|
|
end;
|
|
fieldvarsym:
|
|
result:=VisibilityToStr(tfieldvarsym(vissym).visibility);
|
|
else
|
|
internalerror(2011011204);
|
|
end;
|
|
if (vissym.owner.symtabletype in [staticsymtable,globalsymtable]) or
|
|
(sp_static in vissym.symoptions) then
|
|
result:=result+'static ';
|
|
result:=result+jvmmangledbasename(sym);
|
|
end;
|
|
|
|
|
|
function TJasminAssembler.InnerObjDef(obj: tobjectdef): string;
|
|
var
|
|
kindname: string;
|
|
begin
|
|
if obj.owner.defowner.typ<>objectdef then
|
|
internalerror(2011021701);
|
|
case obj.objecttype of
|
|
odt_javaclass:
|
|
kindname:='class ';
|
|
odt_interfacejava:
|
|
kindname:='interface ';
|
|
else
|
|
internalerror(2011021702);
|
|
end;
|
|
result:=
|
|
'.inner '+
|
|
kindname+
|
|
VisibilityToStr(obj.typesym.visibility)+
|
|
{ Nested classes in the Pascal sense are equivalent to "static"
|
|
inner classes in Java -- will be changed when support for
|
|
Java-style non-static classes is added }
|
|
' static '+
|
|
obj.objextname^+
|
|
' inner '+
|
|
obj.jvm_full_typename(true)+
|
|
' outer '+
|
|
tobjectdef(obj.owner.defowner).jvm_full_typename(true);
|
|
end;
|
|
|
|
|
|
procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
|
|
begin
|
|
if not assigned(pd.exprasmlist) and
|
|
(not is_javainterface(pd.struct) or
|
|
(pd.proctypeoption in [potype_unitinit,potype_unitfinalize])) then
|
|
exit;
|
|
AsmWrite('.method ');
|
|
AsmWriteln(MethodDefinition(pd));
|
|
WriteTree(pd.exprasmlist);
|
|
AsmWriteln('.end method');
|
|
AsmLn;
|
|
end;
|
|
|
|
|
|
procedure TJasminAssembler.WriteFieldSym(sym: tabstractvarsym);
|
|
begin
|
|
{ internal static field definition alias -> skip }
|
|
if sp_static in sym.symoptions then
|
|
exit;
|
|
AsmWrite('.field ');
|
|
AsmWriteln(FieldDefinition(sym));
|
|
end;
|
|
|
|
|
|
procedure TJasminAssembler.WriteSymtableVarSyms(st: TSymtable);
|
|
var
|
|
sym : tsym;
|
|
i : longint;
|
|
begin
|
|
if not assigned(st) then
|
|
exit;
|
|
for i:=0 to st.SymList.Count-1 do
|
|
begin
|
|
sym:=tsym(st.SymList[i]);
|
|
case sym.typ of
|
|
staticvarsym,
|
|
fieldvarsym:
|
|
begin
|
|
WriteFieldSym(tabstractvarsym(sym));
|
|
end;
|
|
end;
|
|
end;
|
|
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
|
|
{ methods are also in the static/globalsymtable of the unit
|
|
-> make sure they are only written for the objectdefs that
|
|
own them }
|
|
if not(st.symtabletype in [staticsymtable,globalsymtable]) or
|
|
(def.owner=st) then
|
|
begin
|
|
WriteProcDef(tprocdef(def));
|
|
if assigned(tprocdef(def).localst) then
|
|
WriteSymtableProcdefs(tprocdef(def).localst);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJasminAssembler.WriteSymtableObjectDefs(st: TSymtable);
|
|
var
|
|
i : longint;
|
|
def : tdef;
|
|
obj : tobjectdef;
|
|
nestedclasses: tfpobjectlist;
|
|
begin
|
|
if not assigned(st) then
|
|
exit;
|
|
nestedclasses:=tfpobjectlist.create(false);
|
|
for i:=0 to st.DefList.Count-1 do
|
|
begin
|
|
def:=tdef(st.DefList[i]);
|
|
case def.typ of
|
|
objectdef:
|
|
if not(oo_is_external in tobjectdef(def).objectoptions) then
|
|
nestedclasses.add(def);
|
|
end;
|
|
end;
|
|
for i:=0 to nestedclasses.count-1 do
|
|
begin
|
|
obj:=tobjectdef(nestedclasses[i]);
|
|
NewAsmFileForObjectDef(obj);
|
|
WriteExtraHeader(obj);
|
|
WriteSymtableVarSyms(obj.symtable);
|
|
AsmLn;
|
|
WriteSymtableProcDefs(obj.symtable);
|
|
WriteSymtableObjectDefs(obj.symtable);
|
|
end;
|
|
nestedclasses.free;
|
|
end;
|
|
|
|
constructor TJasminAssembler.Create(smart: boolean);
|
|
begin
|
|
inherited create(smart);
|
|
InstrWriter:=TJasminInstrWriter.Create(self);
|
|
asmfiles:=TCmdStrList.Create;
|
|
end;
|
|
|
|
|
|
procedure TJasminAssembler.WriteAsmList;
|
|
begin
|
|
{$ifdef EXTDEBUG}
|
|
if assigned(current_module.mainsource) then
|
|
Comment(V_Debug,'Start writing Jasmin-styled assembler output for '+current_module.mainsource^);
|
|
{$endif}
|
|
|
|
AsmStartSize:=AsmSize;
|
|
WriteExtraHeader(nil);
|
|
(*
|
|
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 variables }
|
|
WriteSymtableVarSyms(current_module.globalsymtable);
|
|
WriteSymtableVarSyms(current_module.localsymtable);
|
|
AsmLn;
|
|
{ print all global procedures/functions }
|
|
WriteSymtableProcdefs(current_module.globalsymtable);
|
|
WriteSymtableProcdefs(current_module.localsymtable);
|
|
|
|
WriteSymtableObjectDefs(current_module.globalsymtable);
|
|
WriteSymtableObjectDefs(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 or field -> full type and name
|
|
// ref.base can be <> NR_NO in case an instance field is loaded.
|
|
// This register is not part of this instruction, it will have
|
|
// been placed on the stack by the previous one.
|
|
if (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;
|
|
d: double;
|
|
s: single;
|
|
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:
|
|
begin
|
|
s:=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;
|
|
// 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 }
|
|
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 $JASMINJAR $ASM -d $OBJDIR';
|
|
supported_targets : [system_jvm_java32];
|
|
flags : [];
|
|
labelprefix : 'L';
|
|
comment : ' ; ';
|
|
);
|
|
|
|
|
|
begin
|
|
RegisterAssembler(as_jvm_jasmin_info,TJasminAssembler);
|
|
end.
|