|
@@ -44,12 +44,16 @@ interface
|
|
|
|
|
|
TJasminAssembler=class(texternalassembler)
|
|
TJasminAssembler=class(texternalassembler)
|
|
protected
|
|
protected
|
|
- procedure WriteExtraHeader;virtual;
|
|
|
|
|
|
+ jasminjar: tcmdstr;
|
|
|
|
+ procedure WriteExtraHeader(obj: tobjectdef);
|
|
procedure WriteInstruction(hp: tai);
|
|
procedure WriteInstruction(hp: tai);
|
|
|
|
+ procedure NewAsmFileForObjectDef(obj: tobjectdef);
|
|
procedure WriteProcDef(pd: tprocdef);
|
|
procedure WriteProcDef(pd: tprocdef);
|
|
procedure WriteSymtableProcdefs(st: TSymtable);
|
|
procedure WriteSymtableProcdefs(st: TSymtable);
|
|
|
|
+ procedure WriteSymtableObjectDefs(st: TSymtable);
|
|
public
|
|
public
|
|
constructor Create(smart: boolean); override;
|
|
constructor Create(smart: boolean); override;
|
|
|
|
+ function MakeCmdLine: TCmdStr;override;
|
|
procedure WriteTree(p:TAsmList);override;
|
|
procedure WriteTree(p:TAsmList);override;
|
|
procedure WriteAsmList;override;
|
|
procedure WriteAsmList;override;
|
|
destructor destroy; override;
|
|
destructor destroy; override;
|
|
@@ -79,7 +83,7 @@ implementation
|
|
|
|
|
|
uses
|
|
uses
|
|
SysUtils,
|
|
SysUtils,
|
|
- cutils,cfileutl,systems,
|
|
|
|
|
|
+ cutils,cfileutl,systems,script,
|
|
fmodule,finput,verbose,
|
|
fmodule,finput,verbose,
|
|
symconst,symtype,
|
|
symconst,symtype,
|
|
itcpujas,cpubase,cgutils,
|
|
itcpujas,cpubase,cgutils,
|
|
@@ -379,8 +383,38 @@ implementation
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
- procedure TJasminAssembler.WriteExtraHeader;
|
|
|
|
|
|
+ procedure TJasminAssembler.WriteExtraHeader(obj: tobjectdef);
|
|
|
|
+ var
|
|
|
|
+ n: string;
|
|
begin
|
|
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));
|
|
|
|
+ if not assigned(obj) then
|
|
|
|
+ begin
|
|
|
|
+ { fake class type for unit -> name=unitname and
|
|
|
|
+ superclass=java.lang.object }
|
|
|
|
+ AsmWriteLn('.class '+ChangeFileExt(ExtractFileName(n),''));
|
|
|
|
+ AsmWriteLn('.super java/lang/Object');
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ begin
|
|
|
|
+ AsmWriteLn('.class '+obj.objextname^);
|
|
|
|
+ if assigned(obj.childof) then
|
|
|
|
+ begin
|
|
|
|
+ AsmWrite('.super ');
|
|
|
|
+ if assigned(obj.childof.import_lib) then
|
|
|
|
+ AsmWrite(obj.childof.import_lib^+'/');
|
|
|
|
+ AsmWriteln(obj.childof.objextname^);
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ AsmLn;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
@@ -390,6 +424,65 @@ implementation
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
+ function TJasminAssembler.MakeCmdLine: TCmdStr;
|
|
|
|
+ const
|
|
|
|
+ jasminjarname = 'jasmin.jar';
|
|
|
|
+ var
|
|
|
|
+ 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;
|
|
|
|
+ Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
|
|
|
|
+ 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);
|
|
|
|
+ var
|
|
|
|
+ enclosingobj: tobjectdef;
|
|
|
|
+ st: tsymtable;
|
|
|
|
+ begin
|
|
|
|
+ if AsmSize<>AsmStartSize then
|
|
|
|
+ begin
|
|
|
|
+ AsmClose;
|
|
|
|
+ DoAssemble;
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ AsmClear;
|
|
|
|
+
|
|
|
|
+ AsmFileName:=obj.objextname^;
|
|
|
|
+ st:=obj.owner;
|
|
|
|
+ while assigned(st) and
|
|
|
|
+ (st.symtabletype=objectsymtable) do
|
|
|
|
+ begin
|
|
|
|
+ { nested classes are named as "OuterClass$InnerClass" }
|
|
|
|
+ enclosingobj:=tobjectdef(st.defowner);
|
|
|
|
+ AsmFileName:=enclosingobj.objextname^+'$'+AsmFileName;
|
|
|
|
+ st:=enclosingobj.owner;
|
|
|
|
+ end;
|
|
|
|
+ AsmFileName:=Path+FixFileName(AsmFileName)+target_info.asmext;
|
|
|
|
+ AsmCreate(cut_normal);
|
|
|
|
+ end;
|
|
|
|
+
|
|
|
|
+
|
|
procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
|
|
procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
|
|
begin
|
|
begin
|
|
WriteTree(pd.exprasmlist);
|
|
WriteTree(pd.exprasmlist);
|
|
@@ -399,6 +492,7 @@ implementation
|
|
var
|
|
var
|
|
i : longint;
|
|
i : longint;
|
|
def : tdef;
|
|
def : tdef;
|
|
|
|
+ obj : tobjectdef;
|
|
begin
|
|
begin
|
|
if not assigned(st) then
|
|
if not assigned(st) then
|
|
exit;
|
|
exit;
|
|
@@ -408,14 +502,50 @@ implementation
|
|
case def.typ of
|
|
case def.typ of
|
|
procdef :
|
|
procdef :
|
|
begin
|
|
begin
|
|
- WriteProcDef(tprocdef(def));
|
|
|
|
- if assigned(tprocdef(def).localst) then
|
|
|
|
- WriteSymtableProcdefs(tprocdef(def).localst);
|
|
|
|
|
|
+ { 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;
|
|
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);
|
|
|
|
+ WriteSymtableProcDefs(obj.symtable);
|
|
|
|
+ WriteSymtableObjectDefs(obj.symtable);
|
|
|
|
+ end;
|
|
|
|
+ nestedclasses.free;
|
|
|
|
+ end;
|
|
|
|
|
|
constructor TJasminAssembler.Create(smart: boolean);
|
|
constructor TJasminAssembler.Create(smart: boolean);
|
|
begin
|
|
begin
|
|
@@ -426,7 +556,6 @@ implementation
|
|
|
|
|
|
procedure TJasminAssembler.WriteAsmList;
|
|
procedure TJasminAssembler.WriteAsmList;
|
|
var
|
|
var
|
|
- n : string;
|
|
|
|
hal : tasmlisttype;
|
|
hal : tasmlisttype;
|
|
i: longint;
|
|
i: longint;
|
|
begin
|
|
begin
|
|
@@ -435,24 +564,8 @@ implementation
|
|
Comment(V_Debug,'Start writing Jasmin-styled assembler output for '+current_module.mainsource^);
|
|
Comment(V_Debug,'Start writing Jasmin-styled assembler output for '+current_module.mainsource^);
|
|
{$endif}
|
|
{$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;
|
|
AsmStartSize:=AsmSize;
|
|
|
|
+ WriteExtraHeader(nil);
|
|
(*
|
|
(*
|
|
for hal:=low(TasmlistType) to high(TasmlistType) do
|
|
for hal:=low(TasmlistType) to high(TasmlistType) do
|
|
begin
|
|
begin
|
|
@@ -465,6 +578,9 @@ implementation
|
|
WriteSymtableProcdefs(current_module.globalsymtable);
|
|
WriteSymtableProcdefs(current_module.globalsymtable);
|
|
WriteSymtableProcdefs(current_module.localsymtable);
|
|
WriteSymtableProcdefs(current_module.localsymtable);
|
|
|
|
|
|
|
|
+ WriteSymtableObjectDefs(current_module.globalsymtable);
|
|
|
|
+ WriteSymtableObjectDefs(current_module.localsymtable);
|
|
|
|
+
|
|
AsmLn;
|
|
AsmLn;
|
|
{$ifdef EXTDEBUG}
|
|
{$ifdef EXTDEBUG}
|
|
if assigned(current_module.mainsource) then
|
|
if assigned(current_module.mainsource) then
|
|
@@ -612,7 +728,7 @@ implementation
|
|
id : as_jvm_jasmin;
|
|
id : as_jvm_jasmin;
|
|
idtxt : 'Jasmin';
|
|
idtxt : 'Jasmin';
|
|
asmbin : 'java';
|
|
asmbin : 'java';
|
|
- asmcmd : '-jar jasmin.jar $ASM';
|
|
|
|
|
|
+ asmcmd : '-jar $JASMINJAR $ASM -d $OBJDIR';
|
|
supported_targets : [system_jvm_java32];
|
|
supported_targets : [system_jvm_java32];
|
|
flags : [];
|
|
flags : [];
|
|
labelprefix : 'L';
|
|
labelprefix : 'L';
|