* synchronize with trunk

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

.gitattributes

@@ -103,6 +103,7 @@ compiler/arm/rarmstd.inc svneol=native#text/plain
 compiler/arm/rarmsup.inc svneol=native#text/plain
 compiler/arm/rgcpu.pas svneol=native#text/plain
 compiler/arm/symcpu.pas svneol=native#text/plain
+compiler/armgen/armpara.pas svneol=native#text/plain
 compiler/assemble.pas svneol=native#text/plain
 compiler/avr/aasmcpu.pas svneol=native#text/plain
 compiler/avr/agavrgas.pas svneol=native#text/plain
@@ -2303,6 +2304,7 @@ packages/fcl-db/src/sqldb/postgres/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/postgres/pqconnection.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqldb.pp svneol=native#text/plain
+packages/fcl-db/src/sqldb/sqldbini.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqldblib.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqlite/Makefile svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqlite/Makefile.fpc svneol=native#text/plain
@@ -3314,6 +3316,16 @@ packages/fcl-web/examples/jsonrpc/extdirect/extdemo.lpr svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/extdirect/extdirect.in svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/extdirect/wmext.lfm svneol=native#text/plain
 packages/fcl-web/examples/jsonrpc/extdirect/wmext.pp svneol=native#text/plain
+packages/fcl-web/examples/restbridge/README.txt svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/frmmain.dfm svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/frmmain.pas svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dpr svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dproj svneol=native#text/plain
+packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.res -text
+packages/fcl-web/examples/restbridge/demorestbridge.lpi svneol=native#text/plain
+packages/fcl-web/examples/restbridge/demorestbridge.pp svneol=native#text/plain
+packages/fcl-web/examples/restbridge/expenses-data.sql svneol=native#text/plain
+packages/fcl-web/examples/restbridge/expenses-pq.sql svneol=native#text/plain
 packages/fcl-web/examples/routing-session/routingsessiondemo.lpi svneol=native#text/plain
 packages/fcl-web/examples/routing-session/routingsessiondemo.lpr svneol=native#text/plain
 packages/fcl-web/examples/routing/README svneol=native#text/plain
@@ -3447,6 +3459,19 @@ packages/fcl-web/src/jsonrpc/fpextdirect.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/fpjsonrpc.pp svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/readme.txt svneol=native#text/plain
 packages/fcl-web/src/jsonrpc/webjsonrpc.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestauth.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestauthini.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestbridge.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestcds.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestconst.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestcsv.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestdata.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestini.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestio.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestjson.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestmodule.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestschema.pp svneol=native#text/plain
+packages/fcl-web/src/restbridge/sqldbrestxml.pp svneol=native#text/plain
 packages/fcl-web/src/webdata/Makefile svneol=native#text/plain
 packages/fcl-web/src/webdata/Makefile.fpc svneol=native#text/plain
 packages/fcl-web/src/webdata/extjsjson.pp svneol=native#text/plain
@@ -12762,6 +12787,7 @@ tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
 tests/test/packages/fcl-registry/tw35060a.pp svneol=native#text/plain
 tests/test/packages/fcl-registry/tw35060b.pp svneol=native#text/plain
+tests/test/packages/fcl-registry/tw35060c.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/tw22495.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/uw22495.pp svneol=native#text/plain
@@ -12779,6 +12805,7 @@ tests/test/packages/win-base/tdispvar1.pp svneol=native#text/plain
 tests/test/packages/zlib/tzlib1.pp svneol=native#text/plain
 tests/test/t4cc1.pp svneol=native#text/plain
 tests/test/t4cc2.pp svneol=native#text/plain
+tests/test/taarch64abi.pp svneol=native#text/plain
 tests/test/tabstract1.pp svneol=native#text/pascal
 tests/test/tabstrcl.pp svneol=native#text/plain
 tests/test/tabsvr1.pp svneol=native#text/plain
@@ -16542,6 +16569,8 @@ tests/webtbs/tw35027.pp svneol=native#text/pascal
 tests/webtbs/tw35028.pp svneol=native#text/pascal
 tests/webtbs/tw3504.pp svneol=native#text/plain
 tests/webtbs/tw3506.pp svneol=native#text/plain
+tests/webtbs/tw35139.pp svneol=native#text/plain
+tests/webtbs/tw35139a.pp svneol=native#text/plain
 tests/webtbs/tw3523.pp svneol=native#text/plain
 tests/webtbs/tw3529.pp svneol=native#text/plain
 tests/webtbs/tw3531.pp svneol=native#text/plain

compiler/Makefile

@@ -543,7 +543,10 @@ ifeq ($(PPC_TARGET),sparc64)
 override LOCALOPT+=-Fusparcgen -Fisparcgen
 endif
 ifeq ($(PPC_TARGET),arm)
-override LOCALOPT+=
+override LOCALOPT+=-Fuarmgen
+endif
+ifeq ($(PPC_TARGET),armeb)
+override LOCALOPT+=-Fuarmgen
 endif
 ifeq ($(PPC_TARGET),mipsel)
 override LOCALOPT+=-Fumips
@@ -551,6 +554,9 @@ endif
 ifeq ($(PPC_TARGET),jvm)
 override LOCALOPT+=-Fujvm
 endif
+ifeq ($(PPC_TARGET),aarch64)
+override LOCALOPT+=-Fuarmgen
+endif
 ifeq ($(PPC_TARGET),i8086)
 override LOCALOPT+=-Fux86
 endif

compiler/Makefile.fpc

@@ -309,7 +309,12 @@ endif
 
 # ARM specific
 ifeq ($(PPC_TARGET),arm)
-override LOCALOPT+=
+override LOCALOPT+=-Fuarmgen
+endif
+
+# ARMEB specific
+ifeq ($(PPC_TARGET),armeb)
+override LOCALOPT+=-Fuarmgen
 endif
 
 # mipsel specific
@@ -322,6 +327,11 @@ ifeq ($(PPC_TARGET),jvm)
 override LOCALOPT+=-Fujvm
 endif
 
+# AArch64 specific
+ifeq ($(PPC_TARGET),aarch64)
+override LOCALOPT+=-Fuarmgen
+endif
+
 # i8086 specific
 ifeq ($(PPC_TARGET),i8086)
 override LOCALOPT+=-Fux86

compiler/aarch64/cpupara.pas

@@ -30,10 +30,10 @@ unit cpupara;
        globtype,globals,
        aasmtai,aasmdata,
        cpuinfo,cpubase,cgbase,cgutils,
-       symconst,symbase,symtype,symdef,parabase,paramgr;
+       symconst,symbase,symtype,symdef,parabase,paramgr,armpara;
 
     type
-       tcpuparamanager = class(tparamanager)
+       tcpuparamanager = class(tarmgenparamanager)
           function get_volatile_registers_int(calloption: tproccalloption): tcpuregisterset; override;
           function get_volatile_registers_fpu(calloption: tproccalloption): tcpuregisterset; override;
           function get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset; override;
@@ -42,7 +42,7 @@ unit cpupara;
           function push_addr_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; override;
           function ret_in_param(def: tdef; pd: tabstractprocdef):boolean;override;
           function create_paraloc_info(p: tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p: tabstractprocdef; varargspara: tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist):longint;override;
           function get_funcretloc(p: tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
           function param_use_paraloc(const cgpara: tcgpara): boolean; override;
          private
@@ -52,6 +52,7 @@ unit cpupara;
 
           procedure init_para_alloc_values;
           procedure alloc_para(out result: tcgpara; p: tabstractprocdef; varspez: tvarspez; side: tcallercallee; paradef: tdef; isvariadic, isdelphinestedcc: boolean);
+          function getparaloc(calloption: tproccalloption; p: tdef): tcgloc;
 
           procedure create_paraloc_info_intern(p: tabstractprocdef; side: tcallercallee; paras: tparalist; isvariadic: boolean);
        end;
@@ -106,83 +107,7 @@ unit cpupara;
       end;
 
 
-    function is_hfa_internal(p: tdef; var basedef: tdef; var elecount: longint): boolean;
-      var
-        i: longint;
-        sym: tsym;
-        tmpelecount: longint;
-      begin
-        result:=false;
-        case p.typ of
-          arraydef:
-            begin
-              if is_special_array(p) then
-                exit;
-              { an array of empty records has no influence }
-              if tarraydef(p).elementdef.size=0 then
-                begin
-                  result:=true;
-                  exit
-                end;
-              tmpelecount:=0;
-              if not is_hfa_internal(tarraydef(p).elementdef,basedef,tmpelecount) then
-                exit;
-              { tmpelecount now contains the number of hfa elements in a
-                single array element (e.g. 2 if it's an array of a record
-                containing two singles) -> multiply by number of elements
-                in the array }
-              inc(elecount,tarraydef(p).elecount*tmpelecount);
-              if elecount>4 then
-                exit;
-              result:=true;
-            end;
-          floatdef:
-            begin
-              if not assigned(basedef) then
-                basedef:=p
-              else if basedef<>p then
-                exit;
-              inc(elecount);
-              result:=true;
-            end;
-          recorddef:
-            begin
-              for i:=0 to tabstractrecorddef(p).symtable.symlist.count-1 do
-                begin
-                  sym:=tsym(tabstractrecorddef(p).symtable.symlist[i]);
-                  if sym.typ<>fieldvarsym then
-                    continue;
-                  if not is_hfa_internal(tfieldvarsym(sym).vardef,basedef,elecount) then
-                    exit
-                end;
-              result:=true;
-            end;
-          else
-            exit
-        end;
-      end;
-
-
-    { Returns whether a def is a "homogeneous float array" at the machine level.
-      This means that in the memory layout, the def only consists of maximally
-      4 floating point values that appear consecutively in memory }
-    function is_hfa(p: tdef; out basedef: tdef) : boolean;
-      var
-        elecount: longint;
-      begin
-        result:=false;
-        basedef:=nil;
-        elecount:=0;
-        result:=is_hfa_internal(p,basedef,elecount);
-        result:=
-          result and
-          (elecount>0) and
-          (elecount<=4) and
-          (p.size=basedef.size*elecount)
-      end;
-
-
-    function getparaloc(calloption: tproccalloption; p: tdef): tcgloc;
+    function tcpuparamanager.getparaloc(calloption: tproccalloption; p: tdef): tcgloc;
       var
         hfabasedef: tdef;
       begin
@@ -364,6 +289,24 @@ unit cpupara;
          if not assigned(result.location) or
             not(result.location^.loc in [LOC_REGISTER,LOC_MMREGISTER,LOC_VOID]) then
            internalerror(2014113001);
+         {
+           According to ARM64 ABI: "If the size of the argument is less than 8 bytes then
+           the size of the argument is set to 8 bytes. The effect is as if the argument
+           was copied to the least significant bits of a 64-bit register and the remaining
+           bits filled with unspecified values."
+
+           Therefore at caller side force the ordinal result to be always 64-bit, so it
+           will be stripped to the required size and uneeded bits are discarded.
+
+           This is not required for iOS, where the result is zero/sign extended.
+         }
+         if (target_info.abi<>abi_aarch64_darwin) and
+            (side=callerside) and (result.location^.loc = LOC_REGISTER) and
+            (result.def.size<8) and is_ordinal(result.def) then
+           begin
+             result.location^.size:=OS_64;
+             result.location^.def:=u64inttype;
+           end;
       end;
 
 
@@ -597,14 +540,28 @@ unit cpupara;
                     responsibility to sign or zero-extend arguments having fewer
                     than 32 bits, and that unused bits in a register are
                     unspecified. In iOS, however, the caller must perform such
-                    extensions, up to 32 bits." }
-                 if (target_info.abi=abi_aarch64_darwin) and
-                    (side=callerside) and
-                    is_ordinal(paradef) and
-                    (paradef.size<4) then
+                    extensions, up to 32 bits."
+                    Zero extend an argument at caller side for iOS and
+                    ignore the argument's unspecified high bits at callee side for
+                    all other platforms. }
+                 if (paradef.size<4) and is_ordinal(paradef) then
                    begin
-                     paraloc^.size:=OS_32;
-                     paraloc^.def:=u32inttype;
+                     if target_info.abi=abi_aarch64_darwin then
+                       begin
+                         if side=callerside then
+                           begin
+                             paraloc^.size:=OS_32;
+                             paraloc^.def:=u32inttype;
+                           end;
+                       end
+                     else
+                       begin
+                         if side=calleeside then
+                           begin
+                             paraloc^.size:=OS_32;
+                             paraloc^.def:=u32inttype;
+                           end;
+                       end;
                    end;
 
                  { in case it's a composite, "The argument is passed as though
@@ -682,12 +639,12 @@ unit cpupara;
      end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; varargspara: tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist):longint;
       begin
         init_para_alloc_values;
 
         { non-variadic parameters }
-        create_paraloc_info_intern(p,callerside,p.paras,false);
+        create_paraloc_info_intern(p,side,p.paras,false);
         if p.proccalloption in cstylearrayofconst then
           begin
             { on Darwin, we cannot use any registers for variadic parameters }
@@ -697,11 +654,19 @@ unit cpupara;
                 curmmreg:=succ(RS_LAST_MM_PARAM_SUPREG);
               end;
             { continue loading the parameters  }
-            create_paraloc_info_intern(p,callerside,varargspara,true);
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  create_paraloc_info_intern(p,side,varargspara,true)
+                else
+                  internalerror(2019021916);
+              end;
             result:=curstackoffset;
           end
         else
           internalerror(200410231);
+
+        create_funcretloc_info(p,side);
       end;
 
 begin

compiler/aarch64/ncpuset.pas

@@ -31,9 +31,9 @@ interface
     type
        taarch64casenode = class(tcgcasenode)
          protected
-           procedure optimizevalues(var max_linear_list: aint; var max_dist: aword);override;
+           procedure optimizevalues(var max_linear_list: int64; var max_dist: qword);override;
            function  has_jumptable: boolean;override;
-           procedure genjumptable(hp: pcaselabel ;min_, max_: aint);override;
+           procedure genjumptable(hp: pcaselabel ;min_, max_: int64);override;
        end;
 
 
@@ -56,7 +56,7 @@ implementation
 *****************************************************************************}
 
 
-    procedure taarch64casenode.optimizevalues(var max_linear_list: aint; var max_dist: aword);
+    procedure taarch64casenode.optimizevalues(var max_linear_list: int64; var max_dist: qword);
       begin
         max_linear_list:=10;
       end;
@@ -68,7 +68,7 @@ implementation
       end;
 
 
-    procedure taarch64casenode.genjumptable(hp: pcaselabel; min_, max_: aint);
+    procedure taarch64casenode.genjumptable(hp: pcaselabel; min_, max_: int64);
       var
         last: TConstExprInt;
         tablelabel: TAsmLabel;
@@ -80,7 +80,7 @@ implementation
 
       procedure genitem(list:TAsmList;t : pcaselabel);
         var
-          i : aint;
+          i : int64;
         begin
           if assigned(t^.less) then
             genitem(list,t^.less);

compiler/arm/cpubase.pas

@@ -416,8 +416,11 @@ unit cpubase;
           R_MMREGISTER:
             begin
               case s of
+                { records passed in MM registers }
+                OS_32,
                 OS_F32:
                   cgsize2subreg:=R_SUBFS;
+                OS_64,
                 OS_F64:
                   cgsize2subreg:=R_SUBFD;
                 else

compiler/arm/cpupara.pas

@@ -30,10 +30,10 @@ unit cpupara;
        globtype,globals,
        aasmdata,
        cpuinfo,cpubase,cgbase,cgutils,
-       symconst,symtype,symdef,parabase,paramgr;
+       symconst,symtype,symdef,parabase,paramgr,armpara;
 
     type
-       tcpuparamanager = class(tparamanager)
+       tcpuparamanager = class(tarmgenparamanager)
           function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
@@ -42,9 +42,11 @@ unit cpupara;
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
+          function usemmpararegs(calloption: tproccalloption; variadic: boolean): boolean;
+          function getparaloc(calloption : tproccalloption; p : tdef; isvariadic: boolean) : tcgloc;
           procedure init_values(p: tabstractprocdef; side: tcallercallee; var curintreg,
             curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword;
             var sparesinglereg: tregister);
@@ -131,7 +133,9 @@ unit cpupara;
       end;
 
 
-    function getparaloc(calloption : tproccalloption; p : tdef; isvariadic: boolean) : tcgloc;
+    function tcpuparamanager.getparaloc(calloption : tproccalloption; p : tdef; isvariadic: boolean) : tcgloc;
+      var
+        basedef: tdef;
       begin
          { Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
            if push_addr_param for the def is true
@@ -161,7 +165,11 @@ unit cpupara;
             classrefdef:
               getparaloc:=LOC_REGISTER;
             recorddef:
-              getparaloc:=LOC_REGISTER;
+              if usemmpararegs(calloption,isvariadic) and
+                 is_hfa(p,basedef) then
+                getparaloc:=LOC_MMREGISTER
+              else
+                getparaloc:=LOC_REGISTER;
             objectdef:
               getparaloc:=LOC_REGISTER;
             stringdef:
@@ -176,6 +184,9 @@ unit cpupara;
             arraydef:
               if is_dynamic_array(p) then
                 getparaloc:=LOC_REGISTER
+              else if usemmpararegs(calloption,isvariadic) and
+                 is_hfa(p,basedef) then
+                getparaloc:=LOC_MMREGISTER
               else
                 getparaloc:=LOC_REFERENCE;
             setdef:
@@ -229,12 +240,19 @@ unit cpupara;
       var
         i: longint;
         sym: tsym;
+        basedef: tdef;
       begin
         if handle_common_ret_in_param(def,pd,result) then
           exit;
         case def.typ of
           recorddef:
             begin
+              if usemmpararegs(pd.proccalloption,is_c_variadic(pd)) and
+                 is_hfa(def,basedef) then
+                begin
+                  result:=false;
+                  exit;
+                end;
               result:=def.size>4;
               if not result and
                  (target_info.abi in [abi_default,abi_armeb]) then
@@ -327,11 +345,13 @@ unit cpupara;
 
       var
         nextintreg,nextfloatreg,nextmmreg : tsuperregister;
-        paradef : tdef;
+        paradef,
+        hfabasedef : tdef;
         paraloc : pcgparalocation;
         stack_offset : aword;
         hp : tparavarsym;
         loc : tcgloc;
+        hfabasesize  : tcgsize;
         paracgsize   : tcgsize;
         paralen : longint;
         i : integer;
@@ -359,6 +379,31 @@ unit cpupara;
         end;
 
 
+      procedure updatemmregs(paradef, basedef: tdef);
+        var
+          regsavailable,
+          regsneeded: longint;
+          basesize: asizeint;
+        begin
+          basesize:=basedef.size;
+          regsneeded:=paradef.size div basesize;
+          regsavailable:=ord(RS_D7)-ord(nextmmreg)+1;
+          case basesize of
+            4:
+              regsavailable:=regsavailable*2+ord(sparesinglereg<>NR_NO);
+            8:
+              ;
+            else
+              internalerror(2019022301);
+          end;
+          if regsavailable<regsneeded then
+            begin
+              nextmmreg:=succ(RS_D7);
+              sparesinglereg:=NR_NO;
+            end;
+        end;
+
+
       begin
         result:=0;
         nextintreg:=curintreg;
@@ -429,6 +474,18 @@ unit cpupara;
              hp.paraloc[side].def:=paradef;
              firstparaloc:=true;
 
+             if (loc=LOC_MMREGISTER) and
+                is_hfa(paradef,hfabasedef) then
+               begin
+                 updatemmregs(paradef,hfabasedef);
+                 hfabasesize:=def_cgsize(hfabasedef);
+               end
+             else
+               begin
+                 hfabasedef:=nil;
+                 hfabasesize:=OS_NO;
+               end;
+
 {$ifdef EXTDEBUG}
              if paralen=0 then
                internalerror(200410311);
@@ -455,13 +512,11 @@ unit cpupara;
                            firstparaloc and
                            (paradef.alignment=8) then
                           begin
+                            hp.paraloc[side].Alignment:=8;
                             if (nextintreg in [RS_R1,RS_R3]) then
                               inc(nextintreg)
                             else if nextintreg>RS_R3 then
-                              begin
-                                stack_offset:=align(stack_offset,8);
-                                hp.paraloc[side].Alignment:=8;
-                              end;
+                              stack_offset:=align(stack_offset,8);
                           end;
                         if nextintreg<=RS_R3 then
                           begin
@@ -514,10 +569,18 @@ unit cpupara;
                       end;
                     LOC_MMREGISTER:
                       begin
-                        paraloc^.size:=paracgsize;
-                        paraloc^.def:=paradef;
+                        if assigned(hfabasedef) then
+                          begin
+                            paraloc^.def:=hfabasedef;
+                            paraloc^.size:=hfabasesize;
+                          end
+                        else
+                          begin
+                            paraloc^.size:=paracgsize;
+                            paraloc^.def:=paradef;
+                          end;
                         if (nextmmreg<=RS_D7) or
-                           ((paraloc^.size = OS_F32) and
+                           ((paraloc^.size=OS_F32) and
                             (sparesinglereg<>NR_NO)) then
                           begin
                             paraloc^.loc:=LOC_MMREGISTER;
@@ -642,35 +705,53 @@ unit cpupara;
 
     function  tcpuparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;
       var
-        paraloc : pcgparalocation;
+        paraloc: pcgparalocation;
         retcgsize  : tcgsize;
+        basedef: tdef;
+        i: longint;
+        mmreg: tregister;
       begin
          if set_common_funcretloc_info(p,forcetempdef,retcgsize,result) then
            exit;
 
         paraloc:=result.add_location;
         { Return in FPU register? }
-        if result.def.typ=floatdef then
+        basedef:=nil;
+        if (result.def.typ=floatdef) or
+           is_hfa(result.def,basedef) then
           begin
-            if (target_info.abi=abi_eabihf) or (p.proccalloption=pocall_hardfloat) then
+            if usemmpararegs(p.proccalloption,is_c_variadic(p)) then
               begin
-                paraloc^.loc:=LOC_MMREGISTER;
+                if assigned(basedef) then
+                  begin
+                    for i:=2 to result.def.size div basedef.size do
+                      result.add_location;
+                    retcgsize:=def_cgsize(basedef);
+                  end
+                else
+                  basedef:=result.def;
                 case retcgsize of
                   OS_64,
                   OS_F64:
                     begin
-                      paraloc^.register:=NR_MM_RESULT_REG;
+                      mmreg:=NR_MM_RESULT_REG
                     end;
                   OS_32,
                   OS_F32:
                     begin
-                      paraloc^.register:=NR_S0;
+                      mmreg:=NR_S0;
                     end;
                   else
                     internalerror(2012032501);
                 end;
-                paraloc^.size:=retcgsize;
-                paraloc^.def:=result.def;
+                repeat
+                  paraloc^.loc:=LOC_MMREGISTER;
+                  paraloc^.register:=mmreg;
+                  inc(mmreg);
+                  paraloc^.size:=retcgsize;
+                  paraloc^.def:=basedef;
+                  paraloc:=paraloc^.next;
+                until not assigned(paraloc);
               end
             else if (p.proccalloption in [pocall_softfloat]) or
                (cs_fp_emulation in current_settings.moduleswitches) or
@@ -764,6 +845,14 @@ unit cpupara;
       end;
 
 
+    function tcpuparamanager.usemmpararegs(calloption: tproccalloption; variadic: boolean): boolean;
+      begin
+        result:=
+         ((target_info.abi=abi_eabihf) or (calloption=pocall_hardfloat)) and
+          (not variadic);
+      end;
+
+
     function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
       var
         cur_stack_offset: aword;
@@ -778,20 +867,30 @@ unit cpupara;
      end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
         sparesinglereg:tregister;
       begin
-        init_values(p,callerside,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg);
+        init_values(p,side,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg);
 
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true);
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true);
         if (p.proccalloption in cstylearrayofconst) then
-          { just continue loading the parameters in the registers }
-          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true)
+          begin
+            { just continue loading the parameters in the registers }
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,sparesinglereg,true)
+                else
+                  internalerror(2019021915);
+              end;
+          end
         else
           internalerror(200410231);
+
+        create_funcretloc_info(p,side);
       end;
 
 begin

compiler/arm/narmld.pas

@@ -55,8 +55,6 @@ implementation
 
     procedure tarmloadnode.generate_threadvar_access(gvs: tstaticvarsym);
       var
-        paraloc1 : tcgpara;
-        pd: tprocdef;
         href: treference;
         hregister : tregister;
         handled: boolean;

compiler/arm/narmset.pas

@@ -41,9 +41,9 @@ interface
        end;
 
       tarmcasenode = class(tcgcasenode)
-         procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
+         procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
          function  has_jumptable : boolean;override;
-         procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+         procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
          procedure genlinearlist(hp : pcaselabel);override;
          procedure genjmptreeentry(p : pcaselabel;parentvalue : TConstExprInt);override;
       end;
@@ -136,7 +136,7 @@ implementation
                             TARMCASENODE
 *****************************************************************************}
 
-    procedure tarmcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure tarmcasenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         inc(max_linear_list,2)
       end;
@@ -148,7 +148,7 @@ implementation
       end;
 
 
-    procedure tarmcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tarmcasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         last : TConstExprInt;
         tmpreg,
@@ -161,22 +161,30 @@ implementation
 
         procedure genitem(list:TAsmList;t : pcaselabel);
           var
-            i : aint;
+            i : int64;
           begin
             if assigned(t^.less) then
               genitem(list,t^.less);
             { fill possible hole }
-            for i:=last.svalue+1 to t^._low.svalue-1 do
-              if cs_create_pic in current_settings.moduleswitches then
-                list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,elselabel,picoffset))
-              else
-                list.concat(Tai_const.Create_sym(elselabel));
-            for i:=t^._low.svalue to t^._high.svalue do
-              if cs_create_pic in current_settings.moduleswitches then
-                list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,blocklabel(t^.blockid),picoffset))
-              else
-                list.concat(Tai_const.Create_sym(blocklabel(t^.blockid)));
-            last:=t^._high.svalue;
+            i:=last+1;
+            while i<=t^._low-1 do
+              begin
+                if cs_create_pic in current_settings.moduleswitches then
+                  list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,elselabel,picoffset))
+                else
+                  list.concat(Tai_const.Create_sym(elselabel));
+                i:=i+1;
+              end;
+            i:=t^._low;
+            while i<=t^._high do
+              begin
+                if cs_create_pic in current_settings.moduleswitches then
+                  list.concat(Tai_const.Create_rel_sym_offset(aitconst_ptr,piclabel,blocklabel(t^.blockid),picoffset))
+                else
+                  list.concat(Tai_const.Create_sym(blocklabel(t^.blockid)));
+                i:=i+1;
+              end;
+            last:=t^._high;
             if assigned(t^.greater) then
               genitem(list,t^.greater);
           end;

compiler/armgen/armpara.pas

@@ -0,0 +1,121 @@
+{
+    Copyright (c) 2019 by Jonas Maebe
+
+    ARM and AArch64 common parameter helpers
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    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.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+unit armpara;
+
+{$mode objfpc}
+
+interface
+
+uses
+  symtype,
+  paramgr;
+
+type
+  tarmgenparamanager = class(tparamanager)
+   protected
+    { Returns whether a def is a "homogeneous float array" at the machine level.
+      This means that in the memory layout, the def only consists of maximally
+      4 floating point values that appear consecutively in memory }
+    function is_hfa(p: tdef; out basedef: tdef) : boolean;
+   private
+    function is_hfa_internal(p: tdef; var basedef: tdef; var elecount: longint): boolean;
+  end;
+
+
+implementation
+
+  uses
+    symconst,symdef,symsym,defutil;
+
+
+  function tarmgenparamanager.is_hfa(p: tdef; out basedef: tdef): boolean;
+    var
+      elecount: longint;
+    begin
+      result:=false;
+      basedef:=nil;
+      elecount:=0;
+      result:=is_hfa_internal(p,basedef,elecount);
+      result:=
+        result and
+        (elecount>0) and
+        (elecount<=4) and
+        (p.size=basedef.size*elecount)
+      end;
+
+
+  function tarmgenparamanager.is_hfa_internal(p: tdef; var basedef: tdef; var elecount: longint): boolean;
+    var
+      i: longint;
+      sym: tsym;
+      tmpelecount: longint;
+    begin
+      result:=false;
+      case p.typ of
+        arraydef:
+          begin
+            if is_special_array(p) then
+              exit;
+            { an array of empty records has no influence }
+            if tarraydef(p).elementdef.size=0 then
+              begin
+                result:=true;
+                exit
+              end;
+            tmpelecount:=0;
+            if not is_hfa_internal(tarraydef(p).elementdef,basedef,tmpelecount) then
+              exit;
+            { tmpelecount now contains the number of hfa elements in a
+              single array element (e.g. 2 if it's an array of a record
+              containing two singles) -> multiply by number of elements
+              in the array }
+            inc(elecount,tarraydef(p).elecount*tmpelecount);
+            if elecount>4 then
+              exit;
+            result:=true;
+          end;
+        floatdef:
+          begin
+            if not assigned(basedef) then
+              basedef:=p
+            else if basedef<>p then
+              exit;
+            inc(elecount);
+            result:=true;
+          end;
+        recorddef:
+          begin
+            for i:=0 to tabstractrecorddef(p).symtable.symlist.count-1 do
+              begin
+                sym:=tsym(tabstractrecorddef(p).symtable.symlist[i]);
+                if sym.typ<>fieldvarsym then
+                  continue;
+                if not is_hfa_internal(tfieldvarsym(sym).vardef,basedef,elecount) then
+                  exit
+              end;
+            result:=true;
+          end;
+        else
+          exit
+      end;
+    end;
+
+end.

compiler/avr/cpupara.pas

@@ -39,7 +39,7 @@ unit cpupara;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
@@ -526,17 +526,25 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         curintreg, curfloatreg, curmmreg: tsuperregister;
       begin
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
 
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset);
         if (p.proccalloption in cstylearrayofconst) then
-          { just continue loading the parameters in the registers }
-          result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
+          begin
+            { just continue loading the parameters in the registers }
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset)
+                else
+                  internalerror(2019021914);
+              end;
+          end
         else
           internalerror(200410231);
       end;

compiler/cclasses.pas

@@ -422,9 +422,9 @@ type
           { true if string is in the container }
           function Find(const s:TCmdStr):TCmdStrListItem;
           { inserts an item }
-          procedure InsertItem(item:TCmdStrListItem); {$ifdef CCLASSESINLINE}inline;{$endif}
+          procedure InsertItem(item:TCmdStrListItem);
           { concats an item }
-          procedure ConcatItem(item:TCmdStrListItem); {$ifdef CCLASSESINLINE}inline;{$endif}
+          procedure ConcatItem(item:TCmdStrListItem);
           property Doubles:boolean read FDoubles write FDoubles;
        end;
 

compiler/defutil.pas

@@ -325,6 +325,9 @@ interface
     { # returns true if the procdef has no parameters and no specified return type }
     function is_bareprocdef(pd : tprocdef): boolean;
 
+    { returns true if the procdef is a C-style variadic function }
+    function is_c_variadic(pd: tabstractprocdef): boolean; {$ifdef USEINLINE}inline;{$endif}
+
     { # returns the smallest base integer type whose range encompasses that of
         both ld and rd; if keep_sign_if_equal, then if ld and rd have the same
         signdness, the result will also get that signdness }
@@ -1496,6 +1499,12 @@ implementation
                  (pd.proctypeoption = potype_constructor));
       end;
 
+    function is_c_variadic(pd: tabstractprocdef): boolean;
+      begin
+        result:=
+          (po_varargs in pd.procoptions) or
+          (po_variadic in pd.procoptions);
+      end;
 
     function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef;
       var

compiler/hlcg2ll.pas

@@ -1548,8 +1548,9 @@ implementation
               cg128.a_load128_loc_cgpara(list,l,cgpara)
             else
 {$else cpu64bitalu}
-            { use cg64 only for int64, not for 8 byte records }
-            if (l.size in [OS_64,OS_S64]) and (cgpara.Size in [OS_64,OS_S64]) then
+            { use cg64 only for int64, not for 8 byte records; in particular,
+              filter out records passed in fpu/mm register}
+            if (l.size in [OS_64,OS_S64]) and (cgpara.Size in [OS_64,OS_S64]) and (cgpara.location^.loc=LOC_REGISTER) then
               cg64.a_load64_loc_cgpara(list,l,cgpara)
             else
 {$endif cpu64bitalu}

compiler/i386/aoptcpu.pas

@@ -131,7 +131,6 @@ function WriteOk : Boolean;
   end;
 
 var
-  l : longint;
   p,hp1,hp2 : tai;
   hp3,hp4: tai;
   v:aint;

compiler/i386/cgcpu.pas

@@ -261,10 +261,6 @@ unit cgcpu;
                                 reference_reset_symbol(tmpref,dirref.symbol,0,sizeof(pint),[]);
                                 tmpref.refaddr:=addr_pic;
                                 tmpref.base:=current_procinfo.got;
-{$ifdef EXTDEBUG}
-				if not (pi_needs_got in current_procinfo.flags) then
-				  Comment(V_warning,'pi_needs_got not included');
-{$endif EXTDEBUG}
                                 include(current_procinfo.flags,pi_needs_got);
                                 list.concat(taicpu.op_ref(A_PUSH,S_L,tmpref));
                               end
@@ -548,7 +544,10 @@ unit cgcpu;
             if not (target_info.system in [system_i386_darwin,system_i386_iphonesim]) then
               begin
                 { Use ECX as a temp register by default }
-                tmpreg:=NR_ECX;
+                if current_procinfo.got = NR_EBX then
+                  tmpreg:=NR_EBX
+                else
+                  tmpreg:=NR_ECX;
                 { Allocate registers used for parameters to make sure they
                   never allocated during this PIC init code }
                 for i:=0 to current_procinfo.procdef.paras.Count - 1 do

compiler/i386/cpupara.pas

@@ -42,7 +42,7 @@ unit cpupara;
           function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
           function get_saved_registers_int(calloption : tproccalloption):tcpuregisterarray;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;override;
        private
@@ -767,15 +767,22 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
         parasize:=0;
         { calculate the registers for the normal parameters }
-        create_stdcall_paraloc_info(p,callerside,p.paras,parasize);
+        create_stdcall_paraloc_info(p,side,p.paras,parasize);
         { append the varargs }
-        create_stdcall_paraloc_info(p,callerside,varargspara,parasize);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_stdcall_paraloc_info(p,side,varargspara,parasize)
+            else
+              internalerror(2019021926);
+          end;
+        create_funcretloc_info(p,side);
         result:=parasize;
       end;
 

compiler/i386/cpupi.pas

@@ -100,8 +100,11 @@ unit cpupi;
       begin
         if (cs_create_pic in current_settings.moduleswitches) then
           begin
-            if pi_uses_threadvar in flags then
+            if (pi_uses_threadvar in flags) and (tf_section_threadvars in target_info.flags) then
               begin
+                { FIXME: It is better to use an imaginary register for GOT and
+                  if EBX is needed for some reason just allocate EBX and
+                  copy GOT into it before its usage. }
                 cg.getcpuregister(list,NR_EBX);
                 got := NR_EBX;
               end

compiler/i386/hlcgcpu.pas

@@ -198,6 +198,7 @@ implementation
         { Alloc EBX }
         getcpuregister(list, NR_PIC_OFFSET_REG);
         list.concat(taicpu.op_reg_reg(A_MOV,S_L,current_procinfo.got,NR_PIC_OFFSET_REG));
+        include(current_procinfo.flags,pi_needs_got);
       end;
     Result:=inherited a_call_name(list, pd, s, paras, forceresdef, weak);
     { Free EBX }

compiler/i386/n386set.pas

@@ -31,7 +31,7 @@ interface
 
     type
       ti386casenode = class(tx86casenode)
-         procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
+         procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
       end;
 
 
@@ -44,7 +44,7 @@ implementation
                             TI386CASENODE
 *****************************************************************************}
 
-    procedure ti386casenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure ti386casenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         { a jump table crashes the pipeline! }
         if current_settings.optimizecputype=cpu_386 then

compiler/i8086/cpupara.pas

@@ -55,7 +55,7 @@ unit cpupara;
           }
           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;override;
        private
@@ -783,15 +783,22 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
         parasize:=0;
         { calculate the registers for the normal parameters }
-        create_stdcall_paraloc_info(p,callerside,p.paras,parasize);
+        create_stdcall_paraloc_info(p,side,p.paras,parasize);
         { append the varargs }
-        create_stdcall_paraloc_info(p,callerside,varargspara,parasize);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_stdcall_paraloc_info(p,side,varargspara,parasize)
+            else
+              internalerror(2019021925);
+          end;
+        create_funcretloc_info(p,side);
         result:=parasize;
       end;
 

compiler/jvm/cpupara.pas

@@ -46,7 +46,7 @@ interface
         @param(nr Parameter number of routine, starting from 1)}
         procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
-        function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+        function  create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
         function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
         function param_use_paraloc(const cgpara: tcgpara): boolean; override;
         function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
@@ -209,15 +209,22 @@ implementation
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;
       begin
         parasize:=0;
         { calculate the registers for the normal parameters }
-        create_paraloc_info_intern(p,callerside,p.paras,parasize);
+        create_paraloc_info_intern(p,side,p.paras,parasize);
         { append the varargs }
-        create_paraloc_info_intern(p,callerside,varargspara,parasize);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_paraloc_info_intern(p,side,varargspara,parasize)
+            else
+              internalerror(2019021924);
+          end;
+        create_funcretloc_info(p,side);
         result:=parasize;
       end;
 

compiler/llvm/agllvm.pas

@@ -210,9 +210,9 @@ implementation
               { escape dollars }
               '$':
                  result:=result+'$$';
-              { ^ is used as placeholder for a single dollar (reference to
+              { ` is used as placeholder for a single dollar (reference to
                  argument to the inline assembly) }
-              '^':
+              '`':
                  result:=result+'$';
               #0..#31,
               #127..#255,

compiler/llvm/llvmdef.pas

@@ -118,7 +118,8 @@ implementation
     fmodule,
     symtable,symconst,symsym,
     llvmsym,hlcgobj,
-    defutil,blockutl,cgbase,paramgr;
+    defutil,blockutl,cgbase,paramgr,
+    cpubase;
 
 
 {******************************************************************
@@ -667,9 +668,12 @@ implementation
 
     procedure llvmaddencodedparaloctype(hp: tparavarsym; proccalloption: tproccalloption; withparaname, withattributes: boolean; var first: boolean; var encodedstr: TSymStr);
       var
+        para: PCGPara;
         paraloc: PCGParaLocation;
+        side: tcallercallee;
         signext: tllvmvalueextension;
         usedef: tdef;
+        firstloc: boolean;
       begin
         if (proccalloption in cdecl_pocalls) and
            is_array_of_const(hp.vardef) then
@@ -681,20 +685,17 @@ implementation
             encodedstr:=encodedstr+'...';
             exit
           end;
-        if withparaname then
-          begin
-            { don't add parameters that don't take up registers or stack space;
-              clang doesn't either and some LLVM backends don't support them }
-            if hp.paraloc[calleeside].isempty then
-              exit;
-            paraloc:=hp.paraloc[calleeside].location
-          end
+        if not withparaname then
+          side:=callerside
         else
-          begin
-            if hp.paraloc[callerside].isempty then
-              exit;
-            paraloc:=hp.paraloc[callerside].location;
-          end;
+          side:=calleeside;
+        { don't add parameters that don't take up registers or stack space;
+          clang doesn't either and some LLVM backends don't support them }
+        if hp.paraloc[side].isempty then
+          exit;
+        para:[email protected][side];
+        paraloc:=para^.location;
+        firstloc:=true;
         repeat
           usedef:=paraloc^.def;
           llvmextractvalueextinfo(hp.vardef,usedef,signext);
@@ -723,15 +724,22 @@ implementation
 {$endif aarch64}
               if withattributes then
                  if first then
-                   encodedstr:=encodedstr+' sret'
-                 else { we can add some other attributes to optimise things,}
+                   encodedstr:=encodedstr+' sret noalias nocapture'
+                 else
                    encodedstr:=encodedstr+' noalias nocapture';
             end
           else if not paramanager.push_addr_param(hp.varspez,hp.vardef,proccalloption) and
              llvmbyvalparaloc(paraloc) then
             begin
               if withattributes then
-                encodedstr:=encodedstr+'* byval'
+                begin
+                  encodedstr:=encodedstr+'* byval';
+                  if firstloc and
+                     (para^.alignment<>std_param_align) then
+                    begin
+                      encodedstr:=encodedstr+' align '+tostr(para^.alignment);
+                    end;
+                end
               else
                 encodedstr:=encodedstr+'*';
             end
@@ -751,7 +759,7 @@ implementation
                     vs_value,
                     vs_const:
                       begin
-                        encodedstr:=encodedstr+' nocapture dereferenceable('
+                        encodedstr:=encodedstr+' dereferenceable('
                       end;
                     vs_var,
                     vs_out,
@@ -759,7 +767,7 @@ implementation
                       begin
                         { while normally these are not nil, it is technically possible
                           to pass nil via ptrtype(nil)^ }
-                        encodedstr:=encodedstr+' nocapture dereferenceable_or_null('
+                        encodedstr:=encodedstr+' dereferenceable_or_null('
                       end;
                     else
                       internalerror(2018120801);
@@ -777,6 +785,7 @@ implementation
               encodedstr:=encodedstr+' '+llvmasmsymname(paraloc^.llvmloc.sym);
             end;
           paraloc:=paraloc^.next;
+          firstloc:=false;
           first:=false;
         until not assigned(paraloc);
       end;
@@ -923,6 +932,7 @@ implementation
         retloc: pcgparalocation;
         usedef: tdef;
         valueext: tllvmvalueextension;
+        paraslots,
         i: longint;
         sizeleft: asizeint;
       begin
@@ -983,7 +993,19 @@ implementation
               end
             end
           else
-            retdeflist[i]:=retloc^.def;
+            begin
+              if retloc^.def.typ<>floatdef then
+                begin
+                  paraslots:=sizeleft div cgpara.Alignment;
+                  if (paraslots>1) and
+                     ((paraslots*cgpara.Alignment)=sizeleft) then
+                    retdeflist[i]:=carraydef.getreusable(cgsize_orddef(int_cgsize(cgpara.Alignment)),paraslots)
+                  else
+                    retdeflist[i]:=retloc^.def;
+                end
+              else
+                retdeflist[i]:=retloc^.def;
+            end;
           inc(i);
           retloc:=retloc^.next;
         until not assigned(retloc);

compiler/llvm/nllvmbas.pas

@@ -109,11 +109,11 @@ interface
 
     function tllvmasmnode.getllvmasmparasym(sym: tabstractnormalvarsym): tasmsymbol;
       begin
-        { these have to be transformed from ^nr into into $nr; we use ^ because
+        { these have to be transformed from `nr into into $nr; we use ` because
           we also have to double all other occurrences of '$' in the assembly
           code, and we can't differentiate between these and other '$'s in
           agllvm }
-        result:=current_asmdata.RefAsmSymbol('^'+tostr(getllvmasmopindexforsym(sym)),AT_DATA,false);
+        result:=current_asmdata.RefAsmSymbol('`'+tostr(getllvmasmopindexforsym(sym)),AT_DATA,false);
       end;
 
 

compiler/m68k/cpupara.pas

@@ -45,7 +45,7 @@ unit cpupara;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override;
           function get_volatile_registers_int(calloption:tproccalloption):tcpuregisterset;override;
           function get_volatile_registers_address(calloption:tproccalloption):tcpuregisterset;override;
@@ -675,18 +675,27 @@ unit cpupara;
         inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara);
       end;
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
       begin
         cur_stack_offset:=0;
 
-        result:=create_stdcall_paraloc_info(p,callerside,p.paras,cur_stack_offset);
+        result:=create_stdcall_paraloc_info(p,side,p.paras,cur_stack_offset);
         if (p.proccalloption in cstylearrayofconst) then
-          { just continue loading the parameters in the registers }
-          result:=create_stdcall_paraloc_info(p,callerside,varargspara,cur_stack_offset)
+          begin
+            { just continue loading the parameters in the registers }
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  result:=create_stdcall_paraloc_info(p,side,varargspara,cur_stack_offset)
+                else
+                  internalerror(2019021923);
+              end;
+          end
         else
           internalerror(200410231);
+        create_funcretloc_info(p,side);
       end;
 
 

compiler/mips/cpupara.pas

@@ -73,7 +73,7 @@ interface
         function  get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;override;
         function  get_saved_registers_int(calloption : tproccalloption):TCpuRegisterArray;override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
-        function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
+        function  create_varargs_paraloc_info(p : TAbstractProcDef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
         function  get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
         function  param_use_paraloc(const cgpara: tcgpara): boolean; override;
       private
@@ -490,7 +490,7 @@ implementation
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       begin
         intparareg:=0;
         intparasize:=0;
@@ -498,13 +498,20 @@ implementation
         { Create Function result paraloc }
         create_funcretloc_info(p,callerside);
         { calculate the registers for the normal parameters }
-        create_paraloc_info_intern(p,callerside,p.paras);
+        create_paraloc_info_intern(p,side,p.paras);
         { append the varargs }
         can_use_float := false;
         { restore correct intparasize value }
         if intparareg < 4 then
           intparasize:=intparareg * 4;
-        create_paraloc_info_intern(p,callerside,varargspara);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_paraloc_info_intern(p,side,varargspara)
+            else
+              internalerror(2019021922);
+          end;
+        create_funcretloc_info(p,side);
         { We need to return the size allocated on the stack }
         result:=intparasize;
       end;

compiler/mips/ncpuset.pas

@@ -33,9 +33,9 @@ uses
 type
   tcpucasenode = class(tcgcasenode)
   protected
-    procedure optimizevalues(var max_linear_list: aint; var max_dist: aword); override;
+    procedure optimizevalues(var max_linear_list: int64; var max_dist: qword); override;
     function has_jumptable: boolean; override;
-    procedure genjumptable(hp: pcaselabel; min_, max_: aint); override;
+    procedure genjumptable(hp: pcaselabel; min_, max_: int64); override;
   end;
 
 
@@ -50,7 +50,7 @@ uses
   cgbase, cgutils, cgobj,
   defutil,procinfo;
 
-procedure tcpucasenode.optimizevalues(var max_linear_list: aint; var max_dist: aword);
+procedure tcpucasenode.optimizevalues(var max_linear_list: int64; var max_dist: qword);
 begin
   { give the jump table a higher priority }
   max_dist := (max_dist * 3) div 2;
@@ -63,7 +63,7 @@ begin
 end;
 
 
-procedure tcpucasenode.genjumptable(hp: pcaselabel; min_, max_: aint);
+procedure tcpucasenode.genjumptable(hp: pcaselabel; min_, max_: int64);
 var
   table: tasmlabel;
   last:  TConstExprInt;
@@ -75,15 +75,23 @@ var
 
   procedure genitem(t: pcaselabel);
   var
-    i: aint;
+    i: TConstExprInt;
   begin
     if assigned(t^.less) then
       genitem(t^.less);
     { fill possible hole }
-    for i := last.svalue+1 to t^._low.svalue-1 do
-      jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,elselabel));
-    for i := t^._low.svalue to t^._high.svalue do
-      jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid)));
+    i:=last+1;
+    while i<=t^._low-1 do
+      begin
+        jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,elselabel));
+        i:=i+1;
+      end;
+    i:= t^._low;
+    while i<=t^._high do
+      begin
+        jumpSegment.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid)));
+        i:=i+1;
+      end;
     last := t^._high;
     if assigned(t^.greater) then
       genitem(t^.greater);

compiler/msg/errore.msg

@@ -1594,7 +1594,10 @@ parser_e_only_static_members_via_object_type=03349_E_Only static methods and sta
 %   TObj.test;
 % \end{verbatim}
 % \var{test} is not a static method and hence cannot be called through a type, but only using an instance.
-%
+parse_e_callthrough_varargs=03350_E_Cannot redeclare C-style variadic function "$1" as external on this platform; make its first declaration already external
+% If a function is declared normally in the interface or as a forward declaration, and then later as external, the compiler
+% must generate a stub that calls the external function. Due to code generation limitations, this cannot be done on some
+% platforms. Even on platforms where it is supported, this is quite inefficient.
 %
 % \end{description}
 %

compiler/msgidx.inc

@@ -460,6 +460,7 @@ const
   parser_w_operator_overloaded_hidden_3=03347;
   parser_e_threadvar_must_be_class=03348;
   parser_e_only_static_members_via_object_type=03349;
+  parse_e_callthrough_varargs=03350;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -1107,9 +1108,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 82796;
+  MsgTxtSize = 82926;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,106,350,126,99,59,142,34,221,67,
+    28,106,351,126,99,59,142,34,221,67,
     62,20,30,1,1,1,1,1,1,1
   );

compiler/nbas.pas

@@ -1093,10 +1093,6 @@ implementation
         { temps which are immutable do not need to be initialized/finalized }
         if (tempinfo^.typedef.needs_inittable) and not(ti_const in tempflags) then
           include(current_procinfo.flags,pi_needs_implicit_finally);
-        if (cs_create_pic in current_settings.moduleswitches) and
-           (tf_pic_uses_got in target_info.flags) and
-           is_rtti_managed_type(tempinfo^.typedef) then
-          include(current_procinfo.flags,pi_needs_got);
         if assigned(tempinfo^.withnode) then
           firstpass(tempinfo^.withnode);
         if assigned(tempinfo^.tempinitcode) then

compiler/ncal.pas

@@ -1086,19 +1086,6 @@ implementation
                       aktcallnode.procdefinition.proccalloption) then
           copy_value_by_ref_para;
 
-        { does it need to load RTTI? }
-        if assigned(parasym) and (parasym.varspez=vs_out) and
-           (cs_create_pic in current_settings.moduleswitches) and
-           (
-             is_rtti_managed_type(left.resultdef) or
-             (
-               is_open_array(resultdef) and
-               is_managed_type(tarraydef(resultdef).elementdef)
-             )
-           ) and
-           not(target_info.system in systems_garbage_collected_managed_types) then
-          include(current_procinfo.flags,pi_needs_got);
-
         if assigned(fparainit) then
           firstpass(fparainit);
         firstpass(left);
@@ -4382,11 +4369,6 @@ implementation
               ([cnf_member_call,cnf_inherited] * callnodeflags <> []) then
              current_procinfo.ConstructorCallingConstructor:=true;
 
-           { object check helper will load VMT -> needs GOT }
-           if (cs_check_object in current_settings.localswitches) and
-              (cs_create_pic in current_settings.moduleswitches) then
-             include(current_procinfo.flags,pi_needs_got);
-
            { Continue with checking a normal call or generate the inlined code }
            if cnf_do_inline in callnodeflags then
              result:=pass1_inline
@@ -4416,7 +4398,7 @@ implementation
 
          { calculate the parameter size needed for this call include varargs if they are available }
          if assigned(varargsparas) then
-           pushedparasize:=paramanager.create_varargs_paraloc_info(procdefinition,varargsparas)
+           pushedparasize:=paramanager.create_varargs_paraloc_info(procdefinition,callerside,varargsparas)
          else
            pushedparasize:=procdefinition.callerargareasize;
 

compiler/ncgrtti.pas

@@ -2022,9 +2022,6 @@ implementation
       begin
         s:=def.rtti_mangledname(rt)+suffix;
         result:=current_asmdata.RefAsmSymbol(s,AT_DATA,indirect);
-        if (cs_create_pic in current_settings.moduleswitches) and
-           assigned(current_procinfo) then
-          include(current_procinfo.flags,pi_needs_got);
         if def.owner.moduleid<>current_module.moduleid then
           current_module.add_extern_asmsym(s,AB_EXTERNAL,AT_DATA);
       end;

compiler/ncgset.pas

@@ -82,9 +82,9 @@ interface
           function GetBranchLabel(Block: TNode; out _Label: TAsmLabel): Boolean;
 
           function  blocklabel(id:longint):tasmlabel;
-          procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);virtual;
+          procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);virtual;
           function  has_jumptable : boolean;virtual;
-          procedure genjumptable(hp : pcaselabel;min_,max_ : aint); virtual;
+          procedure genjumptable(hp : pcaselabel;min_,max_ : int64); virtual;
           procedure genlinearlist(hp : pcaselabel); virtual;
           procedure genlinearcmplist(hp : pcaselabel); virtual;
 
@@ -613,7 +613,7 @@ implementation
       end;
 
 
-    procedure tcgcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure tcgcasenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         { no changes by default }
       end;
@@ -626,7 +626,7 @@ implementation
       end;
 
 
-    procedure tcgcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tcgcasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       begin
         internalerror(200209161);
       end;
@@ -827,7 +827,7 @@ implementation
 {$endif}
 {$endif cpuhighleveltarget}
                   begin
-                     hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, aint(t^._low.svalue),hregister, blocklabel(t^.blockid));
+                     hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, tcgint(t^._low.svalue),hregister, blocklabel(t^.blockid));
                   end;
                 { Reset last here, because we've only checked for one value and need to compare
                   for the next range both the lower and upper bound }
@@ -934,7 +934,7 @@ implementation
 {$endif}
 {$endif cpuhighleveltarget}
                        begin
-                        hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, aint(t^._low.svalue), hregister,
+                        hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, tcgint(t^._low.svalue), hregister,
                            elselabel);
                        end;
                   end;
@@ -1026,7 +1026,7 @@ implementation
 {$endif}
 {$endif cpuhighleveltarget}
                   begin
-                     hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_le, aint(t^._high.svalue), hregister, blocklabel(t^.blockid));
+                     hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_le, tcgint(t^._high.svalue), hregister, blocklabel(t^.blockid));
                   end;
 
                 last:=t^._high;
@@ -1165,8 +1165,8 @@ implementation
          distv,
          lv,hv,
          max_label: tconstexprint;
-         max_linear_list : aint;
-         max_dist : aword;
+         max_linear_list : int64;
+         max_dist : qword;
          ShortcutElse: Boolean;
       begin
          location_reset(location,LOC_VOID,OS_NO);

compiler/ncnv.pas

@@ -3177,9 +3177,6 @@ implementation
       begin
          result:=nil;
          expectloc:=LOC_REGISTER;
-         { Use of FPC_EMPTYCHAR label requires setting pi_needs_got flag }
-         if (cs_create_pic in current_settings.moduleswitches) then
-           include(current_procinfo.flags,pi_needs_got);
       end;
 
 
@@ -3604,9 +3601,6 @@ implementation
       begin
          first_ansistring_to_pchar:=nil;
          expectloc:=LOC_REGISTER;
-         { Use of FPC_EMPTYCHAR label requires setting pi_needs_got flag }
-         if (cs_create_pic in current_settings.moduleswitches) then
-           include(current_procinfo.flags,pi_needs_got);
       end;
 
 

compiler/ncon.pas

@@ -465,8 +465,6 @@ implementation
       begin
          result:=nil;
          expectloc:=LOC_CREFERENCE;
-         if (cs_create_pic in current_settings.moduleswitches) then
-           include(current_procinfo.flags,pi_needs_got);
       end;
 
 
@@ -868,9 +866,6 @@ implementation
           end
         else
           expectloc:=LOC_CREFERENCE;
-        if (cs_create_pic in current_settings.moduleswitches) and
-           (expectloc <> LOC_CONSTANT) then
-          include(current_procinfo.flags,pi_needs_got);
       end;
 
 
@@ -1160,9 +1155,6 @@ implementation
           expectloc:=LOC_CONSTANT
          else
           expectloc:=LOC_CREFERENCE;
-        if (cs_create_pic in current_settings.moduleswitches) and
-           (expectloc <> LOC_CONSTANT) then
-          include(current_procinfo.flags,pi_needs_got);
       end;
 
 
@@ -1254,9 +1246,6 @@ implementation
       begin
          result:=nil;
          expectloc:=LOC_CREFERENCE;
-        if (cs_create_pic in current_settings.moduleswitches) and
-          (tf_pic_uses_got in target_info.flags) then
-          include(current_procinfo.flags,pi_needs_got);
       end;
 
 

compiler/nflw.pas

@@ -2416,11 +2416,6 @@ implementation
       begin
          result:=nil;
          include(current_procinfo.flags,pi_do_call);
-         { Loads exception class VMT, therefore may need GOT
-           (generic code only; descendants may need to avoid this check) }
-         if (cs_create_pic in current_settings.moduleswitches) and
-           (tf_pic_uses_got in target_info.flags) then
-           include(current_procinfo.flags,pi_needs_got);
          expectloc:=LOC_VOID;
          if assigned(left) then
            firstpass(left);

compiler/nld.pas

@@ -400,9 +400,6 @@ implementation
       begin
          result:=nil;
          expectloc:=LOC_REFERENCE;
-         if (cs_create_pic in current_settings.moduleswitches) and
-           not(symtableentry.typ in [paravarsym,localvarsym]) then
-           include(current_procinfo.flags,pi_needs_got);
 
          case symtableentry.typ of
             absolutevarsym :
@@ -424,9 +421,6 @@ implementation
                 else
                   if (tabstractvarsym(symtableentry).varspez=vs_const) then
                     expectloc:=LOC_CREFERENCE;
-                if (target_info.system=system_powerpc_darwin) and
-                   ([vo_is_dll_var,vo_is_external] * tabstractvarsym(symtableentry).varoptions <> []) then
-                  include(current_procinfo.flags,pi_needs_got);
                 { call to get address of threadvar }
                 if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then
                   begin
@@ -1383,9 +1377,6 @@ implementation
       begin
         result:=nil;
         expectloc:=LOC_CREFERENCE;
-        if (cs_create_pic in current_settings.moduleswitches) and
-           (tf_pic_uses_got in target_info.flags) then
-          include(current_procinfo.flags,pi_needs_got);
       end;
 
 

compiler/nmem.pas

@@ -242,9 +242,6 @@ implementation
       begin
          result:=nil;
          expectloc:=LOC_REGISTER;
-         if (left.nodetype=typen) and
-            (cs_create_pic in current_settings.moduleswitches) then
-           include(current_procinfo.flags,pi_needs_got);
          if left.nodetype<>typen then
            begin
              if (is_objc_class_or_protocol(left.resultdef) or

compiler/paramgr.pas

@@ -140,7 +140,7 @@ unit paramgr;
             for the routine that are passed as varargs. It returns
             the size allocated on the stack (including the normal parameters)
           }
-          function  create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;virtual;abstract;
+          function  create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;virtual;abstract;
 
           function is_stack_paraloc(paraloc: pcgparalocation): boolean;virtual;
           procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);virtual;

compiler/pdecsub.pas

@@ -1520,6 +1520,13 @@ implementation
             internalerror(2015052202);
         end;
 
+        if (pd.proccalloption in cdecl_pocalls) and
+           (pd.paras.count>0) and
+           is_array_of_const(tparavarsym(pd.paras[pd.paras.count-1]).vardef) then
+          begin
+            include(pd.procoptions,po_variadic);
+          end;
+
         { file types can't be function results }
         if assigned(pd) and
            (pd.returndef.typ=filedef) then

compiler/pdecvar.pas

@@ -1591,14 +1591,13 @@ implementation
          sc : TFPObjectList;
          i  : longint;
          hs,sorg : string;
-         hdef,casetype,tmpdef : tdef;
+         hdef,casetype : tdef;
          { maxsize contains the max. size of a variant }
          { startvarrec contains the start of the variant part of a record }
          maxsize, startvarrecsize : longint;
          usedalign,
          maxalignment,startvarrecalign,
          maxpadalign, startpadalign: shortint;
-         stowner : tdef;
          pt : tnode;
          fieldvs   : tfieldvarsym;
          hstaticvs : tstaticvarsym;

compiler/powerpc/cpupara.pas

@@ -40,7 +40,7 @@ unit cpupara;
 
           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
@@ -628,7 +628,7 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         parasize, l: longint;
@@ -640,36 +640,27 @@ unit cpupara;
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
         firstfloatreg:=curfloatreg;
 
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false);
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false);
         if (p.proccalloption in cstylearrayofconst) then
           { just continue loading the parameters in the registers }
           begin
-            result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true);
+            if assigned(varargspara) then
+              begin
+                if side=callerside then
+                  result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true)
+                else
+                  internalerror(2019021921);
+                if curfloatreg<>firstfloatreg then
+                  include(varargspara.varargsinfo,va_uses_float_reg);
+              end;
             { varargs routines have to reserve at least 32 bytes for the AIX abi }
             if (target_info.abi in [abi_powerpc_aix,abi_powerpc_darwin]) and
                (result < 32) then
               result := 32;
            end
         else
-          begin
-            parasize:=cur_stack_offset;
-            for i:=0 to varargspara.count-1 do
-              begin
-                hp:=tparavarsym(varargspara[i]);
-                hp.paraloc[callerside].alignment:=4;
-                paraloc:=hp.paraloc[callerside].add_location;
-                paraloc^.loc:=LOC_REFERENCE;
-                paraloc^.size:=def_cgsize(hp.vardef);
-                paraloc^.def:=hp.vardef;
-                paraloc^.reference.index:=NR_STACK_POINTER_REG;
-                l:=push_size(hp.varspez,hp.vardef,p.proccalloption);
-                paraloc^.reference.offset:=parasize;
-                parasize:=parasize+l;
-              end;
-            result:=parasize;
-          end;
-        if curfloatreg<>firstfloatreg then
-          include(varargspara.varargsinfo,va_uses_float_reg);
+          internalerror(2019021710);
+        create_funcretloc_info(p,side);
       end;
 
 

compiler/powerpc64/cpupara.pas

@@ -45,8 +45,7 @@ type
 
     procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr: longint; var cgpara: tcgpara); override;
     function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
-    function create_varargs_paraloc_info(p: tabstractprocdef; varargspara:
-      tvarargsparalist): longint; override;
+    function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint; override;
     function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
 
   private
@@ -743,7 +742,7 @@ implemented
   end;
 end;
 
-function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef;
+function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee;
   varargspara: tvarargsparalist): longint;
 var
   cur_stack_offset: aword;
@@ -756,33 +755,28 @@ begin
   init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset);
   firstfloatreg := curfloatreg;
 
-  result := create_paraloc_info_intern(p, callerside, p.paras, curintreg,
+  result := create_paraloc_info_intern(p, side, p.paras, curintreg,
     curfloatreg, curmmreg, cur_stack_offset, false);
-  if (p.proccalloption in cstylearrayofconst) then begin
-    { just continue loading the parameters in the registers }
-    result := create_paraloc_info_intern(p, callerside, varargspara, curintreg,
-      curfloatreg, curmmreg, cur_stack_offset, true);
-    { varargs routines have to reserve at least 64 bytes for the PPC64 ABI }
-    if (result < 64) then
-      result := 64;
-  end else begin
-    parasize := cur_stack_offset;
-    for i := 0 to varargspara.count - 1 do begin
-      hp := tparavarsym(varargspara[i]);
-      hp.paraloc[callerside].alignment := 8;
-      paraloc := hp.paraloc[callerside].add_location;
-      paraloc^.loc := LOC_REFERENCE;
-      paraloc^.size := def_cgsize(hp.vardef);
-      paraloc^.def := hp.vardef;
-      paraloc^.reference.index := NR_STACK_POINTER_REG;
-      l := push_size(hp.varspez, hp.vardef, p.proccalloption);
-      paraloc^.reference.offset := parasize;
-      parasize := parasize + l;
-    end;
-    result := parasize;
-  end;
-  if curfloatreg <> firstfloatreg then
-    include(varargspara.varargsinfo, va_uses_float_reg);
+  if (p.proccalloption in cstylearrayofconst) then
+    begin
+      { just continue loading the parameters in the registers }
+      if assigned(varargspara) then
+        begin
+          if side=callerside then
+            result := create_paraloc_info_intern(p, side, varargspara, curintreg,
+              curfloatreg, curmmreg, cur_stack_offset, true)
+          else
+            internalerror(2019021920);
+          if curfloatreg <> firstfloatreg then
+            include(varargspara.varargsinfo, va_uses_float_reg);
+        end;
+      { varargs routines have to reserve at least 64 bytes for the PPC64 ABI }
+      if (result < 64) then
+        result := 64;
+    end
+  else
+    internalerror(2019021911);
+  create_funcretloc_info(p, side);
 end;
 
 function tcpuparamanager.parseparaloc(p: tparavarsym; const s: string): boolean;

compiler/ppcaarch64.lpi

@@ -43,7 +43,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="aarch64"/>
-      <OtherUnitFiles Value="aarch64;systems"/>
+      <OtherUnitFiles Value="armgen;aarch64;systems"/>
       <UnitOutputDirectory Value="aarch64\lazbuild"/>
     </SearchPaths>
     <Parsing>

compiler/ppcarm.lpi

@@ -62,7 +62,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="arm"/>
-      <OtherUnitFiles Value="arm;systems"/>
+      <OtherUnitFiles Value="armgen;arm;systems"/>
       <UnitOutputDirectory Value="arm\lazbuild"/>
     </SearchPaths>
     <Parsing>

compiler/ppcgen/ngppcset.pas

@@ -31,9 +31,9 @@ interface
     type
        tgppccasenode = class(tcgcasenode)
          protected
-           procedure optimizevalues(var max_linear_list : aint; var max_dist : aword);override;
+           procedure optimizevalues(var max_linear_list : int64; var max_dist : qword);override;
            function  has_jumptable : boolean;override;
-           procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+           procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
            procedure genlinearlist(hp : pcaselabel); override;
        end;
 
@@ -57,7 +57,7 @@ implementation
 *****************************************************************************}
 
 
-    procedure tgppccasenode.optimizevalues(var max_linear_list : aint; var max_dist : aword);
+    procedure tgppccasenode.optimizevalues(var max_linear_list : int64; var max_dist : qword);
     begin
       max_linear_list := 10;
     end;
@@ -69,7 +69,7 @@ implementation
       end;
 
 
-    procedure tgppccasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tgppccasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         table : tasmlabel;
         last : TConstExprInt;

compiler/psub.pas

@@ -297,11 +297,6 @@ implementation
                 include(current_procinfo.flags,pi_needs_implicit_finally);
                 include(current_procinfo.flags,pi_do_call);
               end;
-            if (tparavarsym(p).varspez in [vs_value,vs_out]) and
-               (cs_create_pic in current_settings.moduleswitches) and
-               (tf_pic_uses_got in target_info.flags) and
-               is_rtti_managed_type(tparavarsym(p).vardef) then
-              include(current_procinfo.flags,pi_needs_got);
           end;
       end;
 
@@ -316,10 +311,6 @@ implementation
           begin
             include(current_procinfo.flags,pi_needs_implicit_finally);
             include(current_procinfo.flags,pi_do_call);
-            if is_rtti_managed_type(tlocalvarsym(p).vardef) and
-              (cs_create_pic in current_settings.moduleswitches) and
-              (tf_pic_uses_got in target_info.flags) then
-              include(current_procinfo.flags,pi_needs_got);
           end;
       end;
 
@@ -2371,7 +2362,14 @@ implementation
                  if (not pd.forwarddef) and
                     (pd.hasforward) and
                     (proc_get_importname(pd)<>'') then
-                   call_through_new_name(pd,proc_get_importname(pd))
+                   begin
+                     { we cannot handle the callee-side of variadic functions (and
+                       even if we could, e.g. LLVM cannot call through to something
+                       else in that case) }
+                     if is_c_variadic(pd) then
+                       Message1(parse_e_callthrough_varargs,pd.fullprocname(false));
+                     call_through_new_name(pd,proc_get_importname(pd));
+                   end
                  else
 {$endif cpuhighleveltarget}
                    begin

compiler/rgobj.pas

@@ -1474,8 +1474,9 @@ unit rgobj;
       adj : psuperregisterworklist;
       maxlength,p,i :word;
       minweight: longint;
-      dist,
-      maxdist: Double;
+      {$ifdef SPILLING_NEW}
+      dist: Double;
+      {$endif}
     begin
 {$ifdef SPILLING_NEW}
       { This new approach for selecting the next spill candidate takes care of the weight of a register:

compiler/riscv/nrvset.pas

@@ -31,9 +31,9 @@ interface
     type
        trvcasenode = class(tcgcasenode)
          protected
-           procedure optimizevalues(var max_linear_list : aint; var max_dist : aword);override;
+           procedure optimizevalues(var max_linear_list : int64; var max_dist : qword);override;
            function  has_jumptable : boolean;override;
-           procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+           procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
        end;
 
 
@@ -56,7 +56,7 @@ implementation
 *****************************************************************************}
 
 
-    procedure trvcasenode.optimizevalues(var max_linear_list : aint; var max_dist : aword);
+    procedure trvcasenode.optimizevalues(var max_linear_list : int64; var max_dist : qword);
       begin
         max_linear_list := 3;
       end;
@@ -68,7 +68,7 @@ implementation
       end;
 
 
-    procedure trvcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure trvcasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         table : tasmlabel;
         last : TConstExprInt;

compiler/riscv32/cpupara.pas

@@ -39,7 +39,7 @@ unit cpupara;
 
           procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
          private
           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
@@ -505,7 +505,7 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         cur_stack_offset: aword;
         parasize, l: longint;
@@ -517,32 +517,23 @@ unit cpupara;
         init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset);
         firstfloatreg:=curfloatreg;
 
-        result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false);
+        result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false);
         if (p.proccalloption in cstylearrayofconst) then
           { just continue loading the parameters in the registers }
           begin
-            result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true);
-           end
-        else
-          begin
-            parasize:=cur_stack_offset;
-            for i:=0 to varargspara.count-1 do
+            if assigned(varargspara) then
               begin
-                hp:=tparavarsym(varargspara[i]);
-                hp.paraloc[callerside].alignment:=4;
-                paraloc:=hp.paraloc[callerside].add_location;
-                paraloc^.loc:=LOC_REFERENCE;
-                paraloc^.size:=def_cgsize(hp.vardef);
-                paraloc^.def:=hp.vardef;
-                paraloc^.reference.index:=NR_STACK_POINTER_REG;
-                l:=push_size(hp.varspez,hp.vardef,p.proccalloption);
-                paraloc^.reference.offset:=parasize;
-                parasize:=parasize+l;
+                if side=callerside then
+                  result:=create_paraloc_info_intern(p,side,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true)
+                else
+                  internalerror(2019021919);
+                if curfloatreg<>firstfloatreg then
+                  include(varargspara.varargsinfo,va_uses_float_reg);
               end;
-            result:=parasize;
-          end;
-        if curfloatreg<>firstfloatreg then
-          include(varargspara.varargsinfo,va_uses_float_reg);
+           end
+        else
+          internalerror(2019021912);
+        create_funcretloc_info(p,side);
       end;
 
 begin

compiler/riscv64/cpupara.pas

@@ -40,7 +40,7 @@ unit cpupara;
 
         procedure getintparaloc(list: TAsmList; pd : tabstractprocdef; nr: longint; var cgpara: tcgpara); override;
         function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
-        function create_varargs_paraloc_info(p: tabstractprocdef; varargspara: tvarargsparalist): longint; override;
+        function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint; override;
         function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
 
       private
@@ -490,7 +490,7 @@ implementation
         end;
       end;
 
-function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef;
+function tcpuparamanager.create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee;
   varargspara: tvarargsparalist): longint;
 var
   cur_stack_offset: aword;
@@ -503,33 +503,29 @@ begin
   init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset);
   firstfloatreg := curfloatreg;
 
-  result := create_paraloc_info_intern(p, callerside, p.paras, curintreg,
+  result := create_paraloc_info_intern(p, side, p.paras, curintreg,
     curfloatreg, curmmreg, cur_stack_offset, false);
-  if (p.proccalloption in [pocall_cdecl, pocall_cppdecl, pocall_mwpascal]) then begin
-    { just continue loading the parameters in the registers }
-    result := create_paraloc_info_intern(p, callerside, varargspara, curintreg,
-      curfloatreg, curmmreg, cur_stack_offset, true);
-    { varargs routines have to reserve at least 64 bytes for the RiscV ABI }
-    if (result < 64) then
-      result := 64;
-  end else begin
-    parasize := cur_stack_offset;
-    for i := 0 to varargspara.count - 1 do begin
-      hp := tparavarsym(varargspara[i]);
-      hp.paraloc[callerside].alignment := 8;
-      paraloc := hp.paraloc[callerside].add_location;
-      paraloc^.loc := LOC_REFERENCE;
-      paraloc^.size := def_cgsize(hp.vardef);
-      paraloc^.def := hp.vardef;
-      paraloc^.reference.index := NR_STACK_POINTER_REG;
-      l := push_size(hp.varspez, hp.vardef, p.proccalloption);
-      paraloc^.reference.offset := parasize;
-      parasize := parasize + l;
-    end;
-    result := parasize;
-  end;
-  if curfloatreg <> firstfloatreg then
-    include(varargspara.varargsinfo, va_uses_float_reg);
+  if (p.proccalloption in [pocall_cdecl, pocall_cppdecl, pocall_mwpascal]) then
+    begin
+      { just continue loading the parameters in the registers }
+      if assigned(varargspara) then
+        begin
+          if side=callerside then
+            result := create_paraloc_info_intern(p, side, varargspara, curintreg,
+              curfloatreg, curmmreg, cur_stack_offset, true)
+          else
+            internalerror(2019021918);
+          if curfloatreg <> firstfloatreg then
+            include(varargspara.varargsinfo, va_uses_float_reg);
+        end;
+      { varargs routines have to reserve at least 64 bytes for the RiscV ABI }
+      if (result < 64) then
+        result := 64;
+    end
+  else
+    internalerror(2019021913);
+
+  create_funcretloc_info(p, side);
 end;
 
 function tcpuparamanager.parseparaloc(p: tparavarsym; const s: string): boolean;

compiler/scanner.pas

@@ -572,13 +572,15 @@ implementation
            { Default to intel assembler for delphi/tp7 on i386/i8086 }
            if (m_delphi in current_settings.modeswitches) or
               (m_tp7 in current_settings.modeswitches) then
+             begin
 {$ifdef i8086}
-             current_settings.asmmode:=asmmode_i8086_intel;
+               current_settings.asmmode:=asmmode_i8086_intel;
 {$else i8086}
-             current_settings.asmmode:=asmmode_i386_intel;
+               current_settings.asmmode:=asmmode_i386_intel;
 {$endif i8086}
-           if changeinit then
-             init_settings.asmmode:=current_settings.asmmode;
+               if changeinit then
+                 init_settings.asmmode:=current_settings.asmmode;
+             end;
 {$endif i386 or i8086}
 
            { Exception support explicitly turned on (mainly for macpas, to }

compiler/sparcgen/ncpuset.pas

@@ -34,9 +34,9 @@ unit ncpuset;
     type
        tcpucasenode = class(tcgcasenode)
          protected
-           procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
+           procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
            function has_jumptable : boolean;override;
-           procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+           procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
        end;
 
 
@@ -50,7 +50,7 @@ unit ncpuset;
       cgbase,cgutils,cgobj,
       defutil,procinfo;
 
-    procedure tcpucasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure tcpucasenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         { give the jump table a higher priority }
         max_dist:=(max_dist*3) div 2;
@@ -63,7 +63,7 @@ unit ncpuset;
       end;
 
 
-    procedure tcpucasenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tcpucasenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         base,
         table : tasmlabel;
@@ -74,22 +74,22 @@ unit ncpuset;
 
         procedure genitem(list:TAsmList;t : pcaselabel);
           var
-            i : aint;
+            i : TConstExprInt;
           begin
             if assigned(t^.less) then
               genitem(list,t^.less);
             { fill possible hole }
-            i:=last.svalue+1;
-            while i<=t^._low.svalue-1 do
+            i:=last+1;
+            while i<=t^._low-1 do
               begin
                 list.concat(Tai_const.Create_rel_sym(aitconst_ptr,base,elselabel));
-                inc(i);
+                i:=i+1;
               end;
-            i:=t^._low.svalue;
-            while i<=t^._high.svalue do
+            i:=t^._low;
+            while i<=t^._high do
               begin
                 list.concat(Tai_const.Create_rel_sym(aitconst_ptr,base,blocklabel(t^.blockid)));
-                inc(i);
+                i:=i+1;
               end;
             last:=t^._high;
             if assigned(t^.greater) then

compiler/sparcgen/sppara.pas

@@ -35,7 +35,7 @@ interface
         function  get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet;override;
         function  get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;override;
         function  create_paraloc_info(p : TAbstractProcDef; side: tcallercallee):longint;override;
-        function  create_varargs_paraloc_info(p : TAbstractProcDef; varargspara:tvarargsparalist):longint;override;
+        function  create_varargs_paraloc_info(p : TAbstractProcDef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
         procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
                                              var curintreg: longint; curfloatreg: tsuperregister; var cur_stack_offset: aword);virtual;abstract;
       end;
@@ -66,7 +66,7 @@ implementation
       end;
 
 
-    function tsparcparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tsparcparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         curintreg : LongInt;
         curfloatreg : TSuperRegister;
@@ -76,9 +76,15 @@ implementation
         curfloatreg:=RS_F0;
         cur_stack_offset:=0;
         { calculate the registers for the normal parameters }
-        create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,cur_stack_offset);
+        create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,cur_stack_offset);
         { append the varargs }
-        create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,cur_stack_offset);
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,cur_stack_offset)
+            else
+              internalerror(2019021927);
+          end;
         result:=cur_stack_offset;
       end;
 

compiler/symconst.pas

@@ -415,7 +415,10 @@ type
     { procedure is an automatically generated property setter }
     po_is_auto_setter,
     { must never be inlined          by auto-inlining }
-    po_noinline
+    po_noinline,
+    { same as po_varargs, but with an array-of-const parameter instead of with the
+      "varargs" modifier or Mac-Pascal ".." parameter }
+    po_variadic
   );
   tprocoptions=set of tprocoption;
 
@@ -1027,7 +1030,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
       'C-style blocks',{po_is_block}
       'po_is_auto_getter',{po_is_auto_getter}
       'po_is_auto_setter',{po_is_auto_setter}
-      'po_noinline'{po_noinline}
+      'po_noinline',{po_noinline}
+      'C-style array-of-const' {po_variadic}
     );
 
 implementation

compiler/symdef.pas

@@ -1820,6 +1820,8 @@ implementation
 {$endif}
          generictokenbuf:=nil;
          genericdef:=nil;
+         typesymderef.reset;
+         genericdefderef.reset;
 
          { Don't register forwarddefs, they are disposed at the
            end of an type block }
@@ -2616,6 +2618,7 @@ implementation
          calcsavesize(current_settings.packenum);
          has_jumps:=false;
          basedef:=nil;
+         basedefderef.reset;
          symtable:=tenumsymtable.create(self);
       end;
 
@@ -3127,6 +3130,7 @@ implementation
          inherited create(filedef,true);
          filetyp:=ft_text;
          typedfiledef:=nil;
+         typedfiledefderef.reset;
       end;
 
 
@@ -3355,6 +3359,7 @@ implementation
       begin
         inherited create(dt,true);
         pointeddef:=def;
+        pointeddefderef.reset;
         if df_generic in pointeddef.defoptions then
           include(defoptions,df_generic);
         if df_specialization in pointeddef.defoptions then
@@ -3605,6 +3610,7 @@ implementation
       begin
          inherited create(setdef,doregister);
          elementdef:=def;
+         elementdefderef.reset;
          setmax:=high;
          actual_setalloc:=current_settings.setalloc;
 {$if defined(cpu8bitalu) or defined(cpu16bitalu)}
@@ -3749,7 +3755,9 @@ implementation
          lowrange:=l;
          highrange:=h;
          rangedef:=def;
+         rangedefderef.reset;
          _elementdef:=nil;
+         _elementdefderef.reset;
          arrayoptions:=[];
          symtable:=tarraysymtable.create(self);
       end;
@@ -4486,6 +4494,7 @@ implementation
          if symtable.refcount=1 then
            symtable.defowner:=self;
          isunion:=false;
+         cloneddefderef.reset;
       end;
 
 
@@ -4818,6 +4827,7 @@ implementation
          proccalloption:=pocall_none;
          procoptions:=[];
          returndef:=voidtype;
+         returndefderef.reset;
          savesize:=sizeof(pint);
          callerargareasize:=0;
          calleeargareasize:=0;
@@ -5284,7 +5294,10 @@ implementation
         if (side in [callerside,callbothsides]) and
            not(has_paraloc_info in [callerside,callbothsides]) then
           begin
-            callerargareasize:=paramanager.create_paraloc_info(self,callerside);
+            if not is_c_variadic(self) then
+              callerargareasize:=paramanager.create_paraloc_info(self,callerside)
+            else
+              callerargareasize:=paramanager.create_varargs_paraloc_info(self,callerside,nil);
             if has_paraloc_info in [calleeside,callbothsides] then
               has_paraloc_info:=callbothsides
             else
@@ -5293,7 +5306,10 @@ implementation
         if (side in [calleeside,callbothsides]) and
            not(has_paraloc_info in [calleeside,callbothsides]) then
           begin
-            calleeargareasize:=paramanager.create_paraloc_info(self,calleeside);
+            if not is_c_variadic(self) then
+              calleeargareasize:=paramanager.create_paraloc_info(self,calleeside)
+            else
+              callerargareasize:=paramanager.create_varargs_paraloc_info(self,calleeside,nil);
             if has_paraloc_info in [callerside,callbothsides] then
               has_paraloc_info:=callbothsides
             else
@@ -5617,10 +5633,13 @@ implementation
          extnumber:=$ffff;
          aliasnames:=TCmdStrList.create;
          funcretsym:=nil;
+         funcretsymderef.reset;
+         procsymderef.reset;
          forwarddef:=true;
          interfacedef:=false;
          hasforward:=false;
          struct := nil;
+         structderef.reset;
          import_dll:=nil;
          import_name:=nil;
          import_nr:=0;
@@ -6738,6 +6757,10 @@ implementation
         fcurrent_dispid:=0;
         objecttype:=ot;
         childof:=nil;
+        childofderef.reset;
+        vmt_fieldderef.reset;
+        extendeddefderef.reset;
+        cloneddefderef.reset;
         if objecttype=odt_helper then
           owner.includeoption(sto_has_helper);
         symtable:=tObjectSymtable.create(self,n,current_settings.packrecords,
@@ -7788,6 +7811,7 @@ implementation
       begin
         inherited create;
         intfdef:=aintf;
+        intfdefderef.reset;
         IOffset:=-1;
         IType:=etStandard;
         NameMappings:=nil;

compiler/symsym.pas

@@ -753,6 +753,7 @@ implementation
       begin
          inherited create(namespacesym,n,true);
          unitsym:=nil;
+         unitsymderef.reset;
       end;
 
     constructor tnamespacesym.ppuload(ppufile:tcompilerppufile);
@@ -1333,7 +1334,9 @@ implementation
          index:=0;
          default:=0;
          propdef:=nil;
+         propdefderef.reset;
          indexdef:=nil;
+         indexdefderef.reset;
          parast:=nil;
          for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do
            propaccesslist[pap]:=tpropaccesslist.create;
@@ -1590,6 +1593,7 @@ implementation
       begin
          inherited create(st,n,doregister);
          vardef:=def;
+         vardefderef.reset;
          varspez:=vsp;
          varstate:=vs_declared;
          varoptions:=vopts;
@@ -1839,6 +1843,7 @@ implementation
          fillchar(localloc,sizeof(localloc),0);
          fillchar(initialloc,sizeof(initialloc),0);
          defaultconstsym:=nil;
+         defaultconstsymderef.reset;
       end;
 
 
@@ -1897,6 +1902,7 @@ implementation
     constructor tstaticvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions;doregister:boolean);
       begin
          inherited create(staticvarsym,n,vsp,def,vopts,doregister);
+         fieldvarsymderef.reset;
 {$ifdef symansistr}
          _mangledname:='';
 {$else symansistr}
@@ -2298,6 +2304,7 @@ implementation
          consttyp:=t;
          value.valueord:=v;
          constdef:=def;
+         constdefderef.reset;
       end;
 
 
@@ -2308,6 +2315,7 @@ implementation
          consttyp:=t;
          value.valueordptr:=v;
          constdef:=def;
+         constdefderef.reset;
       end;
 
 
@@ -2318,6 +2326,7 @@ implementation
          consttyp:=t;
          value.valueptr:=v;
          constdef:=def;
+         constdefderef.reset;
       end;
 
 
@@ -2331,6 +2340,7 @@ implementation
            constdef:=def
          else
            constdef:=carraydef.getreusable(cansichartype,l);
+         constdefderef.reset;
          value.len:=l;
       end;
 
@@ -2342,6 +2352,7 @@ implementation
          consttyp:=t;
          pcompilerwidestring(value.valueptr):=pw;
          constdef:=carraydef.getreusable(cwidechartype,getlengthwidestring(pw));
+         constdefderef.reset;
          value.len:=getlengthwidestring(pw);
       end;
 
@@ -2532,6 +2543,7 @@ implementation
       begin
          inherited create(enumsym,n,true);
          definition:=def;
+         definitionderef.reset;
          value:=v;
       end;
 
@@ -2576,6 +2588,7 @@ implementation
       begin
         inherited create(typesym,n,doregister);
         typedef:=def;
+        typedefderef.reset;
         { register the typesym for the definition }
         if assigned(typedef) and
            (typedef.typ<>errordef) and

compiler/symtable.pas

@@ -732,6 +732,7 @@ implementation
         newbuiltdefderefs,
         builtdefderefs,
         builtsymderefs: array of boolean;
+        changed: boolean;
       begin
         newbuiltdefderefs:=nil;
         builtdefderefs:=nil;
@@ -749,6 +750,7 @@ implementation
           { current number of registered defs/syms }
           defidmax:=current_module.deflist.count;
           symidmax:=current_module.symlist.count;
+          changed:=false;
 
           { build the derefs for the registered defs we haven't processed yet }
           for i:=0 to DefList.Count-1 do
@@ -761,6 +763,7 @@ implementation
                       def.buildderef;
                       newbuiltdefderefs[i]:=true;
                       builtdefderefs[i]:=true;
+                      changed:=true;
                     end;
                 end;
             end;
@@ -774,6 +777,7 @@ implementation
                     begin
                       sym.buildderef;
                       builtsymderefs[i]:=true;
+                      changed:=true;
                     end;
                 end;
             end;
@@ -784,12 +788,13 @@ implementation
                 begin
                   newbuiltdefderefs[i]:=false;
                   tstoreddef(DefList[i]).buildderefimpl;
+                  changed:=true;
                 end;
             end;
         { stop when no new defs or syms have been registered while processing
           the currently registered ones (defs/syms get added to the module's
           deflist/symlist when they are registered) }
-        until
+        until not changed and 
           (defidmax=current_module.deflist.count) and
           (symidmax=current_module.symlist.count);
       end;

compiler/symtype.pas

@@ -1103,7 +1103,10 @@ implementation
       begin
         oldcrc:=do_crc;
         do_crc:=false;
-        putlongint(d.dataidx);
+        if d.dataidx=-1 then
+          internalerror(2019022201)
+        else
+          putlongint(d.dataidx);
         do_crc:=oldcrc;
       end;
 

compiler/utils/ppuutils/ppudump.pp

@@ -2016,7 +2016,8 @@ const
      (mask:po_is_block;        str: 'C "Block"'),
      (mask:po_is_auto_getter;  str: 'Automatically generated getter'),
      (mask:po_is_auto_setter;  str: 'Automatically generated setter'),
-     (mask:po_noinline;        str: 'Never inline')
+     (mask:po_noinline;        str: 'Never inline'),
+     (mask:po_variadic;        str: 'C VarArgs with array-of-const para')
   );
 var
   proctypeoption  : tproctypeoption;

compiler/x86/cgx86.pas

@@ -902,10 +902,7 @@ unit cgx86;
                { darwin's assembler doesn't want @PLT after call symbols }
                not(target_info.system in [system_x86_64_darwin,system_i386_iphonesim,system_x86_64_iphonesim]) then
               begin
-{$ifdef i386}
-                include(current_procinfo.flags,pi_needs_got);
-{$endif i386}
-                r.refaddr:=addr_pic
+                r.refaddr:=addr_pic;
               end
             else
               r.refaddr:=addr_full;

compiler/x86/nx86ld.pas

@@ -102,6 +102,7 @@ implementation
                       begin
                         if not(cs_create_pic in current_settings.moduleswitches) then
                           Internalerror(2018110701);
+                        include(current_procinfo.flags,pi_needs_got);
                         reference_reset(href,0,[]);
                         location.reference.index:=current_procinfo.got;
                         location.reference.scalefactor:=1;

compiler/x86/nx86set.pas

@@ -37,7 +37,7 @@ interface
 
       tx86casenode = class(tcgcasenode)
          function  has_jumptable : boolean;override;
-         procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+         procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
          procedure genlinearlist(hp : pcaselabel);override;
          procedure genjmptreeentry(p : pcaselabel;parentvalue : TConstExprInt);override;
       end;
@@ -66,7 +66,7 @@ implementation
       end;
 
 
-    procedure tx86casenode.genjumptable(hp : pcaselabel;min_,max_ : aint);
+    procedure tx86casenode.genjumptable(hp : pcaselabel;min_,max_ : int64);
       var
         table : tasmlabel;
         last : TConstExprInt;
@@ -78,30 +78,30 @@ implementation
         labeltyp: taiconst_type;
         AlmostExhaustive: Boolean;
         lv, hv: TConstExprInt;
-        ExhaustiveLimit, Range, x, oldmin : aint;
+        ExhaustiveLimit, Range, x, oldmin : int64;
 
       const
         ExhaustiveLimitBase = 32;
 
         procedure genitem(list:TAsmList;t : pcaselabel);
           var
-            i : aint;
+            i : TConstExprInt;
           begin
             if assigned(t^.less) then
               genitem(list,t^.less);
 
             { fill possible hole }
-            i:=last.svalue+1;
-            while i<=t^._low.svalue-1 do
+            i:=last+1;
+            while i<=t^._low-1 do
               begin
                 list.concat(Tai_const.Create_type_sym(labeltyp,elselabel));
-                inc(i);
+                i:=i+1;
               end;
-            i:=t^._low.svalue;
-            while i<=t^._high.svalue do
+            i:=t^._low;
+            while i<=t^._high do
               begin
                 list.concat(Tai_const.Create_type_sym(labeltyp,blocklabel(t^.blockid)));
-                inc(i);
+                i:=i+1;
               end;
             last:=t^._high;
             if assigned(t^.greater) then
@@ -176,6 +176,7 @@ implementation
             cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,jumpreg);
             cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,current_procinfo.got,jumpreg);
             emit_reg(A_JMP,S_NO,jumpreg);
+            include(current_procinfo.flags,pi_needs_got);
           end
         else
           emit_ref(A_JMP,S_NO,href);

compiler/x86_64/cpupara.pas

@@ -46,7 +46,7 @@ unit cpupara;
           function get_saved_registers_int(calloption : tproccalloption):tcpuregisterarray;override;
           function get_saved_registers_mm(calloption: tproccalloption):tcpuregisterarray;override;
           function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
-          function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
+          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
           function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
        end;
 
@@ -1946,7 +1946,7 @@ unit cpupara;
       end;
 
 
-    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
+    function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         intparareg,mmparareg,
         parasize : longint;
@@ -1958,11 +1958,18 @@ unit cpupara;
         else
           parasize:=0;
         { calculate the registers for the normal parameters }
-        create_paraloc_info_intern(p,callerside,p.paras,intparareg,mmparareg,parasize,false);
+        create_paraloc_info_intern(p,side,p.paras,intparareg,mmparareg,parasize,false);
         { append the varargs }
-        create_paraloc_info_intern(p,callerside,varargspara,intparareg,mmparareg,parasize,true);
-        { store used no. of SSE registers, that needs to be passed in %AL }
-        varargspara.mmregsused:=mmparareg;
+        if assigned(varargspara) then
+          begin
+            if side=callerside then
+              create_paraloc_info_intern(p,side,varargspara,intparareg,mmparareg,parasize,true)
+            else
+              internalerror(2019021917);
+            { store used no. of SSE registers, that needs to be passed in %AL }
+            varargspara.mmregsused:=mmparareg;
+          end;
+        create_funcretloc_info(p,side);
         result:=parasize;
       end;
 

compiler/x86_64/nx64set.pas

@@ -32,8 +32,8 @@ interface
 
     type
       tx8664casenode = class(tx86casenode)
-         procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
-         procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override;
+         procedure optimizevalues(var max_linear_list:int64;var max_dist:qword);override;
+         procedure genjumptable(hp : pcaselabel;min_,max_ : int64);override;
       end;
 
 
@@ -53,7 +53,7 @@ implementation
                             TX8664CASENODE
 *****************************************************************************}
 
-    procedure tx8664casenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
+    procedure tx8664casenode.optimizevalues(var max_linear_list:int64;var max_dist:qword);
       begin
         inc(max_linear_list,9);
       end;
@@ -61,7 +61,7 @@ implementation
 
     { Always generate position-independent jump table, it is twice less in size at a price
       of two extra instructions (which shouldn't cause more slowdown than pipeline trashing) }
-    procedure tx8664casenode.genjumptable(hp : pcaselabel; min_,max_ : aint);
+    procedure tx8664casenode.genjumptable(hp : pcaselabel; min_,max_ : int64);
       var
         last: TConstExprInt;
         tablelabel: TAsmLabel;
@@ -80,22 +80,22 @@ implementation
 
       procedure genitem(t : pcaselabel);
         var
-          i : aint;
+          i : TConstExprInt;
         begin
           if assigned(t^.less) then
             genitem(t^.less);
           { fill possible hole }
-          i:=last.svalue+1;
-          while i<=t^._low.svalue-1 do
+          i:=last+1;
+          while i<=t^._low-1 do
             begin
               jtlist.concat(Tai_const.Create_rel_sym(jtitemconsttype,tablelabel,elselabel));
-              inc(i);
+              i:=i+1;
             end;
-          i:=t^._low.svalue;
-          while i<=t^._high.svalue do
+          i:=t^._low;
+          while i<=t^._high do
             begin
               jtlist.concat(Tai_const.Create_rel_sym(jtitemconsttype,tablelabel,blocklabel(t^.blockid)));
-              inc(i);
+              i:=i+1;
             end;
           last:=t^._high;
           if assigned(t^.greater) then

packages/fcl-db/fpmake.pp

@@ -831,6 +831,9 @@ begin
     with T.Dependencies do
       AddUnit('fpjsondataset');
 
+    T:=P.Targets.AddUnit('sqldbini.pp');
+    with T.Dependencies do
+      AddUnit('sqldb');
 
     P.ExamplePath.Add('tests');
     T:=P.Targets.AddExampleProgram('dbftoolsunit.pas', DBaseOSes);

packages/fcl-db/src/sqldb/sqldbini.pp

@@ -0,0 +1,219 @@
+unit sqldbini;
+
+{$mode objfpc}{$H+}
+{$modeswitch typehelpers}
+
+interface
+
+uses
+  Classes, SysUtils, sqldb, inifiles, strutils;
+
+Type
+  TSQLDBIniOption = (sioClearOnRead,      // Clear values first
+                     sioSkipPassword,     // Do not save/load password
+                     sioSkipMaskPassword, // do not mask the password
+                     sioUserNameAsMask,   // use the username as mask for password
+                     sioSkipParams        // Do not read/write params.
+                     );
+  TSQLDBIniOptions = set of TSQLDBIniOption;
+
+  { TSQLDBIniHelper }
+
+  TSQLDBIniHelper = class helper for TSQLConnection
+  Private
+    Procedure ClearValues;
+  Public
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; aOptions : TSQLDBIniOptions = []); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TSQLDBIniOptions); overload;
+    Procedure LoadFromFile(Const aFileName : String; aOptions : TSQLDBIniOptions = []); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String; aOptions : TSQLDBIniOptions); overload;
+    Procedure SaveToFile(Const aFileName : String; aOptions : TSQLDBIniOptions = []);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String; aOptions : TSQLDBIniOptions = []);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; aOptions : TSQLDBIniOptions = []); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TSQLDBIniOptions); overload;
+  end;
+
+Var
+  TrivialEncryptKey : String = 'SQLDB';
+  DefaultSection : String = 'Connection';
+
+implementation
+
+{ TSQLDBIniHelper }
+
+procedure TSQLDBIniHelper.ClearValues;
+begin
+  HostName:='';
+  DatabaseName:='';
+  UserName:='';
+  Password:='';
+  CharSet:='';
+  Params.Clear;
+  Port:=0;
+end;
+
+
+Const
+  KeyHost = 'Host';
+  KeyDatabaseName = 'DatabaseName';
+  KeyUserName = 'UserName';
+  KeyPassword = 'Password';
+  KeyPort = 'Port';
+  keyParams = 'Params';
+  KeyCharset = 'Charset';
+  KeyRole = 'Role';
+
+Const
+  ForbiddenParamKeys : Array[1..8] of unicodestring
+                     = (keyHost,KeyDatabaseName,KeyUserName,KeyPassword,KeyPort,keyParams,keyCharSet,keyRole);
+  ParamSeps = [',',';',' '];
+
+procedure TSQLDBIniHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String; aOptions: TSQLDBIniOptions);
+
+Var
+  M,N,P : String;
+  I : integer;
+
+begin
+  With aIni do
+    begin
+    if (sioClearOnRead in aOptions) then
+       ClearValues;
+    HostName:=ReadString(ASection,KeyHost,HostName);
+    DatabaseName:=ReadString(ASection,KeyDatabaseName,DatabaseName);
+    UserName:=ReadString(ASection,KeyUserName,UserName);
+    CharSet:=ReadString(ASection,KeyCharset,CharSet);
+    Role:=ReadString(ASection,KeyRole,Role);
+    Port:=ReadInteger(ASection,KeyPort,Port);
+    // optional parts
+    if not (sioSkipPassword in aOptions) then
+      begin
+      if sioSkipMaskPassword in aOptions then
+        P:=ReadString(ASection,KeyPassword,Password)
+      else
+        begin
+        P:=ReadString(ASection,KeyPassword,'');
+        if (P<>'') then
+          begin
+          if sioUserNameAsMask in aOptions then
+            M:=UserName
+          else
+            M:=TrivialEncryptKey;
+          P:=XorDecode(M,P);
+          end;
+        end;
+      Password:=P;
+      end;
+    if not (sioSkipParams in aOptions) then
+      begin
+      M:=ReadString(ASection,keyParams,'');
+      For I:=1 to WordCount(M,ParamSeps) do
+        begin
+        N:=ExtractWord(I,M,ParamSeps);
+        if IndexStr(Utf8Decode(N),ForbiddenParamKeys)=-1 then
+          begin
+          P:=ReadString(ASection,N,'');
+          Params.Values[N]:=P;
+          end;
+        end;
+      end;
+    end;
+end;
+
+procedure TSQLDBIniHelper.LoadFromIni(const aIni: TCustomIniFile; aOptions: TSQLDBIniOptions);
+begin
+  LoadFromIni(aIni,Defaultsection,aOptions);
+end;
+
+procedure TSQLDBIniHelper.LoadFromFile(const aFileName: String; aOptions: TSQLDBIniOptions);
+
+
+begin
+  Loadfromfile(aFileName,DefaultSection,aOptions);
+end;
+
+procedure TSQLDBIniHelper.LoadFromFile(const aFileName: String; const ASection: String; aOptions: TSQLDBIniOptions);
+
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBIniHelper.SaveToFile(const aFileName: String; aOptions: TSQLDBIniOptions);
+begin
+  SaveToFile(aFileName,DefaultSection,aOptions);
+end;
+
+procedure TSQLDBIniHelper.SaveToFile(const aFileName: String; const ASection: String; aOptions: TSQLDBIniOptions);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToini(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBIniHelper.SaveToIni(const aIni: TCustomIniFile; aOptions: TSQLDBIniOptions);
+begin
+  SaveToIni(aIni,DefaultSection,aOptions);
+end;
+
+procedure TSQLDBIniHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String; aOptions: TSQLDBIniOptions);
+Var
+  M,N,P : String;
+  I : integer;
+
+begin
+  With aIni do
+    begin
+    WriteString(ASection,KeyHost,HostName);
+    WriteString(ASection,KeyDatabaseName,DatabaseName);
+    WriteString(ASection,KeyUserName,UserName);
+    WriteString(ASection,KeyCharset,CharSet);
+    WriteString(ASection,KeyRole,Role);
+    WriteInteger(ASection,KeyPort,Port);
+    if not (sioSkipPassword in aOptions) then
+      begin
+      P:=Password;
+      if Not (sioSkipMaskPassword in aOptions) then
+        begin
+        if sioUserNameAsMask in aOptions then
+          M:=UserName
+        else
+          M:=TrivialEncryptKey;
+        P:=XorEncode(M,P);
+        end;
+      WriteString(ASection,KeyPassword,P);
+      end;
+    if not (sioSkipParams in aOptions) then
+      begin
+      M:='';
+      for I:=0 to Params.Count-1 do
+        begin
+        Params.GetNameValue(I,N,P);
+        if (N<>'') and (IndexStr(Utf8Decode(N),ForbiddenParamKeys)=-1) then
+          begin
+          WriteString(ASection,N,P);
+          if (M<>'') then
+            M:=M+',';
+          M:=M+N;
+          end;
+        end;
+      WriteString(ASection,KeyParams,M);
+      end;
+    end;
+end;
+
+end.
+

packages/fcl-image/examples/imgconv.pp

@@ -17,7 +17,7 @@ program ImgConv;
 
 {_$define UseFile}
 
-uses FPWriteXPM, FPWritePNG, FPWriteBMP,
+uses FPWriteXPM, FPWritePNG, FPWriteBMP,fpreadgif,
      FPReadXPM, FPReadPNG, FPReadBMP, fpreadjpeg,fpwritejpeg,
      fpreadtga,fpwritetga,fpreadpnm,fpwritepnm, fpreadtiff, fpwritetiff,
      {$ifndef UseFile}classes,{$endif}
@@ -40,6 +40,8 @@ begin
       Reader := TFPReaderBMP.Create
     else if T = 'J' then
       Reader := TFPReaderJPEG.Create
+    else if T = 'G' then
+      Reader := TFPReaderGif.Create
     else if T = 'P' then
       Reader := TFPReaderPNG.Create
     else if T = 'T' then
@@ -154,7 +156,7 @@ begin
     begin
     writeln ('Give filename to read and to write, preceded by filetype:');
     writeln ('X for XPM, P for PNG, B for BMP, J for JPEG, T for TGA,');
-    writeln ('N for PNM (read only), F for TIFF');
+    writeln ('N for PNM (read only), F for TIFF, G for gif (read only)');
     writeln ('example: imgconv X hello.xpm P hello.png');
     writeln ('example: imgconv hello.xpm P hello.png');
     writeln ('Options for');

packages/fcl-image/src/fpreadgif.pas

@@ -303,8 +303,8 @@ begin
       end;
     until (B = 0)  or (Stream.Position>=Stream.Size);
     
-    if Stream.Position>=Stream.Size then 
-      Exit(False);
+   { if Stream.Position>=Stream.Size then 
+      Exit(False); }
 
     Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),
              False, Rect(0,0,0,0), '', ContProgress);
@@ -323,8 +323,8 @@ begin
       end;
     until (B = 0) or (Stream.Position>=Stream.Size);
     
-    if Stream.Position>=Stream.Size then
-       Exit(False);
+   { if Stream.Position>=Stream.Size then
+       Exit(False); }
               
 
     Progress(psRunning, trunc(100.0 * (Stream.position / Stream.size)),

packages/fcl-passrc/src/pasresolveeval.pas

@@ -184,6 +184,9 @@ const
   nBitWiseOperationsAre32Bit = 3118;
   nImplictConversionUnicodeToAnsi = 3119;
   nWrongTypeXInArrayConstructor = 3120;
+  nUnknownCustomAttributeX = 3121;
+  nAttributeIgnoredBecauseAbstractX = 3122;
+  nCreatingAnInstanceOfAbstractClassY = 3123;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -315,6 +318,9 @@ resourcestring
   sBitWiseOperationsAre32Bit = 'Bitwise operations are 32-bit';
   sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
   sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
+  sUnknownCustomAttributeX = 'Unknown custom attribute "%s"';
+  sAttributeIgnoredBecauseAbstractX = 'attribute ignored because abstract %s';
+  sCreatingAnInstanceOfAbstractClassY = 'Creating an instance of abstract class "%s"';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }
@@ -361,7 +367,7 @@ const
   MinSafeIntSingle = -16777216;
   MaxSafeIntSingle =  16777216;
   MaskUIntSingle = $3fffff;
-  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 53 bits (52 explicitly stored)
+  MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 54 bits (52 plus signed bit plus implicit highest bit)
   MaxSafeIntDouble =  $1fffffffffffff; //  9007199254740991
   MaskUIntDouble = $1fffffffffffff;
 

packages/fcl-passrc/src/pasresolver.pp

@@ -1065,9 +1065,24 @@ type
     class function IsStoredInElement: boolean; override;
   end;
 
+  { TPasDotBaseScope }
+
+  TPasDotBaseScope = Class(TPasSubExprScope)
+  public
+    GroupScope: TPasGroupScope;
+    OnlyTypeMembers: boolean; // true=only class var/procs, false=default=all
+    ConstParent: boolean;
+    function FindIdentifier(const Identifier: String): TPasIdentifier; override;
+    procedure IterateElements(const aName: string; StartScope: TPasScope;
+      const OnIterateElement: TIterateScopeElement; Data: Pointer;
+      var Abort: boolean); override;
+    procedure WriteIdentifiers(Prefix: string); override;
+    destructor Destroy; override;
+  end;
+
   { TPasModuleDotScope - scope for searching unitname.<identifier> }
 
-  TPasModuleDotScope = Class(TPasSubExprScope)
+  TPasModuleDotScope = Class(TPasDotBaseScope)
   private
     FModule: TPasModule;
     procedure OnInternalIterate(El: TPasElement; ElScope, StartScope: TPasScope;
@@ -1086,21 +1101,6 @@ type
     property Module: TPasModule read FModule write SetModule;
   end;
 
-  { TPasDotBaseScope }
-
-  TPasDotBaseScope = Class(TPasSubExprScope)
-  public
-    GroupScope: TPasGroupScope;
-    OnlyTypeMembers: boolean; // true=only class var/procs, false=default=all
-    ConstParent: boolean;
-    function FindIdentifier(const Identifier: String): TPasIdentifier; override;
-    procedure IterateElements(const aName: string; StartScope: TPasScope;
-      const OnIterateElement: TIterateScopeElement; Data: Pointer;
-      var Abort: boolean); override;
-    procedure WriteIdentifiers(Prefix: string); override;
-    destructor Destroy; override;
-  end;
-
   { TPasDotEnumTypeScope - used for EnumType.EnumValue }
 
   TPasDotEnumTypeScope = Class(TPasDotBaseScope)
@@ -1204,11 +1204,18 @@ type
     property Declaration: TPasElement read FDeclaration write SetDeclaration;
   end;
 
-  { TResolvedRefCtxConstructor - constructed class/record of a newinstance reference }
+  { TResolvedRefCtxConstructor - constructed type of a newinstance reference }
 
   TResolvedRefCtxConstructor = Class(TResolvedRefContext)
   public
-    Typ: TPasType; // e.g. TPasMembersType
+    Typ: TPasType;
+  end;
+
+  { TResolvedRefCtxAttrProc - constructor of an attribute }
+
+  TResolvedRefCtxAttrProc = Class(TResolvedRefContext)
+  public
+    Proc: TPasConstructor;
   end;
 
   TPasResolverResultFlag = (
@@ -1481,8 +1488,10 @@ type
     procedure ResolveBinaryExpr(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
     procedure ResolveSubIdent(El: TBinaryExpr; Access: TResolvedRefAccess); virtual;
     procedure ResolveParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveParamsExprParams(Params: TParamsExpr); virtual;
     procedure ResolveFuncParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
-    procedure ResolveFuncParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
+    procedure ResolveFuncParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr;
+      Access: TResolvedRefAccess; CallName: string = ''); virtual;
     procedure ResolveArrayParamsExpr(Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
     procedure ResolveArrayParamsExprName(NameExpr: TPasExpr; Params: TParamsExpr; Access: TResolvedRefAccess); virtual;
     procedure ResolveArrayParamsArgs(Params: TParamsExpr;
@@ -1531,6 +1540,7 @@ type
     procedure FinishArgument(El: TPasArgument); virtual;
     procedure FinishAncestors(aClass: TPasClassType); virtual;
     procedure FinishMethodResolution(El: TPasMethodResolution); virtual;
+    procedure FinishAttributes(El: TPasAttributes); virtual;
     procedure FinishProcParamAccess(ProcType: TPasProcedureType; Params: TParamsExpr); virtual;
     procedure FinishPropertyParamAccess(Params: TParamsExpr;
       Prop: TPasProperty); virtual;
@@ -2027,6 +2037,10 @@ type
     function IsInterfaceType(TypeEl: TPasType; IntfType: TPasClassInterfaceType): boolean; overload;
     function IsTGUID(RecTypeEl: TPasRecordType): boolean; virtual;
     function IsTGUIDString(const ResolvedEl: TPasResolverResult): boolean; virtual;
+    function IsCustomAttribute(El: TPasElement): boolean; virtual;
+    function IsSystemUnit(El: TPasModule): boolean; virtual;
+    function GetAttributeCallsEl(El: TPasElement): TPasExprArray; virtual;
+    function GetAttributeCalls(Members: TFPList; Index: integer): TPasExprArray; virtual;
     function ProcNeedsParams(El: TPasProcedureType): boolean;
     function IsProcOverride(AncestorProc, DescendantProc: TPasProcedure): boolean;
     function GetTopLvlProc(El: TPasElement): TPasProcedure;
@@ -6383,6 +6397,8 @@ begin
     FinishArgument(TPasArgument(El))
   else if C=TPasMethodResolution then
     FinishMethodResolution(TPasMethodResolution(El))
+  else if C=TPasAttributes then
+    FinishAttributes(TPasAttributes(El))
   else
     begin
     {$IFDEF VerbosePasResolver}
@@ -7119,14 +7135,16 @@ var
   IntfType, IntfTypeRes, HelperForType, AncestorHelperFor: TPasType;
   ResIntfList, Members: TFPList;
   GroupScope: TPasGroupScope;
+  C: TClass;
 begin
   if aClass.IsForward then
     begin
     // check for duplicate forwards
-    if aClass.Parent is TPasDeclarations then
+    C:=aClass.Parent.ClassType;
+    if C.InheritsFrom(TPasDeclarations) then
       Members:=TPasDeclarations(aClass.Parent).Declarations
-    else if aClass.Parent.ClassType=TPasClassType then
-      Members:=TPasClassType(aClass.Parent).Members
+    else if (C=TPasClassType) or (C=TPasRecordType) then
+      Members:=TPasMembersType(aClass.Parent).Members
     else
       RaiseNotYetImplemented(20180430141934,aClass,GetObjName(aClass.Parent));
     for i:=0 to Members.Count-1 do
@@ -7238,6 +7256,7 @@ begin
     aModifier:=lowercase(aClass.Modifiers[i]);
     case aModifier of
     'sealed': IsSealed:=true;
+    'abstract': ;
     else
       RaiseMsg(20170320190619,nIllegalQualifier,sIllegalQualifier,[aClass.Modifiers[i]],aClass);
     end;
@@ -7486,6 +7505,166 @@ begin
   // El.ImplementationProc is resolved in FinishClassType
 end;
 
+procedure TPasResolver.FinishAttributes(El: TPasAttributes);
+var
+  i, j: Integer;
+  NameExpr, Expr: TPasExpr;
+  Bin: TBinaryExpr;
+  LeftResolved, ParamResolved: TPasResolverResult;
+  aModule: TPasModule;
+  LTypeEl: TPasType;
+  AttrName: String;
+  Data: TPRFindData;
+  CurEl, DeclEl: TPasElement;
+  ClassEl: TPasClassType;
+  aConstructor: TPasConstructor;
+  Args: TFPList;
+  AttrRef, ParamRef: TResolvedReference;
+  DotScope: TPasDotBaseScope;
+  Params: TPasExprArray;
+begin
+  for i:=0 to length(El.Calls)-1 do
+    begin
+    NameExpr:=El.Calls[i];
+    {$IFDEF VerbosePasResolver}
+    //writeln('TPasResolver.FinishAttributes El.Calls[',i,']=',GetObjName(NameExpr));
+    {$ENDIF}
+    if NameExpr is TParamsExpr then
+      NameExpr:=TParamsExpr(NameExpr).Value;
+    DotScope:=nil;
+    if NameExpr is TBinaryExpr then
+      begin
+      Bin:=TBinaryExpr(NameExpr);
+      ResolveExpr(Bin.left,rraRead);
+      ComputeElement(Bin.Left,LeftResolved,[rcType,rcSetReferenceFlags]);
+      if LeftResolved.BaseType=btModule then
+        begin
+        // e.g. unitname.identifier
+        // => search in interface and if this is our module in the implementation
+        aModule:=NoNil(LeftResolved.IdentEl) as TPasModule;
+        DotScope:=PushModuleDotScope(aModule);
+        end
+      else if (LeftResolved.BaseType=btContext)
+          and (LeftResolved.IdentEl is TPasType)
+          and (LeftResolved.LoTypeEl is TPasMembersType) then
+        begin
+        // classtype.identifier or recordtype.identifier
+        LTypeEl:=LeftResolved.LoTypeEl;
+        if LTypeEl.ClassType=TPasClassType then
+          begin
+          DotScope:=PushClassDotScope(TPasClassType(LTypeEl));
+          DotScope.OnlyTypeMembers:=true;
+          end
+        else if LTypeEl.ClassType=TPasRecordType then
+          begin
+          DotScope:=PushRecordDotScope(TPasRecordType(LTypeEl));
+          DotScope.OnlyTypeMembers:=true;
+          end
+        else
+          RaiseNotYetImplemented(20190221124930,Bin);
+        end
+      else
+        RaiseMsg(20190221102049,nXExpectedButYFound,sXExpectedButYFound,
+          ['module or type',GetResolverResultDescription(LeftResolved,true)],NameExpr);
+      NameExpr:=Bin.right;
+      end;
+    // find attribute class
+    if not IsNameExpr(NameExpr) then
+      RaiseMsg(20190221125204,nXExpectedButYFound,sXExpectedButYFound,
+        ['identifier',GetElementTypeName(Bin)],NameExpr);
+    AttrName:=TPrimitiveExpr(NameExpr).Value;
+    CurEl:=nil;
+    if not SameText(RightStr(AttrName,length('Attribute')),'Attribute') then
+      begin
+      // first search AttrName+'Attibute'
+      CurEl:=FindFirstEl(AttrName+'Attribute',Data,NameExpr);
+      end;
+    // then search the name
+    if CurEl=nil then
+      CurEl:=FindFirstEl(AttrName,Data,NameExpr);
+    if DotScope<>nil then
+      PopScope;
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.FinishAttributes Found Attr "'+AttrName+'"=',GetObjName(CurEl),' TopScope=',GetObjName(TopScope));
+    {$ENDIF}
+
+    // check if found element is a TCustomAttribute
+    if CurEl=nil then
+      begin
+      LogMsg(20190221144613,mtWarning,nUnknownCustomAttributeX,sUnknownCustomAttributeX,
+        [AttrName],NameExpr);
+      continue;
+      end;
+    if not IsCustomAttribute(CurEl) then
+      RaiseMsg(20190221130400,nIncompatibleTypesGotExpected,sIncompatibleTypesGotExpected,
+        [GetElementTypeName(CurEl),'TCustomAttribute'],NameExpr);
+    ClassEl:=TPasClassType(CurEl);
+    AttrRef:=CreateReference(ClassEl,NameExpr,rraRead);
+    if ClassEl.IsAbstract then
+      // Delphi silently skips attributes using abstract classes/methods
+      LogMsg(20190223194424,mtWarning,nAttributeIgnoredBecauseAbstractX,
+        sAttributeIgnoredBecauseAbstractX,['class'],NameExpr);
+
+    // search constructor "Create" using the params
+    DotScope:=PushClassDotScope(ClassEl);
+    DotScope.OnlyTypeMembers:=true;
+    Expr:=El.Calls[i];
+    if Expr is TParamsExpr then
+      begin
+      // attribute with params
+      if Expr.Kind<>pekFuncParams then
+        begin
+        {$IFDEF VerbosePasResolver}
+        writeln('TPasResolver.FinishAttributes ',ExprKindNames[Expr.Kind]);
+        {$ENDIF}
+        RaiseMsg(20190223195605,nXExpectedButYFound,sXExpectedButYFound,
+          ['(','['],Expr);
+        end;
+      // first resolve params
+      ResolveParamsExprParams(TParamsExpr(Expr));
+      // then resolve call 'Create'
+      ResolveFuncParamsExprName(Expr,TParamsExpr(Expr),rraRead,'Create');
+      // then check that each parameter is a constant expression
+      Params:=TParamsExpr(Expr).Params;
+      for j:=0 to length(Params)-1 do
+        ComputeElement(Params[j],ParamResolved,[rcConstant]);
+      // check if call is constructor
+      ParamRef:=Expr.CustomData as TResolvedReference;
+      DeclEl:=ParamRef.Declaration;
+      if DeclEl.ClassType<>TPasConstructor then
+        RaiseXExpectedButYFound(20190221150212,'constructor Create',GetElementTypeName(DeclEl),NameExpr);
+      aConstructor:=TPasConstructor(DeclEl);
+      end
+    else
+      begin
+      // attribute without params
+      // -> resolve call 'Create'
+      DeclEl:=FindElementWithoutParams('Create',Data,NameExpr,false);
+      if DeclEl=nil then
+        RaiseIdentifierNotFound(20190221144516,'Create',NameExpr);
+      // check call is constructor
+      if DeclEl.ClassType<>TPasConstructor then
+        RaiseXExpectedButYFound(20190221145003,'constructor Create',
+          GetElementTypeName(DeclEl),NameExpr);
+      aConstructor:=TPasConstructor(DeclEl);
+      // check constructor without needed args
+      Args:=aConstructor.ProcType.Args;
+      if (Args.Count>0) and (TPasArgument(Args[0]).ValueExpr=nil) then
+        RaiseMsg(20190221145407,nWrongNumberOfParametersForCallTo,
+          sWrongNumberOfParametersForCallTo,[aConstructor.Name],Expr);
+      end;
+    if aConstructor.IsAbstract then
+      LogMsg(20190223193645,mtWarning,nAttributeIgnoredBecauseAbstractX,
+        sAttributeIgnoredBecauseAbstractX,['mrthod'],NameExpr);
+    // store reference to constructor in NameExpr
+    if AttrRef.Context<>nil then
+      RaiseNotYetImplemented(20190221164717,NameExpr,GetObjName(AttrRef.Context));
+    AttrRef.Context:=TResolvedRefCtxAttrProc.Create;
+    TResolvedRefCtxAttrProc(AttrRef.Context).Proc:=aConstructor;
+    PopScope;
+    end;
+end;
+
 procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType;
   Params: TParamsExpr);
 var
@@ -9057,9 +9236,6 @@ end;
 
 procedure TPasResolver.ResolveParamsExpr(Params: TParamsExpr;
   Access: TResolvedRefAccess);
-var
-  i, ScopeDepth: Integer;
-  ParamAccess: TResolvedRefAccess;
 begin
   if (Params.Kind=pekSet) and not (Access in [rraRead,rraParamToUnknownProc]) then
     begin
@@ -9070,14 +9246,7 @@ begin
     end;
 
   // first resolve params
-  ResetSubExprScopes(ScopeDepth);
-  if Params.Kind in [pekFuncParams,pekArrayParams] then
-    ParamAccess:=rraParamToUnknownProc
-  else
-    ParamAccess:=rraRead;
-  for i:=0 to length(Params.Params)-1 do
-    ResolveExpr(Params.Params[i],ParamAccess);
-  RestoreSubExprScopes(ScopeDepth);
+  ResolveParamsExprParams(Params);
 
   // then resolve the call, typecast, array, set
   if (Params.Kind=pekFuncParams) then
@@ -9090,6 +9259,23 @@ begin
     RaiseNotYetImplemented(20160922163501,Params);
 end;
 
+procedure TPasResolver.ResolveParamsExprParams(Params: TParamsExpr);
+var
+  ScopeDepth, i: integer;
+  ParamAccess: TResolvedRefAccess;
+  Pars: TPasExprArray;
+begin
+  ResetSubExprScopes(ScopeDepth);
+  if Params.Kind in [pekFuncParams,pekArrayParams] then
+    ParamAccess:=rraParamToUnknownProc
+  else
+    ParamAccess:=rraRead;
+  Pars:=Params.Params;
+  for i:=0 to length(Pars)-1 do
+    ResolveExpr(Pars[i],ParamAccess);
+  RestoreSubExprScopes(ScopeDepth);
+end;
+
 procedure TPasResolver.ResolveFuncParamsExpr(Params: TParamsExpr;
   Access: TResolvedRefAccess);
 var
@@ -9149,7 +9335,7 @@ begin
 end;
 
 procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
-  Params: TParamsExpr; Access: TResolvedRefAccess);
+  Params: TParamsExpr; Access: TResolvedRefAccess; CallName: string);
 
   procedure FinishUntypedParams(ParamAccess: TResolvedRefAccess);
   var
@@ -9162,7 +9348,7 @@ procedure TPasResolver.ResolveFuncParamsExprName(NameExpr: TPasExpr;
 
 var
   i: Integer;
-  CallName, Msg: String;
+  Msg: String;
   FindCallData: TFindCallElData;
   Abort: boolean;
   El, FoundEl: TPasElement;
@@ -9174,7 +9360,8 @@ var
   C: TClass;
 begin
   // e.g. Name() -> find compatible
-  if NameExpr.ClassType=TPrimitiveExpr then
+  if CallName<>'' then
+  else if NameExpr.ClassType=TPrimitiveExpr then
     CallName:=TPrimitiveExpr(NameExpr).Value
   else
     RaiseNotYetImplemented(20190115143539,NameExpr);
@@ -15581,6 +15768,7 @@ begin
     else if AClass.InheritsFrom(TPasImplBlock) then
       // resolved when finished
     else if AClass=TPasImplCommand then
+    else if AClass=TPasAttributes then
     else if AClass=TPasUnresolvedUnitRef then
       RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
     else
@@ -15943,11 +16131,11 @@ var
   Proc: TPasProcedure;
   StartScope: TPasScope;
   OnlyTypeMembers, IsClassOf: Boolean;
-  TypeEl: TPasType;
   C: TClass;
   ClassRecScope: TPasClassOrRecordScope;
   i: Integer;
   AbstractProcs: TArrayOfPasProcedure;
+  TypeEl: TPasType;
 begin
   StartScope:=FindData.StartScope;
   OnlyTypeMembers:=false;
@@ -16091,23 +16279,29 @@ begin
         begin
         if ClassRecScope=nil then
           RaiseInternalError(20190123120156,GetObjName(StartScope));
-        TypeEl:=ClassRecScope.Element as TPasType;
+        TypeEl:=ClassRecScope.Element as TPasMembersType;
         if (TypeEl.ClassType=TPasClassType)
             and (TPasClassType(TypeEl).HelperForType<>nil) then
-          TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType);
+          TypeEl:=ResolveAliasType(TPasClassType(TypeEl).HelperForType) as TPasType;
         TResolvedRefCtxConstructor(Ref.Context).Typ:=TypeEl;
         if OnlyTypeMembers and (ClassRecScope is TPasClassScope) then
           begin
-          AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
-          if (length(AbstractProcs)>0) then
+          if (TypeEl.ClassType=TPasClassType) and TPasClassType(TypeEl).IsAbstract then
+            LogMsg(20190224153450,mtWarning,nCreatingAnInstanceOfAbstractClassY,
+              sCreatingAnInstanceOfAbstractClassY,[TypeEl.Name],FindData.ErrorPosEl)
+          else
             begin
-            if IsClassOf then
-              // aClass.Create: do not warn
-            else
-              for i:=0 to length(AbstractProcs)-1 do
-                LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
-                  sConstructingClassXWithAbstractMethodY,
-                  [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
+            AbstractProcs:=TPasClassScope(ClassRecScope).AbstractProcs;
+            if (length(AbstractProcs)>0) then
+              begin
+              if IsClassOf then
+                // aClass.Create: do not warn
+              else
+                for i:=0 to length(AbstractProcs)-1 do
+                  LogMsg(20171227110746,mtWarning,nConstructingClassXWithAbstractMethodY,
+                    sConstructingClassXWithAbstractMethodY,
+                    [TypeEl.Name,AbstractProcs[i].Name],FindData.ErrorPosEl);
+              end;
             end;
           end;
         end;
@@ -16902,7 +17096,7 @@ begin
             Scope.Add(HelperScope);
             HelperScope:=HelperScope.AncestorScope;
             end;
-          if not (msMultipleScopeHelpers in CurrentParser.CurrentModeswitches) then
+          if not (msMultiHelpers in CurrentParser.CurrentModeswitches) then
             break;
           end;
         end;
@@ -22511,6 +22705,122 @@ begin
   Result:=false;
 end;
 
+function TPasResolver.IsCustomAttribute(El: TPasElement): boolean;
+var
+  ClassEl: TPasClassType;
+  ClassScope: TPasClassScope;
+  aModule: TPasModule;
+begin
+  Result:=false;
+  if (El=nil)
+      or (El.ClassType<>TPasClassType) then exit;
+  ClassEl:=TPasClassType(El);
+  if (ClassEl.IsExternal) or (ClassEl.ObjKind<>okClass) then exit;
+  while not SameText(ClassEl.Name,'TCustomAttribute') do
+    begin
+    ClassScope:=ClassEl.CustomData as TPasClassScope;
+    if ClassScope.AncestorScope=nil then exit;
+    ClassEl:=TPasClassType(ClassScope.AncestorScope.Element);
+    end;
+  if not (ClassEl.Parent is TPasSection) then
+    exit; // this TCustomAttribute is not top level
+  aModule:=ClassEl.GetModule;
+  Result:=IsSystemUnit(aModule);
+end;
+
+function TPasResolver.IsSystemUnit(El: TPasModule): boolean;
+var
+  Section: TPasSection;
+begin
+  Result:=false;
+  if El=nil then exit;
+  if SameText(El.Name,'system') then exit(true);
+
+  // tests and scripts are their own system unit: check if this is the root module
+  if El.ClassType=TPasProgram then
+    Section:=TPasProgram(El).ProgramSection
+  else if El.ClassType=TPasLibrary then
+    Section:=TPasLibrary(El).LibrarySection
+  else
+    Section:=El.InterfaceSection;
+  Result:=length(Section.UsesClause)=0;
+end;
+
+function TPasResolver.GetAttributeCallsEl(El: TPasElement): TPasExprArray;
+var
+  Parent: TPasElement;
+  C: TClass;
+  Members: TFPList;
+  i: Integer;
+begin
+  Result:=nil;
+  if El=nil then exit;
+  // find El in El.Parent members
+  Parent:=El.Parent;
+  if Parent=nil then exit;
+  C:=Parent.ClassType;
+  if C.InheritsFrom(TPasDeclarations) then
+    Members:=TPasDeclarations(Parent).Declarations
+  else if C.InheritsFrom(TPasMembersType) then
+    Members:=TPasMembersType(Parent).Members
+  else
+    exit;
+  i:=Members.IndexOf(El);
+  if i<0 then exit;
+  Result:=GetAttributeCalls(Members,i);
+end;
+
+function TPasResolver.GetAttributeCalls(Members: TFPList; Index: integer
+  ): TPasExprArray;
+
+  procedure AddAttributesInFront(Members: TFPList; i: integer);
+  var
+    j, l, k: Integer;
+    Calls: TPasExprArray;
+  begin
+    // find attributes in front
+    j:=i;
+    while (j>0) and (TPasElement(Members[j-1]).ClassType=TPasAttributes) do
+      dec(j);
+    // collect all attribute calls
+    l:=0;
+    while j<i do
+      begin
+      Calls:=TPasAttributes(Members[j]).Calls;
+      SetLength(Result,l+length(Calls));
+      for k:=0 to length(Calls)-1 do
+        begin
+        Result[l]:=Calls[k];
+        inc(l);
+        end;
+      inc(j);
+      end;
+  end;
+
+var
+  El, CurEl: TPasElement;
+begin
+  Result:=nil;
+  El:=TPasElement(Members[Index]);
+  AddAttributesInFront(Members,Index);
+  if (El.ClassType=TPasClassType) and (not TPasClassType(El).IsForward) then
+    repeat
+      dec(Index);
+      if Index<1 then break;
+      CurEl:=TPasElement(Members[Index]);
+      if (CurEl.ClassType=TPasClassType)
+          and TPasClassType(CurEl).IsForward
+          and (TPasClassType(CurEl).CustomData is TResolvedReference)
+          and (TResolvedReference(TPasClassType(CurEl).CustomData).Declaration=El)
+      then
+        begin
+        // class has a forward declaration -> add attributes
+        AddAttributesInFront(Members,Index);
+        break;
+        end;
+    until false;
+end;
+
 function TPasResolver.ProcNeedsParams(El: TPasProcedureType): boolean;
 begin
   Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);

packages/fcl-passrc/src/pastree.pp

@@ -339,14 +339,15 @@ type
   public
     Declarations: TFPList; // list of TPasElement
     // Declarations contains all the following:
-    ResStrings, // TPasResString
-    Types,      // TPasType, except TPasClassType, TPasRecordType
-    Consts,     // TPasConst
+    Attributes, // TPasAttributes
     Classes,    // TPasClassType, TPasRecordType
+    Consts,     // TPasConst
+    ExportSymbols,// TPasExportSymbol
     Functions,  // TPasProcedure
-    Variables,  // TPasVariable, not descendants
     Properties, // TPasProperty
-    ExportSymbols  // TPasExportSymbol
+    ResStrings, // TPasResString
+    Types,      // TPasType, except TPasClassType, TPasRecordType
+    Variables   // TPasVariable, not descendants
       : TFPList;
   end;
 
@@ -979,6 +980,18 @@ type
     Function DefaultValue : string;
   end;
 
+  { TPasAttributes }
+
+  TPasAttributes = class(TPasElement)
+  public
+    destructor Destroy; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+    procedure AddCall(Expr: TPasExpr);
+  public
+    Calls: TPasExprArray;
+  end;
+
   TProcType = (ptProcedure, ptFunction,
                ptOperator, ptClassOperator,
                ptConstructor, ptDestructor,
@@ -1218,6 +1231,17 @@ type
       const Arg: Pointer); override;
   end;
 
+  { TPasMethodResolution }
+
+  TPasMethodResolution = class(TPasElement)
+  public
+    destructor Destroy; override;
+  public
+    ProcClass: TPasProcedureClass;
+    InterfaceName: TPasExpr;
+    InterfaceProc: TPasExpr;
+    ImplementationProc: TPasExpr;
+  end;
 
   TPasImplBlock = class;
 
@@ -1233,18 +1257,6 @@ type
     Body: TPasImplBlock;
   end;
 
-  { TPasMethodResolution }
-
-  TPasMethodResolution = class(TPasElement)
-  public
-    destructor Destroy; override;
-  public
-    ProcClass: TPasProcedureClass;
-    InterfaceName: TPasExpr;
-    InterfaceProc: TPasExpr;
-    ImplementationProc: TPasExpr;
-  end;
-
   { TPasProcedureImpl - used by mkxmlrpc, not by pparser }
 
   TPasProcedureImpl = class(TPasElement)
@@ -1770,6 +1782,36 @@ begin
 end;
 {$ENDIF}
 
+{ TPasAttributes }
+
+destructor TPasAttributes.Destroy;
+var
+  i: Integer;
+begin
+  for i:=0 to length(Calls)-1 do
+    Calls[i].Release{$IFDEF CheckPasTreeRefCount}('TPasAttributes.Destroy'){$ENDIF};
+  inherited Destroy;
+end;
+
+procedure TPasAttributes.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  for i:=0 to length(Calls)-1 do
+    ForEachChildCall(aMethodCall,Arg,Calls[i],false);
+end;
+
+procedure TPasAttributes.AddCall(Expr: TPasExpr);
+var
+  i : Integer;
+begin
+  i:=Length(Calls);
+  SetLength(Calls, i+1);
+  Calls[i]:=Expr;
+end;
+
 { TPasMethodResolution }
 
 destructor TPasMethodResolution.Destroy;
@@ -2740,14 +2782,15 @@ constructor TPasDeclarations.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
   Declarations := TFPList.Create;
-  ResStrings := TFPList.Create;
-  Types := TFPList.Create;
-  Consts := TFPList.Create;
+  Attributes := TFPList.Create;
   Classes := TFPList.Create;
+  Consts := TFPList.Create;
+  ExportSymbols := TFPList.Create;
   Functions := TFPList.Create;
-  Variables := TFPList.Create;
   Properties := TFPList.Create;
-  ExportSymbols := TFPList.Create;
+  ResStrings := TFPList.Create;
+  Types := TFPList.Create;
+  Variables := TFPList.Create;
 end;
 
 destructor TPasDeclarations.Destroy;
@@ -2756,14 +2799,15 @@ var
   Child: TPasElement;
 begin
   {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy START');{$ENDIF}
-  FreeAndNil(ExportSymbols);
-  FreeAndNil(Properties);
   FreeAndNil(Variables);
-  FreeAndNil(Functions);
-  FreeAndNil(Classes);
-  FreeAndNil(Consts);
   FreeAndNil(Types);
   FreeAndNil(ResStrings);
+  FreeAndNil(Properties);
+  FreeAndNil(Functions);
+  FreeAndNil(ExportSymbols);
+  FreeAndNil(Consts);
+  FreeAndNil(Classes);
+  FreeAndNil(Attributes);
   {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy Declarations');{$ENDIF}
   for i := 0 to Declarations.Count - 1 do
     begin

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -255,6 +255,7 @@ type
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
+    procedure UseAttributes(El: TPasElement); virtual;
     function UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean; virtual;
     procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual;
     procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual;
@@ -1116,6 +1117,8 @@ begin
       for i:=0 to Members.Count-1 do
         begin
         Member:=TPasElement(Members[i]);
+        if Member.ClassType=TPasAttributes then
+          continue;
         if IsUsed(Member) then
           UseTypeInfo(Member);
         end;
@@ -1129,6 +1132,8 @@ begin
     for i:=0 to Members.Count-1 do
       begin
       Member:=TPasElement(Members[i]);
+      if Member.ClassType=TPasAttributes then
+        continue; // attributes are never used directly
       UseSubEl(Member);
       end;
     end
@@ -1151,6 +1156,18 @@ begin
     end;
 
   UseElement(El,rraNone,true);
+
+  UseAttributes(El);
+end;
+
+procedure TPasAnalyzer.UseAttributes(El: TPasElement);
+var
+  Calls: TPasExprArray;
+  i: Integer;
+begin
+  Calls:=Resolver.GetAttributeCallsEl(El);
+  for i:=0 to length(Calls)-1 do
+    UseExpr(Calls[i]);
 end;
 
 function TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode): boolean;
@@ -1281,6 +1298,8 @@ begin
       end
     else if C=TPasResString then
       UseResourcestring(TPasResString(Decl))
+    else if C=TPasAttributes then
+      // attributes are never used directly
     else
       RaiseNotSupported(20170306165213,Decl);
     end;
@@ -1456,6 +1475,7 @@ var
   ModScope: TPasModuleScope;
   Access: TResolvedRefAccess;
   SubEl: TPasElement;
+  ParamsExpr: TParamsExpr;
 begin
   if El=nil then exit;
   // Note: expression itself is not marked, but it can reference identifiers
@@ -1470,6 +1490,12 @@ begin
     MarkImplScopeRef(El,Decl,ResolvedToPSRefAccess[Access]);
     UseElement(Decl,Access,false);
 
+    if Ref.Context<>nil then
+      begin
+      if Ref.Context.ClassType=TResolvedRefCtxAttrProc then
+        UseProcedure(TResolvedRefCtxAttrProc(Ref.Context).Proc);
+      end;
+
     if Resolver.IsNameExpr(El) then
       begin
       if Ref.WithExprScope<>nil then
@@ -1502,7 +1528,8 @@ begin
         case BuiltInProc.BuiltIn of
         bfExit:
           begin
-          if El.Parent is TParamsExpr then
+          ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
+          if ParamsExpr<>nil then
             begin
             Params:=(El.Parent as TParamsExpr).Params;
             if length(Params)=1 then
@@ -1521,7 +1548,10 @@ begin
           end;
         bfTypeInfo:
           begin
-          Params:=(El.Parent as TParamsExpr).Params;
+          ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
+          if ParamsExpr=nil then
+            RaiseNotSupported(20190225150136,El);
+          Params:=ParamsExpr.Params;
           if length(Params)<>1 then
             RaiseNotSupported(20180226144217,El.Parent);
           Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
@@ -2082,7 +2112,10 @@ begin
         end;
         //writeln('TPasAnalyzer.UseClassType ',El.FullName,' ',Mode,' ',Member.Name);
         end;
-      end;
+      end
+    else if Member.ClassType=TPasAttributes then
+      continue; // attributes are never used directly
+
     if AllPublished and (Member.Visibility=visPublished) then
       begin
       // include published
@@ -2442,6 +2475,8 @@ begin
       EmitTypeHints(TPasType(Decl))
     else if Decl is TPasProcedure then
       EmitProcedureHints(TPasProcedure(Decl))
+    else if Decl.ClassType=TPasAttributes then
+      // no hints
     else
       begin
       Usage:=FindElement(Decl);
@@ -2461,6 +2496,7 @@ var
   Usage: TPAElement;
   i: Integer;
   Member: TPasElement;
+  Members: TFPList;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
@@ -2483,21 +2519,22 @@ begin
     exit;
     end;
   // emit hints for sub elements
+  Members:=nil;
   C:=El.ClassType;
   if C=TPasRecordType then
-    begin
-    for i:=0 to TPasRecordType(El).Members.Count-1 do
-      EmitVariableHints(TObject(TPasRecordType(El).Members[i]) as TPasVariable);
-    end
+    Members:=TPasRecordType(El).Members
   else if C=TPasClassType then
     begin
     if TPasClassType(El).IsForward then exit;
-    for i:=0 to TPasClassType(El).Members.Count-1 do
+    Members:=TPasClassType(El).Members;
+    end;
+  if Members<>nil then
+    for i:=0 to Members.Count-1 do
       begin
-      Member:=TPasElement(TPasClassType(El).Members[i]);
+      Member:=TPasElement(Members[i]);
+      if Member.ClassType=TPasAttributes then continue;
       EmitElementHints(Member);
       end;
-    end;
 end;
 
 procedure TPasAnalyzer.EmitVariableHints(El: TPasVariable);

packages/fcl-passrc/src/pparser.pp

@@ -174,7 +174,7 @@ type
     stWithExpr, // calls BeginScope after parsing every WITH-expression
     stExceptOnExpr,
     stExceptOnStatement,
-    stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument
+    stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument, ...
     stAncestors, // the list of ancestors and interfaces of a class
     stInitialFinalization
     );
@@ -426,7 +426,7 @@ type
     // Constant declarations
     function ParseConstDecl(Parent: TPasElement): TPasConst;
     function ParseResourcestringDecl(Parent: TPasElement): TPasResString;
-    procedure ParseAttribute(Parent: TPasElement);
+    function ParseAttributes(Parent: TPasElement): TPasAttributes;
     // Variable handling. This includes parts of records
     procedure ParseVarDecl(Parent: TPasElement; List: TFPList);
     procedure ParseInlineVarDecl(Parent: TPasElement; List: TFPList;  AVisibility : TPasMemberVisibility  = visDefault; ClosingBrace: Boolean = False);
@@ -3323,7 +3323,6 @@ var
   ArrEl : TPasArrayType;
   List: TFPList;
   i,j: Integer;
-  VarEl: TPasVariable;
   ExpEl: TPasExportSymbol;
   PropEl : TPasProperty;
   TypeName: String;
@@ -3332,6 +3331,8 @@ var
   ok: Boolean;
   Proc: TPasProcedure;
   RecordEl: TPasRecordType;
+  Attr: TPasAttributes;
+  CurEl: TPasElement;
 begin
   CurBlock := declNone;
   HadTypeSection:=false;
@@ -3512,10 +3513,13 @@ begin
                 ParseVarDecl(Declarations, List);
                 for i := 0 to List.Count - 1 do
                 begin
-                  VarEl := TPasVariable(List[i]);
-                  Declarations.Declarations.Add(VarEl);
-                  Declarations.Variables.Add(VarEl);
-                  Engine.FinishScope(stDeclaration,VarEl);
+                  CurEl := TPasElement(List[i]);
+                  Declarations.Declarations.Add(CurEl);
+                  if CurEl.ClassType=TPasAttributes then
+                    Declarations.Attributes.Add(CurEl)
+                  else
+                    Declarations.Variables.Add(TPasVariable(CurEl));
+                  Engine.FinishScope(stDeclaration,CurEl);
                 end;
                 CheckToken(tkSemicolon);
               finally
@@ -3671,8 +3675,13 @@ begin
         ParseLabels(Declarations);
       end;
     tkSquaredBraceOpen:
-      if [msPrefixedAttributes,msIgnoreAttributes]*CurrentModeSwitches<>[] then
-        ParseAttribute(Declarations)
+      if msPrefixedAttributes in CurrentModeSwitches then
+        begin
+        Attr:=ParseAttributes(Declarations);
+        Declarations.Declarations.Add(Attr);
+        Declarations.Attributes.Add(Attr);
+        Engine.FinishScope(stDeclaration,Attr);
+        end
       else
         ParseExcSyntaxError;
     else
@@ -3949,32 +3958,53 @@ begin
   end;
 end;
 
-procedure TPasParser.ParseAttribute(Parent: TPasElement);
+function TPasParser.ParseAttributes(Parent: TPasElement): TPasAttributes;
 var
-  Expr: TPasExpr;
+  Expr, Arg: TPasExpr;
+  Attributes: TPasAttributes;
+  Params: TParamsExpr;
 begin
-  repeat
-    // skip attribute
-    // [name,name(param,param,...),...]
-    // [name(param,name=param)]
+  Result:=nil;
+  Attributes:=TPasAttributes(CreateElement(TPasAttributes,'',Parent));
+  try
     repeat
-      ExpectIdentifier;
       NextToken;
-    until CurToken<>tkDot;
-    if CurToken=tkBraceOpen then
-      begin
-      repeat
+      // [name,name(param,param,...),...]
+      Expr:=nil;
+      ReadDottedIdentifier(Attributes,Expr,false);
+      if CurToken=tkBraceOpen then
+        begin
+        Params:=TParamsExpr(CreateElement(TParamsExpr,'',Attributes));
+        Params.Kind:=pekFuncParams;
+        Attributes.AddCall(Params);
+        Params.Value:=Expr;
+        Expr.Parent:=Params;
+        Expr:=nil;
+        repeat
+          NextToken;
+          if CurToken=tkBraceClose then
+            break;
+          Arg:=DoParseConstValueExpression(Params);
+          Params.AddParam(Arg);
+        until CurToken<>tkComma;
+        CheckToken(tkBraceClose);
         NextToken;
-        if CurToken=tkBraceClose then
-          break;
-        Expr:=DoParseConstValueExpression(Parent);
-        Expr.Free;
-      until CurToken<>tkComma;
-      CheckToken(tkBraceClose);
-      NextToken;
+        end
+      else
+        begin
+        Attributes.AddCall(Expr);
+        Expr:=nil;
+        end;
+    until CurToken<>tkComma;
+    CheckToken(tkSquaredBraceClose);
+    Result:=Attributes;
+  finally
+    if Result=nil then
+      begin
+      Attributes.Free;
+      Expr.Free;
       end;
-  until CurToken<>tkComma;
-  CheckToken(tkSquaredBraceClose);
+  end;
 end;
 
 procedure TPasParser.ReadGenericArguments(List: TFPList; Parent: TPasElement);
@@ -4355,6 +4385,13 @@ begin
   try
     D:=SaveComments; // This means we support only one comment per 'list'.
     VarEl:=nil;
+    while CurToken=tkSquaredBraceOpen do
+      begin
+      if msPrefixedAttributes in CurrentModeswitches then
+        VarList.Add(ParseAttributes(Parent))
+      else
+        CheckToken(tkIdentifier);
+      end;
     Repeat
       // create the TPasVariable here, so that SourceLineNumber is correct
       VarEl:=TPasVariable(CreateElement(TPasVariable,CurTokenString,Parent,
@@ -5097,7 +5134,7 @@ begin
       end
     else if (CurToken = tkSquaredBraceOpen) then
       begin
-      if ([msPrefixedAttributes,msIgnoreAttributes]*CurrentModeswitches<>[]) then
+      if msPrefixedAttributes in CurrentModeswitches then
         begin
         // [attribute]
         UngetToken;
@@ -6346,6 +6383,8 @@ Var
   isClass : Boolean;
   NamePos: TPasSourcePos;
   OldCount, i: Integer;
+  CurEl: TPasElement;
+  Attr: TPasAttributes;
 begin
   if AllowMethods then
     v:=visPublic
@@ -6379,10 +6418,12 @@ begin
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
         for i:=OldCount to ARec.Members.Count-1 do
           begin
+          CurEl:=TPasElement(ARec.Members[i]);
+          if CurEl.ClassType=TPasAttributes then continue;
           if isClass then
-            With TPasVariable(ARec.Members[i]) do
+            With TPasVariable(CurEl) do
               VarModifiers:=VarModifiers + [vmClass];
-          Engine.FinishScope(stDeclaration,TPasVariable(ARec.Members[i]));
+          Engine.FinishScope(stDeclaration,TPasVariable(CurEl));
           end;
         end;
       tkClass:
@@ -6427,7 +6468,7 @@ begin
         end;
       tkDestructor:
         ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
-      tkGeneric, // Counts as field name
+      tkGeneric,tkSelf, // Counts as field name
       tkIdentifier :
         begin
         If AllowMethods and CheckVisibility(CurTokenString,v) then
@@ -6440,8 +6481,21 @@ begin
         OldCount:=ARec.Members.Count;
         ParseInlineVarDecl(ARec, ARec.Members, v, AEndToken=tkBraceClose);
         for i:=OldCount to ARec.Members.Count-1 do
-          Engine.FinishScope(stDeclaration,TPasVariable(ARec.Members[i]));
+          begin
+          CurEl:=TPasElement(ARec.Members[i]);
+          if CurEl.ClassType=TPasAttributes then continue;
+          Engine.FinishScope(stDeclaration,TPasVariable(CurEl));
+          end;
         end;
+      tkSquaredBraceOpen:
+        if msPrefixedAttributes in CurrentModeswitches then
+          begin
+          Attr:=ParseAttributes(ARec);
+          ARec.Members.Add(Attr);
+          Engine.FinishScope(stDeclaration,Attr);
+          end
+        else
+          CheckToken(tkIdentifier);
       tkCase :
         begin
         ARec.Variants:=TFPList.Create;
@@ -6670,7 +6724,7 @@ Var
   LastToken: TToken;
   PropEl: TPasProperty;
   MethodRes: TPasMethodResolution;
-
+  Attr: TPasAttributes;
 begin
   CurSection:=stNone;
   haveClass:=false;
@@ -6829,8 +6883,12 @@ begin
         HaveClass:=False;
         end;
       tkSquaredBraceOpen:
-        if [msPrefixedAttributes,msIgnoreAttributes]*CurrentModeswitches<>[] then
-          ParseAttribute(AType)
+        if msPrefixedAttributes in CurrentModeswitches then
+          begin
+          Attr:=ParseAttributes(AType);
+          AType.Members.Add(Attr);
+          Engine.FinishScope(stDeclaration,Attr);
+          end
         else
           CheckToken(tkIdentifier);
     else

packages/fcl-passrc/src/pscanner.pp

@@ -293,9 +293,8 @@ type
     msArrayOperators,      { use Delphi compatible array operators instead of custom ones ("+") }
     msExternalClass,       { Allow external class definitions }
     msPrefixedAttributes,  { Allow attributes, disable proc modifier [] }
-    msIgnoreAttributes,    { workaround til resolver/converter supports attributes }
     msOmitRTTI,            { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
-    msMultipleScopeHelpers { off=only one helper per type, on=all }
+    msMultiHelpers         { off=only one helper per type, on=all }
     );
   TModeSwitches = Set of TModeSwitch;
 
@@ -1038,9 +1037,8 @@ const
     'ARRAYOPERATORS',
     'EXTERNALCLASS',
     'PREFIXEDATTRIBUTES',
-    'IGNOREATTRIBUTES',
     'OMITRTTI',
-    'MULTIPLESCOPEHELPERS'
+    'MULTIHELPERS'
     );
 
   LetterSwitchNames: array['A'..'Z'] of string=(

packages/fcl-passrc/tests/tcresolver.pas

@@ -149,6 +149,7 @@ type
     procedure CheckParserException(Msg: string; MsgNumber: integer);
     procedure CheckAccessMarkers; virtual;
     procedure CheckParamsExpr_pkSet_Markers; virtual;
+    procedure CheckAttributeMarkers; virtual;
     procedure GetSrc(Index: integer; out SrcLines: TStringList; out aFilename: string);
     function FindElementsAt(aFilename: string; aLine, aStartCol, aEndCol: integer): TFPList;// list of TPasElement
     function FindElementsAt(aMarker: PSrcMarker; ErrorOnNoElements: boolean = true): TFPList;// list of TPasElement
@@ -608,6 +609,8 @@ type
     Procedure TestClass_UntypedParam_TypeCast;
     Procedure TestClass_Sealed;
     Procedure TestClass_SealedDescendFail;
+    Procedure TestClass_Abstract;
+    Procedure TestClass_AbstractCreateFail;
     Procedure TestClass_VarExternal;
     Procedure TestClass_WarnOverrideLowerVisibility;
     Procedure TestClass_Const;
@@ -911,7 +914,7 @@ type
     Procedure TestClassHelper_ReintroduceHides_CallFail;
     Procedure TestClassHelper_DefaultProperty;
     Procedure TestClassHelper_DefaultClassProperty;
-    Procedure TestClassHelper_MultipleScopeHelpers;
+    Procedure TestClassHelper_MultiHelpers;
     Procedure TestRecordHelper;
     Procedure TestRecordHelper_ForByteFail;
     Procedure TestRecordHelper_ClassNonStaticFail;
@@ -931,7 +934,10 @@ type
     Procedure TestTypeHelper_InterfaceFail;
 
     // attributes
-    Procedure TestAttributes_Ignore;
+    Procedure TestAttributes_Globals;
+    Procedure TestAttributes_NonConstParam_Fail;
+    Procedure TestAttributes_UnknownAttrWarning;
+    Procedure TestAttributes_Members;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -1845,6 +1851,107 @@ begin
     end;
 end;
 
+procedure TCustomTestResolver.CheckAttributeMarkers;
+// check markers of the form {#Attr__ClassMarker__ConstructorMarker[__OptionalName]}
+var
+  aMarker, ClassMarker, ConstructorMarker: PSrcMarker;
+  Elements: TFPList;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+  s, ClassMarkerName, ConstructorMarkerName: String;
+  p: SizeInt;
+  ExpectedClass: TPasClassType;
+  ExpectedConstrucor, ActualConstructor: TPasConstructor;
+begin
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    s:=aMarker^.Identifier;
+    if SameText(LeftStr(s,6),'Attr__') then
+      begin
+      //writeln('TCustomTestResolver.CheckAttributeMarkers ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+      Delete(s,1,6);
+      p:=Pos('__',s);
+      if p<1 then
+        RaiseErrorAtSrcMarker('missing second __ at "#'+aMarker^.Identifier+'"',aMarker);
+      ClassMarkerName:=LeftStr(s,p-1);
+      Delete(s,1,p+1);
+      p:=Pos('__',s);
+      if p<1 then
+        ConstructorMarkerName:=s
+      else
+        ConstructorMarkerName:=copy(s,1,p-1);
+
+      // find attribute class at ClassMarkerName
+      ClassMarker:=FindSrcLabel(ClassMarkerName);
+      if ClassMarker=nil then
+        RaiseErrorAtSrcMarker('ClassMarker "'+ClassMarkerName+'" not found at "#'+aMarker^.Identifier+'"',aMarker);
+      ExpectedClass:=nil;
+      Elements:=FindElementsAt(ClassMarker);
+      try
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          if El is TPasClassType then
+            begin
+            ExpectedClass:=TPasClassType(El);
+            break;
+            end;
+          end;
+        if ExpectedClass=nil then
+          RaiseErrorAtSrcMarker('ClassMarker "'+ClassMarkerName+'" at "#'+aMarker^.Identifier+'" has no TPasClassType',aMarker);
+      finally
+        Elements.Free;
+      end;
+
+      // find constructor at ConstructorMarkerName
+      ConstructorMarker:=FindSrcLabel(ConstructorMarkerName);
+      if ConstructorMarker=nil then
+        RaiseErrorAtSrcMarker('ConstructorMarker "'+ConstructorMarkerName+'" not found at "#'+aMarker^.Identifier+'"',aMarker);
+      ExpectedConstrucor:=nil;
+      Elements:=FindElementsAt(ConstructorMarker);
+      try
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          if El is TPasConstructor then
+            begin
+            ExpectedConstrucor:=TPasConstructor(El);
+            break;
+            end;
+          end;
+        if ExpectedConstrucor=nil then
+          RaiseErrorAtSrcMarker('ConstructorMarker "'+ConstructorMarkerName+'" at "#'+aMarker^.Identifier+'" has no TPasConstructor',aMarker);
+      finally
+        Elements.Free;
+      end;
+
+      Elements:=FindElementsAt(aMarker);
+      try
+        for i:=0 to Elements.Count-1 do
+          begin
+          El:=TPasElement(Elements[i]);
+          //writeln('TCustomTestResolver.CheckAttributeMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+          if not (El.CustomData is TResolvedReference) then continue;
+          Ref:=TResolvedReference(El.CustomData);
+          if Ref.Declaration<>ExpectedClass then
+            RaiseErrorAtSrcMarker('Ref.Declaration at "#'+aMarker^.Identifier+'", expected "'+ExpectedClass.FullName+'" but found "'+Ref.Declaration.FullName+'", El='+GetObjName(El),aMarker);
+          if not (Ref.Context is TResolvedRefCtxAttrProc) then
+            RaiseErrorAtSrcMarker('Ref.Context at "#'+aMarker^.Identifier+'", expected "TResolvedRefCtxAttrConstructor" but found "'+GetObjName(Ref.Context)+'", El='+GetObjName(El),aMarker);
+          ActualConstructor:=TResolvedRefCtxAttrProc(Ref.Context).Proc;
+          if ActualConstructor<>ExpectedConstrucor then
+            RaiseErrorAtSrcMarker('Ref.Context.Proc at "#'+aMarker^.Identifier+'", expected "'+ExpectedConstrucor.FullName+'" but found "'+ActualConstructor.FullName+'", El='+GetObjName(El),aMarker);
+          break;
+          end;
+      finally
+        Elements.Free;
+      end;
+      end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
 procedure TCustomTestResolver.GetSrc(Index: integer; out SrcLines: TStringList; out
   aFilename: string);
 var
@@ -9597,40 +9704,42 @@ end;
 procedure TTestResolver.TestClassCallInherited;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class');
-  Add('    procedure {#TOBJ_ProcA}ProcA(vI: longint); virtual;');
-  Add('    procedure {#TOBJ_ProcB}ProcB(vJ: longint); virtual;');
-  Add('  end;');
-  Add('  {#A}TClassA = class');
-  Add('    procedure {#A_ProcA}ProcA({#i1}vI: longint); override;');
-  Add('    procedure {#A_ProcB}ProcB(vJ: longint); override;');
-  Add('    procedure {#A_ProcC}ProcC; virtual;');
-  Add('  end;');
-  Add('procedure TObject.ProcA(vi: longint);');
-  Add('begin');
-  Add('  inherited; // ignore, do not raise error');
-  Add('end;');
-  Add('procedure TObject.ProcB(vj: longint);');
-  Add('begin');
-  Add('end;');
-  Add('procedure TClassA.ProcA(vi: longint);');
-  Add('begin');
-  Add('  {@A_ProcA}ProcA({@i1}vI);');
-  Add('  {@TOBJ_ProcA}inherited;');
-  Add('  inherited {@TOBJ_ProcA}ProcA({@i1}vI);');
-  Add('  {@A_ProcB}ProcB({@i1}vI);');
-  Add('  inherited {@TOBJ_ProcB}ProcB({@i1}vI);');
-  Add('end;');
-  Add('procedure TClassA.ProcB(vJ: longint);');
-  Add('begin');
-  Add('end;');
-  Add('procedure TClassA.ProcC;');
-  Add('begin');
-  Add('  inherited; // ignore, do not raise error');
-  Add('end;');
-  Add('begin');
+  Add([
+  'type',
+  '  TObject = class',
+  '    procedure {#TOBJ_ProcA}ProcA(vI: longint); virtual;',
+  '    procedure {#TOBJ_ProcB}ProcB(vJ: longint); virtual;',
+  '  end;',
+  '  {#A}TClassA = class',
+  '    procedure {#A_ProcA}ProcA({#i1}vI: longint); override;',
+  '    procedure {#A_ProcB}ProcB(vJ: longint); override;',
+  '    procedure {#A_ProcC}ProcC; virtual;',
+  '  end;',
+  'procedure TObject.ProcA(vi: longint);',
+  'begin',
+  '  inherited; // ignore, do not raise error',
+  'end;',
+  'procedure TObject.ProcB(vj: longint);',
+  'begin',
+  'end;',
+  'procedure TClassA.ProcA(vi: longint);',
+  'begin',
+  '  {@A_ProcA}ProcA({@i1}vI);',
+  '  {@TOBJ_ProcA}inherited;',
+  '  inherited {@TOBJ_ProcA}ProcA({@i1}vI);',
+  '  {@A_ProcB}ProcB({@i1}vI);',
+  '  inherited {@TOBJ_ProcB}ProcB({@i1}vI);',
+  'end;',
+  'procedure TClassA.ProcB(vJ: longint);',
+  'begin',
+  'end;',
+  'procedure TClassA.ProcC;',
+  'begin',
+  '  inherited; // ignore, do not raise error',
+  'end;',
+  'begin']);
   ParseProgram;
+  CheckResolverUnexpectedHints;
 end;
 
 procedure TTestResolver.TestClassCallInheritedNoParamsAbstractFail;
@@ -10730,6 +10839,52 @@ begin
     nCannotCreateADescendantOfTheSealedXY);
 end;
 
+procedure TTestResolver.TestClass_Abstract;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  '  TNop = class abstract(TObject)',
+  '  end;',
+  '  TBird = class(TNop)',
+  '    constructor Create(w: word);',
+  '  end;',
+  'constructor TObject.Create;',
+  'begin',
+  'end;',
+  'constructor TBird.Create(w: word);',
+  'begin',
+  '  inherited Create;',
+  'end;',
+  'begin',
+  '  TBird.Create;']);
+  ParseProgram;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestClass_AbstractCreateFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    constructor Create;',
+  '  end;',
+  '  TNop = class abstract(TObject)',
+  '  end;',
+  'constructor TObject.Create;',
+  'begin',
+  'end;',
+  'begin',
+  '  TNop.Create;']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nCreatingAnInstanceOfAbstractClassY,
+    'Creating an instance of abstract class "TNop"');
+end;
+
 procedure TTestResolver.TestClass_VarExternal;
 begin
   StartProgram(false);
@@ -16837,11 +16992,11 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestClassHelper_MultipleScopeHelpers;
+procedure TTestResolver.TestClassHelper_MultiHelpers;
 begin
   StartProgram(false);
   Add([
-  '{$modeswitch multiplescopehelpers}',
+  '{$modeswitch multihelpers}',
   'type',
   '  TObject = class',
   '  end;',
@@ -17422,32 +17577,107 @@ begin
   CheckResolverException('Type "IUnknown" cannot be extended by a type helper',nTypeXCannotBeExtendedByATypeHelper);
 end;
 
-procedure TTestResolver.TestAttributes_Ignore;
+procedure TTestResolver.TestAttributes_Globals;
 begin
   StartProgram(false);
   Add([
-  '{$modeswitch IgnoreAttributes}',
+  '{$modeswitch prefixedattributes}',
   'type',
-  '  [custom1, custom2(1+3,''foo'')] [mod1.custom3]',
   '  TObject = class',
-  '    [custom5()] FS: string;',
-  '    [customProp] property S: string read FS;',
+  '    constructor {#TObject_Create}Create;',
   '  end;',
-  '  TOnGetCellClass = procedure(Sender: TObject; ACol, ARow:',
-  '   longint; var CellClassType: TObject) of object;',
-  '  [Attr]',
-  '  TBird = class(TObject)',
+  '  {#Custom}TCustomAttribute = class',
+  '  end;',
+  '  {#Red}RedAttribute = class(TCustomAttribute)',
+  '    constructor {#Red_A}Create(Id: word = 3; Deep: boolean = false); overload;',
+  '    constructor {#Red_B}Create(Size: double); overload;',
+  '  end;',
+  '  Red = word;',
+  'constructor TObject.Create; begin end;',
+  'constructor RedAttribute.Create(Id: word; Deep: boolean); begin end;',
+  'constructor RedAttribute.Create(Size: double); begin end;',
+  'var',
+  '  [{#Attr__Custom__TObject_Create}TCustom]',
+  '  [{#Attr__Red__Red_A__1}Red,afile.{#Attr__Red__Red_A__2}Red]',
+  '  o: TObject;',
+  'const',
+  '  [{#Attr__Red__Red_B}RedAttribute(1.3)]',
+  '  c = 3;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckAttributeMarkers;
+  CheckResolverUnexpectedHints;
+end;
+
+procedure TTestResolver.TestAttributes_NonConstParam_Fail;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor Create(w: word);',
+  '  end;',
+  '  TCustomAttribute = class',
   '  end;',
-  '[Attr]',
-  'procedure DoA; forward;',
-  '[Attr]',
-  'procedure DoA; begin end;',
+  'constructor TObject.Create(w: word);',
+  'begin',
+  'end;',
   'var',
-  '  [custom6]',
+  '  w: word;',
+  '  [TCustom(w)]',
   '  o: TObject;',
   'begin',
   '']);
+  CheckResolverException(sConstantExpressionExpected,nConstantExpressionExpected);
+end;
+
+procedure TTestResolver.TestAttributes_UnknownAttrWarning;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TCustomAttribute = class',
+  '  end;',
+  'var',
+  '  [Red]',
+  '  o: TObject;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nUnknownCustomAttributeX,'Unknown custom attribute "Red"');
+end;
+
+procedure TTestResolver.TestAttributes_Members;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#create}Create;',
+  '  end;',
+  '  {#custom}TCustomAttribute = class',
+  '  end;',
+  '  TMyClass = class',
+  '    [{#attr__custom__create__cl}TCustom]',
+  '    Field: word;',
+  '  end;',
+  '  TMyRecord = record',
+  '    [{#attr__custom__create__rec}TCustom]',
+  '    Field: word;',
+  '  end;',
+  'constructor TObject.Create;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
   ParseProgram;
+  CheckAttributeMarkers;
 end;
 
 initialization

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -166,6 +166,8 @@ type
     procedure TestWP_ClassInterface_TGUID;
     procedure TestWP_ClassHelper;
     procedure TestWP_ClassHelper_ClassConstrucor_Used;
+    procedure TestWP_Attributes;
+    procedure TestWP_Attributes_ForwardClass;
 
     // scope references
     procedure TestSR_Proc_UnitVar;
@@ -3151,6 +3153,57 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_Attributes;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#TObject_Create_notused}Create;',
+  '  end;',
+  '  {#TCustomAttribute_used}TCustomAttribute = class',
+  '  end;',
+  '  {#RedAttribute_used}RedAttribute = class(TCustomAttribute)',
+  '    constructor {#Red_A_used}Create(Id: word = 3; Deep: boolean = false); overload;',
+  '    constructor {#Red_B_notused}Create(Size: double); overload;',
+  '  end;',
+  '  {#Red_notused}Red = word;',
+  'constructor TObject.Create; begin end;',
+  'constructor RedAttribute.Create(Id: word; Deep: boolean); begin end;',
+  'constructor RedAttribute.Create(Size: double); begin end;',
+  'var',
+  '  [NotExisting]',
+  '  [Red]',
+  '  o: TObject;',
+  'begin',
+  '  if typeinfo(o)=nil then ;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
+procedure TTestUseAnalyzer.TestWP_Attributes_ForwardClass;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#TObject_Create_used}Create;',
+  '  end;',
+  '  {#TCustomAttribute_used}TCustomAttribute = class',
+  '  end;',
+  '  [TCustom]',
+  '  TBird = class;',
+  '  TMyInt = word;',
+  '  TBird = class end;',
+  'constructor TObject.Create; begin end;',
+  'begin',
+  '  if typeinfo(TBird)=nil then ;',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
 begin
   StartUnit(false);

packages/fcl-registry/src/registry.pp

@@ -504,7 +504,7 @@ var
   u: UnicodeString;
 
 begin
-  u:=UTF8Decode(Value);
+  u:=Value;
   PutData(Name, PWideChar(u), ByteLength(u), rdExpandString);
 end;
 
@@ -538,7 +538,7 @@ var
   u: UnicodeString;
 
 begin
-  u:=UTF8Decode(Value);
+  u:=Value;
   PutData(Name, PWideChar(u), ByteLength(u), rdString);
 end;
 

packages/fcl-web/examples/restbridge/README.txt

@@ -0,0 +1,25 @@
+This is a demo for the SQLDB REST Bridge.
+
+It requires a database. The database can be created using the
+expenses-DB.sql file (replace DB with the appropriate type) 
+
+Sample data can be inserted with the expenses-data.sql file.
+
+You must edit the program to provide the correct database credentials: 
+look for the ExposeDatabase() call, and edit the username/password.
+
+You must also change the name and location of the database.
+
+You can also set the port on which the demo should listen for HTTP requests.
+By default it is 3000.
+
+The program can save the connection data to an .ini file, run it with -s
+myfile.ini. The connection data and database schema will then be saved.
+
+It can pick up the connection data and schema with the -c myfile.ini
+command-line options at a next run.
+
+
+Enjoy !
+
+Michael.

packages/fcl-web/examples/restbridge/delphiclient/frmmain.dfm

@@ -0,0 +1,129 @@
+object Form1: TForm1
+  Left = 0
+  Top = 0
+  Caption = 'SQLDB Rest client demo'
+  ClientHeight = 319
+  ClientWidth = 527
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  DesignSize = (
+    527
+    319)
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Label1: TLabel
+    Left = 16
+    Top = 8
+    Width = 158
+    Height = 13
+    Caption = 'SQLDBRest bridge resource URL:'
+  end
+  object Label2: TLabel
+    Left = 16
+    Top = 54
+    Width = 48
+    Height = 13
+    Caption = 'Username'
+  end
+  object LEPassword: TLabel
+    Left = 172
+    Top = 54
+    Width = 46
+    Height = 13
+    Caption = 'Password'
+    FocusControl = EPassword
+  end
+  object DBNavigator1: TDBNavigator
+    Left = 16
+    Top = 81
+    Width = 240
+    Height = 25
+    DataSource = DSRest
+    TabOrder = 0
+  end
+  object DBGrid1: TDBGrid
+    Left = 16
+    Top = 112
+    Width = 498
+    Height = 199
+    Anchors = [akLeft, akTop, akRight, akBottom]
+    DataSource = DSRest
+    TabOrder = 1
+    TitleFont.Charset = DEFAULT_CHARSET
+    TitleFont.Color = clWindowText
+    TitleFont.Height = -11
+    TitleFont.Name = 'Tahoma'
+    TitleFont.Style = []
+  end
+  object EURL: TEdit
+    Left = 16
+    Top = 24
+    Width = 417
+    Height = 21
+    Anchors = [akLeft, akTop, akRight]
+    TabOrder = 2
+    Text = 'http://192.168.0.98:3000/projects/'
+  end
+  object BFetch: TButton
+    Left = 439
+    Top = 22
+    Width = 75
+    Height = 25
+    Anchors = [akTop, akRight]
+    Caption = 'Fetch data'
+    TabOrder = 3
+    OnClick = BFetchClick
+  end
+  object EUserName: TEdit
+    Left = 70
+    Top = 51
+    Width = 96
+    Height = 21
+    Anchors = [akLeft, akTop, akRight]
+    TabOrder = 4
+    Text = 'Michael'
+  end
+  object EPassword: TEdit
+    Left = 224
+    Top = 51
+    Width = 134
+    Height = 21
+    Anchors = [akLeft, akTop, akRight]
+    PasswordChar = '*'
+    TabOrder = 5
+    Text = 'secret'
+  end
+  object DSRest: TDataSource
+    DataSet = CDSRest
+    Left = 72
+    Top = 128
+  end
+  object CDSRest: TClientDataSet
+    Aggregates = <>
+    Params = <>
+    Left = 128
+    Top = 128
+  end
+  object RestClient: TIdHTTP
+    AllowCookies = True
+    ProxyParams.BasicAuthentication = False
+    ProxyParams.ProxyPort = 0
+    Request.ContentLength = -1
+    Request.ContentRangeEnd = -1
+    Request.ContentRangeStart = -1
+    Request.ContentRangeInstanceLength = -1
+    Request.Accept = 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'
+    Request.BasicAuthentication = False
+    Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
+    Request.Ranges.Units = 'bytes'
+    Request.Ranges = <>
+    HTTPOptions = [hoInProcessAuth, hoForceEncodeParams]
+    Left = 200
+    Top = 128
+  end
+end

packages/fcl-web/examples/restbridge/delphiclient/frmmain.pas

@@ -0,0 +1,66 @@
+unit frmmain;
+
+interface
+
+uses
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, IPPeerClient, REST.Client,
+  REST.Authenticator.Basic, Data.Bind.Components, Data.Bind.ObjectScope,
+  Vcl.StdCtrls, Vcl.Grids, Vcl.DBGrids, Vcl.ExtCtrls, Vcl.DBCtrls,
+  Datasnap.DBClient, System.Net.URLClient, System.Net.HttpClient,
+  System.Net.HttpClientComponent, IdBaseComponent, IdComponent, IdTCPConnection,
+  IdTCPClient, IdHTTP;
+
+type
+  TForm1 = class(TForm)
+    DSRest: TDataSource;
+    CDSRest: TClientDataSet;
+    DBNavigator1: TDBNavigator;
+    DBGrid1: TDBGrid;
+    EURL: TEdit;
+    BFetch: TButton;
+    Label1: TLabel;
+    Label2: TLabel;
+    EUserName: TEdit;
+    LEPassword: TLabel;
+    EPassword: TEdit;
+    RestClient: TIdHTTP;
+    procedure BFetchClick(Sender: TObject);
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.dfm}
+
+procedure TForm1.BFetchClick(Sender: TObject);
+
+Var
+  URL : String;
+  Response : TMemoryStream;
+
+begin
+  URL:=EURL.Text;
+  if Pos('?',URL)=0 then
+    URL:=URL+'?'
+  else
+    URL:=URL+'&';
+  URL:=URL+'fmt=cds';
+  Response:=TMemoryStream.Create;
+  With RestClient.Request do
+    begin
+    UserName:=EUserName.Text;
+    Password:=EPassword.Text;
+    end;
+  RestClient.Get(URL,Response);
+  Response.Position:=0;
+  CDSRest.LoadFromStream(Response);
+end;
+
+end.

packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dpr

@@ -0,0 +1,14 @@
+program sqldbrestclient;
+
+uses
+  Vcl.Forms,
+  frmmain in 'frmmain.pas' {Form1};
+
+{$R *.res}
+
+begin
+  Application.Initialize;
+  Application.MainFormOnTaskbar := True;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.

packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dproj

@@ -0,0 +1,560 @@
+<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+    <PropertyGroup>
+        <ProjectGuid>{7D8C7C45-76FE-4285-B7B8-E1D0E65A6829}</ProjectGuid>
+        <ProjectVersion>18.3</ProjectVersion>
+        <FrameworkType>VCL</FrameworkType>
+        <MainSource>sqldbrestclient.dpr</MainSource>
+        <Base>True</Base>
+        <Config Condition="'$(Config)'==''">Debug</Config>
+        <Platform Condition="'$(Platform)'==''">Win32</Platform>
+        <TargetedPlatforms>1</TargetedPlatforms>
+        <AppType>Application</AppType>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
+        <Base_Win32>true</Base_Win32>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
+        <Base_Win64>true</Base_Win64>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
+        <Cfg_1>true</Cfg_1>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
+        <Cfg_1_Win32>true</Cfg_1_Win32>
+        <CfgParent>Cfg_1</CfgParent>
+        <Cfg_1>true</Cfg_1>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
+        <Cfg_2>true</Cfg_2>
+        <CfgParent>Base</CfgParent>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
+        <Cfg_2_Win32>true</Cfg_2_Win32>
+        <CfgParent>Cfg_2</CfgParent>
+        <Cfg_2>true</Cfg_2>
+        <Base>true</Base>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Base)'!=''">
+        <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
+        <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
+        <DCC_E>false</DCC_E>
+        <DCC_N>false</DCC_N>
+        <DCC_S>false</DCC_S>
+        <DCC_F>false</DCC_F>
+        <DCC_K>false</DCC_K>
+        <DCC_UsePackage>RESTComponents;FlexCel_Pdf;emsclientfiredac;DataSnapFireDAC;RemObjects_Server_Indy_D25;FireDACIBDriver;RemObjects_Indy_D25;xdata;emsclient;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;sparkle;tmsbcl;FireDAC;FlexCel_XlsAdapter;FireDACSqliteDriver;RemObjects_WebBroker_D25;soaprtl;FlexCel_Core;soapmidas;FlexCel_Render;aurelius;$(DCC_UsePackage)</DCC_UsePackage>
+        <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
+        <Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
+        <UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
+        <UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
+        <SanitizedProjectName>sqldbrestclient</SanitizedProjectName>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Base_Win32)'!=''">
+        <DCC_UsePackage>DBXSqliteDriver;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;FMX_FlexCel_Core;vclFireDAC;RemObjects_Server_Synapse_D25;FireDACADSDriver;frxe25;DBXMSSQLDriver;vacommpkgdXE11;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;tmsxlsdXE11;vcltouch;VCLTMSFNCCorePkgDXE11;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;fsIBX25;inetdb;CEF4Delphi;TMSCryptoPkgDXE11;tiOPFGUI;FmxTeeUI;emsedge;DataAbstract_DBXDriver_Enterprise_D25;fmx;fmxdae;frxDB25;tmsdXE11;vclib;VCL_FlexCel_Components;frxTee25;tmsexdXE11;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;RemObjects_Synapse_D25;fsTee25;FMXTMSFNCCorePkgDXE11;DataSnapConnectors;VCLRESTComponents;FMXTMSFNCUIPackPkgDXE11;vclie;fs25;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;TMSWEBCorePkgDXE11;FireDACCommonODBC;DataSnapClient;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;mbColorLibD101Berlin;VCLTMSFNCUIPackPkgDXE11;TMSWEBCorePkgLibDXE11;dsnapcon;madExcept_;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;madBasic_;TeeDB;vacommpkgdedXE11;fsADO25;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DataAbstract_DBXDriver_Pro_D25;frxADO25;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;madDisAsm_;DBXSybaseASADriver;tiOPFCore;CustomIPTransport;vcldsnap;CodeSiteExpressPkg;frx25;frxIntIO25;fsDB25;bindcomp;tmswizdXE11;DBXInformixDriver;IndyIPClient;kbmMemRunD102Pro;frxDBX25;bindcompvcl;SynEdit_R;DataAbstract_SQLiteDriver_D25;TeeUI;FMX_FlexCel_Components;dbxcds;VclSmp;VCL_FlexCel_Core;adortl;FireDACODBCDriver;DataAbstract_SpiderMonkeyScripting_D25;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;frxIBX25;TMSCryptoPkgDEDXE11;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
+        <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
+        <BT_BuildType>Debug</BT_BuildType>
+        <VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
+        <VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
+        <VerInfo_Locale>1033</VerInfo_Locale>
+        <Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Base_Win64)'!=''">
+        <DCC_UsePackage>DBXSqliteDriver;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;FMX_FlexCel_Core;vclFireDAC;RemObjects_Server_Synapse_D25;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;VCLTMSFNCCorePkgDXE11;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;inetdb;TMSCryptoPkgDXE11;FmxTeeUI;emsedge;DataAbstract_DBXDriver_Enterprise_D25;fmx;fmxdae;tmsdXE11;vclib;VCL_FlexCel_Components;tmsexdXE11;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;RemObjects_Synapse_D25;FMXTMSFNCCorePkgDXE11;DataSnapConnectors;VCLRESTComponents;FMXTMSFNCUIPackPkgDXE11;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;VCLTMSFNCUIPackPkgDXE11;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DataAbstract_DBXDriver_Pro_D25;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;DBXInformixDriver;IndyIPClient;bindcompvcl;SynEdit_R;DataAbstract_SQLiteDriver_D25;TeeUI;FMX_FlexCel_Components;dbxcds;VclSmp;VCL_FlexCel_Core;adortl;FireDACODBCDriver;DataAbstract_SpiderMonkeyScripting_D25;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_1)'!=''">
+        <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
+        <DCC_DebugDCUs>true</DCC_DebugDCUs>
+        <DCC_Optimize>false</DCC_Optimize>
+        <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
+        <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
+        <DCC_RemoteDebug>true</DCC_RemoteDebug>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
+        <DCC_RemoteDebug>false</DCC_RemoteDebug>
+        <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
+        <AppEnableHighDPI>true</AppEnableHighDPI>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_2)'!=''">
+        <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
+        <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
+        <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+        <DCC_DebugInformation>0</DCC_DebugInformation>
+    </PropertyGroup>
+    <PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
+        <AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
+        <AppEnableHighDPI>true</AppEnableHighDPI>
+    </PropertyGroup>
+    <ItemGroup>
+        <DelphiCompile Include="$(MainSource)">
+            <MainSource>MainSource</MainSource>
+        </DelphiCompile>
+        <DCCReference Include="frmmain.pas">
+            <Form>Form1</Form>
+            <FormType>dfm</FormType>
+        </DCCReference>
+        <BuildConfiguration Include="Release">
+            <Key>Cfg_2</Key>
+            <CfgParent>Base</CfgParent>
+        </BuildConfiguration>
+        <BuildConfiguration Include="Base">
+            <Key>Base</Key>
+        </BuildConfiguration>
+        <BuildConfiguration Include="Debug">
+            <Key>Cfg_1</Key>
+            <CfgParent>Base</CfgParent>
+        </BuildConfiguration>
+    </ItemGroup>
+    <ProjectExtensions>
+        <Borland.Personality>Delphi.Personality.12</Borland.Personality>
+        <Borland.ProjectType>Application</Borland.ProjectType>
+        <BorlandProject>
+            <Delphi.Personality>
+                <Source>
+                    <Source Name="MainSource">sqldbrestclient.dpr</Source>
+                </Source>
+            </Delphi.Personality>
+            <Deployment Version="3">
+                <DeployFile LocalName="Win32\Debug\sqldbrestclient.exe" Configuration="Debug" Class="ProjectOutput">
+                    <Platform Name="Win32">
+                        <RemoteName>sqldbrestclient.exe</RemoteName>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
+                <DeployClass Name="AdditionalDebugSymbols">
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidClassesDexFile">
+                    <Platform Name="Android">
+                        <RemoteDir>classes</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidGDBServer">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\armeabi-v7a</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidLibnativeArmeabiFile">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\armeabi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidLibnativeMipsFile">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\mips</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidServiceOutput">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\armeabi-v7a</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidSplashImageDef">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="AndroidSplashStyles">
+                    <Platform Name="Android">
+                        <RemoteDir>res\values</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_DefaultAppIcon">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon144">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-xxhdpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon36">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-ldpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon48">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-mdpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon72">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-hdpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_LauncherIcon96">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-xhdpi</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_SplashImage426">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-small</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_SplashImage470">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-normal</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_SplashImage640">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-large</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="Android_SplashImage960">
+                    <Platform Name="Android">
+                        <RemoteDir>res\drawable-xlarge</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="DebugSymbols">
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="DependencyFramework">
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                        <Extensions>.framework</Extensions>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="DependencyModule">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                        <Extensions>.dll;.bpl</Extensions>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Required="true" Name="DependencyPackage">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                        <Extensions>.dylib</Extensions>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                        <Extensions>.bpl</Extensions>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="File">
+                    <Platform Name="Android">
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice32">
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\Resources\StartUp\</RemoteDir>
+                        <Operation>0</Operation>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPad_Launch1024">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPad_Launch1536">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPad_Launch2048">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPad_Launch768">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPhone_Launch320">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPhone_Launch640">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="iPhone_Launch640x1136">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectAndroidManifest">
+                    <Platform Name="Android">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSDeviceDebug">
+                    <Platform Name="iOSDevice32">
+                        <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSDeviceResourceRules">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSEntitlements">
+                    <Platform Name="iOSDevice32">
+                        <RemoteDir>..\</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <RemoteDir>..\</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSInfoPList">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectiOSResource">
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectOSXEntitlements">
+                    <Platform Name="OSX32">
+                        <RemoteDir>..\</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectOSXInfoPList">
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectOSXResource">
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\Resources</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Required="true" Name="ProjectOutput">
+                    <Platform Name="Android">
+                        <RemoteDir>library\lib\armeabi-v7a</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSDevice64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="iOSSimulator">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Linux64">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="OSX32">
+                        <RemoteDir>Contents\MacOS</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win32">
+                        <Operation>0</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="ProjectUWPManifest">
+                    <Platform Name="Win32">
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win64">
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="UWP_DelphiLogo150">
+                    <Platform Name="Win32">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win64">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <DeployClass Name="UWP_DelphiLogo44">
+                    <Platform Name="Win32">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                    <Platform Name="Win64">
+                        <RemoteDir>Assets</RemoteDir>
+                        <Operation>1</Operation>
+                    </Platform>
+                </DeployClass>
+                <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
+                <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
+                <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
+                <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
+                <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
+                <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
+            </Deployment>
+            <Platforms>
+                <Platform value="Win32">True</Platform>
+                <Platform value="Win64">False</Platform>
+            </Platforms>
+        </BorlandProject>
+        <ProjectFileVersion>12</ProjectFileVersion>
+    </ProjectExtensions>
+    <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
+    <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
+    <Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
+</Project>

packages/fcl-web/examples/restbridge/demorestbridge.lpi

@@ -0,0 +1,62 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="SQLDB REST bridge Application"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <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="demorestbridge.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="demorestbridge"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-web/examples/restbridge/demorestbridge.pp

@@ -0,0 +1,160 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST rest bridge demo applocation.
+
+    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.
+
+ **********************************************************************}
+
+program demorestbridge;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils, CustApp, sqldbrestbridge, fphttpapp, IBConnection, odbcconn, mysql55conn, mysql56conn, pqconnection,
+  mssqlconn, oracleconnection, sqldbrestxml, sqldbrestio, sqldbrestschema, sqldbrestdata, sqldbrestjson, sqldbrestcsv, sqldbrestcds,
+  sqldbrestconst, sqldbrestauth, sqldbrestini, sqldb, sqldbrestauthini
+  ;
+
+type
+  { TXMLSQLDBRestDispatcher }
+
+  TXMLSQLDBRestDispatcher = class(TSQLDBRestDispatcher)
+    Function CreateOutputStreamer(IO: TRestIO): TRestOutputStreamer; override;
+  end;
+
+  { TRestServerDemoApplication }
+
+  TRestServerDemoApplication = class(THTTPApplication)
+  private
+    procedure DoAfterRequest(Sender: TObject; aConn: TSQLConnection; aResource: TSQLDBRestResource);
+  Protected
+    FAuth : TRestBasicAuthenticator;
+    FDisp : TSQLDBRestDispatcher;
+    FRequestCount,
+    FMaxRequests : integer;
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp; virtual;
+  end;
+
+{ TXMLSQLDBRestDispatcher }
+
+function TXMLSQLDBRestDispatcher.CreateOutputStreamer(IO: TRestIO): TRestOutputStreamer;
+begin
+  io.Response.ContentStream:=TMemoryStream.Create;
+  io.Response.FreeContentStream:=True;
+  Result:=TXMLOutputStreamer.Create(IO.Response.ContentStream,Strings,@IO.DoGetVariable);
+end;
+
+{ TRestServerDemoApplication }
+
+procedure TRestServerDemoApplication.DoAfterRequest(Sender: TObject; aConn: TSQLConnection; aResource: TSQLDBRestResource);
+begin
+  inc(FRequestCount);
+  if (FMaxRequests>0) and (FRequestCount>=FMaxRequests) then
+    begin
+    DoLog(etInfo,'Maximum requests reached');
+    Terminate;
+    end;
+end;
+
+procedure TRestServerDemoApplication.DoRun;
+var
+  ErrorMsg: String;
+begin
+  // quick check parameters
+  ErrorMsg:=CheckOptions('hc:s:m:', ['help','config:','save-config:','max-requests:']);
+  if ErrorMsg<>'' then begin
+    ShowException(Exception.Create(ErrorMsg));
+    Terminate;
+    Exit;
+  end;
+
+  // parse parameters
+  if HasOption('h', 'help') then begin
+    WriteHelp;
+    Terminate;
+    Exit;
+  end;
+  Port:=3000;
+  FDisp:=TSQLDBRestDispatcher.Create(Self);
+  if HasOption('c', 'config') then
+    FDisp.LoadFromFile(GetOptionValue('c', 'config'),[dioSkipReadSchemas])
+  else
+    begin
+    // create a Default setup
+    FAuth:=TRestBasicAuthenticator.Create(Self);
+    FAuth.DefaultUserName:='me';
+    FAuth.DefaultPassword:='secret';
+    FAuth.AuthenticateUserSQL.Text:='select uID from users where (uLogin=:UserName) and (uPassword=:Password)';
+    FDisp.DispatchOptions:=FDisp.DispatchOptions+[rdoConnectionInURL,rdoCustomView,rdoHandleCORS];
+    FDisp.ExposeDatabase(TPQConnectionDef.TypeName,'localhost','expensetracker','me','secret',Nil,[foFilter,foInInsert,foInUpdate,foOrderByDesc]);
+    With FDisp.Schemas[0].Schema.Resources do
+      begin
+      FindResourceByName('users').Fields.FindByFieldName('uID').GeneratorName:='seqUsersID';
+      FindResourceByName('projects').Fields.FindByFieldName('pID').GeneratorName:='seqProjectsID';
+      FindResourceByName('expensetypes').Fields.FindByFieldName('etID').GeneratorName:='seqExpenseTypesID';
+      FindResourceByName('expenses').Fields.FindByFieldName('eID').GeneratorName:='seqExpenseID';
+      end;
+    FDisp.Authenticator:=Fauth;
+    if HasOption('s','save-config') then
+      FDisp.SaveToFile(GetOptionValue('s','save-config'));
+    end;
+  // Mostly for debug purposes, to get e.g. a heap trace
+  if HasOption('m','max-requests') then
+    FMaxRequests:=StrToIntDef(GetOptionValue('m','max-requests'),0);
+  FDisp.AfterGet:=@DoAfterRequest;
+  FDisp.AfterPost:=@DoAfterRequest;
+  FDisp.AfterPut:=@DoAfterRequest;
+  FDisp.AfterDelete:=@DoAfterRequest;
+  FDisp.Active:=True;
+  Inherited DoRun;
+end;
+
+constructor TRestServerDemoApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+destructor TRestServerDemoApplication.Destroy;
+begin
+  FreeAndNil(FDisp);
+  FreeAndNil(FAuth);
+  inherited Destroy;
+end;
+
+procedure TRestServerDemoApplication.WriteHelp;
+begin
+  writeln('Usage: ', ExeName, ' [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h --help             this message');
+  Writeln('-c --config=File      Read config from .ini file');
+  Writeln('-m --max-requests=N   Server at most N requests, then quit.');
+  Writeln('-s --saveconfig=File  Write config to .ini file (ignored when -c or --config is used)');
+end;
+
+var
+  Application: TRestServerDemoApplication;
+
+begin
+  Application:=TRestServerDemoApplication.Create(nil);
+  Application.Title:='SQLDB REST bridge Application';
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-web/examples/restbridge/expenses-data.sql

@@ -0,0 +1,10 @@
+insert into users (uLogin,uFullName,uPassword) values ('Michael','Michaël Van Canneyt','secret');
+insert into users (uLogin,uFullName,uPassword) values ('Mattias','Mattias Gaertner','secret');
+insert into users (uLogin,uFullName,uPassword) values ('Detlef','Detlef overbeek','secret');
+insert into projects (pName,pDescription) values ('Pas2JS','Pas2JS - Pascal to Javascript converter');
+insert into projects (pName,pDescription) values ('FPC','FPC - Open source pascal compiler');
+insert into projects (pName,pDescription) values ('Lazarus','Lazarus - Open source IDE for Pascal');
+insert into projects (pName,pDescription) values ('JSONViewer','Lazarus JSON viewer tool');
+insert into ExpenseTypes (etName,etDescription) values ('Transport','Travel by bus/train/airplane');
+insert into ExpenseTypes (etName,etDescription) values ('Car','Travel by car');
+insert into ExpenseTypes (etName,etDescription) values ('Food','expenses in Bar, Restaurant');

packages/fcl-web/examples/restbridge/expenses-pq.sql

@@ -0,0 +1,45 @@
+drop table ExpenseTypes;
+create table ExpenseTypes (
+  etID bigint not null default nextval('seqExpenseTypesID'),
+  etName varchar(50) not null,
+  etDescription varchar(100) not null,
+  etMaxAmount decimal(10,2),
+  etCost decimal(10,2) default 1,
+  etActive boolean not null default true
+);
+
+create sequence seqUsersID;
+create table Users (
+  uID bigint not null default nextval('seqUsersID'),
+  uLogin varchar(50) not null,
+  uFullName varchar(100) not null,
+  uPassword varchar(100) not null,
+  uActive boolean not null default true 
+);
+
+create sequence seqProjectsID;
+create table Projects (
+  pID bigint not null default nextval('seqProjectsID'),
+  pName varchar(50) not null,
+  pDescription varchar(100) not null,
+  pActive boolean not null default true
+);
+
+create sequence seqExpenseTypesID;
+
+create sequence seqExpenseID;
+drop table Expenses;
+create table Expenses (
+  eID bigint not null default nextval('seqExpenseID'),
+  eUserFK bigint not null,
+  eProjectFK bigint not null,
+  eTypeFK bigint not null,
+  eAmount decimal(10,2) not null,
+  eDate date not null default 'today',
+  eComment varchar(1024)
+);
+
+alter table ExpenseTypes add constraint pkExpenseTypes primary key (etID);
+alter table Users add constraint pkUsers primary key (uID);
+alter table Projects add constraint pkProjects primary key (pID);
+alter table Expenses add  constraint pkExpenses primary key (eID);

packages/fcl-web/fpmake.pp

@@ -48,6 +48,7 @@ begin
     P.SourcePath.Add('src/webdata');
     P.SourcePath.Add('src/jsonrpc');
     P.SourcePath.Add('src/hpack');
+    P.SourcePath.Add('src/restbridge');
 
     T:=P.Targets.AddUnit('httpdefs.pp');
     T.ResourceStrings:=true;
@@ -294,6 +295,91 @@ begin
       AddUnit('uhpackimp');
       end;
     
+    T:=P.Targets.AddUnit('sqldbrestconst.pp');
+    T.ResourceStrings:=true;
+    
+    T:=P.Targets.AddUnit('sqldbrestschema.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestio.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestconst');
+      AddUnit('sqldbrestschema');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestdata.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestconst');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestio');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestauth.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestconst');
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestjson.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestbridge.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestdata');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestcds.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestcsv.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestxml.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestio');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestini.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestbridge');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestauthini.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestauth');
+      AddUnit('sqldbrestschema');
+      AddUnit('sqldbrestconst');
+      end;
+    T:=P.Targets.AddUnit('sqldbrestmodule.pp');
+    With T.Dependencies do  
+      begin
+      AddUnit('sqldbrestbridge');
+      AddUnit('sqldbrestconst');
+      end;
+    
 {$ifndef ALLPACKAGES}
     Run;
     end;

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

@@ -733,6 +733,7 @@ begin
   FWebHandler.Free;
   if assigned(FEventLog) then
     FEventLog.Free;
+  Inherited;
 end;
 
 procedure TCustomWebApplication.CreateForm(AClass: TComponentClass; out Reference);

packages/fcl-web/src/restbridge/sqldbrestauth.pp

@@ -0,0 +1,263 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST HTTP BASIC authentication.
+
+    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 sqldbrestauth;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldb, db, sqldbrestconst, sqldbrestio, httpdefs;
+
+Type
+  TAuthenticateEvent = procedure (Sender : TObject; aRequest : TRequest) of object;
+
+  { TRestAuthenticator }
+
+  TRestAuthenticator = Class(TComponent)
+  private
+    FAfterAuthenticate: TAuthenticateEvent;
+    FBeforeAuthenticate: TAuthenticateEvent;
+  Protected
+    function DoAuthenticateRequest(io : TRestIO) : Boolean; virtual; abstract;
+  Public
+    Function AuthenticateRequest(io : TRestIO) : Boolean;
+    Function NeedConnection : Boolean; virtual;
+  Published
+    Property BeforeAuthenticate : TAuthenticateEvent Read FBeforeAuthenticate Write FBeforeAuthenticate;
+    Property AfterAuthenticate : TAuthenticateEvent Read FAfterAuthenticate Write FAfterAuthenticate;
+  end;
+
+  TBasicAuthenticationEvent = procedure (sender : TObject; Const aUserName,aPassword : UTF8String; Var allow : Boolean; Var UserID : UTF8String) of object;
+
+  { TRestBasicAuthenticator }
+
+  TRestBasicAuthenticator = Class(TRestAuthenticator)
+  private
+    FAuthConnection: TSQLConnection;
+    FAuthenticationRealm: UTF8String;
+    FAuthSQL: TStringList;
+    FDefaultPassword: UTF8String;
+    FDefaultUserID: UTF8String;
+    FDefaultUserName: UTF8String;
+    FOnBasicAuthentication: TBasicAuthenticationEvent;
+    function GetAuthenticationRealm: UTF8String;
+    function GetAuthSQL: TStrings;
+    function IsNotDefaultRealm: Boolean;
+    procedure SetAuthConnection(AValue: TSQLConnection);
+    procedure SetAuthSQL(AValue: TStrings);
+  Protected
+    function HaveAuthSQL: Boolean;
+    function AuthenticateUserUsingSQl(IO: TRestIO; const UN, PW: UTF8String; out UID: UTF8String): Boolean; virtual;
+  Public
+    Constructor Create(AOwner :TComponent); override;
+    Destructor Destroy; override;
+    class function ExtractUserNamePassword(Req: TRequest; out UN, PW: UTF8String): Boolean;
+    Function NeedConnection : Boolean; override;
+    function DoAuthenticateRequest(IO : TRestIO) : Boolean; override;
+  Published
+    Property AuthConnection : TSQLConnection Read FAuthConnection Write SetAuthConnection;
+    Property AuthenticateUserSQL : TStrings Read GetAuthSQL Write SetAuthSQL;
+    Property DefaultUserName : UTF8String Read FDefaultUserName Write FDefaultUserName;
+    Property DefaultPassword : UTF8String Read FDefaultPassword Write FDefaultPassword;
+    Property DefaultUserID : UTF8String Read FDefaultUserID Write FDefaultUserID ;
+    Property AuthenticationRealm : UTF8String Read GetAuthenticationRealm Write FAuthenticationRealm Stored IsNotDefaultRealm;
+    Property OnBasicAuthentication : TBasicAuthenticationEvent Read FOnBasicAuthentication Write FOnBasicAuthentication;
+  end;
+
+implementation
+
+uses strutils, base64;
+
+{ TRestBasicAuthenticator }
+
+function TRestBasicAuthenticator.GetAuthenticationRealm: UTF8String;
+begin
+  Result:=FAuthenticationRealm;
+  if Result='' then
+    Result:=DefaultAuthenticationRealm;
+end;
+
+function TRestBasicAuthenticator.GetAuthSQL: TStrings;
+begin
+  Result:=FAuthSQL;
+end;
+
+function TRestBasicAuthenticator.IsNotDefaultRealm: Boolean;
+begin
+  Result:=(GetAuthenticationRealm<>DefaultAuthenticationRealm);
+end;
+
+procedure TRestBasicAuthenticator.SetAuthConnection(AValue: TSQLConnection);
+begin
+  if FAuthConnection=AValue then Exit;
+  If Assigned(FAuthConnection) then
+    FAuthConnection.RemoveFreeNotification(Self);
+  FAuthConnection:=AValue;
+  If Assigned(FAuthConnection) then
+    FAuthConnection.FreeNotification(Self);
+end;
+
+procedure TRestBasicAuthenticator.SetAuthSQL(AValue: TStrings);
+begin
+  if FAuthSQL=AValue then Exit;
+  FAuthSQL.Assign(AValue);
+end;
+
+constructor TRestBasicAuthenticator.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FAuthSQL:=TStringList.Create;
+end;
+
+destructor TRestBasicAuthenticator.Destroy;
+begin
+  FreeAndNil(FAuthSQL);
+  inherited Destroy;
+end;
+
+function TRestBasicAuthenticator.NeedConnection: Boolean;
+begin
+  Result:=HaveAuthSQL and (AuthConnection=Nil);
+end;
+
+Function TRestBasicAuthenticator.HaveAuthSQL : Boolean;
+
+begin
+  Result:=(FAuthSQL.Count>0) and (Trim(FAuthSQL.Text)<>'');
+end;
+
+function TRestBasicAuthenticator.AuthenticateUserUsingSQl(IO : TRestIO; Const UN,PW : UTF8String; Out UID : UTF8String) : Boolean;
+
+Var
+  Conn : TSQLConnection;
+  Q : TSQLQuery;
+  P : TParam;
+
+begin
+  Result:=HaveAuthSQL;
+  if not Result then
+     exit;
+  Conn:=Self.AuthConnection;
+  if Conn=Nil then
+    Conn:=IO.Connection;
+  Result:=Conn<>Nil;
+  if not Result then
+    exit;
+  Q:=TSQLQuery.Create(Self);
+  try
+    Q.Database:=Conn;
+    if IO.Transaction<>nil then
+      Q.Transaction:=IO.Transaction;
+    Q.SQL:=FAuthSQL;
+    P:=Q.Params.FindParam('UserName');
+    if P<>Nil then
+      P.AsString:=UN;
+    P:=Q.Params.FindParam('Password');
+    if P<>Nil then
+      P.AsString:=PW;
+    Q.UniDirectional:=True;
+    Q.UsePrimaryKeyAsKey:=False;
+    Q.Open;
+    Result:=Not (Q.EOF and Q.BOF);
+    If Result then
+      UID:=Q.Fields[0].AsString;
+  finally
+    Q.Free;
+  end;
+end;
+
+Class Function TRestBasicAuthenticator.ExtractUserNamePassword(Req : TRequest; Out UN,PW : UTF8String) : Boolean;
+
+Var
+  S,A : String;
+
+begin
+  S:=Req.Authorization;
+  Result:=(S<>'');
+  if not Result then
+    begin
+    UN:='';
+    PW:='';
+    end
+  else
+    begin
+    A:=ExtractWord(1,S,[' ']);
+    S:=ExtractWord(2,S,[' ']);
+    if Not SameText(A,'BASIC') then
+      Exit(False);
+    S:=DecodeStringBase64(S);
+    UN:=ExtractWord(1,S,[':']);
+    PW:=ExtractWord(2,S,[':']);
+    end;
+end;
+
+function TRestBasicAuthenticator.DoAuthenticateRequest(io: TRestIO): Boolean;
+
+Var
+  UID,UN,PW : UTF8String;
+
+begin
+  Result:=False;
+  UID:='';
+  if ExtractUserNamePassword(IO.Request,UN,PW) then
+    begin
+    if (UN<>'') and (PW<>'') then
+      If (DefaultUserName<>'') and (DefaultPassword<>'') then
+        begin
+        Result:=(UN=DefaultUserName) and (PW=DefaultPassword);
+        If Result then
+          begin
+          UID:=DefaultUserID;
+          If UID='' then
+            UID:=DefaultUserName;
+          end;
+        end
+      else
+        UID:=UN;
+    if Assigned(FOnBasicAuthentication) then
+       FOnBasicAuthentication(Self,UN,PW,Result,UID);
+    if not Result then
+      Result:=AuthenticateUserUsingSQl(IO,UN,PW,UID);
+    end;
+  If Result then
+    IO.UserID:=UID
+  else
+    begin
+    IO.Response.Code:=401;
+    IO.Response.CodeText:=SUnauthorized;
+    IO.Response.WWWAuthenticate:=Format('BASIC Realm: "%s"',[AuthenticationRealm]);
+    end;
+end;
+
+{ TRestAuthenticator }
+
+function TRestAuthenticator.AuthenticateRequest(io: TRestIO): Boolean;
+begin
+  If Assigned(FBeforeAuthenticate) then
+    FBeforeAuthenticate(self,IO.Request);
+  Result:=DoAuthenticateRequest(IO);
+  If Assigned(FAfterAuthenticate) then
+    FAfterAuthenticate(self,IO.Request);
+end;
+
+function TRestAuthenticator.NeedConnection: Boolean;
+begin
+  Result:=False;
+end;
+
+
+end.
+

packages/fcl-web/src/restbridge/sqldbrestauthini.pp

@@ -0,0 +1,211 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST bridge : HTTP authorization
+
+    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 sqldbrestauthini;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldbrestauth, inifiles;
+
+Type
+  TBasicAuthIniOption = (baoClearOnRead,      // Clear values first
+                         baoSkipPassword,     // Do not save/load password
+                         baoSkipMaskPassword, // do not mask the password
+                         baoUserNameAsMask    // use the username as mask for password
+                         );
+  TBasicAuthIniOptions = Set of TBasicAuthIniOption;
+
+  TSQLDBRestBasicAuthHelper = class helper for TRestBasicAuthenticator
+  Private
+    Procedure ClearValues;
+  Public
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; aOptions : TBasicAuthIniOptions = []); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TBasicAuthIniOptions); overload;
+    Procedure LoadFromFile(Const aFileName : String; aOptions : TBasicAuthIniOptions = []); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String; aOptions : TBasicAuthIniOptions); overload;
+    Procedure SaveToFile(Const aFileName : String; aOptions : TBasicAuthIniOptions = []);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String; aOptions : TBasicAuthIniOptions = []);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; aOptions : TBasicAuthIniOptions = []); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TBasicAuthIniOptions); overload;
+  end;
+
+Var
+  DefaultBasicAuthSection : String = 'BasicAuth';
+  TrivialEncryptKey : String = 'SQLDBAuth';
+
+Function BasicAuthIniOptionsToStr(Options: TBasicAuthIniOptions): String;
+Function StrToBasicAuthIniOptions(S : String) : TBasicAuthIniOptions;
+
+implementation
+
+uses typinfo,strutils;
+
+Function BasicAuthIniOptionsToStr(Options: TBasicAuthIniOptions): String;
+
+begin
+  Result:=SetToString(PTypeInfo(TypeInfo(TBasicAuthIniOptions)),Integer(Options),false);
+end;
+
+Function StrToBasicAuthIniOptions(S : String) : TBasicAuthIniOptions;
+
+var
+  i : integer;
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TBasicAuthIniOptions)),S);
+  Result:=TBasicAuthIniOptions(I);
+end;
+
+
+{ TSQLDBRestBasicAuthHelper }
+
+Const
+  KeyUserID = 'UserID';
+  KeyUserName = 'UserName';
+  KeyPassword = 'Password';
+  KeyRealm = 'Realm';
+  KeySQL = 'SQL';
+
+
+
+procedure TSQLDBRestBasicAuthHelper.ClearValues;
+begin
+  DefaultUserID:='';
+  DefaultUserName:='';
+  DefaultPassword:='';
+  AuthenticateUserSQL.Clear;
+  AuthenticationRealm:='';
+end;
+
+procedure TSQLDBRestBasicAuthHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String; aOptions: TBasicAuthIniOptions);
+
+Var
+  M,P : String;
+begin
+  With aIni do
+    begin
+    if (baoClearOnRead in aOptions) then
+       ClearValues;
+    DefaultUserName:=ReadString(ASection,KeyUserName,DefaultUserName);
+    DefaultUserID:=ReadString(ASection,KeyUserID,DefaultUserID);
+    AuthenticationRealm:=ReadString(ASection,KeyRealm,AuthenticationRealm);
+    AuthenticateUserSQL.StrictDelimiter:=True;
+    AuthenticateUserSQL.Delimiter:='&';
+    AuthenticateUserSQL.DelimitedText:=ReadString(ASection,KeySQL,AuthenticateUserSQL.DelimitedText);
+    // optional parts
+    if not (baoSkipPassword in aOptions) then
+      begin
+      if baoSkipMaskPassword in aOptions then
+        P:=ReadString(ASection,KeyPassword,DefaultPassword)
+      else
+        begin
+        P:=ReadString(ASection,KeyPassword,'');
+        if (P<>'') then
+          begin
+          if baoUserNameAsMask in aOptions then
+            M:=DefaultUserName
+          else
+            M:=TrivialEncryptKey;
+          P:=XorDecode(M,P);
+          end;
+        end;
+      DefaultPassword:=P;
+      end;
+    end;
+end;
+
+procedure TSQLDBRestBasicAuthHelper.LoadFromIni(const aIni: TCustomIniFile; aOptions: TBasicAuthIniOptions);
+begin
+  LoadFromIni(aIni,DefaultBasicAuthSection,aOptions);
+end;
+
+procedure TSQLDBRestBasicAuthHelper.LoadFromFile(const aFileName: String; aOptions: TBasicAuthIniOptions);
+
+
+begin
+  Loadfromfile(aFileName,DefaultBasicAuthSection,aOptions);
+end;
+
+procedure TSQLDBRestBasicAuthHelper.LoadFromFile(const aFileName: String; const ASection: String; aOptions: TBasicAuthIniOptions);
+
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestBasicAuthHelper.SaveToFile(const aFileName: String; aOptions: TBasicAuthIniOptions);
+begin
+  SaveToFile(aFileName,DefaultBasicAuthSection,aOptions);
+end;
+
+procedure TSQLDBRestBasicAuthHelper.SaveToFile(const aFileName: String; const ASection: String; aOptions: TBasicAuthIniOptions);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToini(Ini,aSection,aOptions);
+    Ini.UpdateFile;
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestBasicAuthHelper.SaveToIni(const aIni: TCustomIniFile; aOptions: TBasicAuthIniOptions);
+begin
+  SaveToIni(aIni,DefaultBasicAuthSection,aOptions);
+end;
+
+procedure TSQLDBRestBasicAuthHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String; aOptions: TBasicAuthIniOptions);
+
+Var
+  M,P : String;
+
+begin
+  With aIni do
+    begin
+    WriteString(ASection,KeyUserName,DefaultUserName);
+    WriteString(ASection,KeyUserID,DefaultUserID);
+    WriteString(ASection,KeyRealm,AuthenticationRealm);
+    AuthenticateUserSQL.StrictDelimiter:=True;
+    AuthenticateUserSQL.Delimiter:='&';
+    WriteString(ASection,KeySQL,AuthenticateUserSQL.DelimitedText);
+    if not (baoSkipPassword in aOptions) then
+      begin
+      P:=DefaultPassword;
+      if Not (baoSkipMaskPassword in aOptions) then
+        begin
+        if baoUserNameAsMask in aOptions then
+          M:=DefaultUserName
+        else
+          M:=TrivialEncryptKey;
+        P:=XorEncode(M,P);
+        end;
+      WriteString(ASection,KeyPassword,P);
+      end;
+    end;
+end;
+
+end.
+

packages/fcl-web/src/restbridge/sqldbrestbridge.pp

@@ -0,0 +1,1804 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST dispatcher component.
+
+    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 sqldbrestbridge;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DB, SQLDB, httpdefs, httproute, fpjson, sqldbrestschema, sqldbrestio, sqldbrestdata, sqldbrestauth;
+
+Type
+  TRestDispatcherOption = (rdoConnectionInURL,rdoExposeMetadata,rdoCustomView,rdoHandleCORS);
+  TRestDispatcherOptions = set of TRestDispatcherOption;
+
+Const
+  DefaultDispatcherOptions = [rdoExposeMetadata];
+
+Type
+
+  { TSQLDBRestConnection }
+
+  TSQLDBRestConnection = Class(TCollectionItem)
+  private
+    FCharSet: UTF8String;
+    FConnection: TSQLConnection;
+    FConnectionType: String;
+    FDatabaseName: UTF8String;
+    FEnabled: Boolean;
+    FHostName: UTF8String;
+    FName: UTF8String;
+    FParams: TStrings;
+    FPassword: UTF8String;
+    FPort: Word;
+    FRole: UTF8String;
+    FUserName: UTF8String;
+    FNotifier : TComponent;
+    function GetName: UTF8String;
+    procedure SetConnection(AValue: TSQLConnection);
+    procedure SetParams(AValue: TStrings);
+  Protected
+    Function GetDisplayName: string; override;
+  Public
+    constructor Create(ACollection: TCollection); override;
+    Destructor Destroy; override;
+    Procedure Assign(Source: TPersistent); override;
+  Published
+    // Always use this connection instance
+    Property SingleConnection : TSQLConnection Read FConnection Write SetConnection;
+    // Allow this connection to be used.
+    Property Enabled : Boolean Read FEnabled Write FEnabled default true;
+    // TSQLConnector type
+    property ConnectionType : String Read FConnectionType Write FConnectionType;
+    // Name for this connection
+    Property Name : UTF8String Read GetName Write FName;
+    // Database user password
+    property Password : UTF8String read FPassword write FPassword;
+    // Database username
+    property UserName : UTF8String read FUserName write FUserName;
+    // Database character set
+    property CharSet : UTF8String read FCharSet write FCharSet;
+    // Database hostname
+    property HostName : UTF8String Read FHostName Write FHostName;
+    // Database role
+    Property Role :  UTF8String read FRole write FRole;
+    // Database database name
+    property DatabaseName : UTF8String Read FDatabaseName Write FDatabaseName;
+    // Other parameters
+    Property Params : TStrings Read FParams Write SetParams;
+    // Port DB is listening on
+    Property Port : Word Read FPort Write FPort;
+  end;
+
+  { TSQLDBRestConnectionList }
+
+  TSQLDBRestConnectionList = Class(TCollection)
+  private
+    function GetConn(aIndex : integer): TSQLDBRestConnection;
+    procedure SetConn(aIndex : integer; AValue: TSQLDBRestConnection);
+  Public
+    // Index of connection by name (case insensitive)
+    Function IndexOfConnection(const aName : string) : Integer;
+    // Find connection by name (case insensitive), nil if none found
+    Function FindConnection(const aName : string) :  TSQLDBRestConnection;
+    // Add new instance, setting basic properties. Return new instance
+    Function AddConnection(Const AType,aHostName,aDatabaseName,aUserName,aPassword : UTF8String) : TSQLDBRestConnection;
+    // Save connection definitions to JSON file.
+    Procedure SaveToFile(Const aFileName : UTF8String);
+    // Save connection definitions  to JSON stream
+    Procedure SaveToStream(Const aStream : TStream);
+    // Return connection definitions as JSON object.
+    function AsJSON(const aPropName: UTF8String=''): TJSONData; virtual;
+    // Load connection definitions from JSON file.
+    Procedure LoadFromFile(Const aFileName : UTF8String);
+    // Load connection definitions from JSON stream.
+    Procedure LoadFromStream(Const aStream : TStream);
+    // Load connection definitions from JSON Object.
+    Procedure FromJSON(aData: TJSONData;const aPropName: UTF8String=''); virtual;
+    // Indexed access to connection definitions
+    Property Connections [aIndex : integer] : TSQLDBRestConnection Read GetConn Write SetConn;  default;
+  end;
+
+  { TSQLDBRestSchemaRef }
+
+  TSQLDBRestSchemaRef = Class(TCollectionItem)
+  Private
+    FEnabled: Boolean;
+    Fschema: TSQLDBRestSchema;
+    FNotifier : TComponent;
+    procedure SetSchema(AValue: TSQLDBRestSchema);
+  Protected
+    Function GetDisplayName: String; override;
+  Public
+    Constructor Create(ACollection: TCollection); override;
+    Destructor Destroy; override;
+    Procedure Assign(Source: TPersistent); override;
+  Published
+    // Schema reference
+    Property Schema : TSQLDBRestSchema Read FSchema Write SetSchema;
+    // Allow this schema to be used ?
+    Property Enabled: Boolean Read FEnabled Write FEnabled default true;
+  end;
+
+  { TSQLDBRestSchemaList }
+
+  TSQLDBRestSchemaList = Class(TCollection)
+  private
+    function GetSchema(aIndex : Integer): TSQLDBRestSchemaRef;
+    procedure SetSchema(aIndex : Integer; AValue: TSQLDBRestSchemaRef);
+  Public
+    Function AddSchema (aSchema : TSQLDBRestSchema) : TSQLDBRestSchemaRef;
+    Property Schemas[aIndex :Integer] : TSQLDBRestSchemaRef Read GetSchema Write SetSchema;default;
+  end;
+
+
+
+  { TSQLDBRestDispatcher }
+
+  TResourceAuthorizedEvent = Procedure (Sender : TObject; aRequest : TRequest; Const aResource : UTF8String; var AllowResource : Boolean) of object;
+  TGetConnectionNameEvent = Procedure(Sender : TObject; aRequest : TRequest; Const AResource : String; var AConnectionName : UTF8String) of object;
+  TGetConnectionEvent = Procedure(Sender : TObject; aDef : TSQLDBRestConnection; var aConnection : TSQLConnection) of object;
+  TRestExceptionEvent = Procedure(Sender : TObject; aRequest : TRequest; Const AResource : string; E : Exception) of object;
+  TRestOperationEvent = Procedure(Sender : TObject; aConn: TSQLConnection; aResource : TSQLDBRestResource) of object;
+  TRestGetFormatEvent = Procedure(Sender : TObject; aRest : TRequest; var aFormat : String) of object;
+
+  TSQLDBRestDispatcher = Class(TComponent)
+  Private
+    Class Var FIOClass : TRestIOClass;
+    Class Var FDBHandlerClass : TSQLDBRestDBHandlerClass;
+  private
+    FCORSAllowedOrigins: String;
+    FDispatchOptions: TRestDispatcherOptions;
+    FInputFormat: String;
+    FCustomViewResource : TSQLDBRestResource;
+    FMetadataResource : TSQLDBRestResource;
+    FMetadataDetailResource : TSQLDBRestResource;
+    FActive: Boolean;
+    FAfterDelete: TRestOperationEvent;
+    FAfterGet: TRestOperationEvent;
+    FAfterPost: TRestOperationEvent;
+    FAfterPut: TRestOperationEvent;
+    FAuthenticator: TRestAuthenticator;
+    FBaseURL: UTF8String;
+    FBeforeDelete: TRestOperationEvent;
+    FBeforeGet: TRestOperationEvent;
+    FBeforePost: TRestOperationEvent;
+    FBeforePut: TRestOperationEvent;
+    FConnections: TSQLDBRestConnectionList;
+    FDefaultConnection: UTF8String;
+    FEnforceLimit: Integer;
+    FOnAllowResource: TResourceAuthorizedEvent;
+    FOnBasicAuthentication: TBasicAuthenticationEvent;
+    FOnException: TRestExceptionEvent;
+    FOnGetConnection: TGetConnectionEvent;
+    FOnGetConnectionName: TGetConnectionNameEvent;
+    FOnGetInputFormat: TRestGetFormatEvent;
+    FOnGetOutputFormat: TRestGetFormatEvent;
+    FOutputFormat: String;
+    FOutputOptions: TRestOutputoptions;
+    FSchemas: TSQLDBRestSchemaList;
+    FListRoute: THTTPRoute;
+    FItemRoute: THTTPRoute;
+    FStrings: TRestStringsConfig;
+    procedure SetActive(AValue: Boolean);
+    procedure SetAuthenticator(AValue: TRestAuthenticator);
+    procedure SetConnections(AValue: TSQLDBRestConnectionList);
+    procedure SetSchemas(AValue: TSQLDBRestSchemaList);
+    procedure SetStrings(AValue: TRestStringsConfig);
+  Protected
+    // Auxiliary methods.
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    function FindConnection(IO: TRestIO): TSQLDBRestConnection;
+    // Factory methods. Override these to customize various helper classes.
+    function CreateConnection: TSQLConnection; virtual;
+    Function CreateConnectionList : TSQLDBRestConnectionList; virtual;
+    Function CreateSchemaList : TSQLDBRestSchemaList; virtual;
+    function CreateRestStrings: TRestStringsConfig; virtual;
+    function CreateDBHandler(IO: TRestIO): TSQLDBRestDBHandler; virtual;
+    function CreateInputStreamer(IO: TRestIO): TRestInputStreamer; virtual;
+    function CreateOutputStreamer(IO: TRestIO): TRestOutputStreamer; virtual;
+    function CreateIO(aRequest: TRequest; aResponse: TResponse): TRestIO; virtual;
+    function GetInputFormat(IO: TRestIO): String; virtual;
+    function GetOutputFormat(IO: TRestIO): String; virtual;
+    function GetConnectionName(IO: TRestIO): UTF8String;
+    function GetSQLConnection(aConnection: TSQLDBRestConnection; Out aTransaction : TSQLTransaction): TSQLConnection; virtual;
+    procedure DoneSQLConnection(aConnection: TSQLDBRestConnection; AConn: TSQLConnection; aTransaction : TSQLTransaction); virtual;
+    // Error handling
+    procedure CreateErrorContent(IO: TRestIO; aCode: Integer; AExtraMessage: UTF8String); virtual;
+    procedure HandleException(E: Exception; IO: TRestIO); virtual;
+    // REST request processing
+    // Extract REST operation type from request
+    procedure SetDefaultResponsecode(IO: TRestIO); virtual;
+    // Must set result code and WWW-Authenticate header when applicable
+    Function AuthenticateRequest(IO : TRestIO; Delayed : Boolean) : Boolean; virtual;
+    function ExtractRestOperation(aRequest: TRequest;AccessControl : Boolean = false): TRestoperation; virtual;
+    function FindRestResource(aResource: UTF8String): TSQLDBRestResource; virtual;
+    function AllowRestResource(aIO : TRestIO): Boolean; virtual;
+    function ExtractRestResourceName(IO: TRestIO): UTF8String; virtual;
+    // Override if you want to create non-sqldb based resources
+    function CreateSpecialResourceDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
+    function IsSpecialResource(aResource: TSQLDBRestResource): Boolean; virtual;
+    function FindSpecialResource(IO: TRestIO; aResource: UTF8String): TSQLDBRestResource; virtual;
+    // Special resources for Metadata handling
+    function CreateMetadataDataset(IO: TRestIO; AOwner: TComponent): TDataset; virtual;
+    function CreateMetadataDetailDataset(IO: TRestIO; Const aResourceName : String; AOwner: TComponent): TDataset; virtual;
+    function CreateMetadataDetailResource: TSQLDBRestResource;  virtual;
+    function CreateMetadataResource: TSQLDBRestResource; virtual;
+    // Custom view handling
+    function CreateCustomViewResource: TSQLDBRestResource; virtual;
+    function CreateCustomViewDataset(IO: TRestIO; const aSQL: String; AOwner: TComponent): TDataset;
+    procedure ResourceToDataset(R: TSQLDBRestResource; D: TDataset); virtual;
+    procedure SchemasToDataset(D: TDataset);virtual;
+    // General HTTP handling
+    procedure DoRegisterRoutes; virtual;
+    procedure DoHandleEvent(IsBefore : Boolean;IO: TRestIO); virtual;
+    procedure HandleCORSRequest(aConnection: TSQLDBRestConnection; IO: TRestIO); virtual;
+    procedure HandleResourceRequest(aConnection : TSQLDBRestConnection; IO: TRestIO); virtual;
+    procedure DoHandleRequest(IO: TRestIO); virtual;
+  Public
+    Class Procedure SetIOClass (aClass: TRestIOClass);
+    Class Procedure SetDBHandlerClass (aClass: TSQLDBRestDBHandlerClass);
+    Constructor Create(AOWner : TComponent); override;
+    Destructor Destroy; override;
+    procedure RegisterRoutes;
+    procedure UnRegisterRoutes;
+    procedure HandleRequest(aRequest : TRequest; aResponse : TResponse);
+    Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : Array of String; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
+    Function ExposeDatabase(Const aType,aHostName,aDatabaseName,aUserName,aPassword : String; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestConnection;
+    Function ExposeConnection(aOwner : TComponent; Const aConnection : TSQLDBRestConnection; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestSchema;
+    Function ExposeConnection(Const aConnection : TSQLDBRestConnection; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []) : TSQLDBRestSchema;
+  Published
+    // Register or unregister HTTP routes
+    Property Active : Boolean Read FActive Write SetActive;
+    // List of database connections to connect to
+    Property Connections : TSQLDBRestConnectionList Read FConnections Write SetConnections;
+    // List of REST schemas to serve
+    Property Schemas : TSQLDBRestSchemaList Read FSchemas Write SetSchemas;
+    // Base URL
+    property BasePath : UTF8String Read FBaseURL Write FBaseURL;
+    // Default connection to use if none is detected from request/schema
+    Property DefaultConnection : UTF8String Read FDefaultConnection Write FDefaultConnection;
+    // Input/Output strings configuration
+    Property Strings : TRestStringsConfig Read FStrings Write SetStrings;
+    // default Output options, modifiable by query.
+    Property OutputOptions : TRestOutputOptions Read FOutputOptions Write FOutputOptions Default allOutputOptions;
+    // Set this to allow only this input format.
+    Property InputFormat : String Read FInputFormat Write FInputFormat;
+    // Set this to allow only this output format.
+    Property OutputFormat : String Read FOutputFormat Write FOutputFormat;
+    // Dispatcher options
+    Property DispatchOptions : TRestDispatcherOptions Read FDispatchOptions Write FDispatchOptions default DefaultDispatcherOptions;
+    // Authenticator for requests
+    Property Authenticator : TRestAuthenticator Read FAuthenticator Write SetAuthenticator;
+    // If >0, Enforce a limit on output results.
+    Property EnforceLimit : Integer Read FEnforceLimit Write FEnforceLimit;
+    // Domains that are allowed to use this REST service
+    Property CORSAllowedOrigins: String Read FCORSAllowedOrigins  Write FCORSAllowedOrigins;
+    // Called when Basic authentication is sufficient.
+    Property OnBasicAuthentication : TBasicAuthenticationEvent Read FOnBasicAuthentication Write FOnBasicAuthentication;
+    // Allow a particular resource or not.
+    Property OnAllowResource : TResourceAuthorizedEvent Read FOnAllowResource Write FonAllowResource;
+    // Called when determining the connection name for a request.
+    Property OnGetConnectionName : TGetConnectionNameEvent Read FOnGetConnectionName Write FOnGetConnectionName;
+    // Called when an exception happened during treatment of request.
+    Property OnException : TRestExceptionEvent Read FOnException Write FOnException;
+    // Called to get an actual connection.
+    Property OnGetConnection : TGetConnectionEvent Read FOnGetConnection Write FOnGetConnection;
+    // Called to determine input format based on request.
+    Property OnGetInputFormat : TRestGetFormatEvent Read FOnGetInputFormat Write FOnGetInputFormat;
+    // Called to determine output format based on request.
+    Property OnGetOutputFormat : TRestGetFormatEvent Read FOnGetInputFormat Write FOnGetOutputFormat;
+    // Called before a GET request.
+    Property BeforeGet : TRestOperationEvent Read FBeforeGet Write FBeforeGet;
+    // Called After a GET request.
+    Property AfterGet : TRestOperationEvent Read FAfterGet Write FAfterGet;
+    // Called before a PUT request.
+    Property BeforePut : TRestOperationEvent Read FBeforePut Write FBeforePut;
+    // Called After a PUT request.
+    Property AfterPut : TRestOperationEvent Read FAfterPut Write FAfterPut;
+    // Called before a POST request.
+    Property BeforePost : TRestOperationEvent Read FBeforePost Write FBeforePost;
+    // Called After a POST request.
+    Property AfterPost : TRestOperationEvent Read FAfterPost Write FAfterPost;
+    // Called before a DELETE request.
+    Property BeforeDelete : TRestOperationEvent Read FBeforeDelete Write FBeforeDelete;
+    // Called After a DELETE request.
+    Property AfterDelete : TRestOperationEvent Read FAfterDelete Write FAfterDelete;
+  end;
+
+
+
+implementation
+
+uses fpjsonrtti, DateUtils, bufdataset, sqldbrestjson, sqldbrestconst;
+
+Type
+
+  { TRestBufDataset }
+
+  TRestBufDataset = class (TBufDataset)
+  protected
+    procedure LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField); override;
+  end;
+
+
+  { TSchemaFreeNotifier }
+
+  TSchemaFreeNotifier = Class(TComponent)
+    FRef : TSQLDBRestSchemaRef;
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  end;
+
+  { TConnectionFreeNotifier }
+
+  TConnectionFreeNotifier = Class(TComponent)
+    FRef : TSQLDBRestConnection;
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+  end;
+
+{ TRestBufDataset }
+
+procedure TRestBufDataset.LoadBlobIntoBuffer(FieldDef: TFieldDef; ABlobBuf: PBufBlobField);
+begin
+  If (FieldDef=Nil) or (aBlobBuf=Nil) then
+    exit;
+end;
+
+
+
+
+
+{ TConnectionFreeNotifier }
+
+procedure TConnectionFreeNotifier.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation=opRemove) and Assigned(FRef) and (Fref.SingleConnection=aComponent) then
+    Fref.SingleConnection:=Nil;
+end;
+
+{ TSQLDBRestSchemaList }
+
+function TSQLDBRestSchemaList.GetSchema(aIndex : Integer): TSQLDBRestSchemaRef;
+begin
+  Result:=TSQLDBRestSchemaRef(Items[aIndex]);
+end;
+
+procedure TSQLDBRestSchemaList.SetSchema(aIndex : Integer; AValue: TSQLDBRestSchemaRef);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+function TSQLDBRestSchemaList.AddSchema(aSchema: TSQLDBRestSchema): TSQLDBRestSchemaRef;
+begin
+  Result:=(Add as TSQLDBRestSchemaRef);
+  Result.Schema:=aSchema;
+  Result.Enabled:=True;
+end;
+
+{ TSQLDBRestDispatcher }
+
+procedure TSQLDBRestDispatcher.SetConnections(AValue: TSQLDBRestConnectionList);
+begin
+  if FConnections=AValue then Exit;
+  FConnections.Assign(AValue);
+end;
+
+procedure TSQLDBRestDispatcher.SetActive(AValue: Boolean);
+begin
+  if FActive=AValue then Exit;
+  if AValue then
+    DoRegisterRoutes
+  else
+    UnRegisterRoutes;
+  FActive:=AValue;
+
+end;
+
+procedure TSQLDBRestDispatcher.SetAuthenticator(AValue: TRestAuthenticator);
+begin
+  if FAuthenticator=AValue then Exit;
+  if Assigned(FAuthenticator) then
+    FAuthenticator.RemoveFreeNotification(Self);
+  FAuthenticator:=AValue;
+  if Assigned(FAuthenticator) then
+    FAuthenticator.FreeNotification(Self);
+end;
+
+procedure TSQLDBRestDispatcher.SetSchemas(AValue: TSQLDBRestSchemaList);
+begin
+  if FSchemas=AValue then Exit;
+  FSchemas.Assign(AValue);
+end;
+
+procedure TSQLDBRestDispatcher.SetStrings(AValue: TRestStringsConfig);
+begin
+  if FStrings=AValue then Exit;
+  FStrings.Assign(AValue);
+end;
+
+procedure TSQLDBRestDispatcher.DoRegisterRoutes;
+
+Var
+  Res : String;
+
+begin
+  Res:=IncludeHTTPPathDelimiter(BasePath);
+  if rdoConnectionInURL in DispatchOptions then
+    Res:=Res+':connection/';
+  Res:=Res+':resource';
+  FListRoute:=HTTPRouter.RegisterRoute(res,@HandleRequest);
+  FItemRoute:=HTTPRouter.RegisterRoute(Res+'/:id',@HandleRequest);
+end;
+
+function TSQLDBRestDispatcher.GetInputFormat(IO : TRestIO) : String;
+
+// Order is: InputFormat setting, Content-type, input format, output format if it exists as input
+
+Var
+  U : UTF8String;
+  D : TStreamerDef;
+
+begin
+  Result:=InputFormat;
+  if (Result='') then
+    begin
+    if Result='' then
+      if IO.GetVariable(Fstrings.GetRestString(rpInputFormat),U,[vsQuery])<>vsNone then
+        Result:=U;
+    if (Result='') and (IO.Request.ContentType<>'') then
+      begin
+      D:=TStreamerFactory.Instance.FindStreamerByContentType(rstInput,IO.Request.ContentType);
+      if D<>Nil then
+        Result:=D.MyName;
+      end;
+    if (Result='') then
+      if IO.GetVariable(Fstrings.GetRestString(rpOutputFormat),U,[vsQuery])<>vsNone then
+        begin
+        if TStreamerFactory.Instance.FindStreamerByName(rstInput,U)<>Nil then
+          Result:=U;
+        end;
+    end;
+  If Assigned(FOnGetInputFormat) then
+    FOnGetInputFormat(Self,IO.Request,Result)
+end;
+
+function TSQLDBRestDispatcher.GetOutputFormat(IO : TRestIO) : String;
+
+// Order is: OutputFormat setting, output format, input Content-type, input format if it exists as output
+
+Var
+  U : UTF8String;
+  D : TStreamerDef;
+
+begin
+  Result:=OutputFormat;
+  if (Result='') then
+    begin
+    if IO.GetVariable(Fstrings.GetRestString(rpOutputFormat),U,[vsQuery])<>vsNone then
+      Result:=U;
+    if (Result='') and (IO.Request.ContentType<>'') then
+      begin
+      D:=TStreamerFactory.Instance.FindStreamerByContentType(rstOutput,IO.Request.ContentType);
+      if D<>Nil then
+        Result:=D.MyName;
+      end;
+    if Result='' then
+      if IO.GetVariable(Fstrings.GetRestString(rpInputFormat),U,[vsQuery])<>vsNone then
+        begin
+        if TStreamerFactory.Instance.FindStreamerByName(rstOutput,U)<>Nil then
+          Result:=U;
+        end;
+    end;
+  If Assigned(FOnGetOutputFormat) then
+    FOnGetOutputFormat(Self,IO.Request,Result)
+end;
+
+function TSQLDBRestDispatcher.CreateInputStreamer(IO : TRestIO): TRestInputStreamer;
+
+Var
+  D : TStreamerDef;
+  aName : String;
+
+begin
+  aName:=GetInputFormat(IO);
+  if aName='' then
+    aName:='json';
+  D:=TStreamerFactory.Instance.FindStreamerByName(rstInput,aName);
+  if (D=Nil) then
+    Raise ESQLDBRest.CreateFmt(400,SErrUnknownOrUnSupportedFormat,[aName]);
+  Result:=TRestInputStreamer(D.MyClass.Create(IO.RequestContentStream,Fstrings,@IO.DoGetVariable));
+end;
+
+function TSQLDBRestDispatcher.CreateOutputStreamer(IO : TRestIO): TRestOutputStreamer;
+
+Var
+  D : TStreamerDef;
+  aName : String;
+
+begin
+  aName:=GetOutputFormat(IO);
+  if aName='' then
+    aName:='json';
+  D:=TStreamerFactory.Instance.FindStreamerByName(rstOutput,aName);
+  if (D=Nil) then
+    Raise ESQLDBRest.CreateFmt(400,SErrUnknownOrUnSupportedFormat,[aName]);
+  Result:=TRestOutputStreamer(D.MyClass.Create(IO.Response.ContentStream,Fstrings,@IO.DoGetVariable));
+end;
+
+
+function TSQLDBRestDispatcher.CreateIO(aRequest: TRequest; aResponse: TResponse): TRestIO;
+
+Var
+  aInput : TRestInputStreamer;
+  aOutput : TRestOutputStreamer;
+
+begin
+  aInput:=Nil;
+  aOutput:=Nil;
+  Result:=FIOClass.Create(aRequest,aResponse);
+  try
+    // Set up output
+    Result.Response.ContentStream:=TMemoryStream.Create;
+    Result.Response.FreeContentStream:=True;
+    Result.SetRestStrings(FStrings);
+    aInput:=CreateInputStreamer(Result);
+    aoutPut:=CreateOutPutStreamer(Result);
+    Result.SetIO(aInput,aOutput);
+    aInput:=Nil;
+    aOutput:=Nil;
+    aResponse.ContentType:=Result.RestOutput.GetContentType;
+    Result.RestOutput.OutputOptions:=Result.GetRequestOutputOptions(OutputOptions);
+  except
+    On E : Exception do
+      begin
+      FreeAndNil(aInput);
+      FreeAndNil(aOutput);
+      FreeAndNil(Result);
+      Raise;
+      end;
+  end;
+end;
+
+procedure TSQLDBRestDispatcher.CreateErrorContent(IO : TRestIO; aCode : Integer; AExtraMessage: UTF8String);
+
+begin
+  IO.Response.Code:=aCode;
+  IO.Response.CodeText:=aExtraMessage;
+  IO.RestOutput.CreateErrorContent(aCode,aExtraMessage);
+  IO.Response.SendResponse;
+end;
+
+class procedure TSQLDBRestDispatcher.SetIOClass(aClass: TRestIOClass);
+
+begin
+  FIOClass:=aClass;
+  if FIOClass=Nil then
+    FIOClass:=TRestIO;
+end;
+
+class procedure TSQLDBRestDispatcher.SetDBHandlerClass(aClass: TSQLDBRestDBHandlerClass);
+
+begin
+  FDBHandlerClass:=aClass;
+  if FDBHandlerClass=Nil then
+    FDBHandlerClass:=TSQLDBRestDBHandler;
+end;
+
+constructor TSQLDBRestDispatcher.Create(AOWner: TComponent);
+begin
+  inherited Create(AOWner);
+  FStrings:=CreateRestStrings;
+  FConnections:=CreateConnectionList;
+  FSchemas:=CreateSchemaList;
+  FOutputOptions:=allOutputOptions;
+  FDispatchOptions:=DefaultDispatcherOptions;
+end;
+
+destructor TSQLDBRestDispatcher.Destroy;
+begin
+  Authenticator:=Nil;
+  FreeAndNil(FCustomViewResource);
+  FreeAndNil(FMetadataResource);
+  FreeAndNil(FMetadataDetailResource);
+  FreeAndNil(FSchemas);
+  FreeAndNil(FConnections);
+  FreeAndNil(FStrings);
+  inherited Destroy;
+end;
+
+function TSQLDBRestDispatcher.CreateRestStrings : TRestStringsConfig;
+
+begin
+  Result:=TRestStringsConfig.Create
+end;
+
+function TSQLDBRestDispatcher.ExtractRestResourceName(IO: TRestIO): UTF8String;
+
+begin
+  Result:=IO.Request.RouteParams['resource'];
+  if (Result='') then
+    Result:=IO.Request.QueryFields.Values[Strings.ResourceParam];
+end;
+
+function TSQLDBRestDispatcher.AllowRestResource( aIO: TRestIO): Boolean;
+
+begin
+  Result:=True;
+  if Assigned(FOnAllowResource) then
+    FOnAllowResource(Self,aIO.Request,aIO.ResourceName,Result);
+end;
+
+
+function TSQLDBRestDispatcher.CreateCustomViewResource: TSQLDBRestResource;
+
+begin
+  Result:=TCustomViewResource.Create(Nil);
+  Result.ResourceName:=FStrings.GetRestString(rpCustomViewResourceName);
+  Result.AllowedOperations:=[roGet];
+end;
+
+function TSQLDBRestDispatcher.CreateMetadataResource: TSQLDBRestResource;
+
+Var
+  O : TRestOperation;
+  S : String;
+
+begin
+  Result:=TSQLDBRestResource.Create(Nil);
+  Result.ResourceName:='metaData';
+  Result.AllowedOperations:=[roGet];
+  Result.Fields.AddField('name',rftString,[foRequired]);
+  Result.Fields.AddField('schemaName',rftString,[foRequired]);
+  for O in TRestOperation do
+    if O<>roUnknown then
+      begin
+      Str(O,S);
+      delete(S,1,2);
+      Result.Fields.AddField(S,rftBoolean,[foRequired]);
+      end;
+end;
+
+function TSQLDBRestDispatcher.CreateMetadataDetailResource: TSQLDBRestResource;
+
+Var
+  O : TRestFieldOption;
+  S : String;
+
+begin
+  Result:=TSQLDBRestResource.Create(Nil);
+  Result.ResourceName:='metaDataField';
+  Result.AllowedOperations:=[roGet];
+  Result.Fields.AddField('name',rftString,[]);
+  Result.Fields.AddField('type',rftString,[]);
+  Result.Fields.AddField('maxlen',rftInteger,[]);
+  Result.Fields.AddField('format',rftString,[]);
+  for O in TRestFieldOption do
+    begin
+    Str(O,S);
+    delete(S,1,2);
+    Result.Fields.AddField(S,rftBoolean,[]);
+    end;
+end;
+
+function TSQLDBRestDispatcher.FindSpecialResource(IO : TRestIO; aResource: UTF8String): TSQLDBRestResource;
+
+  Function IsCustomView : Boolean;inline;
+
+  begin
+    Result:=(rdoCustomView in DispatchOptions)
+            and SameText(aResource,Strings.GetRestString(rpCustomViewResourceName));
+  end;
+  Function IsMetadata : Boolean;inline;
+
+  begin
+    Result:=(rdoExposeMetadata in DispatchOptions)
+            and SameText(aResource,Strings.GetRestString(rpMetaDataResourceName));
+  end;
+
+Var
+  N : UTF8String;
+
+begin
+  Result:=Nil;
+  If isCustomView then
+    begin
+    if FCustomViewResource=Nil then
+      FCustomViewResource:=CreateCustomViewResource;
+    Result:=FCustomViewResource;
+    end
+  else If isMetadata then
+    if (IO.GetVariable('ID',N,[vsRoute,vsQuery])=vsNone) then
+      begin
+      if FMetadataResource=Nil then
+        FMetadataResource:=CreateMetadataResource;
+      Result:=FMetadataResource;
+      end
+    else
+      begin
+      if FindRestResource(N)<>Nil then
+        begin
+        if FMetadataDetailResource=Nil then
+          FMetadataDetailResource:=CreateMetadataDetailResource;
+        Result:=FMetadataDetailResource;
+        end;
+      end
+
+end;
+
+function TSQLDBRestDispatcher.FindRestResource(aResource: UTF8String): TSQLDBRestResource;
+
+Var
+  I : integer;
+
+begin
+  Result:=Nil;
+  I:=0;
+  While (Result=Nil) and (I<Schemas.Count) do
+    begin
+    if Schemas[i].Enabled then
+      Result:=Schemas[i].Schema.Resources.FindResourceByName(aResource);
+    Inc(I);
+    end;
+end;
+
+function TSQLDBRestDispatcher.ExtractRestOperation(aRequest: TRequest;AccessControl : Boolean = false): TRestoperation;
+
+Var
+  M : String;
+
+begin
+  Result:=roUnknown;
+  if not AccessControl then
+    M:=aRequest.Method
+  else
+    M:=aRequest.CustomHeaders.Values['Access-Control-Request-Method'];
+  Case lowercase(M) of
+    'get' : Result:=roGet;
+    'put' : Result:=roPut;
+    'post' : Result:=roPost;
+    'delete' : Result:=roDelete;
+    'options' : Result:=roOptions;
+    'head' : Result:=roHead;
+  end;
+end;
+
+Type
+
+  { TRestSQLConnector }
+
+  { THackSQLConnector }
+
+  THackSQLConnector = Class(TSQLConnection)
+  Public
+    function DoGetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+  end;
+  TRestSQLConnector = Class(TSQLConnector)
+  Private
+    FUse : Integer;
+    FRequestCount : INteger;
+  Protected
+    function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; override;
+    Procedure StartUsing;
+    Function DoneUsing : Boolean;
+  end;
+
+{ THackSQLConnector }
+
+function THackSQLConnector.DoGetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result:=GetNextValueSQL(SequenceName,IncrementBy);
+end;
+
+{ TRestSQLConnector }
+
+function TRestSQLConnector.GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string;
+begin
+  Result:=THackSQLConnector(Proxy).DoGetNextValueSQL(SequenceName, IncrementBy);
+end;
+
+procedure TRestSQLConnector.StartUsing;
+begin
+  InterLockedIncrement(FUse);
+  Inc(FRequestCount);
+end;
+
+function TRestSQLConnector.DoneUsing: Boolean;
+begin
+  InterLockedDecrement(Fuse);
+  Result:=(FRequestCount>100) and (FUse=0);
+end;
+
+function TSQLDBRestDispatcher.CreateConnection : TSQLConnection;
+
+begin
+  Result:=TRestSQLConnector.Create(Self);
+end;
+
+function TSQLDBRestDispatcher.GetSQLConnection(
+  aConnection: TSQLDBRestConnection; out aTransaction: TSQLTransaction
+  ): TSQLConnection;
+
+begin
+  Result:=aConnection.SingleConnection;
+  if (Result=Nil) then
+    begin
+    if Assigned(OnGetConnection) then
+      OnGetConnection(Self,aConnection,Result);
+    if (Result=Nil) then
+      begin
+      Result:=CreateConnection;
+      Result.CharSet:=aConnection.CharSet;
+      Result.HostName:=aConnection.HostName;
+      Result.DatabaseName:=aConnection.DatabaseName;
+      Result.UserName:=aConnection.UserName;
+      Result.Password:=aConnection.Password;
+      Result.Params:=Aconnection.Params;
+      if Result is TRestSQLConnector then
+        TRestSQLConnector(Result).ConnectorType:=aConnection.ConnectionType;
+      aConnection.SingleConnection:=Result;
+      end;
+    end;
+  If (Result is TRestSQLConnector) then
+    TRestSQLConnector(Result).StartUsing;
+  aTransaction:=TSQLTransaction.Create(Self);
+  aTransaction.Database:=Result;
+end;
+
+procedure TSQLDBRestDispatcher.DoHandleEvent(IsBefore: Boolean; IO: TRestIO);
+
+Var
+  R : TRestOperationEvent;
+
+begin
+  R:=Nil;
+  if isBefore then
+    Case IO.Operation of
+      roGet : R:=FBeforeGet;
+      roPut : R:=FBeforePut;
+      roPost : R:=FBeforePost;
+      roDelete : R:=FBeforeDelete;
+    end
+  else
+    Case IO.Operation of
+      roGet : R:=FAfterGet;
+      roPut : R:=FAfterPut;
+      roPost : R:=FAfterPost;
+      roDelete : R:=FAfterDelete;
+    end;
+  If Assigned(R) then
+    R(Self,IO.Connection,IO.Resource)
+end;
+
+
+
+procedure TSQLDBRestDispatcher.DoneSQLConnection(
+  aConnection: TSQLDBRestConnection; AConn: TSQLConnection;
+  aTransaction: TSQLTransaction);
+
+Var
+  NeedNil : Boolean;
+
+begin
+  FreeAndNil(aTransaction);
+  if (aConn is TRestSQLConnector) then
+    begin
+    NeedNil:= (aConnection.SingleConnection=aConn) ;
+    if TRestSQLConnector(aConn).DoneUsing then
+      FreeAndNil(aConn);
+    If NeedNil then
+      aConnection.SingleConnection:=Nil;
+    end;
+end;
+
+
+function TSQLDBRestDispatcher.CreateDBHandler(IO: TRestIO): TSQLDBRestDBHandler;
+
+begin
+  Result:=FDBHandlerClass.Create(Self) ;
+  Result.Init(IO,FStrings,TSQLQuery);
+  Result.EnforceLimit:=Self.EnforceLimit;
+end;
+
+
+procedure TSQLDBRestDispatcher.SetDefaultResponsecode(IO : TRestIO);
+
+Const
+  DefaultCodes : Array[TRestOperation] of Integer = (500,200,201,200,204,200,200);
+  DefaultTexts : Array[TRestOperation] of string = ('Internal Error','OK','Created','OK','No content','OK','OK');
+
+Var
+  aCode : Integer;
+  aText : String;
+
+begin
+  aCode:=DefaultCodes[IO.Operation];
+  aText:=DefaultTexts[IO.Operation];
+  if IO.Response.Code=0 then
+    IO.Response.Code:=aCode;
+  if (IO.Response.CodeText='') then
+    IO.Response.CodeText:=aText;
+end;
+
+function TSQLDBRestDispatcher.IsSpecialResource(aResource: TSQLDBRestResource
+  ): Boolean;
+
+begin
+  Result:=(aResource<>Nil);
+  if not Result then exit;
+  Result:=(aResource=FMetadataResource) or
+          (aResource=FMetadataDetailResource) or
+          (aResource=FCustomViewResource);
+end;
+
+
+procedure TSQLDBRestDispatcher.SchemasToDataset(D: TDataset);
+
+Var
+  S : TSQLDBRestSchema;
+  R : TSQLDBRestResource;
+  O : TRestOperation;
+  I,J : Integer;
+  SO : String;
+  FName,FSchema : TField;
+  FOperations : Array[TRestOperation] of TField;
+
+begin
+  FName:=D.FieldByName('name');
+  FSchema:=D.FieldByName('schemaName');
+  for O in TRestOperation do
+    if O<>roUnknown then
+      begin
+      Str(O,SO);
+      delete(SO,1,2);
+      FOperations[O]:=D.FieldByName(SO);
+      end;
+  For I:=0 to Schemas.Count-1 do
+    if Schemas[I].Enabled then
+      begin
+      S:=Schemas[I].Schema;
+      For J:=0 to S.Resources.Count-1 do
+        begin
+        R:=S.Resources[J];
+        if R.Enabled and R.InMetadata then
+          begin
+          D.Append;
+          FName.AsString:=R.ResourceName;
+          FSchema.AsString:=S.Name;
+          for O in TRestOperation do
+            if O<>roUnknown then
+              FOperations[O].AsBoolean:=O in R.AllowedOperations;
+          end;
+        D.Post;
+        end;
+      end;
+end;
+
+function TSQLDBRestDispatcher.CreateMetadataDataset(IO: TRestIO;
+  AOwner: TComponent): TDataset;
+
+Var
+  BD :  TRestBufDataset;
+  O : TRestOperation;
+  SO : String;
+
+begin
+  if IO=Nil then exit;
+  BD:=TRestBufDataset.Create(aOwner);
+  try
+    Result:=BD;
+    Result.FieldDefs.Add('name',ftString,255,False);
+    Result.FieldDefs.Add('schemaName',ftString,255,False);
+    for O in TRestOperation do
+      if O<>roUnknown then
+        begin
+        Str(O,SO);
+        delete(SO,1,2);
+        Result.FieldDefs.Add(SO,ftBoolean,0,False);
+        end;
+    BD.CreateDataset;
+    SchemasToDataset(BD);
+    BD.First;
+  except
+    BD.Free;
+    Raise;
+  end;
+end;
+
+procedure TSQLDBRestDispatcher.ResourceToDataset(R: TSQLDBRestResource;
+  D: TDataset);
+
+Var
+  F : TSQLDBRestField;
+  O : TRestFieldOption;
+  I : Integer;
+  SO : String;
+  FName,FType,fMaxLen,fFormat : TField;
+  FOptions : Array[TRestFieldOption] of TField;
+
+begin
+  FName:=D.FieldByName('name');
+  FType:=D.FieldByName('type');
+  FMaxLen:=D.FieldByName('maxlen');
+  FFormat:=D.FieldByName('format');
+  for O in TRestFieldOption do
+    begin
+    Str(O,SO);
+    delete(SO,1,2);
+    FOptions[O]:=D.FieldByName(SO);
+    end;
+  For I:=0 to R.Fields.Count-1 do
+    begin
+    F:=R.Fields[i];
+    D.Append;
+    FName.AsString:=F.PublicName;
+    Ftype.AsString:=TypeNames[F.FieldType];
+    FMaxLen.AsInteger:=F.MaxLen;
+    Case F.FieldType of
+      rftDate : FFormat.AsString:=FStrings.GetRestString(rpDateFormat);
+      rftDateTime : FFormat.AsString:=FStrings.GetRestString(rpDatetimeFormat);
+      rftTime : FFormat.AsString:=FStrings.GetRestString(rpTimeFormat);
+    end;
+    for O in TRestFieldOption do
+      FOptions[O].AsBoolean:=O in F.Options;
+    D.Post;
+    end;
+end;
+
+function TSQLDBRestDispatcher.CreateMetadataDetailDataset(IO: TRestIO;
+  const aResourceName: String; AOwner: TComponent): TDataset;
+
+Var
+  BD :  TRestBufDataset;
+  O : TRestFieldOption;
+  SO : String;
+  R : TSQLDBRestResource;
+
+begin
+  if IO=Nil then exit;
+  BD:=TRestBufDataset.Create(aOwner);
+  try
+    Result:=BD;
+    Result.FieldDefs.Add('name',ftString,255,False);
+    Result.FieldDefs.Add('type',ftString,255,False);
+    Result.FieldDefs.Add('maxlen',ftInteger,0,false);
+    Result.FieldDefs.Add('format',ftString,50,false);
+    for O in TRestFieldOption do
+      begin
+      Str(O,SO);
+      delete(SO,1,2);
+      Result.FieldDefs.Add(SO,ftBoolean,0,False);
+      end;
+    BD.CreateDataset;
+    R:=FindRestResource(aResourceName);
+    ResourceToDataset(R,BD);
+    BD.First;
+  except
+    BD.Free;
+    Raise;
+  end;
+end;
+
+function TSQLDBRestDispatcher.CreateCustomViewDataset(IO: TRestIO;
+  const aSQL: String; AOwner: TComponent): TDataset;
+
+Var
+  Q : TRestSQLQuery;
+  ST : TStatementType;
+
+begin
+  ST:=IO.Connection.GetStatementInfo(aSQL).StatementType;
+  if (st<>stSelect) then
+    Raise ESQLDBRest.Create(400,'Only SELECT SQL is allowed for custom view'); // Should never happen.
+  Q:=TRestSQLQuery.Create(aOwner);
+  try
+    Q.DataBase:=IO.Connection;
+    Q.Transaction:=IO.Transaction;
+    Q.ParseSQL:=True;
+    Q.SQL.Text:=aSQL;
+    Result:=Q;
+  except
+    Q.Free;
+    Raise;
+  end;
+end;
+
+
+function TSQLDBRestDispatcher.CreateSpecialResourceDataset(IO: TRestIO;
+  AOwner: TComponent): TDataset;
+
+Var
+  RN : UTF8String;
+
+begin
+  Result:=Nil;
+  if (IO.Resource=FMetadataResource) then
+    Result:=CreateMetadataDataset(IO,AOwner)
+  else if (IO.Resource=FMetadataDetailResource) then
+    begin
+    if IO.GetVariable('ID',RN,[vsRoute,vsQuery])=vsNone then
+      Raise ESQLDBRest.Create(500,'Could not find resource name'); // Should never happen.
+    Result:=CreateMetadataDetailDataset(IO,RN,AOwner)
+    end
+  else   if (IO.Resource=FCustomViewResource) then
+    begin
+    if IO.GetVariable(FStrings.GetRestString(rpCustomViewSQLParam),RN,[vsRoute,vsQuery])=vsNone then
+      Raise ESQLDBRest.Create(400,'Could not find SQL statement for custom view'); // Should never happen.
+    Result:=CreateCustomViewDataset(IO,RN,aOwner);
+    end
+
+end;
+
+procedure TSQLDBRestDispatcher.HandleCORSRequest(aConnection : TSQLDBRestConnection; IO : TRestIO);
+
+Var
+  S : String;
+  Allowed : Boolean;
+
+
+begin
+  Allowed:=(rdoHandleCORS in DispatchOptions) and (roOptions in IO.Resource.AllowedOperations);
+  if Allowed then
+    Allowed:=(ExtractRestOperation(IO.Request,True) in ([roUnknown]+IO.Resource.AllowedOperations));
+  if not Allowed then
+    begin
+    IO.Response.Code:=403;
+    IO.Response.CodeText:='FORBIDDEN';
+    IO.CreateErrorResponse;
+    end
+  else
+    begin
+    S:=FCORSAllowedOrigins;
+    if S='' then
+      S:='*';
+    IO.Response.SetCustomHeader('Access-Control-Allow-Origin',S);
+    S:=IO.Resource.GetHTTPAllow;
+    IO.Response.SetCustomHeader('Access-Control-Allow-Methods',S);
+    IO.Response.Code:=200;
+    IO.Response.CodeText:='OK';
+    end;
+end;
+
+procedure TSQLDBRestDispatcher.HandleResourceRequest(aConnection : TSQLDBRestConnection; IO : TRestIO);
+
+Var
+  Conn : TSQLConnection;
+  TR : TSQLTransaction;
+  H : TSQLDBRestDBHandler;
+  l,o : Int64;
+
+begin
+  H:=Nil;
+  Conn:=GetSQLConnection(aConnection,Tr);
+  try
+    IO.SetConn(Conn,TR);
+    Try
+      if not AuthenticateRequest(IO,True) then
+        exit;
+      DoHandleEvent(True,IO);
+      H:=CreateDBHandler(IO);
+      if IsSpecialResource(IO.Resource) then
+        begin
+        H.ExternalDataset:=CreateSpecialResourceDataset(IO,H);
+        if (IO.Resource=FCustomViewResource) then
+          H.DeriveResourceFromDataset:=True;
+        H.EmulateOffsetLimit:=IO.GetLimitOffset(EnforceLimit,l,o);
+        end;
+      H.ExecuteOperation;
+      DoHandleEvent(False,IO);
+      tr.Commit;
+      SetDefaultResponseCode(IO);
+    except
+      TR.RollBack;
+      Raise;
+    end;
+  finally
+    IO.SetConn(Nil,Nil);
+    DoneSQLConnection(aConnection,Conn,Tr);
+  end;
+end;
+
+function TSQLDBRestDispatcher.GetConnectionName(IO: TRestIO): UTF8String;
+
+Var
+  N : UTF8String;
+  R : TSQLDBRestResource;
+begin
+  R:=IO.Resource;
+  N:='';
+  if (N='') then
+    N:=R.ConnectionName;
+  if (N='') and assigned(R.GetSchema) then
+    N:=R.GetSchema.ConnectionName;
+  if (N='') then
+    IO.GetVariable(Strings.ConnectionParam,N,[vsQuery]);
+  if (N='') and (rdoConnectionInURL in DispatchOptions) then
+    IO.GetVariable(Strings.ConnectionParam,N,[vsQuery]);
+  If Assigned(FOnGetConnectionName) then
+    FOnGetConnectionName(Self,IO.Request,R.ResourceName,N);
+  if (N='') then
+    N:=DefaultConnection;
+  Result:=N;
+end;
+
+function TSQLDBRestDispatcher.FindConnection(IO: TRestIO): TSQLDBRestConnection;
+
+Var
+  N : UTF8String;
+
+begin
+  N:=GetConnectionName(IO);
+  // If we have a name, look for it
+  if (N<>'') then
+    begin
+    Result:=Connections.FindConnection(N);
+    if Assigned(Result) and not (Result.Enabled) then
+      Result:=Nil;
+    end
+  else if Connections.Count=1 then
+    Result:=Connections[0]
+  else
+    Result:=Nil;
+end;
+
+function TSQLDBRestDispatcher.CreateConnectionList: TSQLDBRestConnectionList;
+begin
+  Result:=TSQLDBRestConnectionList.Create(TSQLDBRestConnection);
+
+end;
+
+function TSQLDBRestDispatcher.CreateSchemaList: TSQLDBRestSchemaList;
+begin
+  Result:=TSQLDBRestSchemaList.Create(TSQLDBRestSchemaRef);
+end;
+
+procedure TSQLDBRestDispatcher.DoHandleRequest(IO : TRestIO);
+
+var
+  ResourceName : UTF8String;
+  Operation : TRestOperation;
+  Resource : TSQLDBRestResource;
+  Connection : TSQLDBRestConnection;
+
+begin
+  Operation:=ExtractRestOperation(IO.Request);
+  if (Operation=roUnknown) then
+    CreateErrorContent(IO,400,'Invalid method')
+  else
+    begin
+    IO.SetOperation(Operation);
+    ResourceName:=ExtractRestResourceName(IO);
+    if (ResourceName='') then
+      CreateErrorContent(IO,404,'Invalid resource')
+    else
+      begin
+      Resource:=FindSpecialResource(IO,ResourceName);
+      If Resource=Nil then
+        Resource:=FindRestResource(ResourceName);
+      if Resource=Nil then
+        CreateErrorContent(IO,404,'Invalid resource')
+      else if Not (Operation in Resource.AllowedOperations) then
+        CreateErrorContent(IO,405,'Method not allowed')
+      else
+        begin
+        IO.SetResource(Resource);
+        Connection:=FindConnection(IO);
+        if Connection=Nil then
+          begin
+          if (rdoConnectionInURL in DispatchOptions) then
+            CreateErrorContent(IO,400,Format(SErrNoconnection,[GetConnectionName(IO)]))
+          else
+            CreateErrorContent(IO,500,Format(SErrNoconnection,[GetConnectionName(IO)]));
+          end
+        else if not AllowRestResource(IO) then
+          CreateErrorContent(IO,403,'Forbidden')
+        else
+          if Operation=roOptions then
+            HandleCORSRequest(Connection,IO)
+          else
+            HandleResourceRequest(Connection,IO);
+        end;
+      end;
+    end;
+end;
+
+procedure TSQLDBRestDispatcher.UnRegisterRoutes;
+
+  Procedure Un(Var a : THTTPRoute);
+
+  begin
+    if A=Nil then
+      exit;
+    HTTPRouter.DeleteRoute(A);
+    A:=Nil;
+  end;
+
+begin
+  Un(FListRoute);
+  Un(FItemRoute);
+end;
+
+procedure TSQLDBRestDispatcher.RegisterRoutes;
+begin
+  if (FListRoute<>Nil) then
+    UnRegisterRoutes;
+  DoRegisterRoutes;
+end;
+
+procedure TSQLDBRestDispatcher.HandleException(E : Exception; IO : TRestIO);
+
+  Function StripCR(S : String) : String;
+  begin
+    Result:=StringReplace(S,#13#10,' ',[rfReplaceAll]);
+    Result:=StringReplace(Result,#13,' ',[rfReplaceAll]);
+    Result:=StringReplace(Result,#10,' ',[rfReplaceAll]);
+  end;
+
+Var
+  Code : Integer;
+  Msg : String;
+
+begin
+  try
+    if Assigned(FOnException) then
+      FOnException(Self,IO.Request,IO.ResourceName,E);
+    if not IO.Response.ContentSent then
+      begin
+      Code:=0;
+      If E is ESQLDBRest then
+        begin
+        Code:=ESQLDBRest(E).ResponseCode;
+        Msg:=E.Message;
+        end;
+      if (Code=0) then
+        begin
+        Code:=500;
+        Msg:=Format(SErrUnexpectedException,[E.ClassName,E.Message]);
+        end;
+      IO.Response.Code:=Code;
+      IO.Response.CodeText:=StripCR(Msg);
+      if (IO.Response.Code=405) and Assigned(IO.Resource) then
+        IO.Response.Allow:=IO.Resource.GetHTTPAllow; // ([rmHead,rmOptions]) ?
+      IO.RESTOutput.CreateErrorContent(Code,Msg);
+      end;
+  except
+    on Ex : exception do
+     begin
+     IO.Response.Code:=500;
+     IO.Response.CodeText:=Format('Unexpected exception %s while handling original exception %s : "%s" (Original: "%s")',[Ex.ClassName,E.ClassName,Ex.Message,E.Message]);
+     end;
+  end;
+end;
+
+function TSQLDBRestDispatcher.AuthenticateRequest(IO: TRestIO; Delayed : Boolean): Boolean;
+
+Var
+  B : TRestBasicAuthenticator;
+  A : TRestAuthenticator;
+
+begin
+  A:=Nil;
+  B:=Nil;
+  If Assigned(FAuthenticator) then
+    A:=FAuthenticator
+  else If Assigned(FOnBAsicAuthentication) then
+    begin
+    B:=TRestBasicAuthenticator.Create(Self);
+    A:=B;
+    B.OnBasicAuthentication:=Self.OnBasicAuthentication;
+    end;
+  try
+    Result:=A=Nil;
+    if Not Result Then
+      begin
+      Result:=(A.NeedConnection<>Delayed);
+      If Not Result then
+        Result:=A.AuthenticateRequest(IO)
+      end;
+  finally
+    if Assigned(B) then
+      B.Free;
+  end;
+end;
+
+procedure TSQLDBRestDispatcher.Notification(AComponent: TComponent;
+  Operation: TOperation);
+
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation=opRemove then
+    begin
+    if AComponent=FAuthenticator then
+      FAuthenticator:=Nil
+    end;
+end;
+
+procedure TSQLDBRestDispatcher.HandleRequest(aRequest: TRequest; aResponse: TResponse);
+
+Var IO : TRestIO;
+
+begin
+  aResponse.Code:=0; // Sentinel
+  IO:=CreateIO(aRequest,aResponse);
+  try
+    try
+      // Call initstreaming only here, so IO has set var callback.
+      // First output, then input
+      IO.RestOutput.InitStreaming;
+      IO.RestInput.InitStreaming;
+      if AuthenticateRequest(IO,False) then
+        DoHandleRequest(IO)
+    except
+      On E : Exception do
+        HandleException(E,IO);
+    end;
+  Finally
+    if Not (IO.Operation in [roOptions,roHEAD]) then
+      IO.RestOutput.FinalizeOutput;
+    aResponse.ContentStream.Position:=0;
+    aResponse.ContentLength:=aResponse.ContentStream.Size;
+    if not aResponse.ContentSent then
+      aResponse.SendContent;
+    IO.Free;
+  end;
+end;
+
+function TSQLDBRestDispatcher.ExposeDatabase(const aType, aHostName, aDatabaseName, aUserName, aPassword: String;
+  aTables: array of String; aMinFieldOpts: TRestFieldOptions): TSQLDBRestConnection;
+
+Var
+  L : TStringList;
+  S : String;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.Capacity:=Length(aTables);
+    For S in aTables do
+      L.Add(S);
+    L.Sorted:=True;
+    Result:=ExposeDatabase(aType, aHostName, aDatabaseName, aUserName, aPassword,L, aMinFieldOpts);
+  finally
+    l.Free;
+  end;
+end;
+
+function TSQLDBRestDispatcher.ExposeDatabase(const aType, aHostName, aDatabaseName, aUserName, aPassword: String; aTables : TStrings = nil; aMinFieldOpts : TRestFieldOptions = []): TSQLDBRestConnection;
+
+
+begin
+  Result:=Connections.AddConnection(aType,aHostName,aDatabaseName,aUserName,aPassword);
+  ExposeConnection(Result,aTables,aMinFieldOpts);
+end;
+
+function TSQLDBRestDispatcher.ExposeConnection(aOwner: TComponent;
+  const aConnection: TSQLDBRestConnection; aTables: TStrings;
+  aMinFieldOpts: TRestFieldOptions): TSQLDBRestSchema;
+
+Var
+  Conn : TSQLConnection;
+  TR : TSQLTransaction;
+  S : TSQLDBRestSchema;
+
+begin
+  Conn:=GetSQLConnection(aConnection,TR);
+  S:=TSQLDBRestSchema.Create(aOwner);
+  S.Name:='Schema'+aConnection.Name;
+  S.PopulateResources(Conn,aTables,aMinFieldOpts);
+  if not (rdoConnectionInURL in DispatchOptions) then
+    S.ConnectionName:=aConnection.Name;
+  Schemas.AddSchema(S).Enabled:=true;
+  Result:=S;
+end;
+
+function TSQLDBRestDispatcher.ExposeConnection(
+  const aConnection: TSQLDBRestConnection; aTables: TStrings;
+  aMinFieldOpts: TRestFieldOptions): TSQLDBRestSchema;
+begin
+  Result:=ExposeConnection(Self,aConnection,aTables,aMinFieldOpts);
+end;
+
+{ TSchemaFreeNotifier }
+
+procedure TSchemaFreeNotifier.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation=opRemove) and Assigned(FRef) and (Fref.Schema=aComponent) then
+    Fref.Schema:=nil;
+end;
+
+
+{ TSQLDBRestSchemaRef }
+
+
+procedure TSQLDBRestSchemaRef.SetSchema(AValue: TSQLDBRestSchema);
+begin
+  if (FSchema=AValue) then Exit;
+  if Assigned(FSchema) then
+    FSchema.RemoveFreeNotification(FNotifier);
+  FSchema:=AValue;
+  if Assigned(FSchema) then
+    FSchema.FreeNotification(FNotifier);
+end;
+
+function TSQLDBRestSchemaRef.GetDisplayName: String;
+begin
+  if Assigned(FSchema) then
+    Result:=FSchema.Name
+  else
+    Result:=inherited GetDisplayName;
+end;
+
+constructor TSQLDBRestSchemaRef.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FNotifier:=TSchemaFreeNotifier.Create(Nil);
+  TSchemaFreeNotifier(FNotifier).FRef:=Self;
+  FEnabled:=True;
+end;
+
+destructor TSQLDBRestSchemaRef.Destroy;
+begin
+  FreeAndNil(FNotifier);
+  inherited Destroy;
+end;
+
+procedure TSQLDBRestSchemaRef.Assign(Source: TPersistent);
+
+Var
+  R : TSQLDBRestSchemaRef;
+
+begin
+  if (Source is TSQLDBRestSchemaRef) then
+    begin
+    R:=Source as TSQLDBRestSchemaRef;
+    Schema:=R.Schema;
+    Enabled:=R.Enabled;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TSQLDBRestConnectionList }
+
+function TSQLDBRestConnectionList.GetConn(aIndex : integer): TSQLDBRestConnection;
+begin
+  Result:=TSQLDBRestConnection(Items[aIndex]);
+end;
+
+procedure TSQLDBRestConnectionList.SetConn(aIndex : integer; AValue: TSQLDBRestConnection);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+function TSQLDBRestConnectionList.IndexOfConnection(const aName: string
+  ): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and not SameText(GetConn(Result).Name,aName) do
+    Dec(Result);
+end;
+
+function TSQLDBRestConnectionList.FindConnection(const aName: string): TSQLDBRestConnection;
+Var
+  Idx : Integer;
+
+begin
+  Idx:=IndexOfConnection(aName);
+  if Idx=-1 then
+    Result:=Nil
+  else
+    Result:=GetConn(Idx);
+end;
+
+function TSQLDBRestConnectionList.AddConnection(const AType, aHostName, aDatabaseName, aUserName, aPassword: UTF8String): TSQLDBRestConnection;
+
+Var
+  Idx : Integer;
+  N : String;
+begin
+  Result:=Add as TSQLDBRestConnection;
+  IDX:=Result.ID;
+  Repeat
+    N:='Connection'+IntToStr(IDX);
+    Inc(Idx);
+  Until IndexOfConnection(N)=-1;
+  Result.Name:=N;
+  Result.ConnectionType:=aType;
+  Result.HostName:=aHostName;
+  Result.DatabaseName:=aDatabaseName;
+  Result.UserName:=aUserName;
+  Result.Password:=aPassword;
+end;
+
+procedure TSQLDBRestConnectionList.SaveToFile(const aFileName: UTF8String);
+
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmCreate);
+  try
+    SaveToStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionList.SaveToStream(const aStream: TStream);
+Var
+  D : TJSONData;
+  S : TJSONStringType;
+
+begin
+  D:=asJSON(JSONConnectionsRoot);
+  try
+    S:=D.FormatJSON();
+  finally
+    D.Free;
+  end;
+  aStream.WriteBuffer(S[1],Length(S)*SizeOf(TJSONCharType));
+end;
+
+function TSQLDBRestConnectionList.AsJSON(const aPropName: UTF8String): TJSONData;
+Var
+  S : TJSONStreamer;
+  A : TJSONArray;
+
+begin
+  S:=TJSONStreamer.Create(Nil);
+  try
+    A:=S.StreamCollection(Self);
+  finally
+    S.Free;
+  end;
+  if aPropName='' then
+    Result:=A
+  else
+    Result:=TJSONObject.Create([aPropName,A]);
+end;
+
+procedure TSQLDBRestConnectionList.LoadFromFile(const aFileName: UTF8String);
+Var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    LoadFromStream(F);
+  finally
+    F.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionList.LoadFromStream(const aStream: TStream);
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetJSON(aStream);
+  try
+    FromJSON(D,JSONConnectionsRoot);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionList.FromJSON(aData: TJSONData; const aPropName: UTF8String);
+Var
+  A : TJSONArray;
+  D : TJSONDestreamer;
+
+begin
+  if (aPropName<>'') then
+    A:=(aData as TJSONObject).Arrays[aPropName]
+  else
+    A:=aData as TJSONArray;
+  D:=TJSONDestreamer.Create(Nil);
+  try
+    Clear;
+    D.JSONToCollection(A,Self);
+  finally
+    D.Free;
+  end;
+end;
+
+{ TSQLDBRestConnection }
+
+procedure TSQLDBRestConnection.SetParams(AValue: TStrings);
+begin
+  if FParams=AValue then Exit;
+  FParams.Assign(AValue);
+end;
+
+function TSQLDBRestConnection.GetDisplayName: string;
+begin
+  Result:=Name;
+end;
+
+procedure TSQLDBRestConnection.SetConnection(AValue: TSQLConnection);
+begin
+  if FConnection=AValue then Exit;
+  if Assigned(FConnection) then
+    FConnection.RemoveFreeNotification(FNotifier);
+  FConnection:=AValue;
+  if Assigned(FConnection) then
+    FConnection.FreeNotification(FNotifier);
+end;
+
+function TSQLDBRestConnection.GetName: UTF8String;
+begin
+  Result:=FName;
+  if (Result='') and Assigned(SingleConnection) then
+    Result:=SingleConnection.Name;
+  if (Result='') then
+    Result:='Connection'+IntToStr(ID);
+end;
+
+constructor TSQLDBRestConnection.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FParams:=TStringList.Create;
+  FNotifier:=TConnectionFreeNotifier.Create(Nil);
+  TConnectionFreeNotifier(FNotifier).FRef:=Self;
+  FEnabled:=True;
+end;
+
+destructor TSQLDBRestConnection.Destroy;
+begin
+  TConnectionFreeNotifier(FNotifier).FRef:=Nil;
+  FreeAndNil(FNotifier);
+  FreeAndNil(FParams);
+  inherited Destroy;
+end;
+
+procedure TSQLDBRestConnection.Assign(Source: TPersistent);
+
+Var
+  C : TSQLDBRestConnection;
+
+begin
+  if (Source is TSQLDBRestConnection) then
+    begin
+    C:=Source as TSQLDBRestConnection;
+    Password:=C.Password;
+    UserName:=C.UserName;
+    CharSet :=C.CharSet;
+    HostName:=C.HostName;
+    Role:=C.Role;
+    DatabaseName:=C.DatabaseName;
+    ConnectionType:=C.ConnectionType;
+    Params.Assign(C.Params);
+    end
+  else
+    inherited Assign(Source);
+end;
+
+
+Procedure InitSQLDBRest;
+
+begin
+  TSQLDBRestDispatcher.SetIOClass(TRestIO);
+  TSQLDBRestDispatcher.SetDBHandlerClass(TSQLDBRestDBHandler);
+  TSQLDBRestResource.DefaultFieldListClass:=TSQLDBRestFieldList;
+  TSQLDBRestResource.DefaultFieldClass:=TSQLDBRestField;
+end;
+
+Initialization
+  InitSQLDBRest;
+end.
+

packages/fcl-web/src/restbridge/sqldbrestcds.pp

@@ -0,0 +1,320 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST CDS input/output
+
+    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 sqldbrestcds;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DateUtils, db,fpjson, dom, XMLRead, XMLWrite,sqldbrestschema,sqldbrestio, sqldbrestbridge;
+
+Type
+
+  { TCDSInputStreamer }
+
+  TCDSInputStreamer = Class(TRestInputStreamer)
+  private
+    FXML: TXMLDocument;
+    FPacket : TDOMElement;
+    FROWData : TDOMElement;
+    FRow : TDOMElement;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    Function SelectObject(aIndex : Integer) : Boolean; override;
+    function GetContentField(aName: UTF8string): TJSONData; override;
+    procedure InitStreaming; override;
+    Property XML : TXMLDocument Read FXML;
+    Property Packet : TDOMElement Read FPacket;
+    Property RowData : TDOMElement Read FRowData;
+    Property Row : TDOMElement Read FRow;
+  end;
+
+  { TCDSOutputStreamer }
+
+  TCDSOutputStreamer = Class(TRestOutputStreamer)
+  Private
+    FXML: TXMLDocument;
+    FDataPacket : TDOMElement;
+    FMetaData : TDOMElement;
+    FRow : TDOMElement;
+    FRowData: TDOMElement;
+  Protected
+    Procedure SetOutputOptions(AValue: TRestOutputOptions); override;
+  Public
+    procedure EndData; override;
+    procedure EndRow; override;
+    procedure FinalizeOutput; override;
+    procedure StartData; override;
+    procedure StartRow; override;
+    // Return Nil for null field.
+    procedure WriteField(aPair: TRestFieldPair); override;
+    procedure WriteMetadata(aFieldList: TRestFieldPairArray); override;
+    Procedure CreateErrorContent(aCode : Integer; Const aMessage: String); override;
+    Property XML : TXMLDocument Read FXML;
+    Property RowData : TDOMelement Read FRowData;
+    Property Row : TDOMelement Read FRow;
+    Property Metadata : TDOMelement Read FMetadata;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    procedure InitStreaming; override;
+  end;
+
+implementation
+
+uses sqldbrestconst;
+
+
+
+Const
+  DateTimeFmt = 'yyyymmddThh:nn:sszzz';
+
+
+Const
+  XMLPropTypeNames : Array [TRestFieldType] of UnicodeString = (
+    'Unknown' {rftUnknown},
+    'i4' {rftInteger},
+    'i8' {rftLargeInt},
+    'r8' {rftFloat},
+    'dateTime' {rftDate},
+    'dateTime' {rftTime},
+    'dateTime' {rftDateTime},
+    'string' {rftString},
+    'boolean' {rftBoolean},
+    'bin.hex:Binary' {rftBlob}
+  );
+
+{ TCDSInputStreamer }
+
+destructor TCDSInputStreamer.Destroy;
+begin
+  FreeAndNil(FXML);
+  inherited Destroy;
+end;
+
+class function TCDSInputStreamer.GetContentType: String;
+begin
+  Result:='text/xml';
+end;
+
+function TCDSInputStreamer.SelectObject(aIndex: Integer): Boolean;
+
+Var
+  N : TDomNode;
+  NN : UnicodeString;
+begin
+  Result:=False;
+  NN:='ROW';
+  N:=FRowData.FindNode(NN);
+  if Not (Assigned(N) and (N is TDOMelement)) then
+    raise ESQLDBRest.CreateFmt(400, SErrInvalidCDSMissingElement,[NN]);
+  While (aIndex>0) and (N<>Nil) and (N.NodeName<>NN) and (N.NodeType<>ELEMENT_NODE) do
+    begin
+    N:=N.NextSibling;
+    Dec(aIndex);
+    end;
+  Result:=(aIndex=0) and (N<>Nil);
+  If Result then
+    FRow:=N as TDomElement
+  else
+    FRow:=Nil;
+end;
+
+
+function TCDSInputStreamer.GetContentField(aName: UTF8string): TJSONData;
+
+Var
+  NN : UnicodeString;
+
+begin
+  NN:=UTF8Decode(aName);
+  if Assigned(FRow) and FRow.hasAttribute(NN) then
+    Result:=TJSONString.Create(FRow.AttribStrings[NN])
+  else
+    Result:=Nil;
+end;
+
+procedure TCDSInputStreamer.InitStreaming;
+
+Var
+  Msg : String;
+  N : TDomNode;
+
+begin
+  FreeAndNil(FXML);
+  if Stream.Size<=0 then
+    exit;
+  try
+    ReadXMLFile(FXML,Stream);
+  except
+    On E : Exception do
+      begin
+      Msg:=E.Message;
+      FXML:=Nil;
+      end;
+  end;
+  if (FXML=Nil)  then
+    raise ESQLDBRest.CreateFmt(400, SErrInvalidXMLInput, [Msg]);
+  FPacket:=FXML.DocumentElement;
+  if (FPacket=Nil)  then
+    raise ESQLDBRest.CreateFmt(400, SErrInvalidXMLInput, [SErrMissingDocumentRoot]);
+  if (FPacket.NodeName<>'DATAPACKET') then
+    Raise ESQLDBRest.CreateFmt(400,SErrInvalidCDSMissingElement,['DATAPACKET']);
+  N:=FPacket.FindNode('ROWDATA');
+  if Not (Assigned(N) and (N is TDOMelement)) then
+    Raise ESQLDBRest.CreateFmt(400,SErrInvalidCDSMissingElement,[ROWDATA]);
+  FRowData:=(N as TDOMelement);
+end;
+
+{ TCDSOutputStreamer }
+
+procedure TCDSOutputStreamer.SetOutputOptions(AValue: TRestOutputOptions);
+begin
+  Include(AValue,ooMetadata); // We always need metadata
+  inherited SetOutputOptions(AValue);
+end;
+
+procedure TCDSOutputStreamer.EndData;
+begin
+  FRowData:=Nil;
+end;
+
+procedure TCDSOutputStreamer.EndRow;
+begin
+  FRow:=Nil;
+end;
+
+procedure TCDSOutputStreamer.FinalizeOutput;
+
+begin
+  xmlwrite.WriteXML(FXML,Stream);
+  FreeAndNil(FXML);
+end;
+
+procedure TCDSOutputStreamer.StartData;
+
+begin
+  // Do nothing
+end;
+
+procedure TCDSOutputStreamer.StartRow;
+begin
+  if (FRow<>Nil) then
+    Raise ESQLDBRest.Create(500,SErrDoubleRowStart);
+  FRow:=FXML.CreateElement('ROW');
+  FRowData.AppendChild(FRow);
+end;
+
+procedure TCDSOutputStreamer.WriteField(aPair: TRestFieldPair);
+
+Var
+  N : UTF8String;
+  S : UTF8String;
+  F : TField;
+
+begin
+  N:=aPair.RestField.PublicName;
+  if FRow=Nil then
+    Raise ESQLDBRest.CreateFmt(500,SErrFieldWithoutRow,[N]);
+  F:=aPair.DBField;
+  If (aPair.RestField.FieldType=rftUnknown) then
+    raise ESQLDBRest.CreateFmt(500,SErrUnsupportedRestFieldType, [N]);
+  If (F.IsNull) then
+    Exit;
+  if (aPair.RestField.FieldType in [rftDate,rftTime,rftDateTime]) then
+    S:=FormatDateTime(DateTimeFmt,F.AsDateTime)
+  else
+    S:=FieldToString(aPair.RestField.FieldType,F);
+  FRow[UTF8Decode(N)]:=UTF8Decode(S);
+end;
+
+procedure TCDSOutputStreamer.WriteMetadata(aFieldList: TRestFieldPairArray);
+
+Var
+  FL,F : TDOMElement;
+  P : TREstFieldPair;
+  S,ST : UnicodeString;
+  ml : Integer;
+
+begin
+  FL:=FXML.CreateElement('FIELDS');
+  FMetaData.AppendChild(FL);
+  For P in aFieldList do
+    begin
+    S:=XMLPropTypeNames[P.RestField.FieldType];
+    if (S<>'') then
+      begin
+      ST:='';
+      if P.RestField.PublicName='ID' then
+        ST:='autoinc';
+      F:=FXML.CreateElement('FIELD');
+      F['attrname']:=Utf8Decode(P.RestField.PublicName);
+      F['fieldtype']:=S;
+      if P.RestField.FieldType=rftString then
+         begin
+         ML:=P.RestField.MaxLen;
+         if ML=0 then
+           ML:=255;
+         F['WIDTH']:=Utf8Decode(IntToStr(P.RestField.MaxLen));
+         end;
+      if (ST<>'') then
+        F['subtype']:=ST;
+      FL.AppendChild(F);
+      end;
+    end;
+end;
+
+class function TCDSOutputStreamer.GetContentType: String;
+begin
+  Result:='text/xml';
+end;
+
+procedure TCDSOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
+
+Var
+  ErrorObj : TDomElement;
+
+begin
+  ErrorObj:=FXML.CreateElement(UTF8Decode(GetString(rpErrorRoot)));
+  ErrorObj['code']:=UTF8Decode(IntToStr(aCode));
+  ErrorObj['message']:=UTF8Decode(aMessage);
+  FDataPacket.AppendChild(ErrorObj);
+end;
+
+destructor TCDSOutputStreamer.Destroy;
+begin
+  FreeAndNil(FXML);
+  inherited Destroy;
+end;
+
+procedure TCDSOutputStreamer.InitStreaming;
+begin
+  FXML:=TXMLDocument.Create;
+  FDataPacket:=FXML.CreateElement('DATAPACKET');
+  FXML.AppendChild(FDataPacket);
+  FDataPacket['Version']:='2.0';
+  FMetaData:=FXML.CreateElement('METADATA');
+  FDataPacket.AppendChild(FMetaData);
+  FRowData:=FXML.CreateElement('ROWDATA');
+  FDataPacket.AppendChild(FRowData);
+end;
+
+Initialization
+  TCDSInputStreamer.RegisterStreamer('cds');
+  TCDSOutputStreamer.RegisterStreamer('cds');
+end.
+

packages/fcl-web/src/restbridge/sqldbrestconst.pp

@@ -0,0 +1,58 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST bridge constants.
+
+    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 sqldbrestconst;
+
+{$mode objfpc}{$H+}
+
+interface
+
+Resourcestring
+  SErrNoconnection = 'Could not determine connection for resource "%s"';
+  SErrUnexpectedException = 'An unexpected exception %s occurred with message: %s';
+  SErrFieldWithoutRow = 'Attempt to write field %s without active row!';
+  SErrUnsupportedRestFieldType = 'Unsupported REST field type : %s';
+  SErrDoubleRowStart = 'Starting row within active row';
+  SErrMissingParameter = 'No value provided for parameter: "%s"';
+  SErrInvalidParam = 'Invalid value for parameter: "%s"';
+  SErrFilterParamNotFound = 'Filter parameter for field "%s" not found.';
+  SErrResourceNameEmpty = 'Resource Public name is not allowed to be empty.';
+  SErrDuplicateResource = 'Duplicate resource name : %s';
+  SErrUnknownStatement = 'Unknown kind of statement : %d';
+  SErrRegisterUnknownStreamerClass = 'Registering streamer of unknown class: %s';
+  SErrUnRegisterUnknownStreamerClass = 'Unregistering streamer of unknown class: %s';
+  SErrLimitNotSupported = 'Limit not supported by database backend';
+  SErrInvalidSortField = 'Field "%s" cannot be sorted on';
+  SErrInvalidSortDescField = 'Field "%s" cannot be sorted DESC';
+  SErrInvalidBooleanForField = 'Invalid boolean value for NULL filter on field "%s"';
+  SErrNoKeyParam = 'No key parameter specified';
+  SErrUnknownOrUnSupportedFormat = 'Unknown or unsupported streaming format: %s';
+  SUnauthorized = 'Unauthorized';
+  SErrInvalidXMLInputMissingElement = 'Invalid XML input: missing %s element ';
+  SErrInvalidXMLInput = 'Invalid XML input: %s';
+  SErrMissingDocumentRoot = 'Missing document root';
+  SErrInvalidCDSMissingElement = 'Invalid CDS Data packet: missing %s element';
+  SErrNoResourceDataFound = 'Failed to find resource data in input';
+  SErrNoRESTDispatcher = 'No REST bridge dispatcher assigned to handle request!';
+
+Const
+  DefaultAuthenticationRealm = 'REST API Server';
+  ISODateTimeFormat = 'YYYY"-"mm"-"dd"T"hh":"nn":"ss"';
+  ISODateFormat = ISODateTimeFormat;
+  ISOTimeFormat = '"0000-00-00T"hh":"nn":"ss"';
+
+implementation
+
+end.
+

packages/fcl-web/src/restbridge/sqldbrestcsv.pp

@@ -0,0 +1,210 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST CSV input/output
+
+    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 sqldbrestcsv;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldbrestio, fpjson, sqldbrestschema, csvreadwrite;
+
+Type
+  { TCSVInputStreamer }
+
+  TCSVInputStreamer = Class(TRestInputStreamer)
+  private
+    FCSV: TCSVParser;
+    FValues,
+    FFields : TStrings;
+  Protected
+    Property CSV : TCSVParser Read FCSV;
+  Public
+    Destructor Destroy; override;
+    Function SelectObject(aIndex : Integer) : Boolean; override;
+    function GetContentField(aName: UTF8string): TJSONData; override;
+    procedure InitStreaming; override;
+  end;
+
+  { TCSVOutputStreamer }
+  TCSVOutputStreamer = Class(TRestOutputStreamer)
+  Private
+    FCSV : TCSVBuilder;
+    FField : integer;
+    FRow : Integer;
+  Public
+    procedure EndData; override;
+    procedure EndRow; override;
+    procedure FinalizeOutput; override;
+    procedure StartData; override;
+    procedure StartRow; override;
+    // Return Nil for null field.
+    procedure WriteField(aPair: TRestFieldPair); override;
+    procedure WriteMetadata(aFieldList: TRestFieldPairArray); override;
+    Procedure CreateErrorContent(aCode : Integer; Const aMessage: String); override;
+    Property CSV : TCSVBuilder Read FCSV;
+  Public
+    Destructor Destroy; override;
+    Class Function GetContentType: String; override;
+    procedure InitStreaming; override;
+  end;
+
+implementation
+
+uses DateUtils;
+
+{ TCSVInputStreamer }
+
+procedure TCSVInputStreamer.InitStreaming;
+
+begin
+  FreeAndNil(FCSV);
+  FreeAndNil(FFields);
+  FCSV:=TCSVParser.Create;
+  FCSV.SetSource(Stream);
+  FCSV.QuoteChar:='"';
+  FCSV.Delimiter:=',';
+  FCSV.LineEnding:=LineEnding;//
+  FFields:=TStringList.Create;
+  FValues:=TStringList.Create;
+  While FCSV.ParseNextCell and (FCSV.CurrentRow=0) do
+    FFields.Add(FCSV.CurrentCellText);
+end;
+
+destructor TCSVInputStreamer.Destroy;
+begin
+  FreeAndNil(FCSV);
+  FreeAndNil(FValues);
+  FreeAndNil(FFields);
+  inherited Destroy;
+end;
+
+function TCSVInputStreamer.SelectObject(aIndex: Integer): Boolean;
+
+begin
+  Result:=(aIndex=0) and (FCSV<>Nil) and (FCSV.CurrentRow=1);
+  if Not Result then
+    exit;
+  Repeat
+   // We are on the first cell
+   FValues.Add(FCSV.CurrentCellText);
+  until Not (FCSV.ParseNextCell) or (FCSV.CurrentRow=2);
+end;
+
+function TCSVInputStreamer.GetContentField(aName: UTF8string): TJSONData;
+
+Var
+  Idx : Integer;
+
+begin
+  Idx:=FFields.IndexOf(aName);
+  if (Idx>=0) and (Idx<FValues.Count) then
+    Result:=TJSONString.Create(FValues[Idx])
+  else
+    Result:=nil;
+end;
+
+{ TCSVOutputStreamer }
+
+
+procedure TCSVOutputStreamer.EndData;
+begin
+  FRow:=0;
+end;
+
+procedure TCSVOutputStreamer.EndRow;
+begin
+  if FField=0 then exit;
+  inc(FRow);
+  FCSV.AppendRow;
+  FField:=0;
+end;
+
+procedure TCSVOutputStreamer.FinalizeOutput;
+
+
+begin
+  // Nothing needs to be done.
+  FreeAndNil(FCSV);
+end;
+
+procedure TCSVOutputStreamer.StartData;
+begin
+  FRow:=0;
+end;
+
+procedure TCSVOutputStreamer.StartRow;
+begin
+  Inc(FRow);
+end;
+
+procedure TCSVOutputStreamer.WriteField(aPair: TRestFieldPair);
+
+Var
+  S : UTF8String;
+
+begin
+  S:=FieldToString(aPair.RestField.FieldType,aPair.DBField);
+  FCSV.AppendCell(S);
+  Inc(FField);
+end;
+
+procedure TCSVOutputStreamer.WriteMetadata(aFieldList: TRestFieldPairArray);
+
+Var
+  P : TREstFieldPair;
+
+begin
+  For P in aFieldList do
+    FCSV.AppendCell(P.RestField.PublicName);
+  FCSV.AppendRow;
+end;
+
+Class function TCSVOutputStreamer.GetContentType: String;
+begin
+  Result:='text/csv';
+end;
+
+procedure TCSVOutputStreamer.CreateErrorContent(aCode: Integer; const aMessage: String);
+
+Var
+  S : String;
+
+begin
+  S:=Format('<html><title>Error %d: %s</title>',[aCode,aMessage]);
+  S:=S+Format('<body><h1>Error %d : %s</h1></body></html>',[aCode,aMessage]);
+  Stream.WriteBuffer(S[1],Length(S));
+end;
+
+destructor TCSVOutputStreamer.Destroy;
+begin
+  FreeAndNil(FCSV);
+  inherited Destroy;
+end;
+
+procedure TCSVOutputStreamer.InitStreaming;
+begin
+  FCSV:=TCSVBuilder.Create;
+  FCSV.SetOutput(Stream);
+  FCSV.QuoteChar:='"';
+  FCSV.Delimiter:=',';
+  FCSV.QuoteOuterWhitespace:=True;
+end;
+
+initialization
+  TCSVInputStreamer.RegisterStreamer('CSV');
+  TCSVOutputStreamer.RegisterStreamer('CSV');
+end.
+

packages/fcl-web/src/restbridge/sqldbrestdata.pp

@@ -0,0 +1,880 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST data manipulation routines.
+
+    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 sqldbrestdata;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldb, db, fpjson, sqldbrestio, sqldbrestschema;
+
+Type
+  TSQLQueryClass = Class of TSQLQuery;
+
+  TRestFilterPair = Record
+    Field : TSQLDBRestField;
+    Operation : TRestFieldFilter;
+    ValueParam : TParam;
+    Value : String;
+  end;
+  TRestFilterPairArray = Array of TRestFilterPair;
+
+  { TSQLDBRestDBHandler }
+
+  TSQLDBRestDBHandler = Class(TComponent)
+  private
+    FDeriveResourceFromDataset: Boolean;
+    FEmulateOffsetLimit: Boolean;
+    FEnforceLimit: Int64;
+    FExternalDataset: TDataset;
+    FPostParams: TParams;
+    FQueryClass: TSQLQueryClass;
+    FRestIO: TRestIO;
+    FStrings : TRestStringsConfig;
+    FResource : TSQLDBRestResource;
+    FOwnsResource : Boolean;
+    procedure SetExternalDataset(AValue: TDataset);
+    function StreamRecord(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray): Boolean;
+  Protected
+    procedure CreateResourceFromDataset(D: TDataset); virtual;
+    procedure DoNotFound; virtual;
+    procedure SetPostParams(aParams: TParams; Old : TFields = Nil);virtual;
+    procedure InsertNewRecord; virtual;
+    procedure UpdateExistingRecord(OldData: TDataset); virtual;
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    function SpecialResource: Boolean; virtual;
+    function GetGeneratorValue(const aGeneratorName: String): Int64; virtual;
+    function GetSpecialDatasetForResource(aFieldList: TRestFieldPairArray): TDataset; virtual;
+    function FindFieldForParam(aOperation: TRestOperation; P: TParam): TSQLDBRestField; virtual;
+    function BuildFieldList(ForceAll : Boolean): TRestFieldPairArray; virtual;
+    function CreateQuery(aSQL: String): TSQLQuery; virtual;
+    procedure FillParams(aOperation: TRestOperation; aQuery: TSQLQuery; FilteredFields: TRestFilterPairArray); virtual;
+    function GetDatasetForResource(aFieldList: TRestFieldPairArray; Singleton : Boolean): TDataset; virtual;
+    function GetOrderByFieldArray: TRestFieldOrderPairArray;
+    function GetOrderBy: UTF8String;virtual;
+    function GetIDWhere(Out FilteredFields : TRestFilterPairArray): UTF8String; virtual;
+    function GetWhere(Out FilteredFields : TRestFilterPairArray): UTF8String; virtual;
+    function GetLimit: UTF8String;
+    // Handle 4 basic operations
+    procedure DoHandleGet;virtual;
+    procedure DoHandleDelete;virtual;
+    procedure DoHandlePost;virtual;
+    procedure DoHandlePut; virtual;
+    // Parameters used when executing update SQLs. Used to get values for return dataset params.
+    Property PostParams : TParams Read FPostParams;
+  Public
+    Destructor Destroy; override;
+    // Get limi
+    Function GetLimitOffset(out aLimit, aOffset: Int64) : Boolean; virtual;
+    Procedure Init(aIO: TRestIO; aStrings : TRestStringsConfig;AQueryClass : TSQLQueryClass); virtual;
+    Procedure ExecuteOperation;
+    Function StreamDataset(O: TRestOutputStreamer; D: TDataset; FieldList: TRestFieldPairArray) : Int64;
+    procedure SetParamFromData(P: TParam; F: TSQLDBRestField; D: TJSONData); virtual;
+    function GetDataForParam(P: TParam; F: TSQLDBRestField; Sources : TVariableSources = AllVariableSources): TJSONData; virtual;
+    Function GetString(aString : TRestStringProperty) : UTF8String;
+    Property IO : TRestIO Read FRestIO;
+    Property Strings : TRestStringsConfig Read FStrings;
+    Property QueryClass : TSQLQueryClass Read FQueryClass;
+    Property EnforceLimit : Int64 Read FEnforceLimit Write FEnforceLimit;
+    Property ExternalDataset : TDataset Read FExternalDataset Write SetExternalDataset;
+    Property EmulateOffsetLimit : Boolean Read FEmulateOffsetLimit Write FEmulateOffsetLimit;
+    Property DeriveResourceFromDataset : Boolean Read FDeriveResourceFromDataset Write FDeriveResourceFromDataset;
+  end;
+  TSQLDBRestDBHandlerClass = class of TSQLDBRestDBHandler;
+
+
+implementation
+
+uses strutils, dateutils, base64, sqldbrestconst;
+
+
+Const
+  FilterParamPrefix : Array [TRestFieldFilter] of string = ('eq_','lt_','gt_','lte_','gte_','');
+  FilterOps : Array [TRestFieldFilter] of string = ('=','<','>','<=','>=','IS NULL');
+
+{ TSQLDBRestDBHandler }
+
+
+procedure TSQLDBRestDBHandler.Init(aIO: TRestIO; aStrings: TRestStringsConfig; AQueryClass: TSQLQueryClass);
+begin
+  FRestIO:=aIO;
+  FQueryClass:=aQueryClass;
+  FStrings:=aStrings;
+end;
+
+procedure TSQLDBRestDBHandler.ExecuteOperation;
+
+begin
+  if Not DeriveResourceFromDataset then
+    FResource:=IO.Resource;
+  Case IO.Operation of
+    roGet : DoHandleGet;
+    roPut : DoHandlePut;
+    roPost : DoHandlePost;
+    roDelete : DoHandleDelete;
+  end;
+end;
+
+function TSQLDBRestDBHandler.GetString(aString: TRestStringProperty): UTF8String;
+begin
+  if Assigned(FStrings) then
+    Result:=FStrings.GetRestString(aString)
+  else
+    Result:=TRestStringsConfig.GetDefaultString(aString);
+end;
+
+
+function TSQLDBRestDBHandler.GetIDWhere(out FilteredFields: TRestFilterPairArray): UTF8String;
+
+Var
+  Qry : UTF8String;
+  L : TSQLDBRestFieldArray;
+  F: TSQLDBRestField;
+  I : Integer;
+
+begin
+  FilteredFields:=Default(TRestFilterPairArray);
+  Result:='';
+  if (IO.GetVariable('ID',Qry,[vsQuery,vsRoute,vsHeader])=vsNone) or (Qry='') then
+    if not Assigned(PostParams) then
+      raise ESQLDBRest.Create(400,SErrNoKeyParam);
+  L:=FResource.GetFieldArray(flWhereKey);
+  SetLength(FilteredFields,Length(L));
+  for I:=0 to Length(L)-1 do
+    begin
+    F:=L[i];
+    FilteredFields[I].Field:=F;
+    FilteredFields[I].Operation:=rfEqual;
+    // If we have postparams, it means we're building a dataset for return data.
+    // So check for actual DB value there
+    if Assigned(PostParams) then
+      FilteredFields[I].ValueParam:=PostParams.FindParam(F.FieldName);
+    if (FilteredFields[I].ValueParam=nil) then
+      FilteredFields[I].Value:=ExtractWord(1,Qry,['|']);
+    If (Result<>'') then
+      Result:=Result+' and ';
+    Result:='('+F.FieldName+' = :'+FilterParamPrefix[rfEqual]+F.FieldName+')';
+    end;
+end;
+
+function TSQLDBRestDBHandler.GetWhere(Out FilteredFields : TRestFilterPairArray): UTF8String;
+
+Const
+  MaxFilterCount = 1+ Ord(High(TRestFieldFilter)) - Ord(Low(TRestFieldFilter));
+
+Var
+  Qry : UTF8String;
+  L : TSQLDBRestFieldArray;
+  RF : TSQLDBRestField;
+  fo : TRestFieldFilter;
+  aLen : integer;
+
+begin
+  FilteredFields:=Default(TRestFilterPairArray);
+  Result:='';
+  L:=FResource.GetFieldArray(flFilter);
+  SetLength(FilteredFields,Length(L)*MaxFilterCount);
+  aLen:=0;
+  for RF in L do
+    for FO in RF.Filters do
+      if IO.GetFilterVariable(RF.PublicName,FO,Qry)<>vsNone then
+        begin
+        FilteredFields[aLen].Field:=RF;
+        FilteredFields[aLen].Operation:=FO;
+        FilteredFields[aLen].Value:=Qry;
+        Inc(aLen);
+        If (Result<>'') then Result:=Result+' AND ';
+        if FO<>rfNull then
+          Result:=Result+Format('(%s %s :%s%s)',[RF.FieldName,FilterOps[FO],FilterParamPrefix[FO],RF.FieldName])
+        else
+          Case IO.StrToNullBoolean(Qry,True) of
+            nbTrue : Result:=Result+Format('(%s IS NULL)',[RF.FieldName]);
+            nbFalse : Result:=Result+Format('(%s IS NOT NULL)',[RF.FieldName]);
+            nbNone :  Raise ESQLDBRest.CreateFmt(400,SErrInvalidBooleanForField,[RF.PublicName])
+          end;
+        end;
+  SetLength(FilteredFields,aLen);
+end;
+
+function TSQLDBRestDBHandler.GetOrderByFieldArray : TRestFieldOrderPairArray;
+
+  Procedure AddField(Idx : Integer; F : TSQLDBRestField; aDesc : boolean);
+
+  begin
+    Result[Idx].RestField:=F;
+    Result[Idx].Desc:=aDesc;
+  end;
+
+Var
+  L : TSQLDBRestFieldArray;
+  I,J,aLen : Integer;
+  F : TSQLDBRestField;
+  V,FN : UTF8String;
+  Desc : Boolean;
+
+begin
+  Result:=Default(TRestFieldOrderPairArray);
+  if IO.GetVariable(GetString(rpOrderBy),V,[vsQuery])=vsNone then
+    begin
+    L:=FResource.GetFieldArray(flWhereKey);
+    SetLength(Result,Length(L));
+    I:=0;
+    For F in L do
+      begin
+      AddField(I,F,False);
+      Inc(I);
+      end
+    end
+  else
+    begin
+    L:=FResource.GetFieldArray(flOrderBy);
+    aLen:=WordCount(V,[',']);
+    SetLength(Result,aLen);
+    For I:=1 to WordCount(V,[',']) do
+      begin
+      FN:=ExtractWord(I,V,[',']);
+      Desc:=SameText(ExtractWord(2,FN,[' ']),'desc');
+      FN:=ExtractWord(1,FN,[' ']);
+      J:=Length(L)-1;
+      While (J>=0) and Not SameText(L[J].PublicName,FN) do
+        Dec(J);
+      if J<0 then
+        Raise ESQLDBRest.CreateFmt(400,SErrInvalidSortField,[FN]);
+      F:=L[J];
+      if Desc then
+        if not (foOrderByDesc in F.Options) then
+          Raise ESQLDBRest.CreateFmt(400,SErrInvalidSortDescField,[FN]);
+      AddField(I-1,F,Desc)
+      end;
+    end;
+end;
+
+function TSQLDBRestDBHandler.GetOrderBy: UTF8String;
+
+Const
+  AscDesc : Array[Boolean] of string = ('ASC','DESC');
+
+Var
+  L : TRestFieldOrderPairArray;
+  P : TRestFieldOrderPair;
+
+begin
+  Result:='';
+  L:=GetOrderByFieldArray;
+  For P in L do
+    begin
+    if Result<>'' then
+      Result:=Result+', ';
+    Result:=Result+P.RestField.FieldName+' '+AscDesc[P.Desc];
+    end;
+end;
+
+function TSQLDBRestDBHandler.CreateQuery(aSQL: String): TSQLQuery;
+
+begin
+  Result:=FQueryClass.Create(Self);
+  Result.DataBase:=IO.Connection;
+  Result.Transaction:=IO.Transaction;
+  Result.SQL.Text:=aSQL;
+end;
+
+function TSQLDBRestDBHandler.BuildFieldList(ForceAll : Boolean): TRestFieldPairArray;
+
+Var
+  L : TSQLDBRestFieldArray;
+  F : TSQLDBRestField;
+  aCount : Integer;
+  Fi,Fe : TStrings;
+
+  Function ML(N : String) : TStrings;
+  Var
+    V : UTF8String;
+  begin
+    Result:=Nil;
+    if ForceAll then
+      exit;
+    IO.GetVariable(N,V);
+    if (V<>'') then
+      begin
+      Result:=TStringList.Create;
+      Result.StrictDelimiter:=True;
+      Result.CommaText:=V;
+      end;
+  end;
+
+  Function IsIncluded(F : TSQLDBRestField) : Boolean;
+  begin
+    Result:=(FI=Nil) or (FI.IndexOf(F.PublicName)<>-1)
+  end;
+
+  Function IsExcluded(F : TSQLDBRestField) : Boolean;
+  begin
+    Result:=(FE<>Nil) and (FE.IndexOf(F.PublicName)<>-1)
+  end;
+
+begin
+  Result:=Default(TRestFieldPairArray);
+  if Not Assigned(FResource) then
+    exit;
+  FE:=Nil;
+  FI:=ML(GetString(rpFieldList));
+  try
+    FE:=ML(GetString(rpExcludeFieldList));
+    L:=FResource.GetFieldArray(flSelect);
+    SetLength(Result,Length(L));
+    aCount:=0;
+    For F in L do
+      if IsIncluded(F) and not IsExcluded(F) then
+        begin
+        Result[aCount].RestField:=F;
+        Result[aCount].DBField:=Nil;
+        Inc(aCount);
+        end;
+     SetLength(Result,aCount);
+  finally
+    FI.Free;
+    FE.Free;
+  end;
+end;
+
+Function TSQLDBRestDBHandler.GetDataForParam(P : TParam; F : TSQLDBRestField; Sources : TVariableSources = AllVariableSources) : TJSONData;
+
+Var
+  vs : TVariableSource;
+  S,N : UTF8String;
+
+begin
+  Result:=Nil;
+  if Assigned(F) then
+    begin
+    N:=F.PublicName;
+    vs:=IO.GetVariable(N,S,Sources);
+    if (vs<>vsNone) then
+      Result:=TJSONString.Create(S)
+    else if (vsContent in Sources) then
+      Result:=IO.RESTInput.GetContentField(N);
+    end;
+  If (Result=Nil) then
+    begin
+    N:=P.Name;
+    if N='ID_' then
+      N:='ID';
+    vs:=IO.GetVariable(N,S);
+    if (vs<>vsNone) then
+      Result:=TJSONString.Create(S)
+    else if (vsContent in Sources) then
+      Result:=IO.RESTInput.GetContentField(N)
+    end;
+end;
+
+Procedure TSQLDBRestDBHandler.SetParamFromData(P : TParam; F : TSQLDBRestField; D : TJSONData);
+
+begin
+  if not Assigned(D) then
+    P.Clear
+  else if Assigned(F) then
+    Case F.FieldType of
+      rftInteger : P.AsInteger:=D.AsInteger;
+      rftLargeInt : P.AsLargeInt:=D.AsInt64;
+      rftFloat : P.AsFloat:=D.AsFloat;
+      rftDate : P.AsDateTime:=ScanDateTime(GetString(rpDateFormat),D.AsString);
+      rftTime : P.AsDateTime:=ScanDateTime(GetString(rpTimeFormat),D.AsString);
+      rftDateTime : P.AsDateTime:=ScanDateTime(GetString(rpDateTimeFormat),D.AsString);
+      rftString : P.AsString:=D.AsString;
+      rftBoolean : P.AsBoolean:=D.AsBoolean;
+      rftBlob :
+{$IFNDEF VER3_0}
+         P.AsBlob:=BytesOf(DecodeStringBase64(D.AsString));
+{$ELSE}
+         P.AsBlob:=DecodeStringBase64(D.AsString);
+{$ENDIF}
+    else
+      P.AsString:=D.AsString;
+    end
+  else
+    P.AsString:=D.AsString;
+end;
+
+Function TSQLDBRestDBHandler.FindFieldForParam(aOperation : TRestOperation; P : TParam) : TSQLDBRestField;
+
+Var
+  N : UTF8String;
+  A : TSQLDBRestFieldArray;
+
+begin
+  Result:=Nil;
+  N:=P.Name;
+  if (N='ID_') then
+    begin
+    A:=FResource.GetFieldArray(flWhereKey);
+    if (Length(A)=1) then
+      Result:=A[0];
+    end
+  else
+    Result:=FResource.Fields.FindByFieldName(N);
+end;
+
+procedure TSQLDBRestDBHandler.FillParams(aOperation : TRestOperation; aQuery: TSQLQuery;FilteredFields : TRestFilterPairArray);
+
+Var
+  I : Integer;
+  P : TParam;
+  D : TJSONData;
+  F : TSQLDBRestField;
+  FF : TRestFilterPair;
+  Sources : TVariableSources;
+
+
+begin
+  // Fill known params
+  for FF in FilteredFields do
+    begin
+    F:=FF.Field;
+    if FF.Operation<>rfNull then
+      begin
+      P:=aQuery.Params.FindParam(FilterParamPrefix[FF.Operation]+F.FieldName);
+      if not Assigned(P) then
+        Raise ESQLDBRest.CreateFmt(500,SErrFilterParamNotFound,[F.PublicName]);
+      if Assigned(FF.ValueParam) then
+        P.Value:=FF.ValueParam.Value
+      else
+        begin
+        D:=TJSONString.Create(FF.Value);
+        try
+          SetParamFromData(P,F,D)
+        finally
+          D.Free;
+        end;
+        end;
+      end;
+    end;
+  // Fill in remaining params. Determine source
+  case aOperation of
+    roGet : Sources:=[vsQuery,vsRoute];
+    roPost,
+    roPut : Sources:=[vsQuery,vsContent,vsRoute];
+    roDelete : Sources:=[vsQuery,vsRoute];
+  else
+    Sources:=AllVariableSources;
+  end;
+  For I:=0 to aQuery.Params.Count-1 do
+    begin
+    P:=aQuery.Params[i];
+    if P.IsNull then
+      try
+        D:=Nil;
+        F:=FindFieldForParam(aOperation,P);
+        D:=GetDataForParam(P,F,Sources);
+        if (D<>Nil) then
+          SetParamFromData(P,F,D)
+        else if (aOperation in [roDelete]) then
+          Raise ESQLDBRest.CreateFmt(400,SErrMissingParameter,[P.Name])
+        else
+          P.Clear;
+      finally
+        FreeAndNil(D);
+      end;
+    end;
+end;
+
+Function TSQLDBRestDBHandler.GetLimitOffset(Out aLimit,aOffset : Int64) : Boolean;
+
+begin
+  Result:=IO.GetLimitOffset(EnforceLimit,aLimit,aoffset);
+end;
+
+Function TSQLDBRestDBHandler.GetLimit : UTF8String;
+
+var
+  aOffset, aLimit : Int64;
+  CT : String;
+
+begin
+  Result:='';
+  GetLimitOffset(aLimit,aOffset);
+  if aLimit=0 then
+    exit;
+  if Not (IO.Connection is TSQLConnector) then
+    Raise ESQLDBRest.Create(500,SErrLimitNotSupported);
+  CT:=lowerCase(TSQLConnector(IO.Connection).ConnectorType);
+  if Copy(CT,1,5)='mysql' then
+    CT:='mysql';
+  case CT of
+    'mysql' : Result:=Format('LIMIT %d, %d',[aOffset,aLimit]);
+    'postgresql',
+    'sqlite3' : Result:=Format('LIMIT %d offset %d',[aLimit,aOffset]);
+    'interbase',
+    'firebird' : Result:=Format('ROWS %d TO %d',[aOffset,aOffset+aLimit-1]);
+    'oracle',
+    'sybase',
+    'odbc',
+    'MSSQLServer' : Result:=Format('OFFSET %d ROWS FETCH NEXT %d ROWS ONLY',[aOffset,aLimit]);
+  end;
+end;
+
+
+Function TSQLDBRestDBHandler.StreamRecord(O : TRestOutputStreamer; D : TDataset; FieldList : TRestFieldPairArray) : Boolean;
+
+Var
+  i : Integer;
+
+begin
+  Result:=IO.Resource.AllowRecord(D);
+  if not Result then
+    exit;
+  O.StartRow;
+  For I:=0 to Length(FieldList)-1 do
+    O.WriteField(FieldList[i]);
+  O.EndRow;
+end;
+
+Function TSQLDBRestDBHandler.StreamDataset(O : TRestOutputStreamer; D : TDataset; FieldList : TRestFieldPairArray) : Int64;
+
+Var
+  aLimit,aOffset : Int64;
+
+  Function LimitReached : boolean;
+
+  begin
+    Result:=EmulateOffsetLimit and (aLimit<=0);
+  end;
+
+Var
+  I : Integer;
+
+begin
+  Result:=0;
+  if EmulateOffsetLimit then
+    GetLimitOffset(aLimit,aOffset)
+  else
+    begin
+    aLimit:=0;
+    aOffset:=0;
+    end;
+  For I:=0 to Length(FieldList)-1 do
+    FieldList[i].DBField:=D.FieldByName(FieldList[i].RestField.FieldName);
+  if O.HasOption(ooMetadata) then
+    O.WriteMetadata(FieldList);
+  O.StartData;
+  if EmulateOffsetLimit then
+    While (aOffset>0) and not D.EOF do
+      begin
+      D.Next;
+      Dec(aOffset);
+      end;
+  While not (D.EOF or LimitReached) do
+    begin
+    If StreamRecord(O,D,FieldList) then
+      begin
+      Dec(aLimit);
+      inc(Result);
+      end;
+    D.Next;
+    end;
+  O.EndData;
+end;
+
+Function TSQLDBRestDBHandler.GetSpecialDatasetForResource(aFieldList : TRestFieldPairArray) :  TDataset;
+
+
+Var
+  aLimit,aOffset : Int64;
+
+begin
+  Result:=ExternalDataset;
+  if (Result=Nil) then
+    begin
+    GetLimitOffset(aLimit,aOffset);
+    Result:=FResource.GetDataset(aFieldList,GetOrderByFieldArray,aLimit,aOffset);
+    end;
+end;
+
+procedure TSQLDBRestDBHandler.SetExternalDataset(AValue: TDataset);
+begin
+  if FExternalDataset=AValue then Exit;
+  if Assigned(FExternalDataset) then
+    FExternalDataset.RemoveFreeNotification(Self);
+  FExternalDataset:=AValue;
+  if Assigned(FExternalDataset) then
+    FExternalDataset.FreeNotification(Self);
+end;
+
+Function TSQLDBRestDBHandler.SpecialResource : Boolean;
+
+begin
+  Result:=(ExternalDataset<>Nil) or Assigned(FResource.OnGetDataset);
+end;
+
+function TSQLDBRestDBHandler.GetDatasetForResource(aFieldList: TRestFieldPairArray; Singleton : Boolean): TDataset;
+
+Var
+  aWhere,aOrderby,aLimit,SQL : UTF8String;
+  Q : TSQLQuery;
+  WhereFilterList : TRestFilterPairArray;
+
+begin
+  if SpecialResource then
+    Exit(GetSpecialDatasetForResource(aFieldList));
+  if Singleton then
+    aWhere:=GetIDWhere(WhereFilterList)
+  else
+    aWhere:=GetWhere(WhereFilterList);
+  aOrderBy:=GetOrderBy;
+  aLimit:=GetLimit;
+  SQL:=FResource.GetResolvedSQl(skSelect,aWhere,aOrderBy,aLimit);
+  Q:=CreateQuery(SQL);
+  Try
+    FillParams(roGet,Q,WhereFilterList);
+    Result:=Q;
+  except
+    Q.Free;
+    raise;
+  end;
+end;
+
+procedure TSQLDBRestDBHandler.CreateResourceFromDataset(D : TDataset);
+
+begin
+  FOwnsResource:=True;
+  FResource:=TCustomViewResource.Create(Nil);
+  FResource.PopulateFieldsFromFieldDefs(D.FieldDefs,Nil,Nil,[]);
+end;
+
+procedure TSQLDBRestDBHandler.DoNotFound;
+
+begin
+  IO.Response.Code:=404;
+  IO.Response.CodeText:='NOT FOUND';  // Do not localize
+  IO.CreateErrorResponse;
+end;
+
+procedure TSQLDBRestDBHandler.DoHandleGet;
+
+Var
+  D : TDataset;
+  FieldList : TRestFieldPairArray;
+  qID : UTF8string;
+  Single : Boolean;
+
+begin
+  FieldList:=BuildFieldList(False);
+  Single:=(IO.GetVariable('ID',qId,[vsRoute,vsQuery])<>vsNone);
+  D:=GetDatasetForResource(FieldList,Single);
+  try
+    D.Open;
+    if DeriveResourceFromDataset then
+      begin
+      CreateResourceFromDataset(D);
+      FieldList:=BuildFieldList(False);
+      end;
+    if not (D.EOF and D.BOF) then
+      StreamDataset(IO.RESTOutput,D,FieldList)
+    else if Single then
+      DoNotFound;
+  finally
+    D.Free;
+  end;
+end;
+
+Function TSQLDBRestDBHandler.GetGeneratorValue(Const aGeneratorName : String) : Int64;
+
+begin
+  Result:=IO.Connection.GetNextValue(aGeneratorName,1);
+end;
+
+procedure TSQLDBRestDBHandler.SetPostParams(aParams : TParams; Old : TFields = Nil);
+
+Var
+  I : Integer;
+  P : TParam;
+  D : TJSONData;
+  F : TSQLDBRestField;
+  FOld : TField;
+  V : UTF8string;
+
+begin
+  For I:=0 to aParams.Count-1 do
+    try
+      D:=Nil;
+      FOld:=Nil;
+      P:=aParams[i];
+      F:=FResource.Fields.FindByFieldName(P.Name);
+      If Assigned(Fold) then
+        Fold:=Old.FindField(P.Name);
+      if (F<>Nil) then
+        begin
+        if (F.GeneratorName<>'') and (Old=Nil) then // Only when doing POST
+          D:=TJSONInt64Number.Create(GetGeneratorValue(F.GeneratorName))
+        else
+          D:=IO.RESTInput.GetContentField(F.PublicName);
+        end
+      else if IO.GetVariable(P.Name,V,[vsContent,vsQuery])<>vsNone then
+        D:=TJSONString.Create(V);
+      if (D=Nil) and Assigned(Fold) then
+        P.AssignFromField(Fold) // use old value
+      else
+        SetParamFromData(P,F,D); // Use new value, if any
+    finally
+      D.Free;
+    end;
+  // Give user a chance to look at it.
+  FResource.CheckParams(roPost,aParams);
+  // Save so it can be used in GetWHereID for return
+  FPostParams:=TParams.Create(TParam);
+  FPostParams.Assign(aParams);
+end;
+
+procedure TSQLDBRestDBHandler.InsertNewRecord;
+
+Var
+  S : TSQLStatement;
+  SQL : UTF8String;
+
+begin
+  SQL:=FResource.GetResolvedSQl(skInsert,'','','');
+  S:=TSQLStatement.Create(Self);
+  try
+    S.Database:=IO.Connection;
+    S.Transaction:=IO.Transaction;
+    S.SQL.Text:=SQL;
+    SetPostParams(S.Params);
+    S.Execute;
+    PostParams.Assign(S.Params);
+    S.Transaction.Commit;
+  Finally
+    S.Free;
+  end;
+end;
+
+procedure TSQLDBRestDBHandler.DoHandlePost;
+
+Var
+  D : TDataset;
+  FieldList : TRestFieldPairArray;
+
+begin
+  // We do this first, so we don't run any unnecessary queries
+  if not IO.RESTInput.SelectObject(0) then
+    raise ESQLDBRest.Create(400, SErrNoResourceDataFound);
+  InsertNewRecord;
+  // Now build response
+  FieldList:=BuildFieldList(False);
+  D:=GetDatasetForResource(FieldList,True);
+  try
+    D.Open;
+    IO.RESTOutput.OutputOptions:=IO.RESTOutput.OutputOptions-[ooMetadata];
+    StreamDataset(IO.RESTOutput,D,FieldList);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TSQLDBRestDBHandler.UpdateExistingRecord(OldData : TDataset);
+
+Var
+  S : TSQLStatement;
+  SQl : String;
+
+begin
+  SQL:=FResource.GetResolvedSQl(skUpdate,'','','');
+  S:=TSQLStatement.Create(Self);
+  try
+    S.Database:=IO.Connection;
+    S.Transaction:=IO.Transaction;
+    S.SQL.Text:=SQL;
+    SetPostParams(S.Params,OldData.Fields);
+    // Give user a chance to look at it.
+    FResource.CheckParams(roPut,S.Params);
+    S.Execute;
+    S.Transaction.Commit;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TSQLDBRestDBHandler.DoHandlePut;
+
+Var
+  D : TDataset;
+  FieldList : TRestFieldPairArray;
+
+begin
+  // We do this first, so we don't run any unnecessary queries
+  if not IO.RESTInput.SelectObject(0) then
+    Raise ESQLDBRest.Create(400,SErrNoResourceDataFound);
+  // Get the original record.
+  FieldList:=BuildFieldList(True);
+  D:=GetDatasetForResource(FieldList,True);
+  try
+    D.Open;
+    if (D.BOF and D.EOF) then
+      begin
+      DoNotFound;
+      exit;
+      end;
+    UpdateExistingRecord(D);
+    // Now build response
+    FreeAndNil(D);
+    FieldList:=BuildFieldList(False);
+    D:=GetDatasetForResource(FieldList,True);
+    D.Open;
+    IO.RESTOutput.OutputOptions:=IO.RESTOutput.OutputOptions-[ooMetadata];
+    StreamDataset(IO.RESTOutput,D,FieldList);
+  finally
+    D.Free;
+  end;
+end;
+
+destructor TSQLDBRestDBHandler.Destroy;
+begin
+  FreeAndNil(FPostParams);
+  If FOwnsResource then
+     FreeAndNil(FResource);
+  inherited Destroy;
+end;
+
+procedure TSQLDBRestDBHandler.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  If Operation=opRemove then
+    begin
+    if (aComponent=FExternalDataset) then
+      FExternalDataset:=Nil;
+    end;
+end;
+
+procedure TSQLDBRestDBHandler.DoHandleDelete;
+
+Var
+  aWhere,SQL : UTF8String;
+  Q : TSQLQuery;
+  FilteredFields : TRestFilterPairArray;
+
+begin
+  aWhere:=GetIDWhere(FilteredFields);
+  SQL:=FResource.GetResolvedSQl(skDelete,aWhere,'');
+  Q:=CreateQuery(SQL);
+  try
+    FillParams(roDelete,Q,FilteredFields);
+    Q.ExecSQL;
+    if Q.RowsAffected<>1 then
+      DoNotFound;
+  finally
+    Q.Free;
+  end;
+end;
+
+end.
+

packages/fcl-web/src/restbridge/sqldbrestini.pp

@@ -0,0 +1,674 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2019 by the Free Pascal development team
+
+    SQLDB REST Dispatcher .ini file load/save support.
+
+    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 sqldbrestini;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, sqldbrestio, sqldbrestauth, sqldbrestbridge, sqldbrestschema, inifiles;
+
+Type
+  TConnectionIniOption = (scoClearOnRead,      // Clear values first
+                          scoSkipPassword,     // Do not save/load password
+                          scoSkipMaskPassword, // do not mask the password
+                          scoUserNameAsMask,   // use the username as mask for password
+                          scoSkipParams        // Do not read/write params.
+                         );
+  TConnectionIniOptions = Set of TConnectionIniOption;
+
+  TSQLDBRestConnectionHelper = class helper for TSQLDBRestConnection
+  Private
+    Procedure ClearValues;
+  Public
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; aOptions : TConnectionIniOptions = []); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TConnectionIniOptions); overload;
+    Procedure LoadFromFile(Const aFileName : String; aOptions : TConnectionIniOptions = []); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String; aOptions : TConnectionIniOptions); overload;
+    Procedure SaveToFile(Const aFileName : String; aOptions : TConnectionIniOptions = []);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String; aOptions : TConnectionIniOptions = []);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; aOptions : TConnectionIniOptions = []); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TConnectionIniOptions); overload;
+  end;
+
+  TDispatcherIniOption = (dioSkipReadConnections,   // Do not Read connection definitions
+                          dioSkipExposeConnections, // Do not Expose connections defined in .ini file
+                          dioSkipReadSchemas,       // Do not Read schema definitions
+                          dioDisableSchemas,        // Do not enable schemas
+                          dioSkipWriteConnections,  // Do not write connection definitions
+                          dioSkipWriteSchemas,      // Do not Read schema definitions
+                          dioSkipBasicAuth,         // Do not read/write basic auth data.
+                          dioSkipStringConfig       // Do not read strings config
+                          );
+  TDispatcherIniOptions = set of TDispatcherIniOption;
+
+  { TSQLDBRestDispatcherHelper }
+
+  TSQLDBRestDispatcherHelper = class helper for TSQLDBRestDispatcher
+  private
+  Public
+    procedure ReadSchemas(const aIni: TCustomIniFile; ASection: String; aOptions: TDispatcherIniOptions);
+    procedure ReadConnections(const aIni: TCustomIniFile; ASection: String);
+    procedure WriteConnections(const aIni: TCustomIniFile; ASection: String; aOptions : TConnectionIniOptions);
+    procedure WriteSchemas(const aIni: TCustomIniFile; ASection: String; SchemaFileDir : String);
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; aOptions : TDispatcherIniOptions = []); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TDispatcherIniOptions); overload;
+    Procedure LoadFromFile(Const aFileName : String; aOptions : TDispatcherIniOptions = []); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String; aOptions : TDispatcherIniOptions); overload;
+    Procedure SaveToFile(Const aFileName : String; aOptions : TDispatcherIniOptions = []);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String; aOptions : TDispatcherIniOptions = []);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; aOptions : TDispatcherIniOptions = []); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String; aOptions : TDispatcherIniOptions); overload;
+  end;
+
+  { TRestStringsConfigHelper }
+
+  TRestStringsConfigHelper = class helper for TRestStringsConfig
+  Public
+    Procedure LoadFromIni(Const aIni: TCustomIniFile); overload;
+    Procedure LoadFromIni(Const aIni: TCustomIniFile; ASection : String); overload;
+    Procedure LoadFromFile(Const aFileName : String); overload;
+    Procedure LoadFromFile(Const aFileName : String; Const ASection : String); overload;
+    Procedure SaveToFile(Const aFileName : String);overload;
+    Procedure SaveToFile(Const aFileName : String; Const ASection : String);overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile); overload;
+    Procedure SaveToIni(Const aIni: TCustomIniFile; ASection : String); overload;
+  end;
+
+
+Function StrToOutputOptions(S : String) : TRestOutputOptions;
+Function StrToDispatcherOptions(S : String) : TRestDispatcherOptions;
+Function StrToConnectionIniOptions(S : String) : TConnectionIniOptions;
+Function OutputOptionsToStr(Options : TRestOutputOptions): String;
+Function DispatcherOptionsToStr(Options: TRestDispatcherOptions) : String;
+Function ConnectionIniOptionsToStr(Options: TConnectionIniOptions): String;
+
+Var
+  TrivialEncryptKey : String = 'SQLDB';
+  DefaultConnectionSection : String = 'Connection';
+  DefaultDispatcherSection : String = 'Dispatcher';
+  DefaultStringsConfigSection : String = 'Dispatcher_strings';
+
+implementation
+
+uses typinfo,strutils, sqldbrestauthini;
+
+Const
+  KeyHost = 'Host';
+  KeyDatabaseName = 'DatabaseName';
+  KeyUserName = 'UserName';
+  KeyPassword = 'Password';
+  KeyPort = 'Port';
+  keyParams = 'Params';
+  KeyCharset = 'Charset';
+  KeyRole = 'Role';
+  KeyType = 'Type';
+  KeyConnections = 'Connections';
+  KeySchemas = 'Schemas';
+  keyDispatcherOptions = 'DispatcherOptions';
+  keyOutputOptions = 'OutputOptions';
+  KeyBasePath = 'BasePath';
+  KeyDefaultConnection = 'DefaultConnection';
+  KeyEnforceLimit = 'EnforceLimit';
+  KeyCORSAllowedOrigins = 'CORSAllowedOrigins';
+  KeyLoadOptions = 'LoadOptions';
+  KeyMinFieldOptions = 'MinFieldOptions';
+  KeyFileName = 'File';
+  KeyEnabled = 'Enabled';
+  KeyBasicAuth = 'BasicAuth';
+
+Function StrToOutputOptions(S : String) : TRestOutputOptions;
+
+var
+  i : integer;
+
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TRestOutputOptions)),S);
+  Result:=TRestOutputOptions(I);
+end;
+
+Function StrToDispatcherOptions(S : String) : TRestDispatcherOptions;
+
+var
+  i : integer;
+
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TRestDispatcherOptions)),S);
+  Result:=TRestDispatcherOptions(I);
+end;
+
+Function StrToConnectionIniOptions(S : String) : TConnectionIniOptions;
+
+var
+  i : integer;
+
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TConnectionIniOptions)),S);
+  Result:=TConnectionIniOptions(I);
+end;
+
+Function StrToRestFieldOptions(S : String) : TRestFieldOptions;
+
+var
+  i : integer;
+
+begin
+  I:=StringToSet(PTypeInfo(TypeInfo(TRestFieldOptions)),S);
+  Result:=TRestFieldOptions(I);
+end;
+
+Function OutputOptionsToStr(Options  : TRestOutputOptions): String;
+
+begin
+  Result:=SetToString(PTypeInfo(TypeInfo(TRestOutputOptions)),Integer(Options),False);
+end;
+
+Function DispatcherOptionsToStr(Options : TRestDispatcherOptions) : String;
+
+begin
+  Result:=SetToString(PTypeInfo(TypeInfo(TRestDispatcherOptions)),Integer(Options),false);
+end;
+
+Function ConnectionIniOptionsToStr(Options : TConnectionIniOptions): String;
+
+begin
+  Result:=SetToString(PTypeInfo(TypeInfo(TConnectionIniOptions)),Integer(Options),false);
+end;
+
+{ TRestStringsConfigHelper }
+
+procedure TRestStringsConfigHelper.LoadFromIni(const aIni: TCustomIniFile);
+begin
+  LoadFromIni(aIni,DefaultStringsConfigSection);
+end;
+
+procedure TRestStringsConfigHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String);
+
+Var
+  T : TRestStringProperty;
+  N : String;
+  S : UTF8String;
+
+begin
+  For T in TRestStringProperty do
+    begin
+    Str(T,N);
+    Delete(N,1,2);
+    S:=aIni.ReadString(aSection, N, GetRestString(T));
+    SetRestString(T,S);
+    end;
+end;
+
+procedure TRestStringsConfigHelper.LoadFromFile(const aFileName: String);
+begin
+  LoadFromFile(aFileName,DefaultStringsConfigSection);
+end;
+
+procedure TRestStringsConfigHelper.LoadFromFile(const aFileName: String; const ASection: String);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TRestStringsConfigHelper.SaveToFile(const aFileName: String);
+begin
+  SaveToFile(aFileName,DefaultStringsConfigSection);
+end;
+
+procedure TRestStringsConfigHelper.SaveToFile(const aFileName: String; const ASection: String);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToIni(Ini,aSection);
+    Ini.UpdateFile;
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TRestStringsConfigHelper.SaveToIni(const aIni: TCustomIniFile);
+begin
+  SaveToini(aIni,DefaultStringsConfigSection);
+end;
+
+procedure TRestStringsConfigHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String);
+Var
+  T : TRestStringProperty;
+  N : String;
+
+begin
+  For T in TRestStringProperty do
+    begin
+    Str(T,N);
+    Delete(N,1,2);
+    aIni.WriteString(aSection, N, GetRestString(T));
+    end;
+end;
+
+
+
+{ TSQLDBRestDispatcherHelper }
+
+procedure TSQLDBRestDispatcherHelper.LoadFromIni(const aIni: TCustomIniFile; aOptions: TDispatcherIniOptions);
+begin
+  LoadFromIni(aIni,DefaultDispatcherSection,aOptions);
+end;
+
+procedure TSQLDBRestDispatcherHelper.ReadConnections(const aIni: TCustomIniFile; ASection: String);
+
+Var
+  S,L : String;
+  I : Integer;
+  C : TSQLDBRestConnection;
+  CIO : TConnectionIniOptions;
+begin
+  // Read connections
+  L:=aIni.ReadString(aSection,KeyConnections,'');
+  For I:=1 to WordCount(L,[',']) do
+    begin
+    S:=ExtractWord(I,L,[',']);
+    C:=Connections.AddConnection('','','','','');
+    C.Name:=S;
+    CIO:=StrToConnectionIniOptions(aIni.ReadString(S,KeyLoadOptions,''));
+    C.LoadFromIni(aIni,S,CIO);
+    end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.WriteConnections(const aIni: TCustomIniFile; ASection: String; aOptions: TConnectionIniOptions);
+
+Var
+  S,L : String;
+  I : Integer;
+
+begin
+  L:='';
+  for I:=0 to Connections.Count-1 do
+    begin
+    if (L<>'') then
+      L:=L+',';
+    L:=L+Connections[i].Name;
+    end;
+  aIni.WriteString(aSection,KeyConnections,L);
+  for I:=0 to Connections.Count-1 do
+    begin
+    S:=Connections[i].Name;
+    L:=ConnectionIniOptionsToStr(aOptions);
+    Connections[i].SaveToIni(aIni,S,aOptions);
+    aIni.WriteString(S,KeyLoadOptions,L);
+    end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.WriteSchemas(const aIni: TCustomIniFile; ASection: String; SchemaFileDir : String);
+
+Var
+  S,L,FN : String;
+  I : Integer;
+  Sch : TSQLDBRestSchema;
+
+
+begin
+  // Read Schemas
+  L:='';
+  for I:=0 to Schemas.Count-1 do
+    if Assigned(Schemas[i].Schema) then
+      begin
+      if (L<>'') then
+        L:=L+',';
+      L:=L+Schemas[i].Schema.Name;
+      end;
+  aIni.WriteString(aSection,KeySchemas,L);
+  for I:=0 to Schemas.Count-1 do
+    if Assigned(Schemas[i].Schema) then
+      begin
+      S:=Schemas[i].Schema.Name;
+      Sch:=Schemas[i].Schema;
+      if (SchemaFileDir<>'') then
+        FN:=IncludeTrailingPathDelimiter(SchemaFileDir)+S+'.json'
+      else
+        FN:='';
+      aIni.WriteString(S,KeyFileName,FN);
+      aIni.WriteBool(S,KeyEnabled,Schemas[i].Enabled);
+      if (FN<>'') then
+        Sch.SaveToFile(FN);
+    end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.ReadSchemas(const aIni: TCustomIniFile; ASection: String; aOptions: TDispatcherIniOptions);
+
+Var
+  S,L,FN : String;
+  I : Integer;
+  Sch : TSQLDBRestSchema;
+  SRef : TSQLDBRestSchemaRef;
+
+
+begin
+  // Read Schemas
+  L:=aIni.ReadString(aSection,KeySchemas,'');
+  For I:=1 to WordCount(L,[',']) do
+    begin
+    S:=ExtractWord(I,L,[',']);
+    Sch:=TSQLDBRestSchema.Create(Self);
+    Sch.Name:=S;
+    SRef:=Schemas.AddSchema(Sch);
+    SRef.Enabled:=aIni.ReadBool(S,KeyEnabled,True);
+    if (dioDisableSchemas in aOptions) then
+      SRef.Enabled:=False;
+    FN:=aIni.ReadString(S,KeyFileName,'');
+    if (FN<>'') then
+      Sch.LoadFromFile(FN);
+    end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String; aOptions: TDispatcherIniOptions);
+
+Var
+  I : Integer;
+  FO : TRestFieldOptions;
+  BAN : String;
+  BA : TRestBasicAuthenticator;
+  BAO : TBasicAuthIniOptions;
+
+begin
+  DispatchOptions:=StrToDispatcherOptions(aIni.ReadString(aSection,keyDispatcherOptions,''));
+  OutputOptions:=StrToOutputOptions(aIni.ReadString(aSection,keyOutputOptions,''));
+  BasePath:=aIni.ReadString(aSection,KeyBasePath,'');
+  DefaultConnection:=aIni.ReadString(aSection,KeyDefaultConnection,'');
+  EnforceLimit:=aIni.ReadInteger(aSection,KeyEnforceLimit,0);
+  CORSAllowedOrigins:=aIni.ReadString(aSection,KeyCORSAllowedOrigins,'');
+  if Not (dioSkipReadConnections in aOptions) then
+    ReadConnections(aIni,aSection);
+  if Not (dioSkipReadSchemas in aOptions) then
+    ReadSchemas(aIni,aSection,aOptions);
+  // Expose connections
+  if not (dioSkipExposeConnections in aOptions) then
+    for I:=0 to Connections.Count-1 do
+      if Connections[i].Enabled then
+        begin
+        FO:=StrToRestFieldOptions(aIni.ReadString(Connections[i].Name,KeyMinFieldOptions,''));
+        ExposeConnection(Connections[i],Nil,FO);
+        end;
+  if not (dioSkipBasicAuth in aOptions) then
+    begin
+    BAN:=aIni.ReadString(aSection,KeyBasicAuth,'');
+    if BAN<>'' then
+      begin
+      BAO:=StrToBasicAuthIniOptions(aIni.ReadString(BAN,keyLoadOptions,''));
+      BA:=TRestBasicAuthenticator.Create(Self);
+      BA.Name:=BAN;
+      BA.LoadFromIni(aIni,BAN,BAO);
+      Self.Authenticator:=BA;
+      end;
+    end;
+  if not (dioSkipStringConfig in aOptions) then
+    Strings.LoadFromIni(aIni,aSection+'_strings');
+end;
+
+procedure TSQLDBRestDispatcherHelper.LoadFromFile(const aFileName: String; aOptions: TDispatcherIniOptions);
+begin
+  Loadfromfile(aFileName,DefaultDispatcherSection,aOptions);
+end;
+
+procedure TSQLDBRestDispatcherHelper.LoadFromFile(const aFileName: String; const ASection: String; aOptions: TDispatcherIniOptions);
+
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.SaveToFile(const aFileName: String; aOptions: TDispatcherIniOptions);
+begin
+  SaveTofile(aFileName,DefaultDispatcherSection,aOptions);
+end;
+
+procedure TSQLDBRestDispatcherHelper.SaveToFile(const aFileName: String; const ASection: String; aOptions: TDispatcherIniOptions);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToIni(Ini,aSection,aOptions);
+    Ini.UpdateFile;
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestDispatcherHelper.SaveToIni(const aIni: TCustomIniFile; aOptions: TDispatcherIniOptions);
+begin
+  SaveToIni(aIni,DefaultDispatcherSection,aOptions);
+end;
+
+procedure TSQLDBRestDispatcherHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String; aOptions: TDispatcherIniOptions);
+
+Var
+  BAN : String;
+
+begin
+  aIni.WriteString(aSection,keyDispatcherOptions,DispatcherOptionsToStr(DispatchOptions));
+  aIni.WriteString(aSection,keyOutputOptions,OutputOptionsToStr(OutputOptions));
+  aIni.WriteString(aSection,KeyBasePath,BasePath);
+  aIni.WriteString(aSection,KeyDefaultConnection,DefaultConnection);
+  aIni.WriteInteger(aSection,KeyEnforceLimit,EnforceLimit);
+  aIni.WriteString(aSection,KeyCORSAllowedOrigins,CORSAllowedOrigins);
+  if Not (dioSkipWriteConnections in aOptions) then
+    WriteConnections(aIni,aSection,[]);
+  if Not (dioSkipWriteSchemas in aOptions) then
+    WriteSchemas(aIni,aSection,ExtractFilePath(ExpandFileName(aIni.FileName)));
+  if not (dioSkipBasicAuth in aOptions) then
+    if Assigned(Authenticator) and (Authenticator is TRestBasicAuthenticator) then
+      begin
+      BAN:=Authenticator.Name;
+      if BAN='' then
+        BAN:=Self.Name+'_basicauth';
+      TRestBasicAuthenticator(Authenticator).SaveToIni(aIni,BAN,[]);
+      aIni.WriteString(aSection,KeyBasicAuth,BAN);
+      end;
+  if not (dioSkipStringConfig in aOptions) then
+    Strings.SaveToIni(aIni,aSection+'_strings');
+end;
+
+{ TSQLDBRestConnectionHelper }
+
+procedure TSQLDBRestConnectionHelper.ClearValues;
+begin
+  HostName:='';
+  DatabaseName:='';
+  UserName:='';
+  Password:='';
+  CharSet:='';
+  Params.Clear;
+  Port:=0;
+end;
+
+
+
+Const
+  ForbiddenParamKeys : Array[1..8] of unicodestring
+                     = (keyHost,KeyDatabaseName,KeyUserName,KeyPassword,KeyPort,keyParams,keyCharSet,keyRole);
+  ParamSeps = [',',';',' '];
+
+procedure TSQLDBRestConnectionHelper.LoadFromIni(const aIni: TCustomIniFile; ASection: String; aOptions: TConnectionIniOptions);
+
+Var
+  M,N,P : String;
+  I : integer;
+
+begin
+  With aIni do
+    begin
+    if (scoClearOnRead in aOptions) then
+       ClearValues;
+    ConnectionType:=ReadString(ASection,KeyType,'');
+    HostName:=ReadString(ASection,KeyHost,HostName);
+    DatabaseName:=ReadString(ASection,KeyDatabaseName,DatabaseName);
+    UserName:=ReadString(ASection,KeyUserName,UserName);
+    CharSet:=ReadString(ASection,KeyCharSet,CharSet);
+    Role:=ReadString(ASection,KeyRole,Role);
+    Port:=ReadInteger(ASection,KeyPort,Port);
+    Enabled:=ReadBool(ASection,KeyEnabled,True);
+    // optional parts
+    if not (scoSkipPassword in aOptions) then
+      begin
+      if scoSkipMaskPassword in aOptions then
+        P:=ReadString(ASection,KeyPassword,Password)
+      else
+        begin
+        P:=ReadString(ASection,KeyPassword,'');
+        if (P<>'') then
+          begin
+          if scoUserNameAsMask in aOptions then
+            M:=UserName
+          else
+            M:=TrivialEncryptKey;
+          P:=XorDecode(M,P);
+          end;
+        end;
+      Password:=P;
+      end;
+    if not (scoSkipParams in aOptions) then
+      begin
+      M:=ReadString(ASection,keyParams,'');
+      For I:=1 to WordCount(M,ParamSeps) do
+        begin
+        N:=ExtractWord(I,M,ParamSeps);
+        if IndexStr(Utf8Decode(N),ForbiddenParamKeys)=-1 then
+          begin
+          P:=ReadString(ASection,N,'');
+          Params.Values[N]:=P;
+          end;
+        end;
+      end;
+    end;
+end;
+
+procedure TSQLDBRestConnectionHelper.LoadFromIni(const aIni: TCustomIniFile; aOptions: TConnectionIniOptions);
+begin
+  LoadFromIni(aIni,DefaultConnectionSection,aOptions);
+end;
+
+procedure TSQLDBRestConnectionHelper.LoadFromFile(const aFileName: String; aOptions: TConnectionIniOptions);
+
+
+begin
+  Loadfromfile(aFileName,DefaultConnectionSection,aOptions);
+end;
+
+procedure TSQLDBRestConnectionHelper.LoadFromFile(const aFileName: String; const ASection: String; aOptions: TConnectionIniOptions);
+
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    LoadFromIni(Ini,aSection,aOptions);
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionHelper.SaveToFile(const aFileName: String; aOptions: TConnectionIniOptions);
+begin
+  SaveToFile(aFileName,DefaultConnectionSection,aOptions);
+end;
+
+procedure TSQLDBRestConnectionHelper.SaveToFile(const aFileName: String; const ASection: String; aOptions: TConnectionIniOptions);
+Var
+  Ini : TCustomIniFile;
+
+begin
+  Ini:=TMeminiFile.Create(aFileName);
+  try
+    SaveToini(Ini,aSection,aOptions);
+    Ini.UpdateFile;
+  finally
+    Ini.Free;
+  end;
+end;
+
+procedure TSQLDBRestConnectionHelper.SaveToIni(const aIni: TCustomIniFile; aOptions: TConnectionIniOptions);
+begin
+  SaveToIni(aIni,DefaultConnectionSection,aOptions);
+end;
+
+procedure TSQLDBRestConnectionHelper.SaveToIni(const aIni: TCustomIniFile; ASection: String; aOptions: TConnectionIniOptions);
+Var
+  M,N,P : String;
+  I : integer;
+
+begin
+  With aIni do
+    begin
+    WriteString(ASection,KeyHost,HostName);
+    WriteString(ASection,KeyDatabaseName,DatabaseName);
+    WriteString(ASection,KeyUserName,UserName);
+    WriteString(ASection,KeyCharSet,CharSet);
+    WriteString(ASection,KeyType,ConnectionType);
+    WriteString(ASection,KeyRole,Role);
+    WriteInteger(ASection,KeyPort,Port);
+    WriteBool(ASection,KeyEnabled,Enabled);
+    if not (scoSkipPassword in aOptions) then
+      begin
+      P:=Password;
+      if Not (scoSkipMaskPassword in aOptions) then
+        begin
+        if scoUserNameAsMask in aOptions then
+          M:=UserName
+        else
+          M:=TrivialEncryptKey;
+        P:=XorEncode(M,P);
+        end;
+      WriteString(ASection,KeyPassword,P);
+      end;
+    if not (scoSkipParams in aOptions) then
+      begin
+      M:='';
+      for I:=0 to Params.Count-1 do
+        begin
+        Params.GetNameValue(I,N,P);
+        if (N<>'') and (IndexStr(Utf8Decode(N),ForbiddenParamKeys)=-1) then
+          begin
+          WriteString(ASection,N,P);
+          if (M<>'') then
+            M:=M+',';
+          M:=M+N;
+          end;
+        end;
+      WriteString(ASection,KeyParams,M);
+      end;
+    end;
+end;
+
+end.