2
0
Эх сурвалжийг харах

* synchronised with trunk till r40635

git-svn-id: branches/debug_eh@40636 -
Jonas Maebe 6 жил өмнө
parent
commit
882d676bc9

+ 5 - 0
.gitattributes

@@ -2099,8 +2099,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
@@ -7662,12 +7664,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

+ 2 - 2
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

+ 1 - 1
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

+ 2 - 2
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;

+ 3 - 2
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;

+ 2 - 2
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

+ 4 - 4
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

+ 4 - 4
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;

+ 22 - 2
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;

+ 3 - 3
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

+ 1 - 1
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 }

+ 2 - 2
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

+ 88 - 87
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;
@@ -4624,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
@@ -4773,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));

+ 3 - 3
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:

+ 5 - 10
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;

+ 4 - 2
compiler/ncgutil.pas

@@ -1814,9 +1814,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;

+ 5 - 3
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

+ 1 - 1
compiler/ninl.pas

@@ -4378,7 +4378,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 }

+ 2 - 2
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

+ 19 - 10
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];

+ 18 - 11
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;

+ 2 - 2
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

+ 1 - 1
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;
 

+ 49 - 0
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.

+ 40 - 0
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.

+ 2 - 2
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

+ 1 - 1
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"';
 

+ 3 - 0
packages/pastojs/src/fppas2js.pp

@@ -374,6 +374,9 @@ ToDos:
     - functions
     - rtti
 - bug: DoIt(typeinfo(i))  where DoIt is in another unit and has TTypeInfo
+- $OPTIMIZATION ON|OFF
+- $optimization REMOVEEMPTYPROCS
+- $optimization REMOVEEMPTYPROCS,RemoveNotUsedDeclarations-
 - setlength(dynarray)  modeswitch to not create a copy
 - 'new', 'Function' -> class var use .prototype
 - static arrays

+ 1 - 1
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);

+ 32 - 8
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;

+ 66 - 0
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>

+ 49 - 0
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.

+ 3 - 1
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');

+ 313 - 0
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.

+ 4 - 4
utils/tply/lexbase.pas

@@ -969,7 +969,7 @@ function path(filename : String) : String;
   var i : Integer;
   begin
     i := length(filename);
-    while (i>0) and (filename[i]<>'\') and (filename[i]<>':') do
+    while (i>0) and (filename[i]<>DirectorySeparator) and (filename[i]<>':') do
       dec(i);
     path := copy(filename, 1, i);
   end(*path*);
@@ -985,10 +985,10 @@ function root(filename : String) : String;
             root := copy(filename, 1, i-1);
             exit
           end;
-        '\': exit;
+        DirectorySeparator : exit;
         else
       end;
-  end(*addExt*);
+  end(*root*);
 function addExt(filename, ext : String) : String;
   (* implemented with goto for maximum efficiency *)
   label x;
@@ -999,7 +999,7 @@ function addExt(filename, ext : String) : String;
     for i := length(filename) downto 1 do
       case filename[i] of
         '.' : exit;
-        '\': goto x;
+        DirectorySeparator: goto x;
         else
       end;
     x : addExt := filename+'.'+ext

+ 5 - 1
utils/tply/plex.pas

@@ -597,7 +597,11 @@ var i : Integer;
 
 begin
 {$ifdef Unix}
-  codfilepath1:='/usr/local/lib/fpc/lexyacc/';
+  codfilepath1:=path(paramstr(0));
+  if (codfilepath1<>'') then
+    codfilepath1:=codfilepath1+'../lib/fpc/lexyacc/'
+  else
+    codfilepath1:='/usr/local/lib/fpc/lexyacc/';
   codfilepath2:='/usr/lib/fpc/lexyacc/';
 {$else}
   codfilepath1:=path(paramstr(0));

+ 5 - 1
utils/tply/pyacc.pas

@@ -2375,7 +2375,11 @@ var i : Integer;
 
 begin
 {$ifdef Unix}
-  codfilepath1:='/usr/local/lib/fpc/lexyacc/';
+  codfilepath1:=path(paramstr(0));
+  if (codfilepath1<>'') then
+    codfilepath1:=codfilepath1+'../lib/fpc/lexyacc/'
+  else
+    codfilepath1:='/usr/local/lib/fpc/lexyacc/';
   codfilepath2:='/usr/lib/fpc/lexyacc/';
 {$else}
   codfilepath1:=path(paramstr(0));

+ 5 - 1
utils/tply/pyacc.y

@@ -711,7 +711,11 @@ var i : Integer;
 
 begin
 {$ifdef Unix}
-  codfilepath1:='/usr/local/lib/fpc/lexyacc/';
+  codfilepath1:=path(paramstr(0));
+  if (codfilepath1<>'') then
+    codfilepath1:=codfilepath1+'../lib/fpc/lexyacc/'
+  else
+    codfilepath1:='/usr/local/lib/fpc/lexyacc/';
   codfilepath2:='/usr/lib/fpc/lexyacc/';
 {$else}
   codfilepath1:=path(paramstr(0));

+ 4 - 4
utils/tply/yaccbase.pas

@@ -640,7 +640,7 @@ function path(filename : String) : String;
   var i : Integer;
   begin
     i := length(filename);
-    while (i>0) and (filename[i]<>'\') and (filename[i]<>':') do
+    while (i>0) and (filename[i]<>DirectorySeparator) and (filename[i]<>':') do
       dec(i);
     path := copy(filename, 1, i);
   end(*path*);
@@ -656,10 +656,10 @@ function root(filename : String) : String;
             root := copy(filename, 1, i-1);
             exit
           end;
-        '\': exit;
+        DirectorySeparator: exit;
         else
       end;
-  end(*addExt*);
+  end(*root*);
 function addExt(filename, ext : String) : String;
   (* implemented with goto for maximum efficiency *)
   label x;
@@ -670,7 +670,7 @@ function addExt(filename, ext : String) : String;
     for i := length(filename) downto 1 do
       case filename[i] of
         '.' : exit;
-        '\': goto x;
+        DirectorySeparator : goto x;
         else
       end;
     x : addExt := filename+'.'+ext