* synchronize with trunk

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

.gitattributes

@@ -2098,8 +2098,10 @@ packages/fcl-db/examples/loadlibdemo.lpi svneol=native#text/plain
 packages/fcl-db/examples/loadlibdemo.pp svneol=native#text/plain
 packages/fcl-db/examples/logsqldemo.lpi svneol=native#text/plain
 packages/fcl-db/examples/logsqldemo.pas svneol=native#text/plain
+packages/fcl-db/examples/myext.pp svneol=native#text/plain
 packages/fcl-db/examples/pqeventstest.pp svneol=native#text/plain
 packages/fcl-db/examples/showcsv.pp svneol=native#text/plain
+packages/fcl-db/examples/sqlite3extdemo.pp svneol=native#text/plain
 packages/fcl-db/examples/sqlite3loadlib.lpr svneol=native#text/plain
 packages/fcl-db/examples/sqlparser.pp svneol=native#text/plain
 packages/fcl-db/examples/tsamytable.pp svneol=native#text/plain
@@ -7694,12 +7696,15 @@ packages/sndfile/src/sndfile.pp svneol=native#text/plain
 packages/sqlite/Makefile svneol=native#text/plain
 packages/sqlite/Makefile.fpc svneol=native#text/plain
 packages/sqlite/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/sqlite/examples/myext.lpi svneol=native#text/plain
+packages/sqlite/examples/myext.pp svneol=native#text/plain
 packages/sqlite/fpmake.pp svneol=native#text/plain
 packages/sqlite/src/sqlite.pp svneol=native#text/plain
 packages/sqlite/src/sqlite3.inc svneol=native#text/plain
 packages/sqlite/src/sqlite3.pp svneol=native#text/plain
 packages/sqlite/src/sqlite3db.pas svneol=native#text/x-pascal
 packages/sqlite/src/sqlite3dyn.pp svneol=native#text/plain
+packages/sqlite/src/sqlite3ext.pp svneol=native#text/plain
 packages/sqlite/src/sqlitedb.pas svneol=native#text/plain
 packages/sqlite/tests/test.pas svneol=native#text/plain
 packages/sqlite/tests/testapiv3x.README svneol=native#text/plain
@@ -16436,6 +16441,7 @@ 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
+tests/webtbs/tw33666.pp svneol=native#text/plain
 tests/webtbs/tw33696.pp svneol=native#text/pascal
 tests/webtbs/tw33700.pp svneol=native#text/pascal
 tests/webtbs/tw33706.pp svneol=native#text/plain

compiler/aarch64/cpubase.pas

@@ -368,8 +368,11 @@ unit cpubase;
           R_MMREGISTER:
             begin
               case s of
+                { records }
+                OS_32,
                 OS_F32:
                   cgsize2subreg:=R_SUBMMS;
+                OS_64,
                 OS_F64:
                   cgsize2subreg:=R_SUBMMD;
                 else

compiler/aarch64/cpupara.pas

@@ -270,7 +270,8 @@ unit cpupara;
               then indexed beyond its bounds) }
           arraydef:
             result:=
-              (calloption in cdecl_pocalls) or
+              ((calloption in cdecl_pocalls) and
+               not is_dynamic_array(def)) or
               is_open_array(def) or
               is_array_of_const(def) or
               is_array_constructor(def) or
@@ -400,11 +401,16 @@ unit cpupara;
         if (p.proccalloption in cstylearrayofconst) and
            is_array_of_const(paradef) then
           begin
+            result.size:=OS_NO;
+            result.def:=paradef;
+            result.alignment:=std_param_align;
+            result.intsize:=0;
             paraloc:=result.add_location;
             { hack: the paraloc must be valid, but is not actually used }
             paraloc^.loc:=LOC_REGISTER;
             paraloc^.register:=NR_X0;
             paraloc^.size:=OS_ADDR;
+            paraloc^.def:=paradef;
             exit;
           end;
 
@@ -532,8 +538,48 @@ unit cpupara;
              end
            else
              begin
+{$ifndef llvm}
                paraloc^.size:=locsize;
                paraloc^.def:=locdef;
+{$else llvm}
+               case locsize of
+                 OS_8,OS_16,OS_32:
+                   begin
+                     paraloc^.size:=OS_64;
+                     paraloc^.def:=u64inttype;
+                   end;
+                 OS_S8,OS_S16,OS_S32:
+                   begin
+                     paraloc^.size:=OS_S64;
+                     paraloc^.def:=s64inttype;
+                   end;
+                 OS_F32:
+                   begin
+                     paraloc^.size:=OS_F32;
+                     paraloc^.def:=s32floattype;
+                   end;
+                 OS_F64:
+                   begin
+                     paraloc^.size:=OS_F64;
+                     paraloc^.def:=s64floattype;
+                   end;
+                 else
+                   begin
+                     if is_record(locdef) or
+                        ((locdef.typ=arraydef) and
+                         not is_special_array(locdef)) then
+                       begin
+                         paraloc^.size:=OS_64;
+                         paraloc^.def:=u64inttype;
+                       end
+                     else
+                       begin
+                         paraloc^.size:=locsize;
+                         paraloc^.def:=locdef;
+                       end;
+                   end;
+               end;
+{$endif llvm}
              end;
 
            { paraloc loc }
@@ -556,7 +602,10 @@ unit cpupara;
                     (side=callerside) and
                     is_ordinal(paradef) and
                     (paradef.size<4) then
-                   paraloc^.size:=OS_32;
+                   begin
+                     paraloc^.size:=OS_32;
+                     paraloc^.def:=u32inttype;
+                   end;
 
                  { in case it's a composite, "The argument is passed as though
                    it had been loaded into the registers from a double-word-
@@ -567,7 +616,7 @@ unit cpupara;
                  if (target_info.endian=endian_big) and
                     not(paraloc^.size in [OS_64,OS_S64]) and
                     (paradef.typ in [setdef,recorddef,arraydef,objectdef]) then
-                   paraloc^.shiftval:=-(8-tcgsize2size[paraloc^.size]);
+                   paraloc^.shiftval:=-(8-tcgsize2size[paraloc^.size])*8;
                end;
              LOC_MMREGISTER:
                begin
@@ -581,7 +630,7 @@ unit cpupara;
                   paraloc^.loc:=LOC_REFERENCE;
 
                   { the current stack offset may not be properly aligned in
-                    case we're on Darwin have allocated a non-variadic argument
+                    case we're on Darwin and have allocated a non-variadic argument
                     < 8 bytes previously }
                   if target_info.abi=abi_aarch64_darwin then
                     curstackoffset:=align(curstackoffset,paraloc^.def.alignment);

compiler/aasmcnst.pas

@@ -269,6 +269,8 @@ type
      { finalize the asmlist: add the necessary symbols etc }
      procedure finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); virtual;
      procedure finalize_asmlist_add_indirect_sym(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions); virtual;
+     { prepare finalization (common for the default and overridden versions }
+     procedure finalize_asmlist_prepare(const options: ttcasmlistoptions; var alignment: shortint);
 
      { functionality of the above for vectorized dead strippable sections }
      procedure finalize_vectorized_dead_strip_asmlist(def: tdef; const basename, itemname: TSymStr; st: tsymtable; alignment: shortint; options: ttcasmlistoptions); virtual;
@@ -928,9 +930,7 @@ implementation
      end;
 
 
-   procedure ttai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
-     var
-       prelist: tasmlist;
+   procedure ttai_typedconstbuilder.finalize_asmlist_prepare(const options: ttcasmlistoptions; var alignment: shortint);
      begin
        if tcalo_apply_constalign in options then
          alignment:=const_align(alignment);
@@ -946,7 +946,14 @@ implementation
              tcalo_vectorized_dead_strip_end]*options)<>[]) and
           not fvectorized_finalize_called then
          internalerror(2015110602);
+     end;
+
 
+   procedure ttai_typedconstbuilder.finalize_asmlist(sym: tasmsymbol; def: tdef; section: TAsmSectiontype; const secname: TSymStr; alignment: shortint; const options: ttcasmlistoptions);
+     var
+       prelist: tasmlist;
+     begin
+       finalize_asmlist_prepare(options, alignment);
        prelist:=tasmlist.create;
        { only now add items based on the symbolname, because it may be
          modified by the "section" specifier in case of a typed constant }

compiler/arm/aoptcpu.pas

@@ -439,6 +439,19 @@ Implementation
 
               { finally get rid of the mov }
               taicpu(p).loadreg(0,taicpu(movp).oper[0]^.reg);
+              { Remove preindexing and postindexing for LDR in some cases.
+                For example:
+                  ldr	reg2,[reg1, xxx]!
+                  mov reg1,reg2
+                must be translated to:
+                  ldr	reg1,[reg1, xxx]
+
+                Preindexing must be removed there, since the same register is used as the base and as the target.
+                Such case is not allowed for ARM CPU and produces crash. }
+              if (taicpu(p).opcode = A_LDR) and (taicpu(p).oper[1]^.typ = top_ref)
+                and (taicpu(movp).oper[0]^.reg = taicpu(p).oper[1]^.ref^.base)
+              then
+                taicpu(p).oper[1]^.ref^.addressmode:=AM_OFFSET;
               asml.remove(movp);
               movp.free;
             end;

compiler/arm/symcpu.pas

@@ -101,7 +101,7 @@ type
     { library symbol for AROS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -208,7 +208,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

compiler/blockutl.pas

@@ -207,7 +207,7 @@ implementation
           exit;
         end;
       { bare copy, so that self etc are not inserted }
-      result:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc));
+      result:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,''));
       { will be called accoding to the ABI conventions }
       result.proccalloption:=pocall_cdecl;
       { add po_is_block so that a block "self" pointer gets added (of the type

compiler/browcol.pas

@@ -23,12 +23,17 @@
 {$ifdef TP}
   {$N+,E+}
 {$endif}
+
 unit browcol;
 
 {$i fpcdefs.inc}
 { $define use_refs}
 {$H-}
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -1745,7 +1750,7 @@ var P: PModuleSymbol;
 begin
   P:=nil;
   if Assigned(Modules) then
-    P:=Modules^.FirstThat(@Match);
+    P:=Modules^.FirstThat(TCallbackFunBoolParam(@Match));
   SearchModule:=P;
 end;
 
@@ -2198,7 +2203,7 @@ begin
        FixupSymbol(At(I));
 end;
 begin
-  Modules^.ForEach(@FixupSymbol);
+  Modules^.ForEach(TCallbackProcParam(@FixupSymbol));
 end;
 procedure ReadSymbolPointers(P: PSymbol);
 var I: sw_integer;
@@ -2222,7 +2227,7 @@ begin
   ReadPointers(S,ModuleNames,PD);
   ReadPointers(S,TypeNames,PD);
   ReadPointers(S,Modules,PD);
-  Modules^.ForEach(@ReadSymbolPointers);
+  Modules^.ForEach(TCallbackProcParam(@ReadSymbolPointers));
   FixupPointers;
   Dispose(PD, Done);
 
@@ -2261,7 +2266,7 @@ begin
   StorePointers(S,ModuleNames);
   StorePointers(S,TypeNames);
   StorePointers(S,Modules);
-  Modules^.ForEach(@WriteSymbolPointers);
+  Modules^.ForEach(TCallbackProcParam(@WriteSymbolPointers));
   StoreBrowserCol:=(S^.Status=stOK);
 end;
 

compiler/hlcg2ll.pas

@@ -304,7 +304,7 @@ unit hlcg2ll;
 
           procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);override;
           procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);override;
-          procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override;
+          procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;var size:tdef;maybeconst:boolean);override;
 //          procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);override;
 
           procedure maketojumpboollabels(list: TAsmList; p: tnode; truelabel, falselabel: tasmlabel); override;
@@ -1250,7 +1250,7 @@ implementation
       end;
     end;
 
-  procedure thlcg2ll.location_force_mmregscalar(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean);
+  procedure thlcg2ll.location_force_mmregscalar(list: TAsmList; var l: tlocation; var size: tdef; maybeconst: boolean);
     var
       reg : tregister;
       href : treference;

compiler/hlcgobj.pas

@@ -575,7 +575,7 @@ unit hlcgobj;
           procedure location_force_reg(list:TAsmList;var l:tlocation;src_size,dst_size:tdef;maybeconst:boolean);virtual;
           procedure location_force_fpureg(list:TAsmList;var l: tlocation;size: tdef;maybeconst:boolean);virtual;
           procedure location_force_mem(list:TAsmList;var l:tlocation;size:tdef);virtual;
-          procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;
+          procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;var size:tdef;maybeconst:boolean);virtual;
 //          procedure location_force_mmreg(list:TAsmList;var l: tlocation;size:tdef;maybeconst:boolean);virtual;abstract;
 
           { Retrieve the location of the data pointed to in location l, when the location is
@@ -4100,7 +4100,7 @@ implementation
       end;
     end;
 
-  procedure thlcgobj.location_force_mmregscalar(list: TAsmList; var l: tlocation; size: tdef; maybeconst: boolean);
+  procedure thlcgobj.location_force_mmregscalar(list: TAsmList; var l: tlocation; var size: tdef; maybeconst: boolean);
     var
       reg : tregister;
       href : treference;
@@ -4145,6 +4145,7 @@ implementation
           l.size:=def_cgsize(newsize);
           location_freetemp(list,l);
           location_reset(l,LOC_MMREGISTER,l.size);
+          size:=newsize;
           l.register:=reg;
         end;
     end;

compiler/i386/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AROS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

compiler/i8086/symcpu.pas

@@ -110,7 +110,7 @@ type
 
   tcpuprocvardef = class(ti86procvardef)
     constructor create(level:byte);override;
-    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp):tstoreddef;override;
+    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;override;
     function address_type:tdef;override;
     function ofs_address_type:tdef;override;
     function size:asizeint;override;
@@ -133,7 +133,7 @@ type
     procedure Setinterfacedef(AValue: boolean);override;
    public
     constructor create(level:byte;doregister:boolean);override;
-    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp):tstoreddef;override;
+    function getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;override;
     function address_type:tdef;override;
     function ofs_address_type:tdef;override;
     function size:asizeint;override;
@@ -334,7 +334,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp):tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;
     begin
       result:=inherited;
       if is_far then
@@ -428,7 +428,7 @@ implementation
     end;
 
 
-  function tcpuprocvardef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp):tstoreddef;
+  function tcpuprocvardef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp;const paraprefix:string):tstoreddef;
     begin
       result:=inherited;
       if is_far then

compiler/jvm/pjvm.pas

@@ -505,7 +505,7 @@ implementation
 
         { add a method to call the procvar using unwrapped arguments, which
           then wraps them and calls through to JLRMethod.invoke }
-        methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc));
+        methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
         finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass);
         insert_self_and_vmt_para(methoddef);
         insert_funcret_para(methoddef);
@@ -540,7 +540,7 @@ implementation
             { add a method prototype matching the procvar (like the invoke
               in the procvarclass itself) }
             symtablestack.push(pvintf.symtable);
-            methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc));
+            methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc,''));
             finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf);
             insert_self_and_vmt_para(methoddef);
             insert_funcret_para(methoddef);
@@ -639,7 +639,7 @@ implementation
         wrapperpd.synthetickind:=tsk_jvm_virtual_clmethod;
         wrapperpd.skpara:=pd;
         { also create procvar type that we can use in the implementation }
-        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal));
+        wrapperpv:=tcpuprocvardef(pd.getcopyas(procvardef,pc_normal,''));
         wrapperpv.calcparas;
         { no use in creating a callback wrapper here, this procvar type isn't
           for public consumption }
@@ -667,7 +667,7 @@ implementation
         { wrapper is part of the same symtable as the original procdef }
         symtablestack.push(pd.owner);
         { get a copy of the constructor }
-        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc));
+        wrapperpd:=tprocdef(pd.getcopyas(procdef,pc_bareproc,''));
         { this one is a class method rather than a constructor }
         include(wrapperpd.procoptions,po_classmethod);
         wrapperpd.proctypeoption:=potype_function;

compiler/llvm/aasmllvm.pas

@@ -107,7 +107,7 @@ interface
         constructor getelementptr_reg_size_ref_size_const(dst:tregister;ptrsize:tdef;const ref:treference;indextype:tdef;index1:ptrint;indirect:boolean);
         constructor getelementptr_reg_tai_size_const(dst:tregister;const ai:tai;indextype:tdef;index1:ptrint;indirect:boolean);
 
-        constructor blockaddress(fun, lab: tasmsymbol);
+        constructor blockaddress(size: tdef; fun, lab: tasmsymbol);
         constructor landingpad(dst:tregister;def:tdef;firstclause:taillvm);
         constructor exceptclause(op:tllvmop;def:tdef;kind:TAsmSymbol;nextclause:taillvm);
 
@@ -514,7 +514,7 @@ uses
             end;
           la_blockaddress:
             case opnr of
-              0: result:=operand_write
+              1: result:=operand_write
               else
                 result:=operand_read;
             end
@@ -673,7 +673,7 @@ uses
             end;
           la_blockaddress:
             case opnr of
-              0: result:=voidcodepointertype
+              1: result:=voidcodepointertype
               else
                 internalerror(2015111904);
             end
@@ -1037,12 +1037,13 @@ uses
         loadconst(index+1,index1);
       end;
 
-    constructor taillvm.blockaddress(fun, lab: tasmsymbol);
+    constructor taillvm.blockaddress(size: tdef; fun, lab: tasmsymbol);
       begin
         create_llvm(la_blockaddress);
-        ops:=2;
-        loadsymbol(0,fun,0);
-        loadsymbol(1,lab,0);
+        ops:=3;
+        loaddef(0,size);
+        loadsymbol(1,fun,0);
+        loadsymbol(2,lab,0);
       end;
 
 

compiler/llvm/agllvm.pas

@@ -604,12 +604,18 @@ implementation
           end;
         la_blockaddress:
           begin
-            owner.writer.AsmWrite('i8* blockaddress(');
-            owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false));
+            { nested -> no type }
+            if owner.fdecllevel = 0 then
+              begin
+                owner.writer.AsmWrite(getopstr(taillvm(hp).oper[0]^,false));
+                owner.writer.AsmWrite(' ');
+              end;
+            owner.writer.AsmWrite('blockaddress(');
+            owner.writer.AsmWrite(getopstr(taillvm(hp).oper[1]^,false));
             { getopstr would add a "label" qualifier, which blockaddress does
               not want }
             owner.writer.AsmWrite(',%');
-            with taillvm(hp).oper[1]^ do
+            with taillvm(hp).oper[2]^ do
               begin
                 if (typ<>top_ref) or
                    (ref^.refaddr<>addr_full) then

compiler/llvm/hlcgllvm.pas

@@ -1508,7 +1508,7 @@ implementation
                     exit;
                 end;
               if fromsize<>tosize then
-                g_ptrtypecast_ref(list,cpointerdef.create(fromsize),cpointerdef.create(tosize),href);
+                g_ptrtypecast_ref(list,cpointerdef.getreusable(fromsize),cpointerdef.getreusable(tosize),href);
               { %reg = load size* %ref }
               list.concat(taillvm.op_reg_size_ref(la_load,reg,cpointerdef.getreusable(tosize),href));
             end;
@@ -1800,7 +1800,7 @@ implementation
 
   function thlcgllvm.make_simple_ref(list: TAsmList; const ref: treference; def: tdef): treference;
     begin
-      result:=make_simple_ref_ptr(list,ref,cpointerdef.create(def));
+      result:=make_simple_ref_ptr(list,ref,cpointerdef.getreusable(def));
     end;
 
 

compiler/llvm/llvmdef.pas

@@ -690,9 +690,7 @@ implementation
           llvmextractvalueextinfo(hp.vardef,usedef,signext);
           { implicit zero/sign extension for ABI compliance? }
           if not first then
-             encodedstr:=encodedstr+', '
-          else
-            first:=false;
+             encodedstr:=encodedstr+', ';
           llvmaddencodedtype_intern(usedef,[],encodedstr);
           { in case signextstr<>'', there should be only one paraloc -> no need
             to clear (reason: it means that the paraloc is larger than the
@@ -769,6 +767,7 @@ implementation
               encodedstr:=encodedstr+' '+llvmasmsymname(paraloc^.llvmloc.sym);
             end;
           paraloc:=paraloc^.next;
+          first:=false;
         until not assigned(paraloc);
       end;
 
@@ -952,7 +951,7 @@ implementation
               retdeflist[i]:=retloc^.def;
               dec(sizeleft,retloc^.def.size);
             end
-          else
+          else if retloc^.def.size<>sizeleft then
             begin
               case sizeleft of
                 1:
@@ -971,8 +970,10 @@ implementation
                   retdeflist[i]:=u56inttype;
                 else
                   retdeflist[i]:=retloc^.def;
-              end;
-            end;
+              end
+            end
+          else
+            retdeflist[i]:=retloc^.def;
           inc(i);
           retloc:=retloc^.next;
         until not assigned(retloc);

compiler/llvm/nllvmadd.pas

@@ -261,7 +261,7 @@ implementation
               equaln:
                 llvmfpcmp:=lfc_oeq;
               unequaln:
-                llvmfpcmp:=lfc_one;
+                llvmfpcmp:=lfc_une;
               else
                 internalerror(2015031506);
             end;

compiler/llvm/nllvmcal.pas

@@ -27,7 +27,7 @@ interface
 
     uses
       parabase,
-      ncgcal,
+      ncal,ncgcal,
       cgutils;
 
     type
@@ -38,6 +38,7 @@ interface
 
       tllvmcallnode = class(tcgcallnode)
        protected
+        function paraneedsinlinetemp(para: tcallparanode; const pushconstaddr, complexpara: boolean): boolean; override;
         function can_call_ref(var ref: treference): boolean; override;
         procedure pushparas; override;
       end;
@@ -47,7 +48,7 @@ implementation
 
      uses
        verbose,
-       ncal;
+       symconst,symdef;
 
 {*****************************************************************************
                           TLLVMCALLPARANODE
@@ -64,6 +65,25 @@ implementation
                            TLLVMCALLNODE
  *****************************************************************************}
 
+    function tllvmcallnode.paraneedsinlinetemp(para: tcallparanode; const pushconstaddr, complexpara: boolean): boolean;
+      begin
+        { We don't insert type conversions for self node trees to the type of
+          the self parameter (and doing so is quite hard due to all kinds of
+          ugly hacks with this parameter). This means that if we pass on a
+          self parameter through multiple levels of inlining, it may no
+          longer match the actual type of the parameter it has been passed to
+          -> always store in a temp which by definition will have the right
+          type (if it's a pointer-like type) }
+        if (vo_is_self in para.parasym.varoptions) and
+           (is_class_or_interface_or_dispinterface(para.parasym.vardef) or
+            is_classhelper(para.parasym.vardef) or
+            ((para.parasym.vardef.typ=classrefdef) and
+             is_class(tclassrefdef(para.parasym.vardef).pointeddef))) then
+          result:=true
+        else
+          result:=inherited;
+      end;
+
     function tllvmcallnode.can_call_ref(var ref: treference): boolean;
       begin
         result:=false;

compiler/llvm/nllvmcnv.pas

@@ -80,7 +80,7 @@ class function tllvmtypeconvnode.target_specific_need_equal_typeconv(fromdef, to
     result:=
       (fromdef<>todef) and
       { two procdefs that are structurally the same but semantically different
-        still need a convertion }
+        still need a conversion }
       (
        ((fromdef.typ=procvardef) and
         (todef.typ=procvardef))
@@ -180,7 +180,7 @@ procedure tllvmtypeconvnode.second_proc_to_procvar;
         if location.loc<>LOC_REFERENCE then
           internalerror(2015111902);
         hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,
-          cpointerdef.getreusable(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal)),
+          cpointerdef.getreusable(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal,'')),
           cpointerdef.getreusable(resultdef),
           location.reference);
       end;
@@ -283,7 +283,7 @@ procedure tllvmtypeconvnode.second_nothing;
         hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);
         hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,cpointerdef.getreusable(resultdef));
         hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,cpointerdef.getreusable(resultdef),left.location.reference,hreg);
-        location_reset_ref(location,left.location.loc,left.location.size,left.location.reference.alignment,left.location.reference.volatility);
+        location_reset_ref(location,left.location.loc,def_cgsize(resultdef),left.location.reference.alignment,left.location.reference.volatility);
         reference_reset_base(location.reference,hreg,0,location.reference.temppos,location.reference.alignment,location.reference.volatility);
       end
     else

compiler/llvm/nllvminl.pas

@@ -36,7 +36,9 @@ interface
 
         function first_get_frame: tnode; override;
         function first_abs_real: tnode; override;
+        function first_fma: tnode; override;
         function first_sqr_real: tnode; override;
+        function first_sqrt_real: tnode; override;
         function first_trunc_real: tnode; override;
        public
         procedure second_length; override;
@@ -51,6 +53,7 @@ implementation
        verbose,globals,globtype,constexp,
        aasmbase, aasmdata,
        symconst,symtype,symdef,defutil,
+       compinnr,
        nutils,nadd,nbas,ncal,ncnv,ncon,nflw,ninl,nld,nmat,
        pass_2,
        cgbase,cgutils,tgobj,hlcgobj,
@@ -145,6 +148,26 @@ implementation
         left:=nil;
       end;
 
+    function tllvminlinenode.first_fma: tnode;
+      var
+        procname: string[15];
+      begin
+        case inlinenumber of
+          in_fma_single:
+            procname:='llvm_fma_f32';
+          in_fma_double:
+            procname:='llvm_fma_f64';
+          in_fma_extended:
+            procname:='llvm_fma_f80';
+          in_fma_float128:
+            procname:='llvm_fma_f128';
+          else
+            internalerror(2018122101);
+        end;
+        result:=ccallnode.createintern(procname,left);
+        left:=nil;
+      end;
+
 
     function tllvminlinenode.first_sqr_real: tnode;
       begin
@@ -156,6 +179,29 @@ implementation
       end;
 
 
+    function tllvminlinenode.first_sqrt_real: tnode;
+      var
+        intrinsic: string[20];
+      begin
+        if left.resultdef.typ<>floatdef then
+          internalerror(2018121601);
+        case tfloatdef(left.resultdef).floattype of
+          s32real:
+            intrinsic:='llvm_sqrt_f32';
+          s64real:
+            intrinsic:='llvm_sqrt_f64';
+          s80real,sc80real:
+            intrinsic:='llvm_sqrt_f80';
+          s128real:
+            intrinsic:='llvm_sqrt_f128';
+          else
+            internalerror(2018121602);
+        end;
+        result:=ccallnode.createintern(intrinsic, ccallparanode.create(left,nil));
+        left:=nil;
+      end;
+
+
     function tllvminlinenode.first_trunc_real: tnode;
       begin
         { fptosi is undefined if the value is out of range -> only generate

compiler/llvm/nllvmld.pas

@@ -90,7 +90,7 @@ procedure tllvmloadnode.pass_generate_code;
             (resultdef.typ in [symconst.procdef,procvardef]) and
              not tabstractprocdef(resultdef).is_addressonly then
             begin
-              pvdef:=tprocvardef(procdef.getcopyas(procvardef,pc_normal));
+              pvdef:=tprocvardef(procdef.getcopyas(procvardef,pc_normal,''));
               { on little endian, location.register contains proc and
                 location.registerhi contains self; on big endian, it's the
                 other way around }
@@ -124,7 +124,7 @@ procedure tllvmloadnode.pass_generate_code;
       labelsym:
         begin
           selfreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,voidcodepointertype);
-          ai:=taillvm.blockaddress(
+          ai:=taillvm.blockaddress(voidcodepointertype,
               current_asmdata.RefAsmSymbol(current_procinfo.procdef.mangledname,AT_FUNCTION),
               location.reference.symbol
             );

compiler/llvm/nllvmtcon.pas

@@ -109,6 +109,7 @@ interface
       procedure queue_subscriptn(def: tabstractrecorddef; vs: tfieldvarsym); override;
       procedure queue_typeconvn(fromdef, todef: tdef); override;
       procedure queue_emit_staticvar(vs: tstaticvarsym); override;
+      procedure queue_emit_label(l: tlabelsym); override;
       procedure queue_emit_asmsym(sym: tasmsymbol; def: tdef); override;
       procedure queue_emit_ordconst(value: int64; def: tdef); override;
 
@@ -117,6 +118,7 @@ interface
       function emit_placeholder(def: tdef): ttypedconstplaceholder; override;
 
       class function get_string_symofs(typ: tstringtype; winlikewidestring: boolean): pint; override;
+      class function get_dynarray_symofs: pint; override;
 
       property appendingdef: boolean write fappendingdef;
     end;
@@ -127,6 +129,7 @@ implementation
   uses
     verbose,systems,fmodule,
     aasmdata,
+    procinfo,
     cpubase,cpuinfo,llvmbase,
     symtable,llvmdef,defutil,defcmp;
 
@@ -185,6 +188,7 @@ implementation
       newasmlist: tasmlist;
       decl: taillvmdecl;
     begin
+      finalize_asmlist_prepare(options,alignment);
       newasmlist:=tasmlist.create;
       if assigned(foverriding_def) then
         def:=foverriding_def;
@@ -781,6 +785,24 @@ implementation
     end;
 
 
+  procedure tllvmtai_typedconstbuilder.queue_emit_label(l: tlabelsym);
+    var
+      ai: taillvm;
+      typedai: tai;
+      tmpintdef: tdef;
+      op,
+      firstop,
+      secondop: tllvmop;
+    begin
+      ai:=taillvm.blockaddress(voidcodepointertype,
+          current_asmdata.RefAsmSymbol(current_procinfo.procdef.mangledname,AT_FUNCTION),
+          current_asmdata.RefAsmSymbol(l.mangledname,AT_LABEL)
+        );
+      emit_tai(ai,voidcodepointertype);
+      fqueue_offset:=low(fqueue_offset);
+    end;
+
+
   procedure tllvmtai_typedconstbuilder.queue_emit_asmsym(sym: tasmsymbol; def: tdef);
     begin
       { we've already incorporated the offset via the inserted operations above,
@@ -850,6 +872,13 @@ implementation
     end;
 
 
+  class function tllvmtai_typedconstbuilder.get_dynarray_symofs: pint;
+    begin
+      { LLVM does not support labels in the middle of a declaration }
+      result:=get_dynarray_header_size;
+    end;
+
+
 begin
   ctai_typedconstbuilder:=tllvmtai_typedconstbuilder;
 end.

compiler/m68k/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AmigaOS/MorphOS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

compiler/ncal.pas

@@ -108,6 +108,7 @@ interface
             it's not strictly necessary) for speed and code size reasons.
             Returns true if the temp creation has been handled, false otherwise
           }
+          function paraneedsinlinetemp(para: tcallparanode; const pushconstaddr, complexpara: boolean): boolean; virtual;
           function maybecreateinlineparatemp(para: tcallparanode; out complexpara: boolean): boolean;
           procedure createinlineparas;
           procedure wrapcomplexinlinepara(para: tcallparanode); virtual;
@@ -768,7 +769,7 @@ implementation
                         as a dynamic array here }
                      { first restore the actual resultdef of left }
                      temparraydef:=left.resultdef;
-                     left.resultdef:=parasym.vardef;
+                     left.resultdef:=resultdef;
                      { get its address }
                      lefttemp:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true);
                      addstatement(initstat,lefttemp);
@@ -779,21 +780,19 @@ implementation
                          caddrnode.create_internal(left)
                        )
                      );
-                     { restore the resultdef }
-                     left.resultdef:=temparraydef;
                      { now treat that address (correctly) as the original
                        dynamic array to get its start and length }
                      arraybegin:=cvecnode.create(
                        ctypeconvnode.create_explicit(ctemprefnode.create(lefttemp),
-                         left.resultdef),
+                         temparraydef),
                        genintconstnode(0)
                      );
                      arraysize:=caddnode.create(muln,
                        geninlinenode(in_length_x,false,
                          ctypeconvnode.create_explicit(ctemprefnode.create(lefttemp),
-                           left.resultdef)
+                           temparraydef)
                        ),
-                       genintconstnode(tarraydef(left.resultdef).elementdef.size)
+                       genintconstnode(tarraydef(temparraydef).elementdef.size)
                      );
                    end
                  else
@@ -4626,98 +4625,98 @@ implementation
       end;
 
 
+    function tcallnode.paraneedsinlinetemp(para: tcallparanode; const pushconstaddr, complexpara: boolean): boolean;
+      begin
+        { We need a temp if the passed value will not be in memory, while
+          the parameter inside the routine must be in memory }
+        if (tparavarsym(para.parasym).varregable in [vr_none,vr_addr]) and
+           not(para.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+          exit(true);
+
+        { We cannot create a formaldef temp and assign something to it }
+        if para.parasym.vardef.typ=formaldef then
+          exit(false);
+
+        { We try to handle complex expressions later by taking their address
+          and storing this address in a temp (which is then dereferenced when
+          the value is used; that doesn't work if we cannot take the address
+          of the expression though, in which case we store the result of the
+          expression in a temp }
+        if (complexpara and not(para.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) or
+           (complexpara and
+            (not valid_for_addr(para.left,false) or
+             (para.left.nodetype=calln) or
+             is_constnode(para.left)))) then
+          exit(true);
+
+        { Normally, we do not need to create a temp for value parameters that
+          are not modified in the inlined function, and neither for const
+          parameters that are passed by value.
+
+          However, if we pass a global variable, an object field, a variable
+          whose address has been taken, or an expression containing a pointer
+          dereference as parameter, this value could be modified in other ways
+          as well (even inside the callee) and in such cases we still create a
+          temp to be on the safe side.
+
+          We *must not* create a temp for global variables passed by
+          reference to a const parameter, because if not inlined then any
+          changes to the original value will also be visible in the callee
+          (although this is technically undefined behaviour, since with
+           "const" the programmer tells the compiler this argument will not
+           change). }
+        if (((para.parasym.varspez=vs_value) and
+             (para.parasym.varstate in [vs_initialised,vs_declared,vs_read])) or
+            ((para.parasym.varspez=vs_const) and
+             not pushconstaddr)) and
+           foreachnodestatic(para.left,@nonlocalvars,pointer(symtableproc)) then
+          exit(true);
+
+        { Value parameters of which we know they are modified by definition
+          have to be copied to a temp }
+        if (para.parasym.varspez=vs_value) and
+           not(para.parasym.varstate in [vs_initialised,vs_declared,vs_read]) then
+          exit(true);
+
+        { the compiler expects that it can take the address of parameters passed by reference in
+          the case of const so we can't replace the node simply by a constant node
+          When playing with this code, ensure that
+          function f(const a,b  : longint) : longint;inline;
+            begin
+              result:=a*b;
+            end;
+
+          [...]
+          ...:=f(10,20));
+          [...]
+
+          is still folded. (FK)
+          }
+        if (para.parasym.varspez=vs_const) and
+           { const para's can get vs_readwritten if their address is taken ->
+             in case they are not passed by reference, to keep the same
+             behaviour as without inlining we have to make a copy in case the
+             originally passed parameter value gets changed inside the callee
+           }
+           (not pushconstaddr and
+            (para.parasym.varstate=vs_readwritten)
+           ) or
+           { call-by-reference const's may need to be passed by reference to
+             function called in the inlined code }
+           (pushconstaddr and
+            not valid_for_addr(para.left,false)) then
+          exit(true);
+
+        result:=false;
+      end;
+
+
     function tcallnode.maybecreateinlineparatemp(para: tcallparanode; out complexpara: boolean): boolean;
       var
         tempnode: ttempcreatenode;
         realtarget: tnode;
         paracomplexity: longint;
         pushconstaddr: boolean;
-
-      function needtemp: boolean;
-        begin
-          { We need a temp if the passed value will not be in memory, while
-            the parameter inside the routine must be in memory }
-          if (tparavarsym(para.parasym).varregable in [vr_none,vr_addr]) and
-             not(para.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) then
-            exit(true);
-
-          { We cannot create a formaldef temp and assign something to it }
-          if para.parasym.vardef.typ=formaldef then
-            exit(false);
-
-          { We try to handle complex expressions later by taking their address
-            and storing this address in a temp (which is then dereferenced when
-            the value is used; that doesn't work if we cannot take the address
-            of the expression though, in which case we store the result of the
-            expression in a temp }
-          if (complexpara and not(para.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) or
-             (complexpara and
-              (not valid_for_addr(para.left,false) or
-               (para.left.nodetype=calln) or
-               is_constnode(para.left)))) then
-            exit(true);
-
-          { Normally, we do not need to create a temp for value parameters that
-            are not modified in the inlined function, and neither for const
-            parameters that are passed by value.
-
-            However, if we pass a global variable, an object field, a variable
-            whose address has been taken, or an expression containing a pointer
-            dereference as parameter, this value could be modified in other ways
-            as well (even inside the callee) and in such cases we still create a
-            temp to be on the safe side.
-
-            We *must not* create a temp for global variables passed by
-            reference to a const parameter, because if not inlined then any
-            changes to the original value will also be visible in the callee
-            (although this is technically undefined behaviour, since with
-             "const" the programmer tells the compiler this argument will not
-             change). }
-          if (((para.parasym.varspez=vs_value) and
-               (para.parasym.varstate in [vs_initialised,vs_declared,vs_read])) or
-              ((para.parasym.varspez=vs_const) and
-               not pushconstaddr)) and
-             foreachnodestatic(para.left,@nonlocalvars,pointer(symtableproc)) then
-            exit(true);
-
-          { Value parameters of which we know they are modified by definition
-            have to be copied to a temp }
-          if (para.parasym.varspez=vs_value) and
-             not(para.parasym.varstate in [vs_initialised,vs_declared,vs_read]) then
-            exit(true);
-
-          { the compiler expects that it can take the address of parameters passed by reference in
-            the case of const so we can't replace the node simply by a constant node
-            When playing with this code, ensure that
-            function f(const a,b  : longint) : longint;inline;
-              begin
-                result:=a*b;
-              end;
-
-            [...]
-            ...:=f(10,20));
-            [...]
-
-            is still folded. (FK)
-            }
-          if (para.parasym.varspez=vs_const) and
-             { const para's can get vs_readwritten if their address is taken ->
-               in case they are not passed by reference, to keep the same
-               behaviour as without inlining we have to make a copy in case the
-               originally passed parameter value gets changed inside the callee
-             }
-             (not pushconstaddr and
-              (para.parasym.varstate=vs_readwritten)
-             ) or
-             { call-by-reference const's may need to be passed by reference to
-               function called in the inlined code }
-             (pushconstaddr and
-              not valid_for_addr(para.left,false)) then
-            exit(true);
-
-          result:=false;
-        end;
-
       begin
         result:=false;
         { determine how a parameter is passed to the inlined body
@@ -4775,7 +4774,7 @@ implementation
         { check if we have to create a temp, assign the parameter's
           contents to that temp and then substitute the parameter
           with the temp everywhere in the function                  }
-        if needtemp then
+        if paraneedsinlinetemp(para,pushconstaddr,complexpara) then
           begin
             tempnode:=ctempcreatenode.create(para.parasym.vardef,para.parasym.vardef.size,
               tt_persistent,tparavarsym(para.parasym).is_regvar(false));

compiler/ncgcnv.pas

@@ -423,10 +423,10 @@ interface
          case tstringdef(resultdef).stringtype of
            st_shortstring :
              begin
-               tg.gethltemp(current_asmdata.CurrAsmList,cshortstringtype,256,tt_normal,location.reference);
+               tg.gethltemp(current_asmdata.CurrAsmList,resultdef,resultdef.size,tt_normal,location.reference);
                tmpref:=location.reference;
                hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,
-                 cpointerdef.getreusable(cshortstringtype),
+                 cpointerdef.getreusable(resultdef),
                  cpointerdef.getreusable(left.resultdef),tmpref);
                hlcg.a_load_loc_ref(current_asmdata.CurrAsmList,left.resultdef,left.resultdef,left.location,
                  tmpref);
@@ -574,7 +574,7 @@ interface
                     begin
                       location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
                       { code field is the first one }
-                      hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(tprocvardef(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal))),cpointerdef.getreusable(resultdef),left.location.reference);
+                      hlcg.g_ptrtypecast_ref(current_asmdata.CurrAsmList,cpointerdef.getreusable(tprocvardef(tprocdef(left.resultdef).getcopyas(procvardef,pc_normal,''))),cpointerdef.getreusable(resultdef),left.location.reference);
                       hlcg.a_load_ref_reg(current_asmdata.CurrAsmList,resultdef,resultdef,left.location.reference,location.register);
                     end;
                   LOC_REGISTER,LOC_CREGISTER:

compiler/ncgnstld.pas

@@ -106,8 +106,8 @@ implementation
                      the parentfpstruct inside the routine in which they were
                      originally declared, except in the initialisation code for
                      the parentfpstruct (nf_internal flag) }
-                  (tabstractnormalvarsym(symtableentry).inparentfpstruct and
-                   not(nf_internal in flags))) then
+                  tabstractnormalvarsym(symtableentry).inparentfpstruct) and
+                   not(nf_internal in flags) then
                 begin
                   { get struct holding all locals accessed by nested routines }
                   nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
@@ -142,7 +142,6 @@ implementation
       var
         thissym,
         nestedvars: tsym;
-        nestedvarsdef: tdef;
       begin
         result:=inherited;
         if assigned(result) then
@@ -153,11 +152,8 @@ implementation
             begin
               { Nested variable? Then we have to move it to a structure that
                 can be passed by reference to nested routines }
-              if assigned(current_procinfo) and
-                 (symtable.symtabletype in [localsymtable,parasymtable]) and
-                 ((symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) or
-                  (tabstractnormalvarsym(symtableentry).inparentfpstruct and
-                   not(nf_internal in flags))) then
+              if assigned(left) and
+                 not(nf_internal in flags) then
                 begin
                   { get struct holding all locals accessed by nested routines }
                   nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
@@ -167,7 +163,6 @@ implementation
                       build_parentfpstruct(tprocdef(symtable.defowner));
                       nestedvars:=tprocdef(symtable.defowner).parentfpstruct;
                     end;
-                  nestedvarsdef:=tlocalvarsym(nestedvars).vardef;
                   if nestedvars<>symtableentry then
                     thissym:=nestsym
                   else
@@ -185,7 +180,7 @@ implementation
                   left:=csubscriptnode.create(thissym,cderefnode.create(left));
                   firstpass(left);
                   include(flags,nf_internal);
-                 end;
+                end;
             end;
         end;
       end;

compiler/ncgutil.pas

@@ -1818,9 +1818,11 @@ implementation
                         begin
                           { 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() }
+                            (gets freed in thlcgobj.gen_load_return_value();) }
                           if (typ in [localvarsym,paravarsym]) and
-                             (([vo_is_funcret,vo_is_result]*varoptions)=[]) then
+                             (([vo_is_funcret,vo_is_result]*varoptions)=[]) and
+                             ((current_procinfo.procdef.proctypeoption<>potype_constructor) or
+                              not(vo_is_self in varoptions)) then
                             tg.Ungetlocal(list,localloc.reference);
                         end;
                     end;

compiler/ncnv.pas

@@ -350,7 +350,8 @@ implementation
         if equal_defs(p.resultdef,def) and
            (p.resultdef.typ=def.typ) and
            not is_bitpacked_access(p) and
-           not ctypeconvnode.target_specific_need_equal_typeconv(p.resultdef,def) then
+           ((p.blocktype=bt_const) or
+            not ctypeconvnode.target_specific_need_equal_typeconv(p.resultdef,def)) then
           begin
             { don't replace encoded string constants to rawbytestring encoding.
               preserve the codepage }
@@ -2268,7 +2269,7 @@ implementation
              copytype:=pc_address_only
            else
              copytype:=pc_normal;
-           resultdef:=pd.getcopyas(procvardef,copytype);
+           resultdef:=pd.getcopyas(procvardef,copytype,'');
          end;
       end;
 
@@ -2434,7 +2435,8 @@ implementation
 {$ifdef llvm}
                      { we still may have to insert a type conversion at the
                        llvm level }
-                     if (left.resultdef<>resultdef) and
+                     if (blocktype<>bt_const) and
+                        (left.resultdef<>resultdef) and
                         { if unspecialised generic -> we won't generate any code
                           for this, and keeping the type conversion node will
                           cause valid_for_assign to fail because the typecast will be from/to something of 0

compiler/ncon.pas

@@ -982,6 +982,7 @@ implementation
                             Message1(option_code_page_not_available,IntToStr(cp1));
                           initwidestring(pw);
                           setlengthwidestring(pw,len);
+                          { returns room for terminating 0 }
                           l:=Utf8ToUnicode(PUnicodeChar(pw^.data),len,value_str,len);
                           if (l<>getlengthwidestring(pw)) then
                             begin
@@ -989,6 +990,7 @@ implementation
                               ReAllocMem(value_str,l);
                             end;
                           unicode2ascii(pw,value_str,cp1);
+                          len:=l-1;
                           donewidestring(pw);
                         end
                       else
@@ -1000,6 +1002,7 @@ implementation
                           initwidestring(pw);
                           setlengthwidestring(pw,len);
                           ascii2unicode(value_str,len,cp2,pw);
+                          { returns room for terminating 0 }
                           l:=UnicodeToUtf8(nil,0,PUnicodeChar(pw^.data),len);
                           if l<>len then
                             ReAllocMem(value_str,l);

compiler/ninl.pas

@@ -4371,7 +4371,7 @@ implementation
 
          addstatement(newstatement,cassignmentnode.create(resultnode,hpp));
 
-         { force pass 1, so copied tries get first pass'ed as well and flags like nf_write, nf_call_unique
+         { force pass 1, so copied trees get first pass'ed as well and flags like nf_write, nf_call_unique
            get set right }
          node_reset_flags(newstatement.statement,[nf_pass1_done]);
          { firstpass it }

compiler/powerpc/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AmigaOS/MorphOS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

compiler/symcreat.pas

@@ -515,7 +515,7 @@ implementation
     end;
 
 
-  procedure addvisibibleparameters(var str: ansistring; pd: tprocdef);
+  procedure addvisibleparameters(var str: ansistring; pd: tprocdef);
     var
       currpara: tparavarsym;
       i: longint;
@@ -530,7 +530,7 @@ implementation
               if not firstpara then
                 str:=str+',';
               firstpara:=false;
-              str:=str+currpara.realname;
+              str:=str+'&'+currpara.realname;
             end;
         end;
     end;
@@ -554,7 +554,7 @@ implementation
         mnetion this program/unit name to avoid accidentally calling other
         same-named routines that may be in scope }
       str:=str+def_unit_name_prefix_if_toplevel(callpd)+callpd.procsym.realname+'(';
-      addvisibibleparameters(str,pd);
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       str_parse_method_impl(str,pd,isclassmethod);
     end;
@@ -862,7 +862,7 @@ implementation
          not is_void(pd.returndef) then
         str:=str+'result:=';
       str:=str+'pv(';
-      addvisibibleparameters(str,pd);
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       str_parse_method_impl(str,pd,true)
     end;
@@ -964,7 +964,7 @@ implementation
       if pd.returndef<>voidtype then
         str:=str+'result:=';
       str:=str+'__FPC_BLOCK_INVOKE_PV_TYPE(PFPC_Block_literal_complex_procvar(FPC_Block_Self)^.pv)(';
-      addvisibibleparameters(str,pd);
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       str_parse_method_impl(str,pd,false);
     end;
@@ -988,8 +988,8 @@ implementation
       { now call through to the actual method }
       if pd.returndef<>voidtype then
         str:=str+'result:=';
-      str:=str+callthroughpd.procsym.realname+'(';
-      addvisibibleparameters(str,callthroughpd);
+      str:=str+'&'+callthroughpd.procsym.realname+'(';
+      addvisibleparameters(str,pd);
       str:=str+') end;';
       { add dummy file info so we can step in/through it }
       if pd.owner.iscurrentunit then
@@ -1147,8 +1147,11 @@ implementation
   function create_procdef_alias(pd: tprocdef; const newrealname: string; const newmangledname: TSymStr; newparentst: tsymtable; newstruct: tabstractrecorddef;
       sk: tsynthetickind; skpara: pointer): tprocdef;
     begin
-      { bare copy so we don't copy the aliasnames }
-      result:=tprocdef(pd.getcopyas(procdef,pc_bareproc));
+      { bare copy so we don't copy the aliasnames (specify prefix for
+        parameter names so we don't get issues in the body in case
+        we e.g. reference system.initialize and one of the parameters
+        is called "system") }
+      result:=tprocdef(pd.getcopyas(procdef,pc_bareproc,'__FPCW_'));
       { set the mangled name to the wrapper name }
       result.setmangledname(newmangledname);
       { finish creating the copy }
@@ -1481,7 +1484,10 @@ implementation
         because there may already be references to the mangled name for the
         non-external "test".
       }
-      newpd:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc));
+
+      { prefixing the parameters here is useless, because the new procdef will
+        just be an external declaration without a body }
+      newpd:=tprocdef(orgpd.getcopyas(procdef,pc_bareproc,''));
       insert_funcret_para(newpd);
       newpd.procoptions:=newpd.procoptions+orgpd.procoptions*[po_external,po_has_importname,po_has_importdll];
       newpd.import_name:=orgpd.import_name;
@@ -1493,6 +1499,9 @@ implementation
       newpd.setmangledname(newname);
       finish_copied_procdef(newpd,'__FPC_IMPL_EXTERNAL_REDIRECT_'+newname,current_module.localsymtable,nil);
       newpd.forwarddef:=false;
+      { ideally we would prefix the parameters of the original routine here, but since it
+        can be an interface definition, we cannot do that without risking to change the
+        interface crc }
       orgpd.skpara:=newpd;
       orgpd.synthetickind:=tsk_callthrough;
       orgpd.procoptions:=orgpd.procoptions-[po_external,po_has_importname,po_has_importdll];

compiler/symdef.pas

@@ -630,7 +630,7 @@ interface
           function  is_addressonly:boolean;virtual;
           function  no_self_node:boolean;
           { get either a copy as a procdef or procvardef }
-          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp): tstoreddef; virtual;
+          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef; virtual;
           function  compatible_with_pointerdef_size(ptr: tpointerdef): boolean; virtual;
           procedure check_mark_as_nested;
           procedure init_paraloc_info(side: tcallercallee);
@@ -668,7 +668,7 @@ interface
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
           function  getmangledparaname:TSymStr;override;
-          function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+          function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
        end;
        tprocvardefclass = class of tprocvardef;
 
@@ -813,7 +813,7 @@ interface
                 needs to be finalised afterwards by calling
                 symcreat.finish_copied_procdef() afterwards
           }
-          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp): tstoreddef; override;
+          function  getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef; override;
           function  getcopy: tstoreddef; override;
           function  GetTypeName : string;override;
           function  mangledname : TSymStr; virtual;
@@ -5154,7 +5154,7 @@ implementation
       end;
 
 
-    function tabstractprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp): tstoreddef;
+    function tabstractprocdef.getcopyas(newtyp:tdeftyp;copytyp:tproccopytyp; const paraprefix: string): tstoreddef;
       var
         j, nestinglevel: longint;
         pvs, npvs: tparavarsym;
@@ -5187,8 +5187,15 @@ implementation
                   if (copytyp=pc_bareproc) and
                      (([vo_is_self,vo_is_vmt,vo_is_parentfp,vo_is_result,vo_is_funcret]*pvs.varoptions)<>[]) then
                     continue;
-                  npvs:=cparavarsym.create(pvs.realname,pvs.paranr,pvs.varspez,
-                    pvs.vardef,pvs.varoptions);
+                  if paraprefix='' then
+                    npvs:=cparavarsym.create(pvs.realname,pvs.paranr,pvs.varspez,
+                      pvs.vardef,pvs.varoptions)
+                  else if not(vo_is_high_para in pvs.varoptions) then
+                    npvs:=cparavarsym.create(paraprefix+pvs.realname,pvs.paranr,pvs.varspez,
+                      pvs.vardef,pvs.varoptions)
+                  else
+                    npvs:=cparavarsym.create('$high'+paraprefix+copy(pvs.name,5,length(pvs.name)),pvs.paranr,pvs.varspez,
+                      pvs.vardef,pvs.varoptions);
                   npvs.defaultconstsym:=pvs.defaultconstsym;
                   tabstractprocdef(result).parast.insert(npvs);
                 end;
@@ -6070,11 +6077,11 @@ implementation
       end;
 
 
-    function tprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+    function tprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
       var
         j : longint;
       begin
-        result:=inherited getcopyas(newtyp,copytyp);
+        result:=inherited;
         if newtyp=procvardef then
           begin
             { create new paralist }
@@ -6141,7 +6148,7 @@ implementation
 
     function tprocdef.getcopy: tstoreddef;
       begin
-        result:=getcopyas(procdef,pc_normal);
+        result:=getcopyas(procdef,pc_normal,'');
       end;
 
 
@@ -6504,7 +6511,7 @@ implementation
             { do not simply push/pop current_module.localsymtable, because
               that can have side-effects (e.g., it removes helpers) }
             symtablestack:=nil;
-            result:=tprocvardef(def.getcopyas(procvardef,pc_address_only));
+            result:=tprocvardef(def.getcopyas(procvardef,pc_address_only,''));
             setup_reusable_def(def,result,res,oldsymtablestack);
             { res^.Data may still be nil -> don't overwrite result }
             exit;
@@ -6643,7 +6650,7 @@ implementation
       end;
 
 
-    function tprocvardef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+    function tprocvardef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
       begin
         result:=inherited;
         tabstractprocdef(result).calcparas;

compiler/x86_64/symcpu.pas

@@ -97,7 +97,7 @@ type
     { library symbol for AROS }
     libsym : tsym;
     libsymderef : tderef;
-    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef; override;
+    function getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef; override;
     procedure buildderef; override;
     procedure deref; override;
   end;
@@ -203,7 +203,7 @@ implementation
     end;
 
 
-  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp): tstoreddef;
+  function tcpuprocdef.getcopyas(newtyp: tdeftyp; copytyp: tproccopytyp; const paraprefix: string): tstoreddef;
     begin
       result:=inherited;
       if newtyp=procdef then

packages/chm/src/chmcmd.lpr

@@ -26,7 +26,7 @@ uses
   {$ifdef Unix}cthreads,{$endif} Classes, Sysutils, chmfilewriter, GetOpts;
 
 Const
-  CHMCMDVersion = '3.1.1';
+  CHMCMDVersion = {$I %FPCVERSION%};
 
 Procedure Usage;
 

packages/fcl-db/examples/myext.pp

@@ -0,0 +1,49 @@
+library myext;
+
+{$mode objfpc}{$h+}
+
+uses
+  sysutils,
+  ctypes,
+  sqlite3,
+  sqlite3ext;
+
+procedure mysum(ctx: psqlite3_context; n: cint; v: ppsqlite3_value); cdecl;
+var
+  a, b, r: cint;
+begin
+  a := sqlite3_value_int(v[0]);
+  b := sqlite3_value_int(v[1]);
+  r := a + b;
+  sqlite3_result_int(ctx, r);
+end;
+
+procedure myconcat(ctx: psqlite3_context; n: cint; v: ppsqlite3_value); cdecl;
+var
+  a, b, r: ansistring;
+begin
+  a := sqlite3_value_text(v[0]);
+  b := sqlite3_value_text(v[1]);
+  r := a + b;
+  sqlite3_result_text(ctx, @r[1], length(r), nil);
+end;
+
+function sqlite3_extension_init(db: Psqlite3; pzErrMsg: Ppcchar;
+  const pApi: Psqlite3_api_routines): cint; cdecl; export;
+var
+  rc: cint;
+begin
+  SQLITE_EXTENSION_INIT2(pApi);
+  rc := sqlite3_create_function(db, 'mysum', 2, SQLITE_UTF8, nil,
+    @mysum, nil, nil);
+  if rc = SQLITE_OK then
+    Result := sqlite3_create_function(db, 'myconcat', 2, SQLITE_UTF8, nil,
+      @myconcat, nil, nil);
+  Result := rc;
+end;
+
+exports
+  sqlite3_extension_init;
+
+begin
+end.

packages/fcl-db/examples/sqlite3extdemo.pp

@@ -0,0 +1,40 @@
+program test;
+
+{$mode objfpc}{$H+}
+
+uses
+  sysutils,
+  sqlite3conn,
+  sqlite3ext,
+  sqldb;
+
+const
+  SharedPrefix = {$ifdef mswindows}''{$else}'lib'{$endif};
+
+var
+  con: TSQLite3Connection;
+  trans: TSQLTransaction;
+  q: TSQLQuery;
+begin
+  con := TSQLite3Connection.Create(nil);
+  trans := TSQLTransaction.Create(con);
+  q := TSQLQuery.Create(con);
+  try
+    trans.DataBase := con;
+    q.DataBase := con;
+    q.Transaction := trans;
+    con.DatabaseName := 'test.sqlite3';
+    con.Open;
+    con.LoadExtension(ExtractFilePath(ParamStr(0)) +
+      SharedPrefix + 'myext.' + SharedSuffix);
+    q.SQL.Text := 'SELECT mysum(2, 3);';
+    q.Open;
+    WriteLn('MYSUM: ', q.Fields[0].AsInteger); // prints "MYSUM: 5"
+    q.Close;
+    q.SQL.Text := 'SELECT myconcat(''abc'', ''123'');';
+    q.Open;
+    WriteLn('MYCONCAT: ', q.Fields[0].AsString); // prints "MYCONCAT: abc123"
+  finally
+    con.Free;
+  end;
+end.

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -119,7 +119,7 @@ Type
     // Warning: UTF8CompareCallback needs a wide string manager on Linux such as cwstring
     // Warning: CollationName has to be a UTF-8 string
     procedure CreateCollation(const CollationName: string; eTextRep: integer; Arg: Pointer=nil; Compare: xCompare=nil);
-    procedure LoadExtension(LibraryFile: string);
+    procedure LoadExtension(const LibraryFile: string);
   Published
     Property OpenFlags : TSQLiteOpenFlags Read FOpenFlags Write SetOpenFlags default DefaultOpenFlags;
   end;
@@ -1107,7 +1107,7 @@ begin
   CheckError(sqlite3_create_collation(fhandle, PChar(CollationName), eTextRep, Arg, Compare));
 end;
 
-procedure TSQLite3Connection.LoadExtension(LibraryFile: string);
+procedure TSQLite3Connection.LoadExtension(const LibraryFile: string);
 var
   LoadResult: integer;
 begin

packages/fcl-js/src/jsbase.pp

@@ -26,8 +26,8 @@ uses
   Classes, SysUtils;
 
 const
-  MinSafeIntDouble = -$10000000000000; // -4503599627370496
-  MaxSafeIntDouble =   $fffffffffffff; //  4503599627370495
+  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
+  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
 Type
   TJSType = (jstUNDEFINED,jstNull,jstBoolean,jstNumber,jstString,jstObject,jstReference,jstCompletion);
 

packages/fcl-js/src/jswriter.pp

@@ -355,8 +355,8 @@ Var
 begin
   Result:=Length(S)*SizeOf(TJSWriterChar);
   if Result=0 then exit;
-  MinLen:=Result+FBufPos;
-  If (MinLen>Capacity) then
+  MinLen:=Result+integer(FBufPos);
+  If (MinLen>integer(Capacity)) then
     begin
     DesLen:=(FCapacity*3) div 2;
     if DesLen>MinLen then
@@ -364,7 +364,7 @@ begin
     Capacity:=MinLen;
     end;
   Move(S[1],FBuffer[FBufPos],Result);
-  FBufPos:=FBufPos+Result;
+  FBufPos:=integer(FBufPos)+Result;
 end;
 {$endif}
 
@@ -377,8 +377,8 @@ Var
 begin
   Result:=Length(S)*SizeOf(UnicodeChar);
   if Result=0 then exit;
-  MinLen:=Result+FBufPos;
-  If (MinLen>Capacity) then
+  MinLen:=Result+integer(FBufPos);
+  If (MinLen>integer(Capacity)) then
     begin
     DesLen:=(FCapacity*3) div 2;
     if DesLen>MinLen then
@@ -386,7 +386,7 @@ begin
     Capacity:=MinLen;
     end;
   Move(S[1],FBuffer[FBufPos],Result);
-  FBufPos:=FBufPos+Result;
+  FBufPos:=integer(FBufPos)+Result;
 end;
 {$endif}
 

packages/fcl-passrc/src/pasresolveeval.pas

@@ -134,7 +134,7 @@ const
   nFoundCallCandidateX = 3057;
   nTextAfterFinalIgnored = 3058;
   nNoMemberIsProvidedToAccessProperty = 3059;
-  // free 3060
+  nTheUseOfXisNotAllowedInARecord = 3060;
   // free 3061
   // free 3062
   // free 3063
@@ -251,6 +251,7 @@ resourcestring
   sFoundCallCandidateX = 'Found call candidate %s';
   sTextAfterFinalIgnored = 'Text after final ''end.''. ignored by compiler';
   sNoMemberIsProvidedToAccessProperty = 'No member is provided to access property';
+  sTheUseOfXisNotAllowedInARecord = 'The use of "%s" is not allowed in a record';
   sSymbolXIsNotPortable = 'Symbol "%s" is not portable';
   sSymbolXIsExperimental = 'Symbol "%s" is experimental';
   sSymbolXIsNotImplemented = 'Symbol "%s" is not implemented';
@@ -340,8 +341,8 @@ const
   MinSafeIntSingle = -16777216;
   MaxSafeIntSingle =  16777216;
   MaskUIntSingle = $3fffff;
-  MinSafeIntDouble = -$10000000000000; // -4503599627370496
-  MaxSafeIntDouble =   $fffffffffffff; //  4503599627370495
+  MinSafeIntDouble = -$fffffffffffff-1; // -4503599627370496
+  MaxSafeIntDouble =  $fffffffffffff; //  4503599627370495
   MaskUIntDouble = $fffffffffffff;
 
 type
@@ -697,6 +698,8 @@ type
     procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
     function EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
+    function EvalStringAddExpr(Expr, LeftExpr, RightExpr: TPasExpr;
+      LeftValue, RightValue: TResEvalValue): TResEvalValue; virtual;
     function EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
       Flags: TResEvalFlags): TResEvalEnum; virtual;
     {$ifdef FPC_HAS_CPSTRING}
@@ -1249,7 +1252,7 @@ begin
           reitLongWord: TResEvalInt(Result).Int:=not longword(TResEvalInt(Result).Int);
           reitLongInt: TResEvalInt(Result).Int:=not longint(TResEvalInt(Result).Int);
           reitUIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $fffffffffffff;
-          reitIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $1fffffffffffff;
+          reitIntDouble: {$ifdef fpc}TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $1fffffffffffff{$endif};
           else TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
         end;
         end;
@@ -1534,9 +1537,6 @@ var
   UInt: TMaxPrecUInt;
   Flo: TMaxPrecFloat;
   aCurrency: TMaxPrecCurrency;
-  {$ifdef FPC_HAS_CPSTRING}
-  LeftCP, RightCP: TSystemCodePage;
-  {$endif}
   LeftSet, RightSet: TResEvalSet;
   i: Integer;
 begin
@@ -1634,58 +1634,10 @@ begin
       end;
       end;
     {$ifdef FPC_HAS_CPSTRING}
-    revkString:
-      case RightValue.Kind of
-      revkString:
-        begin
-        LeftCP:=GetCodePage(TResEvalString(LeftValue).S);
-        RightCP:=GetCodePage(TResEvalString(RightValue).S);
-        if (LeftCP=RightCP) then
-          begin
-          Result:=TResEvalString.Create;
-          TResEvalString(Result).S:=TResEvalString(LeftValue).S+TResEvalString(RightValue).S;
-          end
-        else
-          begin
-          Result:=TResEvalUTF16.Create;
-          TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
-                                  +GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
-          end;
-        end;
-      revkUnicodeString:
-        begin
-        Result:=TResEvalUTF16.Create;
-        TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
-                                +TResEvalUTF16(RightValue).S;
-        end;
-      else
-        {$IFDEF VerbosePasResolver}
-        writeln('TResExprEvaluator.EvalBinaryAddExpr string+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
-        {$ENDIF}
-        RaiseNotYetImplemented(20170601141834,Expr);
-      end;
+    revkString,
     {$endif}
     revkUnicodeString:
-      case RightValue.Kind of
-      {$ifdef FPC_HAS_CPSTRING}
-      revkString:
-        begin
-        Result:=TResEvalUTF16.Create;
-        TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S
-                                +GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
-        end;
-      {$endif}
-      revkUnicodeString:
-        begin
-        Result:=TResEvalUTF16.Create;
-        TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+TResEvalUTF16(RightValue).S;
-        end;
-      else
-        {$IFDEF VerbosePasResolver}
-        writeln('TResExprEvaluator.EvalBinaryAddExpr utf16+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
-        {$ENDIF}
-        RaiseNotYetImplemented(20170601141811,Expr);
-      end;
+      Result:=EvalStringAddExpr(Expr,Expr.left,Expr.right,LeftValue,RightValue);
     revkSetOfInt:
       case RightValue.Kind of
       revkSetOfInt:
@@ -4792,6 +4744,72 @@ begin
     {$endif}
 end;
 
+function TResExprEvaluator.EvalStringAddExpr(Expr, LeftExpr,
+  RightExpr: TPasExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
+{$ifdef FPC_HAS_CPSTRING}
+var
+  LeftCP, RightCP: TSystemCodePage;
+{$endif}
+begin
+  case LeftValue.Kind of
+  {$ifdef FPC_HAS_CPSTRING}
+  revkString:
+    case RightValue.Kind of
+    revkString:
+      begin
+      LeftCP:=GetCodePage(TResEvalString(LeftValue).S);
+      RightCP:=GetCodePage(TResEvalString(RightValue).S);
+      if (LeftCP=RightCP) then
+        begin
+        Result:=TResEvalString.Create;
+        TResEvalString(Result).S:=TResEvalString(LeftValue).S+TResEvalString(RightValue).S;
+        end
+      else
+        begin
+        Result:=TResEvalUTF16.Create;
+        TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
+                                +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
+        end;
+      end;
+    revkUnicodeString:
+      begin
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
+                              +TResEvalUTF16(RightValue).S;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryAddExpr string+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170601141834,Expr);
+    end;
+  {$endif}
+  revkUnicodeString:
+    case RightValue.Kind of
+    {$ifdef FPC_HAS_CPSTRING}
+    revkString:
+      begin
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S
+                              +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
+      end;
+    {$endif}
+    revkUnicodeString:
+      begin
+      Result:=TResEvalUTF16.Create;
+      TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+TResEvalUTF16(RightValue).S;
+      end;
+    else
+      {$IFDEF VerbosePasResolver}
+      writeln('TResExprEvaluator.EvalBinaryAddExpr utf16+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
+      {$ENDIF}
+      RaiseNotYetImplemented(20170601141811,Expr);
+    end;
+  else
+    RaiseNotYetImplemented(20181219233139,Expr);
+  end;
+end;
+
 function TResExprEvaluator.EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
   Flags: TResEvalFlags): TResEvalEnum;
 var

packages/fcl-passrc/src/pastree.pp

@@ -692,14 +692,31 @@ type
     Members: TPasRecordType;
   end;
 
-  { TPasRecordType }
+  { TPasMembersType - base type for TPasRecordType and TPasClassType }
 
-  TPasRecordType = class(TPasType)
+  TPasMembersType = class(TPasType)
   private
     procedure ClearChildReferences(El: TPasElement; arg: pointer);
-    procedure GetMembers(S: TStrings);
   protected
     procedure SetParent(const AValue: TPasElement); override;
+  public
+    PackMode: TPackMode;
+    Members: TFPList;
+    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
+    Constructor Create(const AName: string; AParent: TPasElement); override;
+    Destructor Destroy; override;
+    Function IsPacked: Boolean;
+    Function IsBitPacked : Boolean;
+    Procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+    Procedure SetGenericTemplates(AList: TFPList); virtual;
+  end;
+
+  { TPasRecordType }
+
+  TPasRecordType = class(TPasMembersType)
+  private
+    procedure GetMembers(S: TStrings);
   public
     constructor Create(const AName: string; AParent: TPasElement); override;
     destructor Destroy; override;
@@ -708,15 +725,9 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    PackMode: TPackMode;
-    Members: TFPList;     // list of TPasVariable elements
     VariantEl: TPasElement; // nil or TPasVariable or TPasType
     Variants: TFPList;	// list of TPasVariant elements, may be nil!
-    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
-    Function IsPacked: Boolean;
-    Function IsBitPacked : Boolean;
     Function IsAdvancedRecord : Boolean;
-    Procedure SetGenericTemplates(AList : TFPList);
   end;
 
   TPasGenericTemplateType = Class(TPasType);
@@ -734,9 +745,7 @@ type
 
   { TPasClassType }
 
-  TPasClassType = class(TPasType)
-  private
-    procedure ClearChildReferences(El: TPasElement; arg: pointer);
+  TPasClassType = class(TPasMembersType)
   protected
     procedure SetParent(const AValue: TPasElement); override;
   public
@@ -746,7 +755,6 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    PackMode: TPackMode;
     ObjKind: TPasObjKind;
     AncestorType: TPasType;   // TPasClassType or TPasUnresolvedTypeRef or TPasAliasType or TPasTypeAliasType
                               // Note: AncestorType can be nil even though it has a default ancestor
@@ -755,25 +763,20 @@ type
     IsExternal : Boolean;
     IsShortDefinition: Boolean;//class(anchestor); without end
     GUIDExpr : TPasExpr;
-    Members: TFPList;     // list of TPasElement
     Modifiers: TStringList;
     Interfaces : TFPList; // list of TPasType
-    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
     ExternalNameSpace : String;
     ExternalName : String;
     InterfaceType: TPasClassInterfaceType;
-    Procedure SetGenericTemplates(AList : TFPList);
+    Procedure SetGenericTemplates(AList : TFPList); override;
     Function FindMember(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
     Function FindMemberInAncestors(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
-    Function IsPacked : Boolean;
     Function InterfaceGUID : string;
     Function IsSealed : Boolean;
     Function IsAbstract : Boolean;
     Function HasModifier(const aModifier: String): Boolean;
   end;
 
-
-
   TArgumentAccess = (argDefault, argConst, argVar, argOut, argConstRef);
 
   { TPasArgument }
@@ -2948,22 +2951,12 @@ end;
 constructor TPasRecordType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
-  Members := TFPList.Create;
-  GenericTemplateTypes:=TFPList.Create;
 end;
 
 destructor TPasRecordType.Destroy;
 var
   i: Integer;
 begin
-  for i := 0 to GenericTemplateTypes.Count - 1 do
-    TPasElement(GenericTemplateTypes[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasRecordType.GenericTemplateTypes'){$ENDIF};
-  FreeAndNil(GenericTemplateTypes);
-
-  for i := 0 to Members.Count - 1 do
-    TPasVariable(Members[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasRecordType.Members'){$ENDIF};
-  FreeAndNil(Members);
-
   ReleaseAndNil(TPasElement(VariantEl){$IFDEF CheckPasTreeRefCount},'TPasRecordType.VariantEl'{$ENDIF});
 
   if Assigned(Variants) then
@@ -2978,19 +2971,12 @@ end;
 
 { TPasClassType }
 
-procedure TPasClassType.ClearChildReferences(El: TPasElement; arg: pointer);
-begin
-  El.ClearTypeReferences(Self);
-  if arg=nil then ;
-end;
-
 procedure TPasClassType.SetParent(const AValue: TPasElement);
 begin
   if (AValue=nil) and (Parent<>nil) then
     begin
     // parent is cleared
-    // -> clear all child references to this class (releasing loops)
-    ForEachCall(@ClearChildReferences,nil);
+    // -> clear all references to this class (releasing loops)
     if AncestorType=Self then
       ReleaseAndNil(TPasElement(AncestorType){$IFDEF CheckPasTreeRefCount},'TPasClassType.AncestorType'{$ENDIF});
     if HelperForType=Self then
@@ -3002,27 +2988,15 @@ end;
 constructor TPasClassType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
-  PackMode:=pmNone;                     // 12/04/04 - Dave - Added
   IsShortDefinition := False;
-  Members := TFPList.Create;
   Modifiers := TStringList.Create;
   Interfaces:= TFPList.Create;
-  GenericTemplateTypes:=TFPList.Create;
 end;
 
 destructor TPasClassType.Destroy;
 var
   i: Integer;
-  El: TPasElement;
 begin
-  for i := 0 to Members.Count - 1 do
-    begin
-    El:=TPasElement(Members[i]);
-    El.Parent:=nil;
-    El.Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.Members'){$ENDIF};
-    end;
-  FreeAndNil(Members);
-
   for i := 0 to Interfaces.Count - 1 do
     TPasElement(Interfaces[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.Interfaces'){$ENDIF};
   FreeAndNil(Interfaces);
@@ -3030,9 +3004,6 @@ begin
   ReleaseAndNil(TPasElement(HelperForType){$IFDEF CheckPasTreeRefCount},'TPasClassType.HelperForType'{$ENDIF});
   ReleaseAndNil(TPasElement(GUIDExpr){$IFDEF CheckPasTreeRefCount},'TPasClassType.GUIDExpr'{$ENDIF});
   FreeAndNil(Modifiers);
-  for i := 0 to GenericTemplateTypes.Count - 1 do
-    TPasElement(GenericTemplateTypes[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasClassType.GenericTemplateTypes'){$ENDIF};
-  FreeAndNil(GenericTemplateTypes);
   inherited Destroy;
 end;
 
@@ -3062,26 +3033,12 @@ begin
     ForEachChildCall(aMethodCall,Arg,TPasElement(Interfaces[i]),true);
   ForEachChildCall(aMethodCall,Arg,HelperForType,true);
   ForEachChildCall(aMethodCall,Arg,GUIDExpr,false);
-  for i:=0 to Members.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
-  for i:=0 to GenericTemplateTypes.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
 end;
 
 procedure TPasClassType.SetGenericTemplates(AList: TFPList);
-
-Var
-  I : Integer;
-
 begin
   ObjKind:=okGeneric;
-  For I:=0 to AList.Count-1 do
-    begin
-    TPasElement(AList[i]).Parent:=Self;
-    GenericTemplateTypes.Add(AList[i]);
-    end;
-  AList.Clear;
-  ObjKind:=okGeneric;
+  inherited SetGenericTemplates(AList);
 end;
 
 function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
@@ -3155,12 +3112,6 @@ begin
   Result:=false;
 end;
 
-function TPasClassType.IsPacked: Boolean;
-begin
-  Result:=PackMode<>pmNone;
-end;
-
-
 { TPasArgument }
 
 destructor TPasArgument.Destroy;
@@ -3987,12 +3938,95 @@ begin
   ForEachChildCall(aMethodCall,Arg,EnumType,true);
 end;
 
-procedure TPasRecordType.ClearChildReferences(El: TPasElement; arg: pointer);
+{ TPasMembersType }
+
+procedure TPasMembersType.ClearChildReferences(El: TPasElement; arg: pointer);
 begin
   El.ClearTypeReferences(Self);
   if arg=nil then ;
 end;
 
+procedure TPasMembersType.SetParent(const AValue: TPasElement);
+begin
+  if (AValue=nil) and (Parent<>nil) then
+    begin
+    // parent is cleared
+    // -> clear all child references to this class/record (releasing loops)
+    ForEachCall(@ClearChildReferences,nil);
+    end;
+  inherited SetParent(AValue);
+end;
+
+constructor TPasMembersType.Create(const AName: string; AParent: TPasElement);
+begin
+  inherited Create(AName, AParent);
+  PackMode:=pmNone;
+  Members := TFPList.Create;
+  GenericTemplateTypes:=TFPList.Create;
+end;
+
+destructor TPasMembersType.Destroy;
+var
+  i: Integer;
+  El: TPasElement;
+begin
+  for i := 0 to Members.Count - 1 do
+    begin
+    El:=TPasElement(Members[i]);
+    El.Parent:=nil;
+    El.Release{$IFDEF CheckPasTreeRefCount}('TPasMembersType.Members'){$ENDIF};
+    end;
+  FreeAndNil(Members);
+
+  for i := 0 to GenericTemplateTypes.Count - 1 do
+    begin
+    El:=TPasElement(GenericTemplateTypes[i]);
+    El.Parent:=nil;
+    El.Release{$IFDEF CheckPasTreeRefCount}('TPasMembersType.GenericTemplateTypes'){$ENDIF};
+    end;
+  FreeAndNil(GenericTemplateTypes);
+
+  inherited Destroy;
+end;
+
+function TPasMembersType.IsPacked: Boolean;
+begin
+  Result:=(PackMode <> pmNone);
+end;
+
+function TPasMembersType.IsBitPacked: Boolean;
+begin
+  Result:=(PackMode=pmBitPacked)
+end;
+
+procedure TPasMembersType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to GenericTemplateTypes.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),true);
+  for i:=0 to Members.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
+end;
+
+procedure TPasMembersType.SetGenericTemplates(AList: TFPList);
+var
+  I: Integer;
+  El: TPasElement;
+begin
+  For I:=0 to AList.Count-1 do
+    begin
+    El:=TPasElement(AList[i]);
+    El.Parent:=Self;
+    GenericTemplateTypes.Add(El);
+    end;
+  AList.Clear;
+end;
+
+{ TPasRecordType }
+
 procedure TPasRecordType.GetMembers(S: TStrings);
 
 Var
@@ -4049,17 +4083,6 @@ begin
   end;
 end;
 
-procedure TPasRecordType.SetParent(const AValue: TPasElement);
-begin
-  if (AValue=nil) and (Parent<>nil) then
-    begin
-    // parent is cleared
-    // -> clear all child references to this class (releasing loops)
-    ForEachCall(@ClearChildReferences,nil);
-    end;
-  inherited SetParent(AValue);
-end;
-
 function TPasRecordType.GetDeclaration (full : boolean) : string;
 
 Var
@@ -4093,54 +4116,30 @@ var
   i: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  for i:=0 to GenericTemplateTypes.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),true);
-  for i:=0 to Members.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
   ForEachChildCall(aMethodCall,Arg,VariantEl,true);
   if Variants<>nil then
     for i:=0 to Variants.Count-1 do
       ForEachChildCall(aMethodCall,Arg,TPasElement(Variants[i]),false);
 end;
 
-function TPasRecordType.IsPacked: Boolean;
-begin
-  Result:=(PackMode <> pmNone);
-end;
-
-function TPasRecordType.IsBitPacked: Boolean;
-begin
-  Result:=(PackMode=pmBitPacked)
-end;
-
 function TPasRecordType.IsAdvancedRecord: Boolean;
 
 Var
   I : Integer;
+  Member: TPasElement;
 
 begin
   Result:=False;
   I:=0;
   While (Not Result) and (I<Members.Count) do
     begin
-    Result:=TPasElement(Members[i]).InheritsFrom(TPasProcedureBase) or
-            TPasElement(Members[i]).InheritsFrom(TPasProperty);
+    Member:=TPasElement(Members[i]);
+    if (Member.Visibility<>visPublic) then exit(true);
+    if (Member.ClassType<>TPasVariable) then exit(true);
     Inc(I);
     end;
 end;
 
-procedure TPasRecordType.SetGenericTemplates(AList: TFPList);
-var
-  I: Integer;
-begin
-  For I:=0 to AList.Count-1 do
-    begin
-    TPasElement(AList[i]).Parent:=Self;
-    GenericTemplateTypes.Add(AList[i]);
-    end;
-  AList.Clear;
-end;
-
 procedure TPasProcedureType.GetArguments(List : TStrings);
 
 Var

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1479,6 +1479,25 @@ begin
         begin
         BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
         case BuiltInProc.BuiltIn of
+        bfExit:
+          begin
+          if El.Parent is TParamsExpr then
+            begin
+            Params:=(El.Parent as TParamsExpr).Params;
+            if length(Params)=1 then
+              begin
+              SubEl:=El.Parent;
+              while (SubEl<>nil) and not (SubEl is TPasProcedure) do
+                SubEl:=SubEl.Parent;
+              if (SubEl is TPasProcedure)
+                  and (TPasProcedure(SubEl).ProcType is TPasFunctionType) then
+                begin
+                SubEl:=TPasFunctionType(TPasProcedure(SubEl).ProcType).ResultEl;
+                UseElement(SubEl,rraAssign,false);
+                end;
+              end;
+            end;
+          end;
         bfTypeInfo:
           begin
           Params:=(El.Parent as TParamsExpr).Params;
@@ -1490,9 +1509,10 @@ begin
           {$ENDIF}
           if ParamResolved.IdentEl=nil then
             RaiseNotSupported(20180628155107,Params[0]);
-          if ParamResolved.IdentEl is TPasFunction then
+          if (ParamResolved.IdentEl is TPasProcedure)
+              and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
             begin
-            SubEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType;
+            SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
             MarkImplScopeRef(El,SubEl,psraTypeInfo);
             UseTypeInfo(SubEl);
             end

packages/fcl-passrc/src/pparser.pp

@@ -81,7 +81,7 @@ const
   nErrRecordConstantsNotAllowed = 2035;
   nErrRecordMethodsNotAllowed = 2036;
   nErrRecordPropertiesNotAllowed = 2037;
-  nErrRecordVisibilityNotAllowed = 2038;
+  // free , was nErrRecordVisibilityNotAllowed = 2038;
   nParserTypeNotAllowedHere = 2039;
   nParserNotAnOperand = 2040;
   nParserArrayPropertiesCannotHaveDefaultValue = 2041;
@@ -142,7 +142,7 @@ resourcestring
   SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
   SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
   SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.';
-  SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
+  // free, was SErrRecordVisibilityNotAllowed = 'Record visibilities not allowed at this location.';
   SParserTypeNotAllowedHere = 'Type "%s" not allowed here';
   SParserNotAnOperand = 'Not an operand: (%d : %s)';
   SParserArrayPropertiesCannotHaveDefaultValue = 'Array properties cannot have default value';
@@ -4504,7 +4504,7 @@ begin
   ParseVarList(Parent,List,AVisibility,False);
   tt:=[tkEnd,tkSemicolon];
   if ClosingBrace then
-   include(tt,tkBraceClose);
+    Include(tt,tkBraceClose);
   if not (CurToken in tt) then
     ParseExc(nParserExpectedSemiColonEnd,SParserExpectedSemiColonEnd);
 end;
@@ -5233,13 +5233,14 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
   end;
 
 var
-  isArray , ok: Boolean;
+  isArray , ok, IsClass: Boolean;
   ObjKind: TPasObjKind;
 begin
   Result:=TPasProperty(CreateElement(TPasProperty,AName,Parent,AVisibility));
   if IsClassField then
     Include(Result.VarModifiers,vmClass);
-  if (Parent<>nil) and (Parent.ClassType=TPasClassType) then
+  IsClass:=(Parent<>nil) and (Parent.ClassType=TPasClassType);
+  if IsClass then
     ObjKind:=TPasClassType(Parent).ObjKind
   else
     ObjKind:=okClass;
@@ -5272,17 +5273,20 @@ begin
       Result.WriteAccessorName := GetAccessorName(Result,Result.WriteAccessor);
       NextToken;
       end;
-    if CurTokenIsIdentifier('READONLY') then
+    if IsClass and (ObjKind=okDispInterface) then
       begin
-      Result.DispIDReadOnly:=True;
-      NextToken;
-      end;
-    if CurTokenIsIdentifier('DISPID') then
-      begin
-      NextToken;
-      Result.DispIDExpr := DoParseExpression(Result,Nil);
+      if CurTokenIsIdentifier('READONLY') then
+        begin
+        Result.DispIDReadOnly:=True;
+        NextToken;
+        end;
+      if CurTokenIsIdentifier('DISPID') then
+        begin
+        NextToken;
+        Result.DispIDExpr := DoParseExpression(Result,Nil);
+        end;
       end;
-    if (ObjKind in [okClass]) and CurTokenIsIdentifier('IMPLEMENTS') then
+    if IsClass and (ObjKind=okClass) and CurTokenIsIdentifier('IMPLEMENTS') then
       ParseImplements;
     if CurTokenIsIdentifier('STORED') then
       begin
@@ -6362,15 +6366,13 @@ begin
       tkGeneric, // Counts as field name
       tkIdentifier :
         begin
-          if CheckVisibility(CurtokenString,v) then
-            begin
-            If not (msAdvancedRecords in Scanner.CurrentModeSwitches) then
-              ParseExc(nErrRecordVisibilityNotAllowed,SErrRecordVisibilityNotAllowed);
-            if not (v in [visPrivate,visPublic,visStrictPrivate]) then
-              ParseExc(nParserInvalidRecordVisibility,SParserInvalidRecordVisibility);
-            NextToken;
-            Continue;
-            end;
+        If AllowMethods and CheckVisibility(CurTokenString,v) then
+          begin
+          if not (v in [visPrivate,visPublic,visStrictPrivate]) then
+            ParseExc(nParserInvalidRecordVisibility,SParserInvalidRecordVisibility);
+          NextToken;
+          Continue;
+          end;
         OldCount:=ARec.Members.Count;
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
         for i:=OldCount to ARec.Members.Count-1 do
@@ -6423,12 +6425,15 @@ begin
   try
     Result.PackMode:=PackMode;
     NextToken;
-    ParseRecordFieldList(Result,tkEnd,true);
+    ParseRecordFieldList(Result,tkEnd,msAdvancedRecords in Scanner.CurrentModeSwitches);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
   finally
     if not ok then
+      begin
+      Result.Parent:=nil; // clear references from members to Result
       Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+      end;
   end;
 end;
 
@@ -6826,7 +6831,8 @@ begin
     end;
     exit;
     end;
-  if ((AobjKind in [okClass,OKInterface]) and (msExternalClass in CurrentModeswitches) and  CurTokenIsIdentifier('external')) then
+  if ((AObjKind in [okClass,OKInterface]) and (msExternalClass in CurrentModeswitches)
+      and CurTokenIsIdentifier('external')) then
     begin
     NextToken;
     if CurToken<>tkString then

packages/fcl-passrc/src/pscanner.pp

@@ -749,6 +749,7 @@ type
     procedure SetReadOnlyModeSwitches(const AValue: TModeSwitches);
     procedure SetReadOnlyValueSwitches(const AValue: TValueSwitches);
   protected
+    function ReadIdentifier(const AParam: string): string;
     function FetchLine: boolean;
     procedure AddFile(aFilename: string); virtual;
     function GetMacroName(const Param: String): String;
@@ -3457,13 +3458,16 @@ begin
 end;
 
 procedure TPascalScanner.HandleIFDEF(const AParam: String);
+var
+  aName: String;
 begin
   PushSkipMode;
   if PPIsSkipping then
     PPSkipMode := ppSkipAll
   else
     begin
-    if IsDefined(AParam) then
+    aName:=ReadIdentifier(AParam);
+    if IsDefined(aName) then
       PPSkipMode := ppSkipElseBranch
     else
       begin
@@ -3472,20 +3476,23 @@ begin
       end;
     If LogEvent(sleConditionals) then
       if PPSkipMode=ppSkipElseBranch then
-        DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[AParam])
+        DoLog(mtInfo,nLogIFDefAccepted,sLogIFDefAccepted,[aName])
       else
-        DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[AParam]);
+        DoLog(mtInfo,nLogIFDefRejected,sLogIFDefRejected,[aName]);
     end;
 end;
 
 procedure TPascalScanner.HandleIFNDEF(const AParam: String);
+var
+  aName: String;
 begin
   PushSkipMode;
   if PPIsSkipping then
     PPSkipMode := ppSkipAll
   else
     begin
-    if IsDefined(AParam) then
+    aName:=ReadIdentifier(AParam);
+    if IsDefined(aName) then
       begin
       PPSkipMode := ppSkipIfBranch;
       PPIsSkipping := true;
@@ -3494,9 +3501,9 @@ begin
       PPSkipMode := ppSkipElseBranch;
     If LogEvent(sleConditionals) then
       if PPSkipMode=ppSkipElseBranch then
-        DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[AParam])
+        DoLog(mtInfo,nLogIFNDefAccepted,sLogIFNDefAccepted,[aName])
       else
-        DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[AParam]);
+        DoLog(mtInfo,nLogIFNDefRejected,sLogIFNDefRejected,[aName]);
     end;
 end;
 
@@ -4682,6 +4689,16 @@ begin
   FReadOnlyValueSwitches:=AValue;
 end;
 
+function TPascalScanner.ReadIdentifier(const AParam: string): string;
+var
+  p, l: Integer;
+begin
+  p:=1;
+  l:=length(AParam);
+  while (p<=l) and (AParam[p] in IdentChars) do inc(p);
+  Result:=LeftStr(AParam,p-1);
+end;
+
 function TPascalScanner.FetchLine: boolean;
 begin
   if CurSourceFile.IsEOF then

packages/fcl-passrc/tests/tcclasstype.pas

@@ -253,6 +253,8 @@ procedure TTestClassType.StartClass(AncestorName: String; InterfaceList: String)
 Var
   S : String;
 begin
+  if FStarted then
+    Fail('TTestClassType.StartClass already started');
   FStarted:=True;
   S:='TMyClass = Class';
   if (AncestorName<>'') then
@@ -426,7 +428,7 @@ end;
 procedure TTestClassType.SetUp;
 begin
   inherited SetUp;
-  FDecl:=TstringList.Create;
+  FDecl:=TStringList.Create;
   FClass:=Nil;
   FParent:='';
   FStarted:=False;

packages/fcl-passrc/tests/tcresolver.pas

@@ -239,7 +239,7 @@ type
 
     // strings
     Procedure TestChar_BuiltInProcs;
-    Procedure TestString_SetLength;
+    Procedure TestString_BuiltInProcs;
     Procedure TestString_Element;
     Procedure TestStringElement_MissingArgFail;
     Procedure TestStringElement_IndexNonIntFail;
@@ -483,7 +483,28 @@ type
     Procedure TestRecord_Const_UntypedFail;
     Procedure TestRecord_Const_NestedRecord;
     Procedure TestRecord_Const_Variant;
-    Procedure TestRecord_VarExternal; // ToDo
+    Procedure TestRecord_VarExternal;
+    Procedure TestRecord_VarSelfFail;
+
+    // advanced record
+    Procedure TestAdvRecord;
+    Procedure TestAdvRecord_Private;
+    // ToDO: Procedure TestAdvRecord_PropertyWithoutTypeFail;
+    // Todo: Procedure TestAdvRecord_ForwardFail
+    // ToDo: public, private, strict private
+    // ToDo: TestAdvRecordPublishedFail
+    // ToDo: TestAdvRecord_VirtualFail
+    // ToDo: TestAdvRecord_OverrideFail
+    // ToDo: constructor, destructor
+    // ToDo: class function/procedure
+    // ToDo: nested record type
+    // ToDo: const
+    // todo: var
+    // todo: class var
+    // todo: property
+    // todo: class property
+    // todo: TestRecordAsFuncResult
+    // todo: for in record
 
     // class
     Procedure TestClass;
@@ -1579,7 +1600,7 @@ begin
       if (Msg<>E.Message) and (Msg<>E.MsgPattern) and (Msg<>Full) then
         begin
         {$IFDEF VerbosePasResolver}
-        writeln('TCustomTestResolver.CheckResolverException E.MsgPattern={',E.MsgPattern,'}');
+        writeln('TCustomTestResolver.CheckResolverException E.MsgPattern={',E.MsgPattern,'} E.Message={',E.Message,'} Full={',Full,'}');
         {$ENDIF}
         AssertEquals('Expected message ('+IntToStr(MsgNumber)+')',
           '{'+Msg+'}','{'+E.Message+'} OR {'+E.MsgPattern+'} OR {'+Full+'}');
@@ -3200,14 +3221,17 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestString_SetLength;
+procedure TTestResolver.TestString_BuiltInProcs;
 begin
   StartProgram(false);
-  Add('var');
-  Add('  s: string;');
-  Add('begin');
-  Add('  SetLength({#a_var}s,3);');
-  Add('  SetLength({#b_var}s,length({#c_read}s));');
+  Add([
+  'var',
+  '  s: string;',
+  'begin',
+  '  SetLength({#a_var}s,3);',
+  '  SetLength({#b_var}s,length({#c_read}s));',
+  '  s:=concat(''a'',s);',
+  '']);
   ParseProgram;
   CheckAccessMarkers;
 end;
@@ -3734,7 +3758,8 @@ begin
   '  aString:=str(f);',
   '  aString:=str(f:3);',
   '  str(f,aString);',
-  '  writestr(astring,f,i);']);
+  '  writestr(astring,f,i);',
+  '  val(aString,f,i);']);
   ParseProgram;
 end;
 
@@ -7786,6 +7811,53 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestRecord_VarSelfFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TRec = record',
+  '    r: Trec;',
+  '  end;',
+  'begin']);
+  CheckResolverException('type "TRec" is not yet completely defined',nTypeXIsNotYetCompletelyDefined);
+end;
+
+procedure TTestResolver.TestAdvRecord;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure TRec.DoIt;',
+  'begin',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestAdvRecord_Private;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TRec = record',
+  '  private',
+  '    a: byte;',
+  '  public',
+  '    b: byte;',
+  '  end;',
+  'var',
+  '  r: TRec;',
+  'begin',
+  '  r.a:=r.b;']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestClass;
 begin
   StartProgram(false);

packages/fcl-passrc/tests/tcscanner.pas

@@ -1404,7 +1404,7 @@ procedure TTestScanner.TestDefine2;
 
 begin
   FSCanner.Defines.Add('ALWAYS');
-  TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS} of {$ENDIF}');
+  TestTokens([tkComment,tkWhitespace,tkOf,tkWhitespace,tkcomment],'{$IFDEF ALWAYS comment} of {$ENDIF}');
 end;
 
 procedure TTestScanner.TestDefine21;

packages/fcl-passrc/tests/tctypeparser.pas

@@ -171,16 +171,30 @@ type
 
   { TTestRecordTypeParser }
 
-  TTestRecordTypeParser= Class(TBaseTestTypeParser)
+  TTestRecordTypeParser = Class(TBaseTestTypeParser)
   private
+    FDecl : TStrings;
+    FAdvanced,
+    FEnded,
+    FStarted: boolean;
+    FRecord: TPasRecordType;
+    FMember1: TPasElement;
     function GetC(AIndex: Integer): TPasConst;
     Function GetField(AIndex : Integer; R : TPasRecordType) : TPasVariable;
     Function GetField(AIndex : Integer; R : TPasVariant) : TPasVariable;
     function GetF(AIndex: Integer): TPasVariable;
-    function GetR: TPasRecordType;
+    function GetM(AIndex : Integer): TPasElement;
     Function GetVariant(AIndex : Integer; R : TPasRecordType) : TPasVariant;
     function GetV(AIndex: Integer): TPasVariant;
   Protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+    Procedure StartRecord(Advanced: boolean = false);
+    Procedure EndRecord(AEnd : String = 'end');
+    Procedure AddMember(S : String);
+    Procedure ParseRecord;
+    Procedure ParseRecordFail(Msg: string; MsgNumber: integer);
+    Procedure DoParseRecord;
     Procedure TestFields(Const Fields : Array of string; AHint : String; HaveVariant : Boolean = False);
     procedure AssertVariantSelector(AName, AType: string);
     procedure AssertConst1(Hints: TPasMemberHints);
@@ -216,12 +230,15 @@ type
     procedure DoTestVariantNestedVariantFirstDeprecated(Const AHint : string);
     procedure DoTestVariantNestedVariantSecondDeprecated(const AHint: string);
     procedure DoTestVariantNestedVariantBothDeprecated(const AHint: string);
-    Property TheRecord : TPasRecordType Read GetR;
+    Property TheRecord : TPasRecordType Read FRecord;
+    Property Advanced: boolean read FAdvanced;
     Property Const1 : TPasConst Index 0 Read GetC;
     Property Field1 : TPasVariable Index 0 Read GetF;
     Property Field2 : TPasVariable Index 1 Read GetF;
     Property Variant1 : TPasVariant Index 0 Read GetV;
     Property Variant2 : TPasVariant Index 1 Read GetV;
+    Property Members[AIndex : Integer] : TPasElement Read GetM;
+    Property Member1 : TPasElement Read FMember1;
   Published
     Procedure TestEmpty;
     Procedure TestEmptyComment;
@@ -333,6 +350,9 @@ type
     Procedure TestVariantNestedVariantBothDeprecatedDeprecated;
     Procedure TestVariantNestedVariantBothDeprecatedPlatform;
     Procedure TestOperatorField;
+    Procedure TestPropertyFail;
+    Procedure TestAdvRec_Property;
+    Procedure TestAdvRec_PropertyImplementsFail;
   end;
 
   { TTestProcedureTypeParser }
@@ -1148,7 +1168,7 @@ end;
 
 function TTestRecordTypeParser.GetC(AIndex: Integer): TPasConst;
 begin
-  Result:=TObject(GetR.Members[AIndex]) as TPasConst;
+  Result:=TObject(TheRecord.Members[AIndex]) as TPasConst;
 end;
 
 function TTestRecordTypeParser.GetField(AIndex: Integer; R: TPasRecordType
@@ -1174,12 +1194,18 @@ end;
 
 function TTestRecordTypeParser.GetF(AIndex: Integer): TPasVariable;
 begin
-  Result:=GetField(AIndex,GetR);
+  Result:=GetField(AIndex,TheRecord);
 end;
 
-function TTestRecordTypeParser.GetR: TPasRecordType;
+function TTestRecordTypeParser.GetM(AIndex : Integer): TPasElement;
 begin
-  Result:=TheType as TPasRecordType;
+  AssertNotNull('Have Record',TheRecord);
+  if (AIndex>=TheRecord.Members.Count) then
+    Fail('No member '+IntToStr(AIndex));
+  AssertNotNull('Have member'+IntToStr(AIndex),TheRecord.Members[AIndex]);
+  If Not (TObject(TheRecord.Members[AIndex]) is TPasElement) then
+    Fail('Member '+IntTostr(AIndex)+' is not a TPasElement');
+  Result:=TPasElement(TheRecord.Members[AIndex])
 end;
 
 function TTestRecordTypeParser.GetVariant(AIndex: Integer; R: TPasRecordType
@@ -1194,7 +1220,94 @@ end;
 
 function TTestRecordTypeParser.GetV(AIndex: Integer): TPasVariant;
 begin
-  Result:=GetVariant(AIndex,GetR);
+  Result:=GetVariant(AIndex,TheRecord);
+end;
+
+procedure TTestRecordTypeParser.SetUp;
+begin
+  inherited SetUp;
+  FDecl:=TStringList.Create;
+  FStarted:=false;
+  FEnded:=false;
+end;
+
+procedure TTestRecordTypeParser.TearDown;
+begin
+  FreeAndNil(FDecl);
+  inherited TearDown;
+end;
+
+procedure TTestRecordTypeParser.StartRecord(Advanced: boolean);
+var
+  S: String;
+begin
+  if FStarted then
+    Fail('TTestRecordTypeParser.StartRecord already started');
+  FStarted:=True;
+  S:='TMyRecord = record';
+  if Advanced then
+    S:='{$modeswitch advancedrecords}'+sLineBreak+S;
+  FDecl.Add(S);
+end;
+
+procedure TTestRecordTypeParser.EndRecord(AEnd: String);
+begin
+  if FEnded then exit;
+  if not FStarted then
+    StartRecord;
+  FEnded:=True;
+  if (AEnd<>'') then
+    FDecl.Add('  '+AEnd);
+end;
+
+procedure TTestRecordTypeParser.AddMember(S: String);
+begin
+  if Not FStarted then
+    StartRecord;
+  FDecl.Add('    '+S);
+end;
+
+procedure TTestRecordTypeParser.ParseRecord;
+begin
+  DoParseRecord;
+end;
+
+procedure TTestRecordTypeParser.ParseRecordFail(Msg: string; MsgNumber: integer
+  );
+var
+  ok: Boolean;
+begin
+  ok:=false;
+  try
+    ParseRecord;
+  except
+    on E: EParserError do
+      begin
+      AssertEquals('Expected {'+Msg+'}, but got msg {'+Parser.LastMsg+'}',MsgNumber,Parser.LastMsgNumber);
+      ok:=true;
+      end;
+  end;
+  AssertEquals('Missing parser error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
+end;
+
+procedure TTestRecordTypeParser.DoParseRecord;
+begin
+  EndRecord;
+  Add('Type');
+  if AddComment then
+    begin
+    Add('// A comment');
+    Engine.NeedComments:=True;
+    end;
+  Add('  '+TrimRight(FDecl.Text)+';');
+  ParseDeclarations;
+  AssertEquals('One record type definition',1,Declarations.Types.Count);
+  AssertEquals('First declaration is type definition.',TPasRecordType,TObject(Declarations.Types[0]).ClassType);
+  FRecord:=TObject(Declarations.Types[0]) as TPasRecordType;
+  TheType:=FRecord; // needed by AssertComment
+  Definition:=TheType; // needed by CheckHint
+  if TheRecord.Members.Count>0 then
+    FMember1:=TObject(TheRecord.Members[0]) as TPasElement;
 end;
 
 procedure TTestRecordTypeParser.TestFields(const Fields: array of string;
@@ -1205,17 +1318,14 @@ Var
   I : integer;
 
 begin
-  S:='';
+  StartRecord;
   For I:=Low(Fields) to High(Fields) do
-    begin
-    if (S<>'') then
-      S:=S+sLineBreak;
-    S:=S+'    '+Fields[i];
-    end;
-  if (S<>'') then
-    S:=S+sLineBreak;
-  S:='record'+sLineBreak+s+'  end';
-  ParseType(S,TPasRecordType,AHint);
+    AddMember(Fields[i]);
+  S:='end';
+  if AHint<>'' then
+    S:=S+' '+AHint;
+  EndRecord(S);
+  ParseRecord;
   if HaveVariant then
     begin
     AssertNotNull('Have variants',TheRecord.Variants);
@@ -1228,6 +1338,8 @@ begin
     end;
   if AddComment then
     AssertComment;
+  if (AHint<>'') then
+    CheckHint(TPasMemberHint(GetEnumValue(TypeInfo(TPasMemberHint),'h'+AHint)));
 end;
 
 procedure TTestRecordTypeParser.AssertVariantSelector(AName,AType : string);
@@ -2043,6 +2155,7 @@ Var
   P : TPasFunction;
 
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msAdvancedRecords];
   TestFields(['x : integer;','class operator assign(a : ta; b : Cardinal) : boolean;','function dosomething3 : Integer;'],'',False);
   AssertEquals('Member count',3,TheRecord.Members.Count);
   AssertField1([]);
@@ -2057,6 +2170,7 @@ end;
 
 procedure TTestRecordTypeParser.TestFieldAndClassVar;
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msAdvancedRecords];
   TestFields(['x : integer;','class var y : integer;'],'',False);
   AssertField1([]);
   AssertTrue('Second field is class var',vmClass in Field2.VarModifiers);
@@ -2064,6 +2178,7 @@ end;
 
 procedure TTestRecordTypeParser.TestFieldAndVar;
 begin
+  Scanner.CurrentModeSwitches:=Scanner.CurrentModeSwitches+[msAdvancedRecords];
   TestFields(['x : integer;','var y : integer;'],'',False);
   AssertField1([]);
   AssertTrue('Second field is regular var',not (vmClass in Field2.VarModifiers));
@@ -2408,6 +2523,26 @@ begin
   AssertEquals('Field 1 name','operator',Field1.Name);
 end;
 
+procedure TTestRecordTypeParser.TestPropertyFail;
+begin
+  AddMember('Property Something');
+  ParseRecordFail(SErrRecordPropertiesNotAllowed,nErrRecordPropertiesNotAllowed);
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_Property;
+begin
+  StartRecord(true);
+  AddMember('Property Something: word');
+  ParseRecord;
+end;
+
+procedure TTestRecordTypeParser.TestAdvRec_PropertyImplementsFail;
+begin
+  StartRecord(true);
+  AddMember('Property Something: word implements ISome;');
+  ParseRecordFail('Expected ";"',nParserExpectTokenError);
+end;
+
 { TBaseTestTypeParser }
 
 Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;
@@ -2434,9 +2569,9 @@ begin
     AssertEquals('One type definition',1,Declarations.Classes.Count)
   else
     AssertEquals('One type definition',1,Declarations.Types.Count);
-  If (AtypeClass<>Nil) then
+  If ATypeClass<>Nil then
     begin
-    if ATypeClass.InHeritsFrom(TPasClassType) then
+    if ATypeClass.InheritsFrom(TPasClassType) then
       Result:=TPasType(Declarations.Classes[0])
     else
       Result:=TPasType(Declarations.Types[0]);
@@ -2446,7 +2581,7 @@ begin
   FType:=Result;
   Definition:=Result;
   if (Hint<>'') then
-    CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'h'+Hint)));
+    CheckHint(TPasMemberHint(GetEnumValue(TypeInfo(TPasMemberHint),'h'+Hint)));
 end;
 
 Procedure TBaseTestTypeParser.AssertParseTypeError(ASource: String);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -128,6 +128,7 @@ type
     procedure TestM_Hint_FunctionResultRecord;
     procedure TestM_Hint_FunctionResultPassRecordElement;
     procedure TestM_Hint_FunctionResultAssembler;
+    procedure TestM_Hint_FunctionResultExit;
     procedure TestM_Hint_AbsoluteVar;
 
     // whole program optimization
@@ -2158,6 +2159,20 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultExit;
+begin
+  StartProgram(false);
+  Add([
+  'function GetIt: longint;',
+  'begin',
+  '  exit(3);',
+  'end;',
+  'begin',
+  '  GetIt;']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_AbsoluteVar;
 begin
   StartProgram(false);

packages/fcl-process/src/processbody.inc

@@ -80,7 +80,7 @@ Type
     Function  GetExitCode : Integer;
     Function  GetRunning : Boolean;
     Function  GetWindowRect : TRect;
-    procedure SetCommandLine(const AValue: TProcessString);
+    procedure SetCommandLine(const AValue: TProcessString); deprecated;
     procedure SetParameters(const AValue: TProcessStrings);
     Procedure SetWindowRect (Value : TRect);
     Procedure SetShowWindow (Value : TShowWindowOptions);

packages/fpmkunit/src/fpmkunit.pp

@@ -1683,7 +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';
+  SWarnRetryDeleteFile       = 'Failed to remove file "%s". Retry after a short delay';
   SWarnCombinedPathAndUDir= 'Warning: Better do not combine the SearchPath and Global/Local-UnitDir parameters';
   SWarnRemovedNonEmptyDirectory = 'Warning: Removed non empty directory "%s"';
 
@@ -4370,7 +4370,7 @@ begin
   else If UnixPaths then
     Result:=Prefix+'share'+PathDelim+'doc'+PathDelim+'fpc-$(CompilerVersion)'+PathDelim+'$(PackageName)'
   else
-    Result:=BaseInstallDir+'docs'+PathDelim+'$(PackageName)';
+    Result:=BaseInstallDir+'doc'+PathDelim+'$(PackageName)';
 end;
 
 

packages/fv/src/app.pas

@@ -567,7 +567,7 @@ VAR NumCols, NumRows, NumTileable, LeftOver, TileNum: Integer;
 
 BEGIN
    NumTileable := 0;                                  { Zero tileable count }
-   ForEach(@DoCountTileable);                         { Count tileable views }
+   ForEach(TCallbackProcParam(@DoCountTileable));     { Count tileable views }
    If (NumTileable>0) Then Begin
      MostEqualDivisors(NumTileable, NumCols, NumRows,
      NOT TileColumnsFirst);                           { Do pre calcs }
@@ -576,7 +576,7 @@ BEGIN
      Else Begin
        LeftOver := NumTileable MOD NumCols;           { Left over count }
        TileNum := NumTileable-1;                      { Tileable views }
-       ForEach(@DoTile);                              { Tile each view }
+       ForEach(TCallbackProcParam(@DoTile));          { Tile each view }
        DrawView;                                      { Now redraw }
      End;
    End;
@@ -622,14 +622,14 @@ VAR CascadeNum: Integer; LastView: PView; Min, Max: TPoint;
 
 BEGIN
    CascadeNum := 0;                                   { Zero cascade count }
-   ForEach(@DoCount);                                 { Count cascadable }
+   ForEach(TCallbackProcParam(@DoCount));             { Count cascadable }
    If (CascadeNum>0) Then Begin
      LastView^.SizeLimits(Min, Max);                  { Check size limits }
      If (Min.X > R.B.X - R.A.X - CascadeNum) OR
      (Min.Y > R.B.Y - R.A.Y - CascadeNum) Then
      TileError Else Begin                             { Check for error }
        Dec(CascadeNum);                               { One less view }
-       ForEach(@DoCascade);                           { Cascade view }
+       ForEach(TCallbackProcParam(@DoCascade));       { Cascade view }
        DrawView;                                      { Redraw now }
      End;
    End;

packages/fv/src/platform.inc

@@ -278,6 +278,18 @@ FOR FPC THESE ARE THE TRANSLATIONS
   {$DEFINE OS_GO32}
 {$ENDIF}
 
+{---------------------------------------------------------------------------}
+{  FPC high level COMPILER needs nested procvars                                  }
+{---------------------------------------------------------------------------}
+
+{$IFDEF CPULLVM}
+  {$DEFINE TYPED_LOCAL_CALLBACKS}
+{$ENDIF}
+
+{$IFDEF TYPED_LOCAL_CALLBACKS}
+  {$MODESWITCH NESTEDPROCVARS}
+{$ENDIF}
+
 {---------------------------------------------------------------------------}
 {  32 BIT WINDOWS COMPILERS changes bit size - Updated 27Aug98 LdB          }
 {---------------------------------------------------------------------------}

packages/fv/src/tabs.pas

@@ -706,7 +706,7 @@ begin
   if P<>nil then Delete(P);
 end;
 begin
-  ForEach(@DeleteViews);
+  ForEach(TCallbackProcParam(@DeleteViews));
   inherited Done;
   P:=TabDefs;
   while P<>nil do

packages/fv/src/views.pas

@@ -431,6 +431,12 @@ TYPE
 {---------------------------------------------------------------------------}
 {                  TGroup OBJECT - GROUP OBJECT ANCESTOR                    }
 {---------------------------------------------------------------------------}
+{$ifndef TYPED_LOCAL_CALLBACKS}
+   TGroupFirstThatCallback = CodePointer;
+{$else}
+   TGroupFirstThatCallback = Function(View: PView): Boolean is nested;
+{$endif}
+
    TGroup = OBJECT (TView)
          Phase   : (phFocused, phPreProcess, phPostProcess);
          EndState: Word;                              { Modal result }
@@ -445,7 +451,7 @@ TYPE
       FUNCTION GetHelpCtx: Word; Virtual;
       FUNCTION DataSize: Sw_Word; Virtual;
       FUNCTION ExecView (P: PView): Word; Virtual;
-      FUNCTION FirstThat (P: CodePointer): PView;
+      FUNCTION FirstThat (P:  TGroupFirstThatCallback): PView;
       FUNCTION Valid (Command: Word): Boolean; Virtual;
       FUNCTION FocusNext (Forwards: Boolean): Boolean;
       PROCEDURE Draw; Virtual;
@@ -457,7 +463,7 @@ TYPE
       PROCEDURE SelectDefaultView;
       PROCEDURE Insert (P: PView);
       PROCEDURE Delete (P: PView);
-      PROCEDURE ForEach (P: CodePointer);
+      PROCEDURE ForEach (P: TCallbackProcParam);
       { ForEach can't be virtual because it generates SIGSEGV }
       PROCEDURE EndModal (Command: Word); Virtual;
       PROCEDURE SelectNext (Forwards: Boolean);
@@ -2102,7 +2108,7 @@ END;
 {--TGroup-------------------------------------------------------------------}
 {  FirstThat -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB         }
 {---------------------------------------------------------------------------}
-FUNCTION TGroup.FirstThat (P: CodePointer): PView;
+FUNCTION TGroup.FirstThat (P: TGroupFirstThatCallback): PView;
 VAR
   Tp : PView;
 BEGIN
@@ -2111,7 +2117,7 @@ BEGIN
      Tp := Last;                                      { Set temporary ptr }
      Repeat
        Tp := Tp^.Next;                                { Get next view }
-       IF Byte(Longint(CallPointerMethodLocal(P,
+         IF Byte(Longint(CallPointerMethodLocal(TCallbackFunBoolParam(P),
          { On most systems, locals are accessed relative to base pointer,
            but for MIPS cpu, they are accessed relative to stack pointer.
            This needs adaptation for so low level routines,
@@ -2207,7 +2213,7 @@ PROCEDURE TGroup.Awaken;
    END;
 
 BEGIN
-   ForEach(@DoAwaken);                                { Awaken each view }
+   ForEach(TCallbackProcParam(@DoAwaken));            { Awaken each view }
 END;
 
 {--TGroup-------------------------------------------------------------------}
@@ -2300,7 +2306,7 @@ END;
 {--TGroup-------------------------------------------------------------------}
 {  ForEach -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 17Jul99 LdB           }
 {---------------------------------------------------------------------------}
-PROCEDURE TGroup.ForEach (P: CodePointer);
+PROCEDURE TGroup.ForEach (P: TCallbackProcParam);
 VAR
   Tp,Hp,L0 : PView;
 { Vars Hp and L0 are necessary to hold original pointers in case   }
@@ -2398,7 +2404,7 @@ BEGIN
    Case AState Of
      sfActive, sfDragging: Begin
          Lock;                                        { Lock the view }
-         ForEach(@DoSetState);                        { Set each subview }
+         ForEach(TCallbackProcParam(@DoSetState));    { Set each subview }
          UnLock;                                      { Unlock the view }
        End;
      sfFocused: Begin
@@ -2406,7 +2412,7 @@ BEGIN
            Current^.SetState(sfFocused, Enable);          { Focus current view }
        End;
      sfExposed: Begin
-         ForEach(@DoExpose);                          { Expose each subview }
+         ForEach(TCallbackProcParam(@DoExpose));      { Expose each subview }
        End;
    End;
 END;
@@ -2458,7 +2464,7 @@ BEGIN
    OwnerGroup := @Self;                               { Set as owner group }
    Count := IndexOf(Last);                            { Subview count }
    S.Write(Count, SizeOf(Count));                     { Write the count }
-   ForEach(@DoPut);                                   { Put each in stream }
+   ForEach(TCallbackProcParam(@DoPut));               { Put each in stream }
    PutSubViewPtr(S, Current);                         { Current on stream }
    OwnerGroup := OwnerSave;                           { Restore ownergroup }
 END;
@@ -2502,16 +2508,16 @@ BEGIN
    If (Event.What = evNothing) Then Exit;             { No valid event exit }
    If (Event.What AND FocusedEvents <> 0) Then Begin  { Focused event }
      Phase := phPreProcess;                           { Set pre process }
-     ForEach(@DoHandleEvent);                         { Pass to each view }
+     ForEach(TCallbackProcParam(@DoHandleEvent));     { Pass to each view }
      Phase := phFocused;                              { Set focused }
      DoHandleEvent(Current);                          { Pass to current }
      Phase := phPostProcess;                          { Set post process }
-     ForEach(@DoHandleEvent);                         { Pass to each }
+     ForEach(TCallbackProcParam(@DoHandleEvent));     { Pass to each }
    End Else Begin
      Phase := phFocused;                              { Set focused }
      If (Event.What AND PositionalEvents <> 0) Then   { Positional event }
        DoHandleEvent(FirstThat(@ContainsMouse))       { Pass to first }
-       Else ForEach(@DoHandleEvent);                  { Pass to all }
+       Else ForEach(TCallbackProcParam(@DoHandleEvent)); { Pass to all }
    End;
 END;
 
@@ -2539,7 +2545,7 @@ BEGIN
      SetBounds(Bounds);                               { Set new bounds }
      GetExtent(Clip);                                 { Get new clip extents }
      Lock;                                            { Lock drawing }
-     ForEach(@DoCalcChange);                          { Change each view }
+     ForEach(TCallbackProcParam(@DoCalcChange));      { Change each view }
      UnLock;                                          { Unlock drawing }
    End;
 END;

packages/ide/fpcodcmp.pas

@@ -16,6 +16,10 @@
 
 unit FPCodCmp; { CodeComplete }
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,Drivers,Dialogs,
@@ -269,7 +273,7 @@ begin
       New(UnitsCodeCompleteWords, Init(10,10));
       level:=0;
       Overflow:=false;
-      BrowCol.Modules^.ForEach(@InsertInS);
+      BrowCol.Modules^.ForEach(TCallbackProcParam(@InsertInS));
       { if Overflow then
         WarningBox(msg_toomanysymbolscantdisplayall,nil); }
     end;

packages/ide/fpcodtmp.pas

@@ -15,10 +15,8 @@
 
 unit FPCodTmp; { Code Templates }
 
-{2.0 compatibility}
-{$ifdef VER2_0}
-  {$macro on}
-  {$define resourcestring := const}
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
 {$endif}
 
 interface
@@ -154,7 +152,7 @@ begin
 end;
 begin
   if Assigned(AList) and Assigned(Text) then
-    Text^.ForEach(@CopyIt);
+    Text^.ForEach(TCallbackProcParam(@CopyIt));
 end;
 
 procedure TCodeTemplate.SetShortCut(const AShortCut: string);

packages/ide/fpcompil.pas

@@ -12,15 +12,8 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-{$i globdir.inc}
 unit FPCompil;
 
-{2.0 compatibility}
-{$ifdef VER2_0}
-  {$macro on}
-  {$define resourcestring := const}
-{$endif}
-
 interface
 
 { don't redir under linux, because all stdout (also from the ide!) will
@@ -32,6 +25,8 @@ interface
 
 {$mode objfpc}
 
+{$i globdir.inc}
+
 uses
   { We need to include the exceptions from SysUtils, but the types from
     Objects need to be used. Keep the order SysUtils,Objects }
@@ -390,7 +385,7 @@ procedure TCompilerMessageListBox.SelectFirstError;
   var
     P : PCompilerMessage;
 begin
-  P:=List^.FirstThat(@IsError);
+  P:=List^.FirstThat(TCallbackFunBoolParam(@IsError));
   If Assigned(P) then
     Begin
       FocusItem(List^.IndexOf(P));
@@ -861,7 +856,7 @@ procedure ResetErrorMessages;
        PSourceWindow(P)^.Editor^.SetErrorMessage('');
   end;
 begin
-  Desktop^.ForEach(@ResetErrorLine);
+  Desktop^.ForEach(TCallbackProcParam(@ResetErrorLine));
 end;
 
 

packages/ide/fpdebug.pas

@@ -18,8 +18,8 @@ interface
 implementation
 end.
 {$else}
-interface
 {$i globdir.inc}
+interface
 uses
 {$ifdef Windows}
   Windows,
@@ -770,7 +770,7 @@ procedure TDebugController.InsertBreakpoints;
   end;
 
 begin
-  BreakpointsCollection^.ForEach(@DoInsert);
+  BreakpointsCollection^.ForEach(TCallbackProcParam(@DoInsert));
   Disableallinvalidbreakpoints:=false;
 end;
 
@@ -782,7 +782,7 @@ procedure TDebugController.ReadWatches;
   end;
 
 begin
-  WatchesCollection^.ForEach(@DoRead);
+  WatchesCollection^.ForEach(TCallbackProcParam(@DoRead));
   If Assigned(WatchesWindow) then
     WatchesWindow^.Update;
 end;
@@ -795,7 +795,7 @@ procedure TDebugController.RereadWatches;
   end;
 
 begin
-  WatchesCollection^.ForEach(@DoRead);
+  WatchesCollection^.ForEach(TCallbackProcParam(@DoRead));
   If Assigned(WatchesWindow) then
     WatchesWindow^.Update;
 end;
@@ -807,7 +807,7 @@ procedure TDebugController.RemoveBreakpoints;
       PB^.Remove;
     end;
 begin
-   BreakpointsCollection^.ForEach(@DoDelete);
+   BreakpointsCollection^.ForEach(TCallbackProcParam(@DoDelete));
 end;
 
 procedure TDebugController.ResetBreakpointsValues;
@@ -816,7 +816,7 @@ procedure TDebugController.ResetBreakpointsValues;
       PB^.ResetValues;
     end;
 begin
-   BreakpointsCollection^.ForEach(@DoResetVal);
+   BreakpointsCollection^.ForEach(TCallbackProcParam(@DoResetVal));
 end;
 
 destructor TDebugController.Done;
@@ -1168,7 +1168,7 @@ procedure TDebugController.ResetDebuggerRows;
   end;
 
 begin
-  Desktop^.ForEach(@ResetDebuggerRow);
+  Desktop^.ForEach(TCallbackProcParam(@ResetDebuggerRow));
 end;
 
 procedure TDebugController.Reset;
@@ -1614,7 +1614,7 @@ function  ActiveBreakpoints : boolean;
 begin
    IsActive:=false;
    If assigned(BreakpointsCollection) then
-     BreakpointsCollection^.ForEach(@TestActive);
+     BreakpointsCollection^.ForEach(TCallbackProcParam(@TestActive));
    ActiveBreakpoints:=IsActive;
 end;
 
@@ -1959,7 +1959,7 @@ begin
   if index=0 then
     GetGDB:=nil
   else
-    GetGDB:=FirstThat(@IsNum);
+    GetGDB:=FirstThat(TCallbackFunBoolParam(@IsNum));
 end;
 
 procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
@@ -2008,9 +2008,9 @@ procedure TBreakpointCollection.ShowBreakpoints(W : PFPWindow);
 
 begin
   if W=PFPWindow(DisassemblyWindow) then
-    ForEach(@SetInDisassembly)
+    ForEach(TCallbackProcParam(@SetInDisassembly))
   else
-    ForEach(@SetInSource);
+    ForEach(TCallbackProcParam(@SetInSource));
 end;
 
 
@@ -2042,7 +2042,7 @@ procedure TBreakpointCollection.AdaptBreakpoints(Editor : PSourceEditor; Pos, Ch
   var
     I : longint;
 begin
-  ForEach(@AdaptInSource);
+  ForEach(TCallbackProcParam(@AdaptInSource));
   I:=Count-1;
   While (I>=0) do
     begin
@@ -2065,7 +2065,7 @@ function TBreakpointCollection.FindBreakpointAt(Editor : PSourceEditor; Line : l
   end;
 
 begin
-  FindBreakpointAt:=FirstThat(@IsAtLine);
+  FindBreakpointAt:=FirstThat(TCallbackFunBoolParam(@IsAtLine));
 end;
 
 procedure TBreakpointCollection.ShowAllBreakpoints;
@@ -2083,7 +2083,7 @@ procedure TBreakpointCollection.ShowAllBreakpoints;
   end;
 
 begin
-  ForEach(@SetInSource);
+  ForEach(TCallbackProcParam(@SetInSource));
 end;
 
 function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) : PBreakpoint;
@@ -2094,7 +2094,7 @@ function TBreakpointCollection.GetType(typ : BreakpointType;Const s : String) :
   end;
 
 begin
-  GetType:=FirstThat(@IsThis);
+  GetType:=FirstThat(TCallbackFunBoolParam(@IsThis));
 end;
 
 
@@ -2111,7 +2111,7 @@ var
 begin
     ToggleFileLine:=false;
     FileName:=OSFileName(FExpand(FileName));
-    PB:=FirstThat(@IsThere);
+    PB:=FirstThat(TCallbackFunBoolParam(@IsThere));
     If Assigned(PB) then
       begin
         { delete it form source window }
@@ -2610,7 +2610,7 @@ procedure TBreakpointsWindow.ReloadBreakpoints;
 begin
   If not assigned(BreakpointsCollection) then
     exit;
-  BreakpointsCollection^.ForEach(@InsertInBreakLB);
+  BreakpointsCollection^.ForEach(TCallbackProcParam(@InsertInBreakLB));
   ReDraw;
 end;
 
@@ -3004,7 +3004,7 @@ destructor TWatch.Done;
 
          begin
           W:=0;
-          ForEach(@GetMax);
+          ForEach(TCallbackProcParam(@GetMax));
           MaxW:=W;
           If assigned(WatchesWindow) then
             WatchesWindow^.WLB^.Update(MaxW);

packages/ide/fphelp.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit FPHelp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -686,7 +690,7 @@ begin
     end;
 end;
 begin
-  Desktop^.ForEach(@CloseIfHelpWindow);
+  Desktop^.ForEach(TCallbackProcParam(@CloseIfHelpWindow));
 end;
 
 END.

packages/ide/fpide.pas

@@ -14,15 +14,10 @@
  **********************************************************************}
 unit fpide;
 
-{2.0 compatibility}
-{$ifdef VER2_0}
-  {$macro on}
-  {$define resourcestring := const}
-{$endif}
+{$i globdir.inc}
 
 interface
 
-{$i globdir.inc}
 
 uses
   Objects,Drivers,Views,App,Gadgets,MsgBox,Tabs,

packages/ide/fpini.pas

@@ -681,7 +681,7 @@ begin
   INIFile^.SetEntry(secCompile,ieCompileMode,SwitchesModeStr[SwitchesMode]);
   { Help }
   S:='';
-  HelpFiles^.ForEach(@ConcatName);
+  HelpFiles^.ForEach(TCallbackProcParam(@ConcatName));
   INIFile^.SetEntry(secHelp,ieHelpFiles,EscapeIniText(S));
   { Editor }
   INIFile^.SetIntEntry(secEditor,ieDefaultTabSize,DefaultTabSize);

packages/ide/fpmfile.inc

@@ -205,7 +205,7 @@ function TIDEApp.SaveAll: boolean;
 
 begin
   SaveCancelled:=false;
-  Desktop^.ForEach(@SendSave);
+  Desktop^.ForEach(TCallbackProcParam(@SendSave));
   SaveAll:=not SaveCancelled;
 end;
 

packages/ide/fpmsrch.inc

@@ -98,7 +98,7 @@ begin
     end;
   New(S, Init(500,500));
   ProcedureCollection:=S;
-  BrowCol.Modules^.ForEach(@InsertInS);
+  BrowCol.Modules^.ForEach(TCallbackProcParam(@InsertInS));
   if Overflow then
     WarningBox(msg_toomanysymbolscantdisplayall,nil);
   Desktop^.GetExtent(R); R.A.X:=R.B.X-35;
@@ -153,7 +153,7 @@ begin
     end;
   New(S, Init(500,500));
   GlobalsCollection:=S;
-  BrowCol.Modules^.ForEach(@InsertInS);
+  BrowCol.Modules^.ForEach(TCallbackProcParam(@InsertInS));
   if Overflow then
     WarningBox(msg_toomanysymbolscantdisplayall,nil);
   Desktop^.GetExtent(R); R.A.X:=R.B.X-35;
@@ -179,7 +179,7 @@ begin
     end;
   New(S, Init(500,500));
   ModulesCollection:=S;
-  BrowCol.Modules^.ForEach(@InsertInS);
+  BrowCol.Modules^.ForEach(TCallbackProcParam(@InsertInS));
   Desktop^.GetExtent(R); R.A.X:=R.B.X-35;
   Desktop^.Insert(New(PBrowserWindow, Init(R,
     dialog_units,SearchFreeWindowNo,nil,label_sym_globalscope,'',S,nil,nil,nil)));

packages/ide/fpmwnd.inc

@@ -21,7 +21,7 @@ procedure TIDEApp.CloseAll;
   end;
 
 begin
-  Desktop^.ForEach(@SendClose);
+  Desktop^.ForEach(TCallbackProcParam(@SendClose));
 end;
 
 procedure TIDEApp.ResizeApplication(x, y : longint);
@@ -154,8 +154,8 @@ begin
 end;
 begin
   C^.DeleteAll;
-  VisState:=true; Desktop^.ForEach(@AddIt); { add visible windows to list }
-  VisState:=false; Desktop^.ForEach(@AddIt); { add hidden windows }
+  VisState:=true; Desktop^.ForEach(TCallbackProcParam(@AddIt)); { add visible windows to list }
+  VisState:=false; Desktop^.ForEach(TCallbackProcParam(@AddIt)); { add hidden windows }
   LB^.SetRange(C^.Count);
   UpdateButtons;
   ReDraw;

packages/ide/fpswitch.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit FPSwitch;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -804,7 +808,7 @@ function  TSwitches.SetCurrSelParam(const s : String) : boolean;
 var
   FoundP : PSwitchItem;
 begin
-  FoundP:=Items^.FirstThat(@CheckItem);
+  FoundP:=Items^.FirstThat(TCallbackFunBoolParam(@CheckItem));
   if Assigned(FoundP) then
     begin
       SetCurrSelParam:=true;
@@ -867,7 +871,7 @@ begin
         end;
     end
   else
-    Items^.ForEach(@writeitem);
+    Items^.ForEach(TCallbackProcParam(@writeitem));
 end;
 
 procedure WriteCustom;
@@ -906,7 +910,7 @@ var
   FoundP : PSwitchItem;
   code : integer;
 begin
-  FoundP:=Items^.FirstThat(@checkitem);
+  FoundP:=Items^.FirstThat(TCallbackFunBoolParam(@checkitem));
   if assigned(FoundP) then
    begin
      case FoundP^.Typ of
@@ -1074,12 +1078,12 @@ var
 begin
   GetSourceDirectories:='';
   c:='u';
-  P:=DirectorySwitches^.Items^.FirstThat(@CheckItem);
+  P:=DirectorySwitches^.Items^.FirstThat(TCallbackFunBoolParam(@CheckItem));
   S:='';
   if assigned(P) then
     S:=P^.Str[SwitchesMode];
   c:='i';
-  P:=DirectorySwitches^.Items^.FirstThat(@CheckItem);
+  P:=DirectorySwitches^.Items^.FirstThat(TCallbackFunBoolParam(@CheckItem));
   if assigned(P) then
     S:=P^.Str[SwitchesMode]+';'+S;
   if S='' then
@@ -1549,7 +1553,7 @@ begin
    end;
 end;
 begin
-  P^.Items^.ForEach(@HandleSwitch);
+  P^.Items^.ForEach(TCallbackProcParam(@HandleSwitch));
 end;
 var I: integer;
     S: string;

packages/ide/fpsymbol.pas

@@ -298,7 +298,7 @@ procedure CloseAllBrowsers;
   end;
 
 begin
-  Desktop^.ForEach(@SendCloseIfBrowser);
+  Desktop^.ForEach(TCallbackProcParam(@SendCloseIfBrowser));
 end;
 
 procedure RemoveBrowsersCollection;
@@ -367,7 +367,7 @@ begin
    Name:=UpcaseStr(Name);
    If BrowCol.Modules<>nil then
      begin
-       PS:=BrowCol.Modules^.FirstThat(@Search);
+       PS:=BrowCol.Modules^.FirstThat(TCallbackFunBoolParam(@Search));
        If assigned(PS) then
          begin
            S:=PS^.Items^.At(Index);
@@ -744,7 +744,7 @@ begin
 end;
 begin
   BW:=nil;
-  Desktop^.ForEach(@IsBW);
+  Desktop^.ForEach(TCallbackProcParam(@IsBW));
   LastBrowserWindow:=BW;
 end;
 

packages/ide/fptools.pas

@@ -15,6 +15,10 @@
 {$I globdir.inc}
 unit FPTools;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,Drivers,Views,Dialogs,Validate,
@@ -822,7 +826,7 @@ begin
   if OK then
     begin
       ViewCount:=0;
-      F^.ForEachSection(@ProcessSection);
+      F^.ForEachSection(TCallbackProcParam(@ProcessSection));
     end;
   BuildPromptDialogInfo:=OK;
 end;
@@ -1422,7 +1426,7 @@ end;
 begin
   if not Assigned(ToolTempFiles) then Exit;
 {$ifndef DEBUG}
-  ToolTempFiles^.ForEach(@DeleteIt);
+  ToolTempFiles^.ForEach(TCallbackProcParam(@DeleteIt));
 {$endif ndef DEBUG}
   Dispose(ToolTempFiles, Done);
   ToolTempFiles:=nil;

packages/ide/fpviews.pas

@@ -742,7 +742,7 @@ begin
     PSourceWindow(P)^.Editor^.ReloadFile;
 end;
 begin
-  Desktop^.ForEach(@EditorWindowModifiedOnDisk);
+  Desktop^.ForEach(TCallbackProcParam(@EditorWindowModifiedOnDisk));
 end;
 
 function IsThereAnyHelpWindow: boolean;
@@ -2726,7 +2726,7 @@ function   TDisassemblyEditor.GetCurrentLine(address : CORE_ADDR) : PDisasLine;
   Var
     PL : PDisasLine;
 begin
-  PL:=DisasLines^.FirstThat(@IsCorrectLine);
+  PL:=DisasLines^.FirstThat(TCallbackFunBoolParam(@IsCorrectLine));
   if Assigned(PL) then
     begin
       if assigned(CurL) then
@@ -3766,7 +3766,7 @@ begin
   if P<>nil then Delete(P);
 end;
 begin
-  ForEach(@DeleteViews);
+  ForEach(TCallbackProcParam(@DeleteViews));
   inherited Done;
   P:=TabDefs;
   while P<>nil do

packages/ide/globdir.inc

@@ -221,3 +221,11 @@
     {$define GDB_WINDOWS_ALWAYS_USE_ANOTHER_CONSOLE}
   {$endif Windows}
 {$endif GDBMI}
+
+{$ifdef cpullvm}
+{$define TYPED_LOCAL_CALLBACKS}
+{$endif}
+
+{$ifdef TYPED_LOCAL_CALLBACKS}
+{$modeswitch nestedprocvars}
+{$endif}

packages/ide/wcedit.pas

@@ -15,6 +15,10 @@
 {$i globdir.inc}
 unit WCEdit;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,Drivers,Views,
@@ -336,7 +340,7 @@ begin
   if not assigned(EditorInfos) then
     GetEditorInfo:=DefaultEditorInfo
   else
-    GetEditorInfo:=EditorInfos^.FirstThat(@Match);
+    GetEditorInfo:=EditorInfos^.FirstThat(TCallbackFunBoolParam(@Match));
 end;
 
 function TLine.GetFlags: longint;
@@ -477,7 +481,7 @@ begin
 end;
 begin
   if Assigned(Lines) then
-    Lines^.ForEach(@AddIt);
+    Lines^.ForEach(TCallbackProcParam(@AddIt));
 end;
 
 procedure TCodeEditorCore.SetContent(ALines: PUnsortedStringCollection);
@@ -488,7 +492,7 @@ end;
 begin
   DeleteAllLines;
   if Assigned(ALines) then
-    ALines^.ForEach(@AddIt);
+    ALines^.ForEach(TCallbackProcParam(@AddIt));
   LimitsChanged;
 end;
 
@@ -541,7 +545,7 @@ end;
 begin
   if Idx=-1 then Idx:=Lines^.Count;
   I:=0;
-  Bindings^.ForEach(@RegLine);
+  Bindings^.ForEach(TCallbackProcParam(@RegLine));
   Lines^.AtInsert(Idx,Line);
 end;
 

packages/ide/weditor.pas

@@ -15,6 +15,10 @@
 {$I globdir.inc}
 unit WEditor;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 {tes}
 uses
@@ -1421,7 +1425,7 @@ begin
 end;
 begin
   Count:=LineCount_;
-  if assigned(Childs) then Childs^.ForEach(@AddIt);
+  if assigned(Childs) then Childs^.ForEach(TCallbackProcParam(@AddIt));
   GetLineCount:=Count;
 end;
 
@@ -1592,7 +1596,7 @@ begin
   SearchEditor:=P^.Editor=AEditor;
 end;
 begin
-  SearchBinding:=Bindings^.FirstThat(@SearchEditor);
+  SearchBinding:=Bindings^.FirstThat(TCallbackFunBoolParam(@SearchEditor));
 end;
 
 function TCustomCodeEditorCore.CanDispose: boolean;
@@ -1644,7 +1648,7 @@ begin
   IsClip:=(P^.Editor=Clipboard);
 end;
 begin
-  IsClipBoard:=Bindings^.FirstThat(@IsClip)<>nil;
+  IsClipBoard:=Bindings^.FirstThat(TCallbackFunBoolParam(@IsClip))<>nil;
 end;
 
 function TCustomCodeEditorCore.GetTabSize: integer;
@@ -1716,7 +1720,7 @@ begin
   P^.Editor^.BindingsChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.DoLimitsChanged;
@@ -1725,7 +1729,7 @@ begin
   P^.Editor^.DoLimitsChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.DoContentsChanged;
@@ -1734,7 +1738,7 @@ begin
   P^.Editor^.ContentsChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.DoModifiedChanged;
@@ -1743,7 +1747,7 @@ begin
   P^.Editor^.ModifiedChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.DoTabSizeChanged;
@@ -1752,7 +1756,7 @@ begin
   P^.Editor^.TabSizeChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 procedure TCustomCodeEditorCore.UpdateUndoRedo(cm : word; action : byte);
@@ -1770,7 +1774,7 @@ begin
     end;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 
@@ -1780,7 +1784,7 @@ begin
   P^.Editor^.StoreUndoChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 procedure   TCustomCodeEditorCore.DoSyntaxStateChanged;
 procedure CallIt(P: PEditorBinding);
@@ -1788,7 +1792,7 @@ begin
   P^.Editor^.SyntaxStateChanged;
 end;
 begin
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
 end;
 
 function TCustomCodeEditorCore.GetLastVisibleLine : sw_integer;
@@ -1801,7 +1805,7 @@ begin
 end;
 begin
   y:=0;
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
   GetLastVisibleLine:=y;
 end;
 
@@ -2050,7 +2054,7 @@ begin
 end;
 begin
   MinLine:=-1;
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
   UpdateAttrs:=MinLine;
 end;
 
@@ -2064,7 +2068,7 @@ begin
 end;
 begin
   MinLine:=-1;
-  Bindings^.ForEach(@CallIt);
+  Bindings^.ForEach(TCallbackProcParam(@CallIt));
   UpdateAttrsRange:=MinLine;
 end;
 

packages/ide/whelp.pas

@@ -15,6 +15,10 @@
 {$R-}
 unit WHelp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -384,7 +388,7 @@ begin
   if Assigned(T^.NamedMarks) then
   begin
     New(NT^.NamedMarks, Init(T^.NamedMarks^.Count,10));
-    T^.NamedMarks^.ForEach(@CloneMark);
+    T^.NamedMarks^.ForEach(TCallbackProcParam(@CloneMark));
   end;
   NT^.ExtDataSize:=T^.ExtDataSize;
   if Assigned(T^.ExtData) and (T^.ExtDataSize>0) then
@@ -686,10 +690,10 @@ procedure SearchLRU(P: PTopic);
 begin if P^.LastAccess<MinLRU then begin MinLRU:=P^.LastAccess; end; end;
 var P: PTopic;
 begin
-  Count:=0; Topics^.ForEach(@CountThem);
+  Count:=0; Topics^.ForEach(TCallbackProcParam(@CountThem));
   if (Count>=TopicCacheSize) then
   begin
-    MinLRU:=MaxLongint; P:=nil; Topics^.ForEach(@SearchLRU);
+    MinLRU:=MaxLongint; P:=nil; Topics^.ForEach(TCallbackProcParam(@SearchLRU));
     if P<>nil then
     begin
       FreeMem(P^.Text,P^.TextSize); P^.TextSize:=0; P^.Text:=nil;
@@ -758,7 +762,7 @@ begin
        HelpFile:=SearchFile(SourceFileID);
        P:=SearchTopicInHelpFile(HelpFile,Context);
      end;
-  if P=nil then HelpFiles^.FirstThat(@Search);
+  if P=nil then HelpFiles^.FirstThat(TCallbackFunBoolParam(@Search));
   if P=nil then HelpFile:=nil;
   SearchTopicOwner:=HelpFile;
 end;
@@ -808,7 +812,7 @@ end;
 var P: PIndexEntry;
 begin
   H^.LoadIndex;
-  P:=H^.IndexEntries^.FirstThat(@SearchExact);
+  P:=H^.IndexEntries^.FirstThat(TCallbackFunBoolParam(@SearchExact));
   if P<>nil then begin FileID:=H^.ID; Context:=P^.HelpCtx; end;
   ScanHelpFileExact:=P<>nil;
 end;
@@ -820,7 +824,7 @@ end;
 var P: PIndexEntry;
 begin
   H^.LoadIndex;
-  P:=H^.IndexEntries^.FirstThat(@Search);
+  P:=H^.IndexEntries^.FirstThat(TCallbackFunBoolParam(@Search));
   if P<>nil then begin FileID:=H^.ID; Context:=P^.HelpCtx; end;
   ScanHelpFile:=P<>nil;
 end;
@@ -828,9 +832,9 @@ var
   PH : PHelpFile;
 begin
   Keyword:=UpcaseStr(Keyword);
-  PH:=HelpFiles^.FirstThat(@ScanHelpFileExact);
+  PH:=HelpFiles^.FirstThat(TCallbackFunBoolParam(@ScanHelpFileExact));
   if not assigned(PH) then
-    PH:=HelpFiles^.FirstThat(@ScanHelpFile);
+    PH:=HelpFiles^.FirstThat(TCallbackFunBoolParam(@ScanHelpFile));
   TopicSearch:=PH<>nil;
 end;
 
@@ -847,7 +851,7 @@ end;
 begin
   H^.LoadIndex;
   if Keywords^.Count<MaxCollectionSize then
-  H^.IndexEntries^.FirstThat(@InsertKeywords);
+  H^.IndexEntries^.FirstThat(TCallbackFunBoolParam(@InsertKeywords));
 end;
 procedure AddLine(S: string);
 begin
@@ -912,7 +916,7 @@ var KW: PIndexEntry;
     St,LastTag : String;
 begin
   New(Keywords, Init(5000,5000));
-  HelpFiles^.ForEach(@InsertKeywordsOfFile);
+  HelpFiles^.ForEach(TCallbackProcParam(@InsertKeywordsOfFile));
   New(Lines, Init((Keywords^.Count div 2)+100,1000));
   T:=NewTopic(0,0,0,'',nil,0);
   if HelpFiles^.Count=0 then
@@ -978,7 +982,7 @@ begin
   Match:=(P^.ID=ID);
 end;
 begin
-  SearchFile:=HelpFiles^.FirstThat(@Match);
+  SearchFile:=HelpFiles^.FirstThat(TCallbackFunBoolParam(@Match));
 end;
 
 function THelpFacility.SearchTopicInHelpFile(F: PHelpFile; Context: THelpCtx): PTopic;

packages/ide/whtmlhlp.pas

@@ -12,6 +12,10 @@
  **********************************************************************}
 unit WHTMLHlp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,WHTML,WAnsi,WHelp,WChmHWrap;
@@ -1399,7 +1403,7 @@ begin
   if (HelpCtx<>0) and (FileID<>ID) then P:=nil else
   if (FileID=ID) and (LinkNo>TopicLinks^.Count) then P:=nil else
     begin
-      P:=Topics^.FirstThat(@MatchCtx);
+      P:=Topics^.FirstThat(TCallbackFunBoolParam(@MatchCtx));
       if P=nil then
         begin
           if LinkNo=0 then
@@ -1673,7 +1677,7 @@ begin
   if (HelpCtx<>0) and (FileID<>ID) then P:=nil else
   if (FileID=ID) and (LinkNo>TopicLinks^.Count) then P:=nil else
     begin
-      P:=Topics^.FirstThat(@MatchCtx);
+      P:=Topics^.FirstThat(TCallbackFunBoolParam(@MatchCtx));
       if P=nil then
         begin
           if LinkNo=0 then

packages/ide/whtmlscn.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit WHTMLScn;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,
@@ -531,7 +535,7 @@ procedure THTMLLinkScanDocumentCollection.MoveAliasesToSynonym;
       end;
   end;
 begin
-  ForEach(@MoveAliases);
+  ForEach(TCallbackProcParam(@MoveAliases));
 end;
 
 constructor THTMLLinkScanner.Init(const ABaseDir: string);
@@ -834,7 +838,7 @@ procedure THTMLLinkScanFileCollection.CheckNameIDLists;
     end;
 
 begin
-  ForEach(@DoCheckNameList);
+  ForEach(TCallbackProcParam(@DoCheckNameList));
 end;
 
 
@@ -985,7 +989,7 @@ function THTMLFileLinkScanner.FindID(const AName : string) : PNameID;
 var
   D : PHTMLLinkScanFile;
 begin
-  D:=DocumentFiles^.FirstThat(@ContainsNamedID);
+  D:=DocumentFiles^.FirstThat(TCallbackFunBoolParam(@ContainsNamedID));
   if assigned(D) then
     FindID:=D^.FindID(AName)
   else

packages/ide/wini.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit WINI;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects;
@@ -49,7 +53,7 @@ type
       function    AddEntry(const Tag,Value,Comment: string): PINIEntry;
       function    SearchEntry(Tag: string): PINIEntry; virtual;
       procedure   DeleteEntry(Tag: string);
-      procedure   ForEachEntry(EnumProc: pointer); virtual;
+      procedure   ForEachEntry(EnumProc: TCallbackProcParam); virtual;
       destructor  Done; virtual;
     private
       NameHash : Cardinal;
@@ -67,8 +71,8 @@ type
       function    IsModified: boolean; virtual;
       function    SearchSection(Section: string): PINISection; virtual;
       function    SearchEntry(const Section, Tag: string): PINIEntry; virtual;
-      procedure   ForEachSection(EnumProc: pointer); virtual;
-      procedure   ForEachEntry(const Section: string; EnumProc: pointer); virtual;
+      procedure   ForEachSection(EnumProc: TCallbackProcParam); virtual;
+      procedure   ForEachEntry(const Section: string; EnumProc: TCallbackProcParam); virtual;
       function    GetEntry(const Section, Tag, Default: string): string; virtual;
       procedure   SetEntry(const Section, Tag, Value: string); virtual;
       procedure   SetEntry(const Section, Tag, Value,Comment: string); virtual;
@@ -354,7 +358,7 @@ begin
   AddEntry:=E;
 end;
 
-procedure TINIFile.ForEachSection(EnumProc: pointer);
+procedure TINIFile.ForEachSection(EnumProc: TCallbackProcParam);
 var I: Sw_integer;
    S: PINISection;
 begin
@@ -365,7 +369,7 @@ begin
     end;
 end;
 
-procedure TINISection.ForEachEntry(EnumProc: pointer);
+procedure TINISection.ForEachEntry(EnumProc: TCallbackProcParam);
 var I: integer;
     E: PINIEntry;
 begin
@@ -472,11 +476,11 @@ function TINIFile.IsModified: boolean;
     end;
 
   begin
-    SectionModified:=(P^.Entries^.FirstThat(@EntryModified)<>nil);
+    SectionModified:=(P^.Entries^.FirstThat(TCallbackFunBoolParam(@EntryModified))<>nil);
   end;
 
 begin
-  IsModified:=(Sections^.FirstThat(@SectionModified)<>nil);
+  IsModified:=(Sections^.FirstThat(TCallbackFunBoolParam(@SectionModified))<>nil);
 end;
 
 
@@ -554,7 +558,7 @@ begin
   SearchEntry:=E;
 end;
 
-procedure TINIFile.ForEachEntry(const Section: string; EnumProc: pointer);
+procedure TINIFile.ForEachEntry(const Section: string; EnumProc: TCallbackProcParam);
 var P: PINISection;
     E: PINIEntry;
     I: integer;

packages/ide/wnghelp.pas

@@ -15,6 +15,10 @@
 {$R-}
 unit WNGHelp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,
@@ -109,8 +113,8 @@ type
         IndexLoaded: boolean;
 {        NextHelpCtx: longint;}
         function ReadHeader: boolean;
-        function ReadContainer(EnumProc: pointer): boolean;
-        function ReadTopicRec(LineEnumProc: pointer; LinkEnumProc: pointer): boolean;
+        function ReadContainer(EnumProc: TCallbackProcParam): boolean;
+        function ReadTopicRec(LineEnumProc: TCallbackProcParam; LinkEnumProc: TCallbackProcParam): boolean;
         function ReadRecord(var R: TRecord; ReadData: boolean): boolean;
       end;
 
@@ -228,7 +232,7 @@ begin
   ReadHeader:=OK;
 end;
 
-function TNGHelpFile.ReadContainer(EnumProc: pointer): boolean;
+function TNGHelpFile.ReadContainer(EnumProc: TCallbackProcParam): boolean;
 var OK: boolean;
     R: TRecord;
     I: longint;
@@ -259,7 +263,7 @@ begin
   ReadContainer:=OK;
 end;
 
-function TNGHelpFile.ReadTopicRec(LineEnumProc, LinkEnumProc: pointer): boolean;
+function TNGHelpFile.ReadTopicRec(LineEnumProc, LinkEnumProc: TCallbackProcParam): boolean;
 var OK: boolean;
     R: TRecord;
     I: sw_integer;
@@ -380,7 +384,7 @@ begin
       OK:=ReadRecord(R,false);
       if (OK=false) then Break;
       case R.SClass of
-        ng_rtContainer : begin F^.Seek(L); OK:=ReadContainer(@AddToIndex); end;
+        ng_rtContainer : begin F^.Seek(L); OK:=ReadContainer(TCallbackProcParam(@AddToIndex)); end;
         ng_rtTopic     : ;
       else
        begin
@@ -477,14 +481,14 @@ begin
         begin
           F^.Seek(T^.FileOfs);
           AddLine('');
-          OK:=ReadContainer(@AddToTopic);
+          OK:=ReadContainer(TCallbackProcParam(@AddToTopic));
           RenderTopic(Lines,T);
         end;
       ng_rtTopic     :
         begin
           F^.Seek(T^.FileOfs);
           AddLine('');
-          OK:=ReadTopicRec(@AddTopicLine,@AddLink);
+          OK:=ReadTopicRec(TCallbackProcParam(@AddTopicLine),TCallbackProcParam(@AddLink));
           TranslateLines(Lines);
           AddLine('');
           { include copyright info }

packages/ide/wresourc.pas

@@ -14,6 +14,10 @@
  **********************************************************************}
 unit WResourc;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects;
@@ -79,8 +83,8 @@ type
      TResource = object(TObject)
        constructor Init(const AName: string; AClass, AFlags: longint);
        function    GetName: string; virtual;
-       function    FirstThatEntry(Func: pointer): PResourceEntry; virtual;
-       procedure   ForEachEntry(Func: pointer); virtual;
+       function    FirstThatEntry(Func: TCallbackFunBoolParam): PResourceEntry; virtual;
+       procedure   ForEachEntry(Func: TCallbackProcParam); virtual;
        destructor  Done; virtual;
      private
        Name   : PString;
@@ -103,9 +107,9 @@ type
        constructor Load(var RS: TStream);
        constructor CreateFile(AFileName: string);
        constructor LoadFile(AFileName: string);
-       function    FirstThatResource(Func: pointer): PResource; virtual;
-       procedure   ForEachResource(Func: pointer); virtual;
-       procedure   ForEachResourceEntry(Func: pointer); virtual;
+       function    FirstThatResource(Func: TCallbackFunBoolParam): PResource; virtual;
+       procedure   ForEachResource(Func: TCallbackProcParam); virtual;
+       procedure   ForEachResourceEntry(Func: TCallbackProcParam); virtual;
        function    CreateResource(const Name: string; AClass, AFlags: longint): boolean; virtual;
        function    AddResourceEntry(const ResName: string; ALangID, AFlags: longint; var Data;
                    ADataSize: sw_integer): boolean; virtual;
@@ -220,7 +224,7 @@ begin
   GetName:=GetStr(Name);
 end;
 
-function TResource.FirstThatEntry(Func: pointer): PResourceEntry;
+function TResource.FirstThatEntry(Func: TCallbackFunBoolParam): PResourceEntry;
 var EP,P: PResourceEntry;
     I: sw_integer;
 begin
@@ -238,7 +242,7 @@ begin
   FirstThatEntry:=P;
 end;
 
-procedure TResource.ForEachEntry(Func: pointer);
+procedure TResource.ForEachEntry(Func: TCallbackProcParam);
 var RP: PResourceEntry;
     I: sw_integer;
 begin
@@ -364,7 +368,7 @@ begin
     end;
 end;
 
-function TResourceFile.FirstThatResource(Func: pointer): PResource;
+function TResourceFile.FirstThatResource(Func: TCallbackFunBoolParam): PResource;
 var RP,P: PResource;
     I: sw_integer;
 begin
@@ -382,7 +386,7 @@ begin
   FirstThatResource:=P;
 end;
 
-procedure TResourceFile.ForEachResource(Func: pointer);
+procedure TResourceFile.ForEachResource(Func: TCallbackProcParam);
 var RP: PResource;
     I: sw_integer;
 begin
@@ -393,7 +397,7 @@ begin
     end;
 end;
 
-procedure TResourceFile.ForEachResourceEntry(Func: pointer);
+procedure TResourceFile.ForEachResourceEntry(Func: TCallbackProcParam);
 var E: PResourceEntry;
     I: sw_integer;
 begin
@@ -659,10 +663,10 @@ begin
   S^.Write(RH,SizeOf(RH));
   N:=P^.GetName;
   S^.Write(N[1],length(N));
-  P^.ForEachEntry(@WriteResourceEntry);
+  P^.ForEachEntry(TCallbackProcParam(@WriteResourceEntry));
 end;
 begin
-  ForEachResource(@WriteResource);
+  ForEachResource(TCallbackProcParam(@WriteResource));
 end;
 
 procedure TResourceFile.UpdateBlockDatas;
@@ -695,10 +699,10 @@ end;
 begin
   Size:=0; NamesSize:=0;
   Inc(Size,SizeOf(Header)); { this is on start so we always include it }
-  ForEachResourceEntry(@AddResourceEntrySize);
+  ForEachResourceEntry(TCallbackProcParam(@AddResourceEntrySize));
   if IncludeHeaders then
     begin
-      ForEachResource(@AddResourceSize);
+      ForEachResource(TCallbackProcParam(@AddResourceSize));
       Inc(Size,SizeOf(RH)*Resources^.Count);
       Inc(Size,SizeOf(REH)*Entries^.Count);
       Inc(Size,NamesSize);

packages/ide/wutils.pas

@@ -12,6 +12,10 @@
  **********************************************************************}
 unit WUtils;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses
@@ -687,7 +691,7 @@ end;
 begin
   FreeAll;
   if Assigned(ALines) then
-    ALines^.ForEach(@AddIt);
+    ALines^.ForEach(TCallbackProcParam(@AddIt));
 end;
 
 procedure TUnsortedStringCollection.InsertStr(const S: string);

packages/ide/wwinhelp.pas

@@ -15,6 +15,10 @@
 {$R-}
 unit WWinHelp;
 
+{$ifdef cpullvm}
+{$modeswitch nestedprocvars}
+{$endif}
+
 interface
 
 uses Objects,
@@ -225,7 +229,7 @@ type
         function UsesHallCompression: boolean;
         procedure ExtractTopicOffset(TopicOffset: longint; var TopicBlockNo, TopicBlockOffset: word);
         function  ReadTopicBlock(BlockNo: word; var T: TTopicBlock; ReadData: boolean): boolean;
-        function  ProcessTopicBlock(BlockNo: longint; EnumProc: pointer): boolean;
+        function  ProcessTopicBlock(BlockNo: longint; EnumProc: TCallbackFunBoolParam): boolean;
         procedure PhraseDecompress(SrcBufP: pointer; SrcBufSize: longint; DestBufP: pointer; DestBufSize: longint);
         procedure HallDecompress(SrcBufP: pointer; SrcBufSize: longint; DestBufP: pointer; DestBufSize: longint);
       end;
@@ -1165,7 +1169,7 @@ begin
   end;
 end;
 
-function TWinHelpFile.ProcessTopicBlock(BlockNo: longint; EnumProc: pointer): boolean;
+function TWinHelpFile.ProcessTopicBlock(BlockNo: longint; EnumProc: TCallbackFunBoolParam): boolean;
 var TB: TTopicBlock;
     TL: TWinHelpTopicLink;
     BlockFileOfs: longint;
@@ -1643,14 +1647,14 @@ begin
   begin
     ExtractTopicOffset(T^.FileOfs,BlockNo,BlockOfs);
     TopicStartPos:=-1; GotIt:=false;
-    OK:=ProcessTopicBlock(BlockNo,@SearchTopicStart);
+    OK:=ProcessTopicBlock(BlockNo,TCallbackFunBoolParam(@SearchTopicStart));
     OK:=OK and GotIt and (TopicStartPos<>-1);
     if OK then
     begin
       CurLine:='';
       New(Lines, Init(1000,1000));
       LastEmittedChar:=-1;
-      OK:=ProcessTopicBlock(BlockNo,@RenderTopicProc);
+      OK:=ProcessTopicBlock(BlockNo,TCallbackFunBoolParam(@RenderTopicProc));
       FlushLine;
       BuildTopic(Lines,T);
       Dispose(Lines, Done);

packages/pastojs/src/pas2jscompiler.pp

@@ -37,13 +37,13 @@ uses
   {$ENDIF}
   // !! No filesystem units here.
   Classes, SysUtils, contnrs,
-  jstree, jswriter, JSSrcMap,
+  jsbase, jstree, jswriter, JSSrcMap,
   PScanner, PParser, PasTree, PasResolver, PasUseAnalyzer, PasResolveEval,
   FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser;
 
 const
   VersionMajor = 1;
-  VersionMinor = 1;
+  VersionMinor = 3;
   VersionRelease = 1;
   VersionExtra = '';
   DefaultConfigFile = 'pas2js.cfg';
@@ -54,6 +54,8 @@ const
   nOptionIsEnabled = 101; sOptionIsEnabled = 'Option "%s" is %s';
   nSyntaxModeIs = 102; sSyntaxModeIs = 'Syntax mode is %s';
   nMacroDefined = 103; sMacroDefined = 'Macro defined: %s';
+  // 104 in unit Pas2JSFS
+  // 105 in unit Pas2JSFS
   nNameValue = 106; sNameValue = '%s: %s';
   nReadingOptionsFromFile = 107; sReadingOptionsFromFile = 'Reading options from file %s';
   nEndOfReadingConfigFile = 108; sEndOfReadingConfigFile = 'End of reading config file %s';
@@ -92,6 +94,7 @@ const
   nPostProcessorFailX = 141; sPostProcessorFailX = 'Post processor failed: %s';
   nPostProcessorWarnX = 142; sPostProcessorWarnX = 'Post processor: %s';
   nPostProcessorFinished = 143; sPostProcessorFinished = 'Post processor finished';
+  nRTLIdentifierChanged = 144; sRTLIdentifierChanged = 'RTL identifier %s changed from %s to %s';
   // Note: error numbers 201+ are used by Pas2jsFileCache
 
 //------------------------------------------------------------------------------
@@ -423,7 +426,6 @@ type
     Procedure CallPostProcessors(Const JSFileName: String; aWriter: TPas2JSMapper); virtual; abstract;
   end;
 
-
   { TPas2JSConfigSupport }
 
   TPas2JSConfigSupport = Class(TPas2JSCompilerSupport)
@@ -443,11 +445,11 @@ type
     function FindDefaultConfig: String; virtual; abstract;
     function GetReader(aFileName: string): TSourceLineReader; virtual; abstract;
   Public
-    Constructor Create(aCompiler: TPas2jsCompiler); override;
-    Destructor Destroy; override;
+    constructor Create(aCompiler: TPas2jsCompiler); override;
+    destructor Destroy; override;
     procedure LoadDefaultConfig;
-    Procedure LoadConfig(Const aFileName: String);virtual;
-    Property Compiler:  TPas2jsCompiler Read FCompiler;
+    procedure LoadConfig(Const aFileName: String);virtual;
+    property Compiler:  TPas2jsCompiler Read FCompiler;
   end;
 
   { TPas2JSWPOptimizer }
@@ -459,8 +461,8 @@ type
 
   TPas2jsCompiler = class
   private
-    FMainJSFileResolved: String;
-    FIsMainJSFileResolved: Boolean;
+    FAllJSIntoMainJS: Boolean;
+    FConverterGlobals: TPasToJSConverterGlobals;
     FCompilerExe: string;
     FDefines: TStrings; // Objects can be TMacroDef
     FFS: TPas2jsFS;
@@ -471,25 +473,25 @@ type
     FHasShownLogo: boolean;
     FLog: TPas2jsLogger;
     FMainFile: TPas2jsCompilerFile;
+    FMainJSFileResolved: String;
+    FMainJSFileIsResolved: Boolean;
+    FMainJSFile: String;
+    FMainSrcFile: String;
     FMode: TP2jsMode;
     FOptions: TP2jsCompilerOptions;
     FParamMacros: TPas2jsMacroEngine;
     FSrcMapSourceRoot: string;
-    FTargetPlatform: TPasToJsPlatform;
-    FTargetProcessor: TPasToJsProcessor;
     FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
     FWPOAnalyzer: TPas2JSWPOptimizer;
     FInterfaceType: TPasClassInterfaceType;
-    FRTLVersionCheck: TP2jsRTLVersionCheck;
     FPrecompileGUID: TGUID;
     FInsertFilenames: TStringList;
     FNamespaces: TStringList;
     FNamespacesFromCmdLine: integer;
-    FAllJSIntoMainJS: Boolean;
     FConfigSupport: TPas2JSConfigSupport;
-    FMainJSFile: String;
-    FMainSrcFile: String;
     FSrcMapBaseDir: string;
+    FRTLVersionCheck: TP2jsRTLVersionCheck;
+    FPostProcessorSupport: TPas2JSPostProcessorSupport;
     procedure AddInsertJSFilename(const aFilename: string);
     Procedure AddNamespaces(const Paths: string; FromCmdLine: boolean);
     function GetDefaultNamespace: String;
@@ -504,6 +506,8 @@ type
     function GetSrcMapEnable: boolean;
     function GetSrcMapInclude: boolean;
     function GetSrcMapXSSIHeader: boolean;
+    function GetTargetPlatform: TPasToJsPlatform;
+    function GetTargetProcessor: TPasToJsProcessor;
     function GetWriteDebugLog: boolean;
     function GetWriteMsgToStdErr: boolean;
     function HandleOptionOptimization(C: Char; aValue: String): Boolean;
@@ -513,6 +517,8 @@ type
     function OnMacroCfgDir(Sender: TObject; var Params: string; Lvl: integer): boolean;
     procedure RemoveInsertJSFilename(const aFilename: string);
     function ResolvedMainJSFile: string;
+    procedure SetAllJSIntoMainJS(AValue: Boolean);
+    procedure SetConverterGlobals(const AValue: TPasToJSConverterGlobals);
     procedure SetCompilerExe(AValue: string);
     procedure SetFS(AValue: TPas2jsFS);
     procedure SetMode(AValue: TP2jsMode);
@@ -536,9 +542,10 @@ type
     procedure AddDefinesForTargetProcessor;
     procedure AddReadingModule(aFile: TPas2jsCompilerFile);
     procedure RemoveReadingModule(aFile: TPas2jsCompilerFile);
+    procedure RegisterMessages;
   private
-    FPostProcessorSupport: TPas2JSPostProcessorSupport;
     // params, cfg files
+    FCurParam: string;
     procedure LoadConfig(CfgFilename: string);
     procedure ReadParam(Param: string; Quick, FromCmdLine: boolean);
     procedure ReadSingleLetterOptions(const Param: string; p: integer;
@@ -546,8 +553,6 @@ type
     procedure ReadCodeGenerationFlags(Param: String; p: integer);
     procedure ReadSyntaxFlags(Param: String; p: integer);
     procedure ReadVerbosityFlags(Param: String; p: integer);
-    procedure RegisterMessages;
-    procedure SetAllJSIntoMainJS(AValue: Boolean);
   protected
     // Create various other classes. Virtual so they can be overridden in descendents
     function CreateJSMapper: TPas2JSMapper;virtual;
@@ -646,6 +651,7 @@ type
     property MainFile: TPas2jsCompilerFile read FMainFile;
     property Mode: TP2jsMode read FMode write SetMode;
     property Options: TP2jsCompilerOptions read FOptions write SetOptions;
+    property ConverterGlobals: TPasToJSConverterGlobals read FConverterGlobals write SetConverterGlobals;
     property ParamMacros: TPas2jsMacroEngine read FParamMacros;
     property PrecompileGUID: TGUID read FPrecompileGUID write FPrecompileGUID;
     property RTLVersionCheck: TP2jsRTLVersionCheck read FRTLVersionCheck write FRTLVersionCheck;
@@ -659,22 +665,22 @@ type
     property ShowTriedUsedFiles: boolean read GetShowTriedUsedFiles write SetShowTriedUsedFiles;
     property ShowUsedTools: boolean read GetShowUsedTools write SetShowUsedTools;
     property SkipDefaultConfig: Boolean read GetSkipDefaultConfig write SetSkipDefaultConfig;
-    property TargetPlatform: TPasToJsPlatform read FTargetPlatform write SetTargetPlatform;
-    property TargetProcessor: TPasToJsProcessor read FTargetProcessor write SetTargetProcessor;
+    property TargetPlatform: TPasToJsPlatform read GetTargetPlatform write SetTargetPlatform;
+    property TargetProcessor: TPasToJsProcessor read GetTargetProcessor write SetTargetProcessor;
     property WPOAnalyzer: TPas2JSWPOptimizer read FWPOAnalyzer; // Whole Program Optimization
     property WriteDebugLog: boolean read GetWriteDebugLog write SetWriteDebugLog;
     property WriteMsgToStdErr: boolean read GetWriteMsgToStdErr write SetWriteMsgToStdErr;
     property AllJSIntoMainJS: Boolean Read FAllJSIntoMainJS Write SetAllJSIntoMainJS;
     property ExitCode: longint read GetExitCode write SetExitCode;
     property InsertFilenames: TStringList read FInsertFilenames;
-    Property MainJSFile: String Read FMainJSFile Write FMainJSFile;
-    Property MainSrcFile: String Read FMainSrcFile Write FMainSrcFile;
+    property MainJSFile: String Read FMainJSFile Write FMainJSFile;
+    property MainSrcFile: String Read FMainSrcFile Write FMainSrcFile;
     property SrcMapBaseDir: string read FSrcMapBaseDir write SetSrcMapBaseDir; // includes trailing pathdelim
     property Namespaces: TStringList read FNamespaces;
     property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
-    // Will be freed by compiler.
-    Property ConfigSupport: TPas2JSConfigSupport Read FConfigSupport Write FConfigSupport;
-    Property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport;
+    // can be set optionally, will be freed by compiler
+    property ConfigSupport: TPas2JSConfigSupport Read FConfigSupport Write FConfigSupport;
+    property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport;
   end;
 
 
@@ -1078,10 +1084,8 @@ procedure TPas2jsCompilerFile.CreateConverter;
 begin
   if FConverter<>nil then exit;
   FConverter:=TPasToJSConverter.Create;
-  FConverter.RTLVersion:=(VersionMajor*100+VersionMinor)*100+VersionRelease;
+  FConverter.Globals:=Compiler.ConverterGlobals;
   FConverter.Options:=GetInitialConverterOptions;
-  FConverter.TargetPlatform:=Compiler.TargetPlatform;
-  FConverter.TargetProcessor:=Compiler.TargetProcessor;
 end;
 
 procedure TPas2jsCompilerFile.OnResolverCheckSrcName(const Element: TPasElement);
@@ -2477,6 +2481,16 @@ begin
   Result:=coSourceMapXSSIHeader in FOptions;
 end;
 
+function TPas2jsCompiler.GetTargetPlatform: TPasToJsPlatform;
+begin
+  Result:=FConverterGlobals.TargetPlatform;
+end;
+
+function TPas2jsCompiler.GetTargetProcessor: TPasToJsProcessor;
+begin
+  Result:=FConverterGlobals.TargetProcessor;
+end;
+
 function TPas2jsCompiler.GetWriteDebugLog: boolean;
 begin
   Result:=coWriteDebugLog in FOptions;
@@ -2573,20 +2587,26 @@ begin
 end;
 
 procedure TPas2jsCompiler.SetTargetPlatform(const AValue: TPasToJsPlatform);
+var
+  OldPlatform: TPasToJsPlatform;
 begin
-  if FTargetPlatform=AValue then Exit;
-  RemoveDefine(PasToJsPlatformNames[TargetPlatform]);
-  FTargetPlatform:=AValue;
-  if FTargetPlatform=PlatformNodeJS then
+  OldPlatform:=FConverterGlobals.TargetPlatform;
+  if OldPlatform=AValue then Exit;
+  RemoveDefine(PasToJsPlatformNames[OldPlatform]);
+  FConverterGlobals.TargetPlatform:=AValue;
+  if AValue=PlatformNodeJS then
     AllJSIntoMainJS:=true;
   AddDefinesForTargetPlatform;
 end;
 
 procedure TPas2jsCompiler.SetTargetProcessor(const AValue: TPasToJsProcessor);
+var
+  OldTargetProcessor: TPasToJsProcessor;
 begin
-  if FTargetProcessor=AValue then Exit;
-  RemoveDefine(PasToJsProcessorNames[TargetProcessor]);
-  FTargetProcessor:=AValue;
+  OldTargetProcessor:=FConverterGlobals.TargetProcessor;
+  if OldTargetProcessor=AValue then Exit;
+  RemoveDefine(PasToJsProcessorNames[OldTargetProcessor]);
+  FConverterGlobals.TargetProcessor:=AValue;
   AddDefinesForTargetProcessor;
 end;
 
@@ -2631,6 +2651,75 @@ begin
   FReadingModules.Remove(aFile);
 end;
 
+procedure TPas2jsCompiler.RegisterMessages;
+var
+  LastMsgNumber: integer;
+
+  procedure r(MsgType: TMessageType; MsgNumber: integer; const MsgPattern: string);
+  var
+    s: String;
+  begin
+    if (LastMsgNumber>=0) and (MsgNumber<>LastMsgNumber+1) then
+    begin
+      if MsgNumber>LastMsgNumber+1 then
+        s:='TPas2jsCompiler.RegisterMessages: gap in registered message numbers: '+IntToStr(LastMsgNumber+1)+' '+IntToStr(MsgNumber)
+      else
+        s:='TPas2jsCompiler.RegisterMessages: not ascending order in registered message numbers: Last='+IntToStr(LastMsgNumber)+' New='+IntToStr(MsgNumber);
+      RaiseInternalError(20170504161422,s);
+    end;
+    Log.RegisterMsg(MsgType,MsgNumber,MsgPattern);
+    LastMsgNumber:=MsgNumber;
+  end;
+
+begin
+  LastMsgNumber:=-1;
+  r(mtInfo,nOptionIsEnabled,sOptionIsEnabled);
+  r(mtInfo,nSyntaxModeIs,sSyntaxModeIs);
+  r(mtInfo,nMacroDefined,sMacroDefined);
+  r(mtInfo,nUsingPath,sUsingPath);
+  r(mtNote,nFolderNotFound,sFolderNotFound);
+  r(mtInfo,nNameValue,sNameValue);
+  r(mtInfo,nReadingOptionsFromFile,sReadingOptionsFromFile);
+  r(mtInfo,nEndOfReadingConfigFile,sEndOfReadingConfigFile);
+  r(mtDebug,nInterpretingFileOption,sInterpretingFileOption);
+  r(mtFatal,nSourceFileNotFound,sSourceFileNotFound);
+  r(mtFatal,nFileIsFolder,sFileIsFolder);
+  r(mtInfo,nConfigFileSearch,sConfigFileSearch);
+  r(mtDebug,nHandlingOption,sHandlingOption);
+  r(mtDebug,nQuickHandlingOption,sQuickHandlingOption);
+  r(mtFatal,nOutputDirectoryNotFound,sOutputDirectoryNotFound);
+  r(mtError,nUnableToWriteFile,sUnableToWriteFile);
+  r(mtInfo,nWritingFile,sWritingFile);
+  r(mtFatal,nCompilationAborted,sCompilationAborted);
+  r(mtDebug,nCfgDirective,sCfgDirective);
+  r(mtError,nUnitCycle,sUnitCycle);
+  r(mtError,nOptionForbidsCompile,sOptionForbidsCompile);
+  r(mtInfo,nUnitNeedsCompileDueToUsedUnit,sUnitsNeedCompileDueToUsedUnit);
+  r(mtInfo,nUnitNeedsCompileDueToOption,sUnitsNeedCompileDueToOption);
+  r(mtInfo,nUnitNeedsCompileJSMissing,sUnitsNeedCompileJSMissing);
+  r(mtInfo,nUnitNeedsCompilePasHasChanged,sUnitsNeedCompilePasHasChanged);
+  r(mtInfo,nParsingFile,sParsingFile);
+  r(mtInfo,nCompilingFile,sCompilingFile);
+  r(mtError,nExpectedButFound,sExpectedButFound);
+  r(mtInfo,nLinesInFilesCompiled,sLinesInFilesCompiled);
+  r(mtInfo,nTargetPlatformIs,sTargetPlatformIs);
+  r(mtInfo,nTargetProcessorIs,sTargetProcessorIs);
+  r(mtInfo,nMessageEncodingIs,sMessageEncodingIs);
+  r(mtError,nUnableToTranslatePathToDir,sUnableToTranslatePathToDir);
+  r(mtInfo,nSrcMapSourceRootIs,sSrcMapSourceRootIs);
+  r(mtInfo,nSrcMapBaseDirIs,sSrcMapBaseDirIs);
+  r(mtFatal,nUnitFileNotFound,sUnitFileNotFound);
+  r(mtInfo,nClassInterfaceStyleIs,sClassInterfaceStyleIs);
+  r(mtInfo,nMacroXSetToY,sMacroXSetToY);
+  r(mtInfo,nPostProcessorInfoX,sPostProcessorInfoX);
+  r(mtInfo,nPostProcessorRunX,sPostProcessorRunX);
+  r(mtError,nPostProcessorFailX,sPostProcessorFailX);
+  r(mtWarning,nPostProcessorWarnX,sPostProcessorWarnX);
+  r(mtInfo,nPostProcessorFinished,sPostProcessorFinished);
+  r(mtInfo,nRTLIdentifierChanged,sRTLIdentifierChanged);
+  Pas2jsPParser.RegisterMessages(Log);
+end;
+
 procedure TPas2JSConfigSupport.CfgSyntaxError(const Msg: string);
 begin
   Compiler.Log.Log(mtError,Msg,0,CurrentCfgFilename,CurrentCfgLineNumber,0);
@@ -2845,6 +2934,8 @@ end;
 
 procedure TPas2jsCompiler.ParamFatal(Msg: string);
 begin
+  if FCurParam<>'' then
+    Msg:='parameter '+FCurParam+': '+Msg;
   if Assigned(ConfigSupport) and  (ConfigSupport.CurrentCfgFilename<>'') then
     Log.Log(mtFatal,Msg,0,ConfigSupport.CurrentCfgFilename,ConfigSupport.CurrentCfgLineNumber,0)
   else
@@ -2912,17 +3003,19 @@ begin
 
 end;
 
-function TPas2jsCompiler.HandleOptionJS(C: Char; aValue: String; Quick, FromCmdLine: Boolean): Boolean;
+function TPas2jsCompiler.HandleOptionJS(C: Char; aValue: String;
+  Quick, FromCmdLine: Boolean): Boolean;
 
 Var
-  S, ErrorMsg: String;
+  S, ErrorMsg, aName: String;
   i: Integer;
   enable: Boolean;
+  pbi: TPas2JSBuiltInName;
 
 begin
   Result:=True;
   case c of
-  'c':
+  'c': // -Jc concatenate
     begin
       if aValue='' then
         AllJSIntoMainJS:=true
@@ -2931,25 +3024,25 @@ begin
       else
         ParamFatal('invalid value (-Jc) "'+aValue+'"');
     end;
-  'e':
+  'e': // -Je<encoding>
     begin
-    S:=NormalizeEncoding(aValue);
-    case S of
-    {$IFDEF FPC_HAS_CPSTRING}
-    'console','system',
-    {$ENDIF}
-    'utf8', 'json':
-      if Log.Encoding<>S then begin
-        Log.Encoding:=S;
-        if FHasShownEncoding then begin
-          FHasShownEncoding:=false;
-          WriteEncoding;
+      S:=NormalizeEncoding(aValue);
+      case S of
+      {$IFDEF FPC_HAS_CPSTRING}
+      'console','system',
+      {$ENDIF}
+      'utf8', 'json':
+        if Log.Encoding<>S then begin
+          Log.Encoding:=S;
+          if FHasShownEncoding then begin
+            FHasShownEncoding:=false;
+            WriteEncoding;
+          end;
         end;
+      else ParamFatal('invalid encoding (-Je) "'+aValue+'"');
       end;
-    else ParamFatal('invalid encoding (-Je) "'+aValue+'"');
     end;
-    end;
-  'i':
+  'i': // -Ji<js-file>
     if aValue='' then
       ParamFatal('missing insertion file "'+aValue+'"')
     else if not Quick then
@@ -2966,9 +3059,9 @@ begin
       end else
         AddInsertJSFilename(aValue);
     end;
-  'l': SetOption(coLowercase,aValue<>'-');
-  'm':
-    // source map options
+  'l': // -Jl
+    SetOption(coLowercase,aValue<>'-');
+  'm': // -Jm source map options
     if aValue='' then
       SrcMapEnable:=true
     else if aValue[1]='-' then
@@ -3009,31 +3102,49 @@ begin
       // enable source maps when setting any -Jm<x> option
       SrcMapEnable:=true;
     end;
-  'o':
+  'o': // -Jo<flag>
     begin
-      // -Jo<flag>
       S:=aValue;
-      if S='' then
+      if aValue='' then
         ParamFatal('missing value of -Jo option');
-      Enable:=true;
-      c:=S[length(S)];
-      if c in ['+','-'] then
+      if SameText(LeftStr(S,4),'rtl-') then
       begin
-        Enable:=c='+';
-        Delete(S,length(S),1);
-      end;
-      Case lowercase(S) of
-        'searchlikefpc': FS.SearchLikeFPC:=Enable;
-        'usestrict': SetOption(coUseStrict,Enable);
-        'checkversion=main': RTLVersionCheck:=rvcMain;
-        'checkversion=system': RTLVersionCheck:=rvcSystem;
-        'checkversion=unit': RTLVersionCheck:=rvcUnit;
-      else
-        Result:=False;
+        // -Jortl-<name>=<value>   set rtl identifier
+        i:=5;
+        while (i<=length(S)) and (S[i] in ['a'..'z','A'..'Z','0'..'9','_']) do
+          inc(i);
+        if (i>length(S)) or (S[i]<>'=') then
+          ParamFatal('expected -Jortl-name=value');
+        aName:='pbi'+copy(S,5,i-5);
+        S:=copy(S,i+1,255);
+        val(aName,pbi,i);
+        if i<>0 then
+          ParamFatal('unknown rtl identifier "'+aName+'"');
+        if IsValidJSIdentifier(TJSString(ConverterGlobals.BuiltInNames[pbi]))
+            and not IsValidJSIdentifier(TJSString(S)) then
+          ParamFatal('JavaScript identifier expected');
+        if not Quick then
+          ConverterGlobals.BuiltInNames[pbi]:=S;
+      end else begin
+        Enable:=true;
+        c:=S[length(S)];
+        if c in ['+','-'] then
+        begin
+          Enable:=c='+';
+          Delete(S,length(S),1);
+        end;
+        Case lowercase(S) of
+          'searchlikefpc': FS.SearchLikeFPC:=Enable;
+          'usestrict': SetOption(coUseStrict,Enable);
+          'checkversion=main': RTLVersionCheck:=rvcMain;
+          'checkversion=system': RTLVersionCheck:=rvcSystem;
+          'checkversion=unit': RTLVersionCheck:=rvcUnit;
+        else
+          Result:=False;
+        end;
       end;
     end;
-  'p':
-    // -Jp<...>
+  'p': // -Jp<...>
     begin
     if not Assigned(PostProcessorSupport) then
       ParamFatal('-Jp: No postprocessor support available');
@@ -3045,14 +3156,15 @@ begin
         PostProcessorSupport.AddPostProcessor(aValue);
       end;
     end;
-  'u':
+  'u': // -Ju<foreign path>
     if not Quick then
       begin
       ErrorMsg:=FS.AddForeignUnitPath(aValue,FromCmdLine);
       if ErrorMsg<>'' then
         ParamFatal('invalid foreign unit path (-Ju) "'+ErrorMsg+'"');
       end;
-  'U': HandleOptionPCUFormat(aValue);
+  'U': // -JU...
+    HandleOptionPCUFormat(aValue);
   else
     Result:=False;
   end;
@@ -3090,7 +3202,8 @@ Var
   C,c2: Char;
   pr: TPasToJsProcessor;
   pl: TPasToJsPlatform;
-
+  s: string;
+  pbi: TPas2JSBuiltInName;
 begin
   // write information and halt
   InfoMsg:='';
@@ -3103,7 +3216,7 @@ begin
   P:=1;
   L:=Length(aValue);
   while p<=l do
-    begin
+  begin
     C:=aValue[P];
     case C of
     'D': // wite compiler date
@@ -3114,33 +3227,33 @@ begin
       AppendInfo(GetVersion(false));
     'S':
       begin
-      inc(p);
-      if p>l then
-        ParamFatal('missing info option after S in "'+aValue+'".');
-      C2:=aValue[p];
-      case C2 of
-      'O': // write source OS
-        AppendInfo(GetCompiledTargetOS);
-      'P': // write source processor
-        AppendInfo(GetCompiledTargetCPU);
-      else
-        ParamFatal('unknown info option S"'+C2+'" in "'+aValue+'".');
-      end;
+        inc(p);
+        if p>l then
+          ParamFatal('missing info option after S in "'+aValue+'".');
+        C2:=aValue[p];
+        case C2 of
+        'O': // write source OS
+          AppendInfo(GetCompiledTargetOS);
+        'P': // write source processor
+          AppendInfo(GetCompiledTargetCPU);
+        else
+          ParamFatal('unknown info option S"'+C2+'" in "'+aValue+'".');
+        end;
       end;
     'T':
       begin
-      inc(p);
-      if p>l then
-        ParamFatal('missing info option after T in "'+aValue+'".');
-      C2:=aValue[p];
-      case C2 of
-      'O': // write target platform
-        AppendInfo(PasToJsPlatformNames[TargetPlatform]);
-      'P': // write target processor
-        AppendInfo(PasToJsProcessorNames[TargetProcessor]);
-      else
-        ParamFatal('unknown info option S"'+C2+'" in "'+aValue+'".');
-      end;
+        inc(p);
+        if p>l then
+          ParamFatal('missing info option after T in "'+aValue+'".');
+        C2:=aValue[p];
+        case C2 of
+        'O': // write target platform
+          AppendInfo(PasToJsPlatformNames[TargetPlatform]);
+        'P': // write target processor
+          AppendInfo(PasToJsProcessorNames[TargetProcessor]);
+        else
+          ParamFatal('unknown info option S"'+C2+'" in "'+aValue+'".');
+        end;
       end;
     'c':
       // write list of supported JS processors
@@ -3148,20 +3261,31 @@ begin
         Log.LogPlain(PasToJsProcessorNames[pr]);
     'o':
       begin
-      // write list of optimizations
-      Log.LogPlain('EnumNumbers');
-      Log.LogPlain('RemoveNotUsedPrivates');
-      Log.LogPlain('RemoveNotUsedDeclarations');
+        // write list of optimizations
+        Log.LogPlain('EnumNumbers');
+        Log.LogPlain('RemoveNotUsedPrivates');
+        Log.LogPlain('RemoveNotUsedDeclarations');
       end;
     't':
       // write list of supported targets
       for pl in TPasToJsPlatform do
         Log.LogPlain(PasToJsPlatformNames[pl]);
+    'J':
+      // write list of RTL identifiers
+      begin
+        Log.LogPlain('-JoRTL-<x> identifiers:');
+        for pbi in TPas2JSBuiltInName do
+        begin
+          str(pbi,s);
+          Delete(s,1,3);
+          Log.LogPlain('-JoRTL-'+s+'='+Pas2JSBuiltInNames[pbi]);
+        end;
+      end
     else
       ParamFatal('unknown info option "'+C+'" in "'+aValue+'".');
     end;
     inc(p);
-    end;
+  end;
   if InfoMsg<>'' then
     Log.LogPlain(InfoMsg);
 end;
@@ -3188,6 +3312,7 @@ begin
     else
       Log.LogMsgIgnoreFilter(nHandlingOption,[QuoteStr(Param)]);
   if Param='' then exit;
+  FCurParam:=Param;
   ParamMacros.Substitute(Param,Self);
   if Param='' then exit;
 
@@ -3231,7 +3356,7 @@ begin
           end;
         end;
       'C': // code generation
-          ReadCodeGenerationFlags(aValue,1);
+        ReadCodeGenerationFlags(aValue,1);
       'd': // define
         if not Quick then
         begin
@@ -3557,79 +3682,23 @@ begin
   end;
 end;
 
-procedure TPas2jsCompiler.RegisterMessages;
-var
-  LastMsgNumber: integer;
-
-  procedure r(MsgType: TMessageType; MsgNumber: integer; const MsgPattern: string);
-  var
-    s: String;
-  begin
-    if (LastMsgNumber>=0) and (MsgNumber<>LastMsgNumber+1) then
-      begin
-      s:='TPas2jsCompiler.RegisterMessages: gap in registered message numbers: '+IntToStr(LastMsgNumber)+' '+IntToStr(MsgNumber);
-      RaiseInternalError(20170504161422,s);
-      end;
-    Log.RegisterMsg(MsgType,MsgNumber,MsgPattern);
-    LastMsgNumber:=MsgNumber;
-  end;
-
-begin
-  LastMsgNumber:=-1;
-  r(mtInfo,nOptionIsEnabled,sOptionIsEnabled);
-  r(mtInfo,nSyntaxModeIs,sSyntaxModeIs);
-  r(mtInfo,nMacroDefined,sMacroDefined);
-  r(mtInfo,nUsingPath,sUsingPath);
-  r(mtNote,nFolderNotFound,sFolderNotFound);
-  r(mtInfo,nNameValue,sNameValue);
-  r(mtInfo,nReadingOptionsFromFile,sReadingOptionsFromFile);
-  r(mtInfo,nEndOfReadingConfigFile,sEndOfReadingConfigFile);
-  r(mtDebug,nInterpretingFileOption,sInterpretingFileOption);
-  r(mtFatal,nSourceFileNotFound,sSourceFileNotFound);
-  r(mtFatal,nFileIsFolder,sFileIsFolder);
-  r(mtInfo,nConfigFileSearch,sConfigFileSearch);
-  r(mtDebug,nHandlingOption,sHandlingOption);
-  r(mtDebug,nQuickHandlingOption,sQuickHandlingOption);
-  r(mtFatal,nOutputDirectoryNotFound,sOutputDirectoryNotFound);
-  r(mtError,nUnableToWriteFile,sUnableToWriteFile);
-  r(mtInfo,nWritingFile,sWritingFile);
-  r(mtFatal,nCompilationAborted,sCompilationAborted);
-  r(mtDebug,nCfgDirective,sCfgDirective);
-  r(mtError,nUnitCycle,sUnitCycle);
-  r(mtError,nOptionForbidsCompile,sOptionForbidsCompile);
-  r(mtInfo,nUnitNeedsCompileDueToUsedUnit,sUnitsNeedCompileDueToUsedUnit);
-  r(mtInfo,nUnitNeedsCompileDueToOption,sUnitsNeedCompileDueToOption);
-  r(mtInfo,nUnitNeedsCompileJSMissing,sUnitsNeedCompileJSMissing);
-  r(mtInfo,nUnitNeedsCompilePasHasChanged,sUnitsNeedCompilePasHasChanged);
-  r(mtInfo,nParsingFile,sParsingFile);
-  r(mtInfo,nCompilingFile,sCompilingFile);
-  r(mtError,nExpectedButFound,sExpectedButFound);
-  r(mtInfo,nLinesInFilesCompiled,sLinesInFilesCompiled);
-  r(mtInfo,nTargetPlatformIs,sTargetPlatformIs);
-  r(mtInfo,nTargetProcessorIs,sTargetProcessorIs);
-  r(mtInfo,nMessageEncodingIs,sMessageEncodingIs);
-  r(mtError,nUnableToTranslatePathToDir,sUnableToTranslatePathToDir);
-  r(mtInfo,nSrcMapSourceRootIs,sSrcMapSourceRootIs);
-  r(mtInfo,nSrcMapBaseDirIs,sSrcMapBaseDirIs);
-  r(mtFatal,nUnitFileNotFound,sUnitFileNotFound);
-  r(mtInfo,nClassInterfaceStyleIs,sClassInterfaceStyleIs);
-  r(mtInfo,nMacroXSetToY,sMacroXSetToY);
-  r(mtInfo,nPostProcessorInfoX,sPostProcessorInfoX);
-  r(mtInfo,nPostProcessorRunX,sPostProcessorRunX);
-  r(mtError,nPostProcessorFailX,sPostProcessorFailX);
-  r(mtWarning,nPostProcessorWarnX,sPostProcessorWarnX);
-  r(mtInfo,nPostProcessorFinished,sPostProcessorFinished);
-  Pas2jsPParser.RegisterMessages(Log);
-end;
-
 procedure TPas2jsCompiler.SetAllJSIntoMainJS(AValue: Boolean);
 begin
   if FAllJSIntoMainJS=AValue then Exit;
   if aValue then
-    FIsMainJSFileResolved:=False;
+    FMainJSFileIsResolved:=False;
   FAllJSIntoMainJS:=AValue;
 end;
 
+procedure TPas2jsCompiler.SetConverterGlobals(
+  const AValue: TPasToJSConverterGlobals);
+begin
+  if AValue=FConverterGlobals then exit;
+  if (FConverterGlobals<>nil) and (FConverterGlobals.Owner=Self) then
+    FreeAndNil(FConverterGlobals);
+  FConverterGlobals:=AValue;
+end;
+
 function TPas2jsCompiler.FormatPath(const aPath: String): String;
 begin
   Result:=FS.FormatPath(aPath);
@@ -3656,6 +3725,7 @@ constructor TPas2jsCompiler.Create;
 
 begin
   FOptions:=DefaultP2jsCompilerOptions;
+  FConverterGlobals:=TPasToJSConverterGlobals.Create(Self);
   FNamespaces:=TStringList.Create;
   FDefines:=TStringList.Create;
   FInsertFilenames:=TStringList.Create;
@@ -3691,6 +3761,10 @@ destructor TPas2jsCompiler.Destroy;
     FFiles.FreeItems;
     FreeAndNil(FFiles);
 
+    FreeAndNil(FPostProcessorSupport);
+    FreeAndNil(FConfigSupport);
+    ConverterGlobals:=nil;
+
     ClearDefines;
     FreeAndNil(FDefines);
 
@@ -3701,8 +3775,6 @@ destructor TPas2jsCompiler.Destroy;
       FFS:=nil;
 
     FreeAndNil(FParamMacros);
-    FreeAndNil(FConfigSupport);
-    FreeAndNil(FPostProcessorSupport);
   end;
 
 begin
@@ -3784,10 +3856,9 @@ end;
 
 procedure TPas2jsCompiler.WritePrecompiledFormats;
 begin
-  WriteHelpLine('No support for PCU files in this class');
+  WriteHelpLine('   -JU: This pas2js does not support PCU files');
 end;
 
-
 procedure TPas2jsCompiler.AddNamespaces(const Paths: string;
   FromCmdLine: boolean);
 
@@ -3885,9 +3956,11 @@ begin
   FOptions:=DefaultP2jsCompilerOptions;
   FRTLVersionCheck:=DefaultP2jsRTLVersionCheck;
   FMode:=p2jmObjFPC;
-  FTargetPlatform:=PlatformBrowser;
-  FTargetProcessor:=ProcessorECMAScript5;
-  FIsMainJSFileResolved:=False;
+  FConverterGlobals.Reset;
+  FConverterGlobals.RTLVersion:=(VersionMajor*100+VersionMinor)*100+VersionRelease;
+  FConverterGlobals.TargetPlatform:=PlatformBrowser;
+  FConverterGlobals.TargetProcessor:=ProcessorECMAScript5;
+  FMainJSFileIsResolved:=False;
   Log.Reset;
   Log.ShowMsgTypes:=GetShownMsgTypes;
 
@@ -4105,6 +4178,7 @@ begin
   w('    -ic  : Write list of supported JS processors usable by -P<x>');
   w('    -io  : Write list of supported optimizations usable by -Oo<x>');
   w('    -it  : Write list of supported targets usable by -T<x>');
+  w('    -iJ  : Write list of supported JavaScript identifiers -JoRTL-<x>');
   w('  -C<x>  : Code generation options. <x> is a combination of the following letters:');
   // -C3        Turn on ieee error checking for constants
   w('    o    : Overflow checking of integer operations');
@@ -4143,6 +4217,7 @@ begin
   w('     -JoCheckVersion=main: insert rtl version check into main.');
   w('     -JoCheckVersion=system: insert rtl version check into system unit init.');
   w('     -JoCheckVersion=unit: insert rtl version check into every unit init.');
+  w('     -JoRTL-<y>=<z>: set RTL identifier y to value z. See -iJ.');
   w('   -Jpcmd<command>: Run postprocessor. For each generated js execute command passing the js as stdin and read the new js from stdout. This option can be added multiple times to call several postprocessors in succession.');
   w('   -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.');
   WritePrecompiledFormats;
@@ -4266,6 +4341,7 @@ var
   i: Integer;
   S: String;
   M: TMacroDef;
+  pbi: TPas2JSBuiltInName;
 begin
   for i:=0 to Defines.Count-1 do
     begin
@@ -4276,6 +4352,14 @@ begin
     else
       Log.LogMsgIgnoreFilter(nMacroDefined,[S]);
     end;
+  for pbi in TPas2JSBuiltInName do
+    if Pas2JSBuiltInNames[pbi]<>ConverterGlobals.BuiltInNames[pbi] then
+    begin
+      WriteStr(S,pbi);
+      S:=copy(S,4,255);
+      Log.LogMsgIgnoreFilter(nRTLIdentifierChanged,[QuoteStr(S),
+        QuoteStr(Pas2JSBuiltInNames[pbi]),QuoteStr(ConverterGlobals.BuiltInNames[pbi])]);
+    end;
 end;
 
 procedure TPas2jsCompiler.WriteUsedTools;
@@ -4301,7 +4385,7 @@ procedure TPas2jsCompiler.WriteInfo;
 begin
   WriteVersionLine;
   Log.LogLn;
-  Log.LogPlain('Compiler date     : '+GetCompiledDate);
+  Log.LogPlain('Compiler date      : '+GetCompiledDate);
   Log.LogPlain('Compiler CPU target: '+GetCompiledTargetCPU);
   Log.LogLn;
   Log.LogPlain('Supported targets (targets marked with ''{*}'' are under development):');
@@ -4534,6 +4618,16 @@ begin
     InsertFilenames.Delete(i);
 end;
 
+function TPas2jsCompiler.GetResolvedMainJSFile: string;
+
+begin
+  if not FMainJSFileIsResolved then
+  begin
+    FMainJSFileResolved:=ResolvedMainJSFile;
+    FMainJSFileIsResolved:=True;
+  end;
+  Result:=FMainJSFileResolved;
+end;
 
 function TPas2jsCompiler.GetUnitInfo(const UseUnitName, InFileName: String;
   PCUSupport: TPCUSupport): TFindUnitInfo;
@@ -4821,7 +4915,6 @@ begin
 end;
 
 function TPas2jsCompiler.ResolvedMainJSFile: string;
-
 Var
   OP,UP: String;
 
@@ -4861,16 +4954,5 @@ begin
   end;
 end;
 
-function TPas2jsCompiler.GetResolvedMainJSFile: string;
-
-begin
-  if not FIsMainJSFileResolved then
-  begin
-    FMainJSFileResolved:=ResolvedMainJSFile;
-    FIsMainJSFileResolved:=True;
-  end;
-  Result:=FMainJSFileResolved;
-end;
-
 end.
 

packages/pastojs/src/pas2jsfilecache.pp

@@ -1896,7 +1896,7 @@ var
   // 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;
+    if IndexOfFile(SearchedDirs,Dir)>=0 then exit(false);
     SearchedDirs.Add(Dir);
     Filename:=Dir+aUnitname+'.pp';
     if SearchLowUpCase(Filename) then exit(true);

packages/pastojs/tests/tcconverter.pp

@@ -1259,6 +1259,7 @@ end;
 procedure TTestConverter.SetUp;
 begin
   FConverter:=TPasToJSConverter.Create;
+  FConverter.Globals:=TPasToJSConverterGlobals.Create(FConverter);
 end;
 
 procedure TTestConverter.TearDown;

packages/pastojs/tests/tcfiler.pas

@@ -444,8 +444,8 @@ begin
   FInitialFlags.ModeSwitches:=Scanner.CurrentModeSwitches;
   FInitialFlags.BoolSwitches:=Scanner.CurrentBoolSwitches;
   FInitialFlags.ConverterOptions:=Converter.Options;
-  FInitialFlags.TargetPlatform:=Converter.TargetPlatform;
-  FInitialFlags.TargetProcessor:=Converter.TargetProcessor;
+  FInitialFlags.TargetPlatform:=Converter.Globals.TargetPlatform;
+  FInitialFlags.TargetProcessor:=Converter.Globals.TargetProcessor;
   // ToDo: defines
 end;
 

packages/pastojs/tests/tcmodules.pas

@@ -533,6 +533,7 @@ type
     Procedure TestExternalClass_OverloadHint;
     Procedure TestExternalClass_SameNamePublishedProperty;
     Procedure TestExternalClass_Property;
+    Procedure TestExternalClass_PropertyDate;
     Procedure TestExternalClass_ClassProperty;
     Procedure TestExternalClass_ClassOf;
     Procedure TestExternalClass_ClassOtherUnit;
@@ -1197,6 +1198,7 @@ function TCustomTestModule.CreateConverter: TPasToJSConverter;
 begin
   Result:=TPasToJSConverter.Create;
   Result.Options:=co_tcmodules;
+  Result.Globals:=TPasToJSConverterGlobals.Create(Result);
 end;
 
 procedure TCustomTestModule.InitScanner(aScanner: TPas2jsPasScanner);
@@ -1769,9 +1771,9 @@ begin
     if (Item.MsgNumber<>MsgNumber) or (Item.Msg<>Msg) then continue;
     if (Marker<>nil) then
       begin
-      if Item.SourcePos.Row<>Marker^.Row then continue;
-      if (Item.SourcePos.Column<Marker^.StartCol)
-          or (Item.SourcePos.Column>Marker^.EndCol) then continue;
+      if Item.SourcePos.Row<>cardinal(Marker^.Row) then continue;
+      if (Item.SourcePos.Column<cardinal(Marker^.StartCol))
+          or (Item.SourcePos.Column>cardinal(Marker^.EndCol)) then continue;
       end;
     // found
     FHintMsgsGood.Add(Item);
@@ -4068,6 +4070,9 @@ begin
   'procedure DoMore(f,g: TProc);',
   'begin',
   'end;',
+  'procedure DoOdd(v: jsvalue);',
+  'begin',
+  'end;',
   'procedure DoIt(f: TFunc);',
   'begin',
   '  DoIt(function(b:word): word',
@@ -4075,6 +4080,7 @@ begin
   '      Result:=1+b;',
   '    end);',
   '  DoMore(procedure begin end, procedure begin end);',
+  '  DoOdd(procedure begin end);',
   'end;',
   'begin',
   '  DoMore(procedure begin end,',
@@ -4087,6 +4093,8 @@ begin
     LinesToStr([ // statements
     'this.DoMore = function (f, g) {',
     '};',
+    'this.DoOdd = function (v) {',
+    '};',
     'this.DoIt = function (f) {',
     '  $mod.DoIt(function (b) {',
     '    var Result = 0;',
@@ -4096,6 +4104,8 @@ begin
     '  $mod.DoMore(function () {',
     '  }, function () {',
     '  });',
+    '  $mod.DoOdd(function () {',
+    '  });',
     '};',
     '']),
     LinesToStr([
@@ -4437,6 +4447,14 @@ begin
   StartProgram(false);
   Add([
   'type TMyEnum = (Red, Green);',
+  'procedure DoIt(var e: TMyEnum; var i: word);',
+  'var',
+  '  v: longint;',
+  '  s: string;',
+  'begin',
+  '  val(s,e,v);',
+  '  val(s,e,i);',
+  'end;',
   'var',
   '  e: TMyEnum;',
   '  i: longint;',
@@ -4466,6 +4484,7 @@ begin
   '  str(red,s);',
   '  s:=str(e:3);',
   '  writestr(s,e:3,red);',
+  '  val(s,e,i);',
   '  e:=TMyEnum(i);',
   '  i:=longint(e);']);
   ConvertProgram;
@@ -4477,6 +4496,14 @@ begin
     '  "1":"Green",',
     '  Green:1',
     '  };',
+    'this.DoIt = function (e, i) {',
+    '  var v = 0;',
+    '  var s = "";',
+    '  e.set(rtl.valEnum(s, $mod.TMyEnum, function (w) {',
+    '    v = w;',
+    '  }));',
+    '  e.set(rtl.valEnum(s, $mod.TMyEnum, i.set));',
+    '};',
     'this.e = 0;',
     'this.i = 0;',
     'this.s = "";',
@@ -4506,6 +4533,9 @@ begin
     '$mod.s = $mod.TMyEnum[$mod.TMyEnum.Red];',
     '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3);',
     '$mod.s = rtl.spaceLeft($mod.TMyEnum[$mod.e], 3)+$mod.TMyEnum[$mod.TMyEnum.Red];',
+    '$mod.e = rtl.valEnum($mod.s, $mod.TMyEnum, function (v) {',
+    '  $mod.i = v;',
+    '});',
     '$mod.e=$mod.i;',
     '$mod.i=$mod.e;',
     '']));
@@ -6349,6 +6379,8 @@ begin
   '  s:=#$20AC;', // euro
   '  s:=#$10437;', // outside BMP
   '  s:=default(string);',
+  '  s:=concat(s);',
+  '  s:=concat(s,''a'',s)',
   '']);
   ConvertProgram;
   CheckSource('TestStringConst',
@@ -6365,8 +6397,10 @@ begin
     '$mod.s=''"\''"'';',
     '$mod.s="€";',
     '$mod.s="'#$F0#$90#$90#$B7'";',
-    '$mod.s="";'
-    ]));
+    '$mod.s="";',
+    '$mod.s = $mod.s;',
+    '$mod.s = $mod.s.concat("a", $mod.s);',
+    '']));
 end;
 
 procedure TTestModule.TestStringConstSurrogate;
@@ -13828,27 +13862,28 @@ end;
 procedure TTestModule.TestExternalClass_Property;
 begin
   StartProgram(false);
-  Add('{$modeswitch externalclass}');
-  Add('type');
-  Add('  TExtA = class external name ''ExtA''');
-  Add('    function getYear: longint;');
-  Add('    procedure setYear(Value: longint);');
-  Add('    property Year: longint read getyear write setyear;');
-  Add('  end;');
-  Add('  TExtB = class (TExtA)');
-  Add('    procedure OtherSetYear(Value: longint);');
-  Add('    property year write othersetyear;');
-  Add('  end;');
-  Add('procedure textb.othersetyear(value: longint);');
-  Add('begin');
-  Add('  setYear(Value+4);');
-  Add('end;');
-  Add('var');
-  Add('  A: texta;');
-  Add('  B: textb;');
-  Add('begin');
-  Add('  a.year:=a.year+1;');
-  Add('  b.year:=b.year+2;');
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '    function getYear: longint;',
+  '    procedure setYear(Value: longint);',
+  '    property Year: longint read getyear write setyear;',
+  '  end;',
+  '  TExtB = class (TExtA)',
+  '    procedure OtherSetYear(Value: longint);',
+  '    property year write othersetyear;',
+  '  end;',
+  'procedure textb.othersetyear(value: longint);',
+  'begin',
+  '  setYear(Value+4);',
+  'end;',
+  'var',
+  '  A: texta;',
+  '  B: textb;',
+  'begin',
+  '  a.year:=a.year+1;',
+  '  b.year:=b.year+2;']);
   ConvertProgram;
   CheckSource('TestExternalClass_NonExternalOverride',
     LinesToStr([ // statements
@@ -13870,6 +13905,62 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExternalClass_PropertyDate;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '  end;',
+  '  TExtB = class (TExtA)',
+  '    FDate: string;',
+  '    property Date: string read FDate write FDate;',
+  '    property ExtA: string read FDate write FDate;',
+  '  end;',
+  '  {$M+}',
+  '  TObject = class',
+  '    FDate: string;',
+  '  published',
+  '    property Date: string read FDate write FDate;',
+  '    property ExtA: string read FDate write FDate;',
+  '  end;',
+  'var',
+  '  B: textb;',
+  '  o: TObject;',
+  'begin',
+  '  b.date:=b.exta;',
+  '  o.date:=o.exta;']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_PropertyDate',
+    LinesToStr([ // statements
+    'rtl.createClassExt($mod, "TExtB", ExtA, "", function () {',
+    '  this.$init = function () {',
+    '    this.FDate = "";',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FDate = "";',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("FDate", rtl.string);',
+    '  $r.addProperty("Date", 0, rtl.string, "FDate", "FDate");',
+    '  $r.addProperty("ExtA", 0, rtl.string, "FDate", "FDate");',
+    '});',
+    'this.B = null;',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.B.FDate = $mod.B.FDate;',
+    '$mod.o.FDate = $mod.o.FDate;',
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_ClassProperty;
 begin
   StartProgram(false);

packages/pastojs/tests/tcprecompile.pas

@@ -552,7 +552,7 @@ begin
   ExpectedSrc:=LinesToStr([
     UTF8BOM+'rtl.module("system",[],function () {',
     '  "use strict";',
-    '  rtl.checkVersion(10101);',
+    '  rtl.checkVersion(10301);',
     '  var $mod = this;',
     '});']);
   if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then

packages/pastojs/tests/tcunitsearch.pas

@@ -209,7 +209,7 @@ procedure TCustomTestCLI.SetWorkDir(const AValue: string);
 var
   NewValue: String;
 begin
-  NewValue:=IncludeTrailingPathDelimiter(ResolveDots(AValue));
+  NewValue:=IncludeTrailingPathDelimiter(ExpandFileNamePJ(ResolveDots(AValue)));
   if FWorkDir=NewValue then Exit;
   FWorkDir:=NewValue;
 end;
@@ -228,6 +228,7 @@ begin
   CompilerExe:='/usr/bin/pas2js';
   {$ENDIF}
   FCompiler:=TTestCompiler.Create;
+  //FCompiler.ConfigSupport:=TPas2JSFileConfigSupport.Create(FCompiler);
   Compiler.Log.OnLog:=@DoLog;
   Compiler.FileCache.OnReadDirectory:=@OnReadDirectory;
   Compiler.FileCache.OnReadFile:=@OnReadFile;

packages/pastojs/tests/testpas2js.lpi

@@ -76,6 +76,7 @@
       <Unit9>
         <Filename Value="tcunitsearch.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCUnitSearch"/>
       </Unit9>
       <Unit10>
         <Filename Value="tcprecompile.pas"/>

packages/rtl-console/src/unix/keyboard.pp

@@ -96,6 +96,12 @@ const KbShiftUp    = $f0;
       KbShiftDown  = $f3;
       KbShiftHome  = $f4;
       KbShiftEnd   = $f5;
+      KbCtrlShiftUp    = $f6;
+      KbCtrlShiftDown  = $f7;
+      KbCtrlShiftRight = $f8;
+      KbCtrlShiftLeft  = $f9;
+      KbCtrlShiftHome  = $fa;
+      KbCtrlShiftEnd   = $fb;
 
       double_esc_hack_enabled : boolean = false;
 
@@ -494,7 +500,7 @@ const
     MouseEvent.buttons := 0;
     PutMouseEvent(MouseEvent);
   end;
-  
+
   procedure GenMouseEvent;
   var MouseEvent: TMouseEvent;
       ch : char;
@@ -869,7 +875,7 @@ type  key_sequence=packed record
         st:string[7];
       end;
 
-const key_sequences:array[0..289] of key_sequence=(
+const key_sequences:array[0..297] of key_sequence=(
        (char:0;scan:kbAltA;st:#27'A'),
        (char:0;scan:kbAltA;st:#27'a'),
        (char:0;scan:kbAltB;st:#27'B'),
@@ -1136,6 +1142,15 @@ const key_sequences:array[0..289] of key_sequence=(
        (char:0;scan:kbShiftHome;st:#27'[1;2H'),  {xterm}
        (char:0;scan:kbShiftHome;st:#27'[7$'),    {rxvt}
 
+       (char:0;scan:KbCtrlShiftUp;st:#27'[1;6A'),    {xterm}
+       (char:0;scan:KbCtrlShiftDown;st:#27'[1;6B'),  {xterm}
+       (char:0;scan:KbCtrlShiftRight;st:#27'[1;6C'), {xterm, xfce4}
+       (char:0;scan:KbCtrlShiftLeft;st:#27'[1;6D'),  {xterm, xfce4}
+       (char:0;scan:KbCtrlShiftHome;st:#27'[1;6H'),  {xterm}
+       (char:0;scan:KbCtrlShiftEnd;st:#27'[1;6F'),   {xterm}
+
+       (char:0;scan:kbCtrlPgDn;st:#27'[6;5~'),   {xterm}
+       (char:0;scan:kbCtrlPgUp;st:#27'[5;5~'),   {xterm}
        (char:0;scan:kbCtrlUp;st:#27'[1;5A'),     {xterm}
        (char:0;scan:kbCtrlDown;st:#27'[1;5B'),   {xterm}
        (char:0;scan:kbCtrlRight;st:#27'[1;5C'),  {xterm}
@@ -1304,7 +1319,7 @@ begin
               {This is the same hack as in findsequence; see findsequence for
                explanation.}
               ch:=ttyrecvchar;
-              {Alt+O cannot be used in this situation, it can be a function key.} 
+              {Alt+O cannot be used in this situation, it can be a function key.}
               if not(ch in ['a'..'z','A'..'N','P'..'Z','0'..'9','-','+','_','=']) then
                 begin
                   if intail=0 then
@@ -1361,11 +1376,11 @@ begin
         end
       else
         RestoreArray;
-   end
+   end;
 {$ifdef logging}
        writeln(f);
 {$endif logging}
-    ;
+
   ReadKey:=PopKey;
 End;
 
@@ -1541,6 +1556,8 @@ const
     kbAltDown,kbAltPgDn,kbAltIns,kbAltDel);
   ShiftArrow : array [kbShiftUp..kbShiftEnd] of byte =
    (kbUp,kbLeft,kbRight,kbDown,kbHome,kbEnd);
+  CtrlShiftArrow : array [kbCtrlShiftUp..kbCtrlShiftEnd] of byte =
+   (kbCtrlUp,kbCtrlDown,kbCtrlRight,kbCtrlLeft,kbCtrlHome,kbCtrlEnd);
 
 var
   MyScan:byte;
@@ -1601,10 +1618,17 @@ begin {main}
             kbF11..KbF12 : { sF11-sF12 }
               MyScan:=MyScan+kbShiftF11-kbF11;
           end;
-        if myscan in [kbShiftUp..kbShiftEnd] then
+        if myscan in [kbShiftUp..kbCtrlShiftEnd] then
           begin
-            myscan:=ShiftArrow[myscan];
-            sstate:=sstate or kbshift;
+            if myscan <= kbShiftEnd then
+            begin
+               myscan:=ShiftArrow[myscan];
+               sstate:=sstate or kbshift;
+            end else
+            begin
+               myscan:=CtrlShiftArrow[myscan];
+               sstate:=sstate or kbshift or kbCtrl;
+            end;
           end;
         if myscan=kbAltBack then
           sstate:=sstate or kbalt;

packages/rtl-extra/src/inc/objects.pp

@@ -35,6 +35,14 @@
 {                                                          }
 UNIT Objects;
 
+{$ifdef cpullvm}
+{$define TYPED_LOCAL_CALLBACKS}
+{$endif}
+
+{$ifdef TYPED_LOCAL_CALLBACKS}
+{$modeswitch nestedprocvars}
+{$endif}
+
 {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
                                   INTERFACE
 {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
@@ -125,6 +133,24 @@ CONST
 {                          PUBLIC TYPE DEFINITIONS                          }
 {***************************************************************************}
 
+{ Callbacks }
+TYPE
+{$ifndef TYPED_LOCAL_CALLBACKS}
+   TCallbackFun = CodePointer;
+   TCallbackProc = CodePointer;
+   TCallbackFunParam = CodePointer;
+   TCallbackFunBool = CodePointer;
+   TCallbackFunBoolParam = CodePointer;
+   TCallbackProcParam = CodePointer;
+{$else}
+   TCallbackFun = Function: Pointer is nested;
+   TCallbackProc = Procedure is nested;
+   TCallbackFunParam = Function(Item: Pointer): Pointer is nested;
+   TCallbackFunBool = Function: Boolean is nested;
+   TCallbackFunBoolParam = Function(Item: Pointer): Boolean is nested;
+   TCallbackProcParam = Procedure(Item: Pointer) is nested;
+{$endif}
+
 {---------------------------------------------------------------------------}
 {                               CHARACTER SET                               }
 {---------------------------------------------------------------------------}
@@ -412,8 +438,8 @@ TYPE
       FUNCTION At (Index: Sw_Integer): Pointer;
       FUNCTION IndexOf (Item: Pointer): Sw_Integer;                  Virtual;
       FUNCTION GetItem (Var S: TStream): Pointer;                    Virtual;
-      FUNCTION LastThat (Test: CodePointer): Pointer;
-      FUNCTION FirstThat (Test: CodePointer): Pointer;
+      FUNCTION LastThat (Test: TCallbackFunBoolParam): Pointer;
+      FUNCTION FirstThat (Test: TCallbackFunBoolParam): Pointer;
       PROCEDURE Pack;
       PROCEDURE FreeAll;
       PROCEDURE DeleteAll;
@@ -423,7 +449,7 @@ TYPE
       PROCEDURE AtFree (Index: Sw_Integer);
       PROCEDURE FreeItem (Item: Pointer);                            Virtual;
       PROCEDURE AtDelete (Index: Sw_Integer);
-      PROCEDURE ForEach (Action: CodePointer);
+      PROCEDURE ForEach (Action: TCallbackProcParam);
       PROCEDURE SetLimit (ALimit: Sw_Integer);                       Virtual;
       PROCEDURE Error (Code, Info: Integer);                         Virtual;
       PROCEDURE AtPut (Index: Sw_Integer; Item: Pointer);
@@ -602,9 +628,14 @@ function CallPointerMethod(Method: codepointer; Obj: pointer; Param1: pointer):
   Func     Pointer to the local function (which must be far-coded).
   Frame    Frame pointer of the wrapping function.
 }
-
-function CallVoidLocal(Func: codepointer; Frame: Pointer): pointer;inline;
-function CallPointerLocal(Func: codepointer; Frame: Pointer; Param1: pointer): pointer;inline;
+function CallVoidLocal(Func: TCallbackFun; Frame: Pointer): pointer;inline;
+function CallPointerLocal(Func: TCallbackFunParam; Frame: Pointer; Param1: pointer): pointer;inline;
+{$ifdef TYPED_LOCAL_CALLBACKS}
+function CallVoidLocal(Func: TCallbackProc; Frame: Pointer): pointer;inline;
+function CallPointerLocal(Func: TCallbackProcParam; Frame: Pointer; Param1: pointer): pointer;inline;
+function CallVoidLocal(Func: TCallbackFunBool; Frame: Pointer): Boolean;inline;
+function CallPointerLocal(Func: TCallbackFunBoolParam; Frame: Pointer; Param1: pointer): Boolean;inline;
+{$endif}
 
 { Calls of functions/procedures local to methods.
 
@@ -612,8 +643,14 @@ function CallPointerLocal(Func: codepointer; Frame: Pointer; Param1: pointer): p
   Frame    Frame pointer of the wrapping method.
   Obj      Pointer to the object that the method belongs to.
 }
-function CallVoidMethodLocal(Func: codepointer; Frame: Pointer; Obj: pointer): pointer;inline;
-function CallPointerMethodLocal(Func: codepointer; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+function CallVoidMethodLocal(Func: TCallbackFun; Frame: Pointer; Obj: pointer): pointer;inline;
+function CallPointerMethodLocal(Func: TCallbackFunParam; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+{$ifdef TYPED_LOCAL_CALLBACKS}
+function CallVoidMethodLocal(Func: TCallbackFunBool; Frame: Pointer; Obj: pointer): Boolean;inline;
+function CallPointerMethodLocal(Func: TCallbackFunBoolParam; Frame: Pointer; Obj: pointer; Param1: pointer): Boolean;inline;
+function CallVoidMethodLocal(Func: TCallbackProc; Frame: Pointer; Obj: pointer): pointer;inline;
+function CallPointerMethodLocal(Func: TCallbackProcParam; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+{$endif}
 
 
 {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
@@ -795,7 +832,7 @@ end;
 {$error CallPointerMethod function not implemented}
 {$endif not FPC_CallPointerMethod_Implemented}
 
-
+{$ifndef TYPED_LOCAL_CALLBACKS}
 function CallVoidLocal(Func: codepointer; Frame: Pointer): pointer;inline;
 begin
 {$ifdef cpui8086}
@@ -835,8 +872,83 @@ begin
 {$endif cpui8086}
 end;
 
+{$else}
+
+function CallVoidLocal(Func: TCallbackFun; Frame: Pointer): pointer;inline;
+begin
+  CallVoidLocal:=Func();
+end;
+
+
+function CallVoidLocal(Func: TCallbackProc; Frame: Pointer): pointer;inline;
+begin
+  Func();
+  CallVoidLocal:=nil;
+end;
 
 
+function CallVoidLocal(Func: TCallbackFunBool; Frame: Pointer): boolean;inline;
+begin
+  CallVoidLocal:=Func();
+end;
+
+function CallPointerLocal(Func: TCallbackFunParam; Frame: Pointer; Param1: pointer): pointer;inline;
+begin
+  CallPointerLocal:=Func(Param1);
+end;
+
+
+function CallPointerLocal(Func: TCallbackProcParam; Frame: Pointer; Param1: pointer): pointer;inline;
+begin
+  Func(Param1);
+  CallPointerLocal:=nil;
+end;
+
+
+function CallPointerLocal(Func: TCallbackFunBoolParam; Frame: Pointer; Param1: pointer): boolean;inline;
+begin
+  CallPointerLocal:=Func(Param1);
+end;
+
+
+function CallVoidMethodLocal(Func: TCallbackFun; Frame: Pointer; Obj: pointer): pointer;inline;
+begin
+  CallVoidMethodLocal := Func();
+end;
+
+
+function CallVoidMethodLocal(Func: TCallbackFunBool; Frame: Pointer; Obj: pointer): Boolean;inline;
+begin
+  CallVoidMethodLocal := Func();
+end;
+
+
+function CallVoidMethodLocal(Func: TCallbackProc; Frame: Pointer; Obj: pointer): pointer;inline;
+begin
+  Func();
+  CallVoidMethodLocal := nil;
+end;
+
+
+function CallPointerMethodLocal(Func: TCallbackFunParam; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+begin
+  CallPointerMethodLocal := Func(Param1);
+end;
+
+
+function CallPointerMethodLocal(Func: TCallbackFunBoolParam; Frame: Pointer; Obj: pointer; Param1: pointer): Boolean;inline;
+begin
+  CallPointerMethodLocal := Func(Param1);
+end;
+
+
+function CallPointerMethodLocal(Func: TCallbackProcParam; Frame: Pointer; Obj: pointer; Param1: pointer): pointer;inline;
+begin
+  Func(Param1);
+  CallPointerMethodLocal := nil;
+end;
+
+{$endif}
 
 {***************************************************************************}
 {                      PRIVATE INITIALIZED VARIABLES                        }
@@ -1934,7 +2046,7 @@ END;
 {$PUSH}
 {$W+}
 
-FUNCTION TCollection.LastThat (Test: CodePointer): Pointer;
+FUNCTION TCollection.LastThat (Test: TCallbackFunBoolParam): Pointer;
 VAR I: LongInt;
 
 BEGIN
@@ -1963,7 +2075,7 @@ END;
 {--TCollection--------------------------------------------------------------}
 {  FirstThat -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB            }
 {---------------------------------------------------------------------------}
-FUNCTION TCollection.FirstThat (Test: CodePointer): Pointer;
+FUNCTION TCollection.FirstThat (Test: TCallbackFunBoolParam): Pointer;
 VAR I: LongInt;
 BEGIN
    For I := 1 To Count Do Begin                       { Up from first item }
@@ -2092,7 +2204,7 @@ END;
 
 {$PUSH}
 {$W+}
-PROCEDURE TCollection.ForEach (Action: CodePointer);
+PROCEDURE TCollection.ForEach (Action: TCallbackProcParam);
 VAR I: LongInt;
 BEGIN
    For I := 1 To Count Do                             { Up from first item }
@@ -2675,7 +2787,9 @@ END;
 FUNCTION TResourceFile.SwitchTo (AStream: PStream; Pack: Boolean): PStream;
 VAR NewBasePos: LongInt;
 
-   PROCEDURE DoCopyResource (Item: PResourceItem);{$IFNDEF FPC}FAR;{$ENDIF}
+   PROCEDURE DoCopyResource (_Item: Pointer);{$IFNDEF FPC}FAR;{$ENDIF}
+   var
+     Item: PResourceItem absolute _Item;
    BEGIN
      Stream^.Seek(BasePos + Item^.Posn);              { Move stream position }
      Item^.Posn := AStream^.GetPos - NewBasePos;      { Hold new position }

packages/sqlite/examples/myext.lpi

@@ -0,0 +1,66 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <Title Value="myext"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1" Active="Default">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="myext.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="myext"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <RelocatableUnit Value="True"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <ExecutableType Value="Library"/>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/sqlite/examples/myext.pp

@@ -0,0 +1,49 @@
+library myext;
+
+{$mode objfpc}{$h+}
+
+uses
+  sysutils,
+  ctypes,
+  sqlite3,
+  sqlite3ext;
+
+procedure mysum(ctx: psqlite3_context; n: cint; v: ppsqlite3_value); cdecl;
+var
+  a, b, r: cint;
+begin
+  a := sqlite3_value_int(v[0]);
+  b := sqlite3_value_int(v[1]);
+  r := a + b;
+  sqlite3_result_int(ctx, r);
+end;
+
+procedure myconcat(ctx: psqlite3_context; n: cint; v: ppsqlite3_value); cdecl;
+var
+  a, b, r: ansistring;
+begin
+  a := sqlite3_value_text(v[0]);
+  b := sqlite3_value_text(v[1]);
+  r := a + b;
+  sqlite3_result_text(ctx, @r[1], length(r), nil);
+end;
+
+function sqlite3_extension_init(db: Psqlite3; pzErrMsg: Ppcchar;
+  const pApi: Psqlite3_api_routines): cint; cdecl; export;
+var
+  rc: cint;
+begin
+  SQLITE_EXTENSION_INIT2(pApi);
+  rc := sqlite3_create_function(db, 'mysum', 2, SQLITE_UTF8, nil,
+    @mysum, nil, nil);
+  if rc = SQLITE_OK then
+    Result := sqlite3_create_function(db, 'myconcat', 2, SQLITE_UTF8, nil,
+      @myconcat, nil, nil);
+  Result := rc;
+end;
+
+exports
+  sqlite3_extension_init;
+
+begin
+end.

packages/sqlite/fpmake.pp

@@ -47,7 +47,9 @@ begin
           AddUnit('sqlite');
         end;
     T:=P.Targets.AddUnit('sqlite.pp');
-
+    T:=P.Targets.AddUnit('sqlite3ext.pp');
+      T.Dependencies.AddUnit('sqlite');
+ 
     P.ExamplePath.Add('tests/');
     P.Targets.AddExampleProgram('testapiv3x.pp');
     P.Targets.AddExampleProgram('test.pas');

packages/sqlite/src/sqlite3ext.pp

@@ -0,0 +1,313 @@
+{
+  This file is part of the Free Pascal Classes Library (FCL).
+  Copyright (C) 2018 Silvio Clecio (silvioprog) member of
+  the Free Pascal development team.
+
+  This unit file defines the SQLite interface for use by
+  shared libraries that want to be imported as extensions
+  into a SQLite instance.
+
+  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 SQLite3Ext;
+
+{$mode objfpc}{$h+}
+
+interface
+
+uses
+  ctypes,
+  sqlite3;
+
+{$packrecords c}
+
+type
+  Ppcchar = ^pcchar;
+  PPpcchar = ^Ppcchar;
+  va_list = type Pointer;
+
+  xCallback = function (_para1:cunsigned; _para2:pointer; _para3:pointer; _para4:pointer):cint;cdecl;
+
+  Psqlite3_api_routines = ^sqlite3_api_routines;
+  (*
+  ** The following structure holds pointers to all of the SQLite API
+  ** routines.
+  **
+  ** WARNING:  In order to maintain backwards compatibility, add new
+  ** interfaces to the end of this structure only.  If you insert new
+  ** interfaces in the middle of this structure, then older different
+  ** versions of SQLite will not be able to load each other's shared
+  ** libraries!
+  *)
+  sqlite3_api_routines = record
+      aggregate_context : function (_para1:Psqlite3_context; nBytes:cint):pointer;cdecl;
+      aggregate_count : function (_para1:Psqlite3_context):cint;cdecl;
+      bind_blob : function (_para1:Psqlite3_stmt; _para2:cint; _para3:pointer; n:cint; _para5:sqlite3_destructor_type):cint;cdecl;
+      bind_double : function (_para1:Psqlite3_stmt; _para2:cint; _para3:double):cint;cdecl;
+      bind_int : function (_para1:Psqlite3_stmt; _para2:cint; _para3:cint):cint;cdecl;
+      bind_int64 : function (_para1:Psqlite3_stmt; _para2:cint; _para3:sqlite_int64):cint;cdecl;
+      bind_null : function (_para1:Psqlite3_stmt; _para2:cint):cint;cdecl;
+      bind_parameter_count : function (_para1:Psqlite3_stmt):cint;cdecl;
+      bind_parameter_index : function (_para1:Psqlite3_stmt; zName:pcchar):cint;cdecl;
+      bind_parameter_name : function (_para1:Psqlite3_stmt; _para2:cint):pcchar;cdecl;
+      bind_text : function (_para1:Psqlite3_stmt; _para2:cint; _para3:pcchar; n:cint; _para5:sqlite3_destructor_type):cint;cdecl;
+      bind_text16 : function (_para1:Psqlite3_stmt; _para2:cint; _para3:pointer; _para4:cint; _para5:sqlite3_destructor_type):cint;cdecl;
+      bind_value : function (_para1:Psqlite3_stmt; _para2:cint; _para3:Psqlite3_value):cint;cdecl;
+      busy_handler : function (_para1:Psqlite3; _para2:busyhandler_callback; _para3:pointer):cint;cdecl;
+      busy_timeout : function (_para1:Psqlite3; ms:cint):cint;cdecl;
+      changes : function (_para1:Psqlite3):cint;cdecl;
+      close : function (_para1:Psqlite3):cint;cdecl;
+      collation_needed : function (_para1:Psqlite3; _para2:pointer; _para3:collation_needed_cb):cint;cdecl;
+      collation_needed16 : function (_para1:Psqlite3; _para2:pointer; _para3:collation_needed_cb):cint;cdecl;
+      column_blob : function (_para1:Psqlite3_stmt; iCol:cint):pointer;cdecl;
+      column_bytes : function (_para1:Psqlite3_stmt; iCol:cint):cint;cdecl;
+      column_bytes16 : function (_para1:Psqlite3_stmt; iCol:cint):cint;cdecl;
+      column_count : function (pStmt:Psqlite3_stmt):cint;cdecl;
+      column_database_name : function (_para1:Psqlite3_stmt; _para2:cint):pcchar;cdecl;
+      column_database_name16 : function (_para1:Psqlite3_stmt; _para2:cint):pointer;cdecl;
+      column_decltype : function (_para1:Psqlite3_stmt; i:cint):pcchar;cdecl;
+      column_decltype16 : function (_para1:Psqlite3_stmt; _para2:cint):pointer;cdecl;
+      column_double : function (_para1:Psqlite3_stmt; iCol:cint):double;cdecl;
+      column_int : function (_para1:Psqlite3_stmt; iCol:cint):cint;cdecl;
+      column_int64 : function (_para1:Psqlite3_stmt; iCol:cint):sqlite_int64;cdecl;
+      column_name : function (_para1:Psqlite3_stmt; _para2:cint):pcchar;cdecl;
+      column_name16 : function (_para1:Psqlite3_stmt; _para2:cint):pointer;cdecl;
+      column_origin_name : function (_para1:Psqlite3_stmt; _para2:cint):pcchar;cdecl;
+      column_origin_name16 : function (_para1:Psqlite3_stmt; _para2:cint):pointer;cdecl;
+      column_table_name : function (_para1:Psqlite3_stmt; _para2:cint):pcchar;cdecl;
+      column_table_name16 : function (_para1:Psqlite3_stmt; _para2:cint):pointer;cdecl;
+      column_text : function (_para1:Psqlite3_stmt; iCol:cint):pcuchar;cdecl;
+      column_text16 : function (_para1:Psqlite3_stmt; iCol:cint):pointer;cdecl;
+      column_type : function (_para1:Psqlite3_stmt; iCol:cint):cint;cdecl;
+      column_value : function (_para1:Psqlite3_stmt; iCol:cint):Psqlite3_value;cdecl;
+      commit_hook : function (_para1:Psqlite3; _para2:commit_callback; _para3:pointer):pointer;cdecl;
+      complete : function (sql:pcchar):cint;cdecl;
+      complete16 : function (sql:pointer):cint;cdecl;
+      create_collation : function (_para1:Psqlite3; _para2:pcchar; _para3:cint; _para4:pointer; _para5:xCompare):cint;cdecl;
+      create_collation16 : function (_para1:Psqlite3; _para2:pointer; _para3:cint; _para4:pointer; _para5:xCompare):cint;cdecl;
+      create_function : function (_para1:Psqlite3; _para2:pcchar; _para3:cint; _para4:cint; _para5:pointer; 
+                   xFunc:xFunc; xStep:xStep; xFinal:xFinal):cint;cdecl;
+      create_function16 : function (_para1:Psqlite3; _para2:pointer; _para3:cint; _para4:cint; _para5:pointer; 
+                   xFunc:xFunc; xStep:xStep; xFinal:xFinal):cint;cdecl;
+      create_module : function (_para1:Psqlite3; _para2:pcchar; _para3:Psqlite3_module; _para4:pointer):cint;cdecl;
+      data_count : function (pStmt:Psqlite3_stmt):cint;cdecl;
+      db_handle : function (_para1:Psqlite3_stmt):Psqlite3;cdecl;
+      declare_vtab : function (_para1:Psqlite3; _para2:pcchar):cint;cdecl;
+      enable_shared_cache : function (_para1:cint):cint;cdecl;
+      errcode : function (db:Psqlite3):cint;cdecl;
+      errmsg : function (_para1:Psqlite3):pcchar;cdecl;
+      errmsg16 : function (_para1:Psqlite3):pointer;cdecl;
+      exec : function (_para1:Psqlite3; _para2:pcchar; _para3:sqlite3_callback; _para4:pointer; _para5:Ppcchar):cint;cdecl;
+      expired : function (_para1:Psqlite3_stmt):cint;cdecl;
+      finalize : function (pStmt:Psqlite3_stmt):cint;cdecl;
+      free : procedure;cdecl;
+      free_table : procedure (result:Ppcchar);cdecl;
+      get_autocommit : function (_para1:Psqlite3):cint;cdecl;
+      get_auxdata : function (_para1:Psqlite3_context; _para2:cint):pointer;cdecl;
+      get_table : function (_para1:Psqlite3; _para2:pcchar; _para3:PPpcchar; _para4:pcint; _para5:pcint; 
+                   _para6:Ppcchar):cint;cdecl;
+      global_recover : function :cint;cdecl;
+      interruptx : procedure (_para1:Psqlite3);cdecl;
+      last_insert_rowid : function (_para1:Psqlite3):sqlite_int64;cdecl;
+      libversion : function :pcchar;cdecl;
+      libversion_number : function :cint;cdecl;
+      malloc : function (_para1:cint):pointer;cdecl;
+      mprintf : function (_para1:pcchar; args:array of const):pcchar;cdecl;
+      open : function (_para1:pcchar; _para2:PPsqlite3):cint;cdecl;
+      open16 : function (_para1:pointer; _para2:PPsqlite3):cint;cdecl;
+      prepare : function (_para1:Psqlite3; _para2:pcchar; _para3:cint; _para4:PPsqlite3_stmt; _para5:Ppcchar):cint;cdecl;
+      prepare16 : function (_para1:Psqlite3; _para2:pointer; _para3:cint; _para4:PPsqlite3_stmt; _para5:Ppointer):cint;cdecl;
+      profile : function (_para1:Psqlite3; _para2:xProfile; _para3:pointer):pointer;cdecl;
+      progress_handler : procedure (_para1:Psqlite3; _para2:cint; _para3:commit_callback; _para4:pointer);cdecl;
+      realloc : function:pointer;cdecl;
+      reset : function (pStmt:Psqlite3_stmt):cint;cdecl;
+      result_blob : procedure (_para1:Psqlite3_context; _para2:pointer; _para3:cint; _para4:sqlite3_destructor_type);cdecl;
+      result_double : procedure (_para1:Psqlite3_context; _para2:double);cdecl;
+      result_error : procedure (_para1:Psqlite3_context; _para2:pcchar; _para3:cint);cdecl;
+      result_error16 : procedure (_para1:Psqlite3_context; _para2:pointer; _para3:cint);cdecl;
+      result_int : procedure (_para1:Psqlite3_context; _para2:cint);cdecl;
+      result_int64 : procedure (_para1:Psqlite3_context; _para2:sqlite_int64);cdecl;
+      result_null : procedure (_para1:Psqlite3_context);cdecl;
+      result_text : procedure (_para1:Psqlite3_context; _para2:pcchar; _para3:cint; _para4:sqlite3_destructor_type);cdecl;
+      result_text16 : procedure (_para1:Psqlite3_context; _para2:pointer; _para3:cint; _para4:sqlite3_destructor_type);cdecl;
+      result_text16be : procedure (_para1:Psqlite3_context; _para2:pointer; _para3:cint; _para4:sqlite3_destructor_type);cdecl;
+      result_text16le : procedure (_para1:Psqlite3_context; _para2:pointer; _para3:cint; _para4:sqlite3_destructor_type);cdecl;
+      result_value : procedure (_para1:Psqlite3_context; _para2:Psqlite3_value);cdecl;
+      rollback_hook : function (_para1:Psqlite3; _para2:sqlite3_destructor_type; _para3:pointer):pointer;cdecl;
+      set_authorizer : function (_para1:Psqlite3; _para2:xAuth; _para3:pointer):cint;cdecl;
+      set_auxdata : procedure (_para1:Psqlite3_context; _para2:cint; _para3:pointer; _para4:sqlite3_destructor_type);cdecl;
+      xsnprintf : function (_para1:cint; _para2:pcchar; _para3:pcchar; args:array of const):pcchar;cdecl;
+      step : function (_para1:Psqlite3_stmt):cint;cdecl;
+      table_column_metadata : function (_para1:Psqlite3; _para2:pcchar; _para3:pcchar; _para4:pcchar; _para5:Ppcchar; 
+                   _para6:Ppcchar; _para7:pcint; _para8:pcint; _para9:pcint):cint;cdecl;
+      thread_cleanup : procedure ;cdecl;
+      total_changes : function (_para1:Psqlite3):cint;cdecl;
+      trace : function (_para1:Psqlite3; xTrace:xTrace; _para3:pointer):pointer;cdecl;
+      transfer_bindings : function (_para1:Psqlite3_stmt; _para2:Psqlite3_stmt):cint;cdecl;
+      update_hook : function (_para1:Psqlite3; _para2:update_callback; _para3:pointer):pointer;cdecl;
+      user_data : function (_para1:Psqlite3_context):pointer;cdecl;
+      value_blob : function (_para1:Psqlite3_value):pointer;cdecl;
+      value_bytes : function (_para1:Psqlite3_value):cint;cdecl;
+      value_bytes16 : function (_para1:Psqlite3_value):cint;cdecl;
+      value_double : function (_para1:Psqlite3_value):double;cdecl;
+      value_int : function (_para1:Psqlite3_value):cint;cdecl;
+      value_int64 : function (_para1:Psqlite3_value):sqlite_int64;cdecl;
+      value_numeric_type : function (_para1:Psqlite3_value):cint;cdecl;
+      value_text : function (_para1:Psqlite3_value):pcuchar;cdecl;
+      value_text16 : function (_para1:Psqlite3_value):pointer;cdecl;
+      value_text16be : function (_para1:Psqlite3_value):pointer;cdecl;
+      value_text16le : function (_para1:Psqlite3_value):pointer;cdecl;
+      value_type : function (_para1:Psqlite3_value):cint;cdecl;
+      vmprintf : function (_para1:pcchar; _para2:va_list):pcchar;cdecl;
+      overload_function : function (_para1:Psqlite3; zFuncName:pcchar; nArg:cint):cint;cdecl;
+      prepare_v2 : function (_para1:Psqlite3; _para2:pcchar; _para3:cint; _para4:PPsqlite3_stmt; _para5:Ppcchar):cint;cdecl;
+      prepare16_v2 : function (_para1:Psqlite3; _para2:pointer; _para3:cint; _para4:PPsqlite3_stmt; _para5:Ppointer):cint;cdecl;
+      clear_bindings : function (_para1:Psqlite3_stmt):cint;cdecl;
+      create_module_v2 : function (_para1:Psqlite3; _para2:pcchar; _para3:Psqlite3_module; _para4:pointer; xDestroy:sqlite3_destructor_type):cint;cdecl;
+      bind_zeroblob : function (_para1:Psqlite3_stmt; _para2:cint; _para3:cint):cint;cdecl;
+      blob_bytes : function (_para1:Psqlite3_blob):cint;cdecl;
+      blob_close : function (_para1:Psqlite3_blob):cint;cdecl;
+      blob_open : function (_para1:Psqlite3; _para2:pcchar; _para3:pcchar; _para4:pcchar; _para5:sqlite3_int64; 
+                   _para6:cint; _para7:PPsqlite3_blob):cint;cdecl;
+      blob_read : function (_para1:Psqlite3_blob; _para2:pointer; _para3:cint; _para4:cint):cint;cdecl;
+      blob_write : function (_para1:Psqlite3_blob; _para2:pointer; _para3:cint; _para4:cint):cint;cdecl;
+      create_collation_v2 : function (_para1:Psqlite3; _para2:pcchar; _para3:cint; _para4:pointer; _para5:xCompare; 
+                   _para6:sqlite3_destructor_type):cint;cdecl;
+      file_control : function (_para1:Psqlite3; _para2:pcchar; _para3:cint; _para4:pointer):cint;cdecl;
+      memory_highwater : function (_para1:cint):sqlite3_int64;cdecl;
+      memory_used : function :sqlite3_int64;cdecl;
+      mutex_alloc : function (_para1:cint):Psqlite3_mutex;cdecl;
+      mutex_enter : procedure (_para1:Psqlite3_mutex);cdecl;
+      mutex_free : procedure (_para1:Psqlite3_mutex);cdecl;
+      mutex_leave : procedure (_para1:Psqlite3_mutex);cdecl;
+      mutex_try : function (_para1:Psqlite3_mutex):cint;cdecl;
+      open_v2 : function (_para1:pcchar; _para2:PPsqlite3; _para3:cint; _para4:pcchar):cint;cdecl;
+      release_memory : function (_para1:cint):cint;cdecl;
+      result_error_nomem : procedure (_para1:Psqlite3_context);cdecl;
+      result_error_toobig : procedure (_para1:Psqlite3_context);cdecl;
+      sleep : function (_para1:cint):cint;cdecl;
+      soft_heap_limit : procedure (_para1:cint);cdecl;
+      vfs_find : function (_para1:pcchar):Psqlite3_vfs;cdecl;
+      vfs_register : function (_para1:Psqlite3_vfs; _para2:cint):cint;cdecl;
+      vfs_unregister : function (_para1:Psqlite3_vfs):cint;cdecl;
+      xthreadsafe : function :cint;cdecl;
+      result_zeroblob : procedure (_para1:Psqlite3_context; _para2:cint);cdecl;
+      result_error_code : procedure (_para1:Psqlite3_context; _para2:cint);cdecl;
+      test_control : function (_para1:cint; args:array of const):cint;cdecl;
+      randomness : procedure (_para1:cint; _para2:pointer);cdecl;
+      context_db_handle : function (_para1:Psqlite3_context):Psqlite3;cdecl;
+      extended_result_codes : function (_para1:Psqlite3; _para2:cint):cint;cdecl;
+      limit : function (_para1:Psqlite3; _para2:cint; _para3:cint):cint;cdecl;
+      next_stmt : function (_para1:Psqlite3; _para2:Psqlite3_stmt):Psqlite3_stmt;cdecl;
+      sql : function (_para1:Psqlite3_stmt):pcchar;cdecl;
+      status : function (_para1:cint; _para2:pcint; _para3:pcint; _para4:cint):cint;cdecl;
+      backup_finish : function (_para1:Psqlite3backup):cint;cdecl;
+      backup_init : function (_para1:Psqlite3; _para2:pcchar; _para3:Psqlite3; _para4:pcchar):Psqlite3backup;cdecl;
+      backup_pagecount : function (_para1:Psqlite3backup):cint;cdecl;
+      backup_remaining : function (_para1:Psqlite3backup):cint;cdecl;
+      backup_step : function (_para1:Psqlite3backup; _para2:cint):cint;cdecl;
+      compileoption_get : function (_para1:cint):pcchar;cdecl;
+      compileoption_used : function (_para1:pcchar):cint;cdecl;
+      create_function_v2 : function (_para1:Psqlite3; _para2:pcchar; _para3:cint; _para4:cint; _para5:pointer; 
+                   xFunc:xFunc; xStep:xStep; xFinal:xFinal; xDestroy:sqlite3_destructor_type):cint;cdecl;
+      db_config : function (_para1:Psqlite3; _para2:cint; args:array of const):cint;cdecl;
+      db_mutex : function (_para1:Psqlite3):Psqlite3_mutex;cdecl;
+      db_status : function (_para1:Psqlite3; _para2:cint; _para3:pcint; _para4:pcint; _para5:cint):cint;cdecl;
+      extended_errcode : function (_para1:Psqlite3):cint;cdecl;
+      log : procedure (_para1:cint; _para2:pcchar; args:array of const);cdecl;
+      soft_heap_limit64 : function (_para1:sqlite3_int64):sqlite3_int64;cdecl;
+      sourceid : function :pcchar;cdecl;
+      stmt_status : function (_para1:Psqlite3_stmt; _para2:cint; _para3:cint):cint;cdecl;
+      strnicmp : function (_para1:pcchar; _para2:pcchar; _para3:cint):cint;cdecl;
+      unlock_notify : function (_para1:Psqlite3; _para2:xNotifycb; _para3:pointer):cint;cdecl;
+      wal_autocheckpoint : function (_para1:Psqlite3; _para2:cint):cint;cdecl;
+      wal_checkpoint : function (_para1:Psqlite3; _para2:pcchar):cint;cdecl;
+      wal_hook : function (_para1:Psqlite3; _para2:wal_hook_cb; _para3:pointer):pointer;cdecl;
+      blob_reopen : function (_para1:Psqlite3_blob; _para2:sqlite3_int64):cint;cdecl;
+      vtab_config : function (_para1:Psqlite3; op:cint; args:array of const):cint;cdecl;
+      vtab_on_conflict : function (_para1:Psqlite3):cint;cdecl;
+      close_v2 : function (_para1:Psqlite3):cint;cdecl;
+      db_filename : function (_para1:Psqlite3; _para2:pcchar):pcchar;cdecl;
+      db_readonly : function (_para1:Psqlite3; _para2:pcchar):cint;cdecl;
+      db_release_memory : function (_para1:Psqlite3):cint;cdecl;
+      errstr : function (_para1:cint):pcchar;cdecl;
+      stmt_busy : function (_para1:Psqlite3_stmt):cint;cdecl;
+      stmt_readonly : function (_para1:Psqlite3_stmt):cint;cdecl;
+      stricmp : function (_para1:pcchar; _para2:pcchar):cint;cdecl;
+      uri_boolean : function (_para1:pcchar; _para2:pcchar; _para3:cint):cint;cdecl;
+      uri_int64 : function (_para1:pcchar; _para2:pcchar; _para3:sqlite3_int64):sqlite3_int64;cdecl;
+      uri_parameter : function (_para1:pcchar; _para2:pcchar):pcchar;cdecl;
+      xvsnprintf : function (_para1:cint; _para2:pcchar; _para3:pcchar; _para4:va_list):pcchar;cdecl;
+      wal_checkpoint_v2 : function (_para1:Psqlite3; _para2:pcchar; _para3:cint; _para4:pcint; _para5:pcint):cint;cdecl;
+      auto_extension : function (_para1:pointer ):cint;cdecl;
+      bind_blob64 : function (_para1:Psqlite3_stmt; _para2:cint; _para3:pointer; _para4:sqlite3_uint64; _para5:sqlite3_destructor_type):cint;cdecl;
+      bind_text64 : function (_para1:Psqlite3_stmt; _para2:cint; _para3:pcchar; _para4:sqlite3_uint64; _para5:sqlite3_destructor_type; 
+                   _para6:cuchar):cint;cdecl;
+      cancel_auto_extension : function (_para1:pointer ):cint;cdecl;
+      load_extension : function (_para1:Psqlite3; _para2:pcchar; _para3:pcchar; _para4:Ppcchar):cint;cdecl;
+      malloc64 : function (_para1:sqlite3_uint64):pointer;cdecl;
+      msize : function (_para1:pointer):sqlite3_uint64;cdecl;
+      realloc64 : function (_para1:pointer; _para2:sqlite3_uint64):pointer;cdecl;
+      reset_auto_extension : procedure ;cdecl;
+      result_blob64 : procedure (_para1:Psqlite3_context; _para2:pointer; _para3:sqlite3_uint64; _para4:sqlite3_destructor_type);cdecl;
+      result_text64 : procedure (_para1:Psqlite3_context; _para2:pcchar; _para3:sqlite3_uint64; _para4:sqlite3_destructor_type; _para5:cuchar);cdecl;
+      strglob : function (_para1:pcchar; _para2:pcchar):cint;cdecl;
+      value_dup : function (_para1:Psqlite3_value):Psqlite3_value;cdecl;
+      value_free : procedure (_para1:Psqlite3_value);cdecl;
+      result_zeroblob64 : function (_para1:Psqlite3_context; _para2:sqlite3_uint64):cint;cdecl;
+      bind_zeroblob64 : function (_para1:Psqlite3_stmt; _para2:cint; _para3:sqlite3_uint64):cint;cdecl;
+      value_subtype : function (_para1:Psqlite3_value):cuint;cdecl;
+      result_subtype : procedure (_para1:Psqlite3_context; _para2:cuint);cdecl;
+      status64 : function (_para1:cint; _para2:Psqlite3_int64; _para3:Psqlite3_int64; _para4:cint):cint;cdecl;
+      strlike : function (_para1:pcchar; _para2:pcchar; _para3:cuint):cint;cdecl;
+      db_cacheflush : function (_para1:Psqlite3):cint;cdecl;
+      system_errno : function (_para1:Psqlite3):cint;cdecl;
+      trace_v2 : function (_para1:Psqlite3; _para2:cunsigned; _para3:xCallback; _para4:pointer):cint;cdecl;
+      expanded_sql : function (_para1:Psqlite3_stmt):pcchar;cdecl;
+      set_last_insert_rowid : procedure (_para1:Psqlite3; _para2:sqlite3_int64);cdecl;
+      prepare_v3 : function (_para1:Psqlite3; _para2:pcchar; _para3:cint; _para4:cuint; _para5:PPsqlite3_stmt; 
+                   _para6:Ppcchar):cint;cdecl;
+      prepare16_v3 : function (_para1:Psqlite3; _para2:pointer; _para3:cint; _para4:cuint; _para5:PPsqlite3_stmt; 
+                   _para6:Ppointer):cint;cdecl;
+      bind_pointer : function (_para1:Psqlite3_stmt; _para2:cint; _para3:pointer; _para4:pcchar; _para5:sqlite3_destructor_type):cint;cdecl;
+      result_pointer : procedure (_para1:Psqlite3_context; _para2:pointer; _para3:pcchar; _para4:sqlite3_destructor_type);cdecl;
+      value_pointer : function (_para1:Psqlite3_value; _para2:pcchar):pointer;cdecl;
+      vtab_nochange : function (_para1:Psqlite3_context):cint;cdecl;
+      value_nochange : function (_para1:Psqlite3_value):cint;cdecl;
+      vtab_collation : function (_para1:Psqlite3_index_info; _para2:cint):pcchar;cdecl;
+    end;
+
+// These are no-ops.
+procedure SQLITE_EXTENSION_INIT1;
+procedure SQLITE_EXTENSION_INIT3;
+
+// This is actually unnecessary, but is provided for compatibility with sqlite3ext tutorial.
+
+Var
+  sqlite3_api : Psqlite3_api_routines;
+  
+procedure SQLITE_EXTENSION_INIT2(v: Psqlite3_api_routines);
+
+implementation
+
+procedure SQLITE_EXTENSION_INIT1;
+begin
+end;
+
+procedure SQLITE_EXTENSION_INIT2(v: Psqlite3_api_routines);
+begin
+  sqlite3_api:=v;
+end;
+
+procedure SQLITE_EXTENSION_INIT3;
+begin
+
+end;
+
+end.

rtl/inc/llvmintr.inc

@@ -20,3 +20,21 @@ function llvm_frameaddress(level: longint): pointer; compilerproc; external name
 
 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';
+
+function llvm_sqrt_f32(val: single): single; compilerproc; external name 'llvm.sqrt.f32';
+function llvm_sqrt_f64(val: double): double; compilerproc; external name 'llvm.sqrt.f64';
+{$ifdef SUPPORT_EXTENDED}
+function llvm_sqrt_f80(val: extended): extended; compilerproc; external name 'llvm.sqrt.f80';
+{$endif}
+{$ifdef SUPPORT_FLOAT128}
+function llvm_sqrt_f128(val: float128): float128; compilerproc; external name 'llvm.sqrt.f128';
+{$endif}
+
+function llvm_fma_f32(a, b, c: single): single; compilerproc; external name 'llvm.fma.f32';
+function llvm_fma_f64(a, b, c: double): double; compilerproc; external name 'llvm.fma.f64';
+{$ifdef SUPPORT_EXTENDED}
+function llvm_fma_f80(a, b, c: extended): extended; compilerproc; external name 'llvm.fma.f80';
+{$endif}
+{$ifdef SUPPORT_FLOAT128}
+function llvm_fma_f128(a, b, c: float128): float128; compilerproc; external name 'llvm.fma.f128';
+{$endif}

rtl/unix/unix.pp

@@ -914,6 +914,8 @@ var
   pl   : ^cint;
 begin
   AssignStream:=-1;
+  if fpAccess(prog,X_OK)<>0 then
+    exit(-1);
   if AssignPipe(streamin,pipo)=-1 Then
    exit(-1);
   if AssignPipe(pipi,streamout)=-1 Then
@@ -985,7 +987,8 @@ var
   pl: ^cint;
 begin
   AssignStream := -1;
-
+  if fpAccess(prog,X_OK)<>0 then
+    exit(-1);
   // Assign pipes
   if AssignPipe(StreamIn, PipeOut)=-1 Then
    Exit(-1);