瀏覽代碼

* factored searching the exe directories from FindExe() into
FindFileInExeLocations()
* search for jasmin.jar using FindFileInExeLocations and properly
build the java command line, so jasmin can be called successfully
by the compiler
* properly create separate assembler files for each class, and
correctly specify the class name and superclass for each class
(units themselves are still hardcoded to descend from java.lang.Object)

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

Jonas Maebe 14 年之前
父節點
當前提交
74d684878d
共有 2 個文件被更改,包括 161 次插入38 次删除
  1. 141 25
      compiler/agjasmin.pas
  2. 20 13
      compiler/cfileutl.pas

+ 141 - 25
compiler/agjasmin.pas

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

+ 20 - 13
compiler/cfileutl.pas

@@ -119,6 +119,7 @@ interface
     procedure SplitBinCmd(const s:TCmdStr;var bstr: TCmdStr;var cstr:TCmdStr);
     procedure SplitBinCmd(const s:TCmdStr;var bstr: TCmdStr;var cstr:TCmdStr);
     function  FindFile(const f : TCmdStr; const path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
     function  FindFile(const f : TCmdStr; const path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
 {    function  FindFilePchar(const f : TCmdStr;path : pchar;allowcache:boolean;var foundfile:TCmdStr):boolean;}
 {    function  FindFilePchar(const f : TCmdStr;path : pchar;allowcache:boolean;var foundfile:TCmdStr):boolean;}
+    function  FindFileInExeLocations(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
     function  FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
     function  FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
     function  GetShortName(const n:TCmdStr):TCmdStr;
     function  GetShortName(const n:TCmdStr):TCmdStr;
 
 
@@ -1233,22 +1234,28 @@ end;
      end;
      end;
 }
 }
 
 
-   function  FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
-     var
-       Path : TCmdStr;
-       found : boolean;
-     begin
-       found:=FindFile(FixFileName(ChangeFileExt(bin,source_info.exeext)),exepath,allowcache,foundfile);
-       if not found then
-        begin
+  function  FindFileInExeLocations(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
+    var
+      Path : TCmdStr;
+      found : boolean;
+    begin
+       found:=FindFile(FixFileName(bin),exepath,allowcache,foundfile);
+      if not found then
+       begin
 {$ifdef macos}
 {$ifdef macos}
-          Path:=GetEnvironmentVariable('Commands');
+         Path:=GetEnvironmentVariable('Commands');
 {$else}
 {$else}
-          Path:=GetEnvironmentVariable('PATH');
+         Path:=GetEnvironmentVariable('PATH');
 {$endif}
 {$endif}
-          found:=FindFile(FixFileName(ChangeFileExt(bin,source_info.exeext)),Path,allowcache,foundfile);
-        end;
-       FindExe:=found;
+         found:=FindFile(FixFileName(bin),Path,allowcache,foundfile);
+       end;
+      FindFileInExeLocations:=found;
+    end;
+
+
+   function  FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean;
+     begin
+       FindExe:=FindFileInExeLocations(ChangeFileExt(bin,source_info.exeext),allowcache,foundfile);
      end;
      end;