freepascal.compiler/compiler/agjs.pas

{
    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 JS (JVM bytecode) output.
}
unit agjs;

{$i fpcdefs.inc}

interface

    uses
      cclasses,
      globtype,globals,
      symconst,symbase,symdef,symsym,
      aasmbase,aasmtai,aasmdata,aasmcpu,
      assemble;

    type
      TJSInstrWriter = class;
      {  This is a derived class which is used to write
         JS
      }

      TJSAssembler=class(texternalassembler)
      protected
        jasminjar: tcmdstr;
        asmfiles: TCmdStrList;

        procedure WriteExtraHeader(obj: tabstractrecorddef);
        procedure WriteInstruction(hp: tai);
        procedure NewAsmFileForStructDef(obj: tabstractrecorddef);

        function VisibilityToStr(vis: tvisibility): ansistring;
        function MethodDefinition(pd: tprocdef): ansistring;
        function ConstValue(csym: tconstsym): ansistring;
        function ConstAssignmentValue(csym: tconstsym): ansistring;
        function ConstDefinition(sym: tconstsym): ansistring;
        function FieldDefinition(sym: tabstractvarsym): ansistring;
        function InnerStructDef(obj: tabstractrecorddef): ansistring;

        procedure WriteProcDef(pd: tprocdef);
        procedure WriteFieldSym(sym: tabstractvarsym);
        procedure WriteConstSym(sym: tconstsym);
        procedure WriteSymtableVarSyms(st: TSymtable);
        procedure WriteSymtableProcdefs(st: TSymtable);
        procedure WriteSymtableStructDefs(st: TSymtable);
      public
        constructor Create(smart: boolean); override;
        function MakeCmdLine: TCmdStr;override;
        procedure WriteTree(p:TAsmList);override;
        procedure WriteAsmList;override;
        procedure RemoveAsm; override;
        destructor destroy; override;
       protected
        InstrWriter: TJSInstrWriter;
      end;


      { This is the base class for writing instructions.

         The WriteInstruction() method must be overridden
         to write a single instruction to the assembler
         file.
      }
      TJSInstrWriter = class
        constructor create(_owner: TJSAssembler);
        procedure WriteInstruction(hp : tai); virtual;
       protected
        owner: TJSAssembler;
      end;


implementation

    uses
      SysUtils,
      cutils,cfileutl,systems,script,
      fmodule,finput,verbose,
      symtype,symtable,
      cpubase,cpuinfo,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;


   function constastr(p: pchar; len: longint): ansistring;
     var
       i,runstart,runlen: longint;

       procedure flush;
         begin
           if runlen>0 then
             begin
               setlength(result,length(result)+runlen);
               move(p[runstart],result[length(result)-runlen+1],runlen);
               runlen:=0;
             end;
         end;

     begin
       result:='"';
       runlen:=0;
       runstart:=0;
       for i:=0 to len-1 do
         begin
           { escape control codes }
           case p[i] of
             { LF and CR must be escaped specially, because \uXXXX parsing
               happens in the pre-processor, so it's the same as actually
               inserting a newline in the middle of a string constant }
             #10:
               begin
                 flush;
                 result:=result+'\n';
               end;
             #13:
               begin
                 flush;
                 result:=result+'\r';
               end;
             '"','\':
               begin
                 flush;
                 result:=result+'\'+p[i];
               end
             else if p[i]<#32 then
               begin
                 flush;
                 result:=result+'\u'+hexstr(ord(p[i]),4);
               end
             else if p[i]<#127 then
               begin
                 if runlen=0 then
                   runstart:=i;
                 inc(runlen);
               end
             else
               begin
                 { see comments in njvmcon }
                 flush;
                 result:=result+'\u'+hexstr(ord(p[i]),4)
               end;
           end;
         end;
       flush;
       result:=result+'"';
     end;


   function constwstr(w: pcompilerwidechar; len: longint): ansistring;
     var
       i: longint;
     begin
       result:='"';
       for i:=0 to len-1 do
         begin
           { escape control codes }
           case w[i] of
             10:
               result:=result+'\n';
             13:
               result:=result+'\r';
             ord('"'),ord('\'):
               result:=result+'\'+chr(w[i]);
             else if (w[i]<32) or
                (w[i]>=127) then
               result:=result+'\u'+hexstr(w[i],4)
             else
               result:=result+char(w[i]);
           end;
         end;
       result:=result+'"';
     end;


   function constsingle(s: single): ansistring;
     begin
       result:='0fx'+hexstr(longint(t32bitarray(s)),8);
     end;


   function constdouble(d: double): ansistring;
      begin
        // 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;

{****************************************************************************}
{                       Jasmin Assembler writer                              }
{****************************************************************************}

    destructor TJSAssembler.Destroy;
      begin
        InstrWriter.free;
        asmfiles.free;
        inherited destroy;
      end;


    procedure TJSAssembler.WriteTree(p:TAsmList);
      var
        ch       : char;
        hp       : tai;
        hp1      : tailineinfo;
        s        : ansistring;
        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 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 TJSAssembler.WriteExtraHeader(obj: tabstractrecorddef);
      var
        superclass,
        intf: tobjectdef;
        n: ansistring;
        i: longint;
        toplevelowner: tsymtable;
      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 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, make final so you cannot descend
              from it }
            AsmWrite('.class final public ');
            if assigned(current_module.namespace) then
              AsmWrite(current_module.namespace^+'.');
            AsmWriteln(current_module.realmodulename^);
            AsmWriteLn('.super java/lang/Object');
          end
        else
          begin
            toplevelowner:=obj.owner;
            while not(toplevelowner.symtabletype in [staticsymtable,globalsymtable]) do
              toplevelowner:=toplevelowner.defowner.owner;
            case obj.typ of
              recorddef:
                begin
                  { can't inherit from records }
                  AsmWrite('.class final ');
                  if toplevelowner.symtabletype=globalsymtable then
                    AsmWrite('public ');
                  AsmWriteln(obj.jvm_full_typename(true));
                  superclass:=java_fpcbaserecordtype;
                end;
              objectdef:
                begin
                  case tobjectdef(obj).objecttype of
                    odt_javaclass:
                      begin
                        AsmWrite('.class ');
                        if oo_is_sealed in tobjectdef(obj).objectoptions then
                          AsmWrite('final ');
                        if (oo_is_abstract in tobjectdef(obj).objectoptions) or
                           (tobjectdef(obj).abstractcnt<>0) then
                          AsmWrite('abstract ');
                        if toplevelowner.symtabletype=globalsymtable then
                          AsmWrite('public ');
                        if (oo_is_enum_class in tobjectdef(obj).objectoptions) then
                          AsmWrite('enum ');
                        AsmWriteln(obj.jvm_full_typename(true));
                        superclass:=tobjectdef(obj).childof;
                      end;
                    odt_interfacejava:
                      begin
                        AsmWrite('.interface abstract ');
                        if toplevelowner.symtabletype=globalsymtable then
                          AsmWrite('public ');
                        AsmWriteLn(obj.jvm_full_typename(true));
                        { interfaces must always specify Java.lang.object as
                          superclass }
                        superclass:=java_jlobject;
                      end
                    else
                      internalerror(2011010906);
                  end;
                end;
            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 (obj.typ=objectdef) and
               assigned(tobjectdef(obj).ImplementedInterfaces) then
              begin
                for i:=0 to tobjectdef(obj).ImplementedInterfaces.count-1 do
                  begin
                    intf:=TImplementedInterface(tobjectdef(obj).ImplementedInterfaces[i]).IntfDef;
                    AsmWrite('.implements ');
                    AsmWriteLn(intf.jvm_full_typename(true));
                  end;
              end;
            { signature for enum classes (must come after superclass and
              implemented interfaces) }
            if (obj.typ=objectdef) and
               (oo_is_enum_class in tobjectdef(obj).objectoptions) then
              AsmWriteln('.signature "Ljava/lang/Enum<L'+obj.jvm_full_typename(true)+';>;"');
            { in case of nested class: relation to parent class }
            if obj.owner.symtabletype in [objectsymtable,recordsymtable] then
              AsmWriteln(InnerStructDef(obj));
            { add all nested classes }
            for i:=0 to obj.symtable.deflist.count-1 do
              if (is_java_class_or_interface(tdef(obj.symtable.deflist[i])) or
                  (tdef(obj.symtable.deflist[i]).typ=recorddef)) and
                 not(df_generic in tdef(obj.symtable.deflist[i]).defoptions) then
                AsmWriteln(InnerStructDef(tabstractrecorddef(obj.symtable.deflist[i])));
          end;
        AsmLn;
      end;


    procedure TJSAssembler.WriteInstruction(hp: tai);
      begin
        InstrWriter.WriteInstruction(hp);
      end;


   function TJSAssembler.MakeCmdLine: TCmdStr;
     const
       jasminjarname = 'jasmin.jar';
     var
       filenames: tcmdstr;
       asmfile: tcmdstrlistitem;
       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:=ScriptFixFileName(AsmFileName);
       if cs_asm_extern in current_settings.globalswitches then
         filenames:=maybequoted(filenames);
       asmfile:=tcmdstrlistitem(asmfiles.First);
       while assigned(asmfile) do
         begin
           if cs_asm_extern in current_settings.globalswitches then
             filenames:=filenames+' '+maybequoted(ScriptFixFileName(asmfile.str))
           else
            filenames:=filenames+' '+ScriptFixFileName(asmfile.str);
           asmfile:=tcmdstrlistitem(asmfile.next);
        end;
       Replace(result,'$ASM',filenames);
       if (path<>'') then
         if cs_asm_extern in current_settings.globalswitches then
           Replace(result,'$OBJDIR',maybequoted(ScriptFixFileName(path)))
         else
           Replace(result,'$OBJDIR',ScriptFixFileName(path))
       else
         Replace(result,'$OBJDIR','.');
       if cs_asm_extern in current_settings.globalswitches then
         Replace(result,'$JASMINJAR',maybequoted(ScriptFixFileName(jasminjar)))
       else
         Replace(result,'$JASMINJAR',ScriptFixFileName(jasminjar));
       Replace(result,'$EXTRAOPT',asmextraopt);
     end;


   procedure TJSAssembler.NewAsmFileForStructDef(obj: tabstractrecorddef);
      begin
        if AsmSize<>AsmStartSize then
          begin
            AsmClose;
            asmfiles.Concat(AsmFileName);
          end
        else
          AsmClear;

        AsmFileName:=obj.jvm_full_typename(false);
        AsmFileName:=Path+FixFileName(AsmFileName)+target_info.asmext;
        AsmCreate(cut_normal);
      end;


    function TJSAssembler.VisibilityToStr(vis: tvisibility): ansistring;
      begin
        case vis of
          vis_hidden,
          vis_strictprivate:
            result:='private ';
          { protected in Java means "accessible by subclasses *and* by classes
            in the same package" -> similar to regular "protected" in Pascal;
            "strict protected" is actually more strict in Pascal than in Java,
            but there's not much we can do about that }
          vis_protected,
          vis_strictprotected:
            result:='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 TJSAssembler.MethodDefinition(pd: tprocdef): ansistring;
      begin
        //result:=VisibilityToStr(pd.visibility);
        //if (pd.procsym.owner.symtabletype in [globalsymtable,staticsymtable,localsymtable]) or
        //   (po_classmethod in pd.procoptions) then
        //  result:=result+'static ';
        //if (po_abstractmethod in pd.procoptions) or
        //   is_javainterface(tdef(pd.owner.defowner)) then
        //  result:=result+'abstract ';
        //if (pd.procsym.owner.symtabletype in [globalsymtable,staticsymtable,localsymtable]) or
        //   (po_finalmethod in pd.procoptions) or
        //   (not(po_virtualmethod in pd.procoptions) and
        //    not(po_classmethod in pd.procoptions) and
        //    not(pd.proctypeoption in [potype_constructor,potype_class_constructor])) then
        //  result:=result+'final ';
        //result:=result+pd.jvmmangledbasename(false);
      end;


    function TJSAssembler.ConstValue(csym: tconstsym): ansistring;
      begin
        case csym.consttyp of
          constord:
            { always interpret as signed value, because the JVM does not
              support unsigned values }
            case csym.constdef.size of
              1:result:=tostr(shortint(csym.value.valueord.svalue));
              2:result:=tostr(smallint(csym.value.valueord.svalue));
              4:result:=tostr(longint(csym.value.valueord.svalue));
              8:result:=tostr(csym.value.valueord.svalue);
            end;
          conststring:
            result:=constastr(pchar(csym.value.valueptr),csym.value.len);
          constreal:
            case tfloatdef(csym.constdef).floattype of
              s32real:
                result:=constsingle(pbestreal(csym.value.valueptr)^);
              s64real:
                result:=constdouble(pbestreal(csym.value.valueptr)^);
              else
                internalerror(2011021204);
              end;
          constset:
            result:='TODO: add support for constant sets';
          constpointer:
            { can only be null, but that's the default value and should not
              be written; there's no primitive type that can hold nill }
            internalerror(2011021201);
          constnil:
            internalerror(2011021202);
          constresourcestring:
            result:='TODO: add support for constant resource strings';
          constwstring:
            result:=constwstr(pcompilerwidestring(csym.value.valueptr)^.data,pcompilerwidestring(csym.value.valueptr)^.len);
          constguid:
            result:='TODO: add support for constant guids';
          else
            internalerror(2011021205);
        end;
      end;


    function TJSAssembler.ConstAssignmentValue(csym: tconstsym): ansistring;
      begin
        result:='';
        { nil is the default value -> don't write explicitly }
        case csym.consttyp of
          constpointer:
            begin
              if csym.value.valueordptr<>0 then
                internalerror(2011021206);
            end;
          constnil:
            ;
        else
          begin
            { enums and sets are initialized as typed constants }
            if not assigned(csym.constdef) or
               not(csym.constdef.typ in [enumdef,setdef]) then
              result:=' = '+ConstValue(csym);
          end;
        end;
      end;


    function TJSAssembler.ConstDefinition(sym: tconstsym): ansistring;
      begin
        //result:=VisibilityToStr(sym.visibility);
        //{ formal constants are always class-level, not instance-level }
        //result:=result+'static final ';
        //if sp_internal in sym.symoptions then
        //  result:=result+'synthetic ';
        //result:=result+jvmmangledbasename(sym,true);
        //result:=result+ConstAssignmentValue(tconstsym(sym));
      end;


    function TJSAssembler.FieldDefinition(sym: tabstractvarsym): ansistring;
      begin
        //case sym.typ of
        //  staticvarsym:
        //    begin
        //      if sym.owner.symtabletype=globalsymtable then
        //        result:='public '
        //      else
        //        { package visbility }
        //        result:='';
        //    end;
        //  fieldvarsym,
        //  absolutevarsym:
        //    result:=VisibilityToStr(tstoredsym(sym).visibility);
        //  else
        //    internalerror(2011011204);
        //end;
        //if (sym.typ=staticvarsym) or
        //   (sp_static in sym.symoptions) then
        //  result:=result+'static ';
        //if sym.varspez in [vs_const,vs_final] then
        //  result:=result+'final ';
        //if sp_internal in sym.symoptions then
        //  result:=result+'synthetic ';
        //{ mark the class fields of enum classes that contain the initialised
        //  enum instances as "enum" (recognise them by the fact that their type
        //  is the same as their parent class, and that this parent class is
        //  marked as oo_is_enum_class) }
        //if assigned(sym.owner.defowner) and
        //   (tdef(sym.owner.defowner).typ=objectdef) and
        //   (oo_is_enum_class in tobjectdef(sym.owner.defowner).objectoptions) and
        //   (sym.typ=staticvarsym) and
        //   (tstaticvarsym(sym).vardef=tdef(sym.owner.defowner)) then
        //  result:=result+'enum ';
        //result:=result+jvmmangledbasename(sym,true);
      end;


    function TJSAssembler.InnerStructDef(obj: tabstractrecorddef): ansistring;
      var
        extname: pshortstring;
        kindname: ansistring;
      begin
        if not(obj.owner.defowner.typ in [objectdef,recorddef]) then
          internalerror(2011021701);
        { 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 }
        case obj.typ of
          recorddef:
            begin
              kindname:='class static ';
              extname:=obj.symtable.realname;
            end;
          objectdef:
            begin
              extname:=tobjectdef(obj).objextname;
              case tobjectdef(obj).objecttype of
                odt_javaclass:
                  kindname:='class static ';
                odt_interfacejava:
                  kindname:='interface static abstract ';
                else
                  internalerror(2011021702);
              end;
            end;
          else
            internalerror(2011032809);
        end;
        result:=
          '.inner '+
          kindname+
          VisibilityToStr(obj.typesym.visibility)+
         extname^+
         ' inner '+
         obj.jvm_full_typename(true)+
         ' outer '+
         tabstractrecorddef(obj.owner.defowner).jvm_full_typename(true);
      end;


    procedure TJSAssembler.WriteProcDef(pd: tprocdef);
      begin
        //if not assigned(pd.exprasmlist) and
        //   not(po_abstractmethod in pd.procoptions) and
        //   (not is_javainterface(pd.struct) or
        //    (pd.proctypeoption in [potype_unitinit,potype_unitfinalize])) then
        //  exit;
        //AsmWrite('.method ');
        //AsmWriteln(MethodDefinition(pd));
        //if jvmtypeneedssignature(pd) then
        //  begin
        //    AsmWrite('.signature "');
        //    AsmWrite(pd.jvmmangledbasename(true));
        //    AsmWriteln('"');
        //  end;
        //WriteTree(pd.exprasmlist);
        //AsmWriteln('.end method');
        //AsmLn;
      end;


    procedure TJSAssembler.WriteFieldSym(sym: tabstractvarsym);
      begin
        { internal static field definition alias -> skip }
        if (sym.owner.symtabletype in [recordsymtable,ObjectSymtable]) and
           (sym.typ=staticvarsym) then
          exit;
        { external or threadvar definition -> no definition here }
        if ([vo_is_external,vo_is_thread_var]*sym.varoptions)<>[] then
          exit;
        AsmWrite('.field ');
        AsmWriteln(FieldDefinition(sym));
      end;


    procedure TJSAssembler.WriteConstSym(sym: tconstsym);
      begin
        AsmWrite('.field ');
        AsmWriteln(ConstDefinition(sym));
      end;


    procedure TJSAssembler.WriteSymtableVarSyms(st: TSymtable);
      var
        sym : tsym;
        i,j : 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));
                 if (sym.typ=staticvarsym) and
                    assigned(tstaticvarsym(sym).defaultconstsym) then
                   WriteFieldSym(tabstractvarsym(tstaticvarsym(sym).defaultconstsym));
               end;
             constsym:
               begin
                 { multiple procedures can have constants with the same name }
                 if not assigned(sym.owner.defowner) or
                    (tdef(sym.owner.defowner).typ<>procdef) then
                   WriteConstSym(tconstsym(sym));
               end;
             procsym:
               begin
                 for j:=0 to tprocsym(sym).procdeflist.count-1 do
                   if not(df_generic in tprocdef(tprocsym(sym).procdeflist[j]).defoptions) then
                     WriteSymtableVarSyms(tprocdef(tprocsym(sym).procdeflist[j]).localst);
               end;
           end;
         end;
      end;


    procedure TJSAssembler.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)) and
                     not(df_generic in def.defoptions) then
                    begin
                      WriteProcDef(tprocdef(def));
                      if assigned(tprocdef(def).localst) then
                        WriteSymtableProcdefs(tprocdef(def).localst);
                    end;
                end;
            end;
          end;
      end;

    procedure TJSAssembler.WriteSymtableStructDefs(st: TSymtable);
      var
        i   : longint;
        def : tdef;
        obj : tabstractrecorddef;
        nestedstructs: tfpobjectlist;
      begin
        if not assigned(st) then
          exit;
        nestedstructs:=tfpobjectlist.create(false);
        for i:=0 to st.DefList.Count-1 do
          begin
            def:=tdef(st.DefList[i]);
            if df_generic in def.defoptions then
              continue;
            case def.typ of
              objectdef:
                if not(oo_is_external in tobjectdef(def).objectoptions) then
                  nestedstructs.add(def);
              recorddef:
                nestedstructs.add(def);
            end;
          end;
        for i:=0 to nestedstructs.count-1 do
          begin
            obj:=tabstractrecorddef(nestedstructs[i]);
            NewAsmFileForStructDef(obj);
            WriteExtraHeader(obj);
            WriteSymtableVarSyms(obj.symtable);
            AsmLn;
            WriteSymtableProcDefs(obj.symtable);
            WriteSymtableStructDefs(obj.symtable);
          end;
        nestedstructs.free;
      end;

    constructor TJSAssembler.Create(smart: boolean);
      begin
        inherited create(smart);
        InstrWriter:=TJSInstrWriter.Create(self);
        asmfiles:=TCmdStrList.Create;
      end;


    procedure TJSAssembler.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);

      WriteSymtableStructDefs(current_module.globalsymtable);
      WriteSymtableStructDefs(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;


    procedure TJSAssembler.RemoveAsm;
      var
        g : file;
      begin
        inherited;
        if cs_asm_leave in current_settings.globalswitches then
         exit;
        while not asmfiles.empty do
          begin
            if cs_asm_extern in current_settings.globalswitches then
             AsmRes.AddDeleteCommand(asmfiles.GetFirst)
            else
             begin
               assign(g,asmfiles.GetFirst);
               {$I-}
                erase(g);
               {$I+}
               if ioresult<>0 then;
             end;
          end;
      end;

{****************************************************************************}
{                             JS Instruction Writer                          }
{****************************************************************************}

     constructor TJSInstrWriter.create(_owner: TJSAssembler);
       begin
         inherited create;
         owner := _owner;
       end;

    function getreferencestring(var ref : treference) : ansistring;
      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
        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
          //    result:=constsingle(o.sval);
          //  end;
          //top_double:
          //  begin
          //    result:=constdouble(o.dval);
          //  end;
          //top_string:
          //  begin
          //    result:=constastr(o.pcval,o.pcvallen);
          //  end;
          //top_wstring:
          //  begin
          //    result:=constwstr(o.pwstrval^.data,getlengthwidestring(o.pwstrval));
          //  end
          else
            internalerror(2010122802);
        end;
      end;


    procedure TJSInstrWriter.WriteInstruction(hp: tai);
      var
        s: ansistring;
        i: byte;
        sep: ansistring;
      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_js_asmjs_info : tasminfo =
       (
         id     : as_js_asmjs;
         idtxt  : 'asm.js';
         asmbin : '';
         asmcmd : '';
         supported_targets : [system_jvm_java32,system_jvm_android32];
         flags : [];
         labelprefix : 'L';
         comment : ' ; ';
         dollarsign : '$';
       );


begin
  RegisterAssembler(as_js_asmjs_info,TJSAssembler);
end.