+ initial skeleton of the js backend

git-svn-id: branches/js@27484 -

.gitattributes

@@ -37,6 +37,7 @@ 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/agjs.pas svneol=native#text/pascal
 compiler/alpha/aasmcpu.pas svneol=native#text/plain
 compiler/alpha/agaxpgas.pas svneol=native#text/plain
 compiler/alpha/aoptcpu.pas svneol=native#text/plain
@@ -289,6 +290,25 @@ compiler/ia64/ia64reg.dat svneol=native#text/plain
 compiler/ia64/symcpu.pas svneol=native#text/plain
 compiler/impdef.pas svneol=native#text/plain
 compiler/import.pas svneol=native#text/plain
+compiler/js/aasmcpu.pas svneol=native#text/pascal
+compiler/js/cgcpu.pas svneol=native#text/pascal
+compiler/js/cpubase.pas svneol=native#text/pascal
+compiler/js/cpuinfo.pas svneol=native#text/pascal
+compiler/js/cpunode.pas svneol=native#text/pascal
+compiler/js/cpupara.pas svneol=native#text/pascal
+compiler/js/cpupi.pas svneol=native#text/pascal
+compiler/js/cputarg.pas svneol=native#text/pascal
+compiler/js/hlcgcpu.pas svneol=native#text/pascal
+compiler/js/rgcpu.pas svneol=native#text/pascal
+compiler/js/rjscon.inc svneol=native#text/plain
+compiler/js/rjsnor.inc svneol=native#text/plain
+compiler/js/rjsnum.inc svneol=native#text/plain
+compiler/js/rjsrni.inc svneol=native#text/plain
+compiler/js/rjssri.inc svneol=native#text/plain
+compiler/js/rjsstd.inc svneol=native#text/plain
+compiler/js/rjssup.inc svneol=native#text/plain
+compiler/js/symcpu.pas svneol=native#text/plain
+compiler/js/tgcpu.pas svneol=native#text/pascal
 compiler/jvm/aasmcpu.pas svneol=native#text/plain
 compiler/jvm/cgcpu.pas svneol=native#text/plain
 compiler/jvm/cpubase.pas svneol=native#text/plain
@@ -594,6 +614,7 @@ compiler/ppcgen/ngppccnv.pas svneol=native#text/plain
 compiler/ppcgen/ngppcinl.pas svneol=native#text/plain
 compiler/ppcgen/ngppcset.pas svneol=native#text/plain
 compiler/ppcgen/rgcpu.pas svneol=native#text/plain
+compiler/ppcjs.lpi svneol=native#text/plain
 compiler/ppcjvm.lpi svneol=native#text/plain
 compiler/ppcmips.lpi svneol=native#text/plain
 compiler/ppcmipsel.lpi svneol=native#text/plain
@@ -748,6 +769,7 @@ compiler/utils/mkarmins.pp svneol=native#text/plain
 compiler/utils/mkarmreg.pp svneol=native#text/plain
 compiler/utils/mkavrreg.pp svneol=native#text/plain
 compiler/utils/mkia64reg.pp svneol=native#text/pascal
+compiler/utils/mkjsreg.pp svneol=native#text/pascal
 compiler/utils/mkjvmreg.pp svneol=native#text/plain
 compiler/utils/mkmpsreg.pp svneol=native#text/plain
 compiler/utils/mkppcreg.pp svneol=native#text/plain

compiler/agjs.pas

@@ -0,0 +1,1233 @@
+{
+    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.

compiler/fpcdefs.inc

@@ -206,7 +206,6 @@
   {$endif mips}
 {$endif mipsel}
 
-
 {$ifdef mips}
   {$ifndef mips64}
     {$define cpu32bit}
@@ -233,6 +232,14 @@
   {$define SUPPORT_GET_FRAME}
 {$endif}
 
+{$ifdef js}
+  {$define cpu32bit}
+  {$define cpu32bitalu}
+  {$define cpu32bitaddr}
+  {$define cpuhighleveltarget}
+  {$define symansistr}
+{$endif}
+
 {$ifdef aarch64}
   {$define cpu64bit}
   {$define cpu64bitaddr}

compiler/globals.pas

@@ -473,6 +473,11 @@ interface
         optimizecputype : cpu_none;
         fputype : fpu_standard;
   {$endif jvm}
+  {$ifdef js}
+        cputype : cpu_none;
+        optimizecputype : cpu_none;
+        fputype : fpu_standard;
+  {$endif js}
   {$ifdef aarch64}
         cputype : cpu_armv8;
         optimizecputype : cpu_armv8;

compiler/js/aasmcpu.pas

@@ -0,0 +1,304 @@
+{
+    Copyright (c) 1999-2002 by Mazen Neifer
+
+    Contains the assembler object for the JVM
+
+    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 aasmcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  cclasses,
+  globtype,globals,verbose,
+  aasmbase,aasmtai,aasmdata,aasmsym,
+  cgbase,cgutils,cpubase,cpuinfo,
+  widestr;
+
+    { fake, there are no "mov reg,reg" instructions here }
+    const
+      { "mov reg,reg" source operand number }
+      O_MOV_SOURCE = 0;
+      { "mov reg,reg" source operand number }
+      O_MOV_DEST = 0;
+
+    type
+
+      { taicpu }
+
+      taicpu = class(tai_cpu_abstract_sym)
+         constructor op_none(op : tasmop);
+
+         constructor op_reg(op : tasmop;_op1 : tregister);
+         constructor op_const(op : tasmop;_op1 : aint);
+         constructor op_ref(op : tasmop;const _op1 : treference);
+         constructor op_sym(op : tasmop;_op1 : tasmsymbol);
+
+         constructor op_sym_const(op : tasmop;_op1 : tasmsymbol;_op2 : aint);
+
+         constructor op_single(op : tasmop;_op1 : single);
+         constructor op_double(op : tasmop;_op1 : double);
+         constructor op_string(op : tasmop;_op1len : aint;_op1 : pchar);
+         constructor op_wstring(op : tasmop;_op1 : pcompilerwidestring);
+
+         procedure loadsingle(opidx:longint;f:single);
+         procedure loaddouble(opidx:longint;d:double);
+         procedure loadstr(opidx:longint;vallen: aint;pc: pchar);
+         procedure loadpwstr(opidx:longint;pwstr:pcompilerwidestring);
+
+
+         { register allocation }
+         function is_same_reg_move(regtype: Tregistertype):boolean; override;
+
+         { register spilling code }
+         function spilling_get_operation_type(opnr: longint): topertype;override;
+      end;
+
+      tai_align = class(tai_align_abstract)
+        { nothing to add }
+      end;
+
+    procedure InitAsm;
+    procedure DoneAsm;
+
+    function spilling_create_load(const ref:treference;r:tregister):Taicpu;
+    function spilling_create_store(r:tregister; const ref:treference):Taicpu;
+
+implementation
+
+{*****************************************************************************
+                                 taicpu Constructors
+*****************************************************************************}
+
+    constructor taicpu.op_none(op : tasmop);
+      begin
+        inherited create(op);
+      end;
+
+
+    constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
+      begin
+        inherited create(op);
+        ops:=1;
+        loadreg(0,_op1);
+      end;
+
+
+    constructor taicpu.op_ref(op : tasmop;const _op1 : treference);
+      begin
+        inherited create(op);
+        ops:=1;
+        loadref(0,_op1);
+      end;
+
+
+    constructor taicpu.op_const(op : tasmop;_op1 : aint);
+      begin
+        inherited create(op);
+        ops:=1;
+        loadconst(0,_op1);
+      end;
+
+
+    constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
+      begin
+        inherited create(op);
+        ops:=1;
+        is_jmp:=op in [a_if_acmpeq, a_if_acmpne, a_if_icmpeq, a_if_icmpge, a_if_icmpgt,
+          a_if_icmple, a_if_icmplt, a_if_icmpne,
+          a_ifeq, a_ifge, a_ifgt, a_ifle, a_iflt, a_ifne, a_ifnonnull, a_ifnull];
+        loadsymbol(0,_op1,0);
+      end;
+
+
+    constructor taicpu.op_sym_const(op: tasmop; _op1: tasmsymbol; _op2: aint);
+      begin
+        inherited create(op);
+        ops:=2;
+        loadsymbol(0,_op1,0);
+        loadconst(1,_op2);
+      end;
+
+
+    constructor taicpu.op_single(op: tasmop; _op1: single);
+      begin
+        inherited create(op);
+        ops:=1;
+        loadsingle(0,_op1);
+      end;
+
+
+    constructor taicpu.op_double(op: tasmop; _op1: double);
+      begin
+        inherited create(op);
+        ops:=1;
+        loaddouble(0,_op1);
+      end;
+
+    constructor taicpu.op_string(op: tasmop; _op1len: aint; _op1: pchar);
+      begin
+        inherited create(op);
+        ops:=1;
+        loadstr(0,_op1len,_op1);
+      end;
+
+    constructor taicpu.op_wstring(op: tasmop; _op1: pcompilerwidestring);
+      begin
+        inherited create(op);
+        ops:=1;
+        loadpwstr(0,_op1);
+      end;
+
+
+    procedure taicpu.loadsingle(opidx:longint;f:single);
+      begin
+        //allocate_oper(opidx+1);
+        //with oper[opidx]^ do
+        // begin
+        //   if typ<>top_single then
+        //     clearop(opidx);
+        //   sval:=f;
+        //   typ:=top_single;
+        // end;
+        internalerror(2014031401);
+      end;
+
+
+    procedure taicpu.loaddouble(opidx: longint; d: double);
+      begin
+        //allocate_oper(opidx+1);
+        //with oper[opidx]^ do
+        // begin
+        //   if typ<>top_double then
+        //     clearop(opidx);
+        //   dval:=d;
+        //   typ:=top_double;
+        // end;
+        internalerror(2014031402);
+      end;
+
+
+    procedure taicpu.loadstr(opidx: longint; vallen: aint; pc: pchar);
+      begin
+        //allocate_oper(opidx+1);
+        //with oper[opidx]^ do
+        // begin
+        //   clearop(opidx);
+        //   pcvallen:=vallen;
+        //   getmem(pcval,vallen);
+        //   move(pc^,pcval^,vallen);
+        //   typ:=top_string;
+        // end;
+        internalerror(2014031403);
+      end;
+
+
+    procedure taicpu.loadpwstr(opidx:longint;pwstr:pcompilerwidestring);
+      begin
+        //allocate_oper(opidx+1);
+        //with oper[opidx]^ do
+        // begin
+        //   clearop(opidx);
+        //   initwidestring(pwstrval);
+        //   copywidestring(pwstr,pwstrval);
+        //   typ:=top_wstring;
+        // end;
+        internalerror(2014031404);
+      end;
+
+
+    function taicpu.is_same_reg_move(regtype: Tregistertype):boolean;
+      begin
+        result:=false;
+      end;
+
+
+    function taicpu.spilling_get_operation_type(opnr: longint): topertype;
+      begin
+        case opcode of
+          a_iinc:
+            result:=operand_readwrite;
+          a_aastore,
+          a_astore,
+          a_astore_0,
+          a_astore_1,
+          a_astore_2,
+          a_astore_3,
+          a_bastore,
+          a_castore,
+          a_dastore,
+          a_dstore,
+          a_dstore_0,
+          a_dstore_1,
+          a_dstore_2,
+          a_dstore_3,
+          a_fastore,
+          a_fstore,
+          a_fstore_0,
+          a_fstore_1,
+          a_fstore_2,
+          a_fstore_3,
+          a_iastore,
+          a_istore,
+          a_istore_0,
+          a_istore_1,
+          a_istore_2,
+          a_istore_3,
+          a_lastore,
+          a_lstore,
+          a_lstore_0,
+          a_lstore_1,
+          a_lstore_2,
+          a_lstore_3,
+          a_sastore:
+            result:=operand_write;
+          else
+            result:=operand_read;
+        end;
+      end;
+
+
+    function spilling_create_load(const ref:treference;r:tregister):Taicpu;
+      begin
+       internalerror(2010122614);
+       result:=nil;
+      end;
+
+
+    function spilling_create_store(r:tregister; const ref:treference):Taicpu;
+      begin
+       internalerror(2010122615);
+       result:=nil;
+      end;
+
+
+    procedure InitAsm;
+      begin
+      end;
+
+
+    procedure DoneAsm;
+      begin
+      end;
+
+begin
+  cai_cpu:=taicpu;
+  cai_align:=tai_align;
+end.

compiler/js/cgcpu.pas

@@ -0,0 +1,129 @@
+{
+    Copyright (c) 2010 by Jonas Maebe
+
+    This unit implements the code generator for JS
+
+    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 cgcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+       globtype,parabase,
+       cgbase,cgutils,cgobj,cghlcpu,
+       aasmbase,aasmtai,aasmdata,aasmcpu,
+       cpubase,cpuinfo,
+       node,symconst,SymType,symdef,
+       rgcpu;
+
+    type
+      TCgJS=class(thlbasecgcpu)
+     public
+        procedure init_register_allocators;override;
+        procedure done_register_allocators;override;
+        function  getintregister(list:TAsmList;size:Tcgsize):Tregister;override;
+        function  getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override;
+        function  getaddressregister(list:TAsmList):Tregister;override;
+        procedure do_register_allocation(list:TAsmList;headertai:tai);override;
+      end;
+
+    procedure create_codegen;
+
+implementation
+
+  uses
+    globals,verbose,systems,cutils,
+    paramgr,fmodule,
+    tgobj,
+    procinfo,cpupi;
+
+
+{****************************************************************************
+                              Assembler code
+****************************************************************************}
+
+    procedure TCgJS.init_register_allocators;
+      begin
+        inherited init_register_allocators;
+{$ifndef cpu64bitaddr}
+        rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBD,
+          [RS_R0],first_int_imreg,[]);
+{$else not cpu64bitaddr}
+        rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBQ,
+          [RS_R0],first_int_imreg,[]);
+{$endif not cpu64bitaddr}
+        rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBFS,
+          [RS_R0],first_fpu_imreg,[]);
+        rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE,
+          [RS_R0],first_mm_imreg,[]);
+      end;
+
+
+    procedure TCgJS.done_register_allocators;
+      begin
+        rg[R_INTREGISTER].free;
+        rg[R_FPUREGISTER].free;
+        rg[R_MMREGISTER].free;
+        inherited done_register_allocators;
+      end;
+
+
+    function TCgJS.getintregister(list:TAsmList;size:Tcgsize):Tregister;
+      begin
+        if not(size in [OS_64,OS_S64]) then
+          result:=rg[R_INTREGISTER].getregister(list,R_SUBD)
+        else
+          result:=rg[R_INTREGISTER].getregister(list,R_SUBQ);
+      end;
+
+
+    function TCgJS.getfpuregister(list:TAsmList;size:Tcgsize):Tregister;
+      begin
+        if size=OS_F64 then
+          result:=rg[R_FPUREGISTER].getregister(list,R_SUBFD)
+        else
+          result:=rg[R_FPUREGISTER].getregister(list,R_SUBFS);
+      end;
+
+
+    function TCgJS.getaddressregister(list:TAsmList):Tregister;
+      begin
+        { avoid problems in the compiler where int and addr registers are
+          mixed for now; we currently don't have to differentiate between the
+          two as far as the jvm backend is concerned }
+        result:=rg[R_INTREGISTER].getregister(list,R_SUBD)
+      end;
+
+
+    procedure TCgJS.do_register_allocation(list:TAsmList;headertai:tai);
+      begin
+        { We only run the "register allocation" once for an arbitrary allocator,
+          which will perform the register->temp mapping for all register types.
+          This allows us to easily reuse temps. }
+        trgcpu(rg[R_INTREGISTER]).do_all_register_allocation(list,headertai);
+      end;
+
+
+    procedure create_codegen;
+      begin
+        cg:=TCgJS.Create;
+      end;
+
+end.

compiler/js/cpubase.pas

@@ -0,0 +1,338 @@
+{
+    Copyright (c) 2010 by Jonas Maebe
+
+    Contains the base types for the Java VM
+
+    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.
+
+ ****************************************************************************
+}
+{ This Unit contains the base types for the Java Virtual Machine
+}
+unit cpubase;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  globtype,
+  aasmbase,cpuinfo,cgbase;
+
+
+{*****************************************************************************
+                                Assembler Opcodes
+*****************************************************************************}
+
+    type
+      TAsmOp=(A_None,
+        a_aaload, a_aastore, a_aconst_null,
+        a_aload, a_aload_0, a_aload_1, a_aload_2, a_aload_3,
+        a_anewarray, a_areturn, a_arraylength,
+        a_astore, a_astore_0, a_astore_1, a_astore_2, a_astore_3,
+        a_athrow, a_baload, a_bastore, a_bipush, a_breakpoint,
+        a_caload, a_castore, a_checkcast,
+        a_d2f, a_d2i, a_d2l, a_dadd, a_daload, a_dastore, a_dcmpg, a_dcmpl,
+        a_dconst_0, a_dconst_1, a_ddiv,
+        a_dload, a_dload_0, a_dload_1, a_dload_2, a_dload_3,
+        a_dmul, a_dneg, a_drem, a_dreturn,
+        a_dstore, a_dstore_0, a_dstore_1, a_dstore_2, a_dstore_3,
+        a_dsub,
+        a_dup, a_dup2, a_dup2_x1, a_dup2_x2, a_dup_x1, a_dup_x2,
+        a_f2d, a_f2i, a_f2l, a_fadd, a_faload, a_fastore, a_fcmpg, a_fcmpl,
+        a_fconst_0, a_fconst_1, a_fconst_2, a_fdiv,
+        a_fload, a_fload_0, a_fload_1, a_fload_2, a_fload_3,
+        a_fmul, a_fneg, a_frem, a_freturn,
+        a_fstore, a_fstore_0, a_fstore_1, a_fstore_2, a_fstore_3,
+        a_fsub,
+        a_getfield, a_getstatic,
+        a_goto, a_goto_w,
+        a_i2b, a_i2c, a_i2d, a_i2f, a_i2l, a_i2s,
+        a_iadd, a_iaload, a_iand, a_iastore,
+        a_iconst_m1, a_iconst_0, a_iconst_1, a_iconst_2, a_iconst_3,
+        a_iconst_4, a_iconst_5,
+        a_idiv,
+        a_if_acmpeq, a_if_acmpne, a_if_icmpeq, a_if_icmpge, a_if_icmpgt,
+        a_if_icmple, a_if_icmplt, a_if_icmpne,
+        a_ifeq, a_ifge, a_ifgt, a_ifle, a_iflt, a_ifne, a_ifnonnull, a_ifnull,
+        a_iinc,
+        a_iload, a_iload_0, a_iload_1, a_iload_2, a_iload_3,
+        a_imul, a_ineg,
+        a_instanceof,
+        a_invokeinterface, a_invokespecial, a_invokestatic, a_invokevirtual,
+        a_ior, a_irem, a_ireturn, a_ishl, a_ishr,
+        a_istore, a_istore_0, a_istore_1, a_istore_2, a_istore_3,
+        a_isub, a_iushr, a_ixor,
+        a_jsr, a_jsr_w,
+        a_l2d, a_l2f, a_l2i, a_ladd, a_laload, a_land, a_lastore, a_lcmp,
+        a_lconst_0, a_lconst_1,
+        a_ldc, a_ldc2_w, a_ldc_w, a_ldiv,
+        a_lload, a_lload_0, a_lload_1, a_lload_2, a_lload_3,
+        a_lmul, a_lneg,
+        a_lookupswitch,
+        a_lor, a_lrem,
+        a_lreturn,
+        a_lshl, a_lshr,
+        a_lstore, a_lstore_0, a_lstore_1, a_lstore_2, a_lstore_3,
+        a_lsub, a_lushr, a_lxor,
+        a_monitorenter,
+        a_monitorexit,
+        a_multianewarray,
+        a_new,
+        a_newarray,
+        a_nop,
+        a_pop, a_pop2,
+        a_putfield, a_putstatic,
+        a_ret, a_return,
+        a_saload, a_sastore, a_sipush,
+        a_swap,
+        a_tableswitch,
+        a_wide
+      );
+
+      {# This should define the array of instructions as string }
+      op2strtable=array[tasmop] of string[8];
+
+    Const
+      {# First value of opcode enumeration }
+      firstop = low(tasmop);
+      {# Last value of opcode enumeration  }
+      lastop  = high(tasmop);
+
+
+{*****************************************************************************
+                                  Registers
+*****************************************************************************}
+
+    type
+      { Number of registers used for indexing in tables }
+      tregisterindex=0..{$i rjsnor.inc}-1;
+      totherregisterset = set of tregisterindex;
+
+    const
+      { Available Superregisters }
+      {$i rjssup.inc}
+
+      { No Subregisters }
+      R_SUBWHOLE = R_SUBNONE;
+
+      { Available Registers }
+      {$i rjscon.inc}
+
+      { aliases }
+      { used as base register in references for parameters passed to
+        subroutines: these are passed on the evaluation stack, but this way we
+        can use the offset field to indicate the order, which is used by ncal
+        to sort the parameters }
+      NR_EVAL_STACK_BASE = NR_R0;
+
+      maxvarregs = 1;
+      maxfpuvarregs = 1;
+
+      { Integer Super registers first and last }
+      first_int_imreg = 10;
+
+      { Float Super register first and last }
+      first_fpu_imreg     = 10;
+
+      { MM Super register first and last }
+      first_mm_imreg     = 10;
+
+      regnumber_table : array[tregisterindex] of tregister = (
+        {$i rjsnum.inc}
+      );
+
+     EVALSTACKLOCS = [LOC_REGISTER,LOC_CREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER,
+       LOC_MMREGISTER,LOC_CMMREGISTER,LOC_SUBSETREG,LOC_CSUBSETREG];
+
+{*****************************************************************************
+                                Conditions
+*****************************************************************************}
+
+   type
+     // not used by jvm target
+     TAsmCond=(C_None);
+
+{*****************************************************************************
+                                 Constants
+*****************************************************************************}
+
+    const
+      max_operands = 2;
+
+
+{*****************************************************************************
+                          Default generic sizes
+*****************************************************************************}
+
+{$ifdef cpu64bitaddr}
+      {# Defines the default address size for a processor,
+        -- fake for JVM, only influences default width of
+           arithmetic calculations }
+      OS_ADDR = OS_64;
+      {# the natural int size for a processor,
+         has to match osuinttype/ossinttype as initialized in psystem }
+      OS_INT = OS_64;
+      OS_SINT = OS_S64;
+{$else}
+      {# Defines the default address size for a processor,
+        -- fake for JVM, only influences default width of
+           arithmetic calculations }
+      OS_ADDR = OS_32;
+      {# the natural int size for a processor,
+         has to match osuinttype/ossinttype as initialized in psystem }
+      OS_INT = OS_32;
+      OS_SINT = OS_S32;
+{$endif}
+      {# the maximum float size for a processor,           }
+      OS_FLOAT = OS_F64;
+      {# the size of a vector register for a processor     }
+      OS_VECTOR = OS_M128;
+
+{*****************************************************************************
+                          Generic Register names
+*****************************************************************************}
+
+      { dummies, not used for JVM }
+
+      {# Stack pointer register }
+      { used as base register in references to indicate that it's a local }
+      NR_STACK_POINTER_REG = NR_R1;
+      RS_STACK_POINTER_REG = RS_R1;
+      {# Frame pointer register }
+      NR_FRAME_POINTER_REG = NR_STACK_POINTER_REG;
+      RS_FRAME_POINTER_REG = RS_STACK_POINTER_REG;
+
+      { Java results are returned on the evaluation stack, not via a register }
+
+      { Results are returned in this register (32-bit values) }
+      NR_FUNCTION_RETURN_REG = NR_NO;
+      RS_FUNCTION_RETURN_REG = RS_NO;
+      { Low part of 64bit return value }
+      NR_FUNCTION_RETURN64_LOW_REG = NR_NO;
+      RS_FUNCTION_RETURN64_LOW_REG = RS_NO;
+      { High part of 64bit return value }
+      NR_FUNCTION_RETURN64_HIGH_REG = NR_NO;
+      RS_FUNCTION_RETURN64_HIGH_REG = RS_NO;
+      { The value returned from a function is available in this register }
+      NR_FUNCTION_RESULT_REG = NR_FUNCTION_RETURN_REG;
+      RS_FUNCTION_RESULT_REG = RS_FUNCTION_RETURN_REG;
+      { The lowh part of 64bit value returned from a function }
+      NR_FUNCTION_RESULT64_LOW_REG = NR_FUNCTION_RETURN64_LOW_REG;
+      RS_FUNCTION_RESULT64_LOW_REG = RS_FUNCTION_RETURN64_LOW_REG;
+      { The high part of 64bit value returned from a function }
+      NR_FUNCTION_RESULT64_HIGH_REG = NR_FUNCTION_RETURN64_HIGH_REG;
+      RS_FUNCTION_RESULT64_HIGH_REG = RS_FUNCTION_RETURN64_HIGH_REG;
+
+      NR_FPU_RESULT_REG = NR_NO;
+      NR_MM_RESULT_REG = NR_NO;
+
+
+{*****************************************************************************
+                       GCC /ABI linking information
+*****************************************************************************}
+
+      { dummies, not used for JVM }
+
+      {# Registers which must be saved when calling a routine
+
+      }
+      saved_standard_registers : array[0..0] of tsuperregister = (
+        RS_NO
+      );
+
+      { this is only for the generic code which is not used for this architecture }
+      saved_address_registers : array[0..0] of tsuperregister = (RS_INVALID);
+      saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
+
+      { Required parameter alignment when calling a routine }
+      std_param_align = 1;
+
+
+{*****************************************************************************
+                            CPU Dependent Constants
+*****************************************************************************}
+
+      maxfpuregs = 0;
+
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
+    function reg_cgsize(const reg: tregister) : tcgsize;
+
+    function std_regnum_search(const s:string):Tregister;
+    function std_regname(r:Tregister):string;
+    function findreg_by_number(r:Tregister):tregisterindex;
+
+implementation
+
+uses
+  rgbase;
+
+{*****************************************************************************
+                                  Helpers
+*****************************************************************************}
+
+    const
+      std_regname_table : array[tregisterindex] of string[15] = (
+        {$i rjsstd.inc}
+      );
+
+      regnumber_index : array[tregisterindex] of tregisterindex = (
+        {$i rjsrni.inc}
+      );
+
+      std_regname_index : array[tregisterindex] of tregisterindex = (
+        {$i rjssri.inc}
+      );
+
+    function reg_cgsize(const reg: tregister): tcgsize;
+      begin
+        result:=OS_NO;
+      end;
+
+
+    function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister;
+      begin
+        cgsize2subreg:=R_SUBNONE;
+      end;
+
+
+    function std_regnum_search(const s:string):Tregister;
+      begin
+        result:=NR_NO;
+      end;
+
+
+    function findreg_by_number(r:Tregister):tregisterindex;
+      begin
+        result:=findreg_by_number_table(r,regnumber_index);
+      end;
+
+    function std_regname(r:Tregister):string;
+      var
+        p : tregisterindex;
+      begin
+        p:=findreg_by_number_table(r,regnumber_index);
+        if p<>0 then
+          result:=std_regname_table[p]
+        else
+          result:=generic_regname(r);
+      end;
+
+
+end.

compiler/js/cpuinfo.pas

@@ -0,0 +1,75 @@
+{
+    Copyright (c) 2010 by the Free Pascal development team
+
+    Basic Processor information for the Java VM
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+Unit cpuinfo;
+
+Interface
+
+  uses
+    globtype;
+
+Type
+   bestreal = double;
+   ts32real = single;
+   ts64real = double;
+   ts80real = extended;
+   ts128real = extended;
+   ts64comp = comp;
+
+   pbestreal=^bestreal;
+
+   { possible supported processors for this target }
+   tcputype =
+      (cpu_none,
+       { JS for asm.js }
+       cpu_asmjs
+      );
+
+   tfputype =
+     (fpu_none,
+      fpu_standard
+     );
+
+
+Const
+   { calling conventions supported by the code generator }
+   supported_calling_conventions : tproccalloptions = [
+     pocall_internproc
+   ];
+
+   cputypestr : array[tcputype] of string[9] = ('',
+     'ASMJS'
+   );
+
+   fputypestr : array[tfputype] of string[8] = (
+     'NONE',
+     'STANDARD'
+   );
+
+   { Supported optimizations, only used for information }
+   supported_optimizerswitches = genericlevel1optimizerswitches+
+                                 genericlevel2optimizerswitches+
+                                 genericlevel3optimizerswitches-
+                                 { no need to write info about those }
+                                 [cs_opt_level1,cs_opt_level2,cs_opt_level3]+
+                                 [cs_opt_loopunroll,cs_opt_nodecse];
+
+   level1optimizerswitches = genericlevel1optimizerswitches;
+   level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_nodecse];
+   level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}];
+   level4optimizerswitches = genericlevel4optimizerswitches + level3optimizerswitches + [];
+
+Implementation
+
+end.

compiler/js/cpunode.pas

@@ -0,0 +1,38 @@
+{******************************************************************************
+    Copyright (c) 2000-2010 by Florian Klaempfl and Jonas Maebe
+
+    Includes the JS 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,
+    { these are not really nodes }
+    rgcpu,tgcpu;
+
+end.

compiler/js/cpupara.pas

@@ -0,0 +1,306 @@
+{
+    Copyright (c) 1998-2010 by Florian Klaempfl, Jonas Maebe
+
+    Calling conventions for the JVM
+
+    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 cpupara;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      globtype,
+      cclasses,
+      aasmtai,aasmdata,
+      cpubase,cpuinfo,
+      symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase,cgutils;
+
+    type
+
+      { TJSParaManager }
+
+      TJSParaManager=class(TParaManager)
+        function  push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
+        function  keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
+        function  push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
+        function  push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
+        function  push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;override;
+        {Returns a structure giving the information on the storage of the parameter
+        (which must be an integer parameter)
+        @param(nr Parameter number of routine, starting from 1)}
+        procedure getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
+        function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
+        function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+        function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
+        function param_use_paraloc(const cgpara: tcgpara): boolean; override;
+        function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
+        function is_stack_paraloc(paraloc: pcgparalocation): boolean;override;
+      private
+        procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
+                                             var parasize:longint);
+      end;
+
+implementation
+
+    uses
+      cutils,verbose,systems,
+      defutil,
+      aasmcpu,
+      hlcgobj;
+
+
+    procedure TJSParaManager.GetIntParaLoc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
+      begin
+        { not yet implemented/used }
+        internalerror(2010121001);
+      end;
+
+    function TJSParaManager.push_high_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+      begin
+        { we don't need a separate high parameter, since all arrays in Java
+          have an implicit associated length }
+        if not is_open_array(def) and
+           not is_array_of_const(def) then
+          result:=inherited
+        else
+          result:=false;
+      end;
+
+
+    function TJSParaManager.keep_para_array_range(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+      begin
+        { even though these don't need a high parameter (see push_high_param),
+          we do have to keep the original parameter's array length because it's
+          used by the compiler (to determine the size of the array to construct
+          to pass to an array of const parameter)  }
+        if not is_array_of_const(def) then
+          result:=inherited
+        else
+          result:=true;
+      end;
+
+
+    { true if a parameter is too large to copy and only the address is pushed }
+    function TJSParaManager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
+      begin
+        result:=
+          // jvmimplicitpointertype(def) or
+          ((def.typ=formaldef) and
+           not(varspez in [vs_var,vs_out]));
+      end;
+
+
+    function TJSParaManager.push_copyout_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean;
+      begin
+        { in principle also for vs_constref, but since we can't have real
+          references, that won't make a difference }
+        result:=
+          (varspez in [vs_var,vs_out,vs_constref]) { and
+          not jvmimplicitpointertype(def) };
+      end;
+
+
+    function TJSParaManager.push_size(varspez: tvarspez; def: tdef; calloption: tproccalloption): longint;
+      begin
+        { all aggregate types are emulated using indirect pointer types }
+        if def.typ in [arraydef,recorddef,setdef,stringdef] then
+          result:=4
+        else
+          result:=inherited;
+      end;
+
+
+    function TJSParaManager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
+      var
+        paraloc : pcgparalocation;
+        retcgsize  : tcgsize;
+      begin
+        result.init;
+        result.alignment:=get_para_align(p.proccalloption);
+        if not assigned(forcetempdef) then
+          result.def:=p.returndef
+        else
+          begin
+            result.def:=forcetempdef;
+            result.temporary:=true;
+          end;
+        //!!!! result.def:=get_para_push_size(result.def);
+        { void has no location }
+        if is_void(result.def) then
+          begin
+            paraloc:=result.add_location;
+            result.size:=OS_NO;
+            result.intsize:=0;
+            paraloc^.size:=OS_NO;
+            paraloc^.def:=voidtype;
+            paraloc^.loc:=LOC_VOID;
+            exit;
+          end;
+        { Constructors return self instead of a boolean }
+        if (p.proctypeoption=potype_constructor) then
+          begin
+            retcgsize:=OS_INT;
+            result.intsize:=sizeof(pint);
+          end
+{!!!!        else if jvmimplicitpointertype(result.def) then
+          begin
+            retcgsize:=OS_ADDR;
+            result.def:=getpointerdef(result.def);
+          end }
+        else
+          begin
+            retcgsize:=def_cgsize(result.def);
+            result.intsize:=result.def.size;
+          end;
+        result.size:=retcgsize;
+
+        paraloc:=result.add_location;
+        { all values are returned on the evaluation stack }
+        paraloc^.loc:=LOC_REFERENCE;
+        paraloc^.reference.index:=NR_EVAL_STACK_BASE;
+        paraloc^.reference.offset:=0;
+        paraloc^.size:=result.size;
+        paraloc^.def:=result.def;
+      end;
+
+    function TJSParaManager.param_use_paraloc(const cgpara: tcgpara): boolean;
+      begin
+        { all parameters are copied by the VM to local variable locations }
+        result:=true;
+      end;
+
+    function TJSParaManager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+      begin
+        { not as efficient as returning in param for jvmimplicitpointertypes,
+          but in the latter case the routines are harder to use from Java
+          (especially for arrays), because the caller then manually has to
+          allocate the instance/array of the right size }
+        Result:=false;
+      end;
+
+    function TJSParaManager.is_stack_paraloc(paraloc: pcgparalocation): boolean;
+      begin
+        { all parameters are passed on the evaluation stack }
+        result:=true;
+      end;
+
+
+    function TJSParaManager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+      var
+        parasize : longint;
+      begin
+        parasize:=0;
+        { calculate the registers for the normal parameters }
+        create_paraloc_info_intern(p,callerside,p.paras,parasize);
+        { append the varargs }
+        create_paraloc_info_intern(p,callerside,varargspara,parasize);
+        result:=parasize;
+      end;
+
+
+    procedure TJSParaManager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
+                                                           var parasize:longint);
+      var
+        paraloc      : pcgparalocation;
+        i            : integer;
+        hp           : tparavarsym;
+        paracgsize   : tcgsize;
+        paraofs      : longint;
+        paradef      : tdef;
+      begin
+        paraofs:=0;
+        for i:=0 to paras.count-1 do
+          begin
+            hp:=tparavarsym(paras[i]);
+            if push_copyout_param(hp.varspez,hp.vardef,p.proccalloption) then
+              begin
+                { passed via array reference (instead of creating a new array
+                  type for every single parameter, use java_jlobject) }
+                paracgsize:=OS_ADDR;
+                paradef:=java_jlobject;
+              end
+{!!!!            else if jvmimplicitpointertype(hp.vardef) then
+              begin
+                paracgsize:=OS_ADDR;
+                paradef:=getpointerdef(hp.vardef);
+              end }
+            else
+              begin
+                paracgsize:=def_cgsize(hp.vardef);
+                if paracgsize=OS_NO then
+                  paracgsize:=OS_ADDR;
+                paradef:=hp.vardef;
+              end;
+//!!!!!            paradef:=get_para_push_size(paradef);
+            hp.paraloc[side].reset;
+            hp.paraloc[side].size:=paracgsize;
+            hp.paraloc[side].def:=paradef;
+            hp.paraloc[side].alignment:=std_param_align;
+            hp.paraloc[side].intsize:=tcgsize2size[paracgsize];
+            paraloc:=hp.paraloc[side].add_location;
+            { All parameters are passed on the evaluation stack, pushed from
+              left to right (including self, if applicable). At the callee side,
+              they're available as local variables 0..n-1 (with 64 bit values
+              taking up two slots) }
+            paraloc^.loc:=LOC_REFERENCE;;
+            paraloc^.reference.offset:=paraofs;
+            paraloc^.size:=paracgsize;
+            paraloc^.def:=paradef;
+            case side of
+              callerside:
+                begin
+                  paraloc^.loc:=LOC_REFERENCE;
+                  { we use a fake loc_reference to indicate the stack location;
+                    the offset (set above) will be used by ncal to order the
+                    parameters so they will be pushed in the right order }
+                  paraloc^.reference.index:=NR_EVAL_STACK_BASE;
+                end;
+              calleeside:
+                begin
+                  paraloc^.loc:=LOC_REFERENCE;
+                  paraloc^.reference.index:=NR_STACK_POINTER_REG;
+                end;
+            end;
+            { 2 slots for 64 bit integers and floats, 1 slot for the rest }
+            if not(is_64bit(paradef) or
+                   ((paradef.typ=floatdef) and
+                    (tfloatdef(paradef).floattype=s64real))) then
+              inc(paraofs)
+            else
+              inc(paraofs,2);
+          end;
+        parasize:=paraofs;
+      end;
+
+
+    function TJSParaManager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
+      var
+        parasize : longint;
+      begin
+        parasize:=0;
+        create_paraloc_info_intern(p,side,p.paras,parasize);
+        { Create Function result paraloc }
+        create_funcretloc_info(p,side);
+        { We need to return the size allocated on the stack }
+        result:=parasize;
+      end;
+
+
+begin
+   ParaManager:=TJSParaManager.create;
+end.

compiler/js/cpupi.pas

@@ -0,0 +1,65 @@
+{
+    Copyright (c) 2002-2010 by Florian Klaempfl and Jonas Maebe
+
+    This unit contains the CPU specific part of tprocinfo
+
+    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 cpupi;
+
+{$i fpcdefs.inc}
+
+interface
+
+  uses
+    cutils,
+    procinfo,cpuinfo,
+    psub;
+
+  type
+
+    { TSparcProcInfo }
+
+    TJSProcInfo=class(tcgprocinfo)
+    public
+      procedure set_first_temp_offset;override;
+    end;
+
+implementation
+
+    uses
+      systems,globals,
+      tgobj,paramgr,symconst;
+
+    procedure TJSProcInfo.set_first_temp_offset;
+      begin
+        {
+          Stackframe layout:
+          sp:
+            <incoming parameters>
+          sp+first_temp_offset:
+            <locals>
+            <temp>
+        }
+        procdef.init_paraloc_info(calleeside);
+        tg.setfirsttemp(procdef.calleeargareasize);
+      end;
+
+
+begin
+  cprocinfo:=TJSProcInfo;
+end.

compiler/js/cputarg.pas

@@ -0,0 +1,58 @@
+{
+    Copyright (c) 2001-2010 by Peter Vreman and Jonas Maebe
+
+    Includes the JS 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
+**************************************}
+      ,t_jvm
+
+{**************************************
+             Assemblers
+**************************************}
+      ,agjs
+
+{**************************************
+        Assembler Readers
+**************************************}
+
+{**************************************
+             Debuginfo
+**************************************}
+      //,dbgjasm
+      ;
+
+end.

compiler/js/hlcgcpu.pas

@@ -0,0 +1,64 @@
+{
+    Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
+    Member of the Free Pascal development team
+
+    This unit implements the js high level 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 hlcgcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  globtype,
+  aasmbase,aasmdata,
+  symbase,symconst,symtype,symdef,symsym,
+  cpubase, hlcgobj, cgbase, cgutils, parabase;
+
+  type
+    thlcgjs = class(thlcgobj)
+    public
+      constructor create;
+    end;
+
+  procedure create_hlcodegen;
+
+implementation
+
+  uses
+    verbose,cutils,globals,fmodule,constexp,
+    defutil,
+    aasmtai,aasmcpu,
+    symtable,
+    procinfo,cpuinfo,cgcpu,tgobj;
+
+
+  constructor thlcgjs.create;
+    begin
+    end;
+
+
+  procedure create_hlcodegen;
+    begin
+      hlcg:=thlcgjs.create;
+      create_codegen;
+    end;
+
+end.

compiler/js/rgcpu.pas

@@ -0,0 +1,358 @@
+{
+    Copyright (c) 2010 by Jonas Maebe
+
+    This unit implements the JVM specific class for the register
+    allocator
+
+    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 rgcpu;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+      aasmbase,aasmcpu,aasmtai,aasmdata,
+      cgbase,cgutils,
+      cpubase,
+      rgobj;
+
+    type
+      tspilltemps = array[tregistertype] of ^Tspill_temp_list;
+
+      { trgcpu }
+
+      trgcpu=class(trgobj)
+       protected
+        class procedure do_spill_replace_all(list:TAsmList;instr:taicpu;const spilltemps: tspilltemps);
+        class procedure remove_dummy_load_stores(list: TAsmList; headertai: tai);
+       public
+        { performs the register allocation for *all* register types }
+        class procedure do_all_register_allocation(list: TAsmList; headertai: tai);
+      end;
+
+
+implementation
+
+    uses
+      verbose,cutils,
+      globtype,globals,
+      cgobj,
+      tgobj;
+
+    { trgcpu }
+
+    class procedure trgcpu.do_spill_replace_all(list:TAsmList;instr:taicpu;const spilltemps: tspilltemps);
+      var
+        l: longint;
+        reg: tregister;
+      begin
+        { jvm instructions never have more than one memory (virtual register)
+          operand, so there is no danger of superregister conflicts }
+        for l:=0 to instr.ops-1 do
+          if instr.oper[l]^.typ=top_reg then
+            begin
+              reg:=instr.oper[l]^.reg;
+              instr.loadref(l,spilltemps[getregtype(reg)]^[getsupreg(reg)]);
+            end;
+      end;
+
+
+    class procedure trgcpu.remove_dummy_load_stores(list: TAsmList; headertai: tai);
+
+      type
+        taitypeset =  set of taitype;
+
+      function nextskipping(p: tai; const skip: taitypeset): tai;
+        begin
+          result:=p;
+          if not assigned(result) then
+            exit;
+          repeat
+            result:=tai(result.next);
+          until not assigned(result) or
+                not(result.typ in skip);
+        end;
+
+      function issimpleregstore(p: tai; var reg: tregister; doubleprecisionok: boolean): boolean;
+        const
+          simplestoressp = [a_astore,a_fstore,a_istore];
+          simplestoresdp = [a_dstore,a_lstore];
+        begin
+          result:=
+            assigned(p) and
+            (p.typ=ait_instruction) and
+            ((taicpu(p).opcode in simplestoressp) or
+             (doubleprecisionok and
+              (taicpu(p).opcode in simplestoresdp))) and
+            ((reg=NR_NO) or
+             (taicpu(p).oper[0]^.typ=top_reg) and
+             (taicpu(p).oper[0]^.reg=reg));
+          if result and
+             (reg=NR_NO) then
+            reg:=taicpu(p).oper[0]^.reg;
+        end;
+
+      function issimpleregload(p: tai; var reg: tregister; doubleprecisionok: boolean): boolean;
+        const
+          simpleloadssp = [a_aload,a_fload,a_iload];
+          simpleloadsdp = [a_dload,a_lload];
+        begin
+          result:=
+            assigned(p) and
+            (p.typ=ait_instruction) and
+            ((taicpu(p).opcode in simpleloadssp) or
+             (doubleprecisionok and
+              (taicpu(p).opcode in simpleloadsdp))) and
+            ((reg=NR_NO) or
+             (taicpu(p).oper[0]^.typ=top_reg) and
+             (taicpu(p).oper[0]^.reg=reg));
+          if result and
+             (reg=NR_NO) then
+            reg:=taicpu(p).oper[0]^.reg;
+        end;
+
+      function isregallocoftyp(p: tai; typ: TRegAllocType;var reg: tregister): boolean;
+        begin
+          result:=
+            assigned(p) and
+            (p.typ=ait_regalloc) and
+            (tai_regalloc(p).ratype=typ);
+          if result then
+            if reg=NR_NO then
+              reg:=tai_regalloc(p).reg
+            else
+              result:=tai_regalloc(p).reg=reg;
+        end;
+
+      function regininstruction(p: tai; reg: tregister): boolean;
+        var
+          sr: tsuperregister;
+          i: longint;
+        begin
+          result:=false;
+          if p.typ<>ait_instruction then
+            exit;
+          sr:=getsupreg(reg);
+          for i:=0 to taicpu(p).ops-1 do
+            case taicpu(p).oper[0]^.typ of
+              top_reg:
+                if (getsupreg(taicpu(p).oper[0]^.reg)=sr) then
+                  exit(true);
+              top_ref:
+                begin
+                  if (getsupreg(taicpu(p).oper[0]^.ref^.base)=sr) then
+                    exit(true);
+                  if (getsupreg(taicpu(p).oper[0]^.ref^.index)=sr) then
+                    exit(true);
+{                  if (getsupreg(taicpu(p).oper[0]^.ref^.indexbase)=sr) then
+                    exit(true);
+                  if (getsupreg(taicpu(p).oper[0]^.ref^.indexbase)=sr) then
+                    exit(true); }
+                end;
+            end;
+        end;
+
+      function try_remove_store_dealloc_load(var p: tai): boolean;
+        var
+          dealloc,
+          load: tai;
+          reg: tregister;
+        begin
+          result:=false;
+          { check for:
+              store regx
+              dealloc regx
+              load regx
+            and remove. We don't have to check that the load/store
+            types match, because they have to for this to be
+            valid JVM code }
+          dealloc:=nextskipping(p,[ait_comment]);
+          load:=nextskipping(dealloc,[ait_comment]);
+          reg:=NR_NO;
+          if issimpleregstore(p,reg,true) and
+             isregallocoftyp(dealloc,ra_dealloc,reg) and
+             issimpleregload(load,reg,true) then
+            begin
+              { remove the whole sequence: the store }
+              list.remove(p);
+              p.free;
+              p:=Tai(load.next);
+              { the load }
+              list.remove(load);
+              load.free;
+
+              result:=true;
+            end;
+        end;
+
+
+      var
+        p,next,nextnext: tai;
+        reg: tregister;
+        removedsomething: boolean;
+      begin
+        repeat
+          removedsomething:=false;
+          p:=headertai;
+          while assigned(p) do
+            begin
+              case p.typ of
+                ait_regalloc:
+                  begin
+                    reg:=NR_NO;
+                    next:=nextskipping(p,[ait_comment]);
+                    nextnext:=nextskipping(next,[ait_comment,ait_regalloc]);
+                    if assigned(nextnext) then
+                      begin
+                        { remove
+                            alloc reg
+                            dealloc reg
+
+                          (can appear after optimisations, necessary to prevent
+                           useless stack slot allocations) }
+                        if isregallocoftyp(p,ra_alloc,reg) and
+                           isregallocoftyp(next,ra_dealloc,reg) and
+                           not regininstruction(nextnext,reg) then
+                          begin
+                            list.remove(p);
+                            p.free;
+                            p:=tai(next.next);
+                            list.remove(next);
+                            next.free;
+                            removedsomething:=true;
+                            continue;
+                          end;
+                      end;
+                  end;
+                ait_instruction:
+                  begin
+                    if try_remove_store_dealloc_load(p) then
+                      begin
+                        removedsomething:=true;
+                        continue;
+                      end;
+                    { todo in peephole optimizer:
+                        alloc regx // not double precision
+                        store regx // not double precision
+                        load  regy or memy
+                        dealloc regx
+                        load regx
+                      -> change into
+                        load regy or memy
+                        swap       // can only handle single precision
+
+                      and then
+                        swap
+                        <commutative op>
+                       -> remove swap
+                    }
+                  end;
+              end;
+              p:=tai(p.next);
+            end;
+        until not removedsomething;
+      end;
+
+
+    class procedure trgcpu.do_all_register_allocation(list: TAsmList; headertai: tai);
+      var
+        spill_temps : tspilltemps;
+        templist : TAsmList;
+        intrg,
+        fprg     : trgcpu;
+        p,q      : tai;
+        size     : longint;
+      begin
+        { Since there are no actual registers, we simply spill everything. We
+          use tt_regallocator temps, which are not used by the temp allocator
+          during code generation, so that we cannot accidentally overwrite
+          any temporary values }
+
+        { get references to all register allocators }
+        intrg:=trgcpu(cg.rg[R_INTREGISTER]);
+        fprg:=trgcpu(cg.rg[R_FPUREGISTER]);
+        { determine the live ranges of all registers }
+        intrg.insert_regalloc_info_all(list);
+        fprg.insert_regalloc_info_all(list);
+        { Don't do the actual allocation when -sr is passed }
+        if (cs_no_regalloc in current_settings.globalswitches) then
+          exit;
+        { remove some simple useless store/load sequences }
+        remove_dummy_load_stores(list,headertai);
+        { allocate room to store the virtual register -> temp mapping }
+        spill_temps[R_INTREGISTER]:=allocmem(sizeof(treference)*intrg.maxreg);
+        spill_temps[R_FPUREGISTER]:=allocmem(sizeof(treference)*fprg.maxreg);
+        { List to insert temp allocations into }
+        templist:=TAsmList.create;
+        { allocate/replace all registers }
+        p:=headertai;
+        while assigned(p) do
+          begin
+            case p.typ of
+              ait_regalloc:
+                with Tai_regalloc(p) do
+                  begin
+                    case getregtype(reg) of
+                      R_INTREGISTER:
+                        if getsubreg(reg)=R_SUBD then
+                          size:=4
+                        else
+                          size:=8;
+                      R_ADDRESSREGISTER:
+                        size:=4;
+                      R_FPUREGISTER:
+                        if getsubreg(reg)=R_SUBFS then
+                          size:=4
+                        else
+                          size:=8;
+                      else
+                        internalerror(2010122912);
+                    end;
+                    case ratype of
+                      ra_alloc :
+                        tg.gettemp(templist,
+                                   size,1,
+                                   tt_regallocator,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
+                      ra_dealloc :
+                        begin
+                          tg.ungettemp(templist,spill_temps[getregtype(reg)]^[getsupreg(reg)]);
+                          { don't invalidate the temp reference, may still be used one instruction
+                            later }
+                        end;
+                    end;
+                    { insert the tempallocation/free at the right place }
+                    list.insertlistbefore(p,templist);
+                    { remove the register allocation info for the register
+                      (p.previous is valid because we just inserted the temp
+                       allocation/free before p) }
+                    q:=Tai(p.previous);
+                    list.remove(p);
+                    p.free;
+                    p:=q;
+                  end;
+              ait_instruction:
+                do_spill_replace_all(list,taicpu(p),spill_temps);
+            end;
+            p:=Tai(p.next);
+          end;
+        freemem(spill_temps[R_INTREGISTER]);
+        freemem(spill_temps[R_FPUREGISTER]);
+        templist.free;
+      end;
+
+end.

compiler/js/rjscon.inc

@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+NR_NO = tregister($00000000);
+NR_R0 = tregister($01000000);
+NR_R1 = tregister($01000001);
+NR_R2 = tregister($01000002);

compiler/js/rjsnor.inc

@@ -0,0 +1,2 @@
+{ don't edit, this file is generated from jsreg.dat }
+4

compiler/js/rjsnum.inc

@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+tregister($00000000),
+tregister($01000000),
+tregister($01000001),
+tregister($01000002)

compiler/js/rjsrni.inc

@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+0,
+1,
+2,
+3

compiler/js/rjssri.inc

@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+0,
+3,
+1,
+2

compiler/js/rjsstd.inc

@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+'INVALID',
+'evalstacktopptr',
+'localsstackptr',
+'evalstacktop'

compiler/js/rjssup.inc

@@ -0,0 +1,5 @@
+{ don't edit, this file is generated from jsreg.dat }
+RS_NO = $00;
+RS_R0 = $00;
+RS_R1 = $01;
+RS_R2 = $02;

compiler/js/symcpu.pas

@@ -0,0 +1,211 @@
+{
+    Copyright (c) 2014 by the FPC development team and Florian Klaempfl
+
+    Symbol table overrides for JS
+
+    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 symcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+  symtype,symdef,symsym,globtype;
+
+type
+  { defs }
+  tcpufiledef = class(tfiledef)
+  end;
+  tcpufiledefclass = class of tcpufiledef;
+
+  tcpuvariantdef = class(tvariantdef)
+  end;
+  tcpuvariantdefclass = class of tcpuvariantdef;
+
+  tcpuformaldef = class(tformaldef)
+  end;
+  tcpuformaldefclass = class of tcpuformaldef;
+
+  tcpuforwarddef = class(tforwarddef)
+  end;
+  tcpuforwarddefclass = class of tcpuforwarddef;
+
+  tcpuundefineddef = class(tundefineddef)
+  end;
+  tcpuundefineddefclass = class of tcpuundefineddef;
+
+  tcpuerrordef = class(terrordef)
+  end;
+  tcpuerrordefclass = class of tcpuerrordef;
+
+  tcpupointerdef = class(tpointerdef)
+  end;
+  tcpupointerdefclass = class of tcpupointerdef;
+
+  tcpurecorddef = class(trecorddef)
+  end;
+  tcpurecorddefclass = class of tcpurecorddef;
+
+  tcpuimplementedinterface = class(timplementedinterface)
+  end;
+  tcpuimplementedinterfaceclass = class of tcpuimplementedinterface;
+
+  tcpuobjectdef = class(tobjectdef)
+  end;
+  tcpuobjectdefclass = class of tcpuobjectdef;
+
+  tcpuclassrefdef = class(tclassrefdef)
+  end;
+  tcpuclassrefdefclass = class of tcpuclassrefdef;
+
+  tcpuarraydef = class(tarraydef)
+  end;
+  tcpuarraydefclass = class of tcpuarraydef;
+
+  tcpuorddef = class(torddef)
+  end;
+  tcpuorddefclass = class of tcpuorddef;
+
+  tcpufloatdef = class(tfloatdef)
+  end;
+  tcpufloatdefclass = class of tcpufloatdef;
+
+  tcpuprocvardef = class(tprocvardef)
+  end;
+  tcpuprocvardefclass = class of tcpuprocvardef;
+
+  tcpuprocdef = class(tprocdef)
+  end;
+  tcpuprocdefclass = class of tcpuprocdef;
+
+  tcpustringdef = class(tstringdef)
+  end;
+  tcpustringdefclass = class of tcpustringdef;
+
+  tcpuenumdef = class(tenumdef)
+  end;
+  tcpuenumdefclass = class of tcpuenumdef;
+
+  tcpusetdef = class(tsetdef)
+  end;
+  tcpusetdefclass = class of tcpusetdef;
+
+  { syms }
+  tcpulabelsym = class(tlabelsym)
+  end;
+  tcpulabelsymclass = class of tcpulabelsym;
+
+  tcpuunitsym = class(tunitsym)
+  end;
+  tcpuunitsymclass = class of tcpuunitsym;
+
+  tcpunamespacesym = class(tnamespacesym)
+  end;
+  tcpunamespacesymclass = class of tcpunamespacesym;
+
+  tcpuprocsym = class(tprocsym)
+  end;
+  tcpuprocsymclass = class of tcpuprocsym;
+
+  tcpuypesym = class(ttypesym)
+  end;
+  tcpuypesymclass = class of tcpuypesym;
+
+  tcpufieldvarsym = class(tfieldvarsym)
+  end;
+  tcpufieldvarsymclass = class of tcpufieldvarsym;
+
+  tcpulocalvarsym = class(tlocalvarsym)
+  end;
+  tcpulocalvarsymclass = class of tcpulocalvarsym;
+
+  tcpuparavarsym = class(tparavarsym)
+  end;
+  tcpuparavarsymclass = class of tcpuparavarsym;
+
+  tcpustaticvarsym = class(tstaticvarsym)
+  end;
+  tcpustaticvarsymclass = class of tcpustaticvarsym;
+
+  tcpuabsolutevarsym = class(tabsolutevarsym)
+  end;
+  tcpuabsolutevarsymclass = class of tcpuabsolutevarsym;
+
+  tcpupropertysym = class(tpropertysym)
+  end;
+  tcpupropertysymclass = class of tcpupropertysym;
+
+  tcpuconstsym = class(tconstsym)
+  end;
+  tcpuconstsymclass = class of tcpuconstsym;
+
+  tcpuenumsym = class(tenumsym)
+  end;
+  tcpuenumsymclass = class of tcpuenumsym;
+
+  tcpusyssym = class(tsyssym)
+  end;
+  tcpusyssymclass = class of tcpusyssym;
+
+
+const
+  pbestrealtype : ^tdef = @s64floattype;
+
+
+implementation
+
+begin
+  { used tdef classes }
+  cfiledef:=tcpufiledef;
+  cvariantdef:=tcpuvariantdef;
+  cformaldef:=tcpuformaldef;
+  cforwarddef:=tcpuforwarddef;
+  cundefineddef:=tcpuundefineddef;
+  cerrordef:=tcpuerrordef;
+  cpointerdef:=tcpupointerdef;
+  crecorddef:=tcpurecorddef;
+  cimplementedinterface:=tcpuimplementedinterface;
+  cobjectdef:=tcpuobjectdef;
+  cclassrefdef:=tcpuclassrefdef;
+  carraydef:=tcpuarraydef;
+  corddef:=tcpuorddef;
+  cfloatdef:=tcpufloatdef;
+  cprocvardef:=tcpuprocvardef;
+  cprocdef:=tcpuprocdef;
+  cstringdef:=tcpustringdef;
+  cenumdef:=tcpuenumdef;
+  csetdef:=tcpusetdef;
+
+  { used tsym classes }
+  clabelsym:=tcpulabelsym;
+  cunitsym:=tcpuunitsym;
+  cnamespacesym:=tcpunamespacesym;
+  cprocsym:=tcpuprocsym;
+  ctypesym:=tcpuypesym;
+  cfieldvarsym:=tcpufieldvarsym;
+  clocalvarsym:=tcpulocalvarsym;
+  cparavarsym:=tcpuparavarsym;
+  cstaticvarsym:=tcpustaticvarsym;
+  cabsolutevarsym:=tcpuabsolutevarsym;
+  cpropertysym:=tcpupropertysym;
+  cconstsym:=tcpuconstsym;
+  cenumsym:=tcpuenumsym;
+  csyssym:=tcpusyssym;
+end.
+

compiler/js/tgcpu.pas

@@ -0,0 +1,261 @@
+{
+    Copyright (C) 2010 by Jonas Maebe
+
+    This unit handles the temporary variables for the JVM
+
+    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.
+
+ ****************************************************************************
+}
+{
+  This unit handles the temporary variables for the JVM.
+}
+unit tgcpu;
+
+{$i fpcdefs.inc}
+
+  interface
+
+    uses
+       globtype,
+       aasmdata,
+       cgutils,
+       symtype,tgobj;
+
+    type
+       ttgjs = class(ttgobj)
+        protected
+         procedure getimplicitobjtemp(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
+         function getifspecialtemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference): boolean;
+         procedure alloctemp(list: TAsmList; size, alignment: longint; temptype: ttemptype; def: tdef; out ref: treference); override;
+        public
+         procedure setfirsttemp(l : longint); override;
+         procedure getlocal(list: TAsmList; size: longint; alignment: shortint; def: tdef; var ref: treference); override;
+         procedure gethltemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference); override;
+         procedure gethltemptyped(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference); override;
+       end;
+
+  implementation
+
+    uses
+       verbose,
+       cgbase,
+       symconst,symdef,symsym,defutil,
+       cpubase,aasmcpu,
+       hlcgobj,hlcgcpu;
+
+
+    procedure ttgjs.getimplicitobjtemp(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
+      var
+        sym: tsym;
+        pd: tprocdef;
+      begin
+        gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+        list.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(tabstractrecorddef(def).jvm_full_typename(true))));
+        { the constructor doesn't return anything, so put a duplicate of the
+          self pointer on the evaluation stack for use as function result
+          after the constructor has run }
+        list.concat(taicpu.op_none(a_dup));
+
+        //!!!!!!!!!!!! thlcgjvm(hlcg).incstack(list,2);
+
+        { call the constructor }
+        sym:=tsym(tabstractrecorddef(def).symtable.find('CREATE'));
+        if assigned(sym) and
+           (sym.typ=procsym) then
+          begin
+            pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
+            if not assigned(pd) then
+              internalerror(2011032701);
+          end
+        else
+          internalerror(2011060301);
+        hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+
+        //!!!!!!!!!!!!!! thlcgjvm(hlcg).decstack(list,1);
+
+        { store reference to instance }
+        //!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
+      end;
+
+
+    function ttgjs.getifspecialtemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference): boolean;
+      var
+        eledef: tdef;
+        ndim: longint;
+        sym: tsym;
+        pd: tprocdef;
+      begin
+        result:=false;
+        case def.typ of
+          arraydef:
+            begin
+              if not is_dynamic_array(def) then
+                begin
+                  { allocate an array of the right size }
+                  gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+                  ndim:=0;
+                  eledef:=def;
+                  repeat
+                    //!!!!!!!!!!!!!!!! if forcesize<>-1 then
+                      //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_const_stack(list,s32inttype,forcesize div tarraydef(eledef).elesize,R_INTREGISTER)
+                    //!!!!!!!!!!!!!!!! else
+                      //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_const_stack(list,s32inttype,tarraydef(eledef).elecount,R_INTREGISTER);
+                    eledef:=tarraydef(eledef).elementdef;
+                    inc(ndim);
+                    forcesize:=-1;
+                  until (eledef.typ<>arraydef) or
+                        is_dynamic_array(eledef);
+                  eledef:=tarraydef(def).elementdef;
+                  //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).g_newarray(list,def,ndim);
+                  //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
+                  result:=true;
+                end;
+            end;
+          recorddef:
+            begin
+              getimplicitobjtemp(list,def,temptype,ref);
+              result:=true;
+            end;
+          setdef:
+            begin
+              if tsetdef(def).elementdef.typ=enumdef then
+                begin
+                  { load enum class type }
+                  //!!!!!!!!!!!!!!!! list.concat(taicpu.op_sym(a_ldc,current_asmdata.RefAsmSymbol(tenumdef(tsetdef(def).elementdef).getbasedef.classdef.jvm_full_typename(true))));
+                  //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
+                  { call tenumset.noneOf() class method }
+                  sym:=tsym(tobjectdef(java_juenumset).symtable.find('NONEOF'));
+                  if assigned(sym) and
+                     (sym.typ=procsym) then
+                    begin
+                      if tprocsym(sym).procdeflist.Count<>1 then
+                        internalerror(2011062801);
+                      pd:=tprocdef(tprocsym(sym).procdeflist[0]);
+                    end;
+                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+                  { static calls method replaces parameter with set instance
+                    -> no change in stack height }
+                end
+              else
+                begin
+                  list.concat(taicpu.op_sym(a_new,current_asmdata.RefAsmSymbol(java_jubitset.jvm_full_typename(true))));
+                  { the constructor doesn't return anything, so put a duplicate of the
+                    self pointer on the evaluation stack for use as function result
+                    after the constructor has run }
+                  list.concat(taicpu.op_none(a_dup));
+                  //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).incstack(list,2);
+                  { call the constructor }
+                  sym:=tsym(java_jubitset.symtable.find('CREATE'));
+                  if assigned(sym) and
+                     (sym.typ=procsym) then
+                    begin
+                      pd:=tprocsym(sym).find_bytype_parameterless(potype_constructor);
+                      if not assigned(pd) then
+                        internalerror(2011062802);
+                    end
+                  else
+                    internalerror(2011062803);
+                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+                  { duplicate self pointer is removed }
+                  //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).decstack(list,1);
+                end;
+              { store reference to instance }
+              gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+              //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
+              result:=true;
+            end;
+          procvardef:
+            begin
+              if not tprocvardef(def).is_addressonly then
+                begin
+                  //!!!!!!!!!!!!!!!! getimplicitobjtemp(list,tprocvardef(def).classdef,temptype,ref);
+                  result:=true;
+                end;
+            end;
+          stringdef:
+            begin
+              if is_shortstring(def) then
+                begin
+                  gettemp(list,java_jlobject.size,java_jlobject.alignment,temptype,ref);
+                  { add the maxlen parameter (s8inttype because parameters must
+                    be sign extended) }
+                  //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_const_stack(list,s8inttype,shortint(tstringdef(def).len),R_INTREGISTER);
+                  { call the constructor }
+                  sym:=tsym(tobjectdef(java_shortstring).symtable.find('CREATEEMPTY'));
+                  if assigned(sym) and
+                     (sym.typ=procsym) then
+                    begin
+                      if tprocsym(sym).procdeflist.Count<>1 then
+                        internalerror(2011052404);
+                      pd:=tprocdef(tprocsym(sym).procdeflist[0]);
+                    end;
+                  hlcg.a_call_name(list,pd,pd.mangledname,nil,false);
+                  { static calls method replaces parameter with string instance
+                    -> no change in stack height }
+                  { store reference to instance }
+                  //!!!!!!!!!!!!!!!! thlcgjvm(hlcg).a_load_stack_ref(list,java_jlobject,ref,0);
+                  result:=true;
+                end;
+            end;
+        end;
+      end;
+
+
+    procedure ttgjs.alloctemp(list: TAsmList; size, alignment: longint; temptype: ttemptype; def: tdef; out ref: treference);
+      begin
+        { the JVM only supports 1 slot (= 4 bytes in FPC) and 2 slot (= 8 bytes in
+          FPC) temps on the stack. double and int64 are 2 slots, the rest is one slot.
+          There are no problems with reusing the same slot for a value of a different
+          type. There are no alignment requirements either. }
+        if size<4 then
+          size:=4;
+        if not(size in [4,8]) then
+          internalerror(2010121401);
+        { don't pass on "def", since we don't care if a slot is used again for a
+          different type }
+        inherited alloctemp(list, size shr 2, 1, temptype, nil,ref);
+      end;
+
+
+    procedure ttgjs.setfirsttemp(l: longint);
+      begin
+        firsttemp:=l;
+        lasttemp:=l;
+      end;
+
+
+    procedure ttgjs.getlocal(list: TAsmList; size: longint; alignment: shortint; def: tdef; var ref: treference);
+      begin
+        if not getifspecialtemp(list,def,size,tt_persistent,ref) then
+          inherited;
+      end;
+
+
+    procedure ttgjs.gethltemp(list: TAsmList; def: tdef; forcesize: aint; temptype: ttemptype; out ref: treference);
+      begin
+        if not getifspecialtemp(list,def,forcesize,temptype,ref) then
+          inherited;
+      end;
+
+    procedure ttgjs.gethltemptyped(list: TAsmList; def: tdef; temptype: ttemptype; out ref: treference);
+      begin
+        gethltemp(list,def,def.size,temptype,ref);
+      end;
+
+
+begin
+  tgobjclass:=ttgjs;
+end.

compiler/pp.pas

@@ -153,6 +153,12 @@ program pp;
   {$endif CPUDEFINED}
   {$define CPUDEFINED}
 {$endif AARCH64}
+{$ifdef JS}
+  {$ifdef CPUDEFINED}
+    {$fatal ONLY one of the switches for the CPU type must be defined}
+  {$endif CPUDEFINED}
+  {$define CPUDEFINED}
+{$endif}
 {$ifndef CPUDEFINED}
   {$fatal A CPU type switch must be defined}
 {$endif CPUDEFINED}

compiler/ppcjs.lpi

@@ -0,0 +1,74 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="ppcjs"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="pp.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="pp"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="js\pp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="js"/>
+      <OtherUnitFiles Value="js;systems"/>
+      <UnitOutputDirectory Value="js\lazbuild"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <Verbosity>
+        <ShowWarn Value="False"/>
+        <ShowNotes Value="False"/>
+        <ShowHints Value="False"/>
+      </Verbosity>
+      <ConfigFile>
+        <StopAfterErrCount Value="50"/>
+      </ConfigFile>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CustomOptions Value="-djs
+-dnoopt"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>

compiler/systems.inc

@@ -207,6 +207,7 @@
              ,as_x86_64_nasmdarwin
              ,as_i8086_nasm
              ,as_i8086_nasmobj
+             ,as_js_asmjs
        );
 
        tlink = (ld_none,

compiler/utils/mkjsreg.pp

@@ -0,0 +1,265 @@
+{
+    Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl
+
+    Convert jsreg.dat to several .inc files for usage with
+    the Free pascal compiler
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+program mkspreg;
+
+const Version = '1.00';
+      max_regcount = 200;
+
+var s : string;
+    i : longint;
+    line : longint;
+    regcount:byte;
+    regcount_bsstart:byte;
+    names,
+    regtypes,
+    subtypes,
+    supregs,
+    numbers,
+    stdnames : array[0..max_regcount-1] of string[63];
+    regnumber_index,
+    std_regname_index : array[0..max_regcount-1] of byte;
+
+function tostr(l : longint) : string;
+
+begin
+  str(l,tostr);
+end;
+
+function readstr : string;
+
+  var
+     result : string;
+
+  begin
+     result:='';
+     while (s[i]<>',') and (i<=length(s)) do
+       begin
+          result:=result+s[i];
+          inc(i);
+       end;
+     readstr:=result;
+  end;
+
+
+procedure readcomma;
+  begin
+     if s[i]<>',' then
+       begin
+         writeln('Missing "," at line ',line);
+         writeln('Line: "',s,'"');
+         halt(1);
+       end;
+     inc(i);
+  end;
+
+
+procedure skipspace;
+
+  begin
+     while (s[i] in [' ',#9]) do
+       inc(i);
+  end;
+
+procedure openinc(var f:text;const fn:string);
+begin
+  writeln('creating ',fn);
+  assign(f,fn);
+  rewrite(f);
+  writeln(f,'{ don''t edit, this file is generated from jsreg.dat }');
+end;
+
+
+procedure closeinc(var f:text);
+begin
+  writeln(f);
+  close(f);
+end;
+
+procedure build_regnum_index;
+
+var h,i,j,p,t:byte;
+
+begin
+  {Build the registernumber2regindex index.
+   Step 1: Fill.}
+  for i:=0 to regcount-1 do
+    regnumber_index[i]:=i;
+  {Step 2: Sort. We use a Shell-Metzner sort.}
+  p:=regcount_bsstart;
+  repeat
+    for h:=0 to regcount-p-1 do
+      begin
+        i:=h;
+        repeat
+          j:=i+p;
+          if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then
+            break;
+          t:=regnumber_index[i];
+          regnumber_index[i]:=regnumber_index[j];
+          regnumber_index[j]:=t;
+          if i<p then
+            break;
+          dec(i,p);
+        until false;
+      end;
+    p:=p shr 1;
+  until p=0;
+end;
+
+procedure build_std_regname_index;
+
+var h,i,j,p,t:byte;
+
+begin
+  {Build the registernumber2regindex index.
+   Step 1: Fill.}
+  for i:=0 to regcount-1 do
+    std_regname_index[i]:=i;
+  {Step 2: Sort. We use a Shell-Metzner sort.}
+  p:=regcount_bsstart;
+  repeat
+    for h:=0 to regcount-p-1 do
+      begin
+        i:=h;
+        repeat
+          j:=i+p;
+          if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then
+            break;
+          t:=std_regname_index[i];
+          std_regname_index[i]:=std_regname_index[j];
+          std_regname_index[j]:=t;
+          if i<p then
+            break;
+          dec(i,p);
+        until false;
+      end;
+    p:=p shr 1;
+  until p=0;
+end;
+
+
+procedure read_spreg_file;
+
+var infile:text;
+
+begin
+   { open dat file }
+   assign(infile,'jsreg.dat');
+   reset(infile);
+   while not(eof(infile)) do
+     begin
+        { handle comment }
+        readln(infile,s);
+        inc(line);
+        while (s[1]=' ') do
+         delete(s,1,1);
+        if (s='') or (s[1]=';') then
+          continue;
+
+        i:=1;
+        names[regcount]:=readstr;
+        readcomma;
+        regtypes[regcount]:=readstr;
+        readcomma;
+        subtypes[regcount]:=readstr;
+        readcomma;
+        supregs[regcount]:=readstr;
+        readcomma;
+        stdnames[regcount]:=readstr;
+        { Create register number }
+        if supregs[regcount][1]<>'$' then
+          begin
+            writeln('Missing $ before number, at line ',line);
+            writeln('Line: "',s,'"');
+            halt(1);
+          end;
+        numbers[regcount]:=regtypes[regcount]+copy(subtypes[regcount],2,255)+'00'+copy(supregs[regcount],2,255);
+        if i<length(s) then
+          begin
+            writeln('Extra chars at end of line, at line ',line);
+            writeln('Line: "',s,'"');
+            halt(1);
+          end;
+        inc(regcount);
+        if regcount>max_regcount then
+          begin
+            writeln('Error: Too much registers, please increase maxregcount in source');
+            halt(2);
+          end;
+     end;
+   close(infile);
+end;
+
+procedure write_inc_files;
+
+var
+    norfile,stdfile,supfile,
+    numfile,confile,
+    rnifile,srifile:text;
+    first:boolean;
+
+begin
+  { create inc files }
+  openinc(confile,'rjscon.inc');
+  openinc(supfile,'rjssup.inc');
+  openinc(numfile,'rjsnum.inc');
+  openinc(stdfile,'rjsstd.inc');
+  openinc(norfile,'rjsnor.inc');
+  openinc(rnifile,'rjsrni.inc');
+  openinc(srifile,'rjssri.inc');
+  first:=true;
+  for i:=0 to regcount-1 do
+    begin
+      if not first then
+        begin
+          writeln(numfile,',');
+          writeln(stdfile,',');
+          writeln(rnifile,',');
+          writeln(srifile,',');
+        end
+      else
+        first:=false;
+      writeln(supfile,'RS_',names[i],' = ',supregs[i],';');
+      writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';');
+      write(numfile,'tregister(',numbers[i],')');
+      write(stdfile,'''',stdnames[i],'''');
+      write(rnifile,regnumber_index[i]);
+      write(srifile,std_regname_index[i]);
+    end;
+  write(norfile,regcount);
+  close(confile);
+  close(supfile);
+  closeinc(numfile);
+  closeinc(stdfile);
+  closeinc(norfile);
+  closeinc(rnifile);
+  closeinc(srifile);
+  writeln('Done!');
+  writeln(regcount,' registers procesed');
+end;
+
+
+begin
+   writeln('Register Table Converter Version ',Version);
+   line:=0;
+   regcount:=0;
+   read_spreg_file;
+   regcount_bsstart:=1;
+   while 2*regcount_bsstart<regcount do
+     regcount_bsstart:=regcount_bsstart*2;
+   build_regnum_index;
+   build_std_regname_index;
+   write_inc_files;
+end.