Synchronize with trunk

git-svn-id: branches/unicodekvm@40490 -

.gitattributes

@@ -6993,15 +6993,21 @@ packages/pastojs/src/fppas2js.pp svneol=native#text/plain
 packages/pastojs/src/fppjssrcmap.pp svneol=native#text/plain
 packages/pastojs/src/pas2js_defines.inc svneol=native#text/plain
 packages/pastojs/src/pas2jscompiler.pp svneol=native#text/plain
+packages/pastojs/src/pas2jscompilercfg.pp svneol=native#text/plain
+packages/pastojs/src/pas2jscompilerpp.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfilecache.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutils.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilsnodejs.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilsunix.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain
+packages/pastojs/src/pas2jsfs.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsfscompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
+packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcfiler.pas svneol=native#text/plain
 packages/pastojs/tests/tcmodules.pas svneol=native#text/plain
@@ -9634,6 +9640,7 @@ rtl/linux/aarch64/stat.inc svneol=native#text/plain
 rtl/linux/aarch64/syscall.inc svneol=native#text/plain
 rtl/linux/aarch64/syscallh.inc svneol=native#text/plain
 rtl/linux/aarch64/sysnr.inc svneol=native#text/plain
+rtl/linux/arm/abitag.inc svneol=native#text/plain
 rtl/linux/arm/bsyscall.inc svneol=native#text/plain
 rtl/linux/arm/cprt0.as svneol=native#text/plain
 rtl/linux/arm/dllprt0.as svneol=native#text/plain
@@ -9655,6 +9662,7 @@ rtl/linux/errno.inc svneol=native#text/plain
 rtl/linux/errnostr.inc svneol=native#text/plain
 rtl/linux/fpcylix.pp svneol=native#text/plain
 rtl/linux/fpmake.inc svneol=native#text/plain
+rtl/linux/i386/abitag.inc svneol=native#text/plain
 rtl/linux/i386/bsyscall.inc svneol=native#text/plain
 rtl/linux/i386/si_c.inc svneol=native#text/plain
 rtl/linux/i386/si_c21.inc svneol=native#text/plain
@@ -16448,6 +16456,7 @@ tests/webtbs/tw3433.pp svneol=native#text/plain
 tests/webtbs/tw34332.pp svneol=native#text/pascal
 tests/webtbs/tw3435.pp svneol=native#text/plain
 tests/webtbs/tw34380.pp svneol=native#text/plain
+tests/webtbs/tw34385.pp svneol=native#text/plain
 tests/webtbs/tw3441.pp svneol=native#text/plain
 tests/webtbs/tw3443.pp svneol=native#text/plain
 tests/webtbs/tw34438.pp svneol=native#text/pascal
@@ -16456,6 +16465,7 @@ tests/webtbs/tw34442.pp svneol=native#text/plain
 tests/webtbs/tw3456.pp svneol=native#text/plain
 tests/webtbs/tw3457.pp svneol=native#text/plain
 tests/webtbs/tw3460.pp svneol=native#text/plain
+tests/webtbs/tw34605.pp svneol=native#text/plain
 tests/webtbs/tw3467.pp svneol=native#text/plain
 tests/webtbs/tw3470.pp svneol=native#text/plain
 tests/webtbs/tw3474.pp svneol=native#text/plain
@@ -17472,6 +17482,7 @@ utils/pas2js/pas2js.lpi svneol=native#text/plain
 utils/pas2js/pas2js.pp svneol=native#text/plain
 utils/pas2js/pas2jslib.lpi svneol=native#text/plain
 utils/pas2js/pas2jslib.pp svneol=native#text/plain
+utils/pas2js/pas2jswebcompiler.pp svneol=native#text/plain
 utils/pas2js/samples/arraydemo.pp svneol=native#text/plain
 utils/pas2js/samples/fordemo.pp svneol=native#text/plain
 utils/pas2js/samples/fordowndemo.pp svneol=native#text/plain
@@ -17479,6 +17490,7 @@ utils/pas2js/samples/hello.pas svneol=native#text/plain
 utils/pas2js/samples/ifdemo.pp svneol=native#text/plain
 utils/pas2js/samples/repeatdemo.pp svneol=native#text/plain
 utils/pas2js/samples/whiledemo.pp svneol=native#text/plain
+utils/pas2js/webfilecache.pp svneol=native#text/plain
 utils/pas2js/webidl2pas.lpi svneol=native#text/plain
 utils/pas2js/webidl2pas.pp svneol=native#text/plain
 utils/pas2ut/Makefile svneol=native#text/plain

compiler/aasmcnst.pas

@@ -349,7 +349,7 @@ type
      procedure emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef);virtual;
 
      { emits a tasmlabofs as returned by begin_dynarray_const }
-     procedure emit_dynarray_offset(const ll:tasmlabofs;const arrlength:asizeint;const arrdef:tdef);virtual;
+     procedure emit_dynarray_offset(const ll:tasmlabofs;const arrlength:asizeint;const arrdef:tarraydef; const arrconstdatadef: trecorddef);virtual;
      { starts a dynamic array constant so that its data can be emitted directly afterwards }
      function begin_dynarray_const(arrdef:tdef;var startlab:tasmlabel;out arrlengthloc:ttypedconstplaceholder):tasmlabofs;virtual;
      function end_dynarray_const(arrdef:tdef;arrlength:asizeint;arrlengthloc:ttypedconstplaceholder):tdef;virtual;
@@ -1717,7 +1717,7 @@ implementation
      end;
 
 
-   procedure ttai_typedconstbuilder.emit_dynarray_offset(const ll:tasmlabofs;const arrlength:asizeint;const arrdef:tdef);
+   procedure ttai_typedconstbuilder.emit_dynarray_offset(const ll:tasmlabofs;const arrlength:asizeint;const arrdef:tarraydef; const arrconstdatadef: trecorddef);
      begin
        emit_tai(tai_const.create_sym_offset(ll.lab,ll.ofs),arrdef);
      end;

compiler/aoptobj.pas

@@ -1059,7 +1059,10 @@ Unit AoptObj;
             Top_Reg :
               OpsEqual:=o1.reg=o2.reg;
             Top_Ref :
-              OpsEqual := references_equal(o1.ref^, o2.ref^);
+              OpsEqual:=
+                references_equal(o1.ref^, o2.ref^) and
+                (o1.ref^.volatility=[]) and
+                (o2.ref^.volatility=[]);
             Top_Const :
               OpsEqual:=o1.val=o2.val;
             Top_None :

compiler/arm/aoptcpu.pas

@@ -117,7 +117,9 @@ Implementation
         (r1.signindex = r2.signindex) and
         (r1.shiftimm = r2.shiftimm) and
         (r1.addressmode = r2.addressmode) and
-        (r1.shiftmode = r2.shiftmode);
+        (r1.shiftmode = r2.shiftmode) and
+        (r1.volatility=[]) and
+        (r2.volatility=[]);
     end;
 
   function MatchInstruction(const instr: tai; const op: TCommonAsmOps; const cond: TAsmConds; const postfix: TOpPostfixes): boolean;

compiler/avr/aoptcpu.pas

@@ -75,7 +75,9 @@ Implementation
         (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
         (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
         (r1.relsymbol = r2.relsymbol) and
-        (r1.addressmode = r2.addressmode);
+        (r1.addressmode = r2.addressmode) and
+        (r1.volatility=[]) and
+        (r2.volatility=[]);
     end;
 
 

compiler/compinnr.pas

@@ -117,6 +117,7 @@ type
      in_not_assign_x      = 95,
      in_gettypekind_x     = 96,
      in_faraddr_x         = 97,
+     in_volatile_x        = 98,
 
 { Internal constant functions }
      in_const_sqr        = 100,

compiler/dbgdwarf.pas

@@ -1489,8 +1489,12 @@ implementation
         sign         : tdwarf_type;
         signform     : tdwarf_form;
         fullbytesize : byte;
+        ordtype      : tordtype;
       begin
-        case def.ordtype of
+        ordtype:=def.ordtype;
+        if ordtype=customint then
+          ordtype:=range_to_basetype(def.low,def.high);
+        case ordtype of
           s8bit,
           s16bit,
           s32bit,
@@ -1524,7 +1528,7 @@ implementation
                     basedef:=s16inttype
                   else
                     basedef:=u16inttype;
-                4:
+                3,4:
                   if (sign=DW_ATE_signed) then
                     basedef:=s32inttype
                   else

compiler/defcmp.pas

@@ -187,7 +187,7 @@ implementation
            u8bit,u16bit,u32bit,u64bit,
            s8bit,s16bit,s32bit,s64bit,
            pasbool, bool8bit,bool16bit,bool32bit,bool64bit,
-           uchar,uwidechar,scurrency }
+           uchar,uwidechar,scurrency,customint }
 
       type
         tbasedef=(bvoid,bchar,bint,bbool);
@@ -198,7 +198,7 @@ implementation
            bint,bint,bint,bint,bint,
            bbool,bbool,bbool,bbool,bbool,
            bbool,bbool,bbool,bbool,
-           bchar,bchar,bint);
+           bchar,bchar,bint,bint);
 
         basedefconvertsimplicit : array[tbasedef,tbasedef] of tconverttype =
           { void, char, int, bool }
@@ -1969,6 +1969,8 @@ implementation
                   is_subequal:=(torddef(def2).ordtype=uchar);
                 uwidechar :
                   is_subequal:=(torddef(def2).ordtype=uwidechar);
+                customint:
+                  is_subequal:=(torddef(def2).low=torddef(def1).low) and (torddef(def2).high=torddef(def1).high);
               end;
             end
            else

compiler/defutil.pas

@@ -479,7 +479,7 @@ implementation
                                   u8bit,u16bit,u32bit,u64bit,
                                   s8bit,s16bit,s32bit,s64bit,
                                   pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
-                                  bool8bit,bool16bit,bool32bit,bool64bit];
+                                  bool8bit,bool16bit,bool32bit,bool64bit,customint];
              end;
            enumdef :
              is_ordinal:=true;
@@ -550,7 +550,8 @@ implementation
       begin
         result:=(def.typ=orddef) and
                     (torddef(def).ordtype in [u8bit,u16bit,u32bit,u64bit,
-                                          s8bit,s16bit,s32bit,s64bit]);
+                                          s8bit,s16bit,s32bit,s64bit,
+                                          customint]);
       end;
 
 
@@ -948,8 +949,11 @@ implementation
       begin
         result:=(def1.typ=orddef) and (def2.typ=orddef) and
           (torddef(def1).ordtype in [u8bit,u16bit,u32bit,u64bit,
-                                     s8bit,s16bit,s32bit,s64bit]) and
-          (torddef(def1).ordtype=torddef(def2).ordtype);
+                                     s8bit,s16bit,s32bit,s64bit,customint]) and
+          (torddef(def1).ordtype=torddef(def2).ordtype) and
+          ((torddef(def1).ordtype<>customint) or
+           ((torddef(def1).low=torddef(def2).low) and
+            (torddef(def1).high=torddef(def2).high)));
       end;
 
 

compiler/globtype.pas

@@ -392,7 +392,7 @@ interface
        { switches being applied to all CPUs at the given level }
        genericlevel1optimizerswitches = [cs_opt_level1,cs_opt_peephole];
        genericlevel2optimizerswitches = [cs_opt_level2,cs_opt_remove_emtpy_proc];
-       genericlevel3optimizerswitches = [cs_opt_level3,cs_opt_constant_propagate,cs_opt_nodedfa,cs_opt_use_load_modify_store,cs_opt_loopunroll];
+       genericlevel3optimizerswitches = [cs_opt_level3,cs_opt_constant_propagate,cs_opt_nodedfa{$ifndef llvm},cs_opt_use_load_modify_store{$endif},cs_opt_loopunroll];
        genericlevel4optimizerswitches = [cs_opt_level4,cs_opt_reorder_fields,cs_opt_dead_values,cs_opt_fastmath];
 
        { whole program optimizations whose information generation requires

compiler/hlcgobj.pas

@@ -429,6 +429,11 @@ unit hlcgobj;
           }
           procedure g_exception_reason_discard(list : TAsmList; size: tdef; href: treference); virtual;
 
+          {#
+              Call when the current location should never be reached
+          }
+          procedure g_unreachable(list: TAsmList); virtual;
+
           procedure g_maybe_testself(list : TAsmList; selftype: tdef; reg:tregister);
 //          procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef);
           {# This should emit the opcode to copy len bytes from the source
@@ -3159,6 +3164,12 @@ implementation
     end;
 
 
+  procedure thlcgobj.g_unreachable(list: TAsmList);
+    begin
+      { nothing }
+    end;
+
+
   procedure thlcgobj.g_maybe_testself(list: TAsmList; selftype: tdef; reg: tregister);
     var
       OKLabel : tasmlabel;
@@ -4567,13 +4578,14 @@ implementation
       cleanup_regvars(list);
 {$endif OLDREGVARS}
 
-      { finalize temporary data }
-      finalizetempvariables(list);
-
       { finalize paras data }
       if assigned(current_procinfo.procdef.parast) and
          not(po_assembler in current_procinfo.procdef.procoptions) then
         current_procinfo.procdef.parast.SymList.ForEachCall(@final_paras,list);
+
+      { finalize temporary data }
+      finalizetempvariables(list);
+
       current_procinfo:=old_current_procinfo;
     end;
 
@@ -4983,8 +4995,6 @@ implementation
                 end
               else
                 begin
-                  { pass proper alignment info }
-                  localcopyloc.reference.alignment:=tparavarsym(p).vardef.alignment;
                   g_concatcopy(list,tparavarsym(p).vardef,href,localcopyloc.reference);
                 end;
               { update localloc of varsym }

compiler/htypechk.pas

@@ -3132,7 +3132,7 @@ implementation
            tve_shortint,tve_smallint,tve_longint,tve_chari64,tve_incompatible,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
            tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal,
-           tve_chari64,tve_chari64,tve_dblcurrency);
+           tve_chari64,tve_chari64,tve_dblcurrency,tve_incompatible);
 { TODO: fixme for 128 bit floats }
         variantfloatdef_cl: array[tfloattype] of tvariantequaltype =
           (tve_single,tve_dblcurrency,tve_extended,tve_extended,

compiler/i386/n386flw.pas

@@ -247,8 +247,6 @@ function ti386tryfinallynode.simplify(forinline: boolean): tnode;
         if implicitframe then
           begin
             current_procinfo.finalize_procinfo:=finalizepi;
-            { don't leave dangling pointer }
-            tcgprocinfo(current_procinfo).final_asmnode:=nil;
           end;
       end;
   end;

compiler/jvm/njvmutil.pas

@@ -28,7 +28,7 @@ interface
   uses
     cclasses,
     node,nbas,
-    ngenutil,
+    fmodule,ngenutil,
     symtype,symconst,symsym,symdef;
 
 
@@ -36,6 +36,7 @@ interface
     tjvmnodeutils = class(tnodeutils)
       class function initialize_data_node(p:tnode; force: boolean):tnode; override;
       class function finalize_data_node(p:tnode):tnode; override;
+      class procedure append_struct_initfinis(u: tmodule; initfini: tstructinifinipotype; var stat: tstatementnode); override;
       class function force_init: boolean; override;
       class procedure insertbssdata(sym: tstaticvarsym); override;
       class function create_main_procdef(const name: string; potype: tproctypeoption; ps: tprocsym): tdef; override;
@@ -63,7 +64,7 @@ interface
 implementation
 
     uses
-      verbose,cutils,globtype,globals,constexp,fmodule,compinnr,
+      verbose,cutils,globtype,globals,constexp,compinnr,
       aasmdata,aasmtai,cpubase,aasmbase,aasmcpu,
       symbase,symcpu,symtable,defutil,jvmdef,
       ncnv,ncon,ninl,ncal,nld,nmem,
@@ -172,6 +173,12 @@ implementation
     end;
 
 
+  class procedure tjvmnodeutils.append_struct_initfinis(u: tmodule; initfini: tstructinifinipotype; var stat: tstatementnode);
+    begin
+      { class constructors are implicitly called by the JVM runtime and cannot be called explicitly }
+    end;
+
+
   class function tjvmnodeutils.force_init: boolean;
     begin
       { we need an initialisation in case the al_globals list is not empty

compiler/llvm/aasmllvm.pas

@@ -39,6 +39,9 @@ interface
 
         constructor create_llvm(op: tllvmop);
 
+        { e.g. unreachable }
+        constructor op_none(op : tllvmop);
+
         { e.g. ret void }
         constructor op_size(op : tllvmop; size: tdef);
 
@@ -680,6 +683,13 @@ uses
       end;
 
 
+    constructor taillvm.op_none(op: tllvmop);
+      begin
+        create_llvm(op);
+        ops:=0;
+      end;
+
+
     constructor taillvm.op_size(op : tllvmop; size: tdef);
       begin
         create_llvm(op);

compiler/llvm/hlcgllvm.pas

@@ -87,6 +87,8 @@ uses
 
       procedure a_jmp_always(list : TAsmList;l: tasmlabel); override;
 
+      procedure g_unreachable(list: TAsmList); override;
+
       procedure g_concatcopy(list : TAsmList;size: tdef; const source,dest : treference);override;
 
       procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tdef; const ref: treference; reg: tregister); override;
@@ -230,7 +232,7 @@ implementation
                    construction (the record is build from the paraloc
                    types) }
                  else if userecord then
-                   a_load_ref_reg(list,location^.def,location^.def,tmpref,location^.register)
+                   a_load_ref_reg(list,fielddef,location^.def,tmpref,location^.register)
                  { if the parameter is passed in a single paraloc, the
                    paraloc's type may be different from the declared type
                    -> use the original complete parameter size as source so
@@ -1095,6 +1097,11 @@ implementation
       cg.a_jmp_always(list,l);
     end;
 
+  procedure thlcgllvm.g_unreachable(list: TAsmList);
+    begin
+      list.Concat(taillvm.op_none(la_unreachable));
+    end;
+
 
   procedure thlcgllvm.g_concatcopy(list: TAsmList; size: tdef; const source, dest: treference);
     var
@@ -1128,9 +1135,7 @@ implementation
       a_load_const_cgpara(list,u64inttype,size.size,sizepara);
       maxalign:=newalignment(max(source.alignment,dest.alignment),min(source.alignment,dest.alignment));
       a_load_const_cgpara(list,u32inttype,maxalign,alignpara);
-      { we don't know anything about volatility here, should become an extra
-        parameter to g_concatcopy }
-      a_load_const_cgpara(list,llvmbool1type,0,volatilepara);
+      a_load_const_cgpara(list,llvmbool1type,ord((vol_read in source.volatility) or (vol_write in dest.volatility)),volatilepara);
       g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp;
       sourcepara.done;
       destpara.done;

compiler/llvm/llvmdef.pas

@@ -351,8 +351,10 @@ implementation
                 passing it as a parameter may result in unexpected behaviour }
               else if def=llvmbool1type then
                 encodedstr:=encodedstr+'i1'
+              else if torddef(def).ordtype<>customint then
+                encodedstr:=encodedstr+'i'+tostr(def.size*8)
               else
-                encodedstr:=encodedstr+'i'+tostr(def.size*8);
+                encodedstr:=encodedstr+'i'+tostr(def.packedbitsize);
             end;
           pointerdef :
             begin
@@ -836,6 +838,8 @@ implementation
                   s64bit,
                   u64bit:
                     typename:=typename+'i64';
+                  customint:
+                    typename:=typename+'i'+tostr(torddef(hdef).packedbitsize);
                   else
                     { other types should not appear currently, add as needed }
                     internalerror(2014012001);
@@ -876,6 +880,7 @@ implementation
         usedef: tdef;
         valueext: tllvmvalueextension;
         i: longint;
+        sizeleft: asizeint;
       begin
         { single location }
         if not assigned(cgpara.location^.next) then
@@ -903,10 +908,36 @@ implementation
         { multiple locations -> create temp record }
         retloc:=cgpara.location;
         i:=0;
+        sizeleft:=cgpara.Def.size;
         repeat
           if i>high(retdeflist) then
             internalerror(2016121801);
-          retdeflist[i]:=retloc^.def;
+          if assigned(retloc^.next) then
+            begin
+              retdeflist[i]:=retloc^.def;
+              dec(sizeleft,retloc^.def.size);
+            end
+          else
+            begin
+              case sizeleft of
+                1:
+                  retdeflist[i]:=u8inttype;
+                2:
+                  retdeflist[i]:=u16inttype;
+                3:
+                  retdeflist[i]:=u24inttype;
+                4:
+                  retdeflist[i]:=u32inttype;
+                5:
+                  retdeflist[i]:=u40inttype;
+                6:
+                  retdeflist[i]:=u48inttype;
+                7:
+                  retdeflist[i]:=u56inttype;
+                else
+                  retdeflist[i]:=retloc^.def;
+              end;
+            end;
           inc(i);
           retloc:=retloc^.next;
         until not assigned(retloc);

compiler/llvm/nllvmmat.pas

@@ -34,6 +34,9 @@ type
     procedure pass_generate_code; override;
   end;
 
+  tllvmshlshrnode = class(tcgshlshrnode)
+  end;
+
   Tllvmunaryminusnode = class(tcgunaryminusnode)
     procedure emit_float_sign_change(r: tregister; _size : tdef);override;
   end;
@@ -154,9 +157,7 @@ end;
 
 begin
   cmoddivnode := tllvmmoddivnode;
-(*
   cshlshrnode := tllvmshlshrnode;
-*)
   cnotnode    := tllvmnotnode;
   cunaryminusnode := Tllvmunaryminusnode;
 end.

compiler/llvm/nllvmtcon.pas

@@ -103,6 +103,7 @@ interface
       procedure emit_tai(p: tai; def: tdef); override;
       procedure emit_tai_procvar2procdef(p: tai; pvdef: tprocvardef); override;
       procedure emit_string_offset(const ll: tasmlabofs; const strlength: longint; const st: tstringtype; const winlikewidestring: boolean; const charptrdef: tdef); override;
+      procedure emit_dynarray_offset(const ll: tasmlabofs; const arrlength: asizeint; const arrdef: tarraydef; const arrconstdatadef: trecorddef); override;
       procedure queue_init(todef: tdef); override;
       procedure queue_vecn(def: tdef; const index: tconstexprint); override;
       procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
@@ -455,6 +456,40 @@ implementation
     end;
 
 
+  procedure tllvmtai_typedconstbuilder.emit_dynarray_offset(const ll: tasmlabofs; const arrlength: asizeint; const arrdef: tarraydef; const arrconstdatadef: trecorddef);
+    var
+      field: tfieldvarsym;
+      dataptrdef: tdef;
+    begin
+      { nil pointer? }
+      if not assigned(ll.lab) then
+        begin
+          if ll.ofs<>0 then
+            internalerror(2015030701);
+          inherited;
+          exit;
+        end;
+      { if the returned offset is <> 0, then the string data
+        starts at that offset -> translate to a field for the
+        high level code generator }
+      if ll.ofs<>0 then
+        begin
+          { field corresponding to this offset }
+          field:=trecordsymtable(arrconstdatadef.symtable).findfieldbyoffset(ll.ofs);
+          { pointerdef to the string data array }
+          dataptrdef:=cpointerdef.getreusable(field.vardef);
+          { the fields of the resourcestring record are declared as ansistring }
+          queue_init(dataptrdef);
+          queue_subscriptn(arrconstdatadef,field);
+          queue_emit_asmsym(ll.lab,arrconstdatadef);
+        end
+      else
+       { since llvm doesn't support labels in the middle of structs, this
+         offset should never be 0  }
+       internalerror(2018112401);
+    end;
+
+
   procedure tllvmtai_typedconstbuilder.begin_aggregate_internal(def: tdef; anonymous: boolean);
     var
       agg: tai_aggregatetypedconst;

compiler/m68k/aoptcpu.pas

@@ -65,7 +65,9 @@ unit aoptcpu;
           (r1.base = r2.base) and
           (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
           (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
-          (r1.relsymbol = r2.relsymbol);
+          (r1.relsymbol = r2.relsymbol) and
+          (r1.volatility=[]) and
+          (r2.volatility=[]);
       end;
 
     function MatchOperand(const oper1: TOper; const oper2: TOper): boolean;

compiler/m68k/n68kinl.pas

@@ -26,7 +26,7 @@ unit n68kinl;
 interface
 
     uses
-      node,ninl,ncginl,cpubase;
+      node,ninl,ncginl,symtype,cpubase;
 
     type
       t68kinlinenode = class(tcgInlineNode)
@@ -51,6 +51,8 @@ interface
         procedure second_frac_real; override;
         {procedure second_prefetch; override;
         procedure second_abs_long; override;}
+      protected 
+        function second_incdec_tempregdef: tdef; override;
       private
         procedure second_do_operation(op: TAsmOp);
       end;
@@ -342,6 +344,18 @@ implementation
         eor.l   d1,d2
         sub.l   d1,d2
       }
+
+      function t68kinlinenode.second_incdec_tempregdef: tdef;
+        begin
+          { this kludge results in the increment/decrement value of inc/dec to be loaded
+            always in a datareg, regardless of the target type. This results in significantly
+            better code on m68k, where if the inc/decrement is loaded to an address register
+            for pointers, the compiler will generate a bunch of useless data<->address register
+            shuffling, as it cannot do some operations on address registers (like shifting
+            or multiplication) (KB) }
+          second_incdec_tempregdef:=cgsize_orddef(def_cgsize(left.resultdef));
+        end;
+
 begin
   cinlinenode:=t68kinlinenode;
 end.

compiler/msg/errore.msg

@@ -166,7 +166,7 @@ scan_f_end_of_file=02000_F_Unexpected end of file
 scan_f_string_exceeds_line=02001_F_String exceeds line
 % There is a missing closing ' in a string, so it occupies
 % multiple lines.
-scan_f_illegal_char=02002_F_illegal character "$1" ($2)
+scan_f_illegal_char=02002_F_Illegal character "$1" ($2)
 % An illegal character was encountered in the input file.
 scan_f_syn_expected=02003_F_Syntax error, "$1" expected but "$2" found
 % This indicates that the compiler expected a different token than
@@ -236,7 +236,7 @@ scan_w_macro_too_deep=02030_W_Expanding of macros exceeds a depth of 16.
 % When expanding a macro, macros have been nested to a level of 16.
 % The compiler will expand no further, since this may be a sign that
 % recursion is used.
-scan_w_wrong_styled_switch=02031_W_compiler switches are not supported in // styled comments
+scan_w_wrong_styled_switch=02031_W_Compiler switches are not supported in // styled comments
 % Compiler switches should be in normal Pascal style comments.
 scan_d_handling_switch=02032_DL_Handling switch "$1"
 % When you set debugging info on (\var{-vd}) the compiler tells you when it
@@ -502,17 +502,17 @@ parser_e_illegal_parameter_list=03024_E_Illegal parameter list
 parser_e_wrong_parameter_size=03026_E_Wrong number of parameters specified for call to "$1"
 % There is an error in the parameter list of the function or procedure --
 % the number of parameters is not correct.
-parser_e_overloaded_no_procedure=03027_E_overloaded identifier "$1" isn't a function
+parser_e_overloaded_no_procedure=03027_E_Overloaded identifier "$1" isn't a function
 % The compiler encountered a symbol with the same name as an overloaded
 % function, but it is not a function it can overload.
-parser_e_overloaded_have_same_parameters=03028_E_overloaded functions have the same parameter list
+parser_e_overloaded_have_same_parameters=03028_E_Overloaded functions have the same parameter list
 % You're declaring overloaded functions, but with the same parameter list.
 % Overloaded function must have at least 1 different parameter in their
 % declaration.
-parser_e_header_dont_match_forward=03029_E_function header doesn't match the previous declaration "$1"
+parser_e_header_dont_match_forward=03029_E_Function header doesn't match the previous declaration "$1"
 % You declared a function with the same parameters but
 % different result type or function modifiers.
-parser_e_header_different_var_names=03030_E_function header "$1" doesn't match forward : var name changes $2 => $3
+parser_e_header_different_var_names=03030_E_Function header "$1" doesn't match forward : var name changes $2 => $3
 % You declared the function in the \var{interface} part, or with the
 % \var{forward} directive, but defined it with a different parameter list.
 parser_n_duplicate_enum=03031_N_Values in enumeration types have to be ascending
@@ -527,49 +527,49 @@ parser_n_duplicate_enum=03031_N_Values in enumeration types have to be ascending
 parser_e_no_with_for_variable_in_other_segments=03033_E_With cannot be used for variables in a different segment
 % With stores a variable locally on the stack,
 % but this is not possible if the variable belongs to another segment.
-parser_e_too_much_lexlevel=03034_E_function nesting > 31
+parser_e_too_much_lexlevel=03034_E_Function nesting > 31
 % You can nest function definitions only 31 levels deep.
-parser_e_range_check_error=03035_E_range check error while evaluating constants
+parser_e_range_check_error=03035_E_Range check error while evaluating constants
 % The constants are out of their allowed range.
-parser_w_range_check_error=03036_W_range check error while evaluating constants
+parser_w_range_check_error=03036_W_Range check error while evaluating constants
 % The constants are out of their allowed range.
-parser_e_double_caselabel=03037_E_duplicate case label
+parser_e_double_caselabel=03037_E_Duplicate case label
 % You are specifying the same label 2 times in a \var{case} statement.
 parser_e_case_lower_less_than_upper_bound=03038_E_Upper bound of case range is less than lower bound
 % The upper bound of a \var{case} label is less than the lower bound and this
 % is useless.
-parser_e_type_const_not_possible=03039_E_typed constants of classes or interfaces are not allowed
+parser_e_type_const_not_possible=03039_E_Typed constants of classes or interfaces are not allowed
 % You cannot declare a constant of type class or object.
-parser_e_no_overloaded_procvars=03040_E_functions variables of overloaded functions are not allowed
+parser_e_no_overloaded_procvars=03040_E_Function variables of overloaded functions are not allowed
 % You are trying to assign an overloaded function to a procedural variable.
 % This is not allowed.
-parser_e_invalid_string_size=03041_E_string length must be a value from 1 to 255
+parser_e_invalid_string_size=03041_E_String length must be a value from 1 to 255
 % The length of a shortstring in Pascal is limited to 255 characters. You are
 % trying to declare a string with length less than 1 or greater than 255.
-parser_w_use_extended_syntax_for_objects=03042_W_use extended syntax of NEW and DISPOSE for instances of objects
+parser_w_use_extended_syntax_for_objects=03042_W_Use extended syntax of NEW and DISPOSE for instances of objects
 % If you have a pointer \var{a} to an object type, then the statement
 % \var{new(a)} will not initialize the object (i.e. the constructor isn't
 % called), although space will be allocated. You should issue the
 % \var{new(a,init)} statement. This will allocate space, and call the
 % constructor of the object.
-parser_w_no_new_dispose_on_void_pointers=03043_W_use of NEW or DISPOSE for untyped pointers is meaningless
-parser_e_no_new_dispose_on_void_pointers=03044_E_use of NEW or DISPOSE is not possible for untyped pointers
+parser_w_no_new_dispose_on_void_pointers=03043_W_Use of NEW or DISPOSE for untyped pointers is meaningless
+parser_e_no_new_dispose_on_void_pointers=03044_E_Use of NEW or DISPOSE is not possible for untyped pointers
 % You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer
 % because no size is associated to an untyped pointer.
 % It is accepted for compatibility in \var{TP} and \var{DELPHI} modes, but the
 % compiler will still warn you if it finds such a construct.
-parser_e_class_id_expected=03045_E_class identifier expected
+parser_e_class_id_expected=03045_E_Class identifier expected
 % This happens when the compiler scans a procedure declaration that contains
 % a dot, i.e., an object or class method, but the type in front of the dot is not
 % a known type.
 parser_e_no_type_not_allowed_here=03046_E_type identifier not allowed here
 % You cannot use a type inside an expression.
-parser_e_methode_id_expected=03047_E_method identifier expected
+parser_e_methode_id_expected=03047_E_Method identifier expected
 % This identifier is not a method.
 % This happens when the compiler scans a procedure declaration that contains
 % a dot, i.e., an object or class method, but the procedure name is not a
 % procedure of this type.
-parser_e_header_dont_match_any_member=03048_E_function header doesn't match any method of this class "$1"
+parser_e_header_dont_match_any_member=03048_E_Function header doesn't match any method of this class "$1"
 % This identifier is not a method.
 % This happens when the compiler scans a procedure declaration that contains
 % a dot, i.e., an object or class method, but the procedure name is not a
@@ -668,7 +668,7 @@ parser_e_generic_methods_only_in_methods=03072_E_Methods can be only in other me
 parser_e_illegal_colon_qualifier=03073_E_Illegal use of ':'
 % You are using the format \var{:} (colon) 2 times on an expression that
 % is not a real expression.
-parser_e_illegal_set_expr=03074_E_range check error in set constructor or duplicate set element
+parser_e_illegal_set_expr=03074_E_Range check error in set constructor or duplicate set element
 % The declaration of a set contains an error. Either one of the elements is
 % outside the range of the set type, or two of the elements are in fact
 % the same.
@@ -836,7 +836,7 @@ parser_h_inlining_disabled=03124_H_Inlining disabled
 parser_i_writing_browser_log=03125_I_Writing Browser log $1
 % When information messages are on, the compiler warns you when it
 % writes the browser log (generated with the \var{\{\$Y+ \}} switch).
-parser_h_maybe_deref_caret_missing=03126_H_may be pointer dereference is missing
+parser_h_maybe_deref_caret_missing=03126_H_Maybe pointer dereference is missing?
 % The compiler thinks that a pointer may need a dereference.
 parser_f_assembler_reader_not_supported=03127_F_Selected assembler reader not supported
 % The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not
@@ -873,10 +873,10 @@ parser_e_invalid_float_operation=03139_E_Invalid floating point operation
 parser_e_array_lower_less_than_upper_bound=03140_E_Upper bound of range is less than lower bound
 % The upper bound of an array declaration is less than the lower bound and this
 % is not possible.
-parser_w_string_too_long=03141_W_string "$1" is longer than "$2"
+parser_w_string_too_long=03141_W_String "$1" is longer than "$2"
 % The size of the constant string is larger than the size you specified in
 % string type definition.
-parser_e_string_larger_array=03142_E_string length is larger than array of char length
+parser_e_string_larger_array=03142_E_String length is larger than array of char length
 % The size of the constant string is larger than the size you specified in
 % the \var{Array[x..y] of char} definition.
 parser_e_ill_msg_expr=03143_E_Illegal expression after message directive
@@ -966,7 +966,7 @@ parser_e_improper_guid_syntax=03165_E_Improper GUID syntax
 parser_w_interface_mapping_notfound=03168_W_Procedure named "$1" not found that is suitable for implementing the $2.$3
 % The compiler cannot find a suitable procedure which implements the given method of an interface.
 % A procedure with the same name is found, but the arguments do not match.
-parser_e_interface_id_expected=03169_E_interface identifier expected
+parser_e_interface_id_expected=03169_E_Interface identifier expected
 % This happens when the compiler scans a \var{class} declaration that contains
 % \var{interface} function name mapping code like this:
 % \begin{verbatim}
@@ -1633,11 +1633,11 @@ type_e_ordinal_expr_expected=04007_E_Ordinal expression expected
 % The expression must be of ordinal type, i.e., maximum a \var{Longint}.
 % This happens, for instance, when you specify a second argument
 % to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value.
-type_e_pointer_type_expected=04008_E_pointer type expected, but got "$1"
+type_e_pointer_type_expected=04008_E_Pointer type expected, but got "$1"
 % The variable or expression isn't of the type \var{pointer}. This
 % happens when you pass a variable that isn't a pointer to \var{New}
 % or \var{Dispose}.
-type_e_class_type_expected=04009_E_class type expected, but got "$1"
+type_e_class_type_expected=04009_E_Class type expected, but got "$1"
 % The variable or expression isn't of the type \var{class}. This happens
 % typically when
 % \begin{enumerate}
@@ -1660,13 +1660,13 @@ type_w_convert_real_2_comp=04014_W_Automatic type conversion from floating type
 % An implicit type conversion from a real type to a \var{comp} is
 % encountered. Since \var{comp} is a 64 bit integer type, this may indicate
 % an error.
-type_h_use_div_for_int=04015_H_use DIV instead to get an integer result
+type_h_use_div_for_int=04015_H_Use DIV instead to get an integer result
 % When hints are on, then an integer division with the '/' operator will
 % produce this message, because the result will then be of type real.
 type_e_strict_var_string_violation=04016_E_String types have to match exactly in $V+ mode
 % When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter
 % should be of the exact same type as the declared parameter of the procedure.
-type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_succ or pred on enums with assignments not possible
+type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_Succ or Pred on enums with assignments not possible
 % If you declare an enumeration type which has C-like assignments
 % in it, such as in the following:
 % \begin{verbatim}
@@ -1730,7 +1730,7 @@ type_e_no_assign_to_const=04032_E_Can't assign values to const variable
 type_e_array_required=04033_E_Array type required
 % If you are accessing a variable using an index '[<x>]' then
 % the type must be an array. In FPC mode a pointer is also allowed.
-type_e_interface_type_expected=04034_E_interface type expected, but got "$1"
+type_e_interface_type_expected=04034_E_Interface type expected, but got "$1"
 % The compiler expected to encounter an interface type name, but got something else.
 % The following code would produce this error:
 % \begin{verbatim}
@@ -1754,7 +1754,7 @@ type_w_mixed_signed_unsigned2=04036_W_Mixing signed expressions and cardinals he
 type_e_typecast_wrong_size_for_assignment=04037_E_Typecast has different size ($1 -> $2) in assignment
 % Type casting to a type with a different size is not allowed when the variable is
 % used in an assignment.
-type_e_array_index_enums_with_assign_not_possible=04038_E_enums with assignments cannot be used as array index
+type_e_array_index_enums_with_assign_not_possible=04038_E_Enums with assignments cannot be used as array index
 % When you declared an enumeration type which has C-like
 % assignments, such as in the following:
 % \begin{verbatim}
@@ -1971,8 +1971,8 @@ type_w_unicode_data_loss=04108_W_Unicode constant cast with potential data loss
 % Conversion from a WideChar to AnsiChar can lose data since now all unicode characters may be represented in the current
 % system codepage
 % You can nest function definitions only 31 levels deep.
-type_e_range_check_error_bounds=04109_E_range check error while evaluating constants ($1 must be between $2 and $3)
-type_w_range_check_error_bounds=04110_W_range check error while evaluating constants ($1 must be between $2 and $3)
+type_e_range_check_error_bounds=04109_E_Range check error while evaluating constants ($1 must be between $2 and $3)
+type_w_range_check_error_bounds=04110_W_Range check error while evaluating constants ($1 must be between $2 and $3)
 % The constants are outside their allowed range.
 type_e_type_not_allowed_for_default=04111_E_This type is not supported for the Default() intrinsic
 % Some types like for example Text and File Of X are not supported by the Default intrinsic.
@@ -2083,11 +2083,11 @@ sym_e_goto_and_label_not_supported=05017_E_GOTO and LABEL are not supported (use
 % supported.
 sym_e_label_not_found=05018_E_Label not found
 % A \var{goto label} was encountered, but the label wasn't declared.
-sym_e_id_is_no_label_id=05019_E_identifier isn't a label
+sym_e_id_is_no_label_id=05019_E_Identifier isn't a label
 % The identifier specified after the \var{goto} isn't of type label.
-sym_e_label_already_defined=05020_E_label already defined
+sym_e_label_already_defined=05020_E_Label already defined
 % You are defining a label twice. You can define a label only once.
-sym_e_ill_type_decl_set=05021_E_illegal type declaration of set elements
+sym_e_ill_type_decl_set=05021_E_Illegal type declaration of set elements
 % The declaration of a set contains an invalid type definition.
 sym_e_class_forward_not_resolved=05022_E_Forward class definition not resolved "$1"
 % You declared a class, but you did not implement it.
@@ -2135,7 +2135,7 @@ sym_w_uninitialized_variable=05037_W_Variable "$1" does not seem to be initializ
 % be used (i.e. it appears in the right-hand side of an expression) when it
 % was not initialized first (i.e. appeared in the left-hand side of an
 % assignment).
-sym_e_id_no_member=05038_E_identifier idents no member "$1"
+sym_e_id_no_member=05038_E_Identifier idents no member "$1"
 % This error is generated when an identifier of a record,
 % field or method is accessed while it is not defined.
 sym_h_param_list=05039_H_Found declaration: $1
@@ -2320,7 +2320,7 @@ sym_h_uninitialized_managed_variable=05092_H_Variable "$1" of a managed type doe
 % was not initialized first (i.e. t did not appear in the left-hand side of an
 % assignment). Since the variable is managed, i. e. implicitly initialized by the compiler, this might be intended behaviour and
 % does not necessarily mean that the code is wrong.
-sym_w_managed_function_result_uninitialized=05093_W_function result variable of a managed type does not seem to be initialized
+sym_w_managed_function_result_uninitialized=05093_W_Function result variable of a managed type does not seem to be initialized
 % This message is displayed if the compiler thinks that the function result
 % variable will be used (i.e. it appears in the right-hand side of an expression)
 % before it is initialized (i.e. before it appeared in the left-hand side of an
@@ -2378,7 +2378,7 @@ cg_w_member_cd_call_from_method=06016_W_Possible illegal call of constructor or
 % require parameters on entry.
 cg_n_inefficient_code=06017_N_Inefficient code
 % Your statement seems dubious to the compiler.
-cg_w_unreachable_code=06018_W_unreachable code
+cg_w_unreachable_code=06018_W_Unreachable code
 % You specified a construct which will never be executed. Example:
 % \begin{verbatim}
 % while false do
@@ -2531,9 +2531,9 @@ asmr_e_no_local_or_para_allowed=07007_E_Cannot use local variable or parameters
 % You cannot use a local variable or parameter here, mostly because the
 % addressing of locals and parameters is done using the frame pointer register so the
 % address cannot be obtained directly.
-asmr_e_need_offset=07008_E_need to use OFFSET here
+asmr_e_need_offset=07008_E_Need to use OFFSET here
 % You need to use OFFSET <id> here to get the address of the identifier.
-asmr_e_need_dollar=07009_E_need to use $ here
+asmr_e_need_dollar=07009_E_Need to use $ here
 % You need to use $<id> here to get the address of the identifier.
 asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Cannot use multiple relocatable symbols
 % You cannot have more than one relocatable symbol (variable/typed constant)
@@ -2574,7 +2574,7 @@ asmr_e_expr_zero_divide=07025_E_Divide by zero in asm evaluator
 % There is a division by zero in a constant expression
 asmr_e_expr_illegal=07026_E_Illegal expression
 % There is an illegal expression in a constant expression
-asmr_e_escape_seq_ignored=07027_E_escape sequence ignored: $1
+asmr_e_escape_seq_ignored=07027_E_Escape sequence ignored: $1
 % There is a C-styled string, but the escape sequence in the string
 % is unknown, and is therefore ignored
 asmr_e_invalid_symbol_ref=07028_E_Invalid symbol reference
@@ -2621,7 +2621,7 @@ asmr_e_invalid_opcode_and_operand=07048_E_Invalid combination of opcode and oper
 asmr_e_syn_operand=07049_E_Assembler syntax error in operand
 asmr_e_syn_constant=07050_E_Assembler syntax error in constant
 asmr_e_invalid_string_expression=07051_E_Invalid String expression
-asmr_w_const32bit_for_address=07052_W_constant with symbol $1 for address which is not on a pointer
+asmr_w_const32bit_for_address=07052_W_Constant with symbol $1 for address which is not on a pointer
 % A constant expression represents an address which does not fit
 % into a pointer. The address is probably incorrect
 asmr_e_unknown_opcode=07053_E_Unrecognized opcode $1
@@ -2662,7 +2662,7 @@ asmr_e_string_not_allowed_as_const=07073_E_Strings not allowed as constants
 asmr_e_no_var_type_specified=07074_E_No type of variable specified
 % The syntax expects a type identifier after the dot, but
 % none was found.
-asmr_w_assembler_code_not_returned_to_text=07075_E_assembler code not returned to text section
+asmr_w_assembler_code_not_returned_to_text=07075_E_Assembler code not returned to text section
 % There was a directive in the assembler block to change sections,
 % but there is a missing return to the text section at the end
 % of the assembler block. This might cause errors during link time.
@@ -2975,20 +2975,20 @@ exec_e_static_lib_not_supported=09035_E_Creation of Static Libraries not support
 % not yet implemented in the compiler.
 exec_i_closing_script=09020_I_Closing script $1
 % Informational message showing when writing of the external assembling and linking script is finished.
-exec_e_res_not_found=09021_E_resource compiler "$1" not found, switching to external mode
+exec_e_res_not_found=09021_E_Resource compiler "$1" not found, switching to external mode
 % An external resource compiler was not found. The compiler will produce a script that
 % can be used to assemble, compile resources and link or postprocess the program.
 exec_i_compilingresource=09022_I_Compiling resource $1
 % An informational message, showing which resource is being compiled.
-exec_t_unit_not_static_linkable_switch_to_smart=09023_T_unit $1 cannot be statically linked, switching to smart linking
+exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Unit $1 cannot be statically linked, switching to smart linking
 % Static linking was requested, but a unit which is not statically linkable was used.
-exec_t_unit_not_smart_linkable_switch_to_static=09024_T_unit $1 cannot be smart linked, switching to static linking
+exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Unit $1 cannot be smart linked, switching to static linking
 % Smart linking was requested, but a unit which is not smart-linkable was used.
-exec_t_unit_not_shared_linkable_switch_to_static=09025_T_unit $1 cannot be shared linked, switching to static linking
+exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Unit $1 cannot be shared linked, switching to static linking
 % Shared linking was requested, but a unit which is not shared-linkable was used.
-exec_e_unit_not_smart_or_static_linkable=09026_E_unit $1 cannot be smart or static linked
+exec_e_unit_not_smart_or_static_linkable=09026_E_Unit $1 cannot be smart or static linked
 % Smart or static linking was requested, but a unit which cannot be used for either  was used.
-exec_e_unit_not_shared_or_static_linkable=09027_E_unit $1 cannot be shared or static linked
+exec_e_unit_not_shared_or_static_linkable=09027_E_Unit $1 cannot be shared or static linked
 % Shared or static linking was requested, but a unit which cannot be used for either  was used.
 exec_d_resbin_params=09028_D_Calling resource compiler "$1" with "$2" as command line
 % An informational message showing which command line is used for the resource compiler.
@@ -3152,7 +3152,7 @@ unit_f_ppu_cannot_write=10013_F_Can't Write PPU-File
 unit_f_ppu_read_error=10014_F_Error reading PPU-File
 % This means that the unit file was corrupted, and contains invalid
 % information. Recompilation will be necessary.
-unit_f_ppu_read_unexpected_end=10015_F_unexpected end of PPU-File
+unit_f_ppu_read_unexpected_end=10015_F_Unexpected end of PPU-File
 % Unexpected end of file. This may mean that the PPU file is
 % corrupted.
 unit_f_ppu_invalid_entry=10016_F_Invalid PPU-File entry: $1
@@ -3350,7 +3350,7 @@ option_only_one_source_support=11001_W_Only one source file supported, changing
 % you forgot a \var{'-'} sign.
 option_def_only_for_os2=11002_W_DEF file can be created only for OS/2
 % This option can only be specified when you're compiling for OS/2.
-option_no_nested_response_file=11003_E_nested response files are not supported
+option_no_nested_response_file=11003_E_Nested response files are not supported
 % You cannot nest response files with the \var{@file} command line option.
 option_no_source_found=11004_F_No source file name in command line
 % The compiler expects a source file name on the command line.
@@ -3420,15 +3420,15 @@ option_start_reading_configfile=11030_H_Start of reading config file $1
 % Start of configuration file parsing.
 option_end_reading_configfile=11031_H_End of reading config file $1
 % End of configuration file parsing.
-option_interpreting_option=11032_D_interpreting option "$1"
+option_interpreting_option=11032_D_Interpreting option "$1"
 % The compiler is interpreting an option
-option_interpreting_firstpass_option=11036_D_interpreting firstpass option "$1"
+option_interpreting_firstpass_option=11036_D_Interpreting firstpass option "$1"
 % The compiler is interpreting an option for the first time.
-option_interpreting_file_option=11033_D_interpreting file option "$1"
+option_interpreting_file_option=11033_D_Interpreting file option "$1"
 % The compiler is interpreting an option which it read from the configuration file.
 option_read_config_file=11034_D_Reading config file "$1"
 % The compiler is starting to read the configuration file.
-option_found_file=11035_D_found source file name "$1"
+option_found_file=11035_D_Found source file name "$1"
 % Additional information about options.
 % Displayed when you have the debug option turned on.
 option_code_page_not_available=11039_E_Unknown codepage "$1"
@@ -3475,9 +3475,9 @@ option_illegal_fpu_eabihf=11052_E_You must use a FPU type of VFPV2, VFPV3 or VFP
 % The EABIHF (VFP hardfloat) ABI target can only be used with VFP FPUs.
 option_w_unsupported_debug_format=11053_W_The selected debug format is not supported on the current target, not changing the current setting
 % Not all targets support all debug formats (in particular, Stabs is not supported on 64 bit targets).
-option_missing_arg=11054_E_argument to "$1" is missing
+option_missing_arg=11054_E_Argument to "$1" is missing
 % Displayed when parameter must be followed by an argument.
-option_malformed_para=11055_E_malformed parameter: $1
+option_malformed_para=11055_E_Malformed parameter: $1
 % Given argument is not valid for parameter.
 option_smart_link_requires_external_linker=11056_W_Smart linking requires external linker
 option_com_files_require_tiny_model=11057_E_Creating .COM files is not supported in the current memory model. Only the tiny memory model supports making .COM files.
@@ -3632,7 +3632,7 @@ package_f_pcp_cannot_write=13019_F_Can't Write PCP-File
 package_f_pcp_read_error=13020_F_Error reading PCP-File
 % This means that the package file was corrupted, and contains invalid
 % information. Recompilation will be necessary.
-package_f_pcp_read_unexpected_end=13021_F_unexpected end of PCP-File
+package_f_pcp_read_unexpected_end=13021_F_Unexpected end of PCP-File
 % Unexpected end of file. This may mean that the PCP file is
 % corrupted.
 package_f_pcp_invalid_entry=13022_F_Invalid PCP-File entry: $1

compiler/msgidx.inc

@@ -1105,7 +1105,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 82668;
+  MsgTxtSize = 82667;
 
   MsgIdxMax : array[1..20] of longint=(
     28,106,349,126,98,59,142,34,221,67,

compiler/nadd.pas

@@ -377,11 +377,11 @@ implementation
 
     function taddnode.simplify(forinline : boolean) : tnode;
 
-      function is_range_test(nodel, noder: taddnode; var value: tnode; var cl,cr: Tconstexprint): boolean;
+      function is_range_test(nodel, noder: taddnode; out value: tnode; var cl,cr: Tconstexprint): boolean;
         const
           is_upper_test: array[ltn..gten] of boolean = (true,true,false,false);
-          inclusive_adjust: array[boolean,ltn..gten] of integer = ((1,0,-1,0),
-                                                                   (-1,0,1,0));
+          inclusive_adjust: array[boolean,ltn..gten] of integer = ((-1,0,1,0),
+                                                                   (1,0,-1,0));
         var
           swapl, swapr: Boolean;
           valuer: tnode;
@@ -1056,7 +1056,7 @@ implementation
             if is_boolean(left.resultdef) and is_boolean(right.resultdef) then
               begin
                 { transform unsigned comparisons of (v>=x) and (v<=y)
-                  into (v-x)<(y-x)
+                  into (v-x)<=(y-x)
                 }
                 if (nodetype=andn) and
                    (left.nodetype in [ltn,lten,gtn,gten]) and

compiler/nbas.pas

@@ -59,6 +59,14 @@ interface
        end;
        tspecializenodeclass = class of tspecializenode;
 
+       tfinalizetempsnode = class(tnode)
+          constructor create;virtual;
+          function pass_1 : tnode;override;
+          function pass_typecheck:tnode;override;
+          function docompare(p: tnode): boolean; override;
+       end;
+       tfinalizetempsnodeclass = class of tfinalizetempsnode;
+
        tasmnode = class(tnode)
           p_asm : TAsmList;
           currenttai : tai;
@@ -289,6 +297,7 @@ interface
        cnothingnode : tnothingnodeclass = tnothingnode;
        cerrornode : terrornodeclass = terrornode;
        cspecializenode : tspecializenodeclass = tspecializenode;
+       cfinalizetempsnode: tfinalizetempsnodeclass = tfinalizetempsnode;
        casmnode : tasmnodeclass = tasmnode;
        cstatementnode : tstatementnodeclass = tstatementnode;
        cblocknode : tblocknodeclass = tblocknode;
@@ -363,7 +372,6 @@ implementation
       end;
 
 
-
 {*****************************************************************************
                              TFIRSTNOTHING
 *****************************************************************************}
@@ -456,6 +464,34 @@ implementation
       end;
 
 
+{*****************************************************************************
+                             TFINALIZETEMPSNODE
+*****************************************************************************}
+
+    constructor tfinalizetempsnode.create;
+      begin
+        inherited create(finalizetempsn);
+      end;
+
+    function tfinalizetempsnode.pass_1: tnode;
+      begin
+        result:=nil;
+        expectloc:=LOC_VOID;
+      end;
+
+    function tfinalizetempsnode.pass_typecheck: tnode;
+      begin
+        resultdef:=voidtype;
+        result:=nil;
+      end;
+
+    function tfinalizetempsnode.docompare(p: tnode): boolean;
+      begin
+        { these nodes should never be coalesced }
+        result:=false;
+      end;
+
+
 {*****************************************************************************
                             TSTATEMENTNODE
 *****************************************************************************}

compiler/ncgbas.pas

@@ -68,6 +68,10 @@ interface
           procedure pass_generate_code;override;
        end;
 
+       tcgfinalizetempsnode = class(tfinalizetempsnode)
+          procedure pass_generate_code; override;
+       end;
+
   implementation
 
     uses
@@ -714,6 +718,17 @@ interface
       end;
 
 
+{*****************************************************************************
+                         TCGFINALIZETEMPSNODE
+*****************************************************************************}
+
+    procedure tcgfinalizetempsnode.pass_generate_code;
+      begin
+        hlcg.gen_finalize_code(current_asmdata.CurrAsmList);
+        location.loc:=LOC_VOID;
+      end;
+
+
 begin
    cnothingnode:=tcgnothingnode;
    casmnode:=tcgasmnode;
@@ -722,4 +737,5 @@ begin
    ctempcreatenode:=tcgtempcreatenode;
    ctemprefnode:=tcgtemprefnode;
    ctempdeletenode:=tcgtempdeletenode;
+   cfinalizetempsnode:=tcgfinalizetempsnode;
 end.

compiler/ncgflw.pas

@@ -196,8 +196,9 @@ implementation
            hlcg.a_jmp_always(current_asmdata.CurrAsmList,lcont);
 
          if not(cs_opt_size in current_settings.optimizerswitches) then
-            { align loop target }
-            current_asmdata.CurrAsmList.concat(Tai_align.Create(current_settings.alignment.loopalign));
+            { align loop target, as an unconditional jump is done before,
+              use jump align which assume that the instructions inserted as alignment are never executed }
+            current_asmdata.CurrAsmList.concat(cai_align.create_max(current_settings.alignment.jumpalign,current_settings.alignment.jumpalignmax));
 
          hlcg.a_label(current_asmdata.CurrAsmList,lloop);
 

compiler/ncginl.pas

@@ -26,7 +26,7 @@ unit ncginl;
 interface
 
     uses
-       node,ninl;
+       node,ninl,symtype;
 
     type
        tcginlinenode = class(tinlinenode)
@@ -66,6 +66,8 @@ interface
           procedure second_seg; virtual; abstract;
           procedure second_fma; virtual;
           procedure second_frac_real; virtual;
+       protected
+          function  second_incdec_tempregdef: tdef;virtual;
        end;
 
 implementation
@@ -73,7 +75,7 @@ implementation
     uses
       globtype,constexp,
       verbose,globals,compinnr,
-      symconst,symtype,symdef,defutil,
+      symconst,symdef,defutil,
       aasmbase,aasmdata,
       cgbase,pass_2,
       cpubase,procinfo,
@@ -162,6 +164,13 @@ implementation
                 if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then
                   location.reference.alignment:=resultdef.alignment;
               end;
+            in_volatile_x:
+              begin
+                secondpass(tcallparanode(left).left);
+                location:=tcallparanode(left).left.location;
+                if location.loc in [LOC_CREFERENCE,LOC_REFERENCE,LOC_SUBSETREF,LOC_CSUBSETREF] then
+                  location.reference.volatility:=[vol_read,vol_write];
+              end;
 {$ifdef SUPPORT_MMX}
             in_mmx_pcmpeqb..in_mmx_pcmpgtw:
               begin
@@ -332,6 +341,11 @@ implementation
 {*****************************************************************************
                          INC/DEC GENERIC HANDLING
 *****************************************************************************}
+      function tcginlinenode.second_incdec_tempregdef: tdef;
+        begin
+          second_incdec_tempregdef:=left.resultdef;
+        end;
+
       procedure tcginlinenode.second_IncDec;
        const
          addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB);
@@ -382,7 +396,7 @@ implementation
                  addvalue:=addvalue*tpointerconstnode(tcallparanode(tcallparanode(left).right).left).value
               else
                 begin
-                  hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,tcallparanode(tcallparanode(left).right).left.resultdef,cgsize_orddef(def_cgsize(left.resultdef)),addvalue<=1);
+                  hlcg.location_force_reg(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,tcallparanode(tcallparanode(left).right).left.resultdef,second_incdec_tempregdef,addvalue<=1);
                   hregister:=tcallparanode(tcallparanode(left).right).left.location.register;
 {$ifndef cpu64bitalu}
                   hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.register64.reghi;
@@ -684,7 +698,7 @@ implementation
 
         tempreg1:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef);
         tempreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,left.resultdef);
-	
+
         hlcg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,left.resultdef,left.resultdef.size*8-1,left.location.register,tempreg1);
         hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_XOR,left.resultdef,left.location.register,tempreg1,tempreg2);
         hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmlist,OP_SUB,left.resultdef,tempreg1,tempreg2,location.register);
@@ -910,4 +924,4 @@ implementation
 
 begin
    cinlinenode:=tcginlinenode;
-end.  s
+end.

compiler/ncgld.pas

@@ -420,6 +420,7 @@ implementation
         href : treference;
         newsize : tcgsize;
         vd : tdef;
+        alignment: longint;
         indirect : boolean;
         name : TSymStr;
       begin
@@ -529,7 +530,10 @@ implementation
                     { assume packed records may always be unaligned }
                     if not(resultdef.typ in [recorddef,objectdef]) or
                        (tabstractrecordsymtable(tabstractrecorddef(resultdef).symtable).usefieldalignment<>1) then
-                      location_reset_ref(location,LOC_REFERENCE,newsize,resultdef.alignment,[])
+                      begin
+                        alignment:=min(min(min(resultdef.alignment,current_settings.alignment.localalignmax),current_settings.alignment.constalignmax),current_settings.alignment.varalignmax);
+                        location_reset_ref(location,LOC_REFERENCE,newsize,alignment,[]);
+                      end
                     else
                       location_reset_ref(location,LOC_REFERENCE,newsize,1,[]);
                     hlcg.reference_reset_base(location.reference,voidpointertype,hregister,0,ctempposinvalid,location.reference.alignment,[]);

compiler/ncgrtti.pas

@@ -1018,15 +1018,36 @@ implementation
                  otSByte,otSWord,otSLong,otSQWord,otUByte{otNone},
                  otUByte,otUByte,otUWord,otULong,otUQWord,
                  otSByte,otSWord,otSLong,otSQWord,
-                 otUByte,otUWord,otUByte);
+                 otUByte,otUWord,otUByte,255);
             var
               elesize: string[1];
+              deftrans: byte;
           begin
             write_header(tcb,def,typekind);
-            case trans[def.ordtype] of
+            deftrans:=trans[def.ordtype];
+            case deftrans of
               otUQWord,
               otSQWord:
-                elesize:='8'
+                elesize:='8';
+              255:
+                begin
+                  if def.packedbitsize<=32 then
+                    begin
+                      elesize:='4';
+                      if def.low<0 then
+                        deftrans:=otSLong
+                      else
+                        deftrans:=otULong;
+                    end
+                  else
+                    begin
+                      elesize:='8';
+                      if def.low<0 then
+                        deftrans:=otSQWord
+                      else
+                        deftrans:=otUQWord;
+                    end;
+                end
               else
                 elesize:='4'
             end;
@@ -1042,7 +1063,7 @@ implementation
               targetinfos[target_info.system]^.alignment.recordalignmin,
               targetinfos[target_info.system]^.alignment.maxCrecordalign);
             {Convert to longint to smuggle values in high(longint)+1..high(cardinal) into asmlist.}
-            case trans[def.ordtype] of
+            case deftrans of
               otUQWord:
                 begin
                   tcb.emit_ord_const(min,u64inttype);

compiler/ncgset.pas

@@ -234,7 +234,7 @@ implementation
     procedure tcginnode.pass_generate_code;
        var
          adjustment,
-         setbase    : aint;
+         setbase    : {$ifdef CPU8BITALU}smallint{$else}aint{$endif};
          l, l2      : tasmlabel;
          hr,
          pleftreg   : tregister;

compiler/ngenutil.pas

@@ -57,7 +57,7 @@ interface
         all local (static) typed consts }
       class procedure static_syms_finalize(p: TObject; arg: pointer);
       class procedure sym_maybe_finalize(var stat: tstatementnode; sym: tsym);
-      class procedure append_struct_initfinis(u: tmodule; initfini: tstructinifinipotype; var stat: tstatementnode);
+      class procedure append_struct_initfinis(u: tmodule; initfini: tstructinifinipotype; var stat: tstatementnode); virtual;
      public
       class procedure procdef_block_add_implicit_initialize_nodes(pd: tprocdef; var stat: tstatementnode);
       class procedure procdef_block_add_implicit_finalize_nodes(pd: tprocdef; var stat: tstatementnode);

compiler/ngtcon.pas

@@ -361,7 +361,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
     procedure tasmlisttypedconstbuilder.flush_packed_value(var bp: tbitpackedval);
       var
         bitstowrite: longint;
-        writeval : AInt;
+        writeval : {$ifdef CPU8BITALU}smallint{$else}aint{$endif};
       begin
         if (bp.curbitoffset < AIntBits) then
           begin
@@ -403,7 +403,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
     { parses a packed array constant }
     procedure tasmlisttypedconstbuilder.parse_packed_array_def(def: tarraydef);
       var
-        i  : aint;
+        i  : {$ifdef CPU8BITALU}smallint{$else}aint{$endif};
         bp : tbitpackedval;
       begin
         if not(def.elementdef.typ in [orddef,enumdef]) then
@@ -455,7 +455,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
 
     procedure tasmlisttypedconstbuilder.tc_emit_stringdef(def: tstringdef; var node: tnode);
       var
-        strlength : aint;
+        strlength : {$ifdef CPU8BITALU}smallint{$else}aint{$endif};
         strval    : pchar;
         ll        : tasmlabofs;
         ca        : pchar;
@@ -1227,7 +1227,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
 
                     ftcb.finish_internal_data_builder(datatcb,ll,dynarrdef,sizeof(pint));
 
-                    ftcb.emit_dynarray_offset(llofs,dyncount,def);
+                    ftcb.emit_dynarray_offset(llofs,dyncount,def,trecorddef(dynarrdef));
                   end;
               end
             else
@@ -1518,11 +1518,11 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         sorg,s  : TIDString;
         tmpguid : tguid;
         recoffset,
-        fillbytes  : aint;
+        fillbytes  : {$ifdef CPU8BITALU}smallint{$else}aint{$endif};
         bp   : tbitpackedval;
         error,
         is_packed: boolean;
-        startoffset: aword;
+        startoffset: {$ifdef CPU8BITALU}word{$else}aword{$endif};
 
       procedure handle_stringconstn;
         begin
@@ -1733,10 +1733,10 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         obj    : tobjectdef;
         srsym  : tsym;
         st     : tsymtable;
-        objoffset : aint;
+        objoffset : {$ifdef CPU8BITALU}smallint{$else}aint{$endif};
         s,sorg : TIDString;
         vmtwritten : boolean;
-        startoffset:aint;
+        startoffset : {$ifdef CPU8BITALU}smallint{$else}aint{$endif};
       begin
         { no support for packed object }
         if is_packed_record_or_object(def) then
@@ -1926,7 +1926,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         recsym,
         srsym   : tsym;
         sorg,s  : TIDString;
-        recoffset : aint;
+        recoffset : {$ifdef CPU8BITALU}smallint{$else}aint{$endif};
         error,
         is_packed: boolean;
 
@@ -2095,7 +2095,7 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         obj    : tobjectdef;
         srsym  : tsym;
         st     : tsymtable;
-        objoffset : aint;
+        objoffset : {$ifdef CPU8BITALU}smallint{$else}aint{$endif};
         s,sorg : TIDString;
       begin
         { no support for packed object }

compiler/ninl.pas

@@ -3548,6 +3548,12 @@ implementation
                 begin
                   resultdef:=left.resultdef;
                 end;
+              in_volatile_x:
+                begin
+                  resultdef:=left.resultdef;
+                  { volatile only makes sense if the value is in memory }
+                  make_not_regable(left,[ra_addr_regable]);
+                end;
               in_assert_x_y :
                 begin
                   resultdef:=voidtype;
@@ -4037,7 +4043,8 @@ implementation
              expectloc:=LOC_VOID;
            end;
          in_aligned_x,
-         in_unaligned_x:
+         in_unaligned_x,
+         in_volatile_x:
            begin
              expectloc:=tcallparanode(left).left.expectloc;
            end;

compiler/nld.pas

@@ -517,7 +517,6 @@ implementation
 
       begin
          inherited create(assignn,l,r);
-         l.mark_write;
          assigntype:=at_normal;
          if r.nodetype = typeconvn then
            ttypeconvnode(r).warn_pointer_to_signed:=false;
@@ -587,6 +586,8 @@ implementation
 
         typecheckpass(left);
 
+        left.mark_write;
+
         { PI. This is needed to return correct resultdef of add nodes for ansistrings
           rawbytestring return needs to be replaced by left.resultdef }
         oldassignmentnode:=aktassignmentnode;

compiler/nmem.pas

@@ -1176,7 +1176,7 @@ implementation
       begin
         include(flags,nf_write);
         { see comment in tsubscriptnode.mark_write }
-        if not(is_implicit_pointer_object_type(left.resultdef)) then
+        if not(is_implicit_array_pointer(left.resultdef)) then
           left.mark_write;
       end;
 

compiler/node.pas

@@ -110,7 +110,8 @@ interface
           loadparentfpn,    { Load the framepointer of the parent for nested procedures }
           objcselectorn,    { node for an Objective-C message selector }
           objcprotocoln,    { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) }
-          specializen       { parser-only node to handle Delphi-mode inline specializations }
+          specializen,      { parser-only node to handle Delphi-mode inline specializations }
+          finalizetempsn        { Internal node used to clean up code generator temps (warning: must NOT create additional tepms that may need to be finalised!) }
        );
 
        tnodetypeset = set of tnodetype;
@@ -194,7 +195,8 @@ interface
           'loadparentfpn',
           'objcselectorn',
           'objcprotocoln',
-          'specializen');
+          'specializen',
+          'finalizetempsn');
 
       { a set containing all const nodes }
       nodetype_const = [niln,

compiler/nutils.pas

@@ -582,21 +582,32 @@ implementation
         obj_def: tobjectdef;
         self_temp,
         vmt_temp: ttempcreatenode;
-        check_self: tnode;
+        check_self,n: tnode;
         stat: tstatementnode;
         block: tblocknode;
         paras: tcallparanode;
-        docheck: boolean;
+        docheck,is_typecasted_classref: boolean;
       begin
         self_resultdef:=self_node.resultdef;
         case self_resultdef.typ of
           classrefdef:
-            obj_def:=tobjectdef(tclassrefdef(self_resultdef).pointeddef);
+            begin
+              obj_def:=tobjectdef(tclassrefdef(self_resultdef).pointeddef);
+            end;
           objectdef:
             obj_def:=tobjectdef(self_resultdef);
           else
             internalerror(2015052701);
         end;
+        n:=self_node;
+        is_typecasted_classref:=false;
+	if (n.nodetype=typeconvn) then
+          begin
+            while assigned(n) and (n.nodetype=typeconvn) and (nf_explicit in ttypeconvnode(n).flags) do
+              n:=ttypeconvnode(n).left;
+            if assigned(n) and (n.resultdef.typ=classrefdef) then
+              is_typecasted_classref:=true;
+	  end;
         if is_classhelper(obj_def) then
           obj_def:=tobjectdef(tobjectdef(obj_def).extendeddef);
         docheck:=
@@ -639,14 +650,14 @@ implementation
             addstatement(stat,ctempdeletenode.create_normal_temp(self_temp));
             self_node:=ctemprefnode.create(self_temp);
           end;
-        { get the VMT field in case of a class/object }
-        if (self_resultdef.typ=objectdef) and
-           assigned(tobjectdef(self_resultdef).vmt_field) then
-          result:=csubscriptnode.create(tobjectdef(self_resultdef).vmt_field,self_node)
         { in case of a classref, the "instance" is a pointer
           to pointer to a VMT and there is no vmt field }
-        else if self_resultdef.typ=classrefdef then
+        if is_typecasted_classref or (self_resultdef.typ=classrefdef) then
           result:=self_node
+        { get the VMT field in case of a class/object }
+        else if (self_resultdef.typ=objectdef) and
+           assigned(tobjectdef(self_resultdef).vmt_field) then
+          result:=csubscriptnode.create(tobjectdef(self_resultdef).vmt_field,self_node)
         { in case of an interface, the "instance" is a pointer to a pointer
           to a VMT -> dereference once already }
         else
@@ -880,6 +891,7 @@ implementation
                     in_abs_real,
                     in_aligned_x,
                     in_unaligned_x,
+                    in_volatile_x,
                     in_prefetch_var:
                       begin
                         inc(result);
@@ -963,6 +975,11 @@ implementation
                   end;
 
                 end;
+              finalizetempsn:
+                begin
+                  result:=NODE_COMPLEXITY_INF;
+                  exit;
+                end;
               else
                 begin
                   result := NODE_COMPLEXITY_INF;
@@ -1337,7 +1354,7 @@ implementation
     function check_for_sideeffect(var n: tnode; arg: pointer): foreachnoderesult;
       begin
         result:=fen_false;
-        if (n.nodetype in [assignn,calln,asmn]) or
+        if (n.nodetype in [assignn,calln,asmn,finalizetempsn]) or
           ((n.nodetype=inlinen) and
            (tinlinenode(n).inlinenumber in [in_write_x,in_writeln_x,in_read_x,in_readln_x,in_str_x_string,
              in_val_x,in_reset_x,in_rewrite_x,in_reset_typedfile,in_rewrite_typedfile,

compiler/optcse.pas

@@ -329,7 +329,7 @@ unit optcse;
                    (is_set(n.resultdef))
                    ) then
                   while (n.nodetype=tbinarynode(n).left.nodetype) and
-                    { if node (1) is fully boolean evaluated and node (2) not, we cannot do the swap as is might result in B being evaluated always,
+                    { if node (1) is fully boolean evaluated and node (2) not, we cannot do the swap as this might result in B being evaluated always,
                       the other way round is no problem, C is still evaluated only if needed }
                     (not(is_boolean(n.resultdef)) or not(n.nodetype in [andn,orn]) or doshortbooleval(n) or not(doshortbooleval(tbinarynode(n).left))) and
                         { the resulttypes of the operands we'll swap must be equal,
@@ -347,6 +347,17 @@ unit optcse;
                           foreachnodestatic(pm_postprocess,tbinarynode(tbinarynode(n).left).right,@searchsubdomain,@csedomain);
                           if csedomain then
                             begin
+                              { move the full boolean evaluation of (2) to (1), if it was there (so it again applies to A and
+                                what follows) }
+                              if not(doshortbooleval(tbinarynode(n).left)) and
+                                 doshortbooleval(n) then
+                                begin
+                                  n.localswitches:=n.localswitches+(tbinarynode(n).left.localswitches*[cs_full_boolean_eval]);
+                                  exclude(tbinarynode(n).left.localswitches,cs_full_boolean_eval);
+                                  tbinarynode(n).left.flags:=tbinarynode(n).left.flags+(n.flags*[nf_short_bool]);
+                                  exclude(n.Flags,nf_short_bool);
+                                end;
+
                               hp2:=tbinarynode(tbinarynode(n).left).left;
                               tbinarynode(tbinarynode(n).left).left:=tbinarynode(tbinarynode(n).left).right;
                               tbinarynode(tbinarynode(n).left).right:=tbinarynode(n).right;

compiler/pass_2.pas

@@ -156,7 +156,8 @@ implementation
              'loadparentfpn',
              'objselectorn',
              'objcprotocoln',
-             'specializen'
+             'specializen',
+             'finalizetemps'
              );
       var
         p: pchar;

compiler/pexpr.pas

@@ -515,7 +515,8 @@ implementation
             end;
 
           in_aligned_x,
-          in_unaligned_x :
+          in_unaligned_x,
+          in_volatile_x:
             begin
               err:=false;
               consume(_LKLAMMER);

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 203;
+  CurrentPPUVersion = 205;
 
 { unit flags }
   uf_init                = $000001; { unit has initialization section }

compiler/psub.pas

@@ -47,9 +47,8 @@ interface
         loadpara_asmnode,
         exitlabel_asmnode,
         stackcheck_asmnode,
-        init_asmnode,
-        final_asmnode : tasmnode;
-        final_used : boolean;
+        init_asmnode    : tasmnode;
+        temps_finalized : boolean;
         dfabuilder : TDFABuilder;
 
         destructor  destroy;override;
@@ -678,8 +677,6 @@ implementation
      destructor tcgprocinfo.destroy;
        begin
          code.free;
-         if not final_used then
-           final_asmnode.free;
          inherited destroy;
        end;
 
@@ -768,9 +765,10 @@ implementation
                   (cs_implicit_exceptions in current_settings.moduleswitches)) then
                   begin
                     include(tocode.flags,nf_block_with_exit);
-                    addstatement(newstatement,final_asmnode);
+                    if procdef.proctypeoption<>potype_exceptfilter then
+                      addstatement(newstatement,cfinalizetempsnode.create);
                     cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,newstatement);
-                    final_used:=true;
+                    temps_finalized:=true;
                   end;
 
                 { construction successful -> beforedestruction should be called
@@ -880,8 +878,7 @@ implementation
         { Generate code/locations used at end of proc }
         current_filepos:=exitpos;
         exitlabel_asmnode:=casmnode.create_get_position;
-        final_asmnode:=casmnode.create_get_position;
-        final_used:=false;
+        temps_finalized:=false;
         bodyexitcode:=generate_bodyexit_block;
 
         { Generate procedure by combining init+body+final,
@@ -895,6 +892,18 @@ implementation
         addstatement(newstatement,entry_asmnode);
         cnodeutils.procdef_block_add_implicit_initialize_nodes(procdef,newstatement);
         addstatement(newstatement,init_asmnode);
+        if assigned(procdef.parentfpinitblock) then
+          begin
+            if assigned(tblocknode(procdef.parentfpinitblock).left) then
+              begin
+                { could be an asmn in case of a pure assembler procedure,
+                  but those shouldn't access nested variables }
+                addstatement(newstatement,procdef.parentfpinitblock);
+              end
+            else
+              procdef.parentfpinitblock.free;
+            procdef.parentfpinitblock:=nil;
+          end;
         addstatement(newstatement,bodyentrycode);
 
         if (cs_implicit_exceptions in current_settings.moduleswitches) and
@@ -914,13 +923,14 @@ implementation
             current_filepos:=exitpos;
             { Generate code that will be in the try...finally }
             finalcode:=internalstatements(codestatement);
-            addstatement(codestatement,final_asmnode);
+            if procdef.proctypeoption<>potype_exceptfilter then
+              addstatement(codestatement,cfinalizetempsnode.create);
             cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,codestatement);
-            final_used:=true;
+            temps_finalized:=true;
 
             current_filepos:=entrypos;
             wrappedbody:=ctryfinallynode.create_implicit(code,finalcode);
-            { afterconstruction must be called after final_asmnode, because it
+            { afterconstruction must be called after finalizetemps, because it
                has to execute after the temps have been finalised in case of a
                refcounted class (afterconstruction decreases the refcount
                without freeing the instance if the count becomes nil, while
@@ -947,12 +957,13 @@ implementation
             addstatement(newstatement,bodyexitcode);
             if not is_constructor then
               begin
-                addstatement(newstatement,final_asmnode);
+                if procdef.proctypeoption<>potype_exceptfilter then
+                  addstatement(newstatement,cfinalizetempsnode.create);
                 cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,newstatement);
-                final_used:=true;
+                temps_finalized:=true;
               end;
           end;
-        if not final_used then
+        if not temps_finalized then
           begin
             current_filepos:=exitpos;
             cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,newstatement);
@@ -1569,16 +1580,13 @@ implementation
 
             if assigned(finalize_procinfo) then
               generate_exceptfilter(tcgprocinfo(finalize_procinfo))
-            else
+            else if not temps_finalized then
               begin
                 hlcg.gen_finalize_code(templist);
                 { the finalcode must be concated if there was no position available,
                   using insertlistafter will result in an insert at the start
                   when currentai=nil }
-                if assigned(final_asmnode) and assigned(final_asmnode.currenttai) then
-                  aktproccode.insertlistafter(final_asmnode.currenttai,templist)
-                else
-                  aktproccode.concatlist(templist);
+                aktproccode.concatlist(templist);
               end;
             { insert exit label at the correct position }
             hlcg.a_label(templist,CurrExitLabel);
@@ -1753,7 +1761,6 @@ implementation
             delete_marker(exitlabel_asmnode);
             delete_marker(stackcheck_asmnode);
             delete_marker(init_asmnode);
-            delete_marker(final_asmnode);
 
 {$ifndef NoOpt}
             if not(cs_no_regalloc in current_settings.globalswitches) then
@@ -1880,6 +1887,7 @@ implementation
          old_current_structdef: tabstractrecorddef;
          old_current_genericdef,
          old_current_specializedef: tstoreddef;
+         parentfpinitblock: tnode;
          old_parse_generic: boolean;
          recordtokens : boolean;
 
@@ -1992,16 +2000,10 @@ implementation
                begin
                  if assigned(tblocknode(procdef.parentfpinitblock).left) then
                    begin
-                     { could be an asmn in case of a pure assembler procedure,
-                       but those shouldn't access nested variables }
-                     if code.nodetype<>blockn then
-                       internalerror(2015122601);
-                     tblocknode(code).left:=cstatementnode.create(procdef.parentfpinitblock,tblocknode(code).left);
-                     do_typecheckpass(tblocknode(code).left);
+                     parentfpinitblock:=procdef.parentfpinitblock;
+                     do_typecheckpass(parentfpinitblock);
+                     procdef.parentfpinitblock:=parentfpinitblock;
                    end
-                 else
-                   procdef.parentfpinitblock.free;
-                 procdef.parentfpinitblock:=nil;
                end;
 
            end;

compiler/psystem.pas

@@ -103,6 +103,7 @@ implementation
 {$endif SUPPORT_GET_FRAME}
         systemunit.insert(csyssym.create('Unaligned',in_unaligned_x));
         systemunit.insert(csyssym.create('Aligned',in_aligned_x));
+        systemunit.insert(csyssym.create('Volatile',in_volatile_x));
         systemunit.insert(csyssym.create('ObjCSelector',in_objc_selector_x)); { objc only }
         systemunit.insert(csyssym.create('ObjCEncode',in_objc_encode_x)); { objc only }
         systemunit.insert(csyssym.create('Default',in_default_x));
@@ -261,8 +262,16 @@ implementation
         s8inttype:=corddef.create(s8bit,int64(-128),127,true);
         u16inttype:=corddef.create(u16bit,0,65535,true);
         s16inttype:=corddef.create(s16bit,int64(-32768),32767,true);
+        s24inttype:=corddef.create(customint,-(int64(1) shl 23),1 shl 23 - 1,true);
+        u24inttype:=corddef.create(customint,0,1 shl 24 - 1,true);
         u32inttype:=corddef.create(u32bit,0,high(longword),true);
         s32inttype:=corddef.create(s32bit,int64(low(longint)),int64(high(longint)),true);
+        s40inttype:=corddef.create(customint,-(int64(1) shl 39),int64(1) shl 39 - 1,true);
+        u40inttype:=corddef.create(customint,0,int64(1) shl 40 - 1,true);
+        s48inttype:=corddef.create(customint,-(int64(1) shl 47),int64(1) shl 47 - 1,true);
+        u48inttype:=corddef.create(customint,0,int64(1) shl 48 - 1,true);
+        s56inttype:=corddef.create(customint,-(int64(1) shl 55),int64(1) shl 55 - 1,true);
+        u56inttype:=corddef.create(customint,0,int64(1) shl 56 - 1,true);
         u64inttype:=corddef.create(u64bit,low(qword),high(qword),true);
         s64inttype:=corddef.create(s64bit,low(int64),high(int64),true);
         { upper/lower bound not yet properly set for 128 bit types, as we don't
@@ -499,8 +508,16 @@ implementation
         addtype('$shortint',s8inttype);
         addtype('$word',u16inttype);
         addtype('$smallint',s16inttype);
+        addtype('$sint24',s24inttype);
+        addtype('$uint24',u24inttype);
         addtype('$ulong',u32inttype);
         addtype('$longint',s32inttype);
+        addtype('$sint40',s40inttype);
+        addtype('$uint40',u40inttype);
+        addtype('$sint48',s48inttype);
+        addtype('$uint48',u48inttype);
+        addtype('$sint56',s56inttype);
+        addtype('$uint56',u56inttype);
         addtype('$qword',u64inttype);
         addtype('$int64',s64inttype);
         addtype('$uint128',u128inttype);
@@ -632,8 +649,16 @@ implementation
         loadtype('shortint',s8inttype);
         loadtype('word',u16inttype);
         loadtype('smallint',s16inttype);
+        loadtype('uint24',u24inttype);
+        loadtype('sint24',s24inttype);
         loadtype('ulong',u32inttype);
         loadtype('longint',s32inttype);
+        loadtype('uint40',u40inttype);
+        loadtype('sint40',s40inttype);
+        loadtype('uint48',u48inttype);
+        loadtype('sint48',s48inttype);
+        loadtype('uint56',u56inttype);
+        loadtype('sint56',s56inttype);
         loadtype('qword',u64inttype);
         loadtype('int64',s64inttype);
         loadtype('uint128',u128inttype);

compiler/raatt.pas

@@ -1340,9 +1340,9 @@ unit raatt;
                        if actasmtoken=AS_COMMA then
                          begin
                            Consume(AS_COMMA);
-                           if actasmtoken=AS_MOD then
+                           if (actasmtoken=AS_MOD) or (actasmtoken=AS_AT) then
                              begin
-                               Consume(AS_MOD);
+                               Consume(actasmtoken);
                                if actasmtoken=AS_ID then
                                  begin
                                    case actasmpattern of

compiler/rgobj.pas

@@ -110,6 +110,8 @@ unit rgobj;
 {$ifdef llvm}
         def      : pointer;
 {$endif llvm}
+        count_uses : longint;
+        total_interferences : longint;
       end;
       Preginfo=^TReginfo;
 
@@ -710,10 +712,10 @@ unit rgobj;
         i,j:cardinal;
 
     begin
-      assign(f,'igraph'+tostr(loopidx));
+      assign(f,current_procinfo.procdef.mangledname+'_igraph'+tostr(loopidx));
       rewrite(f);
-      writeln(f,'Interference graph');
-      writeln(f,'First imaginary register is ',first_imaginary);
+      writeln(f,'Interference graph of ',current_procinfo.procdef.fullprocname(true));
+      writeln(f,'First imaginary register is ',first_imaginary,' ($',hexstr(first_imaginary,2),')');
       writeln(f);
       write(f,'                  ');
       for i:=0 to maxreg div 16 do
@@ -726,7 +728,7 @@ unit rgobj;
       writeln(f);
       for i:=0 to maxreg-1 do
         begin
-          write(f,reginfo[i].weight:5,'  ',reginfo[i].degree:5,'  ',hexstr(i,2):4);
+          write(f,reginfo[i].weight:5,'  ',reginfo[i].degree:5,'  ',reginfo[i].count_uses:5,'  ',reginfo[i].total_interferences:5,'  ',hexstr(i,2):4);
           for j:=0 to maxreg-1 do
             if ibitmap[i,j] then
               write(f,'*')
@@ -1456,20 +1458,80 @@ unit rgobj;
       freeze_moves(n);
     end;
 
+{ The spilling approach selected by SPILLING_NEW does not work well for AVR as it eploits apparently the problem of the current
+  reg. allocator with AVR. The current reg. allocator is not aware of the fact that r1-r15 and r16-r31 are not equal on AVR }
+{$if defined(AVR)}
+{$define SPILLING_OLD}
+{$else defined(AVR)}
+{ $define SPILLING_NEW}
+{$endif defined(AVR)}
+{$ifndef SPILLING_NEW}
+{$define SPILLING_OLD}
+{$endif SPILLING_NEW}
     procedure trgobj.select_spill;
     var
       n : tsuperregister;
       adj : psuperregisterworklist;
-      max,p,i:word;
+      maxlength,p,i :word;
       minweight: longint;
+      dist,
+      maxdist: Double;
     begin
+{$ifdef SPILLING_NEW}
+      { This new approach for selecting the next spill candidate takes care of the weight of a register:
+        It spills the register with the lowest weight but only if it is expected that it results in convergence of
+        register allocation. Convergence is expected if a register is spilled where the average of the active interferences
+        - active interference means that the register is used in an instruction - is lower than
+        the degree.
+
+        Example (modify means read and the write):
+
+        modify reg1
+
+        loop:
+          modify reg2
+          modify reg3
+          modify reg4
+          modify reg5
+          modify reg6
+          modify reg7
+
+        modify reg1
+
+        In this example, all register have the same degree. However, spilling reg1 is most benefical as it is used least. Furthermore,
+        spilling reg1 is a step toward solving the coloring problem as the registers used during spilling will have a lower degree
+        as no register are in use at the location where reg1 is spilled.
+      }
+      minweight:=high(longint);
+      p:=0;
+      with spillworklist do
+        begin
+          { Safe: This procedure is only called if length<>0 }
+          for i:=0 to length-1 do
+            begin
+              adj:=reginfo[buf^[i]].adjlist;
+              dist:=adj^.length-reginfo[buf^[i]].total_interferences/reginfo[buf^[i]].count_uses;
+              if assigned(adj) and
+                (reginfo[buf^[i]].weight<minweight) and
+                (dist>=1) and
+                (reginfo[buf^[i]].weight>0) then
+                begin
+                  p:=i;
+                  minweight:=reginfo[buf^[i]].weight;
+                end;
+            end;
+          n:=buf^[p];
+          deleteidx(p);
+        end;
+{$endif SPILLING_NEW}
+{$ifdef SPILLING_OLD}
       { We must look for the element with the most interferences in the
         spillworklist. This is required because those registers are creating
         the most conflicts and keeping them in a register will not reduce the
         complexity and even can cause the help registers for the spilling code
         to get too much conflicts with the result that the spilling code
         will never converge (PFV) }
-      max:=0;
+      maxlength:=0;
       minweight:=high(longint);
       p:=0;
       with spillworklist do
@@ -1480,19 +1542,19 @@ unit rgobj;
               adj:=reginfo[buf^[i]].adjlist;
               if assigned(adj) and
                  (
-                  (adj^.length>max) or
-                  ((adj^.length=max) and (reginfo[buf^[i]].weight<minweight))
+                  (adj^.length>maxlength) or
+                  ((adj^.length=maxlength) and (reginfo[buf^[i]].weight<minweight))
                  ) then
                 begin
                   p:=i;
-                  max:=adj^.length;
+                  maxlength:=adj^.length;
                   minweight:=reginfo[buf^[i]].weight;
                 end;
             end;
           n:=buf^[p];
           deleteidx(p);
         end;
-
+{$endif SPILLING_OLD}
       simplifyworklist.add(n);
       freeze_moves(n);
     end;
@@ -1767,12 +1829,20 @@ unit rgobj;
 
 
     procedure trgobj.generate_interference_graph(list:TAsmList;headertai:tai);
+
+      procedure RecordUse(var r : Treginfo);
+        begin
+          inc(r.total_interferences,live_registers.length);
+          inc(r.count_uses);
+        end;
+
       var
         p : tai;
-{$if defined(EXTDEBUG) or defined(DEBUG_REGISTERLIFE)}
         i : integer;
-{$endif defined(EXTDEBUG) or defined(DEBUG_REGISTERLIFE)}
-        supreg : tsuperregister;
+        supreg, u: tsuperregister;
+{$ifdef arm}
+        so: pshifterop;
+{$endif arm}
       begin
         { All allocations are available. Now we can generate the
           interference graph. Walk through all instructions, we can
@@ -1783,46 +1853,123 @@ unit rgobj;
         while assigned(p) do
           begin
             prefetch(pointer(p.next)^);
-            if p.typ=ait_regalloc then
-              with Tai_regalloc(p) do
-                begin
-                  if (getregtype(reg)=regtype) then
-                    begin
-                      supreg:=getsupreg(reg);
-                      case ratype of
-                        ra_alloc :
-                          begin
-                            live_registers.add(supreg);
+            case p.typ of
+              ait_instruction:
+                with Taicpu(p) do
+                  begin
+                    current_filepos:=fileinfo;
+                    {For speed reasons, get_alias isn't used here, instead,
+                     assign_colours will also set the colour of coalesced nodes.
+                     If there are registers with colour=0, then the coalescednodes
+                     list probably doesn't contain these registers, causing
+                     assign_colours not to do this properly.}
+                    for i:=0 to ops-1 do
+                      with oper[i]^ do
+                        case typ of
+                          top_reg:
+                             if (getregtype(reg)=regtype) then
+                               begin
+                                 u:=getsupreg(reg);
+{$ifdef EXTDEBUG}
+                                 if (u>=maxreginfo) then
+                                   internalerror(2018111701);
+{$endif}
+                                 RecordUse(reginfo[u]);
+                               end;
+                          top_ref:
+                            begin
+                              if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then
+                                with ref^ do
+                                  begin
+                                    if (base<>NR_NO) and
+                                       (getregtype(base)=regtype) then
+                                      begin
+                                        u:=getsupreg(base);
+{$ifdef EXTDEBUG}
+                                        if (u>=maxreginfo) then
+                                          internalerror(2018111702);
+{$endif}
+                                        RecordUse(reginfo[u]);
+                                      end;
+                                    if (index<>NR_NO) and
+                                       (getregtype(index)=regtype) then
+                                      begin
+                                        u:=getsupreg(index);
+{$ifdef EXTDEBUG}
+                                        if (u>=maxreginfo) then
+                                          internalerror(2018111703);
+{$endif}
+                                        RecordUse(reginfo[u]);
+                                      end;
+{$if defined(x86)}
+                                    if (segment<>NR_NO) and
+                                       (getregtype(segment)=regtype) then
+                                      begin
+                                        u:=getsupreg(segment);
+{$ifdef EXTDEBUG}
+                                        if (u>=maxreginfo) then
+                                          internalerror(2018111704);
+{$endif}
+                                        RecordUse(reginfo[u]);
+                                      end;
+{$endif defined(x86)}
+                                  end;
+                            end;
+{$ifdef arm}
+                          Top_shifterop:
+                            begin
+                              if regtype=R_INTREGISTER then
+                                begin
+                                  so:=shifterop;
+                                  if (so^.rs<>NR_NO) and
+                                     (getregtype(so^.rs)=regtype) then
+                                    RecordUse(reginfo[getsupreg(so^.rs)]);
+                                end;
+                            end;
+{$endif arm}
+                        end;
+                  end;
+              ait_regalloc:
+                with Tai_regalloc(p) do
+                  begin
+                    if (getregtype(reg)=regtype) then
+                      begin
+                        supreg:=getsupreg(reg);
+                        case ratype of
+                          ra_alloc :
+                            begin
+                              live_registers.add(supreg);
 {$ifdef DEBUG_REGISTERLIFE}
-                            write(live_registers.length,'  ');
-                            for i:=0 to live_registers.length-1 do
-                              write(std_regname(newreg(regtype,live_registers.buf^[i],defaultsub)),' ');
-                            writeln;
+                              write(live_registers.length,'  ');
+                              for i:=0 to live_registers.length-1 do
+                                write(std_regname(newreg(regtype,live_registers.buf^[i],defaultsub)),' ');
+                              writeln;
 {$endif DEBUG_REGISTERLIFE}
-                            add_edges_used(supreg);
-                          end;
-                        ra_dealloc :
-                          begin
-                            live_registers.delete(supreg);
+                              add_edges_used(supreg);
+                            end;
+                          ra_dealloc :
+                            begin
+                              live_registers.delete(supreg);
 {$ifdef DEBUG_REGISTERLIFE}
-                            write(live_registers.length,'  ');
-                            for i:=0 to live_registers.length-1 do
-                              write(std_regname(newreg(regtype,live_registers.buf^[i],defaultsub)),' ');
-                            writeln;
+                              write(live_registers.length,'  ');
+                              for i:=0 to live_registers.length-1 do
+                                write(std_regname(newreg(regtype,live_registers.buf^[i],defaultsub)),' ');
+                              writeln;
 {$endif DEBUG_REGISTERLIFE}
-                            add_edges_used(supreg);
-                          end;
-                        ra_markused :
-                          if (supreg<first_imaginary) then
-                            begin
-                              include(used_in_proc,supreg);
-                              has_usedmarks:=true;
+                              add_edges_used(supreg);
                             end;
+                          ra_markused :
+                            if (supreg<first_imaginary) then
+                              begin
+                                include(used_in_proc,supreg);
+                                has_usedmarks:=true;
+                              end;
+                        end;
+                        { constraints needs always to be updated }
+                        add_constraints(reg);
                       end;
-                      { constraints needs always to be updated }
-                      add_constraints(reg);
-                    end;
-                end;
+                  end;
+            end;
             add_cpu_interferences(p);
             p:=Tai(p.next);
           end;

compiler/symconst.pas

@@ -271,7 +271,7 @@ type
     s8bit,s16bit,s32bit,s64bit,s128bit,
     pasbool1,pasbool8,pasbool16,pasbool32,pasbool64,
     bool8bit,bool16bit,bool32bit,bool64bit,
-    uchar,uwidechar,scurrency
+    uchar,uwidechar,scurrency,customint
   );
 
   tordtypeset = set of tordtype;

compiler/symdef.pas

@@ -158,6 +158,7 @@ interface
           function  getmangledparaname:TSymStr;override;
           function  size:asizeint;override;
           procedure setsize;
+          function alignment: shortint; override;
        end;
        tfiledefclass = class of tfiledef;
 
@@ -956,6 +957,7 @@ interface
           procedure deref;override;
           function  GetTypeName:string;override;
           function  is_publishable : boolean;override;
+          function alignment: shortint; override;
        end;
        tsetdefclass = class of tsetdef;
 
@@ -1055,8 +1057,16 @@ interface
        s8inttype,                 { 8-Bit signed integer }
        u16inttype,                { 16-Bit unsigned integer }
        s16inttype,                { 16-Bit signed integer }
+       u24inttype,                { 24-Bit unsigned integer }
+       s24inttype,                { 24-Bit signed integer }
        u32inttype,                { 32-Bit unsigned integer }
        s32inttype,                { 32-Bit signed integer }
+       u40inttype,                { 40-Bit unsigned integer }
+       s40inttype,                { 40-Bit signed integer }
+       u48inttype,                { 48-Bit unsigned integer }
+       s48inttype,                { 48-Bit signed integer }
+       u56inttype,                { 56-Bit unsigned integer }
+       s56inttype,                { 56-Bit signed integer }
        u64inttype,                { 64-bit unsigned integer }
        s64inttype,                { 64-bit signed integer }
        u128inttype,               { 128-bit unsigned integer }
@@ -2887,10 +2897,12 @@ implementation
           1,2,4,8,16,
           1,1,2,4,8,
           1,2,4,8,
-          1,2,8
+          1,2,8,system.high(longint)
         );
       begin
         savesize:=sizetbl[ordtype];
+        if savesize=system.high(longint) then
+          savesize:=packedbitsize div 8;
       end;
 
 
@@ -2941,9 +2953,11 @@ implementation
           varshortint,varsmallint,varinteger,varint64,varUndefined,
           varboolean,varboolean,varboolean,varboolean,varboolean,
           varboolean,varboolean,varUndefined,varUndefined,
-          varUndefined,varUndefined,varCurrency);
+          varUndefined,varUndefined,varCurrency,varEmpty);
       begin
         result:=basetype2vardef[ordtype];
+        if result=varEmpty then
+          result:=basetype2vardef[range_to_basetype(low,high)];
       end;
 
 
@@ -2971,7 +2985,7 @@ implementation
           'ShortInt','SmallInt','LongInt','Int64','Int128',
           'Boolean','Boolean8','Boolean16','Boolean32','Boolean64',
           'ByteBool','WordBool','LongBool','QWordBool',
-          'Char','WideChar','Currency');
+          'Char','WideChar','Currency','CustomRange');
 
       begin
          GetTypeName:=names[ordtype];
@@ -3200,6 +3214,20 @@ implementation
       end;
 
 
+    function tfiledef.alignment: shortint;
+      begin
+        case filetyp of
+          ft_text:
+            result:=search_system_type('TEXTREC').typedef.alignment;
+          ft_typed,
+          ft_untyped:
+            result:=search_system_type('FILEREC').typedef.alignment;
+          else
+            internalerror(2018120101);
+          end;
+      end;
+
+
     procedure tfiledef.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwrite(ppufile);
@@ -3653,6 +3681,13 @@ implementation
          is_publishable:=savesize in [1,2,4];
       end;
 
+    function tsetdef.alignment: shortint;
+      begin
+        Result:=inherited;
+        if result>sizeof(aint) then
+          result:=sizeof(aint);
+      end;
+
 
     function tsetdef.GetTypeName : string;
       begin
@@ -6239,7 +6274,7 @@ implementation
              'a','s','i','x','',
              'b','b','b','b','b',
              'b','b','b','b',
-             'c','w','x');
+             'c','w','x','C');
 
            floattype2str : array[tfloattype] of string[1] = (
              'f','d','e','e',
@@ -6252,7 +6287,11 @@ implementation
         begin
            case p.typ of
               orddef:
-                s:=ordtype2str[torddef(p).ordtype];
+                begin
+                  s:=ordtype2str[torddef(p).ordtype];
+                  if s='C' then
+                    s:=ordtype2str[range_to_basetype(torddef(p).low,torddef(p).high)];
+                end;
               pointerdef:
                 s:='P'+getcppparaname(tpointerdef(p).pointeddef);
 {$ifndef NAMEMANGLING_GCC2}

compiler/symsym.pas

@@ -1753,7 +1753,7 @@ implementation
     constructor tfieldvarsym.ppuload(ppufile:tcompilerppufile);
       begin
          inherited ppuload(fieldvarsym,ppufile);
-         fieldoffset:=ppufile.getaint;
+         fieldoffset:=ppufile.getasizeint;
          if (vo_has_mangledname in varoptions) then
            externalname:=ppufile.getpshortstring
          else
@@ -1765,7 +1765,7 @@ implementation
     procedure tfieldvarsym.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwrite(ppufile);
-         ppufile.putaint(fieldoffset);
+         ppufile.putasizeint(fieldoffset);
          if (vo_has_mangledname in varoptions) then
            ppufile.putstring(externalname^);
          writeentry(ppufile,ibfieldvarsym);

compiler/systems/i_android.pas

@@ -151,7 +151,7 @@ unit i_android;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -220,7 +220,7 @@ unit i_android;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                  constalignmin   : 0;
-                 constalignmax   : 8;
+                 constalignmax   : 16;
                  varalignmin     : 0;
                  varalignmax     : 16;
                  localalignmin   : 4;
@@ -289,7 +289,7 @@ unit i_android;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                  constalignmin   : 0;
-                 constalignmax   : 8;
+                 constalignmax   : 16;
                  varalignmin     : 0;
                  varalignmax     : 16;
                  localalignmin   : 4;

compiler/systems/i_aros.pas

@@ -79,7 +79,7 @@ unit i_aros;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 0;
@@ -145,7 +145,7 @@ unit i_aros;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -210,7 +210,7 @@ unit i_aros;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 0;

compiler/systems/i_bsd.pas

@@ -180,7 +180,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -250,7 +250,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -317,7 +317,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -383,7 +383,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -453,7 +453,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -656,7 +656,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -856,7 +856,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 0;
@@ -924,11 +924,11 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 0;
-                localalignmax   : 8;
+                localalignmax   : 16;
                 recordalignmin  : 0;
                 recordalignmax  : 16;
                 maxCrecordalign : 16
@@ -1060,7 +1060,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -1127,7 +1127,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -1262,7 +1262,7 @@ unit i_bsd;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;

compiler/systems/i_embed.pas

@@ -287,7 +287,7 @@ unit i_embed;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -354,7 +354,7 @@ unit i_embed;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;

compiler/systems/i_linux.pas

@@ -79,13 +79,13 @@ unit i_linux;
             alignment    :
               (
                 procalign       : 16;
-                loopalign       : 4;
-                jumpalign       : 0;
-                jumpalignmax    : 0;
+                loopalign       : 8;
+                jumpalign       : 16;
+                jumpalignmax    : 10;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -426,7 +426,7 @@ unit i_linux;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -924,7 +924,7 @@ unit i_linux;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;

compiler/systems/i_sunos.pas

@@ -82,7 +82,7 @@ unit i_sunos;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;
@@ -154,7 +154,7 @@ unit i_sunos;
                 coalescealign   : 0;
                 coalescealignmax: 0;
                 constalignmin   : 0;
-                constalignmax   : 8;
+                constalignmax   : 16;
                 varalignmin     : 0;
                 varalignmax     : 16;
                 localalignmin   : 4;

compiler/utils/ppuutils/ppudump.pp

@@ -2788,7 +2788,7 @@ begin
            begin
              def:=TPpuFieldDef.Create(ParentDef);
              readabstractvarsym('Field Variable symbol ',varoptions,TPpuVarDef(def));
-             writeln([space,'      Address : ',getaint]);
+             writeln([space,'      Address : ',getasizeint]);
              if vo_has_mangledname in varoptions then
                writeln([space,' Mangled name : ',getstring]);
            end;
@@ -2937,7 +2937,7 @@ procedure readdefinitions(const s:string; ParentDef: TPpuContainerDef);
     u8bit,u16bit,u32bit,u64bit,u128bit,
     s8bit,s16bit,s32bit,s64bit,s128bit,
     bool8bit,bool16bit,bool32bit,bool64bit,
-    uchar,uwidechar,scurrency
+    uchar,uwidechar,scurrency,customint
   ); }
 
 { type tobjecttyp is in symconst unit }
@@ -3145,6 +3145,12 @@ begin
                    orddef.OrdType:=otCurrency;
                    orddef.Size:=8;
                  end;
+               customint:
+                 begin
+                   writeln('customint');
+                   orddef.OrdType:=otSint;
+                   orddef.Size:=sizeof(ASizeInt);
+                 end
                else
                  WriteWarning('Invalid base type: ' + IntToStr(b));
              end;

compiler/x86/aoptx86.pas

@@ -218,7 +218,9 @@ unit aoptx86;
           (r1.segment = r2.segment) and (r1.base = r2.base) and
           (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and
           (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and
-          (r1.relsymbol = r2.relsymbol);
+          (r1.relsymbol = r2.relsymbol) and
+          (r1.volatility=[]) and
+          (r2.volatility=[]);
       end;
 
 
@@ -232,7 +234,8 @@ unit aoptx86;
          ((base=NR_INVALID) or
           (ref.base=base)) and
          ((index=NR_INVALID) or
-          (ref.index=index));
+          (ref.index=index)) and
+         (ref.volatility=[]);
       end;
 
 
@@ -245,7 +248,8 @@ unit aoptx86;
          ((base=NR_INVALID) or
           (ref.base=base)) and
          ((index=NR_INVALID) or
-          (ref.index=index));
+          (ref.index=index)) and
+         (ref.volatility=[]);
       end;
 
 
@@ -1782,75 +1786,156 @@ unit aoptx86;
           (hp1.typ = ait_instruction) and
           GetNextInstruction(hp1, hp2) and
           MatchInstruction(hp2,A_MOV,[]) and
-          OpsEqual(taicpu(hp2).oper[1]^, taicpu(p).oper[0]^) and
-          (taicpu(hp2).oper[0]^.typ=top_reg) and
           (SuperRegistersEqual(taicpu(hp2).oper[0]^.reg,taicpu(p).oper[1]^.reg)) and
           (IsFoldableArithOp(taicpu(hp1), taicpu(p).oper[1]^.reg) or
            ((taicpu(p).opsize=S_L) and (taicpu(hp1).opsize=S_Q) and (taicpu(hp2).opsize=S_L) and
             IsFoldableArithOp(taicpu(hp1), newreg(R_INTREGISTER,getsupreg(taicpu(p).oper[1]^.reg),R_SUBQ)))
           ) then
-          { change   movsX/movzX    reg/ref, reg2
-                     add/sub/or/... reg3/$const, reg2
-                     mov            reg2 reg/ref
-            to       add/sub/or/... reg3/$const, reg/ref      }
           begin
-            CopyUsedRegs(TmpUsedRegs);
-            UpdateUsedRegs(TmpUsedRegs, tai(p.next));
-            UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
-            If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs)) then
+            if OpsEqual(taicpu(hp2).oper[1]^, taicpu(p).oper[0]^) and
+              (taicpu(hp2).oper[0]^.typ=top_reg) then
+              { change   movsX/movzX    reg/ref, reg2
+                         add/sub/or/... reg3/$const, reg2
+                         mov            reg2 reg/ref
+                         dealloc        reg2
+                to
+                         add/sub/or/... reg3/$const, reg/ref      }
               begin
-                { by example:
-                    movswl  %si,%eax        movswl  %si,%eax      p
-                    decl    %eax            addl    %edx,%eax     hp1
-                    movw    %ax,%si         movw    %ax,%si       hp2
-                  ->
-                    movswl  %si,%eax        movswl  %si,%eax      p
-                    decw    %eax            addw    %edx,%eax     hp1
-                    movw    %ax,%si         movw    %ax,%si       hp2
-                }
-                DebugMsg(SPeepholeOptimization + 'MovOpMov2Op ('+
-                      debug_op2str(taicpu(p).opcode)+debug_opsize2str(taicpu(p).opsize)+' '+
-                      debug_op2str(taicpu(hp1).opcode)+debug_opsize2str(taicpu(hp1).opsize)+' '+
-                      debug_op2str(taicpu(hp2).opcode)+debug_opsize2str(taicpu(hp2).opsize),p);
-                taicpu(hp1).changeopsize(taicpu(hp2).opsize);
-                {
-                  ->
-                    movswl  %si,%eax        movswl  %si,%eax      p
-                    decw    %si             addw    %dx,%si       hp1
-                    movw    %ax,%si         movw    %ax,%si       hp2
-                }
-                case taicpu(hp1).ops of
-                  1:
-                    begin
-                      taicpu(hp1).loadoper(0, taicpu(hp2).oper[1]^);
-                      if taicpu(hp1).oper[0]^.typ=top_reg then
-                        setsubreg(taicpu(hp1).oper[0]^.reg,getsubreg(taicpu(hp2).oper[0]^.reg));
+                CopyUsedRegs(TmpUsedRegs);
+                UpdateUsedRegs(TmpUsedRegs, tai(p.next));
+                UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
+                If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs)) then
+                  begin
+                    { by example:
+                        movswl  %si,%eax        movswl  %si,%eax      p
+                        decl    %eax            addl    %edx,%eax     hp1
+                        movw    %ax,%si         movw    %ax,%si       hp2
+                      ->
+                        movswl  %si,%eax        movswl  %si,%eax      p
+                        decw    %eax            addw    %edx,%eax     hp1
+                        movw    %ax,%si         movw    %ax,%si       hp2
+                    }
+                    DebugMsg(SPeepholeOptimization + 'MovOpMov2Op ('+
+                          debug_op2str(taicpu(p).opcode)+debug_opsize2str(taicpu(p).opsize)+' '+
+                          debug_op2str(taicpu(hp1).opcode)+debug_opsize2str(taicpu(hp1).opsize)+' '+
+                          debug_op2str(taicpu(hp2).opcode)+debug_opsize2str(taicpu(hp2).opsize),p);
+                    taicpu(hp1).changeopsize(taicpu(hp2).opsize);
+                    {
+                      ->
+                        movswl  %si,%eax        movswl  %si,%eax      p
+                        decw    %si             addw    %dx,%si       hp1
+                        movw    %ax,%si         movw    %ax,%si       hp2
+                    }
+                    case taicpu(hp1).ops of
+                      1:
+                        begin
+                          taicpu(hp1).loadoper(0, taicpu(hp2).oper[1]^);
+                          if taicpu(hp1).oper[0]^.typ=top_reg then
+                            setsubreg(taicpu(hp1).oper[0]^.reg,getsubreg(taicpu(hp2).oper[0]^.reg));
+                        end;
+                      2:
+                        begin
+                          taicpu(hp1).loadoper(1, taicpu(hp2).oper[1]^);
+                          if (taicpu(hp1).oper[0]^.typ=top_reg) and
+                            (taicpu(hp1).opcode<>A_SHL) and
+                            (taicpu(hp1).opcode<>A_SHR) and
+                            (taicpu(hp1).opcode<>A_SAR) then
+                            setsubreg(taicpu(hp1).oper[0]^.reg,getsubreg(taicpu(hp2).oper[0]^.reg));
+                        end;
+                      else
+                        internalerror(2008042701);
                     end;
-                  2:
-                    begin
-                      taicpu(hp1).loadoper(1, taicpu(hp2).oper[1]^);
-                      if (taicpu(hp1).oper[0]^.typ=top_reg) and
-                        (taicpu(hp1).opcode<>A_SHL) and
-                        (taicpu(hp1).opcode<>A_SHR) and
-                        (taicpu(hp1).opcode<>A_SAR) then
-                        setsubreg(taicpu(hp1).oper[0]^.reg,getsubreg(taicpu(hp2).oper[0]^.reg));
+                    {
+                      ->
+                        decw    %si             addw    %dx,%si       p
+                    }
+                    asml.remove(p);
+                    asml.remove(hp2);
+                    p.Free;
+                    hp2.Free;
+                    p := hp1;
+                  end;
+                ReleaseUsedRegs(TmpUsedRegs);
+              end
+{$ifndef x86_64}
+            else if MatchOpType(taicpu(hp2),top_reg,top_reg) and
+              not(SuperRegistersEqual(taicpu(hp1).oper[0]^.reg,taicpu(hp2).oper[1]^.reg))
+{$ifdef i386}
+              { byte registers of esi, edi, ebp, esp are not available on i386 }
+              and ((taicpu(hp2).opsize<>S_B) or not(getsupreg(taicpu(hp1).oper[0]^.reg) in [RS_ESI,RS_EDI,RS_EBP,RS_ESP]))
+              and ((taicpu(hp2).opsize<>S_B) or not(getsupreg(taicpu(p).oper[0]^.reg) in [RS_ESI,RS_EDI,RS_EBP,RS_ESP]))
+{$endif i386}
+              then
+              { change   movsX/movzX    reg/ref, reg2
+                         add/sub/or/... regX/$const, reg2
+                         mov            reg2, reg3
+                         dealloc        reg2
+                to
+                         movsX/movzX    reg/ref, reg3
+                         add/sub/or/... reg3/$const, reg3
+              }
+              begin
+                CopyUsedRegs(TmpUsedRegs);
+                UpdateUsedRegs(TmpUsedRegs, tai(p.next));
+                UpdateUsedRegs(TmpUsedRegs, tai(hp1.next));
+                If not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp2,TmpUsedRegs)) then
+                  begin
+                    { by example:
+                        movswl  %si,%eax        movswl  %si,%eax      p
+                        decl    %eax            addl    %edx,%eax     hp1
+                        movw    %ax,%si         movw    %ax,%si       hp2
+                      ->
+                        movswl  %si,%eax        movswl  %si,%eax      p
+                        decw    %eax            addw    %edx,%eax     hp1
+                        movw    %ax,%si         movw    %ax,%si       hp2
+                    }
+                    DebugMsg(SPeepholeOptimization + 'MovOpMov2MovOp ('+
+                          debug_op2str(taicpu(p).opcode)+debug_opsize2str(taicpu(p).opsize)+' '+
+                          debug_op2str(taicpu(hp1).opcode)+debug_opsize2str(taicpu(hp1).opsize)+' '+
+                          debug_op2str(taicpu(hp2).opcode)+debug_opsize2str(taicpu(hp2).opsize),p);
+                    taicpu(hp1).changeopsize(taicpu(hp2).opsize);
+                    taicpu(p).changeopsize(taicpu(hp2).opsize);
+                    if taicpu(p).oper[0]^.typ=top_reg then
+                      setsubreg(taicpu(p).oper[0]^.reg,getsubreg(taicpu(hp2).oper[0]^.reg));
+                    taicpu(p).loadoper(1, taicpu(hp2).oper[1]^);
+                    AllocRegBetween(taicpu(p).oper[1]^.reg,p,hp1,usedregs);
+                    {
+                      ->
+                        movswl  %si,%eax        movswl  %si,%eax      p
+                        decw    %si             addw    %dx,%si       hp1
+                        movw    %ax,%si         movw    %ax,%si       hp2
+                    }
+                    case taicpu(hp1).ops of
+                      1:
+                        begin
+                          taicpu(hp1).loadoper(0, taicpu(hp2).oper[1]^);
+                          if taicpu(hp1).oper[0]^.typ=top_reg then
+                            setsubreg(taicpu(hp1).oper[0]^.reg,getsubreg(taicpu(hp2).oper[0]^.reg));
+                        end;
+                      2:
+                        begin
+                          taicpu(hp1).loadoper(1, taicpu(hp2).oper[1]^);
+                          if (taicpu(hp1).oper[0]^.typ=top_reg) and
+                            (taicpu(hp1).opcode<>A_SHL) and
+                            (taicpu(hp1).opcode<>A_SHR) and
+                            (taicpu(hp1).opcode<>A_SAR) then
+                            setsubreg(taicpu(hp1).oper[0]^.reg,getsubreg(taicpu(hp2).oper[0]^.reg));
+                        end;
+                      else
+                        internalerror(2018111801);
                     end;
-                  else
-                    internalerror(2008042701);
-                end;
-                {
-                  ->
-                    decw    %si             addw    %dx,%si       p
-                }
-                asml.remove(p);
-                asml.remove(hp2);
-                p.Free;
-                hp2.Free;
-                p := hp1;
+                    {
+                      ->
+                        decw    %si             addw    %dx,%si       p
+                    }
+                    asml.remove(hp2);
+                    hp2.Free;
+//                    p := hp1;
+                  end;
+                ReleaseUsedRegs(TmpUsedRegs);
               end;
-            ReleaseUsedRegs(TmpUsedRegs);
+{$endif x86_64}
           end
-
         else if GetNextInstruction_p and
           MatchInstruction(hp1,A_BTS,A_BTR,[Taicpu(p).opsize]) and
           GetNextInstruction(hp1, hp2) and
@@ -1904,7 +1989,7 @@ unit aoptx86;
       end;
 
 
-    function TX86AsmOptimizer.OptPass1MOVXX(var p : tai) : boolean;
+   function TX86AsmOptimizer.OptPass1MOVXX(var p : tai) : boolean;
       var
         hp1 : tai;
       begin

compiler/x86/cgx86.pas

@@ -2080,6 +2080,14 @@ unit cgx86;
             reference_reset_base(href,src,al,ctempposinvalid,0,[]);
             list.concat(taicpu.op_ref_reg(A_LEA,TCgSize2OpSize[size],href,dst));
           end
+        else if (op=OP_SHL) and (size in [OS_32,OS_S32,OS_64,OS_S64]) and
+          (int64(a)>=1) and (int64(a)<=3) then
+          begin
+            reference_reset_base(href,NR_NO,0,ctempposinvalid,0,[]);
+            href.index:=src;
+            href.scalefactor:=1 shl longint(a);
+            list.concat(taicpu.op_ref_reg(A_LEA,TCgSize2OpSize[size],href,dst));
+          end
         else if (op=OP_SUB) and
           ((size in [OS_32,OS_S32]) or
            { lea supports only 32 bit signed displacments }

compiler/x86_64/nx64flw.pas

@@ -216,8 +216,6 @@ function tx64tryfinallynode.simplify(forinline: boolean): tnode;
         if implicitframe then
           begin
             current_procinfo.finalize_procinfo:=finalizepi;
-            { don't leave dangling pointer }
-            tcgprocinfo(current_procinfo).final_asmnode:=nil;
           end;
       end;
   end;

installer/Makefile.fpc

@@ -19,10 +19,9 @@ files_linux=installer.pas
 files_freebsd=installer.pas
 
 [require]
-packages=rtl-console fv unzip rtl-extra
+packages=rtl-console fv unzip rtl-extra ide
 
 [compiler]
-unitdir=../ide
 
 [install]
 fpcpackage=y

packages/fcl-base/fpmake.pp

@@ -78,12 +78,14 @@ begin
           AddUnit('inifiles');
         end;
     T:=P.Targets.AddUnit('inifiles.pp');
+      T.ResourceStrings:=true;
       with T.Dependencies do
         begin
           AddUnit('contnrs');
         end;
     T:=P.Targets.AddUnit('iostream.pp');
     T:=P.Targets.AddUnit('nullstream.pp');
+      T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('maskutils.pp');
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('pooledmm.pp');
@@ -96,11 +98,13 @@ begin
     T:=P.Targets.AddUnit('streamcoll.pp');
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('streamex.pp');
+      T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('streamio.pp');
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('fptemplate.pp');
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('syncobjs.pp',AllOSes-[go32v2,nativent,atari]);
+      T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('uriparser.pp');
     T:=P.Targets.AddUnit('wformat.pp');
     T:=P.Targets.AddUnit('whtml.pp');
@@ -117,6 +121,7 @@ begin
       T.ResourceStrings:=true;
 
     T:=P.Targets.AddUnit('fileinfo.pp');
+      T.ResourceStrings:=true;
     T:=P.Targets.addUnit('fpmimetypes.pp');
     T:=P.Targets.AddUnit('csvreadwrite.pp');
     T:=P.Targets.addUnit('csvdocument.pp');

packages/fcl-db/fpmake.pp

@@ -749,6 +749,7 @@ begin
           AddUnit('bufdataset');
         end;
     T:=P.Targets.AddUnit('pqeventmonitor.pp', SqldbConnectionOSes);
+      T.ResourceStrings:=true;
       with T.Dependencies do
         begin
           AddUnit('sqldb');
@@ -780,6 +781,7 @@ begin
           AddUnit('sqltypes');
         end;
     T:=P.Targets.AddUnit('sqldblib.pp');
+      T.ResourceStrings:=true;
       with T.Dependencies do
         begin
           AddUnit('sqldb');

packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp

@@ -47,6 +47,8 @@ uses
 type
   TEventAlert = procedure(Sender: TObject; EventName: string; EventCount: longint;
     var CancelAlerts: boolean) of object;
+  TEventAlertPayload = procedure(Sender: TObject; EventName, PayLoad: string; EventCount: longint;
+    var CancelAlerts: boolean) of object;
   TErrorEvent = procedure(Sender: TObject; ErrorCode: integer) of object;
 
 { TPQEventMonitor }
@@ -59,6 +61,7 @@ type
     FEvents: TStrings;
     FOnError: TErrorEvent;
     FOnEventAlert: TEventAlert;
+    FOnEventAlertPayLoad: TEventAlertPayload;
     FRegistered: Boolean;
     function GetNativeHandle: pointer;
     procedure SetConnection(AValue: TPQConnection);
@@ -77,6 +80,7 @@ type
     property Events: TStrings read FEvents write SetEvents;
     property Registered: Boolean read FRegistered write SetRegistered;
     property OnEventAlert: TEventAlert read FOnEventAlert write FOnEventAlert;
+    property OnEventAlertPayload: TEventAlertPayload read FOnEventAlertPayload write FOnEventAlertPayload;
     property OnError: TErrorEvent read FOnError write FOnError;
   end;
 
@@ -165,6 +169,8 @@ begin
         begin
         if assigned(OnEventAlert) then
           OnEventAlert(Self,notify^.relname,1,CancelAlerts);
+        if assigned(OnEventAlertPayLoad) then
+          OnEventAlertPayLoad(Self,notify^.relname,Notify^.Extra,1,CancelAlerts);
         PQfreemem(notify);
         end;
     until not assigned(notify) or CancelAlerts;

packages/fcl-image/fpmake.pp

@@ -227,6 +227,7 @@ begin
     T:=P.Targets.AddUnit('freetypeh.pp',[solaris,iphonesim,darwin,freebsd,openbsd,netbsd,linux,haiku,beos,win32,win64,aix,dragonfly]);
     T.Dependencies.AddInclude('libfreetype.inc');
     T:=P.Targets.AddUnit('freetypehdyn.pp',[solaris,iphonesim,darwin,freebsd,openbsd,netbsd,linux,haiku,beos,win32,win64,aix,dragonfly]);
+      T.ResourceStrings:=true;
     T.Dependencies.AddInclude('libfreetype.inc');
     T:=P.Targets.AddUnit('freetype.pp',[solaris,iphonesim,darwin,freebsd,openbsd,netbsd,linux,haiku,beos,win32,win64,aix,dragonfly]);
       with T.Dependencies do

packages/fcl-js/src/jswriter.pp

@@ -109,7 +109,7 @@ Type
   private
     FBufPos,
     FCapacity: Cardinal;
-    FBuffer : TBuffer;
+    FBuffer: TBuffer;
     function GetAsString: TJSWriterString;
     {$ifdef fpc}
     function GetBuffer: Pointer;
@@ -119,6 +119,7 @@ Type
     {$ifdef FPC_HAS_CPSTRING}
     function GetUnicodeString: UnicodeString;
     {$endif}
+    procedure SetAsString(const AValue: TJSWriterString);
     procedure SetCapacity(AValue: Cardinal);
   Protected
     Function DoWrite(Const S : TJSWriterString) : integer; override;
@@ -136,7 +137,7 @@ Type
     {$endif}
     Property BufferLength : Integer Read GetBufferLength;
     Property Capacity : Cardinal Read GetCapacity Write SetCapacity;
-    Property AsString : TJSWriterString Read GetAsString;
+    Property AsString : TJSWriterString Read GetAsString Write SetAsString;
     {$ifdef FPC_HAS_CPSTRING}
     Property AsAnsiString : AnsiString Read GetAsString; deprecated 'use AsString instead, fpc 3.3.1';
     Property AsUnicodeString : UnicodeString Read GetUnicodeString;
@@ -320,6 +321,16 @@ begin
 end;
 {$endif}
 
+procedure TBufferWriter.SetAsString(const AValue: TJSWriterString);
+begin
+  {$ifdef pas2js}
+  SetLength(FBuffer,0);
+  FCapacity:=0;
+  {$endif}
+  FBufPos:=0;
+  DoWrite(AValue);
+end;
+
 procedure TBufferWriter.SetCapacity(AValue: Cardinal);
 begin
   if FCapacity=AValue then Exit;
@@ -328,7 +339,7 @@ begin
     FBufPos:=Capacity;
 end;
 
-Function TBufferWriter.DoWrite(Const S: TJSWriterString): integer;
+function TBufferWriter.DoWrite(const S: TJSWriterString): integer;
 {$ifdef pas2js}
 begin
   Result:=Length(S)*2;
@@ -358,7 +369,7 @@ end;
 {$endif}
 
 {$ifdef FPC_HAS_CPSTRING}
-Function TBufferWriter.DoWrite(Const S: UnicodeString): integer;
+function TBufferWriter.DoWrite(const S: UnicodeString): integer;
 
 Var
   DesLen,MinLen : Integer;
@@ -379,14 +390,14 @@ begin
 end;
 {$endif}
 
-Constructor TBufferWriter.Create(Const ACapacity: Cardinal);
+constructor TBufferWriter.Create(const ACapacity: Cardinal);
 begin
   inherited Create;
   Capacity:=ACapacity;
 end;
 
 {$ifdef fpc}
-Procedure TBufferWriter.SaveToFile(Const AFileName: String);
+procedure TBufferWriter.SaveToFile(const AFileName: String);
 Var
   F : File;
 

packages/fcl-net/src/netdb.pp

@@ -478,6 +478,17 @@ var
   s: string;
   H : THostAddr;
 begin
+  if SystemApiLevel >= 26 then
+    begin
+      // Since Android 8 the net.dnsX properties can't be read.
+      // Use Google Public DNS servers
+      Result:=2;
+      SetLength(DNSServers, Result);
+      DNSServers[0]:=StrToNetAddr('8.8.8.8');
+      DNSServers[1]:=StrToNetAddr('8.8.4.4');
+      exit;
+    end;
+
   Result:=0;
   SetLength(DNSServers, 9);
   for i:=1 to 9 do
@@ -504,6 +515,13 @@ var
 begin
   if not CheckResolveFileAge then
     exit;
+
+  if (Length(DNSServers) = 0) and (SystemApiLevel >= 26) then
+    begin
+      GetDNSServers;
+      exit;
+    end;
+
   n:=GetSystemProperty('net.change');
   if n <> '' then
     v:=GetSystemProperty(PAnsiChar(n))

packages/fcl-passrc/fpmake.pp

@@ -36,6 +36,7 @@ begin
     T:=P.Targets.AddUnit('pscanner.pp');
     T.ResourceStrings := True;
     T:=P.Targets.AddUnit('pparser.pp');
+      T.ResourceStrings:=true;
       with T.Dependencies do
         begin
           AddUnit('pastree');

packages/fcl-passrc/src/pasresolveeval.pas

@@ -4081,9 +4081,9 @@ begin
           begin
           c:=S[p];
           case c of
-          '0'..'9': u:=u*16+ord(c)-ord('0');
-          'a'..'f': u:=u*16+ord(c)-ord('a')+10;
-          'A'..'F': u:=u*16+ord(c)-ord('A')+10;
+          '0'..'9': u:=u*16+longword(ord(c)-ord('0'));
+          'a'..'f': u:=u*16+longword(ord(c)-ord('a'))+10;
+          'A'..'F': u:=u*16+longword(ord(c)-ord('A'))+10;
           else break;
           end;
           if u>$10FFFF then
@@ -4111,7 +4111,7 @@ begin
           begin
           c:=S[p];
           case c of
-          '0'..'9': u:=u*10+ord(c)-ord('0');
+          '0'..'9': u:=u*10+longword(ord(c)-ord('0'));
           else break;
           end;
           if u>$ffff then

packages/fcl-passrc/src/pasresolver.pp

@@ -285,7 +285,10 @@ interface
 
 uses
   {$ifdef pas2js}
-  js, NodeJSFS,
+  js,
+  {$IFDEF NODEJS}
+  NodeJSFS,
+  {$ENDIF}
   {$endif}
   Classes, SysUtils, Math, Types, contnrs,
   PasTree, PScanner, PParser, PasResolveEval;
@@ -1801,7 +1804,9 @@ type
       PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
     function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
     // utility functions
+    function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean;
     function GetElModeSwitches(El: TPasElement): TModeSwitches;
+    function ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch): boolean;
     function GetElBoolSwitches(El: TPasElement): TBoolSwitches;
     function GetProcTypeDescription(ProcType: TPasProcedureType;
       Flags: TPRProcTypeDescFlags = [prptdUseName,prptdResolveSimpleAlias]): string;
@@ -1819,6 +1824,7 @@ type
     function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
     function GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
     function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
+    function GetParentProcBody(El: TPasElement): TProcedureBody;
     function ProcHasImplElements(Proc: TPasProcedure): boolean; virtual;
     function IndexOfImplementedInterface(ClassEl: TPasClassType; aType: TPasType): integer;
     function GetLoop(El: TPasElement): TPasImplElement;
@@ -2067,8 +2073,8 @@ begin
       dec(Indent,2);
       end;
     Result:=Result+')';
-    if El is TPasFunction then
-      Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasFunction(El).ProcType).ResultEl,Indent);
+    if (El is TPasProcedure) and (TPasProcedure(El).ProcType is TPasFunctionType) then
+      Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasProcedure(El).ProcType).ResultEl,Indent);
     if TPasProcedureType(El).IsOfObject then
       Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
     if TPasProcedureType(El).IsNested then
@@ -2268,6 +2274,10 @@ begin
     Result:='class procedure'
   else if C=TPasClassFunction then
     Result:='class function'
+  else if C=TPasAnonymousProcedure then
+    Result:='anonymous procedure'
+  else if C=TPasAnonymousFunction then
+    Result:='anonymous function'
   else if C=TPasMethodResolution then
     Result:='method resolution'
   else if C=TInterfaceSection then
@@ -5305,13 +5315,17 @@ var
   pm: TProcedureModifier;
   ptm: TProcTypeModifier;
   ObjKind: TPasObjKind;
+  ParentBody: TProcedureBody;
 begin
-  if (El.Parent is TPasProcedure) and (TPasProcedure(El.Parent).ProcType=El) then
+  if El.Parent is TPasProcedure then
+    Proc:=TPasProcedure(El.Parent)
+  else
+    Proc:=nil;
+  if (Proc<>nil) and (Proc.ProcType=El) then
     begin
     // finished header of a procedure declaration
     // -> search the best fitting proc
     CheckTopScope(FScopeClass_Proc);
-    Proc:=TPasProcedure(El.Parent);
     {$IFDEF VerbosePasResolver}
     writeln('TPasResolver.FinishProcedureHeader El=',GetTreeDbg(El),' ',GetElementSourcePosStr(El),' IsForward=',Proc.IsForward,' Parent=',GetObjName(El.Parent));
     {$ENDIF}
@@ -5320,13 +5334,14 @@ begin
     if (proProcTypeWithoutIsNested in Options) and El.IsNested then
       RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
 
-    if (Proc.Parent.ClassType=TProcedureBody) then
+    ParentBody:=GetParentProcBody(Proc.Parent);
+    if (ParentBody<>nil) then
       begin
       // nested sub proc
       if not (proProcTypeWithoutIsNested in Options) then
         El.IsNested:=true;
       // inherit 'of Object'
-      ParentProc:=Proc.Parent.Parent as TPasProcedure;
+      ParentProc:=ParentBody.Parent as TPasProcedure;
       if ParentProc.ProcType.IsOfObject then
         El.IsOfObject:=true;
       end;
@@ -5388,7 +5403,7 @@ begin
       end
     else
       begin
-      // intf proc, forward proc, proc body, method body
+      // intf proc, forward proc, proc body, method body, anonymous proc
       if Proc.IsAbstract then
         RaiseInvalidProcModifier(20170216151634,Proc,pmAbstract,Proc);
       if Proc.IsVirtual then
@@ -5400,8 +5415,12 @@ begin
       if Proc.IsStatic then
         RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
       if (not HasDots)
-          and (Proc.ClassType<>TPasProcedure)
-          and (Proc.ClassType<>TPasFunction) then
+          and (Proc.GetProcTypeEnum in [
+               ptClassOperator,
+               ptConstructor, ptDestructor,
+               ptClassProcedure, ptClassFunction,
+               ptClassConstructor, ptClassDestructor
+               ]) then
         RaiseXExpectedButYFound(20170419232724,'full method name','short name',El);
       end;
 
@@ -5413,7 +5432,8 @@ begin
 
     // finish interface/implementation/nested procedure/method declaration
 
-    if not IsValidIdent(ProcName) then
+    if not (Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction])
+        and not IsValidIdent(ProcName) then
       RaiseNotYetImplemented(20160922163407,El);
 
     if El is TPasFunctionType then
@@ -5431,7 +5451,7 @@ begin
       end;
 
     // finish interface/implementation/nested procedure
-    if ProcNeedsBody(Proc) then
+    if (ProcName<>'') and ProcNeedsBody(Proc) then
       begin
       // check if there is a forward declaration
       ParentScope:=Scopes[ScopeCount-2];
@@ -5478,13 +5498,16 @@ begin
       StoreScannerFlagsInProc(ProcScope);
       end;
 
-    // check for invalid overloads
-    FindData:=Default(TFindOverloadProcData);
-    FindData.Proc:=Proc;
-    FindData.Args:=Proc.ProcType.Args;
-    FindData.Kind:=fopkProc;
-    Abort:=false;
-    IterateElements(ProcName,@OnFindOverloadProc,@FindData,Abort);
+    if ProcName<>'' then
+      begin
+      // check for invalid overloads
+      FindData:=Default(TFindOverloadProcData);
+      FindData.Proc:=Proc;
+      FindData.Args:=Proc.ProcType.Args;
+      FindData.Kind:=fopkProc;
+      Abort:=false;
+      IterateElements(ProcName,@OnFindOverloadProc,@FindData,Abort);
+      end;
     end
   else if El.Name<>'' then
     begin
@@ -6831,12 +6854,12 @@ begin
     else
       RaiseNotYetImplemented(20170203161826,ImplProc);
     end;
-  if DeclProc is TPasFunction then
+  if DeclProc.ProcType is TPasFunctionType then
     begin
     // redirect implementation 'Result' to declaration FuncType.ResultEl
     Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
     if Identifier.Element is TPasResultElement then
-      Identifier.Element:=TPasFunction(DeclProc).FuncType.ResultEl;
+      Identifier.Element:=TPasFunctionType(DeclProc.ProcType).ResultEl;
     end;
 end;
 
@@ -6894,11 +6917,11 @@ begin
     RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
   if ImplProc.CallingConvention<>DeclProc.CallingConvention then
     RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
-  if ImplProc is TPasFunction then
+  if ImplProc.ProcType is TPasFunctionType then
     begin
     // check result type
-    ImplResult:=TPasFunction(ImplProc).FuncType.ResultEl.ResultType;
-    DeclResult:=TPasFunction(DeclProc).FuncType.ResultEl.ResultType;
+    ImplResult:=TPasFunctionType(ImplProc.ProcType).ResultEl.ResultType;
+    DeclResult:=TPasFunctionType(DeclProc.ProcType).ResultEl.ResultType;
 
     if not CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple) then
       RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
@@ -7822,6 +7845,7 @@ begin
         [],El);
     ResolveRecordValues(TRecordValues(El));
     end
+  else if ElClass=TProcedureExpr then
   else
     RaiseNotYetImplemented(20170222184329,El);
 
@@ -7877,7 +7901,7 @@ begin
       begin
       // examples: funca or @proca or a.funca or @a.funca ...
       Proc:=TPasProcedure(DeclEl);
-      if (Access=rraAssign) and (Proc is TPasFunction)
+      if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
           and (El.ClassType=TPrimitiveExpr)
           and (El.Parent.ClassType=TPasImplAssign)
           and (TPasImplAssign(El.Parent).left=El) then
@@ -7890,7 +7914,7 @@ begin
         if El.HasParent(ImplProc) then
           begin
           // "FuncA:=" within FuncA  -> redirect to ResultEl
-          Ref.Declaration:=(Proc as TPasFunction).FuncType.ResultEl;
+          Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
           exit;
           end;
         end;
@@ -8112,7 +8136,7 @@ begin
     begin
     LTypeEl:=LeftResolved.LoTypeEl;
     if (LTypeEl.ClassType=TPasPointerType)
-        and (msAutoDeref in GetElModeSwitches(El))
+        and ElHasModeSwitch(El,msAutoDeref)
         and (rrfReadable in LeftResolved.Flags)
         then
       begin
@@ -8494,7 +8518,7 @@ var
     if DeclEl is TPasProcedure then
       begin
       Proc:=TPasProcedure(DeclEl);
-      if (Access=rraAssign) and (Proc is TPasFunction)
+      if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
           and (Value.ClassType=TPrimitiveExpr)
           and (Params.Parent.ClassType=TPasImplAssign)
           and (TPasImplAssign(Params.Parent).left=Params) then
@@ -8507,7 +8531,7 @@ var
         if Params.HasParent(ImplProc) then
           begin
           // "FuncA[]:=" within FuncA -> redirect to ResultEl
-          Ref.Declaration:=(Proc as TPasFunction).FuncType.ResultEl;
+          Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
           end;
         end;
       end;
@@ -8567,7 +8591,7 @@ procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
     if not IsStringIndex then
       begin
       // pointer
-      if not (bsPointerMath in GetElBoolSwitches(Params)) then
+      if not ElHasBoolSwitch(Params,bsPointerMath) then
         exit(false);
       end;
     Result:=true;
@@ -8925,7 +8949,8 @@ begin
   else if (Access in [rraRead,rraParamToUnknownProc])
       and ((C=TPrimitiveExpr)
         or (C=TNilExpr)
-        or (C=TBoolConstExpr)) then
+        or (C=TBoolConstExpr)
+        or (C=TProcedureExpr)) then
     // ok
   else if C=TUnaryExpr then
     AccessExpr(TUnaryExpr(Expr).Operand,Access)
@@ -9345,10 +9370,10 @@ begin
   {$ENDIF}
   if not (TopScope is TPasIdentifierScope) then
     RaiseInvalidScopeForElement(20160922163522,El);
-  // Note: El.ProcType is nil !
+  // Note: El.ProcType is nil !  It is parsed later.
   ProcName:=El.Name;
   HasDot:=Pos('.',ProcName)>1;
-  if not HasDot then
+  if (not HasDot) and (ProcName<>'') then
     AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
   ProcScope:=TPasProcedureScope(PushScope(El,FScopeClass_Proc));
   ProcScope.ModeSwitches:=CurrentParser.CurrentModeswitches;
@@ -9415,7 +9440,7 @@ begin
 
     ProcScope.VisibilityContext:=CurClassType;
     ProcScope.ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
-    end;
+    end;// HasDot=true
 end;
 
 procedure TPasResolver.AddArgument(El: TPasArgument);
@@ -9624,7 +9649,7 @@ begin
         else if RightResolved.BaseType=btPointer then
           begin
           if (Bin.OpCode in [eopAdd,eopSubtract])
-              and (bsPointerMath in GetElBoolSwitches(Bin)) then
+              and ElHasBoolSwitch(Bin,bsPointerMath) then
             begin
             // integer+CanonicalPointer
             SetResolverValueExpr(ResolvedEl,btPointer,
@@ -9638,7 +9663,7 @@ begin
           if RightTypeEl.ClassType=TPasPointerType then
             begin
             if (Bin.OpCode in [eopAdd,eopSubtract])
-                and (bsPointerMath in GetElBoolSwitches(Bin)) then
+                and ElHasBoolSwitch(Bin,bsPointerMath) then
               begin
               // integer+TypedPointer
               RightTypeEl:=TPasPointerType(RightTypeEl).DestType;
@@ -9837,7 +9862,7 @@ begin
       if (RightResolved.BaseType in btAllInteger) then
         case Bin.OpCode of
         eopAdd,eopSubtract:
-          if bsPointerMath in GetElBoolSwitches(Bin) then
+          if ElHasBoolSwitch(Bin,bsPointerMath) then
             begin
             // pointer+integer -> pointer
             SetResolverValueExpr(ResolvedEl,btPointer,
@@ -10118,7 +10143,7 @@ begin
           begin
           if IsDynArray(LeftTypeEl)
               and (Bin.OpCode=eopAdd)
-              and (msArrayOperators in GetElModeSwitches(Bin))
+              and ElHasModeSwitch(Bin,msArrayOperators)
               and ((RightResolved.BaseType in [btArrayOrSet,btArrayLit])
                 or IsDynArray(RightResolved.LoTypeEl)) then
             begin
@@ -10131,7 +10156,7 @@ begin
         else if LeftTypeEl.ClassType=TPasPointerType then
           begin
           if (RightResolved.BaseType in btAllInteger)
-              and (bsPointerMath in GetElBoolSwitches(Bin)) then
+              and ElHasBoolSwitch(Bin,bsPointerMath) then
             begin
             // TypedPointer+Integer
             SetLeftValueExpr([rrfReadable]);
@@ -10226,7 +10251,7 @@ begin
     if (rrfReadable in LeftResolved.Flags)
         and (rrfReadable in RightResolved.Flags)
         and (Bin.OpCode=eopAdd)
-        and (msArrayOperators in GetElModeSwitches(Bin)) then
+        and ElHasModeSwitch(Bin,msArrayOperators) then
       begin
       if RightResolved.BaseType=btArrayLit then
         begin
@@ -10495,9 +10520,9 @@ begin
         Proc:=TPasProcedure(ResolvedEl.IdentEl);
         if rcConstant in Flags then
           RaiseConstantExprExp(20170216152637,Params);
-        if Proc is TPasFunction then
+        if Proc.ProcType is TPasFunctionType then
           // function call => return result
-          ComputeElement(TPasFunction(Proc).FuncType.ResultEl,ResolvedEl,
+          ComputeElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
             Flags+[rcNoImplicitProc],StartEl)
         else if (Proc.ClassType=TPasConstructor)
             and (rrfNewInstance in Ref.Flags) then
@@ -12493,6 +12518,7 @@ var
   ProcScope: TPasProcedureScope;
   ResultEl: TPasResultElement;
   Flags: TPasResolverComputeFlags;
+  CtxProc: TPasProcedure;
 begin
   if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
     exit(cExact);
@@ -12510,14 +12536,15 @@ begin
     begin
     // first param is function result
     ProcScope:=TPasProcedureScope(Scopes[i]);
-    if not (ProcScope.Element is TPasFunction) then
+    CtxProc:=TPasProcedure(ProcScope.Element);
+    if not (CtxProc.ProcType is TPasFunctionType) then
       begin
       if RaiseOnError then
         RaiseMsg(20170216152312,nWrongNumberOfParametersForCallTo,
           sWrongNumberOfParametersForCallTo,['procedure exit'],Params.Params[0]);
       exit(cIncompatible);
       end;
-    ResultEl:=(ProcScope.Element as TPasFunction).FuncType.ResultEl;
+    ResultEl:=TPasFunctionType(CtxProc.ProcType).ResultEl;
     ComputeElement(ResultEl,ResultResolved,[rcType]);
     end
   else
@@ -12581,14 +12608,14 @@ begin
     Result:=cExact
   else if ParamResolved.BaseType=btPointer then
     begin
-    if bsPointerMath in GetElBoolSwitches(Expr) then
+    if ElHasBoolSwitch(Expr,bsPointerMath) then
       Result:=cExact;
     end
   else if ParamResolved.BaseType=btContext then
     begin
     TypeEl:=ParamResolved.LoTypeEl;
     if (TypeEl.ClassType=TPasPointerType)
-        and (bsPointerMath in GetElBoolSwitches(Expr)) then
+        and ElHasBoolSwitch(Expr,bsPointerMath) then
       Result:=cExact;
     end;
   if Result=cIncompatible then
@@ -12932,9 +12959,9 @@ begin
           begin
           Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
           if Expr is TArrayValues then
-            Evaluated:=TResEvalInt.CreateValue(length(TArrayValues(Expr).Values)-1)
+            Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TArrayValues(Expr).Values))-1)
           else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
-            Evaluated:=TResEvalInt.CreateValue(length(TParamsExpr(Expr).Params)-1);
+            Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TParamsExpr(Expr).Params))-1);
           if Evaluated=nil then
             RaiseXExpectedButYFound(20170601191003,'array constant','expression',Params);
           end
@@ -13630,8 +13657,9 @@ begin
       aType:=TPasArgument(Decl).ArgType
     else if Decl.ClassType=TPasResultElement then
       aType:=TPasResultElement(Decl).ResultType
-    else if Decl is TPasFunction then
-      aType:=TPasFunction(Decl).FuncType.ResultEl.ResultType;
+    else if (Decl is TPasProcedure)
+        and (TPasProcedure(Decl).ProcType is TPasFunctionType) then
+      aType:=TPasFunctionType(TPasProcedure(Decl).ProcType).ResultEl.ResultType;
     {$IFDEF VerbosePasResolver}
     {AllowWriteln}
     if aType=nil then
@@ -16441,7 +16469,7 @@ begin
         begin
         EnumType:=TPasEnumType(LTypeEl);
         LRangeValue:=TResEvalRangeInt.CreateValue(revskEnum,EnumType,
-          0,EnumType.Values.Count-1);
+          0,TMaxPrecInt(EnumType.Values.Count)-1);
         end
       else if C=TPasUnresolvedSymbolRef then
         begin
@@ -17042,7 +17070,15 @@ begin
         if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
             TPasProcedure(RHS.IdentEl).ProcType,true,ErrorEl,RaiseOnIncompatible) then
           exit(cExact);
-        end;
+        end
+      else if (LHS.LoTypeEl is TPasProcedureType)
+          and (RHS.ExprEl is TProcedureExpr) then
+        begin
+        // for example  ProcVar:=anonymous-procedure...
+        if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
+            TProcedureExpr(RHS.ExprEl).Proc.ProcType,true,ErrorEl,RaiseOnIncompatible) then
+          exit(cExact);
+        end
       end
     else if LBT=btPointer then
       begin
@@ -17675,6 +17711,12 @@ begin
     exit(true);
 end;
 
+function TPasResolver.ElHasModeSwitch(El: TPasElement; ms: TModeSwitch
+  ): boolean;
+begin
+  Result:=ms in GetElModeSwitches(El);
+end;
+
 function TPasResolver.GetElModeSwitches(El: TPasElement): TModeSwitches;
 var
   C: TClass;
@@ -17694,6 +17736,12 @@ begin
   Result:=CurrentParser.CurrentModeswitches;
 end;
 
+function TPasResolver.ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch
+  ): boolean;
+begin
+  Result:=bs in GetElBoolSwitches(El);
+end;
+
 function TPasResolver.GetElBoolSwitches(El: TPasElement): TBoolSwitches;
 var
   C: TClass;
@@ -19829,7 +19877,7 @@ begin
     begin
     TypeEl:=TPasProcedure(El).ProcType;
     SetResolverIdentifier(ResolvedEl,btProc,El,TypeEl,TypeEl,[rrfCanBeStatement]);
-    if El is TPasFunction then
+    if TPasProcedure(El).ProcType is TPasFunctionType then
       Include(ResolvedEl.Flags,rrfReadable);
     // Note: the readability of TPasConstructor depends on the context
     // Note: implicit calls are handled in TPrimitiveExpr
@@ -19840,6 +19888,11 @@ begin
                TPasProcedureType(El),TPasProcedureType(El),[rrfCanBeStatement]);
     // Note: implicit calls are handled in TPrimitiveExpr
     end
+  else if ElClass=TProcedureExpr then
+    begin
+    TypeEl:=TProcedureExpr(El).Proc.ProcType;
+    SetResolverValueExpr(ResolvedEl,btProc,TypeEl,TypeEl,TProcedureExpr(El),[rrfReadable]);
+    end
   else if ElClass=TPasArrayType then
     SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),TPasArrayType(El),[])
   else if ElClass=TArrayValues then
@@ -19984,6 +20037,17 @@ begin
     end;
 end;
 
+function TPasResolver.GetParentProcBody(El: TPasElement): TProcedureBody;
+begin
+  while El<>nil do
+    begin
+    if El is TProcedureBody then
+      exit(TProcedureBody(El));
+    El:=El.Parent;
+    end;
+  Result:=nil;
+end;
+
 function TPasResolver.ProcHasImplElements(Proc: TPasProcedure): boolean;
 begin
   Result:=GetProcFirstImplEl(Proc)<>nil;
@@ -20280,7 +20344,7 @@ end;
 function TPasResolver.IsArrayOperatorAdd(Expr: TPasExpr): boolean;
 begin
   Result:=(Expr<>nil) and (Expr.ClassType=TBinaryExpr) and (Expr.OpCode=eopAdd)
-          and (msArrayOperators in GetElModeSwitches(Expr));
+          and ElHasModeSwitch(Expr,msArrayOperators);
 end;
 
 function TPasResolver.IsTypeCast(Params: TParamsExpr): boolean;
@@ -20541,7 +20605,7 @@ begin
   else if C=TPasEnumType then
     begin
     Result:=TResEvalRangeInt.CreateValue(revskEnum,TPasEnumType(Decl),
-                                         0,TPasEnumType(Decl).Values.Count-1);
+                              0,TMaxPrecInt(TPasEnumType(Decl).Values.Count)-1);
     Result.IdentEl:=Decl;
     exit;
     end
@@ -20603,8 +20667,14 @@ begin
   if El.CustomData is TResElDataBaseType then
     exit(true); // base type
   if El.Parent=nil then exit;
-  if (El.Parent is TPasType) and not HasTypeInfo(TPasType(El.Parent)) then
-    exit;
+  if El.Parent is TPasType then
+    begin
+    if not HasTypeInfo(TPasType(El.Parent)) then
+      exit;
+    end
+  else
+    if ElHasModeSwitch(El,msOmitRTTI) then
+      exit;
   Result:=true;
 end;
 

packages/fcl-passrc/src/pastree.pp

@@ -82,6 +82,8 @@ resourcestring
   SPasTreeClassDestructor = 'class destructor';
   SPasTreeConstructor = 'constructor';
   SPasTreeDestructor = 'destructor';
+  SPasTreeAnonymousProcedure = 'anonymous procedure';
+  SPasTreeAnonymousFunction = 'anonymous function';
   SPasTreeProcedureImpl = 'procedure/function implementation';
   SPasTreeConstructorImpl = 'constructor implementation';
   SPasTreeDestructorImpl = 'destructor implementation';
@@ -192,7 +194,7 @@ type
 
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
      pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
-     pekInherited, pekSelf, pekSpecialize);
+     pekInherited, pekSelf, pekSpecialize, pekProcedure);
 
   TExprOpCode = (eopNone,
                  eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
@@ -969,7 +971,8 @@ type
                ptOperator, ptClassOperator,
                ptConstructor, ptDestructor,
                ptClassProcedure, ptClassFunction,
-               ptClassConstructor, ptClassDestructor);
+               ptClassConstructor, ptClassDestructor,
+               ptAnonymousProcedure, ptAnonymousFunction);
 
   { TPasProcedureBase }
 
@@ -1004,6 +1007,8 @@ type
                         
   TProcedureBody = class;
 
+  { TPasProcedure - named procedure, not anonymous }
+
   TPasProcedure = class(TPasProcedureBase)
   Private
     FModifiers : TProcedureModifiers;
@@ -1020,13 +1025,13 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    ProcType : TPasProcedureType;
-    Body : TProcedureBody;
     PublicName, // e.g. public PublicName;
     LibrarySymbolName,
     LibraryExpr : TPasExpr; // e.g. external LibraryExpr name LibrarySymbolName;
     DispIDExpr :  TPasExpr;
     AliasName : String;
+    ProcType : TPasProcedureType;
+    Body : TProcedureBody;
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;
@@ -1039,6 +1044,7 @@ type
     Function IsReintroduced : Boolean;
     Function IsStatic : Boolean;
     Function IsForward: Boolean;
+    Function GetProcTypeEnum: TProcType; virtual;
     Property Modifiers : TProcedureModifiers Read FModifiers Write FModifiers;
     Property CallingConvention : TCallingConvention Read GetCallingConvention Write SetCallingConvention;
     Property MessageName : String Read FMessageName Write FMessageName;
@@ -1048,14 +1054,16 @@ type
 
   TArrayOfPasProcedure = array of TPasProcedure;
 
+  { TPasFunction - named function, not anonymous function}
+
   TPasFunction = class(TPasProcedure)
   private
     function GetFT: TPasFunctionType; inline;
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
-    function GetDeclaration (full : boolean) : string; override;
     Property FuncType : TPasFunctionType Read GetFT;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasOperator }
@@ -1082,17 +1090,18 @@ type
     Function OldName(WithPath : Boolean) : String;
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
     function GetDeclaration (full : boolean) : string; override;
     Property OperatorType : TOperatorType Read FOperatorType Write FOperatorType;
     // True if the declaration was using a token instead of an identifier
     Property TokenBased : Boolean Read FTokenBased Write FTokenBased;
   end;
 
-Type
   { TPasClassOperator }
 
   TPasClassOperator = class(TPasOperator)
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
 
@@ -1102,6 +1111,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasClassConstructor }
@@ -1110,6 +1120,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasDestructor }
@@ -1118,6 +1129,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasClassDestructor }
@@ -1126,6 +1138,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasClassProcedure }
@@ -1134,6 +1147,7 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
   { TPasClassFunction }
@@ -1142,8 +1156,43 @@ Type
   public
     function ElementTypeName: string; override;
     function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
+  end;
+
+  { TPasAnonymousProcedure - parent is TProcedureExpr }
+
+  TPasAnonymousProcedure = class(TPasProcedure)
+  public
+    function ElementTypeName: string; override;
+    function TypeName: string; override;
+    function GetProcTypeEnum: TProcType; override;
+  end;
+
+  { TPasAnonymousFunction - parent is TProcedureExpr and ProcType is TPasFunctionType}
+
+  TPasAnonymousFunction = class(TPasAnonymousProcedure)
+  private
+    function GetFT: TPasFunctionType; inline;
+  public
+    function ElementTypeName: string; override;
+    function TypeName: string; override;
+    Property FuncType : TPasFunctionType Read GetFT;
+    function GetProcTypeEnum: TProcType; override;
   end;
 
+  { TProcedureExpr }
+
+  TProcedureExpr = class(TPasExpr)
+  public
+    Proc: TPasAnonymousProcedure;
+    constructor Create(AParent: TPasElement); overload;
+    destructor Destroy; override;
+    function GetDeclaration(full: Boolean): string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+  end;
+
+
   TPasImplBlock = class;
 
   { TProcedureBody - the var+type+const+begin, without the header, child of TPasProcedure }
@@ -1577,7 +1626,8 @@ const
       'ListOfExp',
       'Inherited',
       'Self',
-      'Specialize');
+      'Specialize',
+      'Procedure');
 
   OpcodeStrings : Array[TExprOpCode] of string = (
         '','+','-','*','/','div','mod','**',
@@ -1643,6 +1693,26 @@ begin
   El:=nil;
 end;
 
+Function IndentStrings(S : TStrings; indent : Integer) : string;
+Var
+  I,CurrLen,CurrPos : Integer;
+begin
+  Result:='';
+  CurrLen:=0;
+  CurrPos:=0;
+  For I:=0 to S.Count-1 do
+    begin
+    CurrLen:=Length(S[i]);
+    If (CurrLen+CurrPos)>72 then
+      begin
+      Result:=Result+LineEnding+StringOfChar(' ',Indent);
+      CurrPos:=Indent;
+      end;
+    Result:=Result+S[i];
+    CurrPos:=CurrPos+CurrLen;
+    end;
+end;
+
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 begin
@@ -1843,6 +1913,11 @@ begin
   Result:='class operator';
 end;
 
+function TPasClassOperator.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassOperator;
+end;
+
 { TPasImplAsmStatement }
 
 constructor TPasImplAsmStatement.Create(const AName: string;
@@ -1865,6 +1940,79 @@ begin
   Result:='class '+ inherited TypeName;
 end;
 
+function TPasClassConstructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassConstructor;
+end;
+
+{ TPasAnonymousProcedure }
+
+function TPasAnonymousProcedure.ElementTypeName: string;
+begin
+  Result:=SPasTreeAnonymousProcedure;
+end;
+
+function TPasAnonymousProcedure.TypeName: string;
+begin
+  Result:='anonymous procedure';
+end;
+
+function TPasAnonymousProcedure.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptAnonymousProcedure;
+end;
+
+{ TPasAnonymousFunction }
+
+function TPasAnonymousFunction.GetFT: TPasFunctionType;
+begin
+  Result:=ProcType as TPasFunctionType;
+end;
+
+function TPasAnonymousFunction.ElementTypeName: string;
+begin
+  Result := SPasTreeAnonymousFunction;
+end;
+
+function TPasAnonymousFunction.TypeName: string;
+begin
+  Result:='anonymous function';
+end;
+
+function TPasAnonymousFunction.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptAnonymousFunction;
+end;
+
+{ TProcedureExpr }
+
+constructor TProcedureExpr.Create(AParent: TPasElement);
+begin
+  inherited Create(AParent,pekProcedure, eopNone);
+end;
+
+destructor TProcedureExpr.Destroy;
+begin
+  ReleaseAndNil(TPasElement(Proc){$IFDEF CheckPasTreeRefCount},'TProcedureExpr.Proc'{$ENDIF});
+  inherited Destroy;
+end;
+
+function TProcedureExpr.GetDeclaration(full: Boolean): string;
+begin
+  if Proc<>nil then
+    Result:=Proc.GetDeclaration(full)
+  else
+    Result:='procedure-expr';
+end;
+
+procedure TProcedureExpr.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  if Proc<>nil then
+    Proc.ForEachCall(aMethodCall,Arg);
+end;
+
 { TPasImplRaise }
 
 destructor TPasImplRaise.Destroy;
@@ -2157,7 +2305,7 @@ begin
   Result:=ProcType as TPasFunctionType;
 end;
 
-function TPasFunction.ElementTypeName: string; begin Result := SPasTreeFunction end;
+function TPasFunction.ElementTypeName: string; begin Result := SPasTreeFunction; end;
 function TPasClassProcedure.ElementTypeName: string; begin Result := SPasTreeClassProcedure; end;
 function TPasClassConstructor.ElementTypeName: string; begin Result := SPasTreeClassConstructor; end;
 function TPasClassDestructor.ElementTypeName: string; begin Result := SPasTreeClassDestructor; end;
@@ -2167,6 +2315,11 @@ begin
   Result:='destructor';
 end;
 
+function TPasClassDestructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassDestructor;
+end;
+
 function TPasClassFunction.ElementTypeName: string; begin Result := SPasTreeClassFunction; end;
 
 class function TPasOperator.OperatorTypeToToken(T: TOperatorType): String;
@@ -3229,12 +3382,12 @@ end;
 
 destructor TPasProcedure.Destroy;
 begin
-  ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
-  ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
   ReleaseAndNil(TPasElement(PublicName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.PublicName'{$ENDIF});
   ReleaseAndNil(TPasElement(LibraryExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibraryExpr'{$ENDIF});
   ReleaseAndNil(TPasElement(LibrarySymbolName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibrarySymbolName'{$ENDIF});
   ReleaseAndNil(TPasElement(DispIDExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.DispIDExpr'{$ENDIF});
+  ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
+  ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
   inherited Destroy;
 end;
 
@@ -3764,29 +3917,6 @@ begin
   ForEachChildCall(aMethodCall,Arg,ElType,true);
 end;
 
-Function IndentStrings(S : TStrings; indent : Integer) : string;
-
-Var
-  I,CurrLen,CurrPos : Integer;
-
-
-begin
-  Result:='';
-  CurrLen:=0;
-  CurrPos:=0;
-  For I:=0 to S.Count-1 do
-    begin
-    CurrLen:=Length(S[i]);
-    If (CurrLen+CurrPos)>72 then
-      begin
-      Result:=Result+LineEnding+StringOfChar(' ',Indent);
-      CurrPos:=Indent;
-      end;
-    Result:=Result+S[i];
-    CurrPos:=CurrPos+CurrLen;
-    end;
-end;
-
 function TPasEnumType.GetDeclaration (full : boolean) : string;
 
 Var
@@ -4278,8 +4408,8 @@ procedure TPasProcedure.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,ProcType,false);
+  ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);
   ForEachChildCall(aMethodCall,Arg,LibrarySymbolName,false);
   ForEachChildCall(aMethodCall,Arg,Body,false);
@@ -4347,36 +4477,28 @@ begin
   Result:=pmForward in FModifiers;
 end;
 
-function TPasProcedure.GetDeclaration(full: Boolean): string;
-
-Var
-  S : TStringList;
+function TPasProcedure.GetProcTypeEnum: TProcType;
 begin
-  S:=TStringList.Create;
-  try
-    If Full then
-      S.Add(TypeName+' '+Name);
-    ProcType.GetArguments(S);
-    GetModifiers(S);
-    Result:=IndentStrings(S,Length(S[0]));
-  finally
-    S.Free;
-  end;
+  Result:=ptProcedure;
 end;
 
-function TPasFunction.GetDeclaration (full : boolean) : string;
-
+function TPasProcedure.GetDeclaration(full: Boolean): string;
 Var
   S : TStringList;
-  T : string;
-
+  T: String;
 begin
   S:=TStringList.Create;
   try
     If Full then
-      S.Add(TypeName+' '+Name);
+      begin
+      T:=TypeName;
+      if Name<>'' then
+        T:=T+' '+Name;
+      S.Add(T);
+      end;
     ProcType.GetArguments(S);
-    If Assigned((Proctype as TPasFunctionType).ResultEl) then
+    If ProcType is TPasFunctionType
+        and Assigned(TPasFunctionType(Proctype).ResultEl) then
       With TPasFunctionType(ProcType).ResultEl.ResultType do
         begin
         T:=' : ';
@@ -4398,6 +4520,11 @@ begin
   Result:='function';
 end;
 
+function TPasFunction.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptFunction;
+end;
+
 function TPasOperator.GetOperatorDeclaration(Full : Boolean) : string;
 
 begin
@@ -4450,26 +4577,51 @@ begin
   Result:='operator';
 end;
 
+function TPasOperator.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptOperator;
+end;
+
 function TPasClassProcedure.TypeName: string;
 begin
   Result:='class procedure';
 end;
 
+function TPasClassProcedure.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassProcedure;
+end;
+
 function TPasClassFunction.TypeName: string;
 begin
   Result:='class function';
 end;
 
+function TPasClassFunction.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptClassFunction;
+end;
+
 function TPasConstructor.TypeName: string;
 begin
   Result:='constructor';
 end;
 
+function TPasConstructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptConstructor;
+end;
+
 function TPasDestructor.TypeName: string;
 begin
   Result:='destructor';
 end;
 
+function TPasDestructor.GetProcTypeEnum: TProcType;
+begin
+  Result:=ptDestructor;
+end;
+
 function TPasArgument.GetDeclaration (full : boolean) : string;
 begin
   If Assigned(ArgType) then

packages/fcl-passrc/src/pparser.pp

@@ -31,7 +31,7 @@ unit PParser;
 interface
 
 uses
-  {$ifdef pas2js}
+  {$ifdef NODEJS}
   NodeJSFS,
   {$endif}
   SysUtils, Classes, PasTree, PScanner;
@@ -94,6 +94,7 @@ const
   nParserResourcestringsMustBeGlobal = 2054;
   nParserOnlyOneVariableCanBeAbsolute = 2055;
   nParserXNotAllowedInY = 2056;
+  nFileSystemsNotSupported = 2057;
 
 // resourcestring patterns of messages
 resourcestring
@@ -153,6 +154,7 @@ resourcestring
   SParserResourcestringsMustBeGlobal = 'Resourcestrings can be only static or global';
   SParserOnlyOneVariableCanBeAbsolute = 'Only one variable can be absolute';
   SParserXNotAllowedInY = '%s is not allowed in %s';
+  SErrFileSystemNotSupported = 'No support for filesystems enabled';
 
 type
   TPasScopeType = (
@@ -312,7 +314,7 @@ type
     function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
     function CheckProcedureArgs(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
-      Mandatory: Boolean): boolean;
+      ProcType: TProcType): boolean;
     function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
     procedure ParseExc(MsgNumber: integer; const Msg: String);
     procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif});
@@ -347,12 +349,15 @@ type
     function CreateRecordValues(AParent : TPasElement): TRecordValues;
     Function IsCurTokenHint(out AHint : TPasMemberHint) : Boolean; overload;
     Function IsCurTokenHint: Boolean; overload;
-    Function TokenIsCallingConvention(const S : String; out CC : TCallingConvention) : Boolean; virtual;
-    Function TokenIsProcedureModifier(Parent : TPasElement; const S : String; Out PM : TProcedureModifier) : Boolean; virtual;
+    Function TokenIsCallingConvention(const S: String; out CC : TCallingConvention) : Boolean; virtual;
+    Function TokenIsProcedureModifier(Parent: TPasElement; const S: String; Out PM : TProcedureModifier): Boolean; virtual;
+    Function TokenIsAnonymousProcedureModifier(Parent: TPasElement; S: String; Out PM: TProcedureModifier): Boolean; virtual;
     Function TokenIsProcedureTypeModifier(Parent : TPasElement; const S : String; Out PTM : TProcTypeModifier) : Boolean; virtual;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
+    function IsAnonymousProcAllowed(El: TPasElement): boolean; virtual;
     function ParseParams(AParent : TPasElement; ParamsKind: TPasExprKind; AllowFormatting : Boolean = False): TParamsExpr;
-    function ParseExpIdent(AParent : TPasElement): TPasExpr;
+    function ParseExprOperand(AParent : TPasElement): TPasExpr;
+    function ParseExpIdent(AParent : TPasElement): TPasExpr; deprecated 'use ParseExprOperand instead'; // since fpc 3.3.1
     procedure DoParseClassType(AType: TPasClassType);
     function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
     function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
@@ -472,6 +477,10 @@ Type
     {$endif}
     poSkipDefaultDefs);
   TParseSourceOptions = set of TParseSourceOption;
+
+Var
+  DefaultFileResolverClass : TBaseFileResolverClass = Nil;
+
 function ParseSource(AEngine: TPasTreeContainer;
                      const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
 {$ifdef HasStreams}
@@ -597,8 +606,9 @@ end;
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String;
   Options : TParseSourceOptions): TPasModule;
+
 var
-  FileResolver: TFileResolver;
+  FileResolver: TBaseFileResolver;
   Parser: TPasParser;
   Start, CurPos: integer; // in FPCCommandLine
   Filename: String;
@@ -648,7 +658,7 @@ var
       end;
     end else
       if Filename <> '' then
-        raise Exception.Create(SErrMultipleSourceFiles)
+        raise ENotSupportedException.Create(SErrMultipleSourceFiles)
       else
         Filename := s;
   end;
@@ -656,14 +666,17 @@ var
 var
   s: String;
 begin
+  if DefaultFileResolverClass=Nil then
+    raise ENotImplemented.Create(SErrFileSystemNotSupported);
   Result := nil;
   FileResolver := nil;
   Scanner := nil;
   Parser := nil;
   try
-    FileResolver := TFileResolver.Create;
+    FileResolver := DefaultFileResolverClass.Create;
     {$ifdef HasStreams}
-    FileResolver.UseStreams:=poUseStreams in Options;
+    if FileResolver is TFileResolver then
+      TFileResolver(FileResolver).UseStreams:=poUseStreams in Options;
     {$endif}
     Scanner := TPascalScanner.Create(FileResolver);
     Scanner.LogEvents:=AEngine.ScannerLogEvents;
@@ -733,7 +746,9 @@ begin
 
     if Filename = '' then
       raise Exception.Create(SErrNoSourceGiven);
+{$IFDEF HASFS}
     FileResolver.AddIncludePath(ExtractFilePath(FileName));
+{$ENDIF}
     Scanner.OpenFile(Filename);
     Parser.ParseMain(Result);
   finally
@@ -1229,6 +1244,21 @@ begin
     end;
 end;
 
+function TPasParser.TokenIsAnonymousProcedureModifier(Parent: TPasElement;
+  S: String; out PM: TProcedureModifier): Boolean;
+begin
+  S:=LowerCase(S);
+  case S of
+  'assembler':
+    begin
+    PM:=pmAssembler;
+    exit(true);
+    end;
+  end;
+  Result:=false;
+  if Parent=nil then ;
+end;
+
 function TPasParser.TokenIsProcedureTypeModifier(Parent: TPasElement;
   const S: String; out PTM: TProcTypeModifier): Boolean;
 begin
@@ -1279,6 +1309,17 @@ begin
     ExpectToken(tkSemiColon);
 end;
 
+function TPasParser.IsAnonymousProcAllowed(El: TPasElement): boolean;
+begin
+  while El is TPasExpr do
+    El:=El.Parent;
+  if not (El is TPasImplBlock) then
+    exit(false); // only in statements
+  while El is TPasImplBlock do
+    El:=El.Parent;
+  Result:=El is TProcedureBody; // needs a parent procedure
+end;
+
 function TPasParser.CheckPackMode: TPackMode;
 
 begin
@@ -2069,7 +2110,7 @@ begin
   end;
 end;
 
-function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
+function TPasParser.ParseExprOperand(AParent: TPasElement): TPasExpr;
 
   Function IsWriteOrStr(P : TPasExpr) : boolean;
 
@@ -2097,7 +2138,7 @@ function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
       begin // self.Write(EscapeText(AText));
       optk:=CurToken;
       NextToken;
-      b:=CreateBinaryExpr(AParent,Last, ParseExpIdent(AParent), TokenToExprOp(optk));
+      b:=CreateBinaryExpr(AParent,Last, ParseExprOperand(AParent), TokenToExprOp(optk));
       if not Assigned(b.right) then
         begin
         b.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
@@ -2168,15 +2209,16 @@ var
   ISE: TInlineSpecializeExpr;
   ST: TPasSpecializeType;
   SrcPos, ScrPos: TPasSourcePos;
+  ProcType: TProcType;
 
 begin
   Result:=nil;
   CanSpecialize:=false;
   aName:='';
   case CurToken of
-    tkString:           Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
-    tkChar:             Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenText);
-    tkNumber:           Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
+    tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
+    tkChar:   Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenText);
+    tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
     tkIdentifier:
       begin
       CanSpecialize:=true;
@@ -2200,7 +2242,7 @@ begin
       if (CurToken=tkIdentifier) then
         begin
         SrcPos:=CurTokenPos;
-        Bin:=CreateBinaryExpr(AParent,Last,ParseExpIdent(AParent),eopNone,SrcPos);
+        Bin:=CreateBinaryExpr(AParent,Last,ParseExprOperand(AParent),eopNone,SrcPos);
         if not Assigned(Bin.right) then
           begin
           Bin.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
@@ -2218,6 +2260,27 @@ begin
       Last:=CreateSelfExpr(AParent);
       HandleSelf(Last);
       end;
+    tkprocedure,tkfunction:
+      begin
+      if CurToken=tkprocedure then
+        ProcType:=ptAnonymousProcedure
+      else
+        ProcType:=ptAnonymousFunction;
+      if not IsAnonymousProcAllowed(AParent) then
+        ParseExcExpectedIdentifier;
+      ok:=false;
+      try
+        Result:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
+        TProcedureExpr(Result).Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(Result,ProcType));
+        if CurToken=tkSemicolon then
+          NextToken; // skip optional semicolon
+        ok:=true;
+      finally
+        if not ok then
+          Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+      end;
+      exit; // do not allow postfix operators . ^. [] ()
+      end;
     tkCaret:
       begin
       // is this still needed?
@@ -2317,6 +2380,11 @@ begin
   end;
 end;
 
+function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
+begin
+  Result:=ParseExprOperand(AParent);
+end;
+
 function TPasParser.OpLevel(t: TToken): Integer;
 begin
   case t of
@@ -2479,12 +2547,12 @@ begin
           if (CurToken=tkDot) then
             begin
             NextToken;
-            x:=CreateBinaryExpr(AParent,x, ParseExpIdent(AParent), TokenToExprOp(tkDot));
+            x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
             end;
           end
         else
           begin
-          x:=ParseExpIdent(AParent);
+          x:=ParseExprOperand(AParent);
           if not Assigned(x) then
             ParseExcSyntaxError;
           end;
@@ -4572,12 +4640,11 @@ end;
 
 
 function TPasParser.CheckProcedureArgs(Parent: TPasElement; Args: TFPList;
-  Mandatory: Boolean): boolean;
+  ProcType: TProcType): boolean;
 
 begin
   NextToken;
-  case CurToken of
-  tkBraceOpen:
+  if CurToken=tkBraceOpen then
     begin
     Result:=true;
     NextToken;
@@ -4586,18 +4653,34 @@ begin
       UngetToken;
       ParseArgList(Parent, Args, tkBraceClose);
       end;
-    end;
-  tkSemicolon,tkColon,tkof,tkis,tkIdentifier:
+    end
+  else
     begin
     Result:=false;
-    if Mandatory then
-      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon)
+    case ProcType of
+    ptOperator,ptClassOperator:
+      ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon);
+    ptAnonymousProcedure,ptAnonymousFunction:
+      case CurToken of
+      tkIdentifier, // e.g. procedure assembler
+      tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction:
+        UngetToken;
+      else
+        ParseExcTokenError('begin');
+      end;
     else
-      UngetToken;
-    end
-  else
-    ParseExcTokenError(';');
-  end;
+      case CurToken of
+        tkSemicolon, // e.g. procedure;
+        tkColon, // e.g. function: id
+        tkof, // e.g. procedure of object
+        tkis, // e.g. procedure is nested
+        tkIdentifier: // e.g. procedure cdecl;
+          UngetToken;
+      else
+        ParseExcTokenError(';');
+      end;
+    end;
+    end;
 end;
 
 procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
@@ -4788,20 +4871,22 @@ Var
   Tok : String;
   CC : TCallingConvention;
   PM : TProcedureModifier;
-  Done: Boolean;
   ResultEl: TPasResultElement;
-  OK,IsProc : Boolean;
+  OK: Boolean;
+  IsProc: Boolean; // true = procedure, false = procedure type
+  IsAnonymProc: Boolean;
   PTM: TProcTypeModifier;
-  ModCount: Integer;
+  ModTokenCount: Integer;
   LastToken: TToken;
 
 begin
   // Element must be non-nil. Removed all checks for not-nil.
   // If it is nil, the following fails anyway.
-  CheckProcedureArgs(Element,Element.Args,ProcType in [ptOperator,ptClassOperator]);
+  CheckProcedureArgs(Element,Element.Args,ProcType);
   IsProc:=Parent is TPasProcedure;
+  IsAnonymProc:=IsProc and (ProcType in [ptAnonymousProcedure,ptAnonymousFunction]);
   case ProcType of
-    ptFunction,ptClassFunction:
+    ptFunction,ptClassFunction,ptAnonymousFunction:
       begin
       NextToken;
       if CurToken = tkColon then
@@ -4870,13 +4955,13 @@ begin
     else
       UnGetToken;
     end;
-  ModCount:=0;
+  ModTokenCount:=0;
   Repeat
-    inc(ModCount);
-    // Writeln(modcount, curtokentext);
+    inc(ModTokenCount);
+    // Writeln(ModTokenCount, curtokentext);
     LastToken:=CurToken;
     NextToken;
-    if (ModCount<=3) and (CurToken = tkEqual) and not (Parent is TPasProcedure) then
+    if (CurToken = tkEqual) and not IsProc and (ModTokenCount<=3) then
       begin
       // for example: const p: procedure = nil;
       UngetToken;
@@ -4887,6 +4972,7 @@ begin
       begin
       if LastToken=tkSemicolon then
         ParseExcSyntaxError;
+      continue;
       end
     else if TokenIsCallingConvention(CurTokenString,cc) then
       begin
@@ -4905,11 +4991,18 @@ begin
           NextToken; // remove offset
           end;
       end;
-      ExpectTokens([tkSemicolon,tkEqual]);
-      if CurToken=tkEqual then
-        UngetToken;
+      if IsProc then
+        ExpectTokens([tkSemicolon])
+      else
+        begin
+        ExpectTokens([tkSemicolon,tkEqual]);
+        if CurToken=tkEqual then
+          UngetToken;
+        end;
       end
-    else if IsProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+    else if IsAnonymProc and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
+      HandleProcedureModifier(Parent,PM)
+    else if IsProc and not IsAnonymProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
     else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
       HandleProcedureTypeModifier(Element,PTM)
@@ -4918,16 +5011,22 @@ begin
       Tok:=UpperCase(CurTokenString);
       NextToken;
       If (tok<>'NAME') then
-        Element.Hints:=Element.Hints+[hLibrary]
+        begin
+        if hLibrary in Element.Hints then
+          ParseExcSyntaxError;
+        Element.Hints:=Element.Hints+[hLibrary];
+        end
       else
         begin
-        NextToken;  // Should be export name string.
+        NextToken;  // Should be "export name astring".
         ExpectToken(tkSemicolon);
         end;
       end
-    else if DoCheckHint(Element) then
+    else if (not IsAnonymProc) and DoCheckHint(Element) then
+      // deprecated,platform,experimental,library, unimplemented etc
       ConsumeSemi
-    else if (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0) then
+    else if (CurToken=tkIdentifier) and (not IsAnonymProc)
+        and (CompareText(CurTokenText,'alias')=0) then
       begin
       ExpectToken(tkColon);
       ExpectToken(tkString);
@@ -4947,44 +5046,48 @@ begin
         begin
         // ToDo: read FPC's [] modifiers, e.g. [public,alias:'']
         repeat
-          NextToken
+          NextToken;
+          if CurToken in [tkSquaredBraceOpen,tkSemicolon] then
+            CheckToken(tkSquaredBraceClose);
         until CurToken = tkSquaredBraceClose;
         ExpectToken(tkSemicolon);
         end;
       end
     else
-      CheckToken(tkSemicolon);
-    Done:=(CurToken=tkSemiColon);
-    if Done then
       begin
-      NextToken;
-      Done:=Not ((Curtoken=tkSquaredBraceOpen) or
-                  TokenIsProcedureModifier(Parent,CurtokenString,PM) or
-                  TokenIsProcedureTypeModifier(Parent,CurtokenString,PTM) or
-                  IsCurTokenHint() or
-                  TokenIsCallingConvention(CurTokenString,cc) or
-                  (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0));
-      {$ifdef VerbosePasParser}
-      DumpCurToken('Done '+IntToStr(Ord(Done)));
-      {$endif}
-      UngetToken;
+      // not a modifier/hint/calling convention
+      if LastToken=tkSemicolon then
+        begin
+        UngetToken;
+        if IsAnonymProc and (ModTokenCount<=1) then
+          ParseExcSyntaxError;
+        break;
+        end
+      else if IsAnonymProc then
+        begin
+        UngetToken;
+        break;
+        end
+      else
+        begin
+        CheckToken(tkSemicolon);
+        continue;
+        end;
       end;
-
-//    Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
-  Until Done;
-  if DoCheckHint(Element) then  // deprecated,platform,experimental,library, unimplemented etc
-    ConsumeSemi;
+    // Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
+  Until false;
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
     TPasOperator(Parent).CorrectName;
   Engine.FinishScope(stProcedureHeader,Element);
-  if (Parent is TPasProcedure)
+  if IsProc
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsExternal)
   and ((Parent.Parent is TImplementationSection)
-     or (Parent.Parent is TProcedureBody))
+     or (Parent.Parent is TProcedureBody)
+     or IsAnonymProc)
   then
     ParseProcedureBody(Parent);
-  if Parent is TPasProcedure then
+  if IsProc then
     Engine.FinishScope(stProcedure,Parent);
 end;
 
@@ -5245,6 +5348,7 @@ procedure TPasParser.ParseProcBeginBlock(Parent: TProcedureBody);
 var
   BeginBlock: TPasImplBeginBlock;
   SubBlock: TPasImplElement;
+  Proc: TPasProcedure;
 begin
   BeginBlock := TPasImplBeginBlock(CreateElement(TPasImplBeginBlock, '', Parent));
   Parent.Body := BeginBlock;
@@ -5261,7 +5365,11 @@ begin
         ExpectToken(tkend);
     end;
   until false;
-  ExpectToken(tkSemicolon);
+  Proc:=Parent.Parent as TPasProcedure;
+  if Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction] then
+    NextToken
+  else
+    ExpectToken(tkSemicolon);
 //  writeln('TPasParser.ParseProcBeginBlock ended ',curtokenstring);
 end;
 
@@ -5962,12 +6070,15 @@ begin
     ptDestructor     : Result:=TPasDestructor;
     ptOperator       : Result:=TPasOperator;
     ptClassOperator  : Result:=TPasClassOperator;
+    ptAnonymousProcedure: Result:=TPasAnonymousProcedure;
+    ptAnonymousFunction: Result:=TPasAnonymousFunction;
   else
     ParseExc(nParserUnknownProcedureType,SParserUnknownProcedureType,[Ord(ProcType)]);
   end;
 end;
 
-function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
+function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
+  ProcType: TProcType; AVisibility: TPasMemberVisibility): TPasProcedure;
 
   function ExpectProcName: string;
 
@@ -6011,9 +6122,8 @@ var
   IsTokenBased , ok: Boolean;
 
 begin
-  If (Not (ProcType in [ptOperator,ptClassOperator])) then
-    Name:=ExpectProcName
-  else
+  case ProcType of
+  ptOperator,ptClassOperator:
     begin
     NextToken;
     IsTokenBased:=Curtoken<>tkIdentifier;
@@ -6025,14 +6135,19 @@ begin
       ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
     Name:=OperatorNames[Ot];
     end;
+  ptAnonymousProcedure,ptAnonymousFunction:
+    Name:='';
+  else
+    Name:=ExpectProcName;
+  end;
   PC:=GetProcedureClass(ProcType);
-  Parent:=CheckIfOverLoaded(Parent,Name);
+  if Name<>'' then
+    Parent:=CheckIfOverLoaded(Parent,Name);
   Result:=TPasProcedure(CreateElement(PC,Name,Parent,AVisibility));
   ok:=false;
   try
-    if Not (ProcType in [ptFunction, ptClassFunction, ptOperator, ptClassOperator]) then
-      Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result))
-    else
+    case ProcType of
+    ptFunction, ptClassFunction, ptOperator, ptClassOperator, ptAnonymousFunction:
       begin
       Result.ProcType := CreateFunctionType('', 'Result', Result, False, CurTokenPos);
       if (ProcType in [ptOperator, ptClassOperator]) then
@@ -6042,6 +6157,9 @@ begin
         TPasOperator(Result).CorrectName;
         end;
       end;
+    else
+      Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result));
+    end;
     ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
     Result.Hints:=Result.ProcType.Hints;
     Result.HintMessage:=Result.ProcType.HintMessage;
@@ -6329,6 +6447,8 @@ begin
   Result:=isVisibility(S,AVisibility);
   if Result then
     begin
+    if (AVisibility=visPublished) and (msOmitRTTI in Scanner.CurrentModeSwitches) then
+      AVisibility:=visPublic;
     if B then
       case AVisibility of
         visPrivate   : AVisibility:=visStrictPrivate;
@@ -6987,4 +7107,8 @@ begin
   Result.Kind:=pekListOfExp;
 end;
 
+initialization
+{$IFDEF HASFS}
+  DefaultFileResolverClass:=TFileResolver;
+{$ENDIF}
 end.

packages/fcl-passrc/src/pscanner.pp

@@ -26,13 +26,22 @@ unit PScanner;
   {$IF FPC_FULLVERSION<30101}
     {$define EmulateArrayInsert}
   {$endif}
+  {$define HasFS}
 {$endif}
 
+{$IFDEF NODEJS}
+  {$define HasFS}
+{$ENDIF}
+
 interface
 
 uses
   {$ifdef pas2js}
-  js, NodeJSFS, Types,
+  js,
+  {$IFDEF NODEJS}
+  NodeJSFS,
+  {$ENDIF}
+  Types,
   {$endif}
   SysUtils, Classes;
 
@@ -284,7 +293,8 @@ type
     msArrayOperators,      { use Delphi compatible array operators instead of custom ones ("+") }
     msExternalClass,       { Allow external class definitions }
     msPrefixedAttributes,  { Allow attributes, disable proc modifier [] }
-    msIgnoreAttributes     { workaround til resolver/converter supports attributes }
+    msIgnoreAttributes,    { workaround til resolver/converter supports attributes }
+    msOmitRTTI             { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
   );
   TModeSwitches = Set of TModeSwitch;
 
@@ -478,7 +488,6 @@ type
   Protected
     procedure SetBaseDirectory(AValue: string); virtual;
     procedure SetStrictFileCase(AValue: Boolean); virtual;
-    Function FindIncludeFileName(const AName: string): String;
     Property IncludePaths: TStringList Read FIncludePaths;
   public
     constructor Create; virtual;
@@ -489,7 +498,9 @@ type
     Property StrictFileCase : Boolean Read FStrictFileCase Write SetStrictFileCase;
     property BaseDirectory: string read FBaseDirectory write SetBaseDirectory;
   end;
+  TBaseFileResolverClass = Class of TBaseFileResolver;
 
+{$IFDEF HASFS}
   { TFileResolver }
 
   TFileResolver = class(TBaseFileResolver)
@@ -498,6 +509,7 @@ type
     FUseStreams: Boolean;
     {$endif}
   Protected
+    Function FindIncludeFileName(const AName: string): String; virtual;
     Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
   Public
     function FindSourceFile(const AName: string): TLineReader; override;
@@ -506,6 +518,7 @@ type
     Property UseStreams : Boolean Read FUseStreams Write FUseStreams;
     {$endif}
   end;
+{$ENDIF}
 
   {$ifdef fpc}
   { TStreamResolver }
@@ -1019,7 +1032,8 @@ const
     'ARRAYOPERATORS',
     'EXTERNALCLASS',
     'PREFIXEDATTRIBUTES',
-    'IGNOREATTRIBUTES'
+    'IGNOREATTRIBUTES',
+    'OMITRTTI'
     );
 
   LetterSwitchNames: array['A'..'Z'] of string=(
@@ -1142,6 +1156,7 @@ function FilenameIsAbsolute(const TheFilename: string):boolean;
 function FilenameIsWinAbsolute(const TheFilename: string): boolean;
 function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
 function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean;
+Function ExtractFilenameOnly(Const AFileName : String) : String;
 
 procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
 function SafeFormat(const Fmt: string; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): string;
@@ -1157,6 +1172,13 @@ Var
   SortedTokens : array of TToken;
   LowerCaseTokens  : Array[ttoken] of String;
 
+Function ExtractFilenameOnly(Const AFileName : String) : String;
+
+begin
+  Result:=ChangeFileExt(ExtractFileName(aFileName),'');
+end;
+
+
 Procedure SortTokenInfo;
 
 Var
@@ -2376,7 +2398,45 @@ begin
   FStrictFileCase:=AValue;
 end;
 
-function TBaseFileResolver.FindIncludeFileName(const AName: string): String;
+
+constructor TBaseFileResolver.Create;
+begin
+  inherited Create;
+  FIncludePaths := TStringList.Create;
+end;
+
+destructor TBaseFileResolver.Destroy;
+begin
+  FIncludePaths.Free;
+  inherited Destroy;
+end;
+
+procedure TBaseFileResolver.AddIncludePath(const APath: string);
+
+Var
+  FP : String;
+
+begin
+  if (APath='') then
+    FIncludePaths.Add('./')
+  else
+    begin
+{$IFDEF HASFS}
+    FP:=IncludeTrailingPathDelimiter(ExpandFileName(APath));
+{$ELSE}
+    FP:=APath;
+{$ENDIF}
+    FIncludePaths.Add(FP);
+    end;
+end;
+
+{$IFDEF HASFS}
+
+{ ---------------------------------------------------------------------
+  TFileResolver
+  ---------------------------------------------------------------------}
+
+function TFileResolver.FindIncludeFileName(const AName: string): String;
 
   function SearchLowUpCase(FN: string): string;
 
@@ -2430,30 +2490,6 @@ begin
     end;
 end;
 
-constructor TBaseFileResolver.Create;
-begin
-  inherited Create;
-  FIncludePaths := TStringList.Create;
-end;
-
-destructor TBaseFileResolver.Destroy;
-begin
-  FIncludePaths.Free;
-  inherited Destroy;
-end;
-
-procedure TBaseFileResolver.AddIncludePath(const APath: string);
-begin
-  if (APath='') then
-    FIncludePaths.Add('./')
-  else
-    FIncludePaths.Add(IncludeTrailingPathDelimiter(ExpandFileName(APath)));
-end;
-
-{ ---------------------------------------------------------------------
-  TFileResolver
-  ---------------------------------------------------------------------}
-
 function TFileResolver.CreateFileReader(const AFileName: String): TLineReader;
 begin
   {$ifdef HasStreams}
@@ -2492,6 +2528,7 @@ begin
       Result:=Nil;
     end;
 end;
+{$ENDIF}
 
 {$ifdef fpc}
 { TStreamResolver }
@@ -2646,7 +2683,7 @@ begin
   // Dont' free the first element, because it is CurSourceFile
   while FIncludeStack.Count > 1 do
     begin
-    TFileResolver(FIncludeStack[1]).{$ifdef pas2js}Destroy{$else}Free{$endif};
+    TBaseFileResolver(FIncludeStack[1]).{$ifdef pas2js}Destroy{$else}Free{$endif};
     FIncludeStack.Delete(1);
     end;
   FIncludeStack.Clear;
@@ -2682,7 +2719,9 @@ begin
   FCurSourceFile := FileResolver.FindSourceFile(AFilename);
   FCurFilename := AFilename;
   AddFile(FCurFilename);
+{$IFDEF HASFS}
   FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(FCurFilename));
+{$ENDIF}
   if LogEvent(sleFile) then
     DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(AFileName)],True);
 end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -32,7 +32,7 @@ type
   TSrcMarker = record
     Kind: TSrcMarkerKind;
     Filename: string;
-    Row: integer;
+    Row: cardinal;
     StartCol, EndCol: integer; // token start, end column
     Identifier: string;
     Next: PSrcMarker;
@@ -315,6 +315,7 @@ type
     Procedure TestIncDec;
     Procedure TestIncStringFail;
     Procedure TestTypeInfo;
+    Procedure TestTypeInfo_FailRTTIDisabled;
 
     // statements
     Procedure TestForLoop;
@@ -446,6 +447,25 @@ type
     Procedure TestProc_ImplicitCalls;
     Procedure TestProc_Absolute;
 
+    // anonymous procs
+    // ToDo: fppas2js: check "is TPasFunction", ".FuncType", "parent is TPasProcedureBody"
+    Procedure TestAnonymousProc_Assign;
+    // ToDo: does Delphi allow/require semicolon in assign?
+    Procedure TestAnonymousProc_Arg;
+    // ToDo: does Delphi allow/require semicolon in arg?
+    // ToDo: does Delphi allow calling directly?: function(i: word):word begin end(3)
+    Procedure TestAnonymousProc_EqualFail;
+    // ToDo: does Delphi allow ano proc in const?
+    Procedure TestAnonymousProc_ConstFail;
+    // ToDo: does Delphi allow assembler or calling conventions?
+    Procedure TestAnonymousProc_Assembler;
+    Procedure TestAnonymousProc_NameFail;
+    Procedure TestAnonymousProc_StatementFail;
+    Procedure TestAnonymousProc_Typecast;// ToDo
+    // ToDo: ano in with
+    // ToDo: ano in nested
+    // ToDo: ano in ano
+
     // record
     Procedure TestRecord;
     Procedure TestRecordVariant;
@@ -1410,7 +1430,7 @@ var
           DeclEl:=TPasAliasType(El).DestType;
           ResolverEngine.UnmangleSourceLineNumber(DeclEl.SourceLinenumber,LabelLine,LabelCol);
           if (aLabel^.Filename=DeclEl.SourceFilename)
-          and (aLabel^.Row=LabelLine)
+          and (integer(aLabel^.Row)=LabelLine)
           and (aLabel^.StartCol<=LabelCol)
           and (aLabel^.EndCol>=LabelCol) then
             exit; // success
@@ -1490,8 +1510,8 @@ begin
     if (Marker<>nil) then
       begin
       if Item.SourcePos.Row<>Marker^.Row then continue;
-      if (Item.SourcePos.Column<Marker^.StartCol)
-          or (Item.SourcePos.Column>Marker^.EndCol) then continue;
+      if (integer(Item.SourcePos.Column)<Marker^.StartCol)
+          or (integer(Item.SourcePos.Column)>Marker^.EndCol) then continue;
       end;
     // found
     FResolverGoodMsgs.Add(Item);
@@ -4707,6 +4727,21 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestTypeInfo_FailRTTIDisabled;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch OmitRTTI}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  'var o: TObject;',
+  'begin',
+  '  if typeinfo(o)=nil then ;',
+  '']);
+  CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished);
+end;
+
 procedure TTestResolver.TestForLoop;
 begin
   StartProgram(false);
@@ -7119,6 +7154,137 @@ begin
   'begin']);
 end;
 
+procedure TTestResolver.TestAnonymousProc_Assign;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TFunc = reference to function(x: word): word;',
+  'var Func: TFunc;',
+  'procedure DoIt(a: word);',
+  'begin',
+  '  Func:=function(b:word): word',
+  '  begin',
+  '    Result:=a+b;',
+  '    exit(b);',
+  '    exit(Result);',
+  '  end;',
+  '  a:=3;',// test semicolon
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_Arg;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TFunc = reference to function(x: word): word;',
+  'procedure DoMore(f,g: TProc);',
+  'begin',
+  'end;',
+  'procedure DoIt(f: TFunc);',
+  'begin',
+  '  DoIt(function(b:word): word',
+  '    begin',
+  '      Result:=1+b;',
+  '    end;);',
+  '  DoMore(procedure begin end;, procedure begin end);',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_EqualFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TFunc = reference to function(x: word): word;',
+  'procedure DoIt(f: TFunc);',
+  'var w: word;',
+  'begin',
+  '  if w=function(b:word): word',
+  '    begin',
+  '      Result:=1+b;',
+  '    end; then ;',
+  'end;',
+  'begin']);
+  CheckResolverException('Incompatible types: got "Procedure/Function" expected "Word"',nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolver.TestAnonymousProc_ConstFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'const',
+  '  p: TProc = procedure begin end;',
+  'begin']);
+  CheckParserException('Identifier expected at token "procedure" in file afile.pp at line 5 column 14',nParserExpectedIdentifier);
+end;
+
+procedure TTestResolver.TestAnonymousProc_Assembler;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(p: TProc);',
+  'begin',
+  '  p:=procedure assembler; asm end;',
+  '  p:=procedure() assembler; asm end;',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_NameFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(p: TProc);',
+  'begin',
+  '  p:=procedure Bla() begin end;',
+  'end;',
+  'begin']);
+  CheckParserException(SParserSyntaxError,nParserSyntaxError);
+end;
+
+procedure TTestResolver.TestAnonymousProc_StatementFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'begin',
+  '  procedure () begin end;',
+  'end;',
+  'begin']);
+  CheckParserException(SParserSyntaxError,nParserSyntaxError);
+end;
+
+procedure TTestResolver.TestAnonymousProc_Typecast;
+begin
+  exit;
+
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  'procedure DoIt(p: TProc);',
+  'begin',
+  '  p:=TProc(procedure(b: byte) begin end);',
+  '  p:=TProc(procedure(b: byte) begin end;);',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestRecord;
 begin
   StartProgram(false);

packages/fcl-pdf/fpmake.pp

@@ -37,17 +37,21 @@ begin
     P.Version:='3.3.1';
     T:=P.Targets.AddUnit('src/fpttfencodings.pp');
     T:=P.Targets.AddUnit('src/fpparsettf.pp');
+      T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('src/fpfonttextmapping.pp');
     With T do
       Dependencies.AddUnit('fpttfencodings');
     T:=P.Targets.AddUnit('src/fpttfsubsetter.pp');
+      T.ResourceStrings:=true;
     With T do
       begin
       Dependencies.AddUnit('fpparsettf');
       Dependencies.AddUnit('fpfonttextmapping');
       end;
     T:=P.Targets.AddUnit('src/fpttf.pp');
+      T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('src/fppdf.pp');
+      T.ResourceStrings:=true;
     With T do
       begin
       Dependencies.AddUnit('fpparsettf');

packages/fcl-web/examples/simpleserver/simpleserver.lpi

@@ -39,6 +39,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../../src/base"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
   </CompilerOptions>

packages/fcl-web/examples/simpleserver/simpleserver.pas

@@ -46,6 +46,7 @@ begin
   Writeln('-i --indexpage=name Directory index page to use (default: index.html)');
   Writeln('-n --noindexpage    Do not allow index page.');
   Writeln('-p --port=NNNN      TCP/IP port to listen on (default is 3000)');
+  Writeln('-m --mimetypes=file path of mime.types, default under unix: /etc/mime.types');
   Writeln('-q --quiet          Do not write diagnostic messages');
   Halt(Ord(Msg<>''));
 end;
@@ -65,10 +66,24 @@ begin
   if D='' then
     D:=GetCurrentDir;
   Log(etInfo,'Listening on port %d, serving files from directory: %s',[Port,D]);
+
+  if HasOption('m','mimetypes') then
+    MimeTypesFile:=GetOptionValue('m','mimetypes');
 {$ifdef unix}
-  MimeTypesFile:='/etc/mime.types';
-  if not FileExists(MimeTypesFile) then
-    MimeTypesFile:='';
+  if MimeTypesFile='' then
+    begin
+    MimeTypesFile:='/etc/mime.types';
+    if not FileExists(MimeTypesFile) then
+      begin
+      {$ifdef darwin}
+      MimeTypesFile:='/private/etc/apache2/mime.types';
+      if not FileExists(MimeTypesFile) then
+      {$endif}
+        MimeTypesFile:='';
+      end;
+    end;
+  if (MimeTypesFile<>'') and not FileExists(MimeTypesFile) then
+    Log(etWarning,'mimetypes file not found: '+MimeTypesFile);
 {$endif}
   TSimpleFileModule.BaseDir:=IncludeTrailingPathDelimiter(D);
   TSimpleFileModule.OnLog:=@Log;

packages/fcl-web/fpmake.pp

@@ -50,6 +50,7 @@ begin
     T.Dependencies.AddUnit('httpprotocol');
 
     T:=P.Targets.AddUnit('httproute.pp');
+      T.ResourceStrings:=true;
     T.Dependencies.AddUnit('httpdefs');
 
     T:=P.Targets.AddUnit('cgiapp.pp');
@@ -182,6 +183,11 @@ begin
         OSes:=[Win32,Win64];
         Dependencies.AddUnit('custhttpsys');
       end;
+    with P.Targets.AddUnit('fphttpstatus.pas') do
+      begin
+        Dependencies.AddUnit('fphttpserver');
+        Dependencies.AddUnit('HTTPDefs');
+      end;
     T:=P.Targets.AddUnit('fcgigate.pp');
     T.ResourceStrings:=true;
     With T.Dependencies do
@@ -264,6 +270,7 @@ begin
     T:=P.Targets.AddUnit('fpwebclient.pp');
     T:=P.Targets.AddUnit('fpjwt.pp');
     T:=P.Targets.AddUnit('fpoauth2.pp');
+      T.ResourceStrings:=true;
     T.Dependencies.AddUnit('fpwebclient');
     T.Dependencies.AddUnit('fpjwt');
     T:=P.Targets.AddUnit('fpoauth2ini.pp');

packages/fcl-web/src/base/fphttpclient.pp

@@ -1376,7 +1376,7 @@ procedure TFPCustomHTTPClient.HTTPMethod(const AMethod, AURL: String;
   Stream: TStream; const AllowedResponseCodes: array of Integer);
 
 Var
-  M,L,NL : String;
+  M,L,NL,RNL : String;
   RC : Integer;
   RR : Boolean; // Repeat request ?
 
@@ -1399,17 +1399,22 @@ begin
         if (RC>MaxRedirects) then
           Raise EHTTPClient.CreateFmt(SErrMaxRedirectsReached,[RC]);
         NL:=GetHeader(FResponseHeaders,'Location');
-        if Not Assigned(FOnRedirect) then
-          L:=NL
-        else
+        if Assigned(FOnRedirect) then
           FOnRedirect(Self,L,NL);
+        if (not IsAbsoluteURI(NL)) and ResolveRelativeURI(L,NL,RNL) then
+          NL:=RNL;
         if (RedirectForcesGET(FResponseStatusCode)) then
           M:='GET';
-        L:=NL;
         // Request has saved cookies in sentcookies.
-        FreeAndNil(FCookies);
-        FCookies:=FSentCookies;
-        FSentCookies:=Nil;
+        if ParseURI(L).Host=ParseURI(NL).Host then
+          FreeAndNil(FSentCookies)
+        else
+          begin
+          FreeAndNil(FCookies);
+          FCookies:=FSentCookies;
+          FSentCookies:=Nil;
+          end;
+        L:=NL;
         end;
       end;
     if (FResponseStatusCode=401) then

packages/fcl-web/src/base/fphttpstatus.pas

@@ -171,13 +171,13 @@ begin
       HTTPEncode(ARequest.Connection.Server.AdminMail) +
       '">' +
       HTTPEncode(name) +
-      '</a> Port ' + ARequest.ServerPort +
+      '</a> Port ' + IntToStr(ARequest.ServerPort) +
       '</address>'
   else
     Result := prefix + '<address>' + ARequest.Connection.Server.ServerBanner +
       ' Server at ' +
       ARequest.Connection.Server.AdminMail +
-      ' Port ' + ARequest.ServerPort +
+      ' Port ' + IntToStr(ARequest.ServerPort) +
       '</address>';
 end;
 

packages/fcl-web/src/base/httproute.pp

@@ -422,7 +422,7 @@ Var
 begin
   Result:=High(TRouteMethod);
   MN:=Uppercase(S);
-  While (Result>=Low(TRouteMethod)) and (RouteMethodNames[Result]<>MN) do
+  While (Result>Low(TRouteMethod)) and (RouteMethodNames[Result]<>MN) do
     Result:=Pred(Result);
   if Result=rmAll then Result:=rmUnknown;
 end;

packages/fpmkunit/src/fpmkunit.pp

@@ -19,6 +19,7 @@ unit fpmkunit;
 {$Mode objfpc}
 {$H+}
 {$inline on}
+{$MODESWITCH TYPEHELPERS}
 
 { For target or cpu dependent dependencies also add an overload where you
   can pass only a set of cpus. This is disabled for now because it creates
@@ -222,7 +223,7 @@ Const
     { nativent }( false, true,  false, false, false, false, false, false, false, false, false, false, false, false, false, false,  false,  false),
     { msdos }   ( false, false, false, false, false, false, false, false, false, false, false, false, false, true , false, false,  false,  false),
     { wii }     ( false, false, false, true , false, false, false, false, false, false, false, false, false, false, false, false,  false,  false),
-    { aros }    ( true,  false, false, false, false, false, true,  false, false, false, false, false, false, false, false, false,  false,  false),
+    { aros }    ( false, true,  false, false, false, false, true,  false, false, false, false, false, false, false, false, false,  false,  false),
     { dragonfly}( false, false, false, false, false, true,  false, false, false, false, false, false, false, false, false, false,  false,  false),
     { win16 }   ( false, false, false, false, false, false, false, false, false, false, false, false, false, true , false, false,  false,  false)
   );
@@ -1672,7 +1673,6 @@ ResourceString
   SWarnSkipPackageTargetProgress = '[%3.0f%%] Skipped package %s which has been disabled for target %s';
   SWarnSkipPackageTarget = 'Skipped package %s which has been disabled for target %s';
   SWarnInstallationPackagecomplete = 'Installation package %s for target %s succeeded';
-  SWarnCleanPackagecomplete = 'Clean of package %s completed';
   SWarnCanNotGetAccessRights = 'Warning: Failed to copy access-rights from file %s';
   SWarnCanNotSetAccessRights = 'Warning: Failed to copy access-rights to file %s';
   SWarnCanNotGetFileAge = 'Warning: Failed to get FileAge for %s';
@@ -1683,6 +1683,7 @@ ResourceString
   SWarnNoFCLProcessSupport= 'No FCL-Process support';
   SWarnRetryRemDirectory     = 'Failed to remove directory "%s". Retry after a short delay';
   SWarnCombinedPathAndUDir= 'Warning: Better do not combine the SearchPath and Global/Local-UnitDir parameters';
+  SWarnRemovedNonEmptyDirectory = 'Warning: Removed non empty directory "%s"';
 
   SInfoPackageAlreadyProcessed = 'Package %s is already processed';
   SInfoCompilingTarget    = 'Compiling target %s';
@@ -1692,6 +1693,7 @@ ResourceString
   SInfoUnInstallingPackage= 'Uninstalling package %s';
   SInfoArchivingPackage   = 'Archiving package %s in "%s"';
   SInfoCleaningPackage    = 'Cleaning package %s';
+  SInfoCleanPackagecomplete = 'Clean of package %s completed';
   SInfoManifestPackage    = 'Creating manifest for package %s';
   SInfoPkgListPackage    = 'Adding package %s to the package list';
   SInfoCopyingFile        = 'Copying file "%s" to "%s"';
@@ -1749,7 +1751,8 @@ ResourceString
   SDbgTargetHasToBeCompiled = 'At least one of the targets in the package has to be compiled.';
   SDbgDeletedFile           = 'Recursively deleted file "%s"';
   SDbgRemovedDirectory      = 'Recursively removed directory "%s"';
-
+  SDbgUnregisteredResource  = 'Adding resource file "%s", which is not registered.';
+  SDbgSearchingDir          = 'Searching dir  %s.';
 
   // Help messages for usage
   SValue              = 'Value';
@@ -1759,7 +1762,8 @@ ResourceString
   SHelpBuild          = 'Build all units in the package(s).';
   SHelpInstall        = 'Install all units in the package(s).';
   SHelpUnInstall      = 'Uninstall the package(s).';
-  SHelpClean          = 'Clean (remove) all units in the package(s).';
+  SHelpClean          = 'Clean (remove) all generated files in the package(s) for current CPU-OS target.';
+  SHelpDistclean      = 'Clean (remove) all generated files in the package(s) for all targets.';
   SHelpArchive        = 'Create archive (zip) with all units in the package(s).';
   SHelpHelp           = 'This message.';
   SHelpManifest       = 'Create a manifest suitable for import in repository.';
@@ -1781,6 +1785,7 @@ ResourceString
   SHelpConfig         = 'Use indicated config file when compiling.';
   SHelpOptions        = 'Pass extra options to the compiler.';
   SHelpVerbose        = 'Be verbose when working.';
+  SHelpDebug          = 'Add debug information when working.';
   SHelpInteractive    = 'Allow to interact with child processes';
   SHelpInstExamples   = 'Install the example-sources.';
   SHelpSkipCrossProgs = 'Skip programs when cross-compiling/installing';
@@ -2534,7 +2539,8 @@ procedure SearchFiles(AFileName, ASearchPathPrefix: string; Recursive: boolean;
   var
     Info : TSearchRec;
   begin
-    Writeln('Searching ',Searchdir);
+    if assigned(Installer) then
+      Installer.Log(VlDebug,Format(SDbgSearchingDir,[SearchDir]));
     if FindFirst(SearchDir+AllFilesMask,faAnyFile and faDirectory,Info)=0 then
     begin
       repeat
@@ -3735,6 +3741,7 @@ begin
   OB:=IncludeTrailingPathDelimiter(GetBinOutputDir(ACPU,AOS));
   OU:=IncludeTrailingPathDelimiter(GetUnitsOutputDir(ACPU,AOS));
   List.Add(GetUnitConfigOutputFilename(Defaults.CPU,Defaults.OS));
+  List.Add(ManifestFile);
   AddConditionalStrings(Self, List,CleanFiles,ACPU,AOS);
   For I:=0 to FTargets.Count-1 do
     FTargets.TargetItems[I].GetCleanFiles(List, OU, OB, ACPU, AOS);
@@ -5284,7 +5291,7 @@ begin
       Defaults.BuildMode:=bmBuildUnit
     else if CheckOption(I,'io','ignoreinvalidoption', true) then
       Defaults.IgnoreInvalidOptions:=true
-    else if CheckOption(I,'d','doc-folder') then
+    else if CheckOption(I,'df','doc-folder') then
       Defaults.FPDocOutputDir:=OptionArg(I)
     else if CheckOption(I,'fsp','fpunitsrcpath') then
       Defaults.FPUnitSourcePath:=OptionArg(I)
@@ -5340,6 +5347,7 @@ begin
   LogCmd('install',SHelpInstall);
   LogCmd('uninstall',SHelpUnInstall);
   LogCmd('clean',SHelpClean);
+  LogCmd('distclean',SHelpDistclean);
   LogCmd('archive',SHelpArchive);
   LogCmd('manifest',SHelpManifest);
   LogCmd('zipinstall',SHelpZipInstall);
@@ -5349,6 +5357,7 @@ begin
   LogOption('l','list-commands',SHelpList);
   LogOption('n','nofpccfg',SHelpNoFPCCfg);
   LogOption('v','verbose',SHelpVerbose);
+  LogOption('d','debug',SHelpDebug);
   LogOption('I','interactive',SHelpInteractive);
 {$ifdef HAS_UNIT_PROCESS}
   LogOption('e', 'useenv', sHelpUseEnvironment);
@@ -5371,7 +5380,7 @@ begin
   LogArgOption('r','compiler',SHelpCompiler);
   LogArgOption('f','config',SHelpConfig);
   LogArgOption('o','options',SHelpOptions);
-  LogArgOption('d', 'doc-folder', sHelpFpdocOutputDir);
+  LogArgOption('df', 'doc-folder', sHelpFpdocOutputDir);
   LogArgOption('fsp', 'fpunitsrcpath', sHelpFPUnitSrcPath);
   LogArgOption('zp', 'zipprefix', sHelpZipPrefix);
 {$ifndef NO_THREADING}
@@ -7932,14 +7941,20 @@ var
   AOS: TOS;
   DirectoryList : TStringList;
 begin
+  if not AllTargets and (not(Defaults.OS in APackage.OSes) or
+     not (Defaults.CPU in APackage.CPUs))  then
+    exit;
   Log(vlInfo,SInfoCleaningPackage,[APackage.Name]);
   try
     If (APackage.Directory<>'') then
       EnterDir(APackage.Directory);
     // Check for inherited options (packagevariants) from other packages
-    ResolveDependencies(APackage.Dependencies, (APackage.Collection as TPackages));
-    CheckDependencies(APackage, False);
-    APackage.SetDefaultPackageVariant;
+    if (Defaults.OS in APackage.OSes) and (Defaults.CPU in APackage.CPUs) then
+      begin
+        ResolveDependencies(APackage.Dependencies, (APackage.Collection as TPackages));
+        CheckDependencies(APackage, False);
+        APackage.SetDefaultPackageVariant;
+      end;
     DoBeforeClean(Apackage);
     AddPackageMacrosToDictionary(APackage, APackage.Dictionary);
     if AllTargets then
@@ -7951,7 +7966,8 @@ begin
           for ACPU:=low(TCpu) to high(TCpu) do if ACPU<>cpuNone then
             for AOS:=low(TOS) to high(TOS) do if AOS<>osNone then
               begin
-                if OSCPUSupported[AOS,ACPU] then
+                if OSCPUSupported[AOS,ACPU] and (AOS in APackage.OSes) and
+                   (ACPU in APackage.CPUs) then
                   begin
                     // First perform a normal clean, to be sure that all files
                     // which are not in the units- or bin-dir are cleaned. (like
@@ -7970,6 +7986,7 @@ begin
       Clean(APackage, Defaults.CPU, Defaults.OS);
     DoAfterClean(Apackage);
   Finally
+    log(vlInfo, SInfoCleanPackagecomplete, [APackage.Name]);
     If (APackage.Directory<>'') then
       EnterDir('');
   end;
@@ -7979,6 +7996,8 @@ procedure TBuildEngine.Clean(APackage: TPackage; ACPU: TCPU; AOS: TOS);
 Var
   List : TStringList;
   DirectoryList : TStringList;
+  RemainingList : TStrings;
+  i : longint;
 begin
   List:=TStringList.Create;
   try
@@ -8000,10 +8019,39 @@ begin
         CmdRemoveDirs(DirectoryList);
 
         DirectoryList.Clear;
-        if DirectoryExists(ExtractFileDir(APackage.GetBinOutputDir(ACPU,AOS))) then
-          DirectoryList.Add(ExtractFileDir(APackage.GetBinOutputDir(ACPU,AOS)));
-        if DirectoryExists(ExtractFileDir(APackage.GetUnitsOutputDir(ACPU,AOS))) then
-          DirectoryList.Add(ExtractFileDir(APackage.GetUnitsOutputDir(ACPU,AOS)));
+
+        { force directory removal for units and bin dir if it ends with /$fpc_target }
+        if DirectoryExists(APackage.GetBinOutputDir(ACPU,AOS)) and
+           (MakeTargetString(ACPU,AOS)=ExtractFileName(ExcludeTrailingPathDelimiter(APackage.GetBinOutputDir(ACPU,AOS)))) then
+          begin
+            Installer.Log(vlWarning,Format(SWarnRemovedNonEmptyDirectory,[APackage.Directory+APackage.GetBinOutputDir(ACPU,AOS)]));
+            DirectoryList.Add(APackage.GetBinOutputDir(ACPU,AOS));
+            RemainingList := TStringList.Create;
+            SearchFiles(AllFilesMask, APackage.GetBinOutputDir(ACPU,AOS), true, RemainingList);
+            for i:=0 to RemainingList.Count-1 do
+              Installer.log(vlDebug,format('File %s still present',[RemainingList[i]]));
+            RemainingList.Free;
+            CmdRemoveTrees(DirectoryList);
+            DirectoryList.Clear;
+          end;
+        if DirectoryExists(APackage.GetUnitsOutputDir(ACPU,AOS)) and
+           (MakeTargetString(ACPU,AOS)=ExtractFileName(ExcludeTrailingPathDelimiter(APackage.GetUnitsOutputDir(ACPU,AOS)))) then
+          begin
+            Installer.Log(vlWarning,Format(SWarnRemovedNonEmptyDirectory,[APackage.Directory+APackage.GetUnitsOutputDir(ACPU,AOS)]));
+            DirectoryList.Add(APackage.GetUnitsOutputDir(ACPU,AOS));
+            RemainingList := TStringList.Create;
+            SearchFiles(AllFilesMask, APackage.GetUnitsOutputDir(ACPU,AOS), true, RemainingList);
+            for i:=0 to RemainingList.Count-1 do
+              Installer.log(vlDebug,format('File %s still present',[RemainingList[i]]));
+            RemainingList.Free;
+            CmdRemoveTrees(DirectoryList);
+            DirectoryList.Clear;
+          end;
+        { Also remove units/ or bin/ directory if empty }
+        if IsDirectoryEmpty(ExtractFileDir(ExcludeTrailingPathDelimiter(APackage.GetBinOutputDir(ACPU,AOS)))) then
+          DirectoryList.Add(ExtractFileDir(ExcludeTrailingPathDelimiter(APackage.GetBinOutputDir(ACPU,AOS))));
+        if IsDirectoryEmpty(ExtractFileDir(ExcludeTrailingPathDelimiter(APackage.GetUnitsOutputDir(ACPU,AOS)))) then
+          DirectoryList.Add(ExtractFileDir(ExcludeTrailingPathDelimiter(APackage.GetUnitsOutputDir(ACPU,AOS))));
         CmdRemoveDirs(DirectoryList);
       finally
         DirectoryList.Free;
@@ -8350,7 +8398,6 @@ begin
       P:=Packages.PackageItems[i];
       If AllTargets or PackageOK(P) then
         Clean(P, AllTargets);
-      log(vlWarning, SWarnCleanPackagecomplete, [P.Name]);
     end;
   NotifyEventCollection.CallEvents(neaAfterClean, Self);
 end;
@@ -8694,7 +8741,20 @@ begin
         List.Add(APrefixU + RSJFileName)
       else
         List.Add(APrefixU + RSTFileName);
-    end;
+    end
+  else
+    begin
+      if FileExists(APrefixU + RSJFileName) then
+        begin
+          Installer.Log(VlDebug,Format(SDbgUnregisteredResource,[APrefixU + RSJFileName]));
+          List.Add(APrefixU + RSJFileName);
+        end
+      else if FileExists(APrefixU + RSTFileName) then
+        begin
+          Installer.Log(VlDebug,Format(SDbgUnregisteredResource,[APrefixU + RSTFileName]));
+          List.Add(APrefixU + RSTFileName);
+        end;
+     end;
   // Maybe add later ?  AddConditionalStrings(List,CleanFiles);
 end;
 
@@ -8726,7 +8786,20 @@ begin
         List.Add(APrefixU + RSJFileName)
       else
         List.Add(APrefixU + RSTFileName);
-    end;
+    end
+  else
+    begin
+      if FileExists(UnitsDir + RSJFileName) then
+        begin
+          Installer.Log(VlDebug,Format(SDbgUNregisteredResource,[APrefixU + RSJFileName]));
+          List.Add(APrefixU + RSJFileName);
+        end
+      else if FileExists(UnitsDir + RSTFileName) then
+        begin
+          Installer.Log(VlDebug,Format(SDbgUNregisteredResource,[APrefixU + RSTFileName]));
+          List.Add(APrefixU + RSTFileName);
+        end;
+     end;
 end;
 
 

packages/gdbint/fpmake.pp

@@ -134,11 +134,16 @@ end;
 procedure AfterCompile_gdbint(Sender: TObject);
 var
   L : TStrings;
+  P : TPackage;
 begin
   // Remove the generated gdbver.inc
   L := TStringList.Create;
+  P := Sender as TPackage;
   try
-    L.add(IncludeTrailingPathDelimiter(Installer.BuildEngine.StartDir)+'src/gdbver.inc');
+    if P.Directory<>'' then
+      L.add(IncludeTrailingPathDelimiter(P.Directory)+'src'+DirectorySeparator+'gdbver.inc')
+    else
+      L.add(IncludeTrailingPathDelimiter(Installer.BuildEngine.StartDir)+'src'+DirectorySeparator+'gdbver.inc');
     Installer.BuildEngine.CmdDeleteFiles(L);
   finally
     L.Free;

packages/ide/Makefile.fpc

@@ -1,8 +1,13 @@
 #
 #   Makefile.fpc for running fpmake
 #
+[package]
+name=ide
+version=3.3.1
+
 [require]
-packages=rtl fpmkunit
+packages=rtl fpmkunit rtl-extra fv chm regexpr
+packages_go32v2=graph
 
 [install]
 fpcpackage=y
@@ -67,7 +72,7 @@ ifdef GDBMI
 FPMAKE_OPT+=--GDBMI=1
 # If the rtl does not require libc, then
 # IDE compiled with GDBMI should be a static executable
-# and can thus be cross-compiled 
+# and can thus be cross-compiled
 ifeq ($(findstring $(OS_TARGET),aix beos darwin haiku solaris),)
 GDBMI_IS_STATIC=1
 endif

packages/mysql/fpmake.pp

@@ -120,6 +120,7 @@ begin
           AddInclude('mysql.inc');
         end;
     T:=P.Targets.AddUnit('mysql51dyn.pp');
+      T.ResourceStrings:=true;
       with T.Dependencies do
         begin
           AddInclude('mysql.inc');

packages/openssl/fpmake.pp

@@ -28,6 +28,7 @@ begin
 
     T:=P.Targets.AddUnit('openssl.pas');
     T:=P.Targets.AddUnit('fpopenssl.pp');
+      T.ResourceStrings:=true;
 
     P.ExamplePath.Add('examples');
     P.Targets.AddExampleProgram('test1.pas');

packages/pastojs/fpmake.pp

@@ -27,6 +27,7 @@ begin
     P.Dependencies.Add('fcl-js');
     P.Dependencies.Add('fcl-json');
     P.Dependencies.Add('fcl-passrc');
+    P.Dependencies.Add('fcl-process');
     Defaults.Options.Add('-Sc');
 
     P.Author := 'Free Pascal development team';
@@ -41,16 +42,32 @@ begin
 
     T:=P.Targets.AddUnit('pas2jsfiler.pp');
     T:=P.Targets.AddUnit('fppas2js.pp');
+      T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('fppjssrcmap.pp');
+    T:=P.Targets.AddUnit('pas2jsfs.pp');
+    T:=P.Targets.AddUnit('pas2jsutils.pp');
     T:=P.Targets.AddUnit('pas2jsfilecache.pp');
+      T.Dependencies.AddUnit('pas2jsfs');
+      T.Dependencies.AddUnit('pas2jsutils');
     T:=P.Targets.AddUnit('pas2jsfileutils.pp');
-    T.Dependencies.AddInclude('pas2js_defines.inc');
-    T.Dependencies.AddInclude('pas2jsfileutilsunix.inc',AllUnixOSes);
-    T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
+      T.Dependencies.AddInclude('pas2js_defines.inc');
+      T.Dependencies.AddInclude('pas2jsfileutilsunix.inc',AllUnixOSes);
+      T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
     T:=P.Targets.AddUnit('pas2jslogger.pp');
     T:=P.Targets.AddUnit('pas2jspparser.pp');
     T:=P.Targets.AddUnit('pas2jscompiler.pp');
+    T:=P.Targets.AddUnit('pas2jsfscompiler.pp');
+      T.Dependencies.AddUnit('pas2jscompiler');
+    T:=P.Targets.AddUnit('pas2jspcucompiler.pp');
+      T.Dependencies.AddUnit('pas2jsfscompiler');
+    T:=P.Targets.AddUnit('pas2jscompilercfg.pp');
+      T.Dependencies.AddUnit('pas2jscompiler');
+    T:=P.Targets.AddUnit('pas2jscompilerpp.pp');
+      T.Dependencies.AddUnit('pas2jscompiler');
     T:=P.Targets.AddUnit('pas2jslibcompiler.pp');
+      T.Dependencies.AddUnit('pas2jspcucompiler');
+      T.Dependencies.AddUnit('pas2jscompilercfg');
+      T.Dependencies.AddUnit('pas2jscompilerpp');
 {$ifndef ALLPACKAGES}
     Run;
     end;

packages/pastojs/src/fppas2js.pp

@@ -290,8 +290,8 @@ Works:
   - for key in JSObject do
   - for value in JSArray do
 - Assert(bool[,string])
-  - without sysutils: if(bool) throw string
-  - with sysutils: if(bool) throw pas.sysutils.EAssertionFailed.$create("Create",[string])
+  - without sysutils: if(!bool) throw string
+  - with sysutils: if(!bool) throw pas.sysutils.EAssertionFailed.$create("Create",[string])
 - Object checks:
   - Method call EInvalidCast, rtl.checkMethodCall
   - type cast to class-type and class-of-type, rtl.asExt, EInvalidCast
@@ -353,9 +353,12 @@ Works:
   - dispose, new
 - typecast byte(longword) -> value & $ff
 - typecast TJSFunction(func)
+- modeswitch OmitRTTI
+- debugger;
 
 ToDos:
 - do not rename property Date
+- cmd line param to set modeswitch
 - bug: DoIt(typeinfo(i))  where DoIt is in another unit and has TTypeInfo
 - bug:
   v:=a[0]  gives Local variable "a" is assigned but never used
@@ -1090,7 +1093,8 @@ const
     msNestedComment,
     msExternalClass,
     msArrayOperators,
-    msIgnoreAttributes];
+    msIgnoreAttributes,
+    msOmitRTTI];
 
   msAllPas2jsBoolSwitchesReadOnly = [
     bsLongStrings
@@ -1259,8 +1263,11 @@ type
     procedure ComputeBinaryExprRes(Bin: TBinaryExpr; out
       ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags;
       var LeftResolved, RightResolved: TPasResolverResult); override;
+    // built-in functions
     procedure BI_TypeInfo_OnGetCallResult(Proc: TResElDataBuiltInProc;
       Params: TParamsExpr; out ResolvedEl: TPasResolverResult); override;
+    function BI_Debugger_OnGetCallCompatibility(Proc: TResElDataBuiltInProc;
+      Expr: TPasExpr; RaiseOnError: boolean): integer; virtual;
   public
     constructor Create; reintroduce;
     destructor Destroy; override;
@@ -1610,6 +1617,7 @@ type
     Function CreateLiteralUndefined(El: TPasElement): TJSLiteral; virtual;
     Function CreateLiteralCustomValue(El: TPasElement; const s: TJSString): TJSLiteral; virtual;
     Function CreateSetLiteralElement(Expr: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function CreateUnaryNot(El: TJSElement; Src: TPasElement): TJSUnaryNotExpression; virtual;
     Procedure ConvertCharLiteralToInt(Lit: TJSLiteral; ErrorEl: TPasElement; AContext: TConvertContext); virtual;
     Function ClonePrimaryExpression(El: TJSPrimaryExpression; Src: TPasElement): TJSPrimaryExpression;
     // simple JS expressions
@@ -1745,6 +1753,7 @@ type
     Function ConvertBuiltIn_New(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_Dispose(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBuiltIn_Default(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertBuiltIn_Debugger(El: TPasExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertRecordValues(El: TRecordValues; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertSelfExpression(El: TSelfExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertBinaryExpression(El: TBinaryExpr; AContext: TConvertContext): TJSElement; virtual;
@@ -2045,10 +2054,40 @@ end;
 
 function TPas2jsPasScanner.HandleInclude(const Param: String): TToken;
 
-  procedure SetStr(const s: string);
+  procedure SetStr(s: string);
+  var
+    i: Integer;
+    h: String;
   begin
     Result:=tkString;
-    SetCurTokenString(''''+s+'''');
+    if s='' then
+      s:=''''''
+    else
+      for i:=length(s) downto 1 do
+        case s[i] of
+        #0..#31,#127:
+          begin
+          h:='#'+IntToStr(ord(s[i]));
+          if i>1 then h:=''''+h;
+          if (i<length(s)) and (s[i+1]<>'#') then
+            h:=h+'''';
+          s:=LeftStr(s,i-1)+h+copy(s,i+1,length(s));
+          end;
+        else
+          if i=length(s) then
+            s:=s+'''';
+          if s[i]='''' then
+            Insert('''',s,i);
+          if i=1 then
+            s:=''''+s;
+        end;
+    SetCurTokenString(s);
+  end;
+
+  procedure SetInteger(const i: TMaxPrecInt);
+  begin
+    Result:=tkNumber;
+    SetCurTokenString(IntToStr(i));
   end;
 
 var
@@ -2058,15 +2097,31 @@ var
 begin
   if (Param<>'') and (Param[1]='%') then
   begin
+    if (length(Param)<3) or (Param[length(Param)]<>'%') then
+      begin
+      SetStr('');
+      DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,SWarnIllegalCompilerDirectiveX,
+        ['$i '+Param]);
+      exit;
+      end;
+    if length(Param)>255 then
+      begin
+      SetStr('');
+      DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,SWarnIllegalCompilerDirectiveX,
+        ['$i '+copy(Param,1,255)+'...']);
+      exit;
+      end;
     case lowercase(Param) of
     '%date%':
       begin
+        // 'Y/M/D'
         DecodeDate(Now,Year,Month,Day);
         SetStr(IntToStr(Year)+'/'+IntToStr(Month)+'/'+IntToStr(Day));
         exit;
       end;
     '%time%':
       begin
+        // 'hh:mm:ss'
         DecodeTime(Now,Hour,Minute,Second,MilliSecond);
         SetStr(Format('%2d:%2d:%2d',[Hour,Minute,Second]));
         exit;
@@ -2087,11 +2142,21 @@ begin
         SetStr(CompilerVersion);
         exit;
       end;
+    '%file%':
+      begin
+        SetStr(CurFilename);
+        exit;
+      end;
     '%line%':
       begin
         SetStr(IntToStr(CurRow));
         exit;
       end;
+    '%linenum%':
+      begin
+        SetInteger(CurRow);
+        exit;
+      end;
     '%currentroutine%':
       begin
         if Resolver<>nil then
@@ -2109,8 +2174,8 @@ begin
         exit;
       end;
     else
-      DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,SWarnIllegalCompilerDirectiveX,
-        ['$i '+Param]);
+      SetStr(GetEnvironmentVariable(copy(Param,2,length(Param)-2)));
+      exit;
     end;
   end;
   Result:=inherited HandleInclude(Param);
@@ -4228,6 +4293,16 @@ begin
   if Proc=nil then ;
 end;
 
+function TPas2JSResolver.BI_Debugger_OnGetCallCompatibility(
+  Proc: TResElDataBuiltInProc; Expr: TPasExpr; RaiseOnError: boolean): integer;
+// debugger;
+begin
+  if Expr is TParamsExpr then
+    Result:=CheckBuiltInMaxParamCount(Proc,TParamsExpr(Expr),0,RaiseOnError)
+  else
+    Result:=cExact;
+end;
+
 constructor TPas2JSResolver.Create;
 var
   bt: TPas2jsBaseType;
@@ -4318,6 +4393,9 @@ begin
     AddBaseType(Pas2JSBuiltInNames[pbitnUIntDouble],btUIntDouble);
   if btIntDouble in TheBaseTypes then
     AddBaseType(Pas2JSBuiltInNames[pbitnIntDouble],btIntDouble);
+  AddBuiltInProc('Debugger','procedure Debugger',
+      @BI_Debugger_OnGetCallCompatibility,nil,
+      nil,nil,bfCustom,[bipfCanBeStatement]);
 end;
 
 function TPas2JSResolver.CheckTypeCastRes(const FromResolved,
@@ -5801,10 +5879,12 @@ begin
         BitwiseNot:=ResolvedOp.BaseType in btAllJSInteger;
         end;
       if BitwiseNot then
-        U:=TJSUnaryInvExpression(CreateElement(TJSUnaryInvExpression,El))
+        begin
+        U:=TJSUnaryInvExpression(CreateElement(TJSUnaryInvExpression,El));
+        U.A:=E;
+        end
       else
-        U:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
-      U.A:=E;
+        U:=CreateUnaryNot(E,El);
       end;
     eopAddress:
       begin
@@ -6273,7 +6353,6 @@ function TPasToJSConverter.ConvertBinaryExpressionRes(El: TBinaryExpr;
   function CreateEqualCallback: TJSElement;
   var
     Call: TJSCallExpression;
-    NotEl: TJSUnaryNotExpression;
   begin
     // convert "proctypeA = proctypeB" to "rtl.eqCallback(proctypeA,proctypeB)"
     Call:=CreateCallExpression(El);
@@ -6285,9 +6364,7 @@ function TPasToJSConverter.ConvertBinaryExpressionRes(El: TBinaryExpr;
     if El.OpCode=eopNotEqual then
       begin
       // convert "proctypeA <> proctypeB" to "!rtl.eqCallback(proctypeA,proctypeB)"
-      NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
-      NotEl.A:=Call;
-      Result:=NotEl;
+      Result:=CreateUnaryNot(Call,El);
       end
     else
       Result:=Call;
@@ -6308,7 +6385,6 @@ var
   FunName: String;
   Call: TJSCallExpression;
   DotExpr: TJSDotMemberExpression;
-  NotEl: TJSUnaryNotExpression;
   InOp: TJSRelationalExpressionIn;
   TypeEl, LeftTypeEl, RightTypeEl: TPasType;
   SNE: TJSEqualityExpressionSNE;
@@ -6631,11 +6707,7 @@ begin
             Call.AddArg(A);
             A:=nil;
             if El.OpCode=eopNotEqual then
-              begin
-              NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
-              NotEl.A:=Call;
-              Result:=NotEl;
-              end
+              Result:=CreateUnaryNot(Call,El)
             else
               Result:=Call;
             exit;
@@ -6671,9 +6743,7 @@ begin
             if El.OpCode=eopNotEqual then
               begin
               // convert "recordA <> recordB" to "!recordA.$equal(recordB)"
-              NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
-              NotEl.A:=Call;
-              Result:=NotEl;
+              Result:=CreateUnaryNot(Call,El);
               end
             else
               Result:=Call;
@@ -6694,11 +6764,7 @@ begin
             Call.AddArg(B);
             B:=nil;
             if El.OpCode=eopNotEqual then
-              begin
-              NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
-              NotEl.A:=Call;
-              Result:=NotEl;
-              end
+              Result:=CreateUnaryNot(Call,El)
             else
               Result:=Call;
             exit;
@@ -6718,11 +6784,7 @@ begin
           Call.AddArg(B);
           B:=nil;
           if El.OpCode=eopNotEqual then
-            begin
-            NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
-            NotEl.A:=Call;
-            Result:=NotEl;
-            end
+            Result:=CreateUnaryNot(Call,El)
           else
             Result:=Call;
           exit;
@@ -6757,11 +6819,7 @@ begin
               Call.AddArg(A);
               A:=nil;
               if El.OpCode=eopNotEqual then
-                begin
-                NotEl:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El));
-                NotEl.A:=Call;
-                Result:=NotEl;
-                end
+                Result:=CreateUnaryNot(Call,El)
               else
                 Result:=Call;
               exit;
@@ -7281,6 +7339,12 @@ begin
       bfBreak: Result:=ConvertBuiltInBreak(El,AContext);
       bfContinue: Result:=ConvertBuiltInContinue(El,AContext);
       bfExit: Result:=ConvertBuiltIn_Exit(El,AContext);
+      bfCustom:
+        case BuiltInProc.Element.Name of
+        'Debugger': Result:=ConvertBuiltIn_Debugger(El,AContext);
+        else
+          RaiseNotSupported(El,AContext,20181126102554,'built in custom proc '+BuiltInProc.Element.Name);
+        end
     else
       RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
     end;
@@ -8380,6 +8444,12 @@ begin
             if Result=nil then exit;
             end;
           bfDefault: Result:=ConvertBuiltIn_Default(El,AContext);
+          bfCustom:
+            case BuiltInProc.Element.Name of
+            'Debugger': Result:=ConvertBuiltIn_Debugger(El,AContext);
+            else
+              RaiseNotSupported(El,AContext,20181126101801,'built in custom proc '+BuiltInProc.Element.Name);
+            end;
         else
           RaiseNotSupported(El,AContext,20161130164955,'built in proc '+ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
         end;
@@ -10669,7 +10739,8 @@ begin
   IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
   try
     PosEl:=El.Params[0];
-    IfSt.Cond:=ConvertExpression(El.Params[0],AContext);
+    IfSt.Cond:=CreateUnaryNot(ConvertExpression(PosEl,AContext),PosEl);
+
     ThrowSt:=TJSThrowStatement(CreateElement(TJSThrowStatement,PosEl));
     IfSt.BTrue:=ThrowSt;
 
@@ -10970,6 +11041,13 @@ begin
     AContext.Resolver.GetResolverResultDescription(ResolvedEl)],Param);
 end;
 
+function TPasToJSConverter.ConvertBuiltIn_Debugger(El: TPasExpr;
+  AContext: TConvertContext): TJSElement;
+begin
+  Result:=CreateLiteralCustomValue(El,'debugger');
+  if AContext=nil then ;
+end;
+
 function TPasToJSConverter.ConvertRecordValues(El: TRecordValues;
   AContext: TConvertContext): TJSElement;
 var
@@ -11385,8 +11463,8 @@ Var
       IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,ProcBody));
       AddFunctionFinallySt(IfSt,ProcBody,FuncContext);
       // !$ok
-      IfSt.Cond:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,ProcBody));
-      TJSUnaryNotExpression(IfSt.Cond).A:=CreatePrimitiveDotExpr(FBuiltInNames[pbivnProcOk],ProcBody);
+      IfSt.Cond:=CreateUnaryNot(
+          CreatePrimitiveDotExpr(FBuiltInNames[pbivnProcOk],ProcBody),ProcBody);
       // rtl._Release(Result)
       Call:=CreateCallExpression(ProcBody);
       IfSt.BTrue:=Call;
@@ -16017,7 +16095,6 @@ function TPasToJSConverter.ConvertRepeatStatement(El: TPasImplRepeatUntil;
 // do{implblock}while(!untilcondition);
 var
   C : TJSElement;
-  N : TJSUnaryNotExpression;
   W : TJSDoWhileStatement;
   B : TJSElement;
 begin
@@ -16037,11 +16114,7 @@ begin
       B:=nil;
       end
     else
-      begin
-      N:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,El.ConditionExpr));
-      N.A:=C;
-      C:=N;
-      end;
+      C:=CreateUnaryNot(C,El.ConditionExpr);
     B:=ConvertImplBlockElements(El,AContext,false);
     W:=TJSDoWhileStatement(CreateElement(TJSDoWhileStatement,El));
     W.Cond:=C;
@@ -17559,6 +17632,13 @@ begin
     end;
 end;
 
+function TPasToJSConverter.CreateUnaryNot(El: TJSElement; Src: TPasElement
+  ): TJSUnaryNotExpression;
+begin
+  Result:=TJSUnaryNotExpression(CreateElement(TJSUnaryNotExpression,Src));
+  Result.A:=El;
+end;
+
 procedure TPasToJSConverter.ConvertCharLiteralToInt(Lit: TJSLiteral;
   ErrorEl: TPasElement; AContext: TConvertContext);
 var

packages/pastojs/src/pas2js_defines.inc

@@ -19,6 +19,11 @@
   {$DEFINE UTF8_RTL}
   {$DEFINE HasStdErr}
   {$DEFINE HasPas2jsFiler}
+  {$DEFINE HASFILESYSTEM}
+{$ENDIF}
+
+{$IFDEF NODEJS}
+{$DEFINE HASFILESYSTEM}
 {$ENDIF}
 
 

packages/pastojs/src/pas2jscompilercfg.pp

@@ -0,0 +1,96 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018  Michael Van Canneyt
+
+    Pascal to Javascript converter class.
+
+    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.
+
+ **********************************************************************
+
+  Abstract:
+    Config file handling for compiler, depends on filesystem.
+}
+unit pas2jscompilercfg;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, pas2JSCompiler, pas2jsfs;
+
+Type
+  TPas2JSFileConfigSupport = Class(TPas2JSConfigSupport)
+    function FindDefaultConfig: String; override;
+    function GetReader(aFileName: string): TSourceLineReader; override;
+  end;
+
+implementation
+
+uses pas2jsfileutils;
+
+function TPas2JSFileConfigSupport.GetReader(aFileName: string): TSourceLineReader;
+
+Var
+  CacheFile: TPas2jsFile;
+
+begin
+  CacheFile:=Compiler.FS.LoadFile(aFilename);
+  Result:=CacheFile.CreateLineReader(true);
+end;
+
+Function TPas2JSFileConfigSupport.FindDefaultConfig : String;
+
+  function TryConfig(aFilename: string): boolean;
+  begin
+    Result:=false;
+    if aFilename='' then exit;
+    aFilename:=ExpandFileName(aFilename);
+    if Compiler.ShowDebug or Compiler.ShowTriedUsedFiles then
+      Compiler.Log.LogMsgIgnoreFilter(nConfigFileSearch,[aFilename]);
+    if not Compiler.FS.FileExists(aFilename) then exit;
+    FindDefaultConfig:=aFilename;
+    Result:=true;
+  end;
+
+var
+  aFilename: String;
+
+begin
+  Result:='';
+  // first try HOME directory
+  aFilename:=ChompPathDelim(GetEnvironmentVariablePJ('HOME'));
+  if aFilename<>'' then
+    begin
+    aFilename:=aFilename+PathDelim{$IFDEF UNIX}+'.'{$ENDIF}+DefaultConfigFile;
+    if TryConfig(aFileName) then
+      exit;
+    end;
+
+  // then try compiler directory
+  if (Compiler.CompilerExe<>'') then
+  begin
+    aFilename:=ExtractFilePath(Compiler.CompilerExe);
+    if aFilename<>'' then
+    begin
+      aFilename:=IncludeTrailingPathDelimiter(aFilename)+DefaultConfigFile;
+      if TryConfig(aFilename) then
+        exit;
+    end;
+  end;
+
+  // finally try global directory
+  {$IFDEF Unix}
+  if TryConfig('/etc/'+DefaultConfigFile) then
+    exit;
+  {$ENDIF}
+end;
+
+end.
+

packages/pastojs/src/pas2jscompilerpp.pp

@@ -0,0 +1,262 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2018  Michael Van Canneyt
+
+    Pascal to Javascript converter class.
+
+    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.
+
+ **********************************************************************
+
+  Abstract:
+    Pas2JS compiler Preprocessor support. Can depend on filesystem.
+}
+unit pas2jscompilerpp;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, pas2jscompiler, jswriter, FPPJSSrcMap, contnrs;
+
+Type
+
+  { TPas2JSFSPostProcessorSupport }
+
+  TPas2JSFSPostProcessorSupport = Class(TPas2JSPostProcessorSupport)
+  Private
+    FPostProcs: TObjectList;
+    function CmdListAsStr(CmdList: TStrings): string;
+  Public
+    Constructor Create(aCompiler: TPas2JSCompiler); override;
+    Destructor Destroy; override;
+    Procedure Clear; override;
+    Procedure WriteUsedTools; override;
+    Procedure AddPostProcessor(const Cmd: String); override;
+    Procedure CallPostProcessors(const JSFileName: String; aWriter: TPas2JSMapper); override;
+    function Execute(const JSFilename: String; Cmd: TStringList; JS: TJSWriterString): TJSWriterString;
+  end;
+
+implementation
+
+uses process, pas2jslogger, pas2jsutils, pas2jsfileutils;
+
+function TPas2JSFSPostProcessorSupport.CmdListAsStr(CmdList: TStrings): string;
+var
+  i: Integer;
+begin
+  Result:='';
+  for i:=0 to CmdList.Count-1 do
+  begin
+    if Result<>'' then Result+=' ';
+    Result+=QuoteStr(CmdList[i]);
+  end;
+end;
+
+constructor TPas2JSFSPostProcessorSupport.Create(aCompiler: TPas2JSCompiler);
+begin
+  inherited Create(aCompiler);
+  FPostProcs:=TObjectList.Create; // Owns objects
+end;
+
+destructor TPas2JSFSPostProcessorSupport.Destroy;
+begin
+  FreeAndNil(FPostProcs);
+  inherited Destroy;
+end;
+
+procedure TPas2JSFSPostProcessorSupport.Clear;
+begin
+  FPostProcs.Clear;
+end;
+
+procedure TPas2JSFSPostProcessorSupport.WriteUsedTools;
+
+Var
+  I : integer;
+  PostProc : TStringList;
+
+begin
+  // post processors
+  for i:=0 to FPostProcs.Count-1 do
+  begin
+    PostProc:=TStringList(FPostProcs[i]);
+    Compiler.Log.LogMsgIgnoreFilter(nPostProcessorInfoX,[CmdListAsStr(PostProc)]);
+  end;
+end;
+
+procedure TPas2JSFSPostProcessorSupport.AddPostProcessor(const Cmd: String);
+
+Var
+  PostProc : TStringList;
+  S : String;
+
+begin
+  PostProc:=TStringList.Create;
+  FPostProcs.Add(PostProc);
+  SplitCmdLineParams(Cmd,PostProc);
+  if PostProc.Count<1 then
+    Compiler.ParamFatal('-Jpcmd executable missing');
+  // check executable
+  S:=Compiler.FS.ExpandExecutable(PostProc[0]);
+  if (S='') then
+    Compiler.ParamFatal('-Jpcmd executable "'+S+'" not found');
+  PostProc[0]:=S;
+end;
+
+procedure TPas2JSFSPostProcessorSupport.CallPostProcessors(const JSFileName: String; aWriter: TPas2JSMapper);
+
+var
+  i: Integer;
+  JS, OrigJS: TJSWriterString;
+
+begin
+  if FPostProcs.Count=0 then exit;
+  OrigJS:=aWriter.AsString;
+  JS:=OrigJS;
+  for i:=0 to FPostProcs.Count-1 do
+    JS:=Execute(JSFilename,TStringList(FPostProcs[i]),JS);
+  if JS<>OrigJS then
+  begin
+    aWriter.AsString:=JS;
+    if aWriter.SrcMap<>nil then
+      aWriter.SrcMap.Clear;
+  end;
+
+end;
+
+function TPas2JSFSPostProcessorSupport.Execute(const JSFilename: String; Cmd: TStringList; JS: TJSWriterString): TJSWriterString;
+
+const
+  BufSize = 65536;
+var
+  Exe: String;
+  TheProcess: TProcess;
+  WrittenBytes, ReadBytes: LongInt;
+  Buf, s, ErrBuf: string;
+  OutputChunks: TStringList;
+  CurExitCode, i, InPos: Integer;
+begin
+  Result:='';
+  Buf:='';
+  Exe:=Cmd[0];
+  if Compiler.ShowDebug or Compiler.ShowUsedTools then
+    Compiler.Log.LogMsgIgnoreFilter(nPostProcessorRunX,[QuoteStr(JSFilename)+' | '+CmdListAsStr(Cmd)]);
+  if Compiler.FS.DirectoryExists(Exe) then
+    raise EFOpenError.Create('post processor "'+Exe+'" is a directory');
+  if not FileIsExecutable(Exe) then
+    raise EFOpenError.Create('post processor "'+Exe+'" is a not executable');
+  try
+    TheProcess := TProcess.Create(nil);
+    OutputChunks:=TStringList.Create;
+    try
+      TheProcess.Executable := Exe;
+      for i:=1 to Cmd.Count-1 do
+        TheProcess.Parameters.Add(Cmd[i]);
+      TheProcess.Options:= [poUsePipes];
+      TheProcess.ShowWindow := swoHide;
+      //TheProcess.CurrentDirectory:=WorkingDirectory;
+      TheProcess.Execute;
+      ErrBuf:='';
+      SetLength(Buf,BufSize);
+      InPos:=1;
+      repeat
+        // read stderr and log immediately as warnings
+        repeat
+          if TheProcess.Stderr.NumBytesAvailable=0 then break;
+          ReadBytes:=TheProcess.Stderr.Read(Buf[1],BufSize);
+          if ReadBytes=0 then break;
+          ErrBuf+=LeftStr(Buf,ReadBytes);
+          repeat
+            i:=1;
+            while (i<=length(ErrBuf)) and (i<128) and not (ErrBuf[i] in [#10,#13]) do
+              inc(i);
+            if i>length(ErrBuf) then break;
+            Compiler.Log.LogMsg(nPostProcessorWarnX,[LeftStr(ErrBuf,i)]);
+            if (i<=length(ErrBuf)) and (ErrBuf[i] in [#10,#13]) then
+            begin
+              // skip linebreak
+              if (i<length(ErrBuf)) and (ErrBuf[i+1] in [#10,#13])
+                  and (ErrBuf[i]<>ErrBuf[i+1]) then
+                inc(i,2)
+              else
+                inc(i);
+            end;
+            Delete(ErrBuf,1,i-1);
+          until false;
+        until false;
+        // write to stdin
+        if InPos<length(JS) then
+        begin
+          i:=length(JS)-InPos+1;
+          if i>BufSize then i:=BufSize;
+          WrittenBytes:=TheProcess.Input.Write(JS[InPos],i);
+          inc(InPos,WrittenBytes);
+          if InPos>length(JS) then
+            TheProcess.CloseInput;
+        end else
+          WrittenBytes:=0;
+        // read stdout
+        if TheProcess.Output.NumBytesAvailable=0 then
+          ReadBytes:=0
+        else
+          ReadBytes:=TheProcess.Output.Read(Buf[1],BufSize);
+        if ReadBytes>0 then
+          OutputChunks.Add(LeftStr(Buf,ReadBytes));
+
+        if (WrittenBytes=0) and (ReadBytes=0) then
+        begin
+          if not TheProcess.Running then break;
+          Sleep(10); // give tool some time
+        end;
+      until false;
+      TheProcess.WaitOnExit;
+      CurExitCode:=TheProcess.ExitCode;
+
+      // concatenate output chunks
+      ReadBytes:=0;
+      for i:=0 to OutputChunks.Count-1 do
+        inc(ReadBytes,length(OutputChunks[i]));
+      SetLength(Result,ReadBytes);
+      ReadBytes:=0;
+      for i:=0 to OutputChunks.Count-1 do
+      begin
+        s:=OutputChunks[i];
+        if s='' then continue;
+        System.Move(s[1],Result[ReadBytes+1],length(s));
+        inc(ReadBytes,length(s));
+      end;
+    finally
+      OutputChunks.Free;
+      TheProcess.Free;
+    end;
+  except
+    on E: Exception do begin
+      if Compiler.ShowDebug then
+        Compiler.Log.LogExceptionBackTrace(E);
+      Compiler.Log.LogPlain('Error: '+E.Message);
+      Compiler.Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]);
+      Compiler.Terminate(ExitCodeToolError);
+    end
+    {$IFDEF Pas2js}
+    else HandleJSException('[20181118170506] TPas2jsCompiler.CallPostProcessor Cmd: '+CmdListAsStr(Cmd),JSExceptValue,true);
+    {$ENDIF}
+  end;
+  if CurExitCode<>0 then
+  begin
+    Compiler.Log.LogMsg(nPostProcessorFailX,[CmdListAsStr(Cmd)]);
+    Compiler.Terminate(ExitCodeToolError);
+  end;
+  if Compiler.ShowDebug or Compiler.ShowUsedTools then
+    Compiler.Log.LogMsgIgnoreFilter(nPostProcessorFinished,[]);
+end;
+
+
+end.
+

packages/pastojs/src/pas2jsfiler.pp

@@ -167,7 +167,8 @@ const
     'ArrayOperators',
     'ExternalClass',
     'PrefixedAttributes',
-    'IgnoreAttributes'
+    'IgnoreAttributes',
+    'OmitRTTI'
     );
 
   PCUDefaultBoolSwitches: TBoolSwitches = [
@@ -294,7 +295,8 @@ const
     'List',
     'Inherited',
     'Self',
-    'Specialize');
+    'Specialize',
+    'Procedure');
 
   PCUExprOpCodeNames: array[TExprOpCode] of string = (
     'None',

packages/pastojs/src/pas2jsfileutils.pp

@@ -58,6 +58,7 @@ function ResolveSymLinks(const Filename: string;
                  {%H-}ExceptionOnError: boolean): string; // if a link is broken returns ''
 function MatchGlobbing(Mask, Name: string): boolean;
 function FileIsWritable(const AFilename: string): boolean;
+function FileIsExecutable(const AFilename: string): boolean;
 
 function GetEnvironmentVariableCountPJ: Integer;
 function GetEnvironmentStringPJ(Index: Integer): string;
@@ -729,6 +730,7 @@ begin
   if Position<=length(List) then inc(Position); // skip Delimiter
 end;
 
+
 procedure IncreaseChangeStamp(var Stamp: TChangeStamp);
 begin
   if Stamp<High(TChangeStamp) then

packages/pastojs/src/pas2jsfileutilsnodejs.inc

@@ -152,6 +152,16 @@ begin
   Result:=true;
 end;
 
+function FileIsExecutable(const AFilename: string): boolean;
+begin
+  try
+    NJS_FS.accessSync(AFilename,X_OK);
+  except
+    exit(false);
+  end;
+  Result:=true;
+end;
+
 function GetEnvironmentVariableCountPJ: Integer;
 begin
   Result:=GetEnvironmentVariableCount;

packages/pastojs/src/pas2jsfileutilsunix.inc

@@ -148,6 +148,15 @@ begin
   Result := BaseUnix.FpAccess(AFilename, BaseUnix.W_OK) = 0;
 end;
 
+function FileIsExecutable(const AFilename: string): boolean;
+var
+  Info : Stat;
+begin
+  // first check AFilename is not a directory and then check if executable
+  Result:= (FpStat(AFilename,info{%H-})<>-1) and FPS_ISREG(info.st_mode) and
+           (BaseUnix.FpAccess(AFilename,BaseUnix.X_OK)=0);
+end;
+
 function GetEnvironmentVariableCountPJ: Integer;
 begin
   Result:=GetEnvironmentVariableCount;

packages/pastojs/src/pas2jsfileutilswin.inc

@@ -421,6 +421,11 @@ begin
   Result:=((FileGetAttrUTF8(AFilename) and faReadOnly) = 0);
 end;
 
+function FileIsExecutable(const AFilename: string): boolean;
+begin
+  Result:=FileExists(AFilename);
+end;
+
 function GetEnvironmentVariableCountPJ: Integer;
 var
   hp,p : PWideChar;