summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2>2018-12-24 22:12:19 +0000
committerjonas <jonas@3ad0048d-3df7-0310-abae-a5850022a9f2>2018-12-24 22:12:19 +0000
commita142ff06bcd482d496aa8c96d3294c651d31965a (patch)
treefdb916e044a395791a45a28d197d2e6c1764d6b8
parent636ae0b1f820d20b64ccfc2146aa6e99783547cf (diff)
parent5654f1a2ebf9871ac052d7825076e468d01b52b9 (diff)
downloadfpc-a142ff06bcd482d496aa8c96d3294c651d31965a.tar.gz
* synchronised with trunk till r40635
git-svn-id: https://svn.freepascal.org/svn/fpc/branches/debug_eh@40636 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r--compiler/arm/symcpu.pas4
-rw-r--r--compiler/blockutl.pas2
-rw-r--r--compiler/hlcg2ll.pas4
-rw-r--r--compiler/hlcgobj.pas5
-rw-r--r--compiler/i386/symcpu.pas4
-rw-r--r--compiler/i8086/symcpu.pas8
-rw-r--r--compiler/jvm/pjvm.pas8
-rw-r--r--compiler/llvm/nllvmcal.pas24
-rw-r--r--compiler/llvm/nllvmcnv.pas6
-rw-r--r--compiler/llvm/nllvmld.pas2
-rw-r--r--compiler/m68k/symcpu.pas4
-rw-r--r--compiler/ncal.pas175
-rw-r--r--compiler/ncgcnv.pas6
-rw-r--r--compiler/ncgnstld.pas15
-rw-r--r--compiler/ncgutil.pas6
-rw-r--r--compiler/ncnv.pas8
-rw-r--r--compiler/ninl.pas2
-rw-r--r--compiler/powerpc/symcpu.pas4
-rw-r--r--compiler/symcreat.pas29
-rw-r--r--compiler/symdef.pas29
-rw-r--r--compiler/x86_64/symcpu.pas4
-rw-r--r--packages/chm/src/chmcmd.lpr2
-rw-r--r--packages/fcl-db/examples/myext.pp49
-rw-r--r--packages/fcl-db/examples/sqlite3extdemo.pp40
-rw-r--r--packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp4
-rw-r--r--packages/fpmkunit/src/fpmkunit.pp2
-rw-r--r--packages/pastojs/src/fppas2js.pp3
-rw-r--r--packages/pastojs/src/pas2jsfilecache.pp2
-rw-r--r--packages/rtl-console/src/unix/keyboard.pp40
-rw-r--r--packages/sqlite/examples/myext.lpi66
-rw-r--r--packages/sqlite/examples/myext.pp49
-rw-r--r--packages/sqlite/fpmake.pp4
-rw-r--r--packages/sqlite/src/sqlite3ext.pp313
-rw-r--r--utils/tply/lexbase.pas8
-rw-r--r--utils/tply/plex.pas6
-rw-r--r--utils/tply/pyacc.pas6
-rw-r--r--utils/tply/pyacc.y6
-rw-r--r--utils/tply/yaccbase.pas8
38 files changed, 776 insertions, 181 deletions
diff --git a/compiler/arm/symcpu.pas b/compiler/arm/symcpu.pas
index 926ef4f581..54a9f2a563 100644
--- a/compiler/arm/symcpu.pas
+++ b/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
diff --git a/compiler/blockutl.pas b/compiler/blockutl.pas
index f4e2bfb91c..a5d5ae889f 100644
--- a/compiler/blockutl.pas
+++ b/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
diff --git a/compiler/hlcg2ll.pas b/compiler/hlcg2ll.pas
index 58ce04a03d..fb82a6c89f 100644
--- a/compiler/hlcg2ll.pas
+++ b/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;
diff --git a/compiler/hlcgobj.pas b/compiler/hlcgobj.pas
index 6107966cb1..78bb6a643e 100644
--- a/compiler/hlcgobj.pas
+++ b/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;
diff --git a/compiler/i386/symcpu.pas b/compiler/i386/symcpu.pas
index 1246fa8178..fef67511e8 100644
--- a/compiler/i386/symcpu.pas
+++ b/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
diff --git a/compiler/i8086/symcpu.pas b/compiler/i8086/symcpu.pas
index ff83bf0bc2..6f7c9b8cbb 100644
--- a/compiler/i8086/symcpu.pas
+++ b/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
diff --git a/compiler/jvm/pjvm.pas b/compiler/jvm/pjvm.pas
index 698b4feac4..75b73d6c3d 100644
--- a/compiler/jvm/pjvm.pas
+++ b/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;
diff --git a/compiler/llvm/nllvmcal.pas b/compiler/llvm/nllvmcal.pas
index 4d35cf8063..6f13103e43 100644
--- a/compiler/llvm/nllvmcal.pas
+++ b/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;
diff --git a/compiler/llvm/nllvmcnv.pas b/compiler/llvm/nllvmcnv.pas
index 27e815de8c..53e1014761 100644
--- a/compiler/llvm/nllvmcnv.pas
+++ b/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
diff --git a/compiler/llvm/nllvmld.pas b/compiler/llvm/nllvmld.pas
index 6f7455301c..d5d0aa22ed 100644
--- a/compiler/llvm/nllvmld.pas
+++ b/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 }
diff --git a/compiler/m68k/symcpu.pas b/compiler/m68k/symcpu.pas
index 73f1bd04ee..8920d27629 100644
--- a/compiler/m68k/symcpu.pas
+++ b/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
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index a7cbe3b7ad..2eb6fc33f0 100644
--- a/compiler/ncal.pas
+++ b/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));
diff --git a/compiler/ncgcnv.pas b/compiler/ncgcnv.pas
index 217dd4c850..54ffefbd38 100644
--- a/compiler/ncgcnv.pas
+++ b/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:
diff --git a/compiler/ncgnstld.pas b/compiler/ncgnstld.pas
index 85283aaa8f..4e016f7f5b 100644
--- a/compiler/ncgnstld.pas
+++ b/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;
diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas
index 5cca991e99..990d0924a2 100644
--- a/compiler/ncgutil.pas
+++ b/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;
diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index 0156f31224..6cb539133a 100644
--- a/compiler/ncnv.pas
+++ b/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
diff --git a/compiler/ninl.pas b/compiler/ninl.pas
index 4de11c3c73..60e51efe2e 100644
--- a/compiler/ninl.pas
+++ b/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 }
diff --git a/compiler/powerpc/symcpu.pas b/compiler/powerpc/symcpu.pas
index cd06ccd0b3..55284fe42f 100644
--- a/compiler/powerpc/symcpu.pas
+++ b/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
diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas
index 502abc9614..bea2d0d21c 100644
--- a/compiler/symcreat.pas
+++ b/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];
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index 2a60ab2f5f..f7baf3b16c 100644
--- a/compiler/symdef.pas
+++ b/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;
diff --git a/compiler/x86_64/symcpu.pas b/compiler/x86_64/symcpu.pas
index e6d15ba87e..a2c9ddd79e 100644
--- a/compiler/x86_64/symcpu.pas
+++ b/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
diff --git a/packages/chm/src/chmcmd.lpr b/packages/chm/src/chmcmd.lpr
index f6259e1c50..be56490dee 100644
--- a/packages/chm/src/chmcmd.lpr
+++ b/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;
diff --git a/packages/fcl-db/examples/myext.pp b/packages/fcl-db/examples/myext.pp
new file mode 100644
index 0000000000..7a5bc97e5e
--- /dev/null
+++ b/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.
diff --git a/packages/fcl-db/examples/sqlite3extdemo.pp b/packages/fcl-db/examples/sqlite3extdemo.pp
new file mode 100644
index 0000000000..93869fd14f
--- /dev/null
+++ b/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.
diff --git a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp b/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
index 7b599de878..83cb07d43c 100644
--- a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
+++ b/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
diff --git a/packages/fpmkunit/src/fpmkunit.pp b/packages/fpmkunit/src/fpmkunit.pp
index 878bea8d62..1bd3541d5b 100644
--- a/packages/fpmkunit/src/fpmkunit.pp
+++ b/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"';
diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index daf31556a0..b4f2ad8c32 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/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
diff --git a/packages/pastojs/src/pas2jsfilecache.pp b/packages/pastojs/src/pas2jsfilecache.pp
index a591079e99..86bac7ea13 100644
--- a/packages/pastojs/src/pas2jsfilecache.pp
+++ b/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);
diff --git a/packages/rtl-console/src/unix/keyboard.pp b/packages/rtl-console/src/unix/keyboard.pp
index 111f5a604a..625b35b6cf 100644
--- a/packages/rtl-console/src/unix/keyboard.pp
+++ b/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;
diff --git a/packages/sqlite/examples/myext.lpi b/packages/sqlite/examples/myext.lpi
new file mode 100644
index 0000000000..77b1c453d5
--- /dev/null
+++ b/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>
diff --git a/packages/sqlite/examples/myext.pp b/packages/sqlite/examples/myext.pp
new file mode 100644
index 0000000000..7a5bc97e5e
--- /dev/null
+++ b/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.
diff --git a/packages/sqlite/fpmake.pp b/packages/sqlite/fpmake.pp
index 5aa2c439a3..e81ef2a56a 100644
--- a/packages/sqlite/fpmake.pp
+++ b/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');
diff --git a/packages/sqlite/src/sqlite3ext.pp b/packages/sqlite/src/sqlite3ext.pp
new file mode 100644
index 0000000000..623539c189
--- /dev/null
+++ b/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.
diff --git a/utils/tply/lexbase.pas b/utils/tply/lexbase.pas
index f6b329203c..719df5f2ee 100644
--- a/utils/tply/lexbase.pas
+++ b/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
diff --git a/utils/tply/plex.pas b/utils/tply/plex.pas
index df2aefd1d3..9ea37b962f 100644
--- a/utils/tply/plex.pas
+++ b/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));
diff --git a/utils/tply/pyacc.pas b/utils/tply/pyacc.pas
index 7964476f6e..530ff7842e 100644
--- a/utils/tply/pyacc.pas
+++ b/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));
diff --git a/utils/tply/pyacc.y b/utils/tply/pyacc.y
index ddf614e1ce..5817810d8f 100644
--- a/utils/tply/pyacc.y
+++ b/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));
diff --git a/utils/tply/yaccbase.pas b/utils/tply/yaccbase.pas
index d48188d016..d161ed8be9 100644
--- a/utils/tply/yaccbase.pas
+++ b/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