* synchronize with trunk

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

.gitattributes

@@ -1185,6 +1185,7 @@ packages/arosunits/src/layers.pas svneol=native#text/plain
 packages/arosunits/src/locale.pas svneol=native#text/pascal
 packages/arosunits/src/longarray.pas svneol=native#text/plain
 packages/arosunits/src/mui.pas svneol=native#text/plain
+packages/arosunits/src/serial.pas svneol=native#text/plain
 packages/arosunits/src/tagsarray.pas svneol=native#text/plain
 packages/arosunits/src/timer.pas svneol=native#text/plain
 packages/arosunits/src/utility.pas svneol=native#text/plain
@@ -6290,6 +6291,7 @@ packages/morphunits/src/keymap.pas svneol=native#text/plain
 packages/morphunits/src/layers.pas svneol=native#text/plain
 packages/morphunits/src/locale.pas svneol=native#text/pascal
 packages/morphunits/src/mui.pas svneol=native#text/plain
+packages/morphunits/src/serial.pas svneol=native#text/plain
 packages/morphunits/src/timer.pas svneol=native#text/plain
 packages/morphunits/src/tinygl.pas svneol=native#text/plain
 packages/morphunits/src/utility.pas svneol=native#text/plain
@@ -6777,6 +6779,7 @@ packages/os4units/src/layers.pas svneol=native#text/pascal
 packages/os4units/src/locale.pas svneol=native#text/pascal
 packages/os4units/src/mui.pas svneol=native#text/pascal
 packages/os4units/src/picasso96api.pas svneol=native#text/pascal
+packages/os4units/src/serial.pas svneol=native#text/plain
 packages/os4units/src/timer.pas svneol=native#text/pascal
 packages/os4units/src/utility.pas svneol=native#text/pascal
 packages/os4units/src/workbench.pas svneol=native#text/pascal
@@ -7472,7 +7475,6 @@ packages/rtl-extra/src/amiga/printer.pp svneol=native#text/plain
 packages/rtl-extra/src/amiga/sockets.pp svneol=native#text/plain
 packages/rtl-extra/src/android/clocale.pp svneol=native#text/plain
 packages/rtl-extra/src/android/osdefs.inc svneol=native#text/plain
-packages/rtl-extra/src/android/unixsock.inc svneol=native#text/plain
 packages/rtl-extra/src/android/unxsockh.inc svneol=native#text/plain
 packages/rtl-extra/src/aros/sockets.pp svneol=native#text/plain
 packages/rtl-extra/src/beos/osdefs.inc svneol=native#text/plain
@@ -11110,6 +11112,7 @@ tests/tbf/tb0262.pp svneol=native#text/pascal
 tests/tbf/tb0263.pp svneol=native#text/pascal
 tests/tbf/tb0264.pp svneol=native#text/pascal
 tests/tbf/tb0265.pp svneol=native#text/pascal
+tests/tbf/tb0588.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain
@@ -11701,7 +11704,6 @@ tests/tbs/tb0584.pp svneol=native#text/pascal
 tests/tbs/tb0585.pp svneol=native#text/pascal
 tests/tbs/tb0586.pp svneol=native#text/pascal
 tests/tbs/tb0587.pp svneol=native#text/plain
-tests/tbs/tb0588.pp svneol=native#text/pascal
 tests/tbs/tb0589.pp svneol=native#text/pascal
 tests/tbs/tb0590.pp svneol=native#text/pascal
 tests/tbs/tb0591.pp svneol=native#text/pascal
@@ -14165,6 +14167,7 @@ tests/test/units/classes/tbytesstreamtest.pp svneol=native#text/pascal
 tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
 tests/test/units/classes/tsetstream.pp svneol=native#text/plain
 tests/test/units/classes/tstringlistexchange.pp svneol=native#text/pascal
+tests/test/units/classes/ttbits.pp svneol=native#text/pascal
 tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
 tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
 tests/test/units/crt/tcrt.pp svneol=native#text/plain
@@ -16429,6 +16432,7 @@ tests/webtbs/tw3356.pp svneol=native#text/plain
 tests/webtbs/tw33563.pp svneol=native#text/pascal
 tests/webtbs/tw33564.pp svneol=native#text/pascal
 tests/webtbs/tw3360.pp svneol=native#text/plain
+tests/webtbs/tw33607.pp svneol=native#text/plain
 tests/webtbs/tw33635.pp svneol=native#text/pascal
 tests/webtbs/tw3364.pp svneol=native#text/plain
 tests/webtbs/tw3366.pp svneol=native#text/plain

compiler/aarch64/hlcgcpu.pas

@@ -64,7 +64,10 @@ implementation
     begin
       tocgsize:=def_cgsize(tosize);
       if (sreg.startbit<>0) or
-         not(sreg.bitlen in [32,64]) then
+         not((sreg.subsetregsize in [OS_32,OS_S32]) and
+             (sreg.bitlen=32)) or
+         not((sreg.subsetregsize in [OS_64,OS_S64]) and
+             (sreg.bitlen=64)) then
         begin
           if is_signed(subsetsize) then
             op:=A_SBFX

compiler/dbgdwarf.pas

@@ -2265,7 +2265,7 @@ implementation
 
       var
         procendlabel   : tasmlabel;
-        procentry      : string;
+        procentry,s    : string;
         cc             : Tdwarf_calling_convention;
         st             : tsymtable;
         vmtoffset      : pint;
@@ -2318,6 +2318,19 @@ implementation
           append_entry(DW_TAG_subprogram,true,
             [DW_AT_name,DW_FORM_string,def.mangledname+#0]);
 
+        if (ds_dwarf_cpp in current_settings.debugswitches) and (def.owner.symtabletype in [objectsymtable,recordsymtable]) then
+          begin
+            { If C++ emulation is enabled, add DW_AT_linkage_name attribute for methods.
+              LLDB uses it to display fully qualified method names.
+              Add a simple C++ mangled name without params to achieve at least "Class::Method()"
+              instead of just "Method" in LLDB. }
+            s:=tabstractrecorddef(def.owner.defowner).objrealname^;
+            procentry:=Format('_ZN%d%s', [Length(s), s]);
+            s:=symname(def.procsym, false);
+            procentry:=Format('%s%d%sEv'#0, [procentry, Length(s), s]);
+            append_attribute(DW_AT_linkage_name,DW_FORM_string, [procentry]);
+          end;
+
         append_proc_frame_base(list,def);
 
         { Append optional flags. }
@@ -4303,6 +4316,13 @@ implementation
         end;
 
       begin
+        if (ds_dwarf_cpp in current_settings.debugswitches) then
+          begin
+            // At least LLDB 6.0.0 does not like this implementation of string types.
+            // Call the inherited DWARF 2 implementation, which works fine.
+            inherited;
+            exit;
+          end;
         case def.stringtype of
           st_shortstring:
             begin

compiler/hlcgobj.pas

@@ -5216,7 +5216,9 @@ implementation
             gen_load_loc_function_result(list,retdef,ressym.localloc);
         end
       else
-        gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,current_procinfo.procdef.funcretloc[calleeside])
+        gen_load_uninitialized_function_result(list,current_procinfo.procdef,retdef,current_procinfo.procdef.funcretloc[calleeside]);
+      if ressym.localloc.loc=LOC_REFERENCE then
+        tg.UnGetLocal(list,ressym.localloc.reference);
     end;
 
   procedure thlcgobj.gen_stack_check_size_para(list: TAsmList);

compiler/llvm/hlcgllvm.pas

@@ -47,6 +47,7 @@ uses
       procedure getcpuregister(list: TAsmList; r: Tregister); override;
       procedure ungetcpuregister(list: TAsmList; r: Tregister); override;
       procedure alloccpuregisters(list: TAsmList; rt: Tregistertype; const r: Tcpuregisterset); override;
+      procedure allocallcpuregisters(list: TAsmList); override;
       procedure deallocallcpuregisters(list: TAsmList); override;
 
       procedure a_bit_test_reg_reg_reg(list: TAsmList; bitnumbersize, valuesize, destsize: tdef; bitnumber, value, destreg: tregister); override;
@@ -335,6 +336,12 @@ implementation
     end;
 
 
+  procedure thlcgllvm.allocallcpuregisters(list: TAsmList);
+    begin
+      { don't do anything }
+    end;
+
+
   procedure thlcgllvm.deallocallcpuregisters(list: TAsmList);
     begin
       { don't do anything }

compiler/llvm/llvmdef.pas

@@ -726,6 +726,41 @@ implementation
                 encodedstr:=encodedstr+'* byval'
               else
                 encodedstr:=encodedstr+'*';
+            end
+          else if withattributes and
+             paramanager.push_addr_param(hp.varspez,hp.vardef,proccalloption) then
+            begin
+              { it's not valid to take the address of a parameter and store it for
+                use past the end of the function call (since the address can always
+                be on the stack and become invalid later) }
+              encodedstr:=encodedstr+' nocapture';
+              { open array/array of const/variant array may be a valid pointer but empty }
+              if not is_special_array(hp.vardef) and
+                 { e.g. empty records }
+                 (hp.vardef.size<>0) then
+                begin
+                  case hp.varspez of
+                    vs_value,
+                    vs_const:
+                      begin
+                        encodedstr:=encodedstr+' nocapture dereferenceable('
+                      end;
+                    vs_var,
+                    vs_out,
+                    vs_constref:
+                      begin
+                        { while normally these are not nil, it is technically possible
+                          to pass nil via ptrtype(nil)^ }
+                        encodedstr:=encodedstr+' nocapture dereferenceable_or_null('
+                      end;
+                    else
+                      internalerror(2018120801);
+                  end;
+                  if hp.vardef.typ<>formaldef then
+                    encodedstr:=encodedstr+tostr(hp.vardef.size)+')'
+                  else
+                    encodedstr:=encodedstr+'1)';
+                end;
             end;
           if withparaname then
             begin

compiler/llvm/tgllvm.pas

@@ -57,6 +57,9 @@ unit tgllvm;
        protected
         procedure alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference); override;
         procedure gethltempintern(list: TAsmList; def: tdef; alignment: shortint; forcesize: asizeint; temptype: ttemptype; out ref: treference);
+        procedure freetemphook(list: TAsmList; temp: ptemprecord); override;
+
+        procedure emit_lifetime(list: TAsmList; const procname: string; temp: ptemprecord);
        public
         alloclist: tasmlist;
 
@@ -79,8 +82,8 @@ implementation
        systems,verbose,
        procinfo,
        llvmbase,aasmllvm,
-       symconst,symdef,
-       cgobj
+       symconst,symtable,symdef,defutil,
+       paramgr,parabase,cgobj,hlcgobj
        ;
 
 
@@ -106,8 +109,8 @@ implementation
         templist:=tl;
         temp_to_ref(tl,ref);
         list.concat(tai_tempalloc.alloc(tl^.pos,tl^.size));
-        { TODO: add llvm.lifetime.start() for this allocation and afterwards
-            llvm.lifetime.end() for freetemp (if the llvm version supports it) }
+
+        emit_lifetime(list,'llvm_lifetime_start',tl);
         inc(lasttemp);
         { allocation for the temp -- should have lineinfo of the start of the
           routine }
@@ -136,6 +139,37 @@ implementation
       end;
 
 
+    procedure ttgllvm.freetemphook(list: TAsmList; temp: ptemprecord);
+      begin
+        inherited;
+        emit_lifetime(list,'llvm_lifetime_end',temp);
+      end;
+
+
+    procedure ttgllvm.emit_lifetime(list: TAsmList; const procname: string; temp: ptemprecord);
+      var
+        sizepara, ptrpara: tcgpara;
+        pd: tprocdef;
+        ref: treference;
+      begin
+        if (temp^.size<>0) and
+           not is_managed_type(temp^.def) then
+          begin
+            temp_to_ref(temp,ref);
+            sizepara.init;
+            ptrpara.init;
+            pd:=search_system_proc(procname);
+            paramanager.getintparaloc(list,pd,1,sizepara);
+            paramanager.getintparaloc(list,pd,2,ptrpara);
+            hlcg.a_load_const_cgpara(list,sizepara.def,temp^.size,sizepara);
+            hlcg.a_loadaddr_ref_cgpara(list,temp^.def,ref,ptrpara);
+            hlcg.g_call_system_proc(list,pd,[@sizepara,@ptrpara],nil).resetiftemp;
+            sizepara.reset;
+            ptrpara.reset;
+          end;
+      end;
+
+
     procedure ttgllvm.temp_to_ref(p: ptemprecord; out ref: treference);
       var
         temppos: treftemppos;
@@ -178,7 +212,7 @@ implementation
 
     procedure ttgllvm.gethltemp(list: TAsmList; def: tdef; forcesize: asizeint; temptype: ttemptype; out ref: treference);
       begin
-        gethltempintern(list,def,def.alignment,forcesize,tt_persistent,ref);
+        gethltempintern(list,def,def.alignment,forcesize,temptype,ref);
       end;
 
 

compiler/ncgutil.pas

@@ -1816,7 +1816,11 @@ implementation
                           cg.a_reg_sync(list,localloc.register);
                       LOC_REFERENCE :
                         begin
-                          if typ in [localvarsym,paravarsym] then
+                          { can't free the result, because we load it after
+                            this call into the function result location
+                            (gets freed in thlcgobj.gen_load_return_value() }
+                          if (typ in [localvarsym,paravarsym]) and
+                             (([vo_is_funcret,vo_is_result]*varoptions)=[]) then
                             tg.Ungetlocal(list,localloc.reference);
                         end;
                     end;

compiler/tgobj.pas

@@ -64,6 +64,7 @@ unit tgobj;
           procedure alloctemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref: treference); virtual;
           procedure freetemp(list: TAsmList; pos: treftemppos; temptypes: ttemptypeset);virtual;
           procedure gettempinternal(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; def: tdef; fini: boolean; out ref : treference);
+          procedure freetemphook(list: TAsmList; temp: ptemprecord); virtual;
        public
           { contains all temps }
           templist      : ptemprecord;
@@ -502,7 +503,7 @@ implementation
 {$endif}
                   exit;
                 end;
-               list.concat(tai_tempalloc.dealloc(hp^.pos,hp^.size));
+               freetemphook(list,hp);
                { set this block to free }
                hp^.temptype:=Used2Free[hp^.temptype];
                { Update tempfreelist }
@@ -573,7 +574,6 @@ implementation
       end;
 
 
-
     procedure ttgobj.gettemp(list: TAsmList; size: asizeint; alignment: shortint; temptype: ttemptype; out ref : treference);
       begin
         gettempinternal(list,size,alignment,temptype,nil,false,ref);
@@ -589,6 +589,12 @@ implementation
       end;
 
 
+    procedure ttgobj.freetemphook(list: TAsmList; temp: ptemprecord);
+      begin
+        list.concat(tai_tempalloc.dealloc(temp^.pos,temp^.size));
+      end;
+
+
     procedure ttgobj.gettempmanaged(list: TAsmList; def:tdef;temptype:ttemptype;out ref : treference);
       begin
         gettempinternal(list,def.size,def.alignment,temptype,def,true,ref);

packages/amunits/src/coreunits/serial.pas

@@ -16,25 +16,23 @@
 
 unit serial;
 
-INTERFACE
+interface
+{$PACKRECORDS 2}
 
-uses exec;
+uses
+  exec;
 
+type
 
-Type
+  // array of termination char's to use,see serial.doc setparams
+  PIOTArray = ^TIOTArray;
+  TIOTArray = record
+    TermArray0: LongWord;
+    TermArray1: LongWord;
+  end;
 
-                   { array of termination char's }
-                   { to use,see serial.doc setparams }
-
-    pIOTArray = ^tIOTArray;
-    tIOTArray = record
-        TermArray0 : ULONG;
-        TermArray1 : ULONG;
-    end;
-
-Const
-
-    SER_DEFAULT_CTLCHAR = $11130000;    { default chars for xON,xOFF }
+const
+  SER_DEFAULT_CTLCHAR = $11130000; // default chars for xON,xOFF
 
 { You may change these via SETPARAMS.   At this time, parity is not
    calculated for xON/xOFF characters.  You must supply them with the
@@ -45,151 +43,123 @@ Const
    IOExtSer-sized structure or you may overlay innocent memory !! }
 {****************************************************************}
 
-Type
-
-    pIOExtSer = ^tIOExtSer;
-    tIOExtSer = record
-        IOSer   : tIOStdReq;
-
-{     STRUCT    MsgNode
-*   0   APTR     Succ
-*   4   APTR     Pred
-*   8   UBYTE    Type
-*   9   UBYTE    Pri
-*   A   APTR     Name
-*   E   APTR     ReplyPort
-*  12   UWORD    MNLength
-*     STRUCT   IOExt
-*  14   APTR     io_Device
-*  18   APTR     io_Unit
-*  1C   UWORD    io_Command
-*  1E   UBYTE    io_Flags
-*  1F   UBYTE    io_Error
-*     STRUCT   IOStdExt
-*  20   ULONG    io_Actual
-*  24   ULONG    io_Length
-*  28   APTR     io_Data
-*  2C   ULONG    io_Offset
-*
-*  30 }
-
-        io_CtlChar      : ULONG; { control char's (order = xON,xOFF,INQ,ACK) }
-        io_RBufLen      : ULONG; { length in bytes of serial port's read buffer }
-        io_ExtFlags     : ULONG; { additional serial flags (see bitdefs below) }
-        io_Baud         : ULONG; { baud rate requested (true baud) }
-        io_BrkTime      : ULONG; { duration of break signal in MICROseconds }
-        io_TermArray    : tIOTArray; { termination character array }
-        io_ReadLen      : Byte;   { bits per read character (# of bits) }
-        io_WriteLen     : Byte;   { bits per write character (# of bits) }
-        io_StopBits     : Byte;   { stopbits for read (# of bits) }
-        io_SerFlags     : Byte;   { see SerFlags bit definitions below   }
-        io_Status       : Word;
-    end;
-
-   { status of serial port, as follows:
-*                  BIT  ACTIVE  FUNCTION
-*                   0    ---    reserved
-*                   1    ---    reserved
-*                   2    high   Connected to parallel "select" on the A1000.
-*                               Connected to both the parallel "select" and
-*                               serial "ring indicator" pins on the A500 &
-*                               A2000.  Take care when making cables.
-*                   3    low    Data Set Ready
-*                   4    low    Clear To Send
-*                   5    low    Carrier Detect
-*                   6    low    Ready To Send
-*                   7    low    Data Terminal Ready
-*                   8    high   read overrun
-*                   9    high   break sent
-*                  10    high   break received
-*                  11    high   transmit x-OFFed
-*                  12    high   receive x-OFFed
-*               13-15           reserved
-}
-
-Const
-
-    SDCMD_QUERY         = CMD_NONSTD;
-    SDCMD_BREAK         = CMD_NONSTD + 1;
-    SDCMD_SETPARAMS     = CMD_NONSTD + 2;
-
-
-    SERB_XDISABLED      = 7;    { io_SerFlags xOn-xOff feature disabled bit }
-    SERF_XDISABLED      = 128;  {    "      xOn-xOff feature disabled mask }
-    SERB_EOFMODE        = 6;    {    "      EOF mode enabled bit }
-    SERF_EOFMODE        = 64;   {    "      EOF mode enabled mask }
-    SERB_SHARED         = 5;    {    "      non-exclusive access bit }
-    SERF_SHARED         = 32;   {    "      non-exclusive access mask }
-    SERB_RAD_BOOGIE     = 4;    {    "      high-speed mode active bit }
-    SERF_RAD_BOOGIE     = 16;   {    "      high-speed mode active mask }
-    SERB_QUEUEDBRK      = 3;    {    "      queue this Break ioRqst }
-    SERF_QUEUEDBRK      = 8;    {    "      queue this Break ioRqst }
-    SERB_7WIRE          = 2;    {    "      RS232 7-wire protocol }
-    SERF_7WIRE          = 4;    {    "      RS232 7-wire protocol }
-    SERB_PARTY_ODD      = 1;    {    "      parity feature enabled bit }
-    SERF_PARTY_ODD      = 2;    {    "      parity feature enabled mask }
-    SERB_PARTY_ON       = 0;    {    "      parity-enabled bit }
-    SERF_PARTY_ON       = 1;    {    "      parity-enabled mask }
-
-{ These now refect the actual bit positions in the io_Status UWORD }
-
-    IO_STATB_XOFFREAD   = 12;      { io_Status receive currently xOFF'ed bit }
-    IO_STATF_XOFFREAD   = $1000;   {     "     receive currently xOFF'ed mask }
-    IO_STATB_XOFFWRITE  = 11;      {     "     transmit currently xOFF'ed bit }
-    IO_STATF_XOFFWRITE  = $0800;   {     "     transmit currently xOFF'ed mask }
-    IO_STATB_READBREAK  = 10;      {     "     break was latest input bit }
-    IO_STATF_READBREAK  = $0400;   {     "     break was latest input mask }
-    IO_STATB_WROTEBREAK = 9;       {     "     break was latest output bit }
-    IO_STATF_WROTEBREAK = $0200;   {     "     break was latest output mask }
-    IO_STATB_OVERRUN    = 8;       {     "     status word RBF overrun bit }
-    IO_STATF_OVERRUN    = $0100;   {     "     status word RBF overrun mask }
-
-
-    SEXTB_MSPON         = 1;    { io_ExtFlags. Use mark-space parity, }
-                                {           instead of odd-even. }
-    SEXTF_MSPON         = 2;    {    "      mark-space parity mask }
-    SEXTB_MARK          = 0;    {    "      if mark-space, use mark }
-    SEXTF_MARK          = 1;    {    "      if mark-space, use mark mask }
-
-
-    SerErr_DevBusy      = 1;
-    SerErr_BaudMismatch = 2;    { baud rate not supported by hardware }
-    SerErr_BufErr       = 4;    { Failed to allocate new read buffer }
-    SerErr_InvParam     = 5;
-    SerErr_LineErr      = 6;
-    SerErr_ParityErr    = 9;
-    SerErr_TimerErr     = 11;   {(See the serial/OpenDevice autodoc)}
-    SerErr_BufOverflow  = 12;
-    SerErr_NoDSR        = 13;
-    SerErr_DetectedBreak = 15;
+type
+  TIOExtSer = record
+    IOSer: TIOStdReq;
+    io_CtlChar: LongWord;    // control characters
+    io_RBufLen: LongWord;    // length in bytes of serial read buffer
+    io_ExtFlags: LongWord;   // additional serial flags (SEXTB_*)
+    io_Baud: LongWord;       // baud rate
+    io_BrkTime: LongWord;    // duration of break in microseconds
+    io_TermArray: TIOTArray; // termination character array
+    io_ReadLen: Byte;        // number of bits per read character
+    io_WriteLen: Byte;       // number of bits per write character
+    io_StopBits: Byte;       // number of stopbits for read
+    io_SerFlags: Byte;       // serial device flags (SERB_*)
+    io_Status: Word;         // status of serial port and lines (IO_STATF_*, IOSTF_*)
+  end;
+  PIOExtSer = ^TIOExtSer;
+
+ { status of serial port, as follows:
+      BIT  ACTIVE  FUNCTION
+       0    ---    reserved
+       1    ---    reserved
+       2    high   Connected to parallel "select" on the A1000.
+                   Connected to both the parallel "select" and
+                   serial "ring indicator" pins on the A500 &
+                   A2000.  Take care when making cables.
+       3    low    Data Set Ready
+       4    low    Clear To Send
+       5    low    Carrier Detect
+       6    low    Ready To Send
+       7    low    Data Terminal Ready
+       8    high   read overrun
+       9    high   break sent
+      10    high   break received
+      11    high   transmit x-OFFed
+      12    high   receive x-OFFed
+   13-15           reserved}
+
+const
+  SDCMD_QUERY     = CMD_NONSTD;
+  SDCMD_BREAK     = CMD_NONSTD + 1;
+  SDCMD_SETPARAMS = CMD_NONSTD + 2;
+
+  // flags of TIOExtSer.io_SerFlags
+  SERB_XDISABLED      = 7;                     // xOn-xOff feature disabled
+  SERF_XDISABLED      = 1 shl SERB_XDISABLED;
+  SERB_EOFMODE        = 6;                     // EOF mode enabled
+  SERF_EOFMODE        = 1 shl SERB_EOFMODE;
+  SERB_SHARED         = 5;                     // non-exclusive access
+  SERF_SHARED         = 1 shl SERB_SHARED;
+  SERB_RAD_BOOGIE     = 4;                     // high-speed mode active
+  SERF_RAD_BOOGIE     = 1 shl SERB_RAD_BOOGIE;
+  SERB_QUEUEDBRK      = 3;                     // queue this Break ioRqst
+  SERF_QUEUEDBRK      = 1 shl SERB_QUEUEDBRK;
+  SERB_7WIRE          = 2;                     // RS232 7-wire protocol
+  SERF_7WIRE          = 1 shl SERB_7WIRE;
+  SERB_PARTY_ODD      = 1;                     // parity feature enabled
+  SERF_PARTY_ODD      = 1 shl SERB_PARTY_ODD;
+  SERB_PARTY_ON       = 0;                     // parity-enabled
+  SERF_PARTY_ON       = 1 shl SERB_PARTY_ON;
+
+// These now refect the actual bit positions in the TIOExtSer.io_Status LongWord
+  IO_STATB_XOFFREAD   = 12;                       // receive currently xOFF'ed
+  IO_STATF_XOFFREAD   = 1 shl IO_STATB_XOFFREAD;
+  IO_STATB_XOFFWRITE  = 11;                       // transmit currently xOFF'ed
+  IO_STATF_XOFFWRITE  = 1 shl IO_STATB_XOFFWRITE;
+  IO_STATB_READBREAK  = 10;                       // break was latest input
+  IO_STATF_READBREAK  = 1 shl IO_STATB_READBREAK;
+  IO_STATB_WROTEBREAK = 9;                        // break was latest output
+  IO_STATF_WROTEBREAK = 1 shl IO_STATB_WROTEBREAK;
+  IO_STATB_OVERRUN    = 8;                        // status word RBF overrun
+  IO_STATF_OVERRUN    = 1 shl IO_STATB_OVERRUN;
+
+// TIOExtSer.io_ExtFlags
+  SEXTB_MSPON = 1;                 // Use mark-space parity, instead of odd-even.
+  SEXTF_MSPON = 1 shl SEXTB_MSPON;
+  SEXTB_MARK  = 0;                 // if mark-space, use mark
+  SEXTF_MARK  = 1 shl SEXTB_MARK;
+
+  SerErr_DevBusy       = 1;
+  SerErr_BaudMismatch  = 2;  // baud rate not supported by hardware
+  SerErr_BufErr        = 4;  // Failed to allocate new read buffer
+  SerErr_InvParam      = 5;
+  SerErr_LineErr       = 6;
+  SerErr_ParityErr     = 9;
+  SerErr_TimerErr      = 11; // (See the serial/OpenDevice autodoc)
+  SerErr_BufOverflow   = 12;
+  SerErr_NoDSR         = 13;
+  SerErr_DetectedBreak = 15;
 
 
 { These defines refer to the HIGH ORDER byte of io_Status.  They have
    been replaced by the new, corrected ones above }
-    IOSTB_XOFFREAD  = 4;       { iost_hob receive currently xOFF'ed bit }
-    IOSTF_XOFFREAD  = 16;      {    "     receive currently xOFF'ed mask }
-    IOSTB_XOFFWRITE = 3;       {    "     transmit currently xOFF'ed bit }
-    IOSTF_XOFFWRITE = 8;       {    "     transmit currently xOFF'ed mask }
-    IOSTB_READBREAK = 2;       {    "     break was latest input bit }
-    IOSTF_READBREAK = 4;       {    "     break was latest input mask }
-    IOSTB_WROTEBREAK= 1;       {    "     break was latest output bit }
-    IOSTF_WROTEBREAK= 2;       {    "     break was latest output mask }
-    IOSTB_OVERRUN   = 0;       {    "     status word RBF overrun bit }
-    IOSTF_OVERRUN   = 1;       {    "     status word RBF overrun mask }
-
-    IOSERB_BUFRREAD = 7  ;     { io_Flags from read buffer bit }
-    IOSERF_BUFRREAD = 128;  {    "     from read buffer mask }
-    IOSERB_QUEUED   = 6  ;     {    "     rqst-queued bit }
-    IOSERF_QUEUED   = 64 ; {    "     rqst-queued mask }
-    IOSERB_ABORT    = 5  ;     {    "     rqst-aborted bit }
-    IOSERF_ABORT    = 32 ; {    "     rqst-aborted mask }
-    IOSERB_ACTIVE   = 4  ;     {    "     rqst-qued-OR-current bit }
-    IOSERF_ACTIVE   = 16 ; {    "     rqst-qued-OR-current mask }
-
-
-
-    SERIALNAME          : PChar = 'serial.device';
-
-IMPLEMENTATION
+  IOSTB_XOFFREAD  = 4;                      // receive currently xOFF'ed
+  IOSTF_XOFFREAD  = 1 shl IOSTB_XOFFREAD;
+  IOSTB_XOFFWRITE = 3;                      // transmit currently xOFF'ed
+  IOSTF_XOFFWRITE = 1 shl IOSTB_XOFFWRITE;
+  IOSTB_READBREAK = 2;                      // break was latest input
+  IOSTF_READBREAK = 1 shl IOSTB_READBREAK;
+  IOSTB_WROTEBREAK= 1;                      // break was latest output
+  IOSTF_WROTEBREAK= 1 shl IOSTB_WROTEBREAK;
+  IOSTB_OVERRUN   = 0;                      // status word RBF overrun
+  IOSTF_OVERRUN   = 1 shl IOSTB_OVERRUN;
+
+// TIOExtSer.io_Flags
+  IOSERB_BUFRREAD = 7;                     // from read buffer
+  IOSERF_BUFRREAD = 1 shl IOSERB_BUFRREAD;
+  IOSERB_QUEUED   = 6;                     // rqst-queued
+  IOSERF_QUEUED   = 1 shl IOSERB_QUEUED;
+  IOSERB_ABORT    = 5;                     // rqst-aborted
+  IOSERF_ABORT    = 1 shl IOSERB_ABORT;
+  IOSERB_ACTIVE   = 4;                     // rqst-qued-OR-current
+  IOSERF_ACTIVE   = 1 shl IOSERB_ACTIVE;
+
+  SERIALNAME: PChar = 'serial.device';
+
+implementation
+
+
 
 end.

packages/arosunits/fpmake.pp

@@ -55,6 +55,7 @@ begin
     T:=P.Targets.AddUnit('locale.pas');
     T:=P.Targets.AddUnit('commodities.pas');
     T:=P.Targets.AddUnit('datatypes.pas');
+    T:=P.Targets.AddUnit('serial.pas');
 
 {$ifndef ALLPACKAGES}
     Run;

packages/arosunits/src/exec.pas

@@ -1416,6 +1416,8 @@ type
 procedure ForEachNode(List:PList; NodeProc: TNodeProcedure);
 procedure ForEachNodeSafe(List:PList; NodeProc: TNodeProcedure);
 
+function CreateExtIO(const Mp: PMsgPort; Size: Integer): PIORequest;
+procedure DeleteExtIO(ioReq: PIORequest);
 
 implementation
 
@@ -1563,7 +1565,32 @@ begin
    BitMask := 1 shl no;
 end;
 
-end. (* UNIT EXEC *)
+function CreateExtIO(const Mp: PMsgPort; Size: Integer): PIORequest;
+begin
+  CreateExtIO := nil;
+  if not Assigned(mp) then
+    Exit;
+  CreateExtIO := System.AllocMem(Size);
+  if Assigned(CreateExtIO) then
+  begin
+    CreateExtIO^.io_Message.mn_Node.ln_Type := NT_REPLYMSG;
+    CreateExtIO^.io_Message.mn_ReplyPort := Mp;
+    CreateExtIO^.io_Message.mn_Length := Size;
+  end;
+end;
+
+procedure DeleteExtIO(ioReq: PIORequest);
+begin
+  if Assigned(ioReq) then
+  begin
+    ioReq^.io_Message.mn_Node.ln_Type := Byte(-1);
+    ioReq^.io_Device := Pointer(-1);
+    ioReq^.io_Unit := Pointer(-1);
+    System.FreeMem(ioReq);
+  end;
+end;
+
+end.
 
 
 

packages/arosunits/src/serial.pas

@@ -0,0 +1,165 @@
+{
+    This file is part of the Free Pascal run time library.
+
+    A file in Amiga system run time library.
+    Copyright (c) 1998 by Nils Sjoholm
+    member of the Amiga RTL development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit serial;
+
+interface
+{$PACKRECORDS 2}
+
+uses
+  exec;
+
+type
+
+  // array of termination char's to use,see serial.doc setparams
+  PIOTArray = ^TIOTArray;
+  TIOTArray = record
+    TermArray0: LongWord;
+    TermArray1: LongWord;
+  end;
+
+const
+  SER_DEFAULT_CTLCHAR = $11130000; // default chars for xON,xOFF
+
+{ You may change these via SETPARAMS.   At this time, parity is not
+   calculated for xON/xOFF characters.  You must supply them with the
+   desired parity. }
+
+{****************************************************************}
+{ CAUTION !!  IF YOU ACCESS the serial.device, you MUST (!!!!) use an
+   IOExtSer-sized structure or you may overlay innocent memory !! }
+{****************************************************************}
+
+type
+  TIOExtSer = record
+    IOSer: TIOStdReq;
+    io_CtlChar: LongWord;    // control characters
+    io_RBufLen: LongWord;    // length in bytes of serial read buffer
+    io_ExtFlags: LongWord;   // additional serial flags (SEXTB_*)
+    io_Baud: LongWord;       // baud rate
+    io_BrkTime: LongWord;    // duration of break in microseconds
+    io_TermArray: TIOTArray; // termination character array
+    io_ReadLen: Byte;        // number of bits per read character
+    io_WriteLen: Byte;       // number of bits per write character
+    io_StopBits: Byte;       // number of stopbits for read
+    io_SerFlags: Byte;       // serial device flags (SERB_*)
+    io_Status: Word;         // status of serial port and lines (IO_STATF_*, IOSTF_*)
+  end;
+  PIOExtSer = ^TIOExtSer;
+
+ { status of serial port, as follows:
+      BIT  ACTIVE  FUNCTION
+       0    ---    reserved
+       1    ---    reserved
+       2    high   Connected to parallel "select" on the A1000.
+                   Connected to both the parallel "select" and
+                   serial "ring indicator" pins on the A500 &
+                   A2000.  Take care when making cables.
+       3    low    Data Set Ready
+       4    low    Clear To Send
+       5    low    Carrier Detect
+       6    low    Ready To Send
+       7    low    Data Terminal Ready
+       8    high   read overrun
+       9    high   break sent
+      10    high   break received
+      11    high   transmit x-OFFed
+      12    high   receive x-OFFed
+   13-15           reserved}
+
+const
+  SDCMD_QUERY     = CMD_NONSTD;
+  SDCMD_BREAK     = CMD_NONSTD + 1;
+  SDCMD_SETPARAMS = CMD_NONSTD + 2;
+
+  // flags of TIOExtSer.io_SerFlags
+  SERB_XDISABLED      = 7;                     // xOn-xOff feature disabled
+  SERF_XDISABLED      = 1 shl SERB_XDISABLED;
+  SERB_EOFMODE        = 6;                     // EOF mode enabled
+  SERF_EOFMODE        = 1 shl SERB_EOFMODE;
+  SERB_SHARED         = 5;                     // non-exclusive access
+  SERF_SHARED         = 1 shl SERB_SHARED;
+  SERB_RAD_BOOGIE     = 4;                     // high-speed mode active
+  SERF_RAD_BOOGIE     = 1 shl SERB_RAD_BOOGIE;
+  SERB_QUEUEDBRK      = 3;                     // queue this Break ioRqst
+  SERF_QUEUEDBRK      = 1 shl SERB_QUEUEDBRK;
+  SERB_7WIRE          = 2;                     // RS232 7-wire protocol
+  SERF_7WIRE          = 1 shl SERB_7WIRE;
+  SERB_PARTY_ODD      = 1;                     // parity feature enabled
+  SERF_PARTY_ODD      = 1 shl SERB_PARTY_ODD;
+  SERB_PARTY_ON       = 0;                     // parity-enabled
+  SERF_PARTY_ON       = 1 shl SERB_PARTY_ON;
+
+// These now refect the actual bit positions in the TIOExtSer.io_Status LongWord
+  IO_STATB_XOFFREAD   = 12;                       // receive currently xOFF'ed
+  IO_STATF_XOFFREAD   = 1 shl IO_STATB_XOFFREAD;
+  IO_STATB_XOFFWRITE  = 11;                       // transmit currently xOFF'ed
+  IO_STATF_XOFFWRITE  = 1 shl IO_STATB_XOFFWRITE;
+  IO_STATB_READBREAK  = 10;                       // break was latest input
+  IO_STATF_READBREAK  = 1 shl IO_STATB_READBREAK;
+  IO_STATB_WROTEBREAK = 9;                        // break was latest output
+  IO_STATF_WROTEBREAK = 1 shl IO_STATB_WROTEBREAK;
+  IO_STATB_OVERRUN    = 8;                        // status word RBF overrun
+  IO_STATF_OVERRUN    = 1 shl IO_STATB_OVERRUN;
+
+// TIOExtSer.io_ExtFlags
+  SEXTB_MSPON = 1;                 // Use mark-space parity, instead of odd-even.
+  SEXTF_MSPON = 1 shl SEXTB_MSPON;
+  SEXTB_MARK  = 0;                 // if mark-space, use mark
+  SEXTF_MARK  = 1 shl SEXTB_MARK;
+
+  SerErr_DevBusy       = 1;
+  SerErr_BaudMismatch  = 2;  // baud rate not supported by hardware
+  SerErr_BufErr        = 4;  // Failed to allocate new read buffer
+  SerErr_InvParam      = 5;
+  SerErr_LineErr       = 6;
+  SerErr_ParityErr     = 9;
+  SerErr_TimerErr      = 11; // (See the serial/OpenDevice autodoc)
+  SerErr_BufOverflow   = 12;
+  SerErr_NoDSR         = 13;
+  SerErr_DetectedBreak = 15;
+
+
+{ These defines refer to the HIGH ORDER byte of io_Status.  They have
+   been replaced by the new, corrected ones above }
+  IOSTB_XOFFREAD  = 4;                      // receive currently xOFF'ed
+  IOSTF_XOFFREAD  = 1 shl IOSTB_XOFFREAD;
+  IOSTB_XOFFWRITE = 3;                      // transmit currently xOFF'ed
+  IOSTF_XOFFWRITE = 1 shl IOSTB_XOFFWRITE;
+  IOSTB_READBREAK = 2;                      // break was latest input
+  IOSTF_READBREAK = 1 shl IOSTB_READBREAK;
+  IOSTB_WROTEBREAK= 1;                      // break was latest output
+  IOSTF_WROTEBREAK= 1 shl IOSTB_WROTEBREAK;
+  IOSTB_OVERRUN   = 0;                      // status word RBF overrun
+  IOSTF_OVERRUN   = 1 shl IOSTB_OVERRUN;
+
+// TIOExtSer.io_Flags
+  IOSERB_BUFRREAD = 7;                     // from read buffer
+  IOSERF_BUFRREAD = 1 shl IOSERB_BUFRREAD;
+  IOSERB_QUEUED   = 6;                     // rqst-queued
+  IOSERF_QUEUED   = 1 shl IOSERB_QUEUED;
+  IOSERB_ABORT    = 5;                     // rqst-aborted
+  IOSERF_ABORT    = 1 shl IOSERB_ABORT;
+  IOSERB_ACTIVE   = 4;                     // rqst-qued-OR-current
+  IOSERF_ACTIVE   = 1 shl IOSERB_ACTIVE;
+
+  SERIALNAME: PChar = 'serial.device';
+
+implementation
+
+
+
+end.

packages/fcl-passrc/src/pasresolver.pp

@@ -210,8 +210,16 @@ Works:
 - type alias type overloads
 - $writeableconst off $J-
 - $warn identifier ON|off|error|default
+- anonymous methods:
+  - assign in proc and program begin and initialization   p:=procedure begin end
+  - pass as arg  doit(procedure begin end)
+  - modifiers  assembler varargs cdecl
+  - typecast
 
 ToDo:
+- anonymous methods:
+  - with
+  - self
 - Include/Exclude for set of int/char/bool
 - set of CharRange
 - error if property method resolution is not used
@@ -224,7 +232,6 @@ ToDo:
   - CharSet:=[#13]
 - proc: check if forward and impl default values match
 - call array of proc without ()
-- anonymous functions
 - attributes
 - object
 - type helpers
@@ -1351,6 +1358,7 @@ type
     procedure AddArgument(El: TPasArgument); virtual;
     procedure AddFunctionResult(El: TPasResultElement); virtual;
     procedure AddExceptOn(El: TPasImplExceptOn); virtual;
+    procedure AddWithDo(El: TPasImplWithDo); virtual;
     procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
     procedure ResolveImplElement(El: TPasImplElement); virtual;
     procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
@@ -1409,6 +1417,7 @@ type
     procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
     procedure FinishExceptOnExpr; virtual;
     procedure FinishExceptOnStatement; virtual;
+    procedure FinishWithDo(El: TPasImplWithDo); virtual;
     procedure FinishDeclaration(El: TPasElement); virtual;
     procedure FinishVariable(El: TPasVariable); virtual;
     procedure FinishPropertyOfClass(PropEl: TPasProperty); virtual;
@@ -1647,6 +1656,7 @@ type
     procedure CheckFoundElement(const FindData: TPRFindData;
       Ref: TResolvedReference); virtual;
     function GetVisibilityContext: TPasElement;
+    procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); override;
     procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
     procedure FinishTypeAlias(var NewType: TPasType); override;
     function IsUnitIntfFinished(AModule: TPasModule): boolean;
@@ -1683,12 +1693,14 @@ type
     // scopes
     function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
     procedure PopScope;
+    procedure PopWithScope(El: TPasImplWithDo);
     procedure PushScope(Scope: TPasScope); overload;
     function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
     function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
     function PushClassDotScope(var CurClassType: TPasClassType): TPasDotClassScope;
     function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotRecordScope;
     function PushEnumDotScope(CurEnumType: TPasEnumType): TPasDotEnumTypeScope;
+    function PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
     procedure ResetSubScopes(out Depth: integer);
     procedure RestoreSubScopes(Depth: integer);
     function GetInheritedExprScope(ErrorEl: TPasElement): TPasProcedureScope;
@@ -1846,6 +1858,8 @@ type
     function IsEmptyArrayExpr(const ResolvedEl: TPasResolverResult): boolean;
     function IsClassMethod(El: TPasElement): boolean;
     function IsClassField(El: TPasElement): boolean;
+    function GetFunctionType(El: TPasElement): TPasFunctionType;
+    function IsMethod(El: TPasProcedure): boolean;
     function IsExternalClass_Name(aClass: TPasClassType; const ExtName: string): boolean;
     function IsProcedureType(const ResolvedEl: TPasResolverResult; HasValue: boolean): boolean;
     function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
@@ -5748,6 +5762,11 @@ begin
   PopScope;
 end;
 
+procedure TPasResolver.FinishWithDo(El: TPasImplWithDo);
+begin
+  PopWithScope(El);
+end;
+
 procedure TPasResolver.FinishDeclaration(El: TPasElement);
 var
   C: TClass;
@@ -7552,86 +7571,25 @@ begin
 end;
 
 procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
+// Note: the expressions were already resolved during parsing
+//  and the scopes were already stored in a TPasWithScope.
+//  -> simply push them onto the scope stack
 var
-  i, OldScopeCount: Integer;
-  Expr, ErrorEl: TPasExpr;
-  ExprResolved: TPasResolverResult;
-  TypeEl: TPasType;
+  i: Integer;
   WithScope: TPasWithScope;
-  WithExprScope: TPasWithExprScope;
-  ExprScope: TPasScope;
-  OnlyTypeMembers, IsClassOf: Boolean;
-  ClassEl: TPasClassType;
+  ExprScope: TPasWithExprScope;
 begin
-  OldScopeCount:=ScopeCount;
-  WithScope:=TPasWithScope(CreateScope(El,TPasWithScope));
+  if not (El.CustomData is TPasWithScope) then
+    RaiseInternalError(20181210175349);
+  WithScope:=TPasWithScope(El.CustomData);
   PushScope(WithScope);
-  for i:=0 to El.Expressions.Count-1 do
+  for i:=0 to WithScope.ExpressionScopes.Count-1 do
     begin
-    Expr:=TPasExpr(El.Expressions[i]);
-    ResolveExpr(Expr,rraRead);
-    ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
-    {$IFDEF VerbosePasResolver}
-    writeln('TPasResolver.ResolveImplWithDo ExprResolved=',GetResolverResultDbg(ExprResolved));
-    {$ENDIF}
-    ErrorEl:=Expr;
-    TypeEl:=ExprResolved.LoTypeEl;
-    // ToDo: use last element in Expr for error position
-    if TypeEl=nil then
-      RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
-        [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
-
-    OnlyTypeMembers:=false;
-    IsClassOf:=false;
-    if TypeEl.ClassType=TPasRecordType then
-      begin
-      ExprScope:=NoNil(TPasRecordType(TypeEl).CustomData) as TPasRecordScope;
-      if ExprResolved.IdentEl is TPasType then
-        // e.g. with TPoint do PointInCircle
-        OnlyTypeMembers:=true;
-      end
-    else if TypeEl.ClassType=TPasClassType then
-      begin
-      ExprScope:=NoNil(TPasClassType(TypeEl).CustomData) as TPasClassScope;
-      if ExprResolved.IdentEl is TPasType then
-        // e.g. with TFPMemoryImage do FindHandlerFromExtension()
-        OnlyTypeMembers:=true;
-      end
-    else if TypeEl.ClassType=TPasClassOfType then
-      begin
-      // e.g. with ImageClass do FindHandlerFromExtension()
-      ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
-      ExprScope:=ClassEl.CustomData as TPasClassScope;
-      OnlyTypeMembers:=true;
-      IsClassOf:=true;
-      end
-    else
-      RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
-        [GetElementTypeName(TypeEl)],ErrorEl);
-    WithExprScope:=ScopeClass_WithExpr.Create;
-    WithExprScope.WithScope:=WithScope;
-    WithExprScope.Index:=i;
-    WithExprScope.Expr:=Expr;
-    WithExprScope.Scope:=ExprScope;
-    if not (ExprResolved.IdentEl is TPasType) then
-      Include(WithExprScope.Flags,wesfNeedTmpVar);
-    if OnlyTypeMembers then
-      Include(WithExprScope.Flags,wesfOnlyTypeMembers);
-    if IsClassOf then
-      Include(WithExprScope.Flags,wesfIsClassOf);
-    if (not (rrfWritable in ExprResolved.Flags))
-        and (ExprResolved.BaseType=btContext)
-        and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
-      Include(WithExprScope.Flags,wesfConstParent);
-    WithScope.ExpressionScopes.Add(WithExprScope);
-    PushScope(WithExprScope);
+    ExprScope:=TPasWithExprScope(WithScope.ExpressionScopes[i]);
+    PushScope(ExprScope);
     end;
   ResolveImplElement(El.Body);
-  CheckTopScope(ScopeClass_WithExpr);
-  if TopScope<>WithScope.ExpressionScopes[WithScope.ExpressionScopes.Count-1] then
-    RaiseInternalError(20160923102846);
-  while ScopeCount>OldScopeCount do
-    PopScope;
+  PopWithScope(El);
 end;
 
 procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
@@ -7846,6 +7804,7 @@ begin
     ResolveRecordValues(TRecordValues(El));
     end
   else if ElClass=TProcedureExpr then
+    // resolved by FinishScope(stProcedure)
   else
     RaiseNotYetImplemented(20170222184329,El);
 
@@ -9364,14 +9323,34 @@ var
   CurEl: TPasElement;
   Identifier: TPasIdentifier;
   CurClassScope: TPasClassScope;
+  C: TClass;
 begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.AddProcedure ',GetObjName(El));
   {$ENDIF}
-  if not (TopScope is TPasIdentifierScope) then
-    RaiseInvalidScopeForElement(20160922163522,El);
-  // Note: El.ProcType is nil !  It is parsed later.
   ProcName:=El.Name;
+  if El.Name<>'' then
+    begin
+    // named proc
+    if not (TopScope is TPasIdentifierScope) then
+      RaiseInvalidScopeForElement(20160922163522,El);
+    end
+  else
+    begin
+    // anonymous proc
+    C:=TopScope.ClassType;
+    if (C=ScopeClass_InitialFinalization)
+        or C.InheritsFrom(TPasProcedureScope)
+        or (C=TPasWithScope)
+        or (C=ScopeClass_WithExpr)
+        or (C=TPasExceptOnScope)
+        or (C=TPasForLoopScope) then
+      // ok
+    else
+      RaiseInvalidScopeForElement(20181210173134,El);
+    end;
+
+  // Note: El.ProcType is nil !  It is parsed later.
   HasDot:=Pos('.',ProcName)>1;
   if (not HasDot) and (ProcName<>'') then
     AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
@@ -9503,6 +9482,16 @@ begin
   PushScope(El,TPasExceptOnScope);
 end;
 
+procedure TPasResolver.AddWithDo(El: TPasImplWithDo);
+var
+  WithScope: TPasWithScope;
+begin
+  if TPasWithScope.FreeOnPop then
+    RaiseInternalError(20181210162344);
+  WithScope:=TPasWithScope(CreateScope(El,TPasWithScope));
+  PushScope(WithScope);
+end;
+
 procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
 begin
   if El=nil then ;
@@ -14158,6 +14147,8 @@ begin
     else if AClass=TPasMethodResolution then
     else if AClass=TPasImplExceptOn then
       AddExceptOn(TPasImplExceptOn(El))
+    else if AClass=TPasImplWithDo then
+      AddWithDo(TPasImplWithDo(El))
     else if AClass=TPasImplLabelMark then
     else if AClass=TPasOverloadedProc then
     else if (AClass=TInterfaceSection)
@@ -14751,6 +14742,15 @@ begin
   Result:=nil;
 end;
 
+procedure TPasResolver.BeginScope(ScopeType: TPasScopeType; El: TPasElement);
+begin
+  case ScopeType of
+  stWithExpr: PushWithExprScope(El as TPasExpr);
+  else
+    RaiseMsg(20181210163324,nNotYetImplemented,sNotYetImplemented+' BeginScope',[IntToStr(ord(ScopeType))],nil);
+  end;
+end;
+
 procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
 begin
   if IsElementSkipped(El) then exit;
@@ -14764,6 +14764,7 @@ begin
   stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
   stExceptOnExpr: FinishExceptOnExpr;
   stExceptOnStatement: FinishExceptOnStatement;
+  stWithExpr: FinishWithDo(El as TPasImplWithDo);
   stDeclaration: FinishDeclaration(El);
   stAncestors: FinishAncestors(El as TPasClassType);
   stInitialFinalization: FinishInitialFinalization(El as TPasImplBlock);
@@ -15347,6 +15348,23 @@ begin
     FTopScope:=nil;
 end;
 
+procedure TPasResolver.PopWithScope(El: TPasImplWithDo);
+var
+  WithScope: TPasWithScope;
+  i: Integer;
+begin
+  WithScope:=El.CustomData as TPasWithScope;
+  for i:=WithScope.ExpressionScopes.Count-1 downto 0 do
+    begin
+    CheckTopScope(ScopeClass_WithExpr);
+    if TopScope<>WithScope.ExpressionScopes[i] then
+      RaiseInternalError(20160923102846);
+    PopScope;
+    end;
+  CheckTopScope(TPasWithScope);
+  PopScope;
+end;
+
 procedure TPasResolver.PushScope(Scope: TPasScope);
 begin
   if Scope=nil then
@@ -15446,6 +15464,84 @@ begin
   PushScope(Result);
 end;
 
+function TPasResolver.PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
+var
+  WithEl: TPasImplWithDo;
+  WithScope: TPasWithScope;
+  ExprResolved: TPasResolverResult;
+  ErrorEl: TPasExpr;
+  TypeEl: TPasType;
+  OnlyTypeMembers, IsClassOf: Boolean;
+  ExprScope: TPasIdentifierScope;
+  ClassEl: TPasClassType;
+  WithExprScope: TPasWithExprScope;
+begin
+  if not (Expr.Parent is TPasImplWithDo) then
+    RaiseInternalError(20181210163412,GetObjName(Expr.Parent));
+  WithEl:=TPasImplWithDo(Expr.Parent);
+  if not (WithEl.CustomData is TPasWithScope) then
+    RaiseInternalError(20181210175526);
+  WithScope:=TPasWithScope(WithEl.CustomData);
+
+  ResolveExpr(Expr,rraRead);
+  ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
+  {$IFDEF VerbosePasResolver}
+  writeln('TPasResolver.PushWithExprScope ExprResolved=',GetResolverResultDbg(ExprResolved));
+  {$ENDIF}
+  ErrorEl:=Expr;
+  TypeEl:=ExprResolved.LoTypeEl;
+  // ToDo: use last element in Expr for error position
+  if TypeEl=nil then
+    RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
+      [BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
+
+  OnlyTypeMembers:=false;
+  IsClassOf:=false;
+  if TypeEl.ClassType=TPasRecordType then
+    begin
+    ExprScope:=NoNil(TPasRecordType(TypeEl).CustomData) as TPasRecordScope;
+    if ExprResolved.IdentEl is TPasType then
+      // e.g. with TPoint do PointInCircle
+      OnlyTypeMembers:=true;
+    end
+  else if TypeEl.ClassType=TPasClassType then
+    begin
+    ExprScope:=NoNil(TPasClassType(TypeEl).CustomData) as TPasClassScope;
+    if ExprResolved.IdentEl is TPasType then
+      // e.g. with TFPMemoryImage do FindHandlerFromExtension()
+      OnlyTypeMembers:=true;
+    end
+  else if TypeEl.ClassType=TPasClassOfType then
+    begin
+    // e.g. with ImageClass do FindHandlerFromExtension()
+    ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
+    ExprScope:=ClassEl.CustomData as TPasClassScope;
+    OnlyTypeMembers:=true;
+    IsClassOf:=true;
+    end
+  else
+    RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
+      [GetElementTypeName(TypeEl)],ErrorEl);
+  WithExprScope:=ScopeClass_WithExpr.Create;
+  WithExprScope.WithScope:=WithScope;
+  WithExprScope.Index:=WithEl.Expressions.Count;
+  WithExprScope.Expr:=Expr;
+  WithExprScope.Scope:=ExprScope;
+  if not (ExprResolved.IdentEl is TPasType) then
+    Include(WithExprScope.Flags,wesfNeedTmpVar);
+  if OnlyTypeMembers then
+    Include(WithExprScope.Flags,wesfOnlyTypeMembers);
+  if IsClassOf then
+    Include(WithExprScope.Flags,wesfIsClassOf);
+  if (not (rrfWritable in ExprResolved.Flags))
+      and (ExprResolved.BaseType=btContext)
+      and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
+    Include(WithExprScope.Flags,wesfConstParent);
+  WithScope.ExpressionScopes.Add(WithExprScope);
+  PushScope(WithExprScope);
+  Result:=WithExprScope;
+end;
+
 procedure TPasResolver.ResetSubScopes(out Depth: integer);
 // move all sub scopes from Scopes to SubScopes
 begin
@@ -16224,6 +16320,14 @@ begin
     else
       ; // AnyProc = aRefTo -> ok
     end
+  else if Proc2.Parent is TPasAnonymousProcedure then
+    begin
+    if IsAssign then
+      // NonRefTo := AnonymousProc  -> not possible
+      exit(ModifierError(ptmReferenceTo))
+    else
+      ; // AnyProc = AnonymousProc -> ok
+    end
   else
     begin
     // neither Proc1 nor Proc2 is a reference-to  -> check isNested and OfObject
@@ -19269,6 +19373,42 @@ begin
           else
             Result:=cCompatible;
           end
+        end
+      else if FromResolved.BaseType=btProc then
+        begin
+        FromTypeEl:=FromResolved.LoTypeEl;
+        if FromTypeEl is TPasProcedureType then
+          begin
+          // typecast procedure (or anonymous procedure) to proctype
+          FromProcType:=TPasProcedureType(FromTypeEl);
+          if (msDelphi in CurrentParser.CurrentModeswitches)
+              and (FromResolved.IdentEl=nil)
+              and (FromResolved.LoTypeEl.Name<>'') then
+            // Delphi forbids typecast (non anonymous) procedure to proctype
+          else if ToProcType.IsReferenceTo then
+            Result:=cCompatible
+          else if FromResolved.IdentEl=nil then
+            // anonymous proc to proctype
+            Result:=cCompatible
+          else if (FromProcType.IsOfObject<>ToProcType.IsOfObject)
+              and not (proMethodAddrAsPointer in Options) then
+            begin
+            // e.g. TProcedure(Obj.DoIt)
+            if RaiseOnError then
+              RaiseMsg(20181210151058,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],''),
+                 ToProcType.ElementTypeName+BoolToStr(ToProcType.IsOfObject,' '+ProcTypeModifiers[ptmOfObject],'')],ErrorEl);
+            end
+          else if FromProcType.IsNested<>ToProcType.IsNested then
+            begin
+            if RaiseOnError then
+              RaiseMsg(20181210151102,nIllegalTypeConversionTo,sIllegalTypeConversionTo,
+                [GetElementTypeName(FromProcType)+BoolToStr(FromProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],''),
+                 ToProcType.ElementTypeName+BoolToStr(ToProcType.IsNested,' '+ProcTypeModifiers[ptmIsNested],'')],ErrorEl);
+            end
+          else
+            Result:=cCompatible;
+          end;
         end;
       end
     else if C=TPasPointerType then
@@ -20291,6 +20431,30 @@ begin
     and (El.Parent is TPasClassType);
 end;
 
+function TPasResolver.GetFunctionType(El: TPasElement): TPasFunctionType;
+var
+  ProcType: TPasProcedureType;
+begin
+  if not (El is TPasProcedure) then exit(nil);
+  ProcType:=TPasProcedure(El).ProcType;
+  if ProcType is TPasFunctionType then
+    Result:=TPasFunctionType(ProcType)
+  else
+    Result:=nil;
+end;
+
+function TPasResolver.IsMethod(El: TPasProcedure): boolean;
+var
+  ProcScope: TPasProcedureScope;
+begin
+  Result:=false;
+  if El=nil then exit;
+  if El.Parent is TPasClassType then exit(true);
+  if not (El.CustomData is TPasProcedureScope) then exit;
+  ProcScope:=TPasProcedureScope(El.CustomData);
+  Result:=IsMethod(ProcScope.DeclarationProc);
+end;
+
 function TPasResolver.IsExternalClass_Name(aClass: TPasClassType;
   const ExtName: string): boolean;
 var
@@ -20672,9 +20836,10 @@ begin
     if not HasTypeInfo(TPasType(El.Parent)) then
       exit;
     end
-  else
-    if ElHasModeSwitch(El,msOmitRTTI) then
-      exit;
+  else if ElHasModeSwitch(El,msOmitRTTI) then
+    exit
+  else if El.Parent is TPasAnonymousProcedure then
+    exit;
   Result:=true;
 end;
 

packages/fcl-passrc/src/pastree.pp

@@ -1988,7 +1988,7 @@ end;
 
 constructor TProcedureExpr.Create(AParent: TPasElement);
 begin
-  inherited Create(AParent,pekProcedure, eopNone);
+  inherited Create(AParent,pekProcedure,eopNone);
 end;
 
 destructor TProcedureExpr.Destroy;
@@ -2009,8 +2009,7 @@ procedure TProcedureExpr.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  if Proc<>nil then
-    Proc.ForEachCall(aMethodCall,Arg);
+  ForEachChildCall(aMethodCall,Arg,Proc,false);
 end;
 
 { TPasImplRaise }
@@ -4497,7 +4496,7 @@ begin
       S.Add(T);
       end;
     ProcType.GetArguments(S);
-    If ProcType is TPasFunctionType
+    If (ProcType is TPasFunctionType)
         and Assigned(TPasFunctionType(Proctype).ResultEl) then
       With TPasFunctionType(ProcType).ResultEl.ResultType do
         begin

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -390,9 +390,7 @@ begin
   aModule:=El.GetModule;
   if aModule=El then exit;
   if aModule=nil then
-    Result:='NilModule.'+Result
-  else
-    Result:=aModule.Name+'.'+Result;
+    Result:='NilModule.'+Result;
 end;
 
 function dbgs(a: TPAIdentifierAccess): string;
@@ -1554,6 +1552,8 @@ begin
     end
   else if C=TInheritedExpr then
     UseInheritedExpr(TInheritedExpr(El))
+  else if C=TProcedureExpr then
+    UseProcedure(TProcedureExpr(El).Proc)
   else
     RaiseNotSupported(20170307085444,El);
 end;
@@ -2335,6 +2335,7 @@ var
   UsedModule, aModule: TPasModule;
   UsesClause: TPasUsesClause;
   Use: TPasUsesUnit;
+  PosEl: TPasElement;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitSectionHints ',GetElModName(Section));
@@ -2350,8 +2351,12 @@ begin
       UsedModule:=TPasModule(Use.Module);
       if CompareText(UsedModule.Name,'system')=0 then continue;
       if not PAElementExists(UsedModule) then
+        begin
+        PosEl:=Use.Expr;
+        if PosEl=nil then PosEl:=Use;
         EmitMessage(20170311191725,mtHint,nPAUnitNotUsed,sPAUnitNotUsed,
-          [UsedModule.Name,aModule.Name],Use.Expr);
+          [UsedModule.Name,aModule.Name],PosEl);
+        end;
       end;
     end;
 
@@ -2488,6 +2493,7 @@ var
   ProcScope: TPasProcedureScope;
   PosEl: TPasElement;
   DeclProc, ImplProc: TPasProcedure;
+  FuncType: TPasFunctionType;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
@@ -2553,12 +2559,14 @@ begin
         end;
       end;
     // check result
-    if (El is TPasFunction) then
+    if (El.ProcType is TPasFunctionType) then
       begin
-      PosEl:=TPasFunction(El).FuncType.ResultEl;
-      if (ProcScope.ImplProc<>nil) and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
+      FuncType:=TPasFunctionType(TPasProcedure(El).ProcType);
+      PosEl:=FuncType.ResultEl;
+      if (ProcScope.ImplProc<>nil)
+          and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
         PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
-      Usage:=FindElement(TPasFunction(El).FuncType.ResultEl);
+      Usage:=FindElement(FuncType.ResultEl);
       if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
         // result was never used
         EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,

packages/fcl-passrc/src/pparser.pp

@@ -24,8 +24,14 @@
   {$IF FPC_FULLVERSION<30101}
     {$define EmulateArrayInsert}
   {$endif}
+  {$define HasFS}
 {$endif}
 
+{$IFDEF NODEJS}
+  {$define HasFS}
+{$ENDIF}
+
+
 unit PParser;
 
 interface
@@ -165,6 +171,7 @@ type
     stResourceString, // e.g. TPasResString
     stProcedure, // also method, procedure, constructor, destructor, ...
     stProcedureHeader,
+    stWithExpr, // calls BeginScope after parsing every WITH-expression
     stExceptOnExpr,
     stExceptOnStatement,
     stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument
@@ -206,6 +213,7 @@ type
     function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
       UseParentAsResultParent: Boolean; const ASrcPos: TPasSourcePos): TPasFunctionType;
     function FindElement(const AName: String): TPasElement; virtual; abstract;
+    procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
     procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
     procedure FinishTypeAlias(var aType: TPasType); virtual;
     function FindModule(const AName: String): TPasModule; virtual;
@@ -448,7 +456,7 @@ type
     procedure ParseArgList(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
       EndToken: TToken);
-    procedure ParseProcedureOrFunctionHeader(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
+    procedure ParseProcedureOrFunction(Parent: TPasElement; Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
     procedure ParseProcedureBody(Parent: TPasElement);
     function ParseMethodResolution(Parent: TPasElement): TPasMethodResolution;
     // Properties for external access
@@ -803,6 +811,13 @@ begin
     visDefault, ASrcPos));
 end;
 
+procedure TPasTreeContainer.BeginScope(ScopeType: TPasScopeType; El: TPasElement
+  );
+begin
+  if ScopeType=stModule then ; // avoid compiler warning
+  if El=nil then ;
+end;
+
 procedure TPasTreeContainer.FinishScope(ScopeType: TPasScopeType;
   El: TPasElement);
 begin
@@ -1155,7 +1170,6 @@ begin
         end;
     ParseExcTokenError(S);
     end;
-
 end;
 
 
@@ -1247,15 +1261,9 @@ 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;
+  Result:=IsProcModifier(S,PM);
+  if not Result then exit;
+  Result:=PM in [pmAssembler];
   if Parent=nil then ;
 end;
 
@@ -1313,11 +1321,7 @@ 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
+  Result:=El is TPasImplBlock; // only in statements
 end;
 
 function TPasParser.CheckPackMode: TPackMode;
@@ -1814,14 +1818,14 @@ begin
     tkProcedure:
       begin
         Result := TPasProcedureType(CreateElement(TPasProcedureType, '', Parent));
-        ParseProcedureOrFunctionHeader(Result, TPasProcedureType(Result), ptProcedure, True);
+        ParseProcedureOrFunction(Result, TPasProcedureType(Result), ptProcedure, True);
         if CurToken = tkSemicolon then
           UngetToken;        // Unget semicolon
       end;
     tkFunction:
       begin
         Result := CreateFunctionType('', 'Result', Parent, False, CurSourcePos);
-        ParseProcedureOrFunctionHeader(Result, TPasFunctionType(Result), ptFunction, True);
+        ParseProcedureOrFunction(Result, TPasFunctionType(Result), ptFunction, True);
         if CurToken = tkSemicolon then
           UngetToken;        // Unget semicolon
       end;
@@ -2210,6 +2214,7 @@ var
   ST: TPasSpecializeType;
   SrcPos, ScrPos: TPasSourcePos;
   ProcType: TProcType;
+  ProcExpr: TProcedureExpr;
 
 begin
   Result:=nil;
@@ -2262,22 +2267,19 @@ begin
       end;
     tkprocedure,tkfunction:
       begin
+      if not IsAnonymousProcAllowed(AParent) then
+        ParseExcExpectedIdentifier;
       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;
+        ProcExpr:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
+        ProcExpr.Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(ProcExpr,ProcType));
+        Result:=ProcExpr;
       finally
-        if not ok then
-          Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+        if Result=nil then
+          ProcExpr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
       end;
       exit; // do not allow postfix operators . ^. [] ()
       end;
@@ -2392,11 +2394,13 @@ begin
   //    Result:=5;
     tknot,tkAt,tkAtAt:
       Result:=4;
-    tkMul, tkDivision, tkdiv, tkmod, tkand, tkShl,tkShr, tkas, tkPower :
+    tkMul, tkDivision, tkdiv, tkmod, tkand, tkShl,tkShr, tkas, tkPower, tkis:
+      // Note that "is" has same precedence as "and" in Delphi and fpc, even though
+      // some docs say otherwise. e.g. "Obj is TObj and aBool"
       Result:=3;
     tkPlus, tkMinus, tkor, tkxor:
       Result:=2;
-    tkEqual, tkNotEqual, tkLessThan, tkLessEqualThan, tkGreaterThan, tkGreaterEqualThan, tkin, tkis:
+    tkEqual, tkNotEqual, tkLessThan, tkLessEqualThan, tkGreaterThan, tkGreaterEqualThan, tkin:
       Result:=1;
   else
     Result:=0;
@@ -4140,7 +4144,7 @@ begin
     Result := TPasProcedureType(CreateElement(TPasProcedureType, TypeName, Parent, NamePos));
   ok:=false;
   try
-    ParseProcedureOrFunctionHeader(Result, TPasProcedureType(Result), PT, True);
+    ParseProcedureOrFunction(Result, TPasProcedureType(Result), PT, True);
     ok:=true;
   finally
     if not ok then
@@ -4665,6 +4669,11 @@ begin
       tkIdentifier, // e.g. procedure assembler
       tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction:
         UngetToken;
+      tkColon:
+        if ProcType=ptAnonymousFunction then
+          UngetToken
+        else
+          ParseExcTokenError('begin');
       else
         ParseExcTokenError('begin');
       end;
@@ -4828,7 +4837,7 @@ begin
     end;
 end;
 
-procedure TPasParser.ParseProcedureOrFunctionHeader(Parent: TPasElement;
+procedure TPasParser.ParseProcedureOrFunction(Parent: TPasElement;
   Element: TPasProcedureType; ProcType: TProcType; OfObjectPossible: Boolean);
 
   Function FindInSection(AName : String;ASection : TPasSection) : Boolean;
@@ -4873,8 +4882,8 @@ Var
   PM : TProcedureModifier;
   ResultEl: TPasResultElement;
   OK: Boolean;
-  IsProc: Boolean; // true = procedure, false = procedure type
-  IsAnonymProc: Boolean;
+  IsProcType: Boolean; // false = procedure, true = procedure type
+  IsAnonymous: Boolean;
   PTM: TProcTypeModifier;
   ModTokenCount: Integer;
   LastToken: TToken;
@@ -4883,8 +4892,8 @@ 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);
-  IsProc:=Parent is TPasProcedure;
-  IsAnonymProc:=IsProc and (ProcType in [ptAnonymousProcedure,ptAnonymousFunction]);
+  IsProcType:=not (Parent is TPasProcedure);
+  IsAnonymous:=(not IsProcType) and (ProcType in [ptAnonymousProcedure,ptAnonymousFunction]);
   case ProcType of
     ptFunction,ptClassFunction,ptAnonymousFunction:
       begin
@@ -4897,7 +4906,8 @@ begin
       // In Delphi mode, the implementation in the implementation section can be
       // without result as it was declared
       // We actually check if the function exists in the interface section.
-      else if (msDelphi in CurrentModeswitches)
+      else if (not IsAnonymous)
+          and (msDelphi in CurrentModeswitches)
           and (Assigned(CurModule.ImplementationSection)
             or (CurModule is TPasProgram))
           then
@@ -4956,12 +4966,13 @@ begin
       UnGetToken;
     end;
   ModTokenCount:=0;
+  //writeln('TPasParser.ParseProcedureOrFunction IsProcType=',IsProcType,' IsAnonymous=',IsAnonymous);
   Repeat
     inc(ModTokenCount);
-    // Writeln(ModTokenCount, curtokentext);
+    //writeln('TPasParser.ParseProcedureOrFunction ',ModTokenCount,' ',CurToken,' ',CurTokenText);
     LastToken:=CurToken;
     NextToken;
-    if (CurToken = tkEqual) and not IsProc and (ModTokenCount<=3) then
+    if (CurToken = tkEqual) and IsProcType and (ModTokenCount<=3) then
       begin
       // for example: const p: procedure = nil;
       UngetToken;
@@ -4970,6 +4981,8 @@ begin
       end;
     If CurToken=tkSemicolon then
       begin
+      if IsAnonymous then
+        CheckToken(tkbegin); // begin expected, but ; found
       if LastToken=tkSemicolon then
         ParseExcSyntaxError;
       continue;
@@ -4991,22 +5004,25 @@ begin
           NextToken; // remove offset
           end;
       end;
-      if IsProc then
-        ExpectTokens([tkSemicolon])
-      else
+      if IsProcType then
         begin
         ExpectTokens([tkSemicolon,tkEqual]);
         if CurToken=tkEqual then
           UngetToken;
-        end;
+        end
+      else if IsAnonymous then
+      else
+        ExpectTokens([tkSemicolon]);
       end
-    else if IsAnonymProc and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
-      HandleProcedureModifier(Parent,PM)
-    else if IsProc and not IsAnonymProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+    else if IsAnonymous and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
     else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
       HandleProcedureTypeModifier(Element,PTM)
-    else if (CurToken=tklibrary) then // library is a token and a directive.
+    else if (not IsProcType) and (not IsAnonymous)
+        and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
+      HandleProcedureModifier(Parent,PM)
+    else if (CurToken=tklibrary) and not IsProcType and not IsAnonymous then
+      // library is a token and a directive.
       begin
       Tok:=UpperCase(CurTokenString);
       NextToken;
@@ -5022,10 +5038,10 @@ begin
         ExpectToken(tkSemicolon);
         end;
       end
-    else if (not IsAnonymProc) and DoCheckHint(Element) then
+    else if (not IsAnonymous) and DoCheckHint(Element) then
       // deprecated,platform,experimental,library, unimplemented etc
       ConsumeSemi
-    else if (CurToken=tkIdentifier) and (not IsAnonymProc)
+    else if (CurToken=tkIdentifier) and (not IsAnonymous)
         and (CompareText(CurTokenText,'alias')=0) then
       begin
       ExpectToken(tkColon);
@@ -5059,11 +5075,11 @@ begin
       if LastToken=tkSemicolon then
         begin
         UngetToken;
-        if IsAnonymProc and (ModTokenCount<=1) then
+        if IsAnonymous then
           ParseExcSyntaxError;
         break;
         end
-      else if IsAnonymProc then
+      else if IsAnonymous then
         begin
         UngetToken;
         break;
@@ -5079,15 +5095,15 @@ begin
   if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
     TPasOperator(Parent).CorrectName;
   Engine.FinishScope(stProcedureHeader,Element);
-  if IsProc
+  if (not IsProcType)
   and (not TPasProcedure(Parent).IsForward)
   and (not TPasProcedure(Parent).IsExternal)
   and ((Parent.Parent is TImplementationSection)
      or (Parent.Parent is TProcedureBody)
-     or IsAnonymProc)
+     or IsAnonymous)
   then
     ParseProcedureBody(Parent);
-  if IsProc then
+  if not IsProcType then
     Engine.FinishScope(stProcedure,Parent);
 end;
 
@@ -5380,7 +5396,9 @@ begin
   AsmBlock:=TPasImplAsmStatement(CreateElement(TPasImplAsmStatement,'',Parent));
   Parent.Body:=AsmBlock;
   ParseAsmBlock(AsmBlock);
-  ExpectToken(tkSemicolon);
+  NextToken;
+  if not (Parent.Parent is TPasAnonymousProcedure) then
+    CheckToken(tkSemicolon);
 end;
 
 procedure TPasParser.ParseAsmBlock(AsmBlock: TPasImplAsmStatement);
@@ -5463,9 +5481,13 @@ var
   {$ENDIF}
 
   function CloseBlock: boolean; // true if parent reached
+  var C: TPasImplBlockClass;
   begin
-    if CurBlock.ClassType=TPasImplExceptOn then
-      Engine.FinishScope(stExceptOnStatement,CurBlock);
+    C:=TPasImplBlockClass(CurBlock.ClassType);
+    if C=TPasImplExceptOn then
+      Engine.FinishScope(stExceptOnStatement,CurBlock)
+    else if C=TPasImplWithDo then
+      Engine.FinishScope(stWithExpr,CurBlock);
     CurBlock:=CurBlock.Parent as TPasImplBlock;
     Result:=CurBlock=Parent;
   end;
@@ -5717,11 +5739,12 @@ begin
           CheckSemicolon;
           SrcPos:=CurTokenPos;
           NextToken;
+          El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
           Left:=DoParseExpression(CurBlock);
           //writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
-          El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
           TPasImplWithDo(El).AddExpression(Left);
           Left.Parent:=El;
+          Engine.BeginScope(stWithExpr,Left);
           Left:=nil;
           CreateBlock(TPasImplWithDo(El));
           El:=nil;
@@ -5733,6 +5756,7 @@ begin
             Left:=DoParseExpression(CurBlock);
             //writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
             TPasImplWithDo(CurBlock).AddExpression(Left);
+            Engine.BeginScope(stWithExpr,Left);
             Left:=nil;
           until false;
         end;
@@ -6160,7 +6184,7 @@ begin
     else
       Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result));
     end;
-    ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
+    ParseProcedureOrFunction(Result, Result.ProcType, ProcType, False);
     Result.Hints:=Result.ProcType.Hints;
     Result.HintMessage:=Result.ProcType.HintMessage;
     // + is detected as 'positive', but is in fact Add if there are 2 arguments.

packages/fcl-passrc/src/pscanner.pp

@@ -486,6 +486,7 @@ type
     FIncludePaths: TStringList;
     FStrictFileCase : Boolean;
   Protected
+    function FindIncludeFileName(const aFilename: string): String; virtual; abstract;
     procedure SetBaseDirectory(AValue: string); virtual;
     procedure SetStrictFileCase(AValue: Boolean); virtual;
     Property IncludePaths: TStringList Read FIncludePaths;
@@ -509,7 +510,7 @@ type
     FUseStreams: Boolean;
     {$endif}
   Protected
-    Function FindIncludeFileName(const AName: string): String; virtual;
+    Function FindIncludeFileName(const AName: string): String; override;
     Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
   Public
     function FindSourceFile(const AName: string): TLineReader; override;
@@ -530,6 +531,8 @@ type
     function FindStream(const AName: string; ScanIncludes: Boolean): TStream;
     function FindStreamReader(const AName: string; ScanIncludes: Boolean): TLineReader;
     procedure SetOwnsStreams(AValue: Boolean);
+  Protected
+    function FindIncludeFileName(const aFilename: string): String; override;
   Public
     constructor Create; override;
     destructor Destroy; override;
@@ -2539,6 +2542,12 @@ begin
   FOwnsStreams:=AValue;
 end;
 
+function TStreamResolver.FindIncludeFileName(const aFilename: string): String;
+begin
+  raise EFileNotFoundError.Create('TStreamResolver.FindIncludeFileName not supported '+aFilename);
+  Result:='';
+end;
+
 constructor TStreamResolver.Create;
 begin
   Inherited;

packages/fcl-passrc/tests/tcresolver.pas

@@ -448,23 +448,23 @@ type
     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_AssignSemicolonFail;
+    Procedure TestAnonymousProc_Assign_ReferenceToMissingFail;
+    Procedure TestAnonymousProc_Assign_WrongParamListFail;
     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_ArgSemicolonFail;
     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
+    Procedure TestAnonymousProc_Typecast_ObjFPC;
+    Procedure TestAnonymousProc_Typecast_Delphi;
+    Procedure TestAnonymousProc_TypecastToResultFail;
+    Procedure TestAnonymousProc_With;
+    Procedure TestAnonymousProc_ExceptOn;
+    Procedure TestAnonymousProc_Nested;
 
     // record
     Procedure TestRecord;
@@ -2233,6 +2233,11 @@ begin
       if TParamsExpr(El).Params[i].Parent<>El then
         E('TParamsExpr(El).Params[i].Parent='+GetObjName(TParamsExpr(El).Params[i].Parent)+'<>El');
     end
+  else if El is TProcedureExpr then
+    begin
+    if (TProcedureExpr(El).Proc<>nil) and (TProcedureExpr(El).Proc.Parent<>El) then
+      E('TProcedureExpr(El).Proc.Parent='+GetObjName(TProcedureExpr(El).Proc.Parent)+'<>El');
+    end
   else if El is TPasDeclarations then
     begin
     for i:=0 to TPasDeclarations(El).Declarations.Count-1 do
@@ -7168,13 +7173,67 @@ begin
   '    Result:=a+b;',
   '    exit(b);',
   '    exit(Result);',
-  '  end;',
-  '  a:=3;',// test semicolon
+  '  end;',// test semicolon
+  '  a:=3;',
   'end;',
-  'begin']);
+  'begin',
+  '  Func:=function(c:word):word begin',
+  '    Result:=3+c;',
+  '    exit(c);',
+  '    exit(Result);',
+  '  end;']);
   ParseProgram;
 end;
 
+procedure TTestResolver.TestAnonymousProc_AssignSemicolonFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(a: word);',
+  'var p: TProc;',
+  'begin',
+  '  p:=procedure; begin end;',
+  '  a:=3;',
+  'end;',
+  'begin']);
+  CheckParserException('Expected "begin" at token ";" in file afile.pp at line 7 column 15',
+    nParserExpectTokenError);
+end;
+
+procedure TTestResolver.TestAnonymousProc_Assign_ReferenceToMissingFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = procedure;',
+  'procedure DoIt;',
+  'var p: TProc;',
+  'begin',
+  '  p:=procedure(w: word) begin end;',
+  'end;',
+  'begin']);
+  CheckResolverException('procedural type modifier "reference to" mismatch',
+    nXModifierMismatchY);
+end;
+
+procedure TTestResolver.TestAnonymousProc_Assign_WrongParamListFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt;',
+  'var p: TProc;',
+  'begin',
+  '  p:=procedure(w: word) begin end;',
+  'end;',
+  'begin']);
+  CheckResolverException('Incompatible types, got 0 parameters, expected 1',
+    nIncompatibleTypesGotParametersExpected);
+end;
+
 procedure TTestResolver.TestAnonymousProc_Arg;
 begin
   StartProgram(false);
@@ -7190,13 +7249,30 @@ begin
   '  DoIt(function(b:word): word',
   '    begin',
   '      Result:=1+b;',
-  '    end;);',
-  '  DoMore(procedure begin end;, procedure begin end);',
+  '    end);',
+  '  DoMore(procedure begin end, procedure begin end);',
   'end;',
-  'begin']);
+  'begin',
+  '  DoMore(procedure begin end, procedure begin end);',
+  '']);
   ParseProgram;
 end;
 
+procedure TTestResolver.TestAnonymousProc_ArgSemicolonFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'procedure DoIt(p: TProc);',
+  'begin',
+  'end;',
+  'begin',
+  '  DoIt(procedure begin end;);']);
+  CheckParserException('Expected "," at token ";" in file afile.pp at line 8 column 27',
+    nParserExpectTokenError);
+end;
+
 procedure TTestResolver.TestAnonymousProc_EqualFail;
 begin
   StartProgram(false);
@@ -7209,7 +7285,7 @@ begin
   '  if w=function(b:word): word',
   '    begin',
   '      Result:=1+b;',
-  '    end; then ;',
+  '    end then ;',
   'end;',
   'begin']);
   CheckResolverException('Incompatible types: got "Procedure/Function" expected "Word"',nIncompatibleTypesGotExpected);
@@ -7233,10 +7309,13 @@ begin
   Add([
   'type',
   '  TProc = reference to procedure;',
+  '  TProcB = reference to procedure cdecl;',
   'procedure DoIt(p: TProc);',
+  'var b: TProcB;',
   'begin',
-  '  p:=procedure assembler; asm end;',
-  '  p:=procedure() assembler; asm end;',
+  '  p:=procedure assembler asm end;',
+  '  p:=procedure() assembler asm end;',
+  '  b:=procedure() cdecl assembler asm end;',
   'end;',
   'begin']);
   ParseProgram;
@@ -7268,18 +7347,149 @@ begin
   CheckParserException(SParserSyntaxError,nParserSyntaxError);
 end;
 
-procedure TTestResolver.TestAnonymousProc_Typecast;
+procedure TTestResolver.TestAnonymousProc_Typecast_ObjFPC;
 begin
-  exit;
+  StartProgram(false);
+  Add([
+  '{$mode ObjFPC}',
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  '  TArr = array of word;',
+  '  TFuncArr = reference to function: TArr;',
+  'procedure DoIt(p: TProc);',
+  'var',
+  '  w: word;',
+  '  a: TArr;',
+  'begin',
+  '  p:=TProc(procedure(b: smallint) begin end);',
+  '  a:=TFuncArr(function: TArr begin end)();',
+  '  w:=TFuncArr(function: TArr begin end)()[3];',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
 
+procedure TTestResolver.TestAnonymousProc_Typecast_Delphi;
+begin
   StartProgram(false);
   Add([
+  '{$mode Delphi}',
   'type',
   '  TProc = reference to procedure(w: word);',
+  '  TArr = array of word;',
+  '  TFuncArr = reference to function: TArr;',
   'procedure DoIt(p: TProc);',
+  'var',
+  '  w: word;',
+  '  a: TArr;',
+  'begin',
+  '  p:=TProc(procedure(b: smallint) begin end);',
+  '  a:=TFuncArr(function: TArr begin end)();',
+  '  w:=TFuncArr(function: TArr begin end)()[3];',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_TypecastToResultFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure DoIt;',
+  'var i: longint;',
+  'begin',
+  '  i:=longint(function(b: byte): byte begin end);',
+  'end;',
+  'begin']);
+  CheckResolverException('Illegal type conversion: "Procedure/Function" to "Longint"',
+    nIllegalTypeConversionTo);
+end;
+
+procedure TTestResolver.TestAnonymousProc_With;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  '  TObject = class end;',
+  '  TBird = class',
+  '    {#bool}b: boolean;',
+  '  end;',
+  'procedure DoIt({#i}i: longint);',
+  'var',
+  '  {#p}p: TProc;',
+  '  {#bird}bird: TBird;',
+  'begin',
+  '  with {@bird}bird do',
+  '    {@p}p:=procedure({#w}w: word)',
+  '      begin',
+  '        {@bool}b:=true;',
+  '        {@bool}b:=({@w}w+{@i}i)>2;',
+  '      end;',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_ExceptOn;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TObject = class end;',
+  '  Exception = class',
+  '    {#bool}b: boolean;',
+  '  end;',
+  'procedure DoIt;',
+  'var',
+  '  {#p}p: TProc;',
+  'begin',
+  '  try',
+  '  except',
+  '    on {#E}E: Exception do',
+  '    {@p}p:=procedure',
+  '      begin',
+  '        {@E}E.{@bool}b:=true;',
+  '      end;',
+  '  end;',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAnonymousProc_Nested;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TObject = class',
+  '    i: byte;',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure TObject.DoIt;',
+  'var',
+  '  p: TProc;',
+  '  procedure Sub;',
+  '  begin',
+  '    p:=procedure',
+  '      begin',
+  '        i:=3;',
+  '        Self.i:=4;',
+  '        p:=procedure',
+  '            procedure SubSub;',
+  '            begin',
+  '              i:=13;',
+  '              Self.i:=14;',
+  '            end;',
+  '          begin',
+  '            i:=13;',
+  '            Self.i:=14;',
+  '          end;',
+  '      end;',
+  '  end;',
   'begin',
-  '  p:=TProc(procedure(b: byte) begin end);',
-  '  p:=TProc(procedure(b: byte) begin end;);',
   'end;',
   'begin']);
   ParseProgram;

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -72,6 +72,7 @@ type
     procedure TestM_NestedFuncResult;
     procedure TestM_Enums;
     procedure TestM_ProcedureType;
+    procedure TestM_AnonymousProc;
     procedure TestM_Params;
     procedure TestM_Class;
     procedure TestM_ClassForward;
@@ -999,6 +1000,27 @@ begin
   AnalyzeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestM_AnonymousProc;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#TProc_used}TProc = reference to procedure;',
+  'procedure {#DoIt_used}DoIt;',
+  'var',
+  '  {#p_used}p: TProc;',
+  '  {#i_used}i: longint;',
+  'begin',
+  '  p:=procedure',
+  '    begin',
+  '      i:=3;',
+  '    end;',
+  'end;',
+  'begin',
+  '  DoIt;']);
+  AnalyzeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestM_Params;
 begin
   StartProgram(false);

packages/fpmkunit/src/fpmkunit.pp

@@ -890,6 +890,7 @@ Type
     Property SupportBuildModes: TBuildModes read FSupportBuildModes write FSupportBuildModes;
     Property BuildMode: TBuildMode read FBuildMode;
     Property Flags: TStrings read FFlags;
+    Property PackageVersion: TFPVersion read FVersion;
     // Options which are passed to the compiler for packages which depend on
     // this package.
     Property TransmitOptions: TStrings Read GetTransmitOptions Write SetTransmitOptions;
@@ -1682,6 +1683,7 @@ ResourceString
   SWarngcclibpath         = 'Warning: Unable to determine the libgcc path.';
   SWarnNoFCLProcessSupport= 'No FCL-Process support';
   SWarnRetryRemDirectory     = 'Failed to remove directory "%s". Retry after a short delay';
+  SWarnRetryDeleteFile       = 'Failed to remove file "%f". 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"';
 
@@ -5830,13 +5832,27 @@ end;
 
 
 procedure TBuildEngine.SysDeleteFile(Const AFileName : String);
+var retries : integer;
+    res : boolean;
 begin
   if not FileExists(AFileName) then
     Log(vldebug,SDbgFileDoesNotExist,[AFileName])
-  else If Not SysUtils.DeleteFile(AFileName) then
-    Error(SErrDeletingFile,[AFileName])
   else
-    Log(vlInfo,SInfoDeletedFile,[AFileName]);
+    begin
+      retries := 2;
+      res := SysUtils.DeleteFile(AFileName);
+      while not res and (retries>0) do
+        begin
+           log(vlWarning, SWarnRetryDeleteFile, [AFileName]);
+           sleep(5000);
+           dec(retries);
+           res := SysUtils.DeleteFile(AFileName);
+        end;
+     if not res then
+       Error(SErrDeletingFile,[AFileName])
+     else
+       Log(vlInfo,SInfoDeletedFile,[AFileName]);
+   end;
 end;
 
 procedure TBuildEngine.SysDeleteDirectory(Const ADirectoryName: String);

packages/graph/src/inc/graphh.inc

@@ -618,7 +618,7 @@ TYPE
       MaxY: word;                { Max. column.                    }
       DirectColor: boolean;         { Is this a direct color mode??   }
       Hardwarepages: byte;          { total number of image pages - 1 }
-      ModeName: String[18];
+      ModeName: String[32];
       { necessary hooks ... }
       DirectPutPixel : DefPixelProc;
       GetPixel       : GetPixelProc;

packages/graph/src/win32/graph.pp

@@ -2190,7 +2190,7 @@ function queryadapterinfo : pmodeinfo;
           mode.PaletteSize := mode.MaxColor;
           mode.DirectColor := FALSE;
           mode.MaxX := 1023;
-          mode.MaxY := 768;
+          mode.MaxY := 767;
           SetupWin32GUIDefault;
           mode.XAspect := 10000;
           mode.YAspect := 10000;

packages/morphunits/fpmake.pp

@@ -60,6 +60,7 @@ begin
     T:=P.Targets.AddUnit('icon.pas');
     T:=P.Targets.AddUnit('locale.pas');
     T:=P.Targets.AddUnit('commodities.pas');
+    T:=P.Targets.AddUnit('serial.pas');
 
 {$ifndef ALLPACKAGES}
     Run;

packages/morphunits/src/exec.pas

@@ -2342,6 +2342,9 @@ function AddExecNode(InNode: APTR; const Tags: array of PtrUInt): APTR; inline;
 function NewGetTaskPIDAttrs(PID: LongWord; Data: APTR; DataSize, Type_: LongWord; const Tags: array of PtrUInt): LongWord; inline;
 function NewSetTaskPIDAttrs(PID: LongWord; Data: APTR; DataSize, Type_: LongWord; const Tags: array of PtrUInt): LongWord; inline;
 
+function CreateExtIO(const Mp: PMsgPort; Size: Integer): PIORequest;
+procedure DeleteExtIO(ioReq: PIORequest);
+
 implementation
 
 function NewGetTaskAttrs(Task: PTask; Data: APTR; DataSize, TType: LongWord; const Tags: array of PtrUInt): LongWord; Inline;
@@ -2486,6 +2489,30 @@ asm
   lwz r3,68(r2)
 end;
 
+function CreateExtIO(const Mp: PMsgPort; Size: Integer): PIORequest;
+begin
+  CreateExtIO := nil;
+  if not Assigned(mp) then
+    Exit;
+  CreateExtIO := System.AllocMem(Size);
+  if Assigned(CreateExtIO) then
+  begin
+    CreateExtIO^.io_Message.mn_Node.ln_Type := NT_REPLYMSG;
+    CreateExtIO^.io_Message.mn_ReplyPort := Mp;
+    CreateExtIO^.io_Message.mn_Length := Size;
+  end;
+end;
+
+procedure DeleteExtIO(ioReq: PIORequest);
+begin
+  if Assigned(ioReq) then
+  begin
+    ioReq^.io_Message.mn_Node.ln_Type := Byte(-1);
+    ioReq^.io_Device := Pointer(-1);
+    ioReq^.io_Unit := Pointer(-1);
+    System.FreeMem(ioReq);
+  end;
+end;
 
 begin
   ExecBase:=MOS_ExecBase;

packages/morphunits/src/serial.pas

@@ -0,0 +1,165 @@
+{
+    This file is part of the Free Pascal run time library.
+
+    A file in Amiga system run time library.
+    Copyright (c) 1998 by Nils Sjoholm
+    member of the Amiga RTL development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit serial;
+
+interface
+{$PACKRECORDS 2}
+
+uses
+  exec;
+
+type
+
+  // array of termination char's to use,see serial.doc setparams
+  PIOTArray = ^TIOTArray;
+  TIOTArray = record
+    TermArray0: LongWord;
+    TermArray1: LongWord;
+  end;
+
+const
+  SER_DEFAULT_CTLCHAR = $11130000; // default chars for xON,xOFF
+
+{ You may change these via SETPARAMS.   At this time, parity is not
+   calculated for xON/xOFF characters.  You must supply them with the
+   desired parity. }
+
+{****************************************************************}
+{ CAUTION !!  IF YOU ACCESS the serial.device, you MUST (!!!!) use an
+   IOExtSer-sized structure or you may overlay innocent memory !! }
+{****************************************************************}
+
+type
+  TIOExtSer = record
+    IOSer: TIOStdReq;
+    io_CtlChar: LongWord;    // control characters
+    io_RBufLen: LongWord;    // length in bytes of serial read buffer
+    io_ExtFlags: LongWord;   // additional serial flags (SEXTB_*)
+    io_Baud: LongWord;       // baud rate
+    io_BrkTime: LongWord;    // duration of break in microseconds
+    io_TermArray: TIOTArray; // termination character array
+    io_ReadLen: Byte;        // number of bits per read character
+    io_WriteLen: Byte;       // number of bits per write character
+    io_StopBits: Byte;       // number of stopbits for read
+    io_SerFlags: Byte;       // serial device flags (SERB_*)
+    io_Status: Word;         // status of serial port and lines (IO_STATF_*, IOSTF_*)
+  end;
+  PIOExtSer = ^TIOExtSer;
+
+ { status of serial port, as follows:
+      BIT  ACTIVE  FUNCTION
+       0    ---    reserved
+       1    ---    reserved
+       2    high   Connected to parallel "select" on the A1000.
+                   Connected to both the parallel "select" and
+                   serial "ring indicator" pins on the A500 &
+                   A2000.  Take care when making cables.
+       3    low    Data Set Ready
+       4    low    Clear To Send
+       5    low    Carrier Detect
+       6    low    Ready To Send
+       7    low    Data Terminal Ready
+       8    high   read overrun
+       9    high   break sent
+      10    high   break received
+      11    high   transmit x-OFFed
+      12    high   receive x-OFFed
+   13-15           reserved}
+
+const
+  SDCMD_QUERY     = CMD_NONSTD;
+  SDCMD_BREAK     = CMD_NONSTD + 1;
+  SDCMD_SETPARAMS = CMD_NONSTD + 2;
+
+  // flags of TIOExtSer.io_SerFlags
+  SERB_XDISABLED      = 7;                     // xOn-xOff feature disabled
+  SERF_XDISABLED      = 1 shl SERB_XDISABLED;
+  SERB_EOFMODE        = 6;                     // EOF mode enabled
+  SERF_EOFMODE        = 1 shl SERB_EOFMODE;
+  SERB_SHARED         = 5;                     // non-exclusive access
+  SERF_SHARED         = 1 shl SERB_SHARED;
+  SERB_RAD_BOOGIE     = 4;                     // high-speed mode active
+  SERF_RAD_BOOGIE     = 1 shl SERB_RAD_BOOGIE;
+  SERB_QUEUEDBRK      = 3;                     // queue this Break ioRqst
+  SERF_QUEUEDBRK      = 1 shl SERB_QUEUEDBRK;
+  SERB_7WIRE          = 2;                     // RS232 7-wire protocol
+  SERF_7WIRE          = 1 shl SERB_7WIRE;
+  SERB_PARTY_ODD      = 1;                     // parity feature enabled
+  SERF_PARTY_ODD      = 1 shl SERB_PARTY_ODD;
+  SERB_PARTY_ON       = 0;                     // parity-enabled
+  SERF_PARTY_ON       = 1 shl SERB_PARTY_ON;
+
+// These now refect the actual bit positions in the TIOExtSer.io_Status LongWord
+  IO_STATB_XOFFREAD   = 12;                       // receive currently xOFF'ed
+  IO_STATF_XOFFREAD   = 1 shl IO_STATB_XOFFREAD;
+  IO_STATB_XOFFWRITE  = 11;                       // transmit currently xOFF'ed
+  IO_STATF_XOFFWRITE  = 1 shl IO_STATB_XOFFWRITE;
+  IO_STATB_READBREAK  = 10;                       // break was latest input
+  IO_STATF_READBREAK  = 1 shl IO_STATB_READBREAK;
+  IO_STATB_WROTEBREAK = 9;                        // break was latest output
+  IO_STATF_WROTEBREAK = 1 shl IO_STATB_WROTEBREAK;
+  IO_STATB_OVERRUN    = 8;                        // status word RBF overrun
+  IO_STATF_OVERRUN    = 1 shl IO_STATB_OVERRUN;
+
+// TIOExtSer.io_ExtFlags
+  SEXTB_MSPON = 1;                 // Use mark-space parity, instead of odd-even.
+  SEXTF_MSPON = 1 shl SEXTB_MSPON;
+  SEXTB_MARK  = 0;                 // if mark-space, use mark
+  SEXTF_MARK  = 1 shl SEXTB_MARK;
+
+  SerErr_DevBusy       = 1;
+  SerErr_BaudMismatch  = 2;  // baud rate not supported by hardware
+  SerErr_BufErr        = 4;  // Failed to allocate new read buffer
+  SerErr_InvParam      = 5;
+  SerErr_LineErr       = 6;
+  SerErr_ParityErr     = 9;
+  SerErr_TimerErr      = 11; // (See the serial/OpenDevice autodoc)
+  SerErr_BufOverflow   = 12;
+  SerErr_NoDSR         = 13;
+  SerErr_DetectedBreak = 15;
+
+
+{ These defines refer to the HIGH ORDER byte of io_Status.  They have
+   been replaced by the new, corrected ones above }
+  IOSTB_XOFFREAD  = 4;                      // receive currently xOFF'ed
+  IOSTF_XOFFREAD  = 1 shl IOSTB_XOFFREAD;
+  IOSTB_XOFFWRITE = 3;                      // transmit currently xOFF'ed
+  IOSTF_XOFFWRITE = 1 shl IOSTB_XOFFWRITE;
+  IOSTB_READBREAK = 2;                      // break was latest input
+  IOSTF_READBREAK = 1 shl IOSTB_READBREAK;
+  IOSTB_WROTEBREAK= 1;                      // break was latest output
+  IOSTF_WROTEBREAK= 1 shl IOSTB_WROTEBREAK;
+  IOSTB_OVERRUN   = 0;                      // status word RBF overrun
+  IOSTF_OVERRUN   = 1 shl IOSTB_OVERRUN;
+
+// TIOExtSer.io_Flags
+  IOSERB_BUFRREAD = 7;                     // from read buffer
+  IOSERF_BUFRREAD = 1 shl IOSERB_BUFRREAD;
+  IOSERB_QUEUED   = 6;                     // rqst-queued
+  IOSERF_QUEUED   = 1 shl IOSERB_QUEUED;
+  IOSERB_ABORT    = 5;                     // rqst-aborted
+  IOSERF_ABORT    = 1 shl IOSERB_ABORT;
+  IOSERB_ACTIVE   = 4;                     // rqst-qued-OR-current
+  IOSERF_ACTIVE   = 1 shl IOSERB_ACTIVE;
+
+  SERIALNAME: PChar = 'serial.device';
+
+implementation
+
+
+
+end.

packages/os4units/fpmake.pp

@@ -51,6 +51,7 @@ begin
     T:=P.Targets.AddUnit('cybergraphics.pas');
     T:=P.Targets.AddUnit('locale.pas');
     T:=P.Targets.AddUnit('datatypes.pas');
+    T:=P.Targets.AddUnit('serial.pas');
 
 {$ifndef ALLPACKAGES}
     Run;

packages/os4units/src/exec.pas

@@ -1987,6 +1987,9 @@ function IsMinListEmpty(List: PMinList): Boolean; inline;
 function IsMsgPortEmpty(mp: PMsgPort): Boolean; inline;
 procedure NewListType(var List: PList; NType: Byte); inline;
 
+function CreateExtIO(const Mp: PMsgPort; Size: Integer): PIORequest;
+procedure DeleteExtIO(ioReq: PIORequest);
+
 implementation
 
 function BitMask(No: ShortInt): LongInt; inline;
@@ -2016,4 +2019,29 @@ begin
   List^.lh_Type := NType;
 end;
 
+function CreateExtIO(const Mp: PMsgPort; Size: Integer): PIORequest;
+begin
+  CreateExtIO := nil;
+  if not Assigned(mp) then
+    Exit;
+  CreateExtIO := System.AllocMem(Size);
+  if Assigned(CreateExtIO) then
+  begin
+    CreateExtIO^.io_Message.mn_Node.ln_Type := NT_REPLYMSG;
+    CreateExtIO^.io_Message.mn_ReplyPort := Mp;
+    CreateExtIO^.io_Message.mn_Length := Size;
+  end;
+end;
+
+procedure DeleteExtIO(ioReq: PIORequest);
+begin
+  if Assigned(ioReq) then
+  begin
+    ioReq^.io_Message.mn_Node.ln_Type := Byte(-1);
+    ioReq^.io_Device := Pointer(-1);
+    ioReq^.io_Unit := Pointer(-1);
+    System.FreeMem(ioReq);
+  end;
+end;
+
 end.

packages/os4units/src/serial.pas

@@ -0,0 +1,165 @@
+{
+    This file is part of the Free Pascal run time library.
+
+    A file in Amiga system run time library.
+    Copyright (c) 1998 by Nils Sjoholm
+    member of the Amiga RTL development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit serial;
+
+interface
+{$PACKRECORDS 2}
+
+uses
+  exec;
+
+type
+
+  // array of termination char's to use,see serial.doc setparams
+  PIOTArray = ^TIOTArray;
+  TIOTArray = record
+    TermArray0: LongWord;
+    TermArray1: LongWord;
+  end;
+
+const
+  SER_DEFAULT_CTLCHAR = $11130000; // default chars for xON,xOFF
+
+{ You may change these via SETPARAMS.   At this time, parity is not
+   calculated for xON/xOFF characters.  You must supply them with the
+   desired parity. }
+
+{****************************************************************}
+{ CAUTION !!  IF YOU ACCESS the serial.device, you MUST (!!!!) use an
+   IOExtSer-sized structure or you may overlay innocent memory !! }
+{****************************************************************}
+
+type
+  TIOExtSer = record
+    IOSer: TIOStdReq;
+    io_CtlChar: LongWord;    // control characters
+    io_RBufLen: LongWord;    // length in bytes of serial read buffer
+    io_ExtFlags: LongWord;   // additional serial flags (SEXTB_*)
+    io_Baud: LongWord;       // baud rate
+    io_BrkTime: LongWord;    // duration of break in microseconds
+    io_TermArray: TIOTArray; // termination character array
+    io_ReadLen: Byte;        // number of bits per read character
+    io_WriteLen: Byte;       // number of bits per write character
+    io_StopBits: Byte;       // number of stopbits for read
+    io_SerFlags: Byte;       // serial device flags (SERB_*)
+    io_Status: Word;         // status of serial port and lines (IO_STATF_*, IOSTF_*)
+  end;
+  PIOExtSer = ^TIOExtSer;
+
+ { status of serial port, as follows:
+      BIT  ACTIVE  FUNCTION
+       0    ---    reserved
+       1    ---    reserved
+       2    high   Connected to parallel "select" on the A1000.
+                   Connected to both the parallel "select" and
+                   serial "ring indicator" pins on the A500 &
+                   A2000.  Take care when making cables.
+       3    low    Data Set Ready
+       4    low    Clear To Send
+       5    low    Carrier Detect
+       6    low    Ready To Send
+       7    low    Data Terminal Ready
+       8    high   read overrun
+       9    high   break sent
+      10    high   break received
+      11    high   transmit x-OFFed
+      12    high   receive x-OFFed
+   13-15           reserved}
+
+const
+  SDCMD_QUERY     = CMD_NONSTD;
+  SDCMD_BREAK     = CMD_NONSTD + 1;
+  SDCMD_SETPARAMS = CMD_NONSTD + 2;
+
+  // flags of TIOExtSer.io_SerFlags
+  SERB_XDISABLED      = 7;                     // xOn-xOff feature disabled
+  SERF_XDISABLED      = 1 shl SERB_XDISABLED;
+  SERB_EOFMODE        = 6;                     // EOF mode enabled
+  SERF_EOFMODE        = 1 shl SERB_EOFMODE;
+  SERB_SHARED         = 5;                     // non-exclusive access
+  SERF_SHARED         = 1 shl SERB_SHARED;
+  SERB_RAD_BOOGIE     = 4;                     // high-speed mode active
+  SERF_RAD_BOOGIE     = 1 shl SERB_RAD_BOOGIE;
+  SERB_QUEUEDBRK      = 3;                     // queue this Break ioRqst
+  SERF_QUEUEDBRK      = 1 shl SERB_QUEUEDBRK;
+  SERB_7WIRE          = 2;                     // RS232 7-wire protocol
+  SERF_7WIRE          = 1 shl SERB_7WIRE;
+  SERB_PARTY_ODD      = 1;                     // parity feature enabled
+  SERF_PARTY_ODD      = 1 shl SERB_PARTY_ODD;
+  SERB_PARTY_ON       = 0;                     // parity-enabled
+  SERF_PARTY_ON       = 1 shl SERB_PARTY_ON;
+
+// These now refect the actual bit positions in the TIOExtSer.io_Status LongWord
+  IO_STATB_XOFFREAD   = 12;                       // receive currently xOFF'ed
+  IO_STATF_XOFFREAD   = 1 shl IO_STATB_XOFFREAD;
+  IO_STATB_XOFFWRITE  = 11;                       // transmit currently xOFF'ed
+  IO_STATF_XOFFWRITE  = 1 shl IO_STATB_XOFFWRITE;
+  IO_STATB_READBREAK  = 10;                       // break was latest input
+  IO_STATF_READBREAK  = 1 shl IO_STATB_READBREAK;
+  IO_STATB_WROTEBREAK = 9;                        // break was latest output
+  IO_STATF_WROTEBREAK = 1 shl IO_STATB_WROTEBREAK;
+  IO_STATB_OVERRUN    = 8;                        // status word RBF overrun
+  IO_STATF_OVERRUN    = 1 shl IO_STATB_OVERRUN;
+
+// TIOExtSer.io_ExtFlags
+  SEXTB_MSPON = 1;                 // Use mark-space parity, instead of odd-even.
+  SEXTF_MSPON = 1 shl SEXTB_MSPON;
+  SEXTB_MARK  = 0;                 // if mark-space, use mark
+  SEXTF_MARK  = 1 shl SEXTB_MARK;
+
+  SerErr_DevBusy       = 1;
+  SerErr_BaudMismatch  = 2;  // baud rate not supported by hardware
+  SerErr_BufErr        = 4;  // Failed to allocate new read buffer
+  SerErr_InvParam      = 5;
+  SerErr_LineErr       = 6;
+  SerErr_ParityErr     = 9;
+  SerErr_TimerErr      = 11; // (See the serial/OpenDevice autodoc)
+  SerErr_BufOverflow   = 12;
+  SerErr_NoDSR         = 13;
+  SerErr_DetectedBreak = 15;
+
+
+{ These defines refer to the HIGH ORDER byte of io_Status.  They have
+   been replaced by the new, corrected ones above }
+  IOSTB_XOFFREAD  = 4;                      // receive currently xOFF'ed
+  IOSTF_XOFFREAD  = 1 shl IOSTB_XOFFREAD;
+  IOSTB_XOFFWRITE = 3;                      // transmit currently xOFF'ed
+  IOSTF_XOFFWRITE = 1 shl IOSTB_XOFFWRITE;
+  IOSTB_READBREAK = 2;                      // break was latest input
+  IOSTF_READBREAK = 1 shl IOSTB_READBREAK;
+  IOSTB_WROTEBREAK= 1;                      // break was latest output
+  IOSTF_WROTEBREAK= 1 shl IOSTB_WROTEBREAK;
+  IOSTB_OVERRUN   = 0;                      // status word RBF overrun
+  IOSTF_OVERRUN   = 1 shl IOSTB_OVERRUN;
+
+// TIOExtSer.io_Flags
+  IOSERB_BUFRREAD = 7;                     // from read buffer
+  IOSERF_BUFRREAD = 1 shl IOSERB_BUFRREAD;
+  IOSERB_QUEUED   = 6;                     // rqst-queued
+  IOSERF_QUEUED   = 1 shl IOSERB_QUEUED;
+  IOSERB_ABORT    = 5;                     // rqst-aborted
+  IOSERF_ABORT    = 1 shl IOSERB_ABORT;
+  IOSERB_ACTIVE   = 4;                     // rqst-qued-OR-current
+  IOSERF_ACTIVE   = 1 shl IOSERB_ACTIVE;
+
+  SERIALNAME: PChar = 'serial.device';
+
+implementation
+
+
+
+end.

packages/pastojs/src/fppas2js.pp

@@ -355,6 +355,9 @@ Works:
 - typecast TJSFunction(func)
 - modeswitch OmitRTTI
 - debugger;
+- anonymous functions
+  - assign
+  - pass as argument
 
 ToDos:
 - do not rename property Date
@@ -1717,9 +1720,9 @@ type
     // Expressions
     Function ConvertConstValue(Value: TResEvalValue; AContext: TConvertContext; El: TPasElement): TJSElement; virtual;
     Function ConvertArrayValues(El: TArrayValues; AContext: TConvertContext): TJSElement; virtual;
-    Function ConvertInheritedExpression(El: TInheritedExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertInheritedExpr(El: TInheritedExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertNilExpr(El: TNilExpr; AContext: TConvertContext): TJSElement; virtual;
-    Function ConvertParamsExpression(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertParamsExpr(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertArrayParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertFuncParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertExternalConstructor(Left: TPasElement; Ref: TResolvedReference;
@@ -1869,6 +1872,8 @@ function PosLast(c: char; const s: string): integer;
 
 function JSEquals(A, B: TJSElement): boolean;
 
+function dbgs(opts: TPasToJsConverterOptions): string; overload;
+
 implementation
 
 const
@@ -1913,6 +1918,21 @@ begin
     exit(false);
 end;
 
+function dbgs(opts: TPasToJsConverterOptions): string;
+var
+  o: TPasToJsConverterOption;
+  h: string;
+begin
+  Result:='';
+  for o in opts do
+    begin
+    if Result<>'' then Result:=Result+',';
+    str(o,h);
+    Result:=Result+h;
+    end;
+  Result:='['+Result+']';
+end;
+
 { TPas2JSSectionScope }
 
 procedure TPas2JSSectionScope.InternalAddElevatedLocal(Item: TPasIdentifier);
@@ -2889,11 +2909,12 @@ procedure TPas2JSResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
   end;
 
   procedure CheckResultEl(Ref: TResolvedReference);
+  // Ref.Declaration is TPasResultElement
   var
-    Func: TPasFunction;
     CurEl: TPasElement;
     Lvl: Integer;
     ProcScope, CurProcScope: TPas2JSProcedureScope;
+    FuncType: TPasFunctionType;
   begin
     // result refers to a function result
     // -> check if it is referring to a parent function result
@@ -2902,19 +2923,24 @@ procedure TPas2JSResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
     CurProcScope:=nil;
     while CurEl<>nil do
       begin
-      if CurEl is TPasFunction then
+      if (CurEl is TPasProcedure)
+          and (TPasProcedure(CurEl).ProcType is TPasFunctionType) then
         begin
         inc(Lvl);
-        ProcScope:=CurEl.CustomData as TPas2JSProcedureScope;
-        Func:=ProcScope.DeclarationProc as TPasFunction;
-        if Func=nil then
-          Func:=TPasFunction(CurEl);
+        if not (CurEl.CustomData is TPas2JSProcedureScope) then
+          RaiseInternalError(20181210231858);
+        ProcScope:=TPas2JSProcedureScope(CurEl.CustomData);
+        if ProcScope.DeclarationProc is TPasFunction then
+          FuncType:=TPasFunctionType(ProcScope.DeclarationProc.ProcType)
+        else
+          FuncType:=TPasFunctionType(TPasProcedure(CurEl).ProcType);
         if Lvl=1 then
           begin
           // current function (where the statement of El is)
-          if (Func.FuncType.ResultEl=Ref.Declaration) then
+          if (FuncType.ResultEl=Ref.Declaration) then
             exit; // accessing current function -> ok
           // accessing Result variable of higher function -> need rename
+          // Note: ProcScope.ResultVarName only valid in implementation ProcScope
           if ProcScope.ResultVarName<>'' then
             exit; // is already renamed
           CurProcScope:=ProcScope;
@@ -6153,7 +6179,7 @@ begin
   eopNone:
     if El.left is TInheritedExpr then
       begin
-      Result:=ConvertInheritedExpression(TInheritedExpr(El.left),AContext);
+      Result:=ConvertInheritedExpr(TInheritedExpr(El.left),AContext);
       exit;
       end;
   end;
@@ -6893,7 +6919,7 @@ begin
       if ParamsExpr<>nil then
         begin
         // left side is done in ConvertFuncParams
-        Result:=ConvertParamsExpression(El.right as TParamsExpr,AContext);
+        Result:=ConvertParamsExpr(El.right as TParamsExpr,AContext);
         end
       else
         // e.g. ExtClass.new;
@@ -7172,12 +7198,12 @@ var
   TargetProcType: TPasProcedureType;
   ArrLit: TJSArrayLiteral;
   IndexExpr: TPasExpr;
-  Func: TPasFunction;
   FuncScope: TPas2JSProcedureScope;
   Value: TResEvalValue;
   aResolver: TPas2JSResolver;
   BracketExpr: TJSBracketMemberExpression;
   PathExpr: TJSElement;
+  Proc: TPasProcedure;
 begin
   Result:=nil;
   if not (El.CustomData is TResolvedReference) then
@@ -7333,7 +7359,7 @@ begin
     begin
     BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
     {$IFDEF VerbosePas2JS}
-    writeln('TPasToJSConverter.ConvertPrimitiveExpression ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
+    writeln('TPasToJSConverter.ConvertIdentifierExpr ',Decl.Name,' ',ResolverBuiltInProcNames[BuiltInProc.BuiltIn]);
     {$ENDIF}
     case BuiltInProc.BuiltIn of
       bfBreak: Result:=ConvertBuiltInBreak(El,AContext);
@@ -7367,8 +7393,8 @@ begin
   else if (Decl is TPasResultElement) then
     begin
     Name:=ResolverResultVar;
-    Func:=Decl.Parent.Parent as TPasFunction;
-    FuncScope:=Func.CustomData as TPas2JSProcedureScope;
+    Proc:=Decl.Parent.Parent as TPasProcedure;
+    FuncScope:=Proc.CustomData as TPas2JSProcedureScope;
     if FuncScope.ImplProc<>nil then
       FuncScope:=FuncScope.ImplProc.CustomData as TPas2JSProcedureScope;
     if FuncScope.ResultVarName<>'' then
@@ -7433,7 +7459,7 @@ begin
   Result:=CreateLiteralNull(El);
 end;
 
-function TPasToJSConverter.ConvertInheritedExpression(El: TInheritedExpr;
+function TPasToJSConverter.ConvertInheritedExpr(El: TInheritedExpr;
   AContext: TConvertContext): TJSElement;
 
   function CreateAncestorCall(ParentEl: TPasElement; Apply: boolean;
@@ -7598,7 +7624,7 @@ begin
   Result:=ConvertIdentifierExpr(El,'Self',AContext);
 end;
 
-function TPasToJSConverter.ConvertParamsExpression(El: TParamsExpr;
+function TPasToJSConverter.ConvertParamsExpr(El: TParamsExpr;
   AContext: TConvertContext): TJSElement;
 begin
   Result:=Nil;
@@ -9604,10 +9630,16 @@ var
   FuncContext: TFunctionContext;
   AssignSt: TJSSimpleAssignStatement;
   St: TJSStatementList;
+  Proc: TPasProcedure;
 begin
+  {$IFDEF VerbosePas2JS}
+  writeln('TPasToJSConverter.ConvertBuiltIn_Exit ',GetObjName(El));
+  {$ENDIF}
   ProcEl:=El.Parent;
   while (ProcEl<>nil) and not (ProcEl is TPasProcedure) do
     ProcEl:=ProcEl.Parent;
+  // ProcEl can be nil, when exit is in program begin block
+  Proc:=TPasProcedure(ProcEl);
   Result:=TJSReturnStatement(CreateElement(TJSReturnStatement,El));
   if (El is TParamsExpr) and (length(TParamsExpr(El).Params)>0) then
     begin
@@ -9617,10 +9649,10 @@ begin
   else
     begin
     // without parameter
-    if ProcEl is TPasFunction then
+    if (Proc<>nil) and (Proc.ProcType is TPasFunctionType) then
       begin
       // in a function, "return result;"
-      Scope:=ProcEl.CustomData as TPas2JSProcedureScope;
+      Scope:=Proc.CustomData as TPas2JSProcedureScope;
       VarName:=Scope.ResultVarName;
       if VarName='' then
         VarName:=ResolverResultVar;
@@ -11137,11 +11169,13 @@ begin
   else if (El.ClassType=TNilExpr) then
     Result:=ConvertNilExpr(TNilExpr(El),AContext)
   else if (El.ClassType=TInheritedExpr) then
-    Result:=ConvertInheritedExpression(TInheritedExpr(El),AContext)
+    Result:=ConvertInheritedExpr(TInheritedExpr(El),AContext)
   else if (El.ClassType=TSelfExpr) then
     Result:=ConvertSelfExpression(TSelfExpr(El),AContext)
   else if (El.ClassType=TParamsExpr) then
-    Result:=ConvertParamsExpression(TParamsExpr(El),AContext)
+    Result:=ConvertParamsExpr(TParamsExpr(El),AContext)
+  else if (El.ClassType=TProcedureExpr) then
+    Result:=ConvertProcedure(TProcedureExpr(El).Proc,AContext)
   else if (El.ClassType=TRecordValues) then
     Result:=ConvertRecordValues(TRecordValues(El),AContext)
   else if (El.ClassType=TArrayValues) then
@@ -11366,16 +11400,16 @@ Var
 
   Procedure AddFunctionResultInit;
   var
-    VarSt: TJSVariableStatement;
-    PasFun: TPasFunction;
+    Proc: TPasProcedure;
     FunType: TPasFunctionType;
+    VarSt: TJSVariableStatement;
     SrcEl: TPasElement;
     Scope: TPas2JSProcedureScope;
   begin
-    PasFun:=El.Parent as TPasFunction;
-    FunType:=PasFun.FuncType;
+    Proc:=El.Parent as TPasProcedure;
+    FunType:=Proc.ProcType as TPasFunctionType;
     ResultEl:=FunType.ResultEl;
-    Scope:=PasFun.CustomData as TPas2JSProcedureScope;
+    Scope:=Proc.CustomData as TPas2JSProcedureScope;
     if Scope.ResultVarName<>'' then
       ResultVarName:=Scope.ResultVarName
     else
@@ -11492,7 +11526,8 @@ begin
   }
 
   IsProcBody:=(El is TProcedureBody) and (TProcedureBody(El).Body<>nil);
-  IsFunction:=IsProcBody and (El.Parent is TPasFunction);
+  IsFunction:=IsProcBody and (El.Parent is TPasProcedure)
+                    and (TPasProcedure(El.Parent).ProcType is TPasFunctionType);
   IsAssembler:=IsProcBody and (TProcedureBody(El).Body is TPasImplAsmStatement);
   HasResult:=IsFunction and not IsAssembler;
 
@@ -13042,9 +13077,10 @@ begin
     AssignSt.Expr:=FS
   else
     begin
-    // local/nested function
+    // local/nested or anonymous function
     Result:=FS;
-    FD.Name:=TJSString(TransformVariableName(El,AContext));
+    if El.Name<>'' then
+      FD.Name:=TJSString(TransformVariableName(El,AContext));
     end;
 
   for n := 0 to El.ProcType.Args.Count - 1 do
@@ -13111,7 +13147,7 @@ begin
       if ProcScope.ClassScope<>nil then
         begin
         // method or class method
-        if El.Parent is TProcedureBody then
+        if not AContext.IsGlobal then
           begin
           // nested sub procedure  ->  no 'this'
           FuncContext.ThisPas:=nil;
@@ -15744,7 +15780,8 @@ begin
       writeln('TPasToJSConverter.ConvertAssignStatement Left={',GetResolverResultDbg(AssignContext.LeftResolved),'} Right={',GetResolverResultDbg(AssignContext.RightResolved),'}');
       {$ENDIF}
       if LeftIsProcType and (msDelphi in AContext.CurrentModeSwitches)
-          and (AssignContext.RightResolved.BaseType=btProc) then
+          and (AssignContext.RightResolved.BaseType=btProc)
+          and (AssignContext.RightResolved.IdentEl is TPasProcedure) then
         begin
         // Delphi allows assigning a proc without @: proctype:=proc
         AssignContext.RightSide:=CreateCallback(El.right,AssignContext.RightResolved,AContext);
@@ -16026,10 +16063,9 @@ end;
 
 function TPasToJSConverter.ConvertIfStatement(El: TPasImplIfElse;
   AContext: TConvertContext): TJSElement;
-
 Var
-  C,BThen,BElse : TJSElement;
-  T : TJSIfStatement;
+  C, BThen, BElse: TJSElement;
+  T: TJSIfStatement;
 begin
   Result:=nil;
   if AContext=nil then ;

packages/pastojs/src/pas2jscompilercfg.pp

@@ -16,14 +16,17 @@
   Abstract:
     Config file handling for compiler, depends on filesystem.
 }
-unit pas2jscompilercfg;
+unit Pas2JSCompilerCfg;
 
 {$mode objfpc}{$H+}
 
 interface
 
 uses
-  Classes, SysUtils, pas2JSCompiler, pas2jsfs;
+  {$IFDEF NodeJS}
+  NodeJSFS,
+  {$ENDIF}
+  Classes, SysUtils, Pas2jsFileUtils, Pas2JSFS, Pas2jsCompiler;
 
 Type
   TPas2JSFileConfigSupport = Class(TPas2JSConfigSupport)
@@ -33,8 +36,6 @@ Type
 
 implementation
 
-uses pas2jsfileutils;
-
 function TPas2JSFileConfigSupport.GetReader(aFileName: string): TSourceLineReader;
 
 Var

packages/pastojs/src/pas2jscompilerpp.pp

@@ -14,9 +14,9 @@
  **********************************************************************
 
   Abstract:
-    Pas2JS compiler Preprocessor support. Can depend on filesystem.
+    Pas2JS compiler Postprocessor support. Can depend on filesystem.
 }
-unit pas2jscompilerpp;
+unit Pas2JSCompilerPP;
 
 {$mode objfpc}{$H+}
 

packages/pastojs/src/pas2jsfilecache.pp

@@ -230,22 +230,15 @@ type
     FResetStamp: TChangeStamp;
     FUnitPaths: TStringList;
     FUnitPathsFromCmdLine: integer;
+    FPCUPaths: TStringList;
     function FileExistsILogged(var Filename: string): integer;
     function FileExistsLogged(const Filename: string): boolean;
     function GetOnReadDirectory: TReadDirectoryEvent;
-    function GetSearchLikeFPC: boolean;
-    function GetShowFullFilenames: boolean;
-    function GetShowTriedUsedFiles: boolean;
-    function GetStrictFileCase: Boolean;
     procedure RegisterMessages;
     procedure SetBaseDirectory(AValue: string);
     function AddSearchPaths(const Paths: string; Kind: TPas2jsSearchPathKind;
       FromCmdLine: boolean; var List: TStringList; var CmdLineCount: integer): string;
     procedure SetOnReadDirectory(AValue: TReadDirectoryEvent);
-    procedure SetSearchLikeFPC(const AValue: boolean);
-    procedure SetShowFullFilenames(const AValue: boolean);
-    procedure SetShowTriedUsedFiles(const AValue: boolean);
-    procedure SetStrictFileCase(AValue: Boolean);
   protected
     function FindSourceFileName(const aFilename: string): String; override;
     function GetHasPCUSupport: Boolean; virtual;
@@ -257,6 +250,7 @@ type
     procedure Reset; override;
     procedure WriteFoldersAndSearchPaths; override;
     procedure GetPCUDirs(aList: TStrings; const aBaseDir: String); override;
+    function PCUExists(var aFileName: string): Boolean; override;
     Function SameFileName(Const File1,File2 : String) : Boolean;  override;
     Function File1IsNewer(const File1, File2: String): Boolean; override;
     function SearchLowUpCase(var Filename: string): boolean;
@@ -303,7 +297,6 @@ type
     property OnWriteFile: TPas2jsWriteFileEvent read FOnWriteFile write FOnWriteFile;
   end;
 
-
 {$IFDEF Pas2js}
 function PtrStrToStr(StrAsPtr: Pointer): string;
 function PtrFilenameToKeyName(FilenameAsPtr: Pointer): string;
@@ -1203,7 +1196,6 @@ begin
   inherited Create(aCache);
 end;
 
-
 { TPas2jsFilesCache }
 
 procedure TPas2jsFilesCache.RegisterMessages;
@@ -1221,28 +1213,6 @@ begin
   Result:=False;
 end;
 
-function TPas2jsFilesCache.GetStrictFileCase : Boolean;
-
-begin
-  Result:=caoStrictFileCase in Options;
-end;
-
-function TPas2jsFilesCache.GetSearchLikeFPC: boolean;
-begin
-  Result:=caoSearchLikeFPC in Options;
-end;
-
-function TPas2jsFilesCache.GetShowFullFilenames: boolean;
-begin
-  Result:=caoShowFullFilenames in Options;
-end;
-
-function TPas2jsFilesCache.GetShowTriedUsedFiles: boolean;
-begin
-  Result:=caoShowTriedUsedFiles in Options;
-end;
-
-
 procedure TPas2jsFilesCache.SetBaseDirectory(AValue: string);
 begin
   AValue:=Pas2jsFileUtils.ExpandDirectory(AValue);
@@ -1363,26 +1333,6 @@ begin
   DirectoryCache.OnReadDirectory:=AValue;
 end;
 
-procedure TPas2jsFilesCache.SetSearchLikeFPC(const AValue: boolean);
-begin
-  SetOption(caoSearchLikeFPC,AValue);
-end;
-
-procedure TPas2jsFilesCache.SetShowFullFilenames(const AValue: boolean);
-begin
-  SetOption(caoShowFullFilenames,AValue);
-end;
-
-procedure TPas2jsFilesCache.SetShowTriedUsedFiles(const AValue: boolean);
-begin
-  SetOption(caoShowTriedUsedFiles,AValue);
-end;
-
-procedure TPas2jsFilesCache.SetStrictFileCase(AValue: Boolean);
-begin
-  SetOption(caoStrictFileCase,aValue)
-end;
-
 function TPas2jsFilesCache.ReadFile(Filename: string; var Source: string
   ): boolean;
 {$IFDEF Pas2js}
@@ -1509,6 +1459,7 @@ begin
   FreeAndNil(FIncludePaths);
   FreeAndNil(FForeignUnitPaths);
   FreeAndNil(FUnitPaths);
+  FreeAndNil(FPCUPaths);
   inherited Destroy;
 end;
 
@@ -1525,6 +1476,7 @@ begin
   FUnitPathsFromCmdLine:=0;
   FIncludePaths.Clear;
   FIncludePathsFromCmdLine:=0;
+  FreeAndNil(FPCUPaths);
   // FOnReadFile: TPas2jsReadFileEvent; keep
   // FOnWriteFile: TPas2jsWriteFileEvent; keep
 end;
@@ -1553,9 +1505,24 @@ begin
 end;
 
 procedure TPas2jsFilesCache.GetPCUDirs(aList: TStrings; const aBaseDir: String);
+var
+  i: Integer;
+begin
+  if FPCUPaths=nil then
+    begin
+    FPCUPaths:=TStringList.Create;
+    inherited GetPCUDirs(FPCUPaths, aBaseDir);
+    FPCUPaths.AddStrings(UnitPaths);
+    for i:=0 to FPCUPaths.Count-1 do
+      FPCUPaths[i]:=IncludeTrailingPathDelimiter(FPCUPaths[i]);
+    DeleteDuplicateFiles(FPCUPaths);
+    end;
+  aList.Assign(FPCUPaths);
+end;
+
+function TPas2jsFilesCache.PCUExists(var aFileName: string): Boolean;
 begin
-  inherited GetPCUDirs(aList, aBaseDir);
-  aList.AddStrings(UnitPaths);
+  Result:=SearchLowUpCase(aFileName);
 end;
 
 function TPas2jsFilesCache.SameFileName(const File1, File2: String): Boolean;
@@ -1575,7 +1542,6 @@ begin
   Result:=ErrorMsg='';
 end;
 
-
 function TPas2jsFilesCache.AddUnitPaths(const Paths: string;
   FromCmdLine: boolean; out ErrorMsg: string): boolean;
 begin
@@ -1619,7 +1585,7 @@ end;
 
 
 
-function TPas2jsFilesCache.DirectoryExists(Const Filename: string): boolean;
+function TPas2jsFilesCache.DirectoryExists(const Filename: string): boolean;
 begin
   Result:=DirectoryCache.DirectoryExists(FileName);
 end;
@@ -1671,7 +1637,6 @@ begin
       raise EFileNotFoundError.Create('invalid file name "'+Filename+'"');
 end;
 
-
 procedure TPas2jsFilesCache.GetListing(const aDirectory: string;
   var Files: TStrings; FullPaths: boolean);
 begin
@@ -1924,11 +1889,15 @@ end;
 
 
 function TPas2jsFilesCache.FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String;
+var
+  SearchedDirs: TStringList;
 
   function SearchInDir(Dir: string; var Filename: string): boolean;
   // search in Dir for pp, pas, p times given case, lower case, upper case
   begin
     Dir:=IncludeTrailingPathDelimiter(Dir);
+    if IndexOfFile(SearchedDirs,Dir)>=0 then exit;
+    SearchedDirs.Add(Dir);
     Filename:=Dir+aUnitname+'.pp';
     if SearchLowUpCase(Filename) then exit(true);
     Filename:=Dir+aUnitname+'.pas';
@@ -1944,38 +1913,42 @@ var
 begin
   Result:='';
   IsForeign:=false;
-
-  if InFilename<>'' then
-  begin
-    aFilename:=SetDirSeparators(InFilename);
-    Result:=ResolveDots(aFilename);
-    if FilenameIsAbsolute(Result) then
-    begin
-      if SearchLowUpCase(Result) then exit;
-    end else
+  SearchedDirs:=TStringList.Create;
+  try
+    if InFilename<>'' then
     begin
-      Result:=ResolveDots(BaseDirectory+Result);
-      if SearchLowUpCase(Result) then exit;
+      aFilename:=SetDirSeparators(InFilename);
+      Result:=ResolveDots(aFilename);
+      if FilenameIsAbsolute(Result) then
+      begin
+        if SearchLowUpCase(Result) then exit;
+      end else
+      begin
+        Result:=ResolveDots(BaseDirectory+Result);
+        if SearchLowUpCase(Result) then exit;
+      end;
+      exit('');
     end;
-    exit('');
-  end;
 
-  // first search in foreign unit paths
-  IsForeign:=true;
-  for i:=0 to ForeignUnitPaths.Count-1 do
-    if SearchInDir(ForeignUnitPaths[i],Result) then
-    begin
-      IsForeign:=true;
-      exit;
-    end;
+    // first search in foreign unit paths
+    IsForeign:=true;
+    for i:=0 to ForeignUnitPaths.Count-1 do
+      if SearchInDir(ForeignUnitPaths[i],Result) then
+      begin
+        IsForeign:=true;
+        exit;
+      end;
 
-  // then in BaseDirectory
-  IsForeign:=false;
-  if SearchInDir(BaseDirectory,Result) then exit;
+    // then in BaseDirectory
+    IsForeign:=false;
+    if SearchInDir(BaseDirectory,Result) then exit;
 
-  // finally search in unit paths
-  for i:=0 to UnitPaths.Count-1 do
-    if SearchInDir(UnitPaths[i],Result) then exit;
+    // finally search in unit paths
+    for i:=0 to UnitPaths.Count-1 do
+      if SearchInDir(UnitPaths[i],Result) then exit;
+  finally
+    SearchedDirs.Free;
+  end;
 
   Result:='';
 end;

packages/pastojs/src/pas2jsfiler.pp

@@ -2130,7 +2130,7 @@ begin
   WriteModeSwitches(Obj,'FinalModeSwitches',Scanner.CurrentModeSwitches,InitialFlags.Modeswitches);
   WriteBoolSwitches(Obj,'FinalBoolSwitches',Scanner.CurrentBoolSwitches,InitialFlags.BoolSwitches);
   if InitialFlags.ConverterOptions<>Converter.Options then
-    RaiseMsg(20180314185555);
+    RaiseMsg(20180314185555,'InitialFlags='+dbgs(InitialFlags.ConverterOptions)+' Converter='+dbgs(Converter.Options));
   // ToDo: write final flags: used defines, used macros
 end;
 
@@ -7853,9 +7853,7 @@ end;
 
 initialization
   PrecompileFormats:=TPas2JSPrecompileFormats.Create;
-  {$IFDEF EnablePas2jsPrecompiled}
-  PrecompileFormats.Add('pcu','all used units must be pcu too',TPCUReader,TPCUWriter);
-  {$ENDIF}
+  PrecompileFormats.Add('pcu','all used pcu must match exactly',TPCUReader,TPCUWriter);
 finalization
   PrecompileFormats.Free;
   PrecompileFormats:=nil;

packages/pastojs/src/pas2jsfs.pp

@@ -61,7 +61,7 @@ Type
     property Source: string read FSource;
     property SrcPos: integer read FSrcPos;
   public
-    Constructor Create(Const aFileName, aSource : String); overload;
+    Constructor Create(Const aFileName, aSource: String); overload;
     function IsEOF: Boolean; override;
     function ReadLine: string; override;
     property LineNumber: integer read FLineNumber;
@@ -90,7 +90,7 @@ Type
   Protected
     // Not to be overridden
     procedure SetOption(Flag: TP2jsFSOption; Enable: boolean);
-    Function OptionIsSet(Index : Integer) :  Boolean;
+    Function OptionIsSet(Index: Integer):  Boolean;
   Protected
     // Protected Abstract. Must be overridden
     function FindSourceFileName(const aFilename: string): String; virtual; abstract;
@@ -98,28 +98,30 @@ Type
     // Public Abstract. Must be overridden
     function FindIncludeFileName(const aFilename: string): String; virtual; abstract;
     function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract;
-    Function FileExists(Const aFileName : String) : Boolean; virtual; abstract;
+    Function FileExists(Const aFileName: String): Boolean; virtual; abstract;
     function FindUnitJSFileName(const aUnitFilename: string): String; virtual; abstract;
     function FindCustomJSFileName(const aFilename: string): String; virtual; abstract;
     function FindUnitFileName(const aUnitname, InFilename: string; out IsForeign: boolean): String; virtual; abstract;
     procedure SaveToFile(ms: TFPJSStream; Filename: string); virtual; abstract;
-    Function PCUExists(var aFileName : string) : Boolean; virtual;
+    function PCUExists(var aFileName: string): Boolean; virtual;
     procedure GetPCUDirs(aList: TStrings; const aBaseDir: String); virtual;
   Public
     // Public, may be overridden
-    Function SameFileName(Const File1,File2 : String) : Boolean; virtual;
-    Function File1IsNewer(Const File1,File2 : String) : Boolean; virtual;
+    Function SameFileName(Const File1,File2: String): Boolean; virtual;
+    Function File1IsNewer(Const File1,File2: String): Boolean; virtual;
     function ExpandDirectory(const Filename: string): string; virtual;
     function ExpandFileName(const Filename: string): string; virtual;
     function ExpandExecutable(const Filename: string): string; virtual;
-    Function FormatPath(Const aFileName : string) : String; virtual;
-    Function DirectoryExists(Const aDirectory : string) : boolean; virtual;
+    Function FormatPath(Const aFileName: string): String; virtual;
+    Function DirectoryExists(Const aDirectory: string): boolean; virtual;
     function TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String): Boolean; virtual;
+    procedure DeleteDuplicateFiles(List: TStrings); virtual;
+    function IndexOfFile(FileList: TStrings; aFilename: string; Start: integer = 0): integer; virtual;// -1 if not found
     Procedure WriteFoldersAndSearchPaths; virtual;
     function CreateResolver: TPas2jsFSResolver; virtual;
     // On success, return '', On error, return error message.
-    Function AddForeignUnitPath(Const aValue : String; FromCmdLine : Boolean) : String; virtual;
-    Function HandleOptionPaths(C : Char; aValue : String; FromCmdLine : Boolean) : String; virtual;
+    Function AddForeignUnitPath(Const aValue: String; FromCmdLine: Boolean): String; virtual;
+    Function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; virtual;
   Public
     Constructor Create; virtual;
     Procedure Reset; virtual;
@@ -129,7 +131,7 @@ Type
     property ShowFullPaths: boolean Index 0 Read OptionIsSet Write SetOptionFromIndex;
     property ShowTriedUsedFiles: boolean Index 1 read OptionIsSet Write SetOptionFromIndex;
     property SearchLikeFPC: boolean index 2 read OptionIsSet Write SetOptionFromIndex;
-    Property StrictFileCase : Boolean Index 3 Read OptionIsSet Write SetOptionFromIndex;
+    Property StrictFileCase: Boolean Index 3 Read OptionIsSet Write SetOptionFromIndex;
     property MainOutputPath: string read FDefaultOutputPath write SetDefaultOutputPath; // includes trailing pathdelim
     property UnitOutputPath: string read FUnitOutputPath write SetUnitOutputPath; // includes trailing pathdelim
   end;
@@ -142,13 +144,13 @@ Type
     FFS: TPas2JSFS;
     FSource: string;
   Protected
-    Procedure SetSource(aSource : String);
+    Procedure SetSource(aSource: String);
   public
     constructor Create(aFS: TPas2jsFS; const aFilename: string);
     function CreateLineReader(RaiseOnError: boolean): TSourceLineReader; virtual; abstract;
     function Load(RaiseOnError: boolean; Binary: boolean): boolean; virtual; abstract;
     property Source: string read FSource; // UTF-8 without BOM or Binary
-    Property FS : TPas2JSFS Read FFS;
+    Property FS: TPas2JSFS Read FFS;
     property Filename: string read FFilename;
   end;
 
@@ -158,7 +160,7 @@ Type
   private
     FFS: TPas2jsFS;
   public
-    constructor Create(aFS : TPas2jsFS); reintroduce;
+    constructor Create(aFS: TPas2jsFS); reintroduce;
     // Redirect all calls to FS.
     function FindIncludeFileName(const aFilename: string): String; override;
     function FindIncludeFile(const aFilename: string): TLineReader; override;
@@ -199,7 +201,7 @@ begin
     Exclude(FOptions,Flag);
 end;
 
-function TPas2JSFS.OPtionIsSet(Index: Integer): Boolean;
+function TPas2JSFS.OptionIsSet(Index: Integer): Boolean;
 begin
   Result:=TP2jsFSOption(Index) in FOptions;
 end;
@@ -209,11 +211,11 @@ begin
   Result:=Self.FileExists(aFileName);
 end;
 
-procedure TPas2JSFS.GetPCUDirs(aList: TStrings; Const aBaseDir : String);
+procedure TPas2JSFS.GetPCUDirs(aList: TStrings; const aBaseDir: String);
 begin
   if UnitOutputPath<>'' then
-    Alist.Add(UnitOutputPath);
-  Alist.Add(aBaseDir);
+    aList.Add(UnitOutputPath);
+  aList.Add(aBaseDir);
 end;
 
 function TPas2JSFS.SameFileName(const File1, File2: String): Boolean;
@@ -227,7 +229,7 @@ begin
   if File1=File2 then ;
 end;
 
-function TPas2JSFS.ExpandDirectory(const Filename : String): string;
+function TPas2JSFS.ExpandDirectory(const Filename: string): string;
 begin
   Result:=FileName;
 end;
@@ -237,7 +239,7 @@ begin
   Result:=FileName;
 end;
 
-function TPas2JSFS.ExpandExecutable(const Filename : string): string;
+function TPas2JSFS.ExpandExecutable(const Filename: string): string;
 begin
   Result:=FileName
 end;
@@ -260,6 +262,27 @@ begin
   if (BaseDirectory='') or UsePointDirectory then ;
 end;
 
+procedure TPas2JSFS.DeleteDuplicateFiles(List: TStrings);
+var
+  i, j: Integer;
+begin
+  for i:=0 to List.Count-2 do
+    for j:=List.Count-1 downto i+1 do
+      if SameFileName(List[i],List[j]) then
+        List.Delete(j);
+end;
+
+function TPas2JSFS.IndexOfFile(FileList: TStrings; aFilename: string;
+  Start: integer): integer;
+var
+  i: Integer;
+begin
+  if FileList<>nil then
+    for i:=Start to FileList.Count-1 do
+      if SameFileName(FileList[i],aFilename) then exit(i);
+  Result:=-1;
+end;
+
 procedure TPas2JSFS.WriteFoldersAndSearchPaths;
 begin
   // Do nothing
@@ -278,7 +301,7 @@ end;
 
 function TPas2JSFS.HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String;
 begin
-  Result:='Invalid parameter : -F'+C+aValue;
+  Result:='Invalid parameter: -F'+C+aValue;
   if FromCmdLine then ;
 end;
 
@@ -299,14 +322,14 @@ begin
   Inc(FReadLineCounter);
 end;
 
-procedure TPas2jsFS.SetDefaultOutputPath(AValue: string);
+procedure TPas2JSFS.SetDefaultOutputPath(AValue: string);
 begin
   AValue:=ExpandDirectory(AValue);
   if FDefaultOutputPath=AValue then Exit;
   FDefaultOutputPath:=AValue;
 end;
 
-procedure TPas2jsFS.SetUnitOutputPath(AValue: string);
+procedure TPas2JSFS.SetUnitOutputPath(AValue: string);
 
 begin
   AValue:=ExpandDirectory(AValue);
@@ -333,8 +356,7 @@ begin
   inc(FLineNumber);
 end;
 
-Constructor TSourceLineReader.Create(Const aFileName, aSource : String);
-
+Constructor TSourceLineReader.Create(Const aFileName, aSource: String);
 begin
   Inherited Create(aFileName);
   FSource:=aSource;

packages/pastojs/src/pas2jsfscompiler.pp

@@ -23,7 +23,8 @@ unit Pas2JSFSCompiler;
 interface
 
 uses
-  Classes, SysUtils, pastree, PScanner, PasUseAnalyzer,
+  Classes, SysUtils,
+  PasUseAnalyzer,
   Pas2jsFileCache, Pas2jsCompiler,
   Pas2JSFS,
   FPPas2Js, Pas2jsFileUtils;
@@ -65,21 +66,21 @@ begin
   Result:=LowerCase(aFile.PasUnitName);
 end;
 {$ELSE}
-function CompareCompilerFilesPasFile(Item1, Item2: Pointer): integer;
+function CompareCompilerFiles_UnitFilename(Item1, Item2: Pointer): integer;
 var
   File1: TPas2JSCompilerFile absolute Item1;
   File2: TPas2JSCompilerFile absolute Item2;
 begin
-  Result:=CompareFilenames(File1.PasFilename,File2.PasFilename);
+  Result:=CompareFilenames(File1.UnitFilename,File2.UnitFilename);
 end;
 
-function CompareFileAndCompilerFilePasFile(Filename, Item: Pointer): integer;
+function CompareFileAndCompilerFile_UnitFilename(Filename, Item: Pointer): integer;
 var
   aFile: TPas2JSCompilerFile absolute Item;
   aFilename: String;
 begin
   aFilename:=AnsiString(Filename);
-  Result:=CompareFilenames(aFilename,aFile.PasFilename);
+  Result:=CompareFilenames(aFilename,aFile.UnitFilename);
 end;
 
 function CompareCompilerFilesPasUnitname(Item1, Item2: Pointer): integer;
@@ -90,7 +91,7 @@ begin
   Result:=CompareText(File1.PasUnitName,File2.PasUnitName);
 end;
 
-function CompareUnitnameAndCompilerFile(TheUnitname, Item: Pointer): integer;
+function CompareUnitnameAndCompilerFile_PasUnitName(TheUnitname, Item: Pointer): integer;
 var
   aFile: TPas2JSCompilerFile absolute Item;
   anUnitname: String;
@@ -116,8 +117,8 @@ begin
   Result:=FS as TPas2jsFilesCache;
 end;
 
-function TPas2jsFSCompiler.OnMacroEnv(Sender: TObject; var Params: string; Lvl: integer): boolean;
-
+function TPas2jsFSCompiler.OnMacroEnv(Sender: TObject; var Params: string;
+  Lvl: integer): boolean;
 begin
   if Lvl=0 then ;
   Params:=GetEnvironmentVariablePJ(Params);
@@ -138,14 +139,14 @@ begin
           {$IFDEF Pas2js}
           @Pas2jsCompilerFile_FilenameToKeyName,@PtrFilenameToKeyName
           {$ELSE}
-          @CompareCompilerFilesPasFile,@CompareFileAndCompilerFilePasFile
+          @CompareCompilerFiles_UnitFilename,@CompareFileAndCompilerFile_UnitFilename
           {$ENDIF});
     kcUnitName:
       Result:=TPasAnalyzerKeySet.Create(
         {$IFDEF Pas2js}
         @Pas2jsCompilerFile_UnitnameToKeyName,@PtrUnitnameToKeyName
         {$ELSE}
-        @CompareCompilerFilesPasUnitname,@CompareUnitnameAndCompilerFile
+        @CompareCompilerFilesPasUnitname,@CompareUnitnameAndCompilerFile_PasUnitName
         {$ENDIF});
   else
     Raise EPas2jsFileCache.CreateFmt('Internal Unknown key type: %d',[Ord(KeyType)]);

packages/pastojs/src/pas2jslibcompiler.pp

@@ -21,7 +21,9 @@ unit pas2jslibcompiler;
 interface
 
 uses
-  SysUtils, Classes, FPPJsSrcMap, Pas2jsFileCache, Pas2JSCompiler, Pas2jsPCUCompiler, pas2jscompilercfg, pas2jscompilerpp;
+  SysUtils, Classes,
+  FPPJsSrcMap, Pas2jsFileCache, Pas2JSCompiler, Pas2jsPCUCompiler,
+  Pas2JSCompilerCfg, Pas2JSCompilerPP;
 
 { ---------------------------------------------------------------------
   Compiler descendant, usable in library

packages/pastojs/src/pas2jslogger.pp

@@ -29,6 +29,9 @@ interface
 uses
   {$IFDEF Pas2JS}
   JS,
+  {$IFDEF NodeJS}
+  NodeJSFS,
+  {$ENDIF}
   {$ENDIF}
   pas2jsutils,
   {$IFDEF HASFILESYSTEM}
@@ -1072,7 +1075,7 @@ begin
   if FOutputFile<>nil then exit;
   if OutputFilename='' then
     raise Exception.Create('Log has empty OutputFilename');
-   if DirectoryExists(OutputFilename) then
+  if DirectoryExists(OutputFilename) then
     raise Exception.Create('Log is directory: "'+OutputFilename+'"');
 {$ENDIF}
   FOutputFile:=CreateTextWriter(OutputFileName);

packages/pastojs/src/pas2jspcucompiler.pp

@@ -37,6 +37,9 @@ uses
   Pas2jsLogger, Pas2jsFileUtils;
 
 Type
+
+  { TFilerPCUSupport }
+
   TFilerPCUSupport = Class(TPCUSupport)
   Private
     FPCUFormat: TPas2JSPrecompileFormat;
@@ -48,37 +51,37 @@ Type
     function OnWriterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
     procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar; out Count: integer);
   Public
-    constructor create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
-    Destructor destroy; override;
-    Function Compiler : TPas2JSCompiler;
-    Function HandleException(E: exception) : Boolean; override;
-    function FindPCU(const UseUnitName: string): string;override;
+    constructor Create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat); reintroduce;
+    destructor Destroy; override;
+    function Compiler: TPas2JSCompiler;
+    function HandleException(E: Exception): Boolean; override;
+    function FindPCU(const UseUnitName: string): string; override;
     function FindPCU(const UseUnitName: string; out aFormat: TPas2JSPrecompileFormat): string;
-    Function HasReader : Boolean; override;
-    Function ReadContinue: Boolean; override;
-    Function ReadCanContinue : Boolean; override;
-    Procedure SetInitialCompileFlags; override;
-    Procedure WritePCU; override;
+    function HasReader: Boolean; override;
+    function ReadContinue: Boolean; override;
+    function ReadCanContinue: Boolean; override;
+    procedure SetInitialCompileFlags; override;
+    procedure WritePCU; override;
     procedure CreatePCUReader; override;
-    Procedure ReadUnit; override;
+    procedure ReadUnit; override;
     property PrecompileInitialFlags: TPCUInitialFlags read FPrecompileInitialFlags;
   end;
 
   { TPas2jsPCUCompilerFile }
 
   TPas2jsPCUCompilerFile = Class(TPas2jsCompilerFile)
-    Function CreatePCUSupport: TPCUSupport; override;
+    function CreatePCUSupport: TPCUSupport; override;
   end;
 
   { TPas2jsPCUCompiler }
 
   TPas2jsPCUCompiler = Class(TPas2JSFSCompiler)
   Private
-    FPrecompileFormat : TPas2JSPrecompileFormat;
+    FPrecompileFormat: TPas2JSPrecompileFormat;
   Protected
     procedure WritePrecompiledFormats; override;
-    function CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile; override;
-    Procedure HandleOptionPCUFormat(Value : string) ; override;
+    function CreateCompilerFile(const PasFileName, PCUFilename: String): TPas2jsCompilerFile; override;
+    procedure HandleOptionPCUFormat(Value: string) ; override;
   end;
 
 implementation
@@ -91,19 +94,21 @@ implementation
 
 { TFilerPCUSupport }
 
-constructor TFilerPCUSupport.create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
+constructor TFilerPCUSupport.Create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
 begin
   Inherited Create(aCompilerFile);
   FPCUFormat:=AFormat;
+  if FPCUFormat=nil then
+    RaiseInternalError(20181207143653,aCompilerFile.UnitFilename);
   FPrecompileInitialFlags:=TPCUInitialFlags.Create;
 end;
 
-destructor TFilerPCUSupport.destroy;
+destructor TFilerPCUSupport.Destroy;
 begin
   FreeAndNil(FPrecompileInitialFlags);
   FreeAndNil(FPCUReader);
   FreeAndNil(FPCUReaderStream);
-  inherited destroy;
+  inherited Destroy;
 end;
 
 function TFilerPCUSupport.Compiler: TPas2JSCompiler;
@@ -111,7 +116,7 @@ begin
   Result:=MyFile.Compiler;
 end;
 
-Function TFilerPCUSupport.HandleException(E: Exception) : Boolean;
+function TFilerPCUSupport.HandleException(E: Exception): Boolean;
 
 begin
   Result:=False;
@@ -119,11 +124,9 @@ begin
     begin
     Result:=True;
     if EPas2JsReadError(E).Owner is TPCUCustomReader then
-      begin
-        MyFile.Log.Log(mtError,E.Message,0,MyFile.PCUFilename);
-      end else begin
-        MyFile.Log.Log(mtError,E.Message);
-      end;
+      MyFile.Log.Log(mtError,E.Message,0,MyFile.PCUFilename)
+    else
+      MyFile.Log.Log(mtError,E.Message);
     Compiler.Terminate(ExitCodePCUError);
     end
   else if (E is EPas2JsWriteError) then
@@ -136,8 +139,12 @@ end;
 
 function TFilerPCUSupport.FindPCU(const UseUnitName: string): string;
 
+var
+  aPCUFormat: TPas2JSPrecompileFormat;
 begin
-  Result:=FindPCU(UseUnitName,FPCUFormat);
+  Result:=FindPCU(UseUnitName,aPCUFormat);
+  if (Result<>'') and (FPCUFormat<>aPCUFormat) then
+    RaiseInternalError(20181207143826,UseUnitName);
 end;
 
 function TFilerPCUSupport.HasReader: Boolean;
@@ -230,7 +237,7 @@ function TFilerPCUSupport.FindPCU(const UseUnitName: string;
   end;
 
 var
-  L : TstringList;
+  L: TstringList;
   i: Integer;
 
 begin
@@ -263,7 +270,7 @@ var
   ms: TMemoryStream;
   DestDir: String;
   JS: TJSElement;
-  FN : String;
+  FN: String;
 
 begin
   if FPCUFormat=Nil then
@@ -311,10 +318,12 @@ begin
     MyFile.Converter.OnIsTypeInfoUsed:=@OnPCUConverterIsTypeInfoUsed;
     JS:=MyFile.Converter.ConvertPasElement(MyFile.PasModule,MyFile.PascalResolver);
     MyFile.Converter.Options:=MyFile.Converter.Options-[coStoreImplJS];
+    MyFile.PCUSupport.SetInitialCompileFlags;
     {$IFDEF REALLYVERBOSE}
     writeln('TPas2jsCompilerFile.WritePCU create pcu ... ',MyFile.PCUFilename);
     {$ENDIF}
-    Writer.WritePCU(MyFile.PascalResolver,MyFile.Converter,PrecompileInitialFlags,ms,AllowCompressed);
+    Writer.WritePCU(MyFile.PascalResolver,MyFile.Converter,
+                    PrecompileInitialFlags,ms,AllowCompressed);
     {$IFDEF REALLYVERBOSE}
     writeln('TPas2jsCompilerFile.WritePCU precompiled ',MyFile.PCUFilename);
     {$ENDIF}
@@ -387,34 +396,30 @@ end;
 
 { TPas2jsPCUCompiler }
 
-
-
 procedure TPas2jsPCUCompiler.WritePrecompiledFormats;
-
 Var
-  I : Integer;
-
+  I: Integer;
 begin
   if PrecompileFormats.Count>0 then
   begin
-    writeHelpLine('   -JU<x> : Create precompiled units in format x.');
+    writeHelpLine('   -JU<x>: Create precompiled units in format x.');
     for i:=0 to PrecompileFormats.Count-1 do
       with PrecompileFormats[i] do
-        writeHelpLine('     -JU'+Ext+' : '+Description);
-    writeHelpLine('     -JU- : Disable prior -JU<x> option. Do not create precompiled units.');
+        writeHelpLine('     -JU'+Ext+': '+Description);
+    writeHelpLine('     -JU-: Disable prior -JU<x> option. Do not create precompiled units.');
   end;
 end;
 
-function TPas2jsPCUCompiler.CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile;
+function TPas2jsPCUCompiler.CreateCompilerFile(const PasFileName,
+  PCUFilename: String): TPas2jsCompilerFile;
 begin
-  Result:=TPas2JSPCUCompilerFile.Create(Self,UnitFileName);
+  Result:=TPas2JSPCUCompilerFile.Create(Self,PasFileName,PCUFilename);
 end;
 
 procedure TPas2jsPCUCompiler.HandleOptionPCUFormat(Value: string);
-
 Var
-  Found : Boolean;
-  I : integer;
+  Found: Boolean;
+  I: integer;
   PF: TPas2JSPrecompileFormat;
 begin
   Found:=false;
@@ -422,7 +427,7 @@ begin
   begin
     PF:=PrecompileFormats[i];
     if not SameText(Value,PF.Ext) then continue;
-      FPrecompileFormat:=PrecompileFormats[i];
+    FPrecompileFormat:=PrecompileFormats[i];
     Found:=true;
   end;
   if not Found then

packages/pastojs/tests/tcfiler.pas

@@ -24,7 +24,7 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, testregistry,
-  PasTree, PScanner, PasResolver, PasResolveEval, PParser, PasUseAnalyzer,
+  PasTree, PScanner, PParser, PasResolveEval, PasResolver, PasUseAnalyzer,
   FPPas2Js, Pas2JsFiler,
   tcmodules, jstree;
 

packages/pastojs/tests/tcmodules.pas

@@ -17,7 +17,7 @@
     ./testpas2js --suite=TTestModule.TestEmptyProgram
     ./testpas2js --suite=TTestModule.TestEmptyUnit
 }
-unit tcmodules;
+unit TCModules;
 
 {$mode objfpc}{$H+}
 
@@ -327,6 +327,16 @@ type
     Procedure TestProc_LocalVarAbsolute;
     Procedure TestProc_ReservedWords;
 
+    // anonymous functions
+    Procedure TestAnonymousProc_Assign_ObjFPC;
+    Procedure TestAnonymousProc_Assign_Delphi;
+    Procedure TestAnonymousProc_Arg;
+    Procedure TestAnonymousProc_Typecast;
+    Procedure TestAnonymousProc_With;
+    Procedure TestAnonymousProc_ExceptOn;
+    Procedure TestAnonymousProc_Nested;
+    Procedure TestAnonymousProc_NestedAssignResult;
+
     // enums, sets
     Procedure TestEnum_Name;
     Procedure TestEnum_Number;
@@ -3966,6 +3976,388 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestAnonymousProc_Assign_ObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '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;',// test semicolon
+  '  a:=3;',
+  'end;',
+  'begin',
+  '  Func:=function(c:word):word begin',
+  '    Result:=3+c;',
+  '    exit(c);',
+  '    exit(Result);',
+  '  end;']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Assign_ObjFPC',
+    LinesToStr([ // statements
+    'this.Func = null;',
+    'this.DoIt = function (a) {',
+    '  $mod.Func = function (b) {',
+    '    var Result = 0;',
+    '    Result = a + b;',
+    '    return b;',
+    '    return Result;',
+    '    return Result;',
+    '  };',
+    '  a = 3;',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.Func = function (c) {',
+    '  var Result = 0;',
+    '  Result = 3 + c;',
+    '  return c;',
+    '  return Result;',
+    '  return Result;',
+    '};',
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_Assign_Delphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TProc = reference to procedure(x: word);',
+  'procedure DoIt(a: word);',
+  'var Proc: TProc;',
+  'begin',
+  '  Proc:=procedure(b:word) begin end;',
+  'end;',
+  'var Proc: TProc;',
+  'begin',
+  '  Proc:=procedure(c:word) begin end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Assign_Delphi',
+    LinesToStr([ // statements
+    'this.DoIt = function (a) {',
+    '  var Proc = null;',
+    '  Proc = function (b) {',
+    '  };',
+    '};',
+    'this.Proc = null;',
+    '']),
+    LinesToStr([
+    '$mod.Proc = function (c) {',
+    '};',
+    '']));
+end;
+
+procedure TTestModule.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',
+  '  DoMore(procedure begin end,',
+  '    procedure assembler asm',
+  '      console.log("c");',
+  '    end);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Arg',
+    LinesToStr([ // statements
+    'this.DoMore = function (f, g) {',
+    '};',
+    'this.DoIt = function (f) {',
+    '  $mod.DoIt(function (b) {',
+    '    var Result = 0;',
+    '    Result = 1 + b;',
+    '    return Result;',
+    '  });',
+    '  $mod.DoMore(function () {',
+    '  }, function () {',
+    '  });',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.DoMore(function () {',
+    '}, function () {',
+    '  console.log("c");',
+    '});',
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_Typecast;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  '  TArr = array of word;',
+  '  TFuncArr = reference to function: TArr;',
+  'procedure DoIt(p: TProc);',
+  'var',
+  '  w: word;',
+  '  a: TArr;',
+  'begin',
+  '  p:=TProc(procedure(b: smallint) begin end);',
+  '  a:=TFuncArr(function: TArr begin end)();',
+  '  w:=TFuncArr(function: TArr begin end)()[3];',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Typecast',
+    LinesToStr([ // statements
+    'this.DoIt = function (p) {',
+    '  var w = 0;',
+    '  var a = [];',
+    '  p = function (b) {',
+    '  };',
+    '  a = function () {',
+    '    var Result = [];',
+    '    return Result;',
+    '  }();',
+    '  w = function () {',
+    '    var Result = [];',
+    '    return Result;',
+    '  }()[3];',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_With;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure(w: word);',
+  '  TObject = class',
+  '    b: boolean;',
+  '  end;',
+  'var',
+  '  p: TProc;',
+  '  bird: TObject;',
+  'begin',
+  '  with bird do',
+  '    p:=procedure(w: word)',
+  '      begin',
+  '        b:=w>2;',
+  '      end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_With',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.b = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.p = null;',
+    'this.bird = null;',
+    '']),
+    LinesToStr([
+    'var $with1 = $mod.bird;',
+    '$mod.p = function (w) {',
+    '  $with1.b = w > 2;',
+    '};',
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_ExceptOn;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TObject = class',
+  '    b: boolean;',
+  '  end;',
+  'procedure DoIt;',
+  'var',
+  '  p: TProc;',
+  'begin',
+  '  try',
+  '  except',
+  '    on E: TObject do',
+  '    p:=procedure',
+  '      begin',
+  '        E.b:=true;',
+  '      end;',
+  '  end;',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_ExceptOn',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.b = false;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'this.DoIt = function () {',
+    '  var p = null;',
+    '  try {} catch ($e) {',
+    '    if ($mod.TObject.isPrototypeOf($e)) {',
+    '      var E = $e;',
+    '      p = function () {',
+    '        E.b = true;',
+    '      };',
+    '    } else throw $e',
+    '  };',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_Nested;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  '  TObject = class',
+  '    i: byte;',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure TObject.DoIt;',
+  'var',
+  '  p: TProc;',
+  '  procedure Sub;',
+  '  begin',
+  '    p:=procedure',
+  '      begin',
+  '        i:=3;',
+  '        Self.i:=4;',
+  '        p:=procedure',
+  '            procedure SubSub;',
+  '            begin',
+  '              i:=13;',
+  '              Self.i:=14;',
+  '            end;',
+  '          begin',
+  '            i:=13;',
+  '            Self.i:=14;',
+  '          end;',
+  '      end;',
+  '  end;',
+  'begin',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_Nested',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.i = 0;',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.DoIt = function () {',
+    '    var Self = this;',
+    '    var p = null;',
+    '    function Sub() {',
+    '      p = function () {',
+    '        Self.i = 3;',
+    '        Self.i = 4;',
+    '        p = function () {',
+    '          function SubSub() {',
+    '            Self.i = 13;',
+    '            Self.i = 14;',
+    '          };',
+    '          Self.i = 13;',
+    '          Self.i = 14;',
+    '        };',
+    '      };',
+    '    };',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
+procedure TTestModule.TestAnonymousProc_NestedAssignResult;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TProc = reference to procedure;',
+  'function DoIt: TProc;',
+  '  function Sub: TProc;',
+  '  begin',
+  '    Result:=procedure',
+  '      begin',
+  '        Sub:=procedure',
+  '            procedure SubSub;',
+  '            begin',
+  '              Result:=nil;',
+  '              Sub:=nil;',
+  '              DoIt:=nil;',
+  '            end;',
+  '          begin',
+  '            Result:=nil;',
+  '            Sub:=nil;',
+  '            DoIt:=nil;',
+  '          end;',
+  '      end;',
+  '  end;',
+  'begin',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestAnonymousProc_NestedAssignResult',
+    LinesToStr([ // statements
+    'this.DoIt = function () {',
+    '  var Result = null;',
+    '  function Sub() {',
+    '    var Result$1 = null;',
+    '    Result$1 = function () {',
+    '      Result$1 = function () {',
+    '        function SubSub() {',
+    '          Result$1 = null;',
+    '          Result$1 = null;',
+    '          Result = null;',
+    '        };',
+    '        Result$1 = null;',
+    '        Result$1 = null;',
+    '        Result = null;',
+    '      };',
+    '    };',
+    '    return Result$1;',
+    '  };',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestEnum_Name;
 begin
   StartProgram(false);

packages/pastojs/tests/tcprecompile.pas

@@ -17,7 +17,7 @@
     ./testpas2js --suite=TTestCLI_Precompile
     ./testpas2js --suite=TTestModule.TestEmptyUnit
 }
-unit tcprecompile;
+unit TCPrecompile;
 
 {$mode objfpc}{$H+}
 
@@ -26,7 +26,7 @@ interface
 uses
   Classes, SysUtils,
   fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler, Pas2jsCompiler,
-  tcunitsearch, tcmodules;
+  TCUnitSearch, TCModules;
 
 type
 
@@ -115,6 +115,8 @@ begin
     JSFile:=FindFile(JSFilename);
     OrigSrc:=JSFile.Source;
     // compile, using .pcu files
+    //for i:=0 to FileCount-1 do
+    //  writeln('TCustomTestCLI_Precompile.CheckPrecompile ',i,' ',Files[i].Filename);
     {$IFDEF VerbosePCUFiler}
     writeln('TTestCLI_Precompile.CheckPrecompile compile using pcu files==================');
     {$ENDIF}
@@ -285,7 +287,7 @@ begin
    'end;']);
   AddUnit('src/unit2.pp',
   ['uses unit1;',
-  'procedure Do2(j: integer);'],
+   'procedure Do2(j: integer);'],
   ['procedure Do2(j: integer);',
    'begin',
    '  unit1.i:=j;',

packages/pastojs/tests/tcunitsearch.pas

@@ -18,7 +18,7 @@
     ./testpas2js --suite=TestUS_Program
     ./testpas2js --suite=TestUS_UsesEmptyFileFail
 }
-unit tcunitsearch;
+unit TCUnitSearch;
 
 {$mode objfpc}{$H+}
 
@@ -29,14 +29,14 @@ uses
   fpcunit, testregistry,
   PScanner, PasTree,
   {$IFDEF CheckPasTreeRefCount}PasResolveEval,{$ENDIF}
-  Pas2jsFileUtils, Pas2jsCompiler, Pas2JSFSCompiler, Pas2jsFileCache, Pas2jsLogger,
+  Pas2jsFileUtils, Pas2jsCompiler, Pas2JSPCUCompiler, Pas2jsFileCache, Pas2jsLogger,
   tcmodules;
 
 type
 
   { TTestCompiler }
 
-  TTestCompiler = class(TPas2jsFSCompiler)
+  TTestCompiler = class(TPas2jsPCUCompiler)
   private
     FExitCode: longint;
   protected

packages/pastojs/tests/testpas2js.lpi

@@ -49,6 +49,7 @@
       <Unit3>
         <Filename Value="tcmodules.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCModules"/>
       </Unit3>
       <Unit4>
         <Filename Value="tcoptimizations.pas"/>
@@ -79,6 +80,7 @@
       <Unit10>
         <Filename Value="tcprecompile.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCPrecompile"/>
       </Unit10>
     </Units>
   </ProjectOptions>

packages/rtl-extra/src/android/unixsock.inc

@@ -1,239 +0,0 @@
-{
-   This file is part of the Free Pascal run time library.
-   (c) 2004 by Marco van de Voort
-   member of the Free Pascal development team.
-
-   See the file COPYING.FPC, included in this distribution,
-   for details about the copyright.
-
-   socket call implementations for Linux
-
-   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.
-}
-
-{$if defined(cpu386)}
-  {$define NEED_SOCKETCALL}
-{$endif}
-
-{******************************************************************************
-                          Basic Socket Functions
-******************************************************************************}
-
-{$ifdef NEED_SOCKETCALL}
-
-Const
-  {
-    Arguments to the Linux Kernel system call for sockets. All
-    Socket Connected calls go through the same system call,
-    with an extra argument to determine what action to take.
-  }
-  Socket_Sys_SOCKET      = 1;
-  Socket_Sys_BIND        = 2;
-  Socket_Sys_CONNECT     = 3;
-  Socket_Sys_LISTEN      = 4;
-  Socket_Sys_ACCEPT      = 5;
-  Socket_Sys_GETSOCKNAME = 6;
-  Socket_Sys_GETPEERNAME = 7;
-  Socket_Sys_SOCKETPAIR  = 8;
-  Socket_Sys_SEND        = 9;
-  Socket_Sys_RECV        = 10;
-  Socket_Sys_SENDTO      = 11;
-  Socket_Sys_RECVFROM    = 12;
-  Socket_Sys_SHUTDOWN    = 13;
-  Socket_Sys_SETSOCKOPT  = 14;
-  Socket_Sys_GETSOCKOPT  = 15;
-  Socket_Sys_SENDMSG     = 16;
-  Socket_Sys_RECVMSG     = 17;
-
-
-Function SocketCall(SockCallNr,a1,a2,a3,a4,a5,a6:TSysParam):cint; inline;
-var
-  Args:array[1..6] of TSysParam;
-begin
-  args[1]:=a1;
-  args[2]:=a2;
-  args[3]:=a3;
-  args[4]:=a4;
-  args[5]:=a5;
-  args[6]:=a6;
-  SocketCall:=do_Syscall(syscall_nr_socketcall,sockcallnr,TSysParam(@args));
-  internal_socketerror:=fpgeterrno;
-end;
-
-
-function SocketCall(SockCallNr,a1,a2,a3:TSysParam):cint;inline;
-begin
-  SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
-end;
-
-function  fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
-begin
-  fpSocket:=SocketCall(Socket_Sys_socket,Domain,xtype,Protocol);
-end;
-
-function  fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
-begin
-  fpSend:=SocketCall(Socket_Sys_sendto,S,TSysParam(msg),Len,Flags,0,0);
-end;
-
-function  fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
-begin
-  fpSendto:=SocketCall(Socket_Sys_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
-end;
-
-function  fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
-begin
-  fpRecv:=SocketCall(Socket_Sys_Recvfrom,S,tsysparam(buf),len,flags,0,0);
-end;
-
-function  fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
-begin
-  fpRecvFrom:=SocketCall(Socket_Sys_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
-end;
-
-function  fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
-begin
-  fpBind:=SocketCall(Socket_Sys_Bind,S,TSysParam(addrx),addrlen);
-end;
-
-function  fplisten (s:cint; backlog : cint):cint;
-begin
-  fpListen:=SocketCall(Socket_Sys_Listen,S,backlog,0);
-end;
-
-function  fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
-begin
-  fpAccept:=SocketCall(Socket_Sys_accept,S,TSysParam(addrx),TSysParam(addrlen));
-end;
-
-function  fpconnect (s:cint; name  : psockaddr; namelen : tsocklen):cint;
-begin
-  fpConnect:=SocketCall(Socket_Sys_connect,S,TSysParam(name),namelen);
-end;
-
-function  fpshutdown (s:cint; how:cint):cint;
-begin
-  fpShutDown:=SocketCall(Socket_Sys_shutdown,S,how,0);
-end;
-
-function  fpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpGetSockName:=SocketCall(Socket_Sys_GetSockName,S,TSysParam(name),TSysParam(namelen));
-end;
-
-function  fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpGetPeerName:=SocketCall(Socket_Sys_GetPeerName,S,TSysParam(name),TSysParam(namelen));
-end;
-
-function  fpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
-begin
-  fpSetSockOpt:=SocketCall(Socket_Sys_SetSockOpt,S,level,optname,TSysParam(optval),optlen,0);
-end;
-
-function  fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
-begin
-  fpGetSockOpt:=SocketCall(Socket_Sys_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen),0);
-end;
-
-function  fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
-begin
-  fpSocketPair:=SocketCall(Socket_Sys_SocketPair,d,xtype,protocol,TSysParam(sv),0,0);
-end;
-
-{$else NEED_SOCKETCALL}
-
-function  fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
-begin
-  fpSocket:=do_syscall(syscall_nr_socket,Domain,xtype,Protocol);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
-begin
-  fpSend:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,0,0);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
-begin
-  fpSendto:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
-begin
-  fpRecv:=do_syscall(syscall_nr_Recvfrom,S,tsysparam(buf),len,flags,0,0);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
-begin
-  fpRecvFrom:=do_syscall(syscall_nr_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
-begin
-  fpBind:=do_syscall(syscall_nr_Bind,S,TSysParam(addrx),addrlen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fplisten (s:cint; backlog : cint):cint;
-begin
-  fpListen:=do_syscall(syscall_nr_Listen,S,backlog);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
-begin
-  fpAccept:=do_syscall(syscall_nr_accept4,S,TSysParam(addrx),TSysParam(addrlen), 0);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpconnect (s:cint; name  : psockaddr; namelen : tsocklen):cint;
-begin
-  fpConnect:=do_syscall(syscall_nr_connect,S,TSysParam(name),namelen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpshutdown (s:cint; how:cint):cint;
-begin
-  fpShutDown:=do_syscall(syscall_nr_shutdown,S,how);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpGetSockName:=do_syscall(syscall_nr_GetSockName,S,TSysParam(name),TSysParam(namelen));
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
-begin
-  fpGetPeerName:=do_syscall(syscall_nr_GetPeerName,S,TSysParam(name),TSysParam(namelen));
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
-begin
-  fpSetSockOpt:=do_syscall(syscall_nr_SetSockOpt,S,level,optname,TSysParam(optval),optlen);
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
-begin
-  fpGetSockOpt:=do_syscall(syscall_nr_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen));
-  internal_socketerror:=fpgeterrno;
-end;
-
-function  fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
-begin
-  fpSocketPair:=do_syscall(syscall_nr_SocketPair,d,xtype,protocol,TSysParam(sv));
-  internal_socketerror:=fpgeterrno;
-end;
-
-{$endif NEED_do_syscall}
-

packages/rtl-extra/src/android/unxsockh.inc

@@ -13,6 +13,10 @@
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 }
 
+{ Use libc for sockets since the "accept" syscall is blocked by SECCOMP,
+  but the "accept4" alternative is not available on old Android versions (2.3 and older). }
+{$define FPC_USE_LIBC}
+
 Const
 {* Supported address families. *}
   AF_UNSPEC     = 0;

packages/rtl-objpas/src/inc/strutils.pp

@@ -2427,7 +2427,12 @@ begin
       Result := True;
     Exit;
   end;
-  if (Len = 0) then Exit;
+  if (Len = 0) then
+  begin
+    Result:=true;
+    N:=0;
+    Exit;
+  end;
   i := 1;
   N := 0;
   Terminated := False;

rtl/android/aarch64/sysnr.inc

@@ -42,8 +42,6 @@ const
   syscall_nr_symlinkat = 36;
   syscall_nr_linkat = 37;
   syscall_nr_renameat = 38;
-  syscall_nr_umount2 = 39; // Blacklisted. Do not use.
-  syscall_nr_mount = 40; // Blacklisted. Do not use.
   syscall_nr_pivot_root = 41;
   syscall_nr_statfs = 43;
   syscall_nr_fstatfs = 44;
@@ -55,7 +53,6 @@ const
   syscall_nr_faccessat = 48;
   syscall_nr_chdir = 49;
   syscall_nr_fchdir = 50;
-  syscall_nr_chroot = 51; // Blacklisted. Do not use.
   syscall_nr_fchmod = 52;
   syscall_nr_fchmodat = 53;
   syscall_nr_fchownat = 54;
@@ -95,7 +92,6 @@ const
   syscall_nr_timerfd_settime = 86;
   syscall_nr_timerfd_gettime = 87;
   syscall_nr_utimensat = 88;
-  syscall_nr_acct = 89; // Blacklisted. Do not use.
   syscall_nr_capget = 90;
   syscall_nr_capset = 91;
   syscall_nr_personality = 92;
@@ -108,19 +104,14 @@ const
   syscall_nr_nanosleep = 101;
   syscall_nr_getitimer = 102;
   syscall_nr_setitimer = 103;
-  syscall_nr_init_module = 105; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 106; // Blacklisted. Do not use.
   syscall_nr_timer_create = 107;
   syscall_nr_timer_gettime = 108;
   syscall_nr_timer_getoverrun = 109;
   syscall_nr_timer_settime = 110;
   syscall_nr_timer_delete = 111;
-  syscall_nr_clock_settime = 112; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 113;
   syscall_nr_clock_getres = 114;
   syscall_nr_clock_nanosleep = 115;
-  syscall_nr_syslog = 116; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_ptrace = 117;
   syscall_nr_sched_setparam = 118;
   syscall_nr_sched_setscheduler = 119;
@@ -146,27 +137,17 @@ const
   syscall_nr_rt_sigreturn = 139;
   syscall_nr_setpriority = 140;
   syscall_nr_getpriority = 141;
-  syscall_nr_reboot = 142; // Blacklisted. Do not use.
   syscall_nr_setregid = 143;
-  syscall_nr_setgid = 144; // Blacklisted. Do not use.
-  syscall_nr_setreuid = 145; // Blacklisted. Do not use.
-  syscall_nr_setuid = 146; // Blacklisted. Do not use.
   syscall_nr_setresuid = 147;
   syscall_nr_getresuid = 148;
-  syscall_nr_setresgid = 149; // Blacklisted. Do not use.
   syscall_nr_getresgid = 150;
-  syscall_nr_setfsuid = 151; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 152; // Blacklisted. Do not use.
   syscall_nr_times = 153;
   syscall_nr_setpgid = 154;
   syscall_nr_getpgid = 155;
   syscall_nr_getsid = 156;
   syscall_nr_setsid = 157;
   syscall_nr_getgroups = 158;
-  syscall_nr_setgroups = 159; // Blacklisted. Do not use.
   syscall_nr_uname = 160;
-  syscall_nr_sethostname = 161; // Blacklisted. Do not use.
-  syscall_nr_setdomainname = 162; // Blacklisted. Do not use.
   syscall_nr_getrlimit = 163;
   syscall_nr_setrlimit = 164;
   syscall_nr_getrusage = 165;
@@ -174,8 +155,6 @@ const
   syscall_nr_prctl = 167;
   syscall_nr_getcpu = 168;
   syscall_nr_gettimeofday = 169;
-  syscall_nr_settimeofday = 170; // Blacklisted. Do not use.
-  syscall_nr_adjtimex = 171; // Blacklisted. Do not use.
   syscall_nr_getpid = 172;
   syscall_nr_getppid = 173;
   syscall_nr_getuid = 174;
@@ -207,8 +186,6 @@ const
   syscall_nr_mmap = 222;
   syscall_nr_mmap64 = syscall_nr_mmap;
   syscall_nr_fadvise64 = 223;
-  syscall_nr_swapon = 224; // Blacklisted. Do not use.
-  syscall_nr_swapoff = 225; // Blacklisted. Do not use.
   syscall_nr_mprotect = 226;
   syscall_nr_msync = 227;
   syscall_nr_mlock = 228;
@@ -224,7 +201,6 @@ const
   syscall_nr_wait4 = 260;
   syscall_nr_prlimit64 = 261;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 266; // Blacklisted. Do not use.
   syscall_nr_syncfs = 267;
   syscall_nr_setns = 268;
   syscall_nr_sendmmsg = 269;
@@ -241,3 +217,31 @@ const
   syscall_nr_copy_file_range = 285;
   syscall_nr_preadv2 = 286;
   syscall_nr_pwritev2 = 287;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_umount2 = 39 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_mount = 40 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 51 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 89 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 105 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 106 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 112 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_syslog = 116 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 116 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 142 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 144 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 145 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 146 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 149 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 151 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 152 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 159 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 161 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 162 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 170 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 171 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 224 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 225 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 266 deprecated 'This syscall is blocked on Android 8+';

rtl/android/arm/sysnr.inc

@@ -16,7 +16,6 @@ const
   syscall_nr_chdir = 12;
   syscall_nr_lseek = 19;
   syscall_nr_getpid = 20;
-  syscall_nr_mount = 21; // Blacklisted. Do not use.
   syscall_nr_getuid = 24;
   syscall_nr_ptrace = 26;
   syscall_nr_access = 33;
@@ -28,52 +27,36 @@ const
   syscall_nr_pipe = 42;
   syscall_nr_times = 43;
   syscall_nr_brk = 45;
-  syscall_nr_acct = 51; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 52; // Blacklisted. Do not use.
   syscall_nr_ioctl = 54;
   syscall_nr_fcntl = 55;
   syscall_nr_setpgid = 57;
   syscall_nr_umask = 60;
-  syscall_nr_chroot = 61; // Blacklisted. Do not use.
   syscall_nr_dup2 = 63;
   syscall_nr_getppid = 64;
   syscall_nr_setsid = 66;
   syscall_nr_sigaction = 67;
-  syscall_nr_sethostname = 74; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 75;
   syscall_nr_getrusage = 77;
   syscall_nr_gettimeofday = 78;
-  syscall_nr_settimeofday = 79; // Blacklisted. Do not use.
   syscall_nr_readlink = 85;
-  syscall_nr_swapon = 87; // Blacklisted. Do not use.
-  syscall_nr_reboot = 88; // Blacklisted. Do not use.
   syscall_nr_munmap = 91;
   syscall_nr_truncate = 92;
   syscall_nr_fchmod = 94;
   syscall_nr_getpriority = 96;
   syscall_nr_setpriority = 97;
-  syscall_nr_syslog = 103; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_setitimer = 104;
   syscall_nr_getitimer = 105;
   syscall_nr_wait4 = 114;
-  syscall_nr_swapoff = 115; // Blacklisted. Do not use.
   syscall_nr_sysinfo = 116;
   syscall_nr_fsync = 118;
   syscall_nr_sigreturn = 119;
   syscall_nr_clone = 120;
-  syscall_nr_setdomainname = 121; // Blacklisted. Do not use.
   syscall_nr_uname = 122;
-  syscall_nr_adjtimex = 124; // Blacklisted. Do not use.
   syscall_nr_mprotect = 125;
-  syscall_nr_init_module = 128; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 129; // Blacklisted. Do not use.
   syscall_nr_quotactl = 131;
   syscall_nr_getpgid = 132;
   syscall_nr_fchdir = 133;
   syscall_nr_personality = 136;
-  syscall_nr_setfsuid = 138; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 139; // Blacklisted. Do not use.
   syscall_nr__llseek = 140;
   syscall_nr_getdents = 141;
   syscall_nr__newselect = 142;
@@ -130,28 +113,18 @@ const
   syscall_nr_geteuid = syscall_nr_geteuid32;
   syscall_nr_getegid32 = 202;
   syscall_nr_getegid = syscall_nr_getegid32;
-  syscall_nr_setreuid32 = 203; // Blacklisted. Do not use.
-  syscall_nr_setreuid = syscall_nr_setreuid32; // Blacklisted. Do not use.
   syscall_nr_setregid32 = 204;
   syscall_nr_setregid = syscall_nr_setregid32;
   syscall_nr_getgroups32 = 205;
   syscall_nr_getgroups = syscall_nr_getgroups32;
-  syscall_nr_setgroups32 = 206; // Blacklisted. Do not use.
-  syscall_nr_setgroups = syscall_nr_setgroups32; // Blacklisted. Do not use.
   syscall_nr_fchown32 = 207;
   syscall_nr_fchown = syscall_nr_fchown32;
   syscall_nr_setresuid32 = 208;
   syscall_nr_setresuid = syscall_nr_setresuid32;
   syscall_nr_getresuid32 = 209;
   syscall_nr_getresuid = syscall_nr_getresuid32;
-  syscall_nr_setresgid32 = 210; // Blacklisted. Do not use.
-  syscall_nr_setresgid = syscall_nr_setresgid32; // Blacklisted. Do not use.
   syscall_nr_getresgid32 = 211;
   syscall_nr_getresgid = syscall_nr_getresgid32;
-  syscall_nr_setuid32 = 213; // Blacklisted. Do not use.
-  syscall_nr_setuid = syscall_nr_setuid32; // Blacklisted. Do not use.
-  syscall_nr_setgid32 = 214; // Blacklisted. Do not use.
-  syscall_nr_setgid = syscall_nr_setgid32; // Blacklisted. Do not use.
   syscall_nr_getdents64 = 217;
   syscall_nr_mincore = 219;
   syscall_nr_madvise = 220;
@@ -191,7 +164,6 @@ const
   syscall_nr_timer_gettime = 259;
   syscall_nr_timer_getoverrun = 260;
   syscall_nr_timer_delete = 261;
-  syscall_nr_clock_settime = 262; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 263;
   syscall_nr_clock_getres = 264;
   syscall_nr_clock_nanosleep = 265;
@@ -260,7 +232,6 @@ const
   syscall_nr_accept4 = 366;
   syscall_nr_prlimit64 = 369;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 372; // Blacklisted. Do not use.
   syscall_nr_syncfs = 373;
   syscall_nr_sendmmsg = 374;
   syscall_nr_setns = 375;
@@ -280,3 +251,36 @@ const
   syscall_nr___ARM_NR_cacheflush = 983042;
   syscall_nr_cacheflush = syscall_nr___ARM_NR_cacheflush;
   syscall_nr___ARM_NR_set_tls = 983045;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_mount = 21 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 51 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 52 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 61 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 74 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 79 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 87 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 88 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_syslog = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 115 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 121 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 124 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 128 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 129 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 138 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 139 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid32 = 203 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 203 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups32 = 206 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 206 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid32 = 210 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 210 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid32 = 213 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 213 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid32 = 214 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 214 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 262 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 372 deprecated 'This syscall is blocked on Android 8+';

rtl/android/i386/sysnr.inc

@@ -16,7 +16,6 @@ const
   syscall_nr_chdir = 12;
   syscall_nr_lseek = 19;
   syscall_nr_getpid = 20;
-  syscall_nr_mount = 21; // Blacklisted. Do not use.
   syscall_nr_getuid = 24;
   syscall_nr_ptrace = 26;
   syscall_nr_access = 33;
@@ -28,25 +27,18 @@ const
   syscall_nr_pipe = 42;
   syscall_nr_times = 43;
   syscall_nr_brk = 45;
-  syscall_nr_acct = 51; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 52; // Blacklisted. Do not use.
   syscall_nr_ioctl = 54;
   syscall_nr_fcntl = 55;
   syscall_nr_setpgid = 57;
   syscall_nr_umask = 60;
-  syscall_nr_chroot = 61; // Blacklisted. Do not use.
   syscall_nr_dup2 = 63;
   syscall_nr_getppid = 64;
   syscall_nr_setsid = 66;
   syscall_nr_sigaction = 67;
-  syscall_nr_sethostname = 74; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 75;
   syscall_nr_getrusage = 77;
   syscall_nr_gettimeofday = 78;
-  syscall_nr_settimeofday = 79; // Blacklisted. Do not use.
   syscall_nr_readlink = 85;
-  syscall_nr_swapon = 87; // Blacklisted. Do not use.
-  syscall_nr_reboot = 88; // Blacklisted. Do not use.
   syscall_nr_mmap = 90;
   syscall_nr_mmap64 = syscall_nr_mmap;
   syscall_nr_munmap = 91;
@@ -55,28 +47,19 @@ const
   syscall_nr_getpriority = 96;
   syscall_nr_setpriority = 97;
   syscall_nr_socketcall = 102;
-  syscall_nr_syslog = 103; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_setitimer = 104;
   syscall_nr_getitimer = 105;
   syscall_nr_wait4 = 114;
-  syscall_nr_swapoff = 115; // Blacklisted. Do not use.
   syscall_nr_sysinfo = 116;
   syscall_nr_fsync = 118;
   syscall_nr_sigreturn = 119;
   syscall_nr_clone = 120;
-  syscall_nr_setdomainname = 121; // Blacklisted. Do not use.
   syscall_nr_uname = 122;
-  syscall_nr_adjtimex = 124; // Blacklisted. Do not use.
   syscall_nr_mprotect = 125;
-  syscall_nr_init_module = 128; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 129; // Blacklisted. Do not use.
   syscall_nr_quotactl = 131;
   syscall_nr_getpgid = 132;
   syscall_nr_fchdir = 133;
   syscall_nr_personality = 136;
-  syscall_nr_setfsuid = 138; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 139; // Blacklisted. Do not use.
   syscall_nr__llseek = 140;
   syscall_nr_getdents = 141;
   syscall_nr__newselect = 142;
@@ -133,28 +116,18 @@ const
   syscall_nr_geteuid = syscall_nr_geteuid32;
   syscall_nr_getegid32 = 202;
   syscall_nr_getegid = syscall_nr_getegid32;
-  syscall_nr_setreuid32 = 203; // Blacklisted. Do not use.
-  syscall_nr_setreuid = syscall_nr_setreuid32; // Blacklisted. Do not use.
   syscall_nr_setregid32 = 204;
   syscall_nr_setregid = syscall_nr_setregid32;
   syscall_nr_getgroups32 = 205;
   syscall_nr_getgroups = syscall_nr_getgroups32;
-  syscall_nr_setgroups32 = 206; // Blacklisted. Do not use.
-  syscall_nr_setgroups = syscall_nr_setgroups32; // Blacklisted. Do not use.
   syscall_nr_fchown32 = 207;
   syscall_nr_fchown = syscall_nr_fchown32;
   syscall_nr_setresuid32 = 208;
   syscall_nr_setresuid = syscall_nr_setresuid32;
   syscall_nr_getresuid32 = 209;
   syscall_nr_getresuid = syscall_nr_getresuid32;
-  syscall_nr_setresgid32 = 210; // Blacklisted. Do not use.
-  syscall_nr_setresgid = syscall_nr_setresgid32; // Blacklisted. Do not use.
   syscall_nr_getresgid32 = 211;
   syscall_nr_getresgid = syscall_nr_getresgid32;
-  syscall_nr_setuid32 = 213; // Blacklisted. Do not use.
-  syscall_nr_setuid = syscall_nr_setuid32; // Blacklisted. Do not use.
-  syscall_nr_setgid32 = 214; // Blacklisted. Do not use.
-  syscall_nr_setgid = syscall_nr_setgid32; // Blacklisted. Do not use.
   syscall_nr_mincore = 218;
   syscall_nr_madvise = 219;
   syscall_nr_getdents64 = 220;
@@ -195,7 +168,6 @@ const
   syscall_nr_timer_gettime = 261;
   syscall_nr_timer_getoverrun = 262;
   syscall_nr_timer_delete = 263;
-  syscall_nr_clock_settime = 264; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 265;
   syscall_nr_clock_getres = 266;
   syscall_nr_clock_nanosleep = 267;
@@ -248,7 +220,6 @@ const
   syscall_nr_perf_event_open = 336;
   syscall_nr_prlimit64 = 340;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 343; // Blacklisted. Do not use.
   syscall_nr_syncfs = 344;
   syscall_nr_setns = 346;
   syscall_nr_process_vm_readv = 347;
@@ -264,3 +235,36 @@ const
   syscall_nr_copy_file_range = 377;
   syscall_nr_preadv2 = 378;
   syscall_nr_pwritev2 = 379;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_mount = 21 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 51 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 52 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 61 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 74 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 79 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 87 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 88 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_syslog = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 115 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 121 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 124 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 128 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 129 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 138 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 139 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid32 = 203 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 203 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups32 = 206 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 206 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid32 = 210 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 210 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid32 = 213 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 213 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid32 = 214 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 214 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 264 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 343 deprecated 'This syscall is blocked on Android 8+';

rtl/android/mips64/sysnr.inc

@@ -72,27 +72,18 @@ const
   syscall_nr_times = 5098;
   syscall_nr_ptrace = 5099;
   syscall_nr_getuid = 5100;
-  syscall_nr_syslog = 5101; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_getgid = 5102;
-  syscall_nr_setuid = 5103; // Blacklisted. Do not use.
-  syscall_nr_setgid = 5104; // Blacklisted. Do not use.
   syscall_nr_geteuid = 5105;
   syscall_nr_getegid = 5106;
   syscall_nr_setpgid = 5107;
   syscall_nr_getppid = 5108;
   syscall_nr_setsid = 5110;
-  syscall_nr_setreuid = 5111; // Blacklisted. Do not use.
   syscall_nr_setregid = 5112;
   syscall_nr_getgroups = 5113;
-  syscall_nr_setgroups = 5114; // Blacklisted. Do not use.
   syscall_nr_setresuid = 5115;
   syscall_nr_getresuid = 5116;
-  syscall_nr_setresgid = 5117; // Blacklisted. Do not use.
   syscall_nr_getresgid = 5118;
   syscall_nr_getpgid = 5119;
-  syscall_nr_setfsuid = 5120; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 5121; // Blacklisted. Do not use.
   syscall_nr_getsid = 5122;
   syscall_nr_capget = 5123;
   syscall_nr_capset = 5124;
@@ -119,21 +110,8 @@ const
   syscall_nr_munlockall = 5149;
   syscall_nr_pivot_root = 5151;
   syscall_nr_prctl = 5153;
-  syscall_nr_adjtimex = 5154; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 5155;
-  syscall_nr_chroot = 5156; // Blacklisted. Do not use.
   syscall_nr_sync = 5157;
-  syscall_nr_acct = 5158; // Blacklisted. Do not use.
-  syscall_nr_settimeofday = 5159; // Blacklisted. Do not use.
-  syscall_nr_mount = 5160; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 5161; // Blacklisted. Do not use.
-  syscall_nr_swapon = 5162; // Blacklisted. Do not use.
-  syscall_nr_swapoff = 5163; // Blacklisted. Do not use.
-  syscall_nr_reboot = 5164; // Blacklisted. Do not use.
-  syscall_nr_sethostname = 5165; // Blacklisted. Do not use.
-  syscall_nr_setdomainname = 5166; // Blacklisted. Do not use.
-  syscall_nr_init_module = 5168; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 5169; // Blacklisted. Do not use.
   syscall_nr_quotactl = 5172;
   syscall_nr_gettid = 5178;
   syscall_nr_readahead = 5179;
@@ -170,7 +148,6 @@ const
   syscall_nr_timer_gettime = 5218;
   syscall_nr_timer_getoverrun = 5219;
   syscall_nr_timer_delete = 5220;
-  syscall_nr_clock_settime = 5221; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 5222;
   syscall_nr_clock_getres = 5223;
   syscall_nr_clock_nanosleep = 5224;
@@ -225,7 +202,6 @@ const
   syscall_nr_recvmmsg = 5294;
   syscall_nr_prlimit64 = 5297;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 5300; // Blacklisted. Do not use.
   syscall_nr_syncfs = 5301;
   syscall_nr_sendmmsg = 5302;
   syscall_nr_setns = 5303;
@@ -243,3 +219,31 @@ const
   syscall_nr_copy_file_range = 5320;
   syscall_nr_preadv2 = 5321;
   syscall_nr_pwritev2 = 5322;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_syslog = 5101 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 5101 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 5103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 5104 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 5111 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 5114 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 5117 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 5120 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 5121 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 5154 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 5156 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 5158 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 5159 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_mount = 5160 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 5161 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 5162 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 5163 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 5164 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 5165 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 5166 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 5168 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 5169 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 5221 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 5300 deprecated 'This syscall is blocked on Android 8+';

rtl/android/mipsel/sysnr.inc

@@ -15,8 +15,6 @@ const
   syscall_nr_chdir = 4012;
   syscall_nr_lseek = 4019;
   syscall_nr_getpid = 4020;
-  syscall_nr_mount = 4021; // Blacklisted. Do not use.
-  syscall_nr_setuid = 4023; // Blacklisted. Do not use.
   syscall_nr_getuid = 4024;
   syscall_nr_ptrace = 4026;
   syscall_nr_access = 4033;
@@ -28,34 +26,24 @@ const
   syscall_nr_pipe = 4042;
   syscall_nr_times = 4043;
   syscall_nr_brk = 4045;
-  syscall_nr_setgid = 4046; // Blacklisted. Do not use.
   syscall_nr_getgid = 4047;
   syscall_nr_geteuid = 4049;
   syscall_nr_getegid = 4050;
-  syscall_nr_acct = 4051; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 4052; // Blacklisted. Do not use.
   syscall_nr_ioctl = 4054;
   syscall_nr_fcntl = 4055;
   syscall_nr_setpgid = 4057;
   syscall_nr_umask = 4060;
-  syscall_nr_chroot = 4061; // Blacklisted. Do not use.
   syscall_nr_dup2 = 4063;
   syscall_nr_getppid = 4064;
   syscall_nr_setsid = 4066;
   syscall_nr_sigaction = 4067;
-  syscall_nr_setreuid = 4070; // Blacklisted. Do not use.
   syscall_nr_setregid = 4071;
-  syscall_nr_sethostname = 4074; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 4075;
   syscall_nr_getrlimit = 4076;
   syscall_nr_getrusage = 4077;
   syscall_nr_gettimeofday = 4078;
-  syscall_nr_settimeofday = 4079; // Blacklisted. Do not use.
   syscall_nr_getgroups = 4080;
-  syscall_nr_setgroups = 4081; // Blacklisted. Do not use.
   syscall_nr_readlink = 4085;
-  syscall_nr_swapon = 4087; // Blacklisted. Do not use.
-  syscall_nr_reboot = 4088; // Blacklisted. Do not use.
   syscall_nr_mmap = 4090;
   syscall_nr_mmap64 = syscall_nr_mmap;
   syscall_nr_munmap = 4091;
@@ -64,28 +52,19 @@ const
   syscall_nr_fchown = 4095;
   syscall_nr_getpriority = 4096;
   syscall_nr_setpriority = 4097;
-  syscall_nr_syslog = 4103; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_setitimer = 4104;
   syscall_nr_getitimer = 4105;
   syscall_nr_wait4 = 4114;
-  syscall_nr_swapoff = 4115; // Blacklisted. Do not use.
   syscall_nr_sysinfo = 4116;
   syscall_nr_fsync = 4118;
   syscall_nr_sigreturn = 4119;
   syscall_nr_clone = 4120;
-  syscall_nr_setdomainname = 4121; // Blacklisted. Do not use.
   syscall_nr_uname = 4122;
-  syscall_nr_adjtimex = 4124; // Blacklisted. Do not use.
   syscall_nr_mprotect = 4125;
-  syscall_nr_init_module = 4128; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 4129; // Blacklisted. Do not use.
   syscall_nr_quotactl = 4131;
   syscall_nr_getpgid = 4132;
   syscall_nr_fchdir = 4133;
   syscall_nr_personality = 4136;
-  syscall_nr_setfsuid = 4138; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 4139; // Blacklisted. Do not use.
   syscall_nr__llseek = 4140;
   syscall_nr_getdents = 4141;
   syscall_nr__newselect = 4142;
@@ -127,7 +106,6 @@ const
   syscall_nr_setresuid = 4185;
   syscall_nr_getresuid = 4186;
   syscall_nr_poll = 4188;
-  syscall_nr_setresgid = 4190; // Blacklisted. Do not use.
   syscall_nr_getresgid = 4191;
   syscall_nr_prctl = 4192;
   syscall_nr_rt_sigreturn = 4193;
@@ -194,7 +172,6 @@ const
   syscall_nr_timer_gettime = 4259;
   syscall_nr_timer_getoverrun = 4260;
   syscall_nr_timer_delete = 4261;
-  syscall_nr_clock_settime = 4262; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 4263;
   syscall_nr_clock_getres = 4264;
   syscall_nr_clock_nanosleep = 4265;
@@ -247,7 +224,6 @@ const
   syscall_nr_recvmmsg = 4335;
   syscall_nr_prlimit64 = 4338;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 4341; // Blacklisted. Do not use.
   syscall_nr_syncfs = 4342;
   syscall_nr_sendmmsg = 4343;
   syscall_nr_setns = 4344;
@@ -264,3 +240,31 @@ const
   syscall_nr_copy_file_range = 4360;
   syscall_nr_preadv2 = 4361;
   syscall_nr_pwritev2 = 4362;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_mount = 4021 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 4023 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 4046 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 4051 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 4052 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 4061 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 4070 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 4074 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 4079 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 4081 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 4087 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 4088 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_syslog = 4103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 4103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 4115 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 4121 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 4124 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 4128 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 4129 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 4138 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 4139 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 4190 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 4262 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 4341 deprecated 'This syscall is blocked on Android 8+';

rtl/android/x86_64/sysnr.inc

@@ -74,27 +74,18 @@ const
   syscall_nr_times = 100;
   syscall_nr_ptrace = 101;
   syscall_nr_getuid = 102;
-  syscall_nr_syslog = 103; // Blacklisted. Do not use.
-  syscall_nr_klogctl = syscall_nr_syslog; // Blacklisted. Do not use.
   syscall_nr_getgid = 104;
-  syscall_nr_setuid = 105; // Blacklisted. Do not use.
-  syscall_nr_setgid = 106; // Blacklisted. Do not use.
   syscall_nr_geteuid = 107;
   syscall_nr_getegid = 108;
   syscall_nr_setpgid = 109;
   syscall_nr_getppid = 110;
   syscall_nr_setsid = 112;
-  syscall_nr_setreuid = 113; // Blacklisted. Do not use.
   syscall_nr_setregid = 114;
   syscall_nr_getgroups = 115;
-  syscall_nr_setgroups = 116; // Blacklisted. Do not use.
   syscall_nr_setresuid = 117;
   syscall_nr_getresuid = 118;
-  syscall_nr_setresgid = 119; // Blacklisted. Do not use.
   syscall_nr_getresgid = 120;
   syscall_nr_getpgid = 121;
-  syscall_nr_setfsuid = 122; // Blacklisted. Do not use.
-  syscall_nr_setfsgid = 123; // Blacklisted. Do not use.
   syscall_nr_getsid = 124;
   syscall_nr_capget = 125;
   syscall_nr_capset = 126;
@@ -122,21 +113,8 @@ const
   syscall_nr_pivot_root = 155;
   syscall_nr_prctl = 157;
   syscall_nr_arch_prctl = 158;
-  syscall_nr_adjtimex = 159; // Blacklisted. Do not use.
   syscall_nr_setrlimit = 160;
-  syscall_nr_chroot = 161; // Blacklisted. Do not use.
   syscall_nr_sync = 162;
-  syscall_nr_acct = 163; // Blacklisted. Do not use.
-  syscall_nr_settimeofday = 164; // Blacklisted. Do not use.
-  syscall_nr_mount = 165; // Blacklisted. Do not use.
-  syscall_nr_umount2 = 166; // Blacklisted. Do not use.
-  syscall_nr_swapon = 167; // Blacklisted. Do not use.
-  syscall_nr_swapoff = 168; // Blacklisted. Do not use.
-  syscall_nr_reboot = 169; // Blacklisted. Do not use.
-  syscall_nr_sethostname = 170; // Blacklisted. Do not use.
-  syscall_nr_setdomainname = 171; // Blacklisted. Do not use.
-  syscall_nr_init_module = 175; // Blacklisted. Do not use.
-  syscall_nr_delete_module = 176; // Blacklisted. Do not use.
   syscall_nr_quotactl = 179;
   syscall_nr_gettid = 186;
   syscall_nr_readahead = 187;
@@ -170,7 +148,6 @@ const
   syscall_nr_timer_gettime = 224;
   syscall_nr_timer_getoverrun = 225;
   syscall_nr_timer_delete = 226;
-  syscall_nr_clock_settime = 227; // Blacklisted. Do not use.
   syscall_nr_clock_gettime = 228;
   syscall_nr_clock_getres = 229;
   syscall_nr_clock_nanosleep = 230;
@@ -225,7 +202,6 @@ const
   syscall_nr_recvmmsg = 299;
   syscall_nr_prlimit64 = 302;
   syscall_nr_prlimit = syscall_nr_prlimit64;
-  syscall_nr_clock_adjtime = 305; // Blacklisted. Do not use.
   syscall_nr_syncfs = 306;
   syscall_nr_sendmmsg = 307;
   syscall_nr_setns = 308;
@@ -243,3 +219,31 @@ const
   syscall_nr_copy_file_range = 326;
   syscall_nr_preadv2 = 327;
   syscall_nr_pwritev2 = 328;
+
+// The following syscalls are blocked by SECCOMP starting from Android 8.
+// Do not use them, unless you know what you are doing.
+const
+  syscall_nr_syslog = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_klogctl = 103 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setuid = 105 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgid = 106 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setreuid = 113 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setgroups = 116 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setresgid = 119 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsuid = 122 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setfsgid = 123 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_adjtimex = 159 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_chroot = 161 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_acct = 163 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_settimeofday = 164 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_mount = 165 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_umount2 = 166 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapon = 167 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_swapoff = 168 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_reboot = 169 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_sethostname = 170 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_setdomainname = 171 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_init_module = 175 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_delete_module = 176 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_settime = 227 deprecated 'This syscall is blocked on Android 8+';
+  syscall_nr_clock_adjtime = 305 deprecated 'This syscall is blocked on Android 8+';

rtl/inc/llvmintr.inc

@@ -17,3 +17,6 @@
 procedure llvm_memcpy64(dest, source: pointer; len: qword; align: cardinal; isvolatile: LLVMBool1); compilerproc; external name 'llvm.memcpy.p0i8.p0i8.i64';
 
 function llvm_frameaddress(level: longint): pointer; compilerproc; external name 'llvm.frameaddress';
+
+procedure llvm_lifetime_start(size: int64; ptr: pointer); compilerproc; external name 'llvm.lifetime.start';
+procedure llvm_lifetime_end(size: int64; ptr: pointer); compilerproc; external name 'llvm.lifetime.end';

rtl/linux/bunxsysc.inc

@@ -460,7 +460,7 @@ Function fpSelect(N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cin
   Select checks whether the file descriptor sets in readfs/writefs/exceptfs
   have changed.
 }
-{$if defined(generic_linux_syscalls)}
+{$if defined(generic_linux_syscalls) and not defined(NO_SYSCALL_PSELECT6)}
 
 var ts : timespec;
     pts : PTimeSpec;
@@ -495,7 +495,7 @@ end;
 {$endif}
 
 function fpPoll(fds: ppollfd; nfds: cuint; timeout: clong): cint;
-{$if defined(generic_linux_syscalls)}
+{$if defined(generic_linux_syscalls) and not defined(NO_SYSCALL_PPOLL)}
 var ts : timespec;
 begin
   if timeout<0 then

rtl/linux/osdefs.inc

@@ -107,6 +107,10 @@
 
 {$ifdef android}
   {$define generic_linux_syscalls}
+  {$ifdef cpuarm}
+    {$define NO_SYSCALL_PSELECT6}
+    {$define NO_SYSCALL_PPOLL}
+  {$endif cpuarm}
   {$define userenameat}
   {$undef usestime}
   {$undef OLDMMAP}

rtl/objpas/classes/bits.inc

@@ -173,6 +173,12 @@ begin
       result := (FBits^[n] and (longint(1) shl (bit and MASK))) <> 0;
 end;
 
+procedure TBits.CopyBits(BitSet : TBits);
+begin
+  setSize(bitset.Size);
+  Move(bitset.FBits^,FBits^,FSize*SizeOf(cardinal));
+end;
+
 procedure TBits.andbits(bitset : TBits);
 var
    n : longint;

rtl/objpas/classes/classesh.inc

@@ -400,6 +400,7 @@ type
       procedure SetOn(Bit : longint);
       procedure Clear(Bit : longint);
       procedure Clearall;
+      procedure CopyBits(BitSet : TBits);
       procedure AndBits(BitSet : TBits);
       procedure OrBits(BitSet : TBits);
       procedure XorBits(BitSet : TBits);

rtl/objpas/sysutils/sysstr.inc

@@ -850,6 +850,17 @@ begin
  System.Str(Value, result);
 end ;
 
+function UIntToStr(Value: QWord): string;
+
+begin
+  result:=IntTostr(Value);
+end;
+
+function UIntToStr(Value: Cardinal): string; 
+
+begin
+  System.Str(Value, result);
+end;
 
 {   IntToHex returns a string representing the hexadecimal value of Value   }
 

rtl/objpas/sysutils/sysstrh.inc

@@ -115,6 +115,8 @@ function IsValidIdent(const Ident: string; AllowDots: Boolean = False; StrictDot
 function IntToStr(Value: Longint): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToStr(Value: Int64): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToStr(Value: QWord): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
+function UIntToStr(Value: QWord): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
+function UIntToStr(Value: Cardinal): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}
 function IntToHex(Value: Longint; Digits: integer): string;
 function IntToHex(Value: Int64; Digits: integer): string;
 function IntToHex(Value: QWord; Digits: integer): string; {$ifdef SYSUTILSINLINE}inline;{$ENDIF}

rtl/solaris/ostypes.inc

@@ -170,15 +170,21 @@ CONST
     { File access modes for `open' and `fcntl'.    }
     O_RDONLY    = 0;    { Open read-only.  }
     O_WRONLY    = 1;    { Open write-only. }
-    O_RDWR      = 2;    { Open read/write. }
+    O_RDWR      = 2;    { Open read/write. }    
+    O_NDELAY    = 4;
     { Bits OR'd into the second argument to open.  }
     O_CREAT     = $100; { Create file if it doesn't exist.  }
     O_EXCL      = $400; { Fail if file already ??????.      }
     O_TRUNC     = $200; { Truncate file to zero length.     }
     O_NOCTTY    = $800; { Don't assign a controlling terminal. }
+    O_XATTR     = $4000;
+    O_NOFOLLOW  = $20000;
+    O_NOLINKS   = $40000;
     { File status flags for `open' and `fcntl'.  }
     O_APPEND    =  $08; { Writes append to the file.        }
+    O_SYNC      =  $10;
     O_NONBLOCK  =  $80; { Non-blocking I/O.                 }
+    O_LARGEFILE =  $2000;
 
 
     { mode_t possible values                                 }

tests/Makefile

@@ -5,7 +5,7 @@ default: allexectests
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android i386-aros m68k-linux m68k-netbsd m68k-amiga m68k-atari m68k-palmos m68k-macos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded x86_64-iphonesim x86_64-android x86_64-aros x86_64-dragonfly arm-linux arm-netbsd arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android arm-aros powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux mipsel-embedded mipsel-android jvm-java jvm-android i8086-embedded i8086-msdos i8086-win16 aarch64-linux aarch64-darwin aarch64-android wasm-wasm sparc64-linux riscv32-linux riscv32-embedded riscv64-linux riscv64-embedded
 BSDs = freebsd netbsd openbsd darwin dragonfly
 UNIXs = linux $(BSDs) solaris qnx haiku aix
-LIMIT83fs = go32v2 os2 emx watcom msdos
+LIMIT83fs = go32v2 os2 emx watcom msdos win16 atari
 OSNeedsComspecToRunBatch = go32v2 watcom
 FORCE:
 .PHONY: FORCE
@@ -184,6 +184,12 @@ $(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t
 endif
 override FPCOPT+=-Cp$(SUBARCH)
 endif
+ifeq ($(FULL_TARGET),avr-embedded)
+ifeq ($(SUBARCH),)
+$(error When compiling for avr-embedded, a sub-architecture (e.g. SUBARCH=avr25 or SUBARCH=avr35) must be defined)
+endif
+override FPCOPT+=-Cp$(SUBARCH)
+endif
 ifeq ($(FULL_TARGET),mipsel-embedded)
 ifeq ($(SUBARCH),)
 $(error When compiling for mipsel-embedded, a sub-architecture (e.g. SUBARCH=pic32mx) must be defined)
@@ -226,7 +232,7 @@ endif
 export OS_TARGET OS_SOURCE ARCH CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
 ifdef FPCDIR
 override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR=wrong
 endif
 else
@@ -235,7 +241,7 @@ endif
 ifdef DEFAULT_FPCDIR
 ifeq ($(FPCDIR),wrong)
 override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR=wrong
 endif
 endif
@@ -249,11 +255,11 @@ endif
 else
 override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
 override FPCDIR:=$(FPCDIR)/..
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR:=$(FPCDIR)/..
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR:=$(BASEDIR)
-ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl)),)
 override FPCDIR=c:/pp
 endif
 endif
@@ -298,7 +304,7 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
 ifeq ($(UNITSDIR),)
 UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
-PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages)
 ifndef FPCFPMAKE
 ifdef CROSSCOMPILE
 ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),)
@@ -350,9 +356,6 @@ endif
 ifeq ($(FULL_TARGET),i386-solaris)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
-ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_PROGRAMS+=gparmake createlst
-endif
 ifeq ($(FULL_TARGET),i386-netware)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
@@ -398,9 +401,6 @@ endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_PROGRAMS+=gparmake createlst
-endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
@@ -410,10 +410,10 @@ endif
 ifeq ($(FULL_TARGET),m68k-atari)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
+ifeq ($(FULL_TARGET),m68k-palmos)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
-ifeq ($(FULL_TARGET),m68k-palmos)
+ifeq ($(FULL_TARGET),m68k-macos)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
@@ -497,6 +497,9 @@ endif
 ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
+ifeq ($(FULL_TARGET),arm-netbsd)
+override TARGET_PROGRAMS+=gparmake createlst
+endif
 ifeq ($(FULL_TARGET),arm-palmos)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
@@ -521,6 +524,9 @@ endif
 ifeq ($(FULL_TARGET),arm-android)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
+ifeq ($(FULL_TARGET),arm-aros)
+override TARGET_PROGRAMS+=gparmake createlst
+endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
@@ -560,6 +566,9 @@ endif
 ifeq ($(FULL_TARGET),jvm-android)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
+ifeq ($(FULL_TARGET),i8086-embedded)
+override TARGET_PROGRAMS+=gparmake createlst
+endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 override TARGET_PROGRAMS+=gparmake createlst
 endif
@@ -990,6 +999,21 @@ STATICLIBPREFIX=
 STATICLIBEXT=.a
 SHORTSUFFIX=d16
 endif
+ifeq ($(OS_TARGET),embedded)
+ifeq ($(CPU_TARGET),i8086)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+else
+EXEEXT=.bin
+endif
+SHORTSUFFIX=emb
+endif
+ifeq ($(OS_TARGET),win16)
+STATICLIBPREFIX=
+STATICLIBEXT=.a
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w16
+endif
 ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
 FPCMADE=fpcmade.$(SHORTSUFFIX)
 ZIPSUFFIX=$(SHORTSUFFIX)
@@ -1272,9 +1296,6 @@ endif
 ifeq ($(FULL_TARGET),i386-solaris)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(FULL_TARGET),i386-qnx)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifeq ($(FULL_TARGET),i386-netware)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1320,9 +1341,6 @@ endif
 ifeq ($(FULL_TARGET),m68k-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(FULL_TARGET),m68k-freebsd)
-REQUIRE_PACKAGES_RTL=1
-endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1332,10 +1350,10 @@ endif
 ifeq ($(FULL_TARGET),m68k-atari)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(FULL_TARGET),m68k-openbsd)
+ifeq ($(FULL_TARGET),m68k-palmos)
 REQUIRE_PACKAGES_RTL=1
 endif
-ifeq ($(FULL_TARGET),m68k-palmos)
+ifeq ($(FULL_TARGET),m68k-macos)
 REQUIRE_PACKAGES_RTL=1
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
@@ -1419,6 +1437,9 @@ endif
 ifeq ($(FULL_TARGET),arm-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),arm-netbsd)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),arm-palmos)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1443,6 +1464,9 @@ endif
 ifeq ($(FULL_TARGET),arm-android)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),arm-aros)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1482,6 +1506,9 @@ endif
 ifeq ($(FULL_TARGET),jvm-android)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),i8086-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),i8086-msdos)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1565,6 +1592,7 @@ endif
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
 override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH)
+override FPMAKE_BUILD_OPT+=-FD$(NEW_BINUTILS_PATH)
 endif
 ifndef CROSSBOOTSTRAP
 ifneq ($(BINUTILSPREFIX),)
@@ -1577,6 +1605,7 @@ endif
 ifndef CROSSCOMPILE
 ifneq ($(BINUTILSPREFIX),)
 override FPCMAKEOPT+=-XP$(BINUTILSPREFIX)
+override FPMAKE_BUILD_OPT+=-XP$(BINUTILSPREFIX)
 endif
 endif
 ifdef UNITDIR
@@ -1676,6 +1705,9 @@ endif
 ifdef OPT
 override FPCOPT+=$(OPT)
 endif
+ifdef FPMAKEBUILDOPT
+override FPMAKE_BUILD_OPT+=$(FPMAKEBUILDOPT)
+endif
 ifdef FPCOPTDEF
 override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
 endif
@@ -1818,7 +1850,11 @@ ifdef INSTALL_BUILDUNIT
 override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
 endif
 ifdef INSTALLPPUFILES
+ifneq ($(IMPORTLIBPREFIX)-$(STATICLIBEXT),$(STATICLIBPREFIX)-$(STATICLIBEXT))
 override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+else
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+endif
 ifneq ($(UNITTARGETDIRPREFIX),)
 override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
 override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
@@ -1867,7 +1903,7 @@ endif
 fpc_sourceinstall: distclean
 	$(MKDIR) $(INSTALL_SOURCEDIR)
 	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
-fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+fpc_exampleinstall: $(EXAMPLEINSTALLTARGET) $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
 ifdef HASEXAMPLES
 	$(MKDIR) $(INSTALL_EXAMPLEDIR)
 endif
@@ -1920,7 +1956,7 @@ ifdef LIB_NAME
 	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
 endif
 	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
 fpc_cleanall: $(CLEANTARGET)
 ifdef CLEANEXEFILES
 	-$(DEL) $(CLEANEXEFILES)
@@ -1946,13 +1982,17 @@ ifneq ($(PPUEXT),.ppu)
 endif
 	-$(DELTREE) *$(SMARTEXT)
 	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
-	-$(DEL) *_ppas$(BATCHEXT)
+	-$(DEL) *_ppas$(BATCHEXT) ppas$(BATCHEXT) ppaslink$(BATCHEXT)
 ifdef AOUTEXT
 	-$(DEL) *$(AOUTEXT)
 endif
 ifdef DEBUGSYMEXT
 	-$(DEL) *$(DEBUGSYMEXT)
 endif
+ifdef LOCALFPMAKEBIN
+	-$(DEL) $(LOCALFPMAKEBIN)
+	-$(DEL) $(FPMAKEBINOBJ)
+endif
 fpc_distclean: cleanall
 .PHONY: fpc_baseinfo
 override INFORULES+=fpc_baseinfo
@@ -2183,7 +2223,7 @@ export LOG:=$(TEST_OUTPUTDIR)/log
 endif
 LOGFILES=$(TEST_OUTPUTDIR)/log $(TEST_OUTPUTDIR)/longlog $(TEST_OUTPUTDIR)/faillist
 LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog
-TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows
+TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows classes character dateutil fpcunit softfpu variants
 TESTDIRECTDIRS=
 TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS))
 TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2

tests/Makefile.fpc

@@ -154,7 +154,7 @@ LOGFILES=$(TEST_OUTPUTDIR)/log $(TEST_OUTPUTDIR)/longlog $(TEST_OUTPUTDIR)/faill
 LOGEXT=.testlog .tbslog .tbflog .webtbslog .webtbflog
 
 # Subdirs available in the test subdir
-TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows
+TESTUNITDIRS=system dos crt objects strings sysutils math sharemem strutils matrix lineinfo ucomplex fpwidestring cpu fmtbcd windows classes character dateutil fpcunit softfpu variants
 TESTDIRECTDIRS=
 TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS))
 TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2

tests/tbf/tb0588.pp

@@ -0,0 +1,32 @@
+{ %FAIL }
+{ %opt=-O4 -Sew }
+
+{ This code can generate trouble because
+  uninitialized retrun value in f method 
+  can have a pattern that generates a
+  floating point exception later.
+
+  As core decided not to generate an error in such cases,
+  this test was modified to al least test that a warning
+  is issued about non-initialized return value. }
+
+{$mode objfpc}
+uses
+  sysutils;
+type
+  tmyclass = class
+    function f : double;virtual;
+  end;
+
+function tmyclass.f : double;
+  begin
+  end;
+
+var
+  myclass : tmyclass;
+begin
+  myclass:=tmyclass.create;
+  writeln(myclass.f+myclass.f+myclass.f);
+  myclass.free;
+  writeln('ok');
+end.

tests/tbs/tb0588.pp

@@ -1,21 +0,0 @@
-{ %opt=-O4 }
-{$mode objfpc}
-uses
-  sysutils;
-type
-  tmyclass = class
-    function f : double;virtual;
-  end;
-
-function tmyclass.f : double;
-  begin
-  end;
-
-var
-  myclass : tmyclass;
-begin
-  myclass:=tmyclass.create;
-  writeln(myclass.f+myclass.f+myclass.f);
-  myclass.free;
-  writeln('ok');
-end.

tests/test/units/classes/ttbits.pp

@@ -0,0 +1,53 @@
+program ttbits;
+
+{$MODE objfpc}{$H+}
+
+uses
+  Classes;
+
+procedure Fail;
+begin
+  Writeln('Err!');
+  Halt(1);
+end;
+
+procedure FillWithRandom(b: TBits);
+var
+  I: Integer;
+begin
+  for I := 0 to b.Size - 1 do
+    b[I] := Random(2) <> 0;
+end;
+
+procedure TestCopyBits;
+const
+  NumTests = 100;
+  MaxBits = 200;
+var
+  b1: TBits = nil;
+  b2: TBits = nil;
+  I: Integer;
+begin
+  try
+    b1 := TBits.Create;
+    b2 := TBits.Create;
+    for I := 1 to NumTests do
+    begin
+      b1.Size := Random(MaxBits);
+      FillWithRandom(b1);
+      b2.CopyBits(b1);
+      if not b1.Equals(b2) then
+        Fail;
+      if not b2.Equals(b1) then
+        Fail;
+    end;
+  finally
+    b1.Free;
+    b2.Free;
+  end;
+end;
+
+begin
+  TestCopyBits;
+  Writeln('Ok!');
+end.

tests/test/units/strutils/tromantoint.pp

@@ -14,10 +14,16 @@ procedure RomanToIntTest(const testRoman: string;
   var
     test: integer;
   begin
-    test := RomanToInt(testRoman);
+    try
+      test := RomanToInt(testRoman);
+    except
+      { make sure that if an exception is generated,
+        the error is raised }
+      test:=expectation-1;
+    end;
     if test <> expectation then
     begin
-      writeln('Testing strUtils/RomanToInt: Test with ', testRoman, ' failed.');
+      writeln('Testing strUtils/RomanToInt: Test with "', testRoman, '" failed.');
       writeln('Returned number: ', test);
       writeln('Expected number: ', expectation);
       exitCode := 1;
@@ -30,6 +36,9 @@ var
   testInteger: integer;
 
 begin
+  { Check that empty string is accepted as zero vvalue }
+  RomanToIntTest('',0);
+
   for i := 1 to 2000 do
   begin
     testInteger := i;

tests/webtbs/tw33607.pp

@@ -0,0 +1,51 @@
+{$mode objfpc}{$H+}
+{$modeSwitch advancedRecords}
+
+type
+   TRectangle = record
+		   public
+		   Left, Bottom: Integer;
+		   Width, Height: Cardinal;
+
+		function ScaleAround0(const Factor: Single): TRectangle;
+		end;
+
+function TRectangle.ScaleAround0(const Factor: Single): TRectangle;
+begin
+   if Width <= 0 then
+   begin
+      Result.Width  := Width;
+      Result.Left   := Left;
+   end else
+      halt(3);
+
+   Result.Height := Height;
+   Result.Bottom := Bottom;
+end;
+
+function Rectangle(const Left, Bottom: Integer;
+		   const Width, Height: Cardinal): TRectangle;
+begin
+   Rectangle.Left := Left;
+   Rectangle.Bottom := Bottom;
+   Rectangle.Width := Width;
+   Rectangle.Height := Height;
+end;
+
+procedure test(c: qword);
+begin
+  if c<>0 then
+    halt(2);
+end;
+
+var
+   R, S	:  TRectangle;
+begin
+   R := Rectangle(10, 20, 0, 50);
+   S := R.ScaleAround0(2);
+   if s.width<>0 then
+     halt(1);
+
+  test(R.ScaleAround0(2).Width);
+end.
+

utils/fppkg/fpmake.pp

@@ -13,6 +13,7 @@ const
 Var
   P : TPackage;
   T : TTarget;
+  VS: string;
 
 begin
   With Installer do
@@ -39,6 +40,16 @@ begin
 
     P.SupportBuildModes:=[bmOneByOne];
 
+    P.Options.Add('-Sm');
+    Str(P.PackageVersion.Major, VS);
+    P.Options.Add('-dpackage_version_major:='+VS);
+    Str(P.PackageVersion.Minor, VS);
+    P.Options.Add('-dpackage_version_minor:='+VS);
+    Str(P.PackageVersion.Micro, VS);
+    P.Options.Add('-dpackage_version_micro:='+VS);
+    Str(P.PackageVersion.Build, VS);
+    P.Options.Add('-dpackage_version_build:='+VS);
+
     P.Dependencies.Add('fcl-base');
     P.Dependencies.Add('fcl-xml');
     P.Dependencies.Add('fcl-process');

utils/fppkg/fppkg.pp

@@ -1,11 +1,24 @@
 program fppkg;
 
-{$mode objfpc}{$H+}
+{$mode objfpc}{$H+}{$macro on}
 
 {$if defined(VER2_2) and (FPC_PATCH<1)}
   {$fatal At least FPC 2.2.1 is required to compile fppkg}
 {$endif}
 
+{$ifndef package_version_major}
+  {$define package_version_major:=0}
+{$endif}
+{$ifndef package_version_minor}
+  {$define package_version_minor:=0}
+{$endif}
+{$ifndef package_version_micro}
+  {$define package_version_micro:=0}
+{$endif}
+{$ifndef package_version_build}
+  {$define package_version_build:=0}
+{$endif}
+
 uses
   // General
 {$ifdef unix}
@@ -28,6 +41,12 @@ uses
 {$endif}
   ;
 
+const
+  version_major = package_version_major;
+  version_minor = package_version_minor;
+  version_micro = package_version_micro;
+  version_build = package_version_build;
+
 Type
   { TMakeTool }
 
@@ -37,6 +56,7 @@ Type
     ParaPackages : TStringList;
     procedure MaybeCreateLocalDirs;
     procedure ShowUsage;
+    procedure ShowVersion;
   Public
     Constructor Create;
     Destructor Destroy;override;
@@ -94,6 +114,7 @@ begin
   Writeln('  -C --config-file   Specify the configuration file to use');
   Writeln('  -c --config        Set compiler configuration to use');
   Writeln('  -h --help          This help');
+  Writeln('  -V --version       Show version and exit');
   Writeln('  -v --verbose       Show more information');
   Writeln('  -d --debug         Show debugging information');
   Writeln('  -f --force         Force installation also if the package is already installed');
@@ -256,6 +277,11 @@ begin
           ShowUsage;
           halt(0);
         end
+      else if CheckOption(I,'V','version') then
+        begin
+          ShowVersion;
+          halt(0);
+        end
       else if (Length(Paramstr(i))>0) and (Paramstr(I)[1]='-') then
         begin
           if FirstPass then
@@ -426,6 +452,11 @@ begin
   SetCurrentDir(OldCurrDir);
 end;
 
+procedure TMakeTool.ShowVersion;
+begin
+  Writeln('Version: ', version_major, '.', version_minor, '.', version_micro, '-', version_build);
+end;
+
 
 begin
   With TMakeTool.Create do

utils/pas2js/docs/translation.html

@@ -2031,8 +2031,9 @@ rtl = {
 
     <div class="section">
     <h2 id="anonymousfunctions">Translating anonymous functions</h2>
-    Anonymous functions are not yet supported by pas2js. The next best thing are
-    local procedures. For example:
+    Anonymous functions are supported since pas2js 1.1.<br>
+    Note that in pas2js local procedures are closures as well. See below.<br>
+    For pas2js 1.0 the next best thing are local procedures. For example:
     <table class="sample">
       <tbody>
         <tr>

utils/pas2js/nodepas2js.pp

@@ -6,7 +6,8 @@ program nodepas2js;
 uses
   JS, NodeJSApp,
   Classes, SysUtils,
-  Pas2jsFileUtils, Pas2jsLogger, pas2jscompiler, Pas2jsfscompiler;
+  Pas2jsFileUtils, Pas2jsLogger,
+  Pas2jsCompiler, Pas2JSFSCompiler, Pas2JSCompilerCfg;
 
 type
 
@@ -66,6 +67,7 @@ begin
   inherited Create(TheOwner);
   StopOnException:=True;
   FCompiler:=TPas2jsFSCompiler.Create;
+  FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
 end;
 
 destructor TPas2jsCLI.Destroy;

utils/pas2js/pas2js.pp

@@ -12,7 +12,8 @@ uses
   cthreads, cwstring,
   {$ENDIF}
   Classes, SysUtils, CustApp,
-  Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler, pas2jspcucompiler, pas2jscompilerpp, pas2JScompilercfg;
+  Pas2jsFileUtils, Pas2jsLogger, Pas2jsCompiler,
+  Pas2JSPCUCompiler, Pas2JSCompilerPP, Pas2JSCompilerCfg;
 
 Type
 

utils/pas2js/webfilecache.pp

@@ -211,8 +211,7 @@ begin
     if RaiseOnError then
       Raise EFileNotFoundError.Create('File not loaded '+FileName)
 {$IFDEF VERBOSEWEBCACHE}
-    else
-      Writeln('File not loaded '+FileName);
+    else Writeln('File not loaded '+FileName);
 {$ENDIF}
 end;
 
@@ -451,7 +450,9 @@ begin
   for I:=0 to MS.Length-1 do
     begin
     v:=MS[i];
+    {AllowWriteln}
     Writeln('Char ',i,'(',v,') : ',TJSString.fromCharCode(v));
+    {AllowWriteln-}
     aContent:=aContent+TJSString.fromCharCode(MS[i]);
     end;
   SetFileContent(FileName,aContent);